ext/Compress/Zlib/t/09gziphdr.t

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