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: FEXTRA Body",
 384             "Header Error: Truncated in FEXTRA Body Section",
 385             ['a', undef, undef]              ],
 386         ["Length of field incorrect",
 387             "Error with ExtraField Parameter: FEXTRA Body",
 388             "Header Error: Truncated in FEXTRA Body Section",
 389             ["ab", 255, "abc"]               ],
 390         ["Length of 2nd field incorrect",
 391             "Error with ExtraField Parameter: FEXTRA Body",
 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: Truncated in FEXTRA Body Section",
 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, -ExtraField  => $input, Strict => 0
 432                 or diag "GzipError is $GzipError" ;                            ;
 433             my $string = "abcd" ;
 434             $x->write($string) ;
 435             $x->close ;
 436             is anyUncompress(\$buffer), $string ;
 437
 438             $x = new IO::Uncompress::Gunzip \$buffer, Strict => 0,
 439                                        Transparent => 0,
 440                                        ParseExtra => $check;
 441             if ($check) {
 442                 ok ! $x ;
 443                 like $GunzipError, "/^$gunzip_error/";
 444             }
 445             else {
 446                 ok $x ;
 447             }
 448
 449         }
 450     }
 451 }
 452
 453
 454 {
 455     title 'Check Minimal';
 456
 457     ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;
 458     my $string = "abcd" ;
 459     ok $x->write($string) ;
 460     ok $x->close ;
 461     #is GZreadFile($name), $string ;
 462
 463     ok $x = new IO::Uncompress::Gunzip $name  ;
 464     my $hdr = $x->getHeaderInfo();
 465     ok $hdr;
 466     ok $hdr->{Time} == 0;
 467     is $hdr->{ExtraFlags}, 0;
 468     ok ! defined $hdr->{Name} ;
 469     ok ! defined $hdr->{ExtraFieldRaw} ;
 470     ok ! defined $hdr->{Comment} ;
 471     is $hdr->{OsName}, 'Unknown' ;
 472     is $hdr->{MethodName}, "Deflated";
 473     is $hdr->{Flags}, 0;
 474     ok $hdr->{isMinimalHeader} ;
 475     ok ! $hdr->{TextFlag} ;
 476     ok $x->close ;
 477 }
 478
 479 {
 480     # Check Minimal + no comressed data
 481     # This is the smallest possible gzip file (20 bytes)
 482
 483     ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;
 484     ok $x->close ;
 485     #ok GZreadFile($name) eq '' ;
 486
 487     ok $x = new IO::Uncompress::Gunzip $name, -Append => 1 ;
 488     my $data ;
 489     my $status  = 1;
 490
 491     $status = $x->read($data)
 492         while $status >  0;
 493     is $status, 0 ;
 494     is $data, '';
 495     ok ! $x->error() ;
 496     ok $x->eof() ;
 497
 498     my $hdr = $x->getHeaderInfo();
 499     ok $hdr;
 500
 501     ok defined $hdr->{ISIZE} ;
 502     is $hdr->{ISIZE}, 0;
 503
 504     ok defined $hdr->{CRC32} ;
 505     is $hdr->{CRC32}, 0;
 506
 507     is $hdr->{Time}, 0;
 508     ok ! defined $hdr->{Name} ;
 509     ok ! defined $hdr->{ExtraFieldRaw} ;
 510     ok ! defined $hdr->{Comment} ;
 511     is $hdr->{OsName}, 'Unknown' ;
 512     is $hdr->{MethodName}, "Deflated";
 513     is $hdr->{Flags}, 0;
 514     ok $hdr->{isMinimalHeader} ;
 515     ok ! $hdr->{TextFlag} ;
 516     ok $x->close ;
 517 }
 518
 519 {
 520     # Header Corruption Tests
 521
 522     my $string = <<EOM;
 523 some text
 524 EOM
 525
 526     my $good = '';
 527     ok my $x = new IO::Compress::Gzip \$good, -HeaderCRC => 1 ;
 528     ok $x->write($string) ;
 529     ok $x->close ;
 530
 531     {
 532         title "Header Corruption - Fingerprint wrong 1st byte" ;
 533         my $buffer = $good ;
 534         substr($buffer, 0, 1) = 'x' ;
 535
 536         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
 537         ok $GunzipError =~ /Header Error: Bad Magic/;
 538     }
 539
 540     {
 541         title "Header Corruption - Fingerprint wrong 2nd byte" ;
 542         my $buffer = $good ;
 543         substr($buffer, 1, 1) = "\xFF" ;
 544
 545         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
 546         ok $GunzipError =~ /Header Error: Bad Magic/;
 547         #print "$GunzipError\n";
 548     }
 549
 550     {
 551         title "Header Corruption - CM not 8";
 552         my $buffer = $good ;
 553         substr($buffer, 2, 1) = 'x' ;
 554
 555         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
 556         like $GunzipError, '/Header Error: Not Deflate \(CM is \d+\)/';
 557     }
 558
 559     {
 560         title "Header Corruption - Use of Reserved Flags";
 561         my $buffer = $good ;
 562         substr($buffer, 3, 1) = "\xff";
 563
 564         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
 565         like $GunzipError, '/Header Error: Use of Reserved Bits in FLG field./';
 566     }
 567
 568     {
 569         title "Header Corruption - Fail HeaderCRC";
 570         my $buffer = $good ;
 571         substr($buffer, 10, 1) = chr((ord(substr($buffer, 10, 1)) + 1) & 0xFF);
 572
 573         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0, Strict => 1
 574          or print "# $GunzipError\n";
 575         like $GunzipError, '/Header Error: CRC16 mismatch/'
 576             #or diag "buffer length " . length($buffer);
 577             or hexDump(\$good), hexDump(\$buffer);
 578     }
 579 }
 580
 581 {
 582     title "ExtraField max raw size";
 583     my $x ;
 584     my $store = "x" x GZIP_FEXTRA_MAX_SIZE ;
 585     my $z = new IO::Compress::Gzip(\$x, ExtraField => $store, Strict => 0) ;
 586     ok $z,  "Created IO::Compress::Gzip object" ;
 587     my $gunz = new IO::Uncompress::Gunzip \$x, Strict => 0;
 588     ok $gunz, "Created IO::Uncompress::Gunzip object" ;
 589     my $hdr = $gunz->getHeaderInfo();
 590     ok $hdr;
 591
 592     is $hdr->{ExtraFieldRaw}, $store ;
 593 }
 594
 595 {
 596     title "Header Corruption - ExtraField too big";
 597     my $x;
 598     eval { new IO::Compress::Gzip(\$x, -ExtraField => "x" x (GZIP_FEXTRA_MAX_SIZE + 1)) ;};
 599     like $@, mkErr('Error with ExtraField Parameter: Too Large');
 600     like $GzipError, '/Error with ExtraField Parameter: Too Large/';
 601 }
 602
 603 {
 604     title "Header Corruption - Create Name with Illegal Chars";
 605
 606     my $x;
 607     eval { new IO::Compress::Gzip \$x, -Name => "fred\x02" };
 608     like $@, mkErr('Non ISO 8859-1 Character found in Name');
 609     like $GzipError, '/Non ISO 8859-1 Character found in Name/';
 610
 611     ok  my $gz = new IO::Compress::Gzip \$x,
 612                                       -Strict => 0,
 613                                       -Name => "fred\x02" ;
 614     ok $gz->close();
 615
 616     ok ! new IO::Uncompress::Gunzip \$x,
 617                         -Transparent => 0,
 618                         -Strict => 1;
 619
 620     like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Name/';
 621     ok my $gunzip = new IO::Uncompress::Gunzip \$x,
 622                                    -Strict => 0;
 623
 624     my $hdr = $gunzip->getHeaderInfo() ;
 625
 626     is $hdr->{Name}, "fred\x02";
 627
 628 }
 629
 630 {
 631     title "Header Corruption - Null Chars in Name";
 632     my $x;
 633     eval { new IO::Compress::Gzip \$x, -Name => "\x00" };
 634     like $@, mkErr('Null Character found in Name');
 635     like $GzipError, '/Null Character found in Name/';
 636
 637     eval { new IO::Compress::Gzip \$x, -Name => "abc\x00" };
 638     like $@, mkErr('Null Character found in Name');
 639     like $GzipError, '/Null Character found in Name/';
 640
 641     ok my $gz = new IO::Compress::Gzip \$x,
 642                                      -Strict  => 0,
 643                                      -Name => "abc\x00de" ;
 644     ok $gz->close() ;
 645     ok my $gunzip = new IO::Uncompress::Gunzip \$x,
 646                                    -Strict => 0;
 647
 648     my $hdr = $gunzip->getHeaderInfo() ;
 649
 650     is $hdr->{Name}, "abc";
 651
 652 }
 653
 654 {
 655     title "Header Corruption - Create Comment with Illegal Chars";
 656
 657     my $x;
 658     eval { new IO::Compress::Gzip \$x, -Comment => "fred\x02" };
 659     like $@, mkErr('Non ISO 8859-1 Character found in Comment');
 660     like $GzipError, '/Non ISO 8859-1 Character found in Comment/';
 661
 662     ok  my $gz = new IO::Compress::Gzip \$x,
 663                                       -Strict => 0,
 664                                       -Comment => "fred\x02" ;
 665     ok $gz->close();
 666
 667     ok ! new IO::Uncompress::Gunzip \$x, Strict => 1,
 668                         -Transparent => 0;
 669
 670     like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Comment/';
 671     ok my $gunzip = new IO::Uncompress::Gunzip \$x, Strict => 0;
 672
 673     my $hdr = $gunzip->getHeaderInfo() ;
 674
 675     is $hdr->{Comment}, "fred\x02";
 676
 677 }
 678
 679 {
 680     title "Header Corruption - Null Char in Comment";
 681     my $x;
 682     eval { new IO::Compress::Gzip \$x, -Comment => "\x00" };
 683     like $@, mkErr('Null Character found in Comment');
 684     like $GzipError, '/Null Character found in Comment/';
 685
 686     eval { new IO::Compress::Gzip \$x, -Comment => "abc\x00" } ;
 687     like $@, mkErr('Null Character found in Comment');
 688     like $GzipError, '/Null Character found in Comment/';
 689
 690     ok my $gz = new IO::Compress::Gzip \$x,
 691                                      -Strict  => 0,
 692                                      -Comment => "abc\x00de" ;
 693     ok $gz->close() ;
 694     ok my $gunzip = new IO::Uncompress::Gunzip \$x,
 695                                    -Strict => 0;
 696
 697     my $hdr = $gunzip->getHeaderInfo() ;
 698
 699     is $hdr->{Comment}, "abc";
 700
 701 }
 702
 703
 704 for my $index ( GZIP_MIN_HEADER_SIZE + 1 ..  GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1)
 705 {
 706     title "Header Corruption - Truncated in Extra";
 707     my $string = <<EOM;
 708 some text
 709 EOM
 710
 711     my $truncated ;
 712     ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1, Strict => 0,
 713                                 -ExtraField => "hello" x 10  ;
 714     ok $x->write($string) ;
 715     ok $x->close ;
 716
 717     substr($truncated, $index) = '' ;
 718     #my $lex = new LexFile my $name ;
 719     #writeFile($name, $truncated) ;
 720
 721     #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
 722     my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
 723     ok ! $g
 724         or print "# $g\n" ;
 725
 726     like($GunzipError, '/^Header Error: Truncated in FEXTRA/');
 727
 728
 729 }
 730
 731 my $Name = "fred" ;
 732     my $truncated ;
 733 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Name) -1)
 734 {
 735     title "Header Corruption - Truncated in Name";
 736     my $string = <<EOM;
 737 some text
 738 EOM
 739
 740     my $truncated ;
 741     ok my $x = new IO::Compress::Gzip \$truncated, -Name => $Name;
 742     ok $x->write($string) ;
 743     ok $x->close ;
 744
 745     substr($truncated, $index) = '' ;
 746
 747     my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
 748     ok ! $g
 749         or print "# $g\n" ;
 750
 751     like $GunzipError, '/^Header Error: Truncated in FNAME Section/';
 752
 753 }
 754
 755 my $Comment = "comment" ;
 756 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Comment) -1)
 757 {
 758     title "Header Corruption - Truncated in Comment";
 759     my $string = <<EOM;
 760 some text
 761 EOM
 762
 763     my $truncated ;
 764     ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment;
 765     ok $x->write($string) ;
 766     ok $x->close ;
 767
 768     substr($truncated, $index) = '' ;
 769     #my $lex = new LexFile my $name ;
 770     #writeFile($name, $truncated) ;
 771
 772     #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
 773     my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
 774     ok ! $g
 775         or print "# $g\n" ;
 776
 777     like $GunzipError, '/^Header Error: Truncated in FCOMMENT Section/';
 778
 779 }
 780
 781 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
 782 {
 783     title "Header Corruption - Truncated in CRC";
 784     my $string = <<EOM;
 785 some text
 786 EOM
 787
 788     my $truncated ;
 789     ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1;
 790     ok $x->write($string) ;
 791     ok $x->close ;
 792
 793     substr($truncated, $index) = '' ;
 794     my $lex = new LexFile my $name ;
 795     writeFile($name, $truncated) ;
 796
 797     my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
 798     #my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
 799     ok ! $g
 800         or print "# $g\n" ;
 801
 802     like $GunzipError, '/^Header Error: Truncated in FHCRC Section/';
 803
 804 }
 805
 806
 807 {
 808     # Trailer Corruption tests
 809
 810     my $string = <<EOM;
 811 some text
 812 EOM
 813
 814     my $good ;
 815     {
 816         ok my $x = new IO::Compress::Gzip \$good ;
 817         ok $x->write($string) ;
 818         ok $x->close ;
 819     }
 820
 821     writeFile($name, $good) ;
 822     ok my $gunz = new IO::Uncompress::Gunzip $name,
 823                                        -Strict   => 1;
 824     my $uncomp ;
 825     1 while  $gunz->read($uncomp) > 0 ;
 826     ok $gunz->close() ;
 827     ok $uncomp eq $string
 828         or print "# got [$uncomp] wanted [$string]\n";;
 829
 830     foreach my $trim (-8 .. -1)
 831     {
 832         my $got = $trim + 8 ;
 833         title "Trailer Corruption - Trailer truncated to $got bytes" ;
 834         my $buffer = $good ;
 835         my $expected_trailing = substr($good, -8, 8) ;
 836         substr($expected_trailing, $trim) = '';
 837
 838         substr($buffer, $trim) = '';
 839         writeFile($name, $buffer) ;
 840
 841         foreach my $strict (0, 1)
 842         {
 843             ok my $gunz = new IO::Uncompress::Gunzip $name, -Strict   => $strict ;
 844             my $uncomp ;
 845             if ($strict)
 846             {
 847                 ok $gunz->read($uncomp) < 0 ;
 848                 like $GunzipError, "/Trailer Error: trailer truncated. Expected 8 bytes, got $got/";
 849             }
 850             else
 851             {
 852                 ok   $gunz->read($uncomp) > 0 ;
 853                 ok ! $GunzipError ;
 854                 my $expected = substr($buffer, - $got);
 855                 is  $gunz->trailingData(),  $expected_trailing;
 856             }
 857             ok $gunz->eof() ;
 858             ok $uncomp eq $string;
 859             ok $gunz->close ;
 860         }
 861
 862     }
 863
 864     {
 865         title "Trailer Corruption - Length Wrong, CRC Correct" ;
 866         my $buffer = $good ;
 867         my $actual_len = unpack("V", substr($buffer, -4, 4));
 868         substr($buffer, -4, 4) = pack('V', $actual_len + 1);
 869         writeFile($name, $buffer) ;
 870
 871         foreach my $strict (0, 1)
 872         {
 873             ok my $gunz = new IO::Uncompress::Gunzip $name,
 874                                                -Strict   => $strict ;
 875             my $uncomp ;
 876             if ($strict)
 877             {
 878                 ok $gunz->read($uncomp) < 0 ;
 879                 my $got_len = $actual_len + 1;
 880                 like $GunzipError, "/Trailer Error: ISIZE mismatch. Got $got_len, expected $actual_len/";
 881             }
 882             else
 883             {
 884                 ok   $gunz->read($uncomp) > 0 ;
 885                 ok ! $GunzipError ;
 886                 #is   $gunz->trailingData(), substr($buffer, - $got) ;
 887             }
 888             ok ! $gunz->trailingData() ;
 889             ok $gunz->eof() ;
 890             ok $uncomp eq $string;
 891             ok $gunz->close ;
 892         }
 893
 894     }
 895
 896     {
 897         title "Trailer Corruption - Length Correct, CRC Wrong" ;
 898         my $buffer = $good ;
 899         my $actual_crc = unpack("V", substr($buffer, -8, 4));
 900         substr($buffer, -8, 4) = pack('V', $actual_crc+1);
 901         writeFile($name, $buffer) ;
 902
 903         foreach my $strict (0, 1)
 904         {
 905             ok my $gunz = new IO::Uncompress::Gunzip $name,
 906                                                -Strict   => $strict ;
 907             my $uncomp ;
 908             if ($strict)
 909             {
 910                 ok $gunz->read($uncomp) < 0 ;
 911                 like $GunzipError, '/Trailer Error: CRC mismatch/';
 912             }
 913             else
 914             {
 915                 ok   $gunz->read($uncomp) > 0 ;
 916                 ok ! $GunzipError ;
 917             }
 918             ok ! $gunz->trailingData() ;
 919             ok $gunz->eof() ;
 920             ok $uncomp eq $string;
 921             ok $gunz->close ;
 922         }
 923
 924     }
 925
 926     {
 927         title "Trailer Corruption - Length Wrong, CRC Wrong" ;
 928         my $buffer = $good ;
 929         my $actual_len = unpack("V", substr($buffer, -4, 4));
 930         my $actual_crc = unpack("V", substr($buffer, -8, 4));
 931         substr($buffer, -4, 4) = pack('V', $actual_len+1);
 932         substr($buffer, -8, 4) = pack('V', $actual_crc+1);
 933         writeFile($name, $buffer) ;
 934
 935         foreach my $strict (0, 1)
 936         {
 937             ok my $gunz = new IO::Uncompress::Gunzip $name,
 938                                                -Strict   => $strict ;
 939             my $uncomp ;
 940             if ($strict)
 941             {
 942                 ok $gunz->read($uncomp) < 0 ;
 943                 like $GunzipError, '/Trailer Error: CRC mismatch/';
 944             }
 945             else
 946             {
 947                 ok   $gunz->read($uncomp) > 0 ;
 948                 ok ! $GunzipError ;
 949             }
 950             ok $gunz->eof() ;
 951             ok $uncomp eq $string;
 952             ok $gunz->close ;
 953         }
 954
 955     }
 956 }
 957
 958
 959