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

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