ext/Compress/IO/Zlib/t/004gziphdr.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = ("../lib", "lib/compress");
   5     }
   6 }
   7
   8 use lib qw(t t/compress);
   9 use strict;
  10 use warnings;
  11 use bytes;
  12
  13 use Test::More ;
  14 use CompTestUtils;
  15
  16 BEGIN {
  17     # use Test::NoWarnings, if available
  18     my $extra = 0 ;
  19     $extra = 1
  20         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  21
  22
  23     plan tests => 910 + $extra ;
  24
  25     use_ok('Compress::Raw::Zlib') ;
  26     use_ok('IO::Compress::Gzip::Constants') ;
  27
  28     use_ok('IO::Compress::Gzip', qw($GzipError)) ;
  29     use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ;
  30
  31 }
  32
  33
  34
  35 # Check the Gzip Header Parameters
  36 #========================================
  37
  38 my $ThisOS_code = $Compress::Raw::Zlib::gzip_os_code;
  39
  40 my $lex = new LexFile my $name ;
  41
  42 {
  43     title "Check Defaults";
  44     # Check Name defaults undef, no name, no comment
  45     # and Time can be explicitly set.
  46
  47     my $hdr = readHeaderInfo($name, -Time => 1234);
  48
  49     is $hdr->{Time}, 1234;
  50     ok ! defined $hdr->{Name};
  51     is $hdr->{MethodName}, 'Deflated';
  52     is $hdr->{ExtraFlags}, 0;
  53     is $hdr->{MethodID}, Z_DEFLATED;
  54     is $hdr->{OsID}, $ThisOS_code ;
  55     ok ! defined $hdr->{Comment} ;
  56     ok ! defined $hdr->{ExtraFieldRaw} ;
  57     ok ! defined $hdr->{HeaderCRC} ;
  58     ok ! $hdr->{isMinimalHeader} ;
  59 }
  60
  61 {
  62
  63     title "Check name can be different from filename" ;
  64     # Check Name can be different from filename
  65     # Comment and Extra can be set
  66     # Can specify a zero Time
  67
  68     my $comment = "This is a Comment" ;
  69     my $extra = "A little something extra" ;
  70     my $aname = "a new name" ;
  71     my $hdr = readHeaderInfo $name,
  72                                       -Strict     => 0,
  73                                       -Name       => $aname,
  74                                   -Comment    => $comment,
  75                                   -ExtraField => $extra,
  76                                   -Time       => 0 ;
  77
  78     ok $hdr->{Time} == 0;
  79     ok $hdr->{Name} eq $aname;
  80     ok $hdr->{MethodName} eq 'Deflated';
  81     ok $hdr->{MethodID} == 8;
  82     is $hdr->{ExtraFlags}, 0;
  83     ok $hdr->{Comment} eq $comment ;
  84     is $hdr->{OsID}, $ThisOS_code ;
  85     ok ! $hdr->{isMinimalHeader} ;
  86     ok ! defined $hdr->{HeaderCRC} ;
  87 }
  88
  89 {
  90     title "Check Time defaults to now" ;
  91
  92     # Check Time defaults to now
  93     # and that can have empty name, comment and extrafield
  94     my $before = time ;
  95     my $hdr = readHeaderInfo $name,
  96                           -TextFlag   => 1,
  97                           -Name       => "",
  98                       -Comment    => "",
  99                       -ExtraField => "";
 100     my $after = time ;
 101
 102     ok $hdr->{Time} >= $before ;
 103     ok $hdr->{Time} <= $after ;
 104
 105     ok defined $hdr->{Name} ;
 106     ok $hdr->{Name} eq "";
 107     ok defined $hdr->{Comment} ;
 108     ok $hdr->{Comment} eq "";
 109     ok defined $hdr->{ExtraFieldRaw} ;
 110     ok $hdr->{ExtraFieldRaw} eq "";
 111     is $hdr->{ExtraFlags}, 0;
 112
 113     ok ! $hdr->{isMinimalHeader} ;
 114     ok   $hdr->{TextFlag} ;
 115     ok ! defined $hdr->{HeaderCRC} ;
 116     is $hdr->{OsID}, $ThisOS_code ;
 117
 118 }
 119
 120 {
 121     title "can have null extrafield" ;
 122
 123     my $before = time ;
 124     my $hdr = readHeaderInfo $name,
 125                                       -strict     => 0,
 126                               -Name       => "a",
 127                               -Comment    => "b",
 128                               -ExtraField => "\x00";
 129     my $after = time ;
 130
 131     ok $hdr->{Time} >= $before ;
 132     ok $hdr->{Time} <= $after ;
 133     ok $hdr->{Name} eq "a";
 134     ok $hdr->{Comment} eq "b";
 135     is $hdr->{ExtraFlags}, 0;
 136     ok $hdr->{ExtraFieldRaw} eq "\x00";
 137     ok ! $hdr->{isMinimalHeader} ;
 138     ok ! $hdr->{TextFlag} ;
 139     ok ! defined $hdr->{HeaderCRC} ;
 140     is $hdr->{OsID}, $ThisOS_code ;
 141
 142 }
 143
 144 {
 145     title "can have undef name, comment, time and extrafield" ;
 146
 147     my $hdr = readHeaderInfo $name,
 148                           -Name       => undef,
 149                           -Comment    => undef,
 150                           -ExtraField => undef,
 151                       -Time       => undef;
 152
 153     ok $hdr->{Time} == 0;
 154     ok ! defined $hdr->{Name} ;
 155     ok ! defined $hdr->{Comment} ;
 156     ok ! defined $hdr->{ExtraFieldRaw} ;
 157     ok ! $hdr->{isMinimalHeader} ;
 158     ok ! $hdr->{TextFlag} ;
 159     ok ! defined $hdr->{HeaderCRC} ;
 160     is $hdr->{OsID}, $ThisOS_code ;
 161
 162 }
 163
 164 for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D")
 165 {
 166     title "Comment with $value" ;
 167
 168     my $v = pack "H*", $value;
 169     my $comment = "my${v}comment$v";
 170     my $hdr = readHeaderInfo $name,
 171                     Time => 0,
 172                   -TextFlag   => 1,
 173                   -Name       => "",
 174                   -Comment    => $comment,
 175                   -ExtraField => "";
 176     my $after = time ;
 177
 178     is $hdr->{Time}, 0 ;
 179
 180     ok defined $hdr->{Name} ;
 181     ok $hdr->{Name} eq "";
 182     ok defined $hdr->{Comment} ;
 183     is $hdr->{Comment}, $comment;
 184     ok defined $hdr->{ExtraFieldRaw} ;
 185     ok $hdr->{ExtraFieldRaw} eq "";
 186     is $hdr->{ExtraFlags}, 0;
 187
 188     ok ! $hdr->{isMinimalHeader} ;
 189     ok   $hdr->{TextFlag} ;
 190     ok ! defined $hdr->{HeaderCRC} ;
 191     is $hdr->{OsID}, $ThisOS_code ;
 192
 193 }
 194
 195 {
 196     title "Check crchdr" ;
 197
 198     my $hdr = readHeaderInfo $name, -HeaderCRC  => 1;
 199
 200     ok ! defined $hdr->{Name};
 201     is $hdr->{ExtraFlags}, 0;
 202     ok ! defined $hdr->{ExtraFieldRaw} ;
 203     ok ! defined $hdr->{Comment} ;
 204     ok ! $hdr->{isMinimalHeader} ;
 205     ok ! $hdr->{TextFlag} ;
 206     ok   defined $hdr->{HeaderCRC} ;
 207     is $hdr->{OsID}, $ThisOS_code ;
 208 }
 209
 210 {
 211     title "Check ExtraFlags" ;
 212
 213     my $hdr = readHeaderInfo $name, -Level  => Z_BEST_SPEED;
 214
 215     ok ! defined $hdr->{Name};
 216     is $hdr->{ExtraFlags}, 2;
 217     ok ! defined $hdr->{ExtraFieldRaw} ;
 218     ok ! defined $hdr->{Comment} ;
 219     ok ! $hdr->{isMinimalHeader} ;
 220     ok ! $hdr->{TextFlag} ;
 221     ok ! defined $hdr->{HeaderCRC} ;
 222
 223     $hdr = readHeaderInfo $name, -Level  => Z_BEST_COMPRESSION;
 224
 225     ok ! defined $hdr->{Name};
 226     is $hdr->{ExtraFlags}, 4;
 227     ok ! defined $hdr->{ExtraFieldRaw} ;
 228     ok ! defined $hdr->{Comment} ;
 229     ok ! $hdr->{isMinimalHeader} ;
 230     ok ! $hdr->{TextFlag} ;
 231     ok ! defined $hdr->{HeaderCRC} ;
 232
 233     $hdr = readHeaderInfo $name, -Level  => Z_BEST_COMPRESSION,
 234                                  -ExtraFlags => 42;
 235
 236     ok ! defined $hdr->{Name};
 237     is $hdr->{ExtraFlags}, 42;
 238     ok ! defined $hdr->{ExtraFieldRaw} ;
 239     ok ! defined $hdr->{Comment} ;
 240     ok ! $hdr->{isMinimalHeader} ;
 241     ok ! $hdr->{TextFlag} ;
 242     ok ! defined $hdr->{HeaderCRC} ;
 243
 244
 245 }
 246
 247 {
 248     title "OS Code" ;
 249
 250     for my $code ( -1, undef, '', 'fred' )
 251     {
 252         my $code_name = defined $code ? "'$code'" : "'undef'";
 253         eval { new IO::Compress::Gzip $name, -OS_Code => $code } ;
 254         like $@, mkErr("^IO::Compress::Gzip: Parameter 'OS_Code' must be an unsigned int, got $code_name"),
 255             " Trap OS Code $code_name";
 256     }
 257
 258     for my $code ( qw( 256 ) )
 259     {
 260         eval { ok ! new IO::Compress::Gzip($name, OS_Code => $code) };
 261         like $@, mkErr("OS_Code must be between 0 and 255, got '$code'"),
 262             " Trap OS Code $code";
 263         like $GzipError, "/OS_Code must be between 0 and 255, got '$code'/",
 264             " Trap OS Code $code";
 265     }
 266
 267     for my $code ( qw(0 1 12 254 255) )
 268     {
 269         my $hdr = readHeaderInfo $name, OS_Code => $code;
 270
 271         is $hdr->{OsID}, $code, "  Code is $code" ;
 272     }
 273
 274
 275
 276 }
 277
 278 {
 279     title 'Check ExtraField';
 280
 281     my @tests = (
 282         [1, ['AB' => '']                   => [['AB'=>'']] ],
 283         [1, {'AB' => ''}                   => [['AB'=>'']] ],
 284         [1, ['AB' => 'Fred']               => [['AB'=>'Fred']] ],
 285         [1, {'AB' => 'Fred'}               => [['AB'=>'Fred']] ],
 286         [1, ['Xx' => '','AB' => 'Fred']    => [['Xx' => ''],['AB'=>'Fred']] ],
 287         [1, ['Xx' => '','Xx' => 'Fred']    => [['Xx' => ''],['Xx'=>'Fred']] ],
 288         [1, ['Xx' => '',
 289              'Xx' => 'Fred',
 290              'Xx' => 'Fred']               => [['Xx' => ''],['Xx'=>'Fred'],
 291                                                ['Xx'=>'Fred']] ],
 292         [1, [ ['Xx' => 'a'],
 293               ['AB' => 'Fred'] ]           => [['Xx' => 'a'],['AB'=>'Fred']] ],
 294         [0, {'AB' => 'Fred',
 295              'Pq' => 'r',
 296              "\x01\x02" => "\x03"}         => [['AB'=>'Fred'],
 297                                                ['Pq'=>'r'],
 298                                                ["\x01\x02"=>"\x03"]] ],
 299         [1, ['AB' => 'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE] =>
 300                             [['AB'=>'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE]] ],
 301                 );
 302
 303     foreach my $test (@tests) {
 304         my ($order, $input, $result) = @$test ;
 305         ok my $x = new IO::Compress::Gzip $name,
 306                                 -ExtraField  => $input,
 307                                 -HeaderCRC   => 1
 308             or diag "GzipError is $GzipError" ;                            ;
 309         my $string = "abcd" ;
 310         ok $x->write($string) ;
 311         ok $x->close ;
 312         #is GZreadFile($name), $string ;
 313
 314         ok $x = new IO::Uncompress::Gunzip $name,
 315                               #-Strict     => 1,
 316                                -ParseExtra => 1
 317             or diag "GunzipError is $GunzipError" ;                            ;
 318         my $hdr = $x->getHeaderInfo();
 319         ok $hdr;
 320         ok ! defined $hdr->{Name};
 321         ok ! defined $hdr->{Comment} ;
 322         ok ! $hdr->{isMinimalHeader} ;
 323         ok ! $hdr->{TextFlag} ;
 324         ok   defined $hdr->{HeaderCRC} ;
 325
 326         ok   defined $hdr->{ExtraFieldRaw} ;
 327         ok   defined $hdr->{ExtraField} ;
 328
 329         my $extra = $hdr->{ExtraField} ;
 330
 331         if ($order) {
 332             eq_array $extra, $result;
 333         } else {
 334             eq_set $extra, $result;
 335         }
 336     }
 337
 338 }
 339
 340 {
 341     title 'Write Invalid ExtraField';
 342
 343     my $prefix = 'Error with ExtraField Parameter: ';
 344     my @tests = (
 345             [ sub{ "abc" }        => "Not a scalar, array ref or hash ref"],
 346             [ [ "a" ]             => "Not even number of elements"],
 347             [ [ "a" => "fred" ]   => 'SubField ID not two chars long'],
 348             [ [ "a\x00" => "fred" ]   => 'SubField ID 2nd byte is 0x00'],
 349             [ [ [ {}, "abc" ]]    => "SubField ID is a reference"],
 350             [ [ [ "ab", \1 ]]     => "SubField Data is a reference"],
 351             [ [ {"a" => "fred"} ] => "Not list of lists"],
 352             [ [ ['ab'=>'x'],{"a" => "fred"} ] => "Not list of lists"],
 353             [ [ ["aa"] ]          => "SubField must have two parts"],
 354             [ [ ["aa", "b", "c"] ] => "SubField must have two parts"],
 355             [ [ ["ab" => 'x' x (GZIP_FEXTRA_SUBFIELD_MAX_SIZE + 1) ] ]
 356                                    => "SubField Data too long"],
 357
 358             [ { 'abc', 1 }        => "SubField ID not two chars long"],
 359             [ { \1 , "abc" }    => "SubField ID not two chars long"],
 360             [ { "ab", \1 }     => "SubField Data is a reference"],
 361         );
 362
 363
 364
 365     foreach my $test (@tests) {
 366         my ($input, $string) = @$test ;
 367         my $buffer ;
 368         my $x ;
 369         eval { $x = new IO::Compress::Gzip \$buffer, -ExtraField  => $input; };
 370         like $@, mkErr("$prefix$string");
 371         like $GzipError, "/$prefix$string/";
 372         ok ! $x ;
 373
 374     }
 375
 376 }
 377
 378 {
 379     # Corrupt ExtraField
 380
 381     my @tests = (
 382         ["Sub-field truncated",
 383             "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",
 384             "Header Error: Truncated in FEXTRA Body Section",
 385             ['a', undef, undef]              ],
 386         ["Length of field incorrect",
 387             "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",
 388             "Header Error: Truncated in FEXTRA Body Section",
 389             ["ab", 255, "abc"]               ],
 390         ["Length of 2nd field incorrect",
 391             "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",
 392             "Header Error: Truncated in FEXTRA Body Section",
 393             ["ab", 3, "abc"], ["de", 7, "x"] ],
 394         ["Length of 2nd field incorrect",
 395             "Error with ExtraField Parameter: SubField ID 2nd byte is 0x00",
 396             "Header Error: SubField ID 2nd byte is 0x00",
 397             ["a\x00", 3, "abc"], ["de", 7, "x"] ],
 398         );
 399
 400     foreach my $test (@tests)
 401     {
 402         my $name = shift @$test;
 403         my $gzip_error = shift @$test;
 404         my $gunzip_error = shift @$test;
 405
 406         title "Read Corrupt ExtraField - $name" ;
 407
 408         my $input = '';
 409
 410         for my $field (@$test)
 411         {
 412             my ($id, $len, $data) = @$field;
 413
 414             $input .= $id if defined $id ;
 415             $input .= pack("v", $len) if defined $len ;
 416             $input .= $data if defined $data;
 417         }
 418         #hexDump(\$input);
 419
 420         my $buffer ;
 421         my $x ;
 422         eval {$x = new IO::Compress::Gzip \$buffer, -ExtraField  => $input, Strict => 1; };
 423         like $@, mkErr("$gzip_error"), "  $name";
 424         like $GzipError, "/$gzip_error/", "  $name";
 425
 426         ok ! $x, "  IO::Compress::Gzip fails";
 427         like $GzipError, "/$gzip_error/", "  $name";
 428
 429         foreach my $check (0, 1)
 430         {
 431             ok $x = new IO::Compress::Gzip \$buffer,
 432                                            ExtraField => $input,
 433                                            Strict     => 0
 434                 or diag "GzipError is $GzipError" ;
 435             my $string = "abcd" ;
 436             $x->write($string) ;
 437             $x->close ;
 438             is anyUncompress(\$buffer), $string ;
 439
 440             $x = new IO::Uncompress::Gunzip \$buffer,
 441                                        Strict      => 0,
 442                                        Transparent => 0,
 443                                        ParseExtra  => $check;
 444             if ($check) {
 445                 ok ! $x ;
 446                 like $GunzipError, "/^$gunzip_error/";
 447             }
 448             else {
 449                 ok $x ;
 450             }
 451
 452         }
 453     }
 454 }
 455
 456
 457 {
 458     title 'Check Minimal';
 459
 460     ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;
 461     my $string = "abcd" ;
 462     ok $x->write($string) ;
 463     ok $x->close ;
 464     #is GZreadFile($name), $string ;
 465
 466     ok $x = new IO::Uncompress::Gunzip $name  ;
 467     my $hdr = $x->getHeaderInfo();
 468     ok $hdr;
 469     ok $hdr->{Time} == 0;
 470     is $hdr->{ExtraFlags}, 0;
 471     ok ! defined $hdr->{Name} ;
 472     ok ! defined $hdr->{ExtraFieldRaw} ;
 473     ok ! defined $hdr->{Comment} ;
 474     is $hdr->{OsName}, 'Unknown' ;
 475     is $hdr->{MethodName}, "Deflated";
 476     is $hdr->{Flags}, 0;
 477     ok $hdr->{isMinimalHeader} ;
 478     ok ! $hdr->{TextFlag} ;
 479     ok $x->close ;
 480 }
 481
 482 {
 483     # Check Minimal + no comressed data
 484     # This is the smallest possible gzip file (20 bytes)
 485
 486     ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;
 487     ok $x->close ;
 488     #ok GZreadFile($name) eq '' ;
 489
 490     ok $x = new IO::Uncompress::Gunzip $name, -Append => 1 ;
 491     my $data ;
 492     my $status  = 1;
 493
 494     $status = $x->read($data)
 495         while $status >  0;
 496     is $status, 0 ;
 497     is $data, '';
 498     ok ! $x->error() ;
 499     ok $x->eof() ;
 500
 501     my $hdr = $x->getHeaderInfo();
 502     ok $hdr;
 503
 504     ok defined $hdr->{ISIZE} ;
 505     is $hdr->{ISIZE}, 0;
 506
 507     ok defined $hdr->{CRC32} ;
 508     is $hdr->{CRC32}, 0;
 509
 510     is $hdr->{Time}, 0;
 511     ok ! defined $hdr->{Name} ;
 512     ok ! defined $hdr->{ExtraFieldRaw} ;
 513     ok ! defined $hdr->{Comment} ;
 514     is $hdr->{OsName}, 'Unknown' ;
 515     is $hdr->{MethodName}, "Deflated";
 516     is $hdr->{Flags}, 0;
 517     ok $hdr->{isMinimalHeader} ;
 518     ok ! $hdr->{TextFlag} ;
 519     ok $x->close ;
 520 }
 521
 522 {
 523     # Header Corruption Tests
 524
 525     my $string = <<EOM;
 526 some text
 527 EOM
 528
 529     my $good = '';
 530     ok my $x = new IO::Compress::Gzip \$good, -HeaderCRC => 1 ;
 531     ok $x->write($string) ;
 532     ok $x->close ;
 533
 534     {
 535         title "Header Corruption - Fingerprint wrong 1st byte" ;
 536         my $buffer = $good ;
 537         substr($buffer, 0, 1) = 'x' ;
 538
 539         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
 540         ok $GunzipError =~ /Header Error: Bad Magic/;
 541     }
 542
 543     {
 544         title "Header Corruption - Fingerprint wrong 2nd byte" ;
 545         my $buffer = $good ;
 546         substr($buffer, 1, 1) = "\xFF" ;
 547
 548         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
 549         ok $GunzipError =~ /Header Error: Bad Magic/;
 550         #print "$GunzipError\n";
 551     }
 552
 553     {
 554         title "Header Corruption - CM not 8";
 555         my $buffer = $good ;
 556         substr($buffer, 2, 1) = 'x' ;
 557
 558         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
 559         like $GunzipError, '/Header Error: Not Deflate \(CM is \d+\)/';
 560     }
 561
 562     {
 563         title "Header Corruption - Use of Reserved Flags";
 564         my $buffer = $good ;
 565         substr($buffer, 3, 1) = "\xff";
 566
 567         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
 568         like $GunzipError, '/Header Error: Use of Reserved Bits in FLG field./';
 569     }
 570
 571     {
 572         title "Header Corruption - Fail HeaderCRC";
 573         my $buffer = $good ;
 574         substr($buffer, 10, 1) = chr((ord(substr($buffer, 10, 1)) + 1) & 0xFF);
 575
 576         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0, Strict => 1
 577          or print "# $GunzipError\n";
 578         like $GunzipError, '/Header Error: CRC16 mismatch/'
 579             #or diag "buffer length " . length($buffer);
 580             or hexDump(\$good), hexDump(\$buffer);
 581     }
 582 }
 583
 584 {
 585     title "ExtraField max raw size";
 586     my $x ;
 587     my $store = "x" x GZIP_FEXTRA_MAX_SIZE ;
 588     my $z = new IO::Compress::Gzip(\$x, ExtraField => $store, Strict => 0) ;
 589     ok $z,  "Created IO::Compress::Gzip object" ;
 590     my $gunz = new IO::Uncompress::Gunzip \$x, Strict => 0;
 591     ok $gunz, "Created IO::Uncompress::Gunzip object" ;
 592     my $hdr = $gunz->getHeaderInfo();
 593     ok $hdr;
 594
 595     is $hdr->{ExtraFieldRaw}, $store ;
 596 }
 597
 598 {
 599     title "Header Corruption - ExtraField too big";
 600     my $x;
 601     eval { new IO::Compress::Gzip(\$x, -ExtraField => "x" x (GZIP_FEXTRA_MAX_SIZE + 1)) ;};
 602     like $@, mkErr('Error with ExtraField Parameter: Too Large');
 603     like $GzipError, '/Error with ExtraField Parameter: Too Large/';
 604 }
 605
 606 {
 607     title "Header Corruption - Create Name with Illegal Chars";
 608
 609     my $x;
 610     eval { new IO::Compress::Gzip \$x, -Name => "fred\x02" };
 611     like $@, mkErr('Non ISO 8859-1 Character found in Name');
 612     like $GzipError, '/Non ISO 8859-1 Character found in Name/';
 613
 614     ok  my $gz = new IO::Compress::Gzip \$x,
 615                                       -Strict => 0,
 616                                       -Name => "fred\x02" ;
 617     ok $gz->close();
 618
 619     ok ! new IO::Uncompress::Gunzip \$x,
 620                         -Transparent => 0,
 621                         -Strict => 1;
 622
 623     like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Name/';
 624     ok my $gunzip = new IO::Uncompress::Gunzip \$x,
 625                                    -Strict => 0;
 626
 627     my $hdr = $gunzip->getHeaderInfo() ;
 628
 629     is $hdr->{Name}, "fred\x02";
 630
 631 }
 632
 633 {
 634     title "Header Corruption - Null Chars in Name";
 635     my $x;
 636     eval { new IO::Compress::Gzip \$x, -Name => "\x00" };
 637     like $@, mkErr('Null Character found in Name');
 638     like $GzipError, '/Null Character found in Name/';
 639
 640     eval { new IO::Compress::Gzip \$x, -Name => "abc\x00" };
 641     like $@, mkErr('Null Character found in Name');
 642     like $GzipError, '/Null Character found in Name/';
 643
 644     ok my $gz = new IO::Compress::Gzip \$x,
 645                                      -Strict  => 0,
 646                                      -Name => "abc\x00de" ;
 647     ok $gz->close() ;
 648     ok my $gunzip = new IO::Uncompress::Gunzip \$x,
 649                                    -Strict => 0;
 650
 651     my $hdr = $gunzip->getHeaderInfo() ;
 652
 653     is $hdr->{Name}, "abc";
 654
 655 }
 656
 657 {
 658     title "Header Corruption - Create Comment with Illegal Chars";
 659
 660     my $x;
 661     eval { new IO::Compress::Gzip \$x, -Comment => "fred\x02" };
 662     like $@, mkErr('Non ISO 8859-1 Character found in Comment');
 663     like $GzipError, '/Non ISO 8859-1 Character found in Comment/';
 664
 665     ok  my $gz = new IO::Compress::Gzip \$x,
 666                                       -Strict => 0,
 667                                       -Comment => "fred\x02" ;
 668     ok $gz->close();
 669
 670     ok ! new IO::Uncompress::Gunzip \$x, Strict => 1,
 671                         -Transparent => 0;
 672
 673     like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Comment/';
 674     ok my $gunzip = new IO::Uncompress::Gunzip \$x, Strict => 0;
 675
 676     my $hdr = $gunzip->getHeaderInfo() ;
 677
 678     is $hdr->{Comment}, "fred\x02";
 679
 680 }
 681
 682 {
 683     title "Header Corruption - Null Char in Comment";
 684     my $x;
 685     eval { new IO::Compress::Gzip \$x, -Comment => "\x00" };
 686     like $@, mkErr('Null Character found in Comment');
 687     like $GzipError, '/Null Character found in Comment/';
 688
 689     eval { new IO::Compress::Gzip \$x, -Comment => "abc\x00" } ;
 690     like $@, mkErr('Null Character found in Comment');
 691     like $GzipError, '/Null Character found in Comment/';
 692
 693     ok my $gz = new IO::Compress::Gzip \$x,
 694                                      -Strict  => 0,
 695                                      -Comment => "abc\x00de" ;
 696     ok $gz->close() ;
 697     ok my $gunzip = new IO::Uncompress::Gunzip \$x,
 698                                    -Strict => 0;
 699
 700     my $hdr = $gunzip->getHeaderInfo() ;
 701
 702     is $hdr->{Comment}, "abc";
 703
 704 }
 705
 706
 707 for my $index ( GZIP_MIN_HEADER_SIZE + 1 ..  GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1)
 708 {
 709     title "Header Corruption - Truncated in Extra";
 710     my $string = <<EOM;
 711 some text
 712 EOM
 713
 714     my $truncated ;
 715     ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1, Strict => 0,
 716                                 -ExtraField => "hello" x 10  ;
 717     ok $x->write($string) ;
 718     ok $x->close ;
 719
 720     substr($truncated, $index) = '' ;
 721     #my $lex = new LexFile my $name ;
 722     #writeFile($name, $truncated) ;
 723
 724     #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
 725     my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
 726     ok ! $g
 727         or print "# $g\n" ;
 728
 729     like($GunzipError, '/^Header Error: Truncated in FEXTRA/');
 730
 731
 732 }
 733
 734 my $Name = "fred" ;
 735     my $truncated ;
 736 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Name) -1)
 737 {
 738     title "Header Corruption - Truncated in Name";
 739     my $string = <<EOM;
 740 some text
 741 EOM
 742
 743     my $truncated ;
 744     ok my $x = new IO::Compress::Gzip \$truncated, -Name => $Name;
 745     ok $x->write($string) ;
 746     ok $x->close ;
 747
 748     substr($truncated, $index) = '' ;
 749
 750     my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
 751     ok ! $g
 752         or print "# $g\n" ;
 753
 754     like $GunzipError, '/^Header Error: Truncated in FNAME Section/';
 755
 756 }
 757
 758 my $Comment = "comment" ;
 759 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Comment) -1)
 760 {
 761     title "Header Corruption - Truncated in Comment";
 762     my $string = <<EOM;
 763 some text
 764 EOM
 765
 766     my $truncated ;
 767     ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment;
 768     ok $x->write($string) ;
 769     ok $x->close ;
 770
 771     substr($truncated, $index) = '' ;
 772     #my $lex = new LexFile my $name ;
 773     #writeFile($name, $truncated) ;
 774
 775     #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
 776     my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
 777     ok ! $g
 778         or print "# $g\n" ;
 779
 780     like $GunzipError, '/^Header Error: Truncated in FCOMMENT Section/';
 781
 782 }
 783
 784 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
 785 {
 786     title "Header Corruption - Truncated in CRC";
 787     my $string = <<EOM;
 788 some text
 789 EOM
 790
 791     my $truncated ;
 792     ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1;
 793     ok $x->write($string) ;
 794     ok $x->close ;
 795
 796     substr($truncated, $index) = '' ;
 797     my $lex = new LexFile my $name ;
 798     writeFile($name, $truncated) ;
 799
 800     my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
 801     #my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
 802     ok ! $g
 803         or print "# $g\n" ;
 804
 805     like $GunzipError, '/^Header Error: Truncated in FHCRC Section/';
 806
 807 }
 808
 809
 810 {
 811     # Trailer Corruption tests
 812
 813     my $string = <<EOM;
 814 some text
 815 EOM
 816
 817     my $good ;
 818     {
 819         ok my $x = new IO::Compress::Gzip \$good ;
 820         ok $x->write($string) ;
 821         ok $x->close ;
 822     }
 823
 824     writeFile($name, $good) ;
 825     ok my $gunz = new IO::Uncompress::Gunzip $name,
 826                                        -Strict   => 1;
 827     my $uncomp ;
 828     1 while  $gunz->read($uncomp) > 0 ;
 829     ok $gunz->close() ;
 830     ok $uncomp eq $string
 831         or print "# got [$uncomp] wanted [$string]\n";;
 832
 833     foreach my $trim (-8 .. -1)
 834     {
 835         my $got = $trim + 8 ;
 836         title "Trailer Corruption - Trailer truncated to $got bytes" ;
 837         my $buffer = $good ;
 838         my $expected_trailing = substr($good, -8, 8) ;
 839         substr($expected_trailing, $trim) = '';
 840
 841         substr($buffer, $trim) = '';
 842         writeFile($name, $buffer) ;
 843
 844         foreach my $strict (0, 1)
 845         {
 846             ok my $gunz = new IO::Uncompress::Gunzip $name, -Strict   => $strict ;
 847             my $uncomp ;
 848             if ($strict)
 849             {
 850                 ok $gunz->read($uncomp) < 0 ;
 851                 like $GunzipError, "/Trailer Error: trailer truncated. Expected 8 bytes, got $got/";
 852             }
 853             else
 854             {
 855                 ok   $gunz->read($uncomp) > 0 ;
 856                 ok ! $GunzipError ;
 857                 my $expected = substr($buffer, - $got);
 858                 is  $gunz->trailingData(),  $expected_trailing;
 859             }
 860             ok $gunz->eof() ;
 861             ok $uncomp eq $string;
 862             ok $gunz->close ;
 863         }
 864
 865     }
 866
 867     {
 868         title "Trailer Corruption - Length Wrong, CRC Correct" ;
 869         my $buffer = $good ;
 870         my $actual_len = unpack("V", substr($buffer, -4, 4));
 871         substr($buffer, -4, 4) = pack('V', $actual_len + 1);
 872         writeFile($name, $buffer) ;
 873
 874         foreach my $strict (0, 1)
 875         {
 876             ok my $gunz = new IO::Uncompress::Gunzip $name,
 877                                                -Strict   => $strict ;
 878             my $uncomp ;
 879             if ($strict)
 880             {
 881                 ok $gunz->read($uncomp) < 0 ;
 882                 my $got_len = $actual_len + 1;
 883                 like $GunzipError, "/Trailer Error: ISIZE mismatch. Got $got_len, expected $actual_len/";
 884             }
 885             else
 886             {
 887                 ok   $gunz->read($uncomp) > 0 ;
 888                 ok ! $GunzipError ;
 889                 #is   $gunz->trailingData(), substr($buffer, - $got) ;
 890             }
 891             ok ! $gunz->trailingData() ;
 892             ok $gunz->eof() ;
 893             ok $uncomp eq $string;
 894             ok $gunz->close ;
 895         }
 896
 897     }
 898
 899     {
 900         title "Trailer Corruption - Length Correct, CRC Wrong" ;
 901         my $buffer = $good ;
 902         my $actual_crc = unpack("V", substr($buffer, -8, 4));
 903         substr($buffer, -8, 4) = pack('V', $actual_crc+1);
 904         writeFile($name, $buffer) ;
 905
 906         foreach my $strict (0, 1)
 907         {
 908             ok my $gunz = new IO::Uncompress::Gunzip $name,
 909                                                -Strict   => $strict ;
 910             my $uncomp ;
 911             if ($strict)
 912             {
 913                 ok $gunz->read($uncomp) < 0 ;
 914                 like $GunzipError, '/Trailer Error: CRC mismatch/';
 915             }
 916             else
 917             {
 918                 ok   $gunz->read($uncomp) > 0 ;
 919                 ok ! $GunzipError ;
 920             }
 921             ok ! $gunz->trailingData() ;
 922             ok $gunz->eof() ;
 923             ok $uncomp eq $string;
 924             ok $gunz->close ;
 925         }
 926
 927     }
 928
 929     {
 930         title "Trailer Corruption - Length Wrong, CRC Wrong" ;
 931         my $buffer = $good ;
 932         my $actual_len = unpack("V", substr($buffer, -4, 4));
 933         my $actual_crc = unpack("V", substr($buffer, -8, 4));
 934         substr($buffer, -4, 4) = pack('V', $actual_len+1);
 935         substr($buffer, -8, 4) = pack('V', $actual_crc+1);
 936         writeFile($name, $buffer) ;
 937
 938         foreach my $strict (0, 1)
 939         {
 940             ok my $gunz = new IO::Uncompress::Gunzip $name,
 941                                                -Strict   => $strict ;
 942             my $uncomp ;
 943             if ($strict)
 944             {
 945                 ok $gunz->read($uncomp) < 0 ;
 946                 like $GunzipError, '/Trailer Error: CRC mismatch/';
 947             }
 948             else
 949             {
 950                 ok   $gunz->read($uncomp) > 0 ;
 951                 ok ! $GunzipError ;
 952             }
 953             ok $gunz->eof() ;
 954             ok $uncomp eq $string;
 955             ok $gunz->close ;
 956         }
 957
 958     }
 959 }
 960
 961
 962