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

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = ("../lib", "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 => 920 + $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 $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         ok ! new IO::Compress::Gzip($name, OS_Code => $code) ;
 261         like $GzipError, "/^OS_Code must be between 0 and 255, got '$code'/",
 262             " Trap OS Code $code";
 263     }
 264
 265     for my $code ( qw(0 1 12 254 255) )
 266     {
 267         my $hdr = readHeaderInfo $name, OS_Code => $code;
 268
 269         is $hdr->{OsID}, $code, "  Code is $code" ;
 270     }
 271
 272
 273
 274 }
 275
 276 {
 277     title 'Check ExtraField';
 278
 279     my @tests = (
 280         [1, ['AB' => '']                   => [['AB'=>'']] ],
 281         [1, {'AB' => ''}                   => [['AB'=>'']] ],
 282         [1, ['AB' => 'Fred']               => [['AB'=>'Fred']] ],
 283         [1, {'AB' => 'Fred'}               => [['AB'=>'Fred']] ],
 284         [1, ['Xx' => '','AB' => 'Fred']    => [['Xx' => ''],['AB'=>'Fred']] ],
 285         [1, ['Xx' => '','Xx' => 'Fred']    => [['Xx' => ''],['Xx'=>'Fred']] ],
 286         [1, ['Xx' => '',
 287              'Xx' => 'Fred',
 288              'Xx' => 'Fred']               => [['Xx' => ''],['Xx'=>'Fred'],
 289                                                ['Xx'=>'Fred']] ],
 290         [1, [ ['Xx' => 'a'],
 291               ['AB' => 'Fred'] ]           => [['Xx' => 'a'],['AB'=>'Fred']] ],
 292         [0, {'AB' => 'Fred',
 293              'Pq' => 'r',
 294              "\x01\x02" => "\x03"}         => [['AB'=>'Fred'],
 295                                                ['Pq'=>'r'],
 296                                                ["\x01\x02"=>"\x03"]] ],
 297         [1, ['AB' => 'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE] =>
 298                             [['AB'=>'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE]] ],
 299                 );
 300
 301     foreach my $test (@tests) {
 302         my ($order, $input, $result) = @$test ;
 303         ok my $x = new IO::Compress::Gzip $name,
 304                                 -ExtraField  => $input,
 305                                 -HeaderCRC   => 1
 306             or diag "GzipError is $GzipError" ;                            ;
 307         my $string = "abcd" ;
 308         ok $x->write($string) ;
 309         ok $x->close ;
 310         is GZreadFile($name), $string ;
 311
 312         ok $x = new IO::Uncompress::Gunzip $name,
 313                               #-Strict     => 1,
 314                                -ParseExtra => 1
 315             or diag "GunzipError is $GunzipError" ;                            ;
 316         my $hdr = $x->getHeaderInfo();
 317         ok $hdr;
 318         ok ! defined $hdr->{Name};
 319         ok ! defined $hdr->{Comment} ;
 320         ok ! $hdr->{isMinimalHeader} ;
 321         ok ! $hdr->{TextFlag} ;
 322         ok   defined $hdr->{HeaderCRC} ;
 323
 324         ok   defined $hdr->{ExtraFieldRaw} ;
 325         ok   defined $hdr->{ExtraField} ;
 326
 327         my $extra = $hdr->{ExtraField} ;
 328
 329         if ($order) {
 330             eq_array $extra, $result
 331         } else {
 332             eq_set $extra, $result;
 333         }
 334     }
 335
 336 }
 337
 338 {
 339     title 'Write Invalid ExtraField';
 340
 341     my $prefix = 'Error with ExtraField Parameter: ';
 342     my @tests = (
 343             [ sub{ "abc" }        => "Not a scalar, array ref or hash ref"],
 344             [ [ "a" ]             => "Not even number of elements"],
 345             [ [ "a" => "fred" ]   => 'SubField ID not two chars long'],
 346             [ [ "a\x00" => "fred" ]   => 'SubField ID 2nd byte is 0x00'],
 347             [ [ [ {}, "abc" ]]    => "SubField ID is a reference"],
 348             [ [ [ "ab", \1 ]]     => "SubField Data is a reference"],
 349             [ [ {"a" => "fred"} ] => "Not list of lists"],
 350             [ [ ['ab'=>'x'],{"a" => "fred"} ] => "Not list of lists"],
 351             [ [ ["aa"] ]          => "SubField must have two parts"],
 352             [ [ ["aa", "b", "c"] ] => "SubField must have two parts"],
 353             [ [ ["ab" => 'x' x (GZIP_FEXTRA_SUBFIELD_MAX_SIZE + 1) ] ]
 354                                    => "SubField Data too long"],
 355
 356             [ { 'abc', 1 }        => "SubField ID not two chars long"],
 357             [ { \1 , "abc" }    => "SubField ID not two chars long"],
 358             [ { "ab", \1 }     => "SubField Data is a reference"],
 359         );
 360
 361
 362
 363     foreach my $test (@tests) {
 364         my ($input, $string) = @$test ;
 365         my $buffer ;
 366         my $x = new IO::Compress::Gzip \$buffer, -ExtraField  => $input;
 367         ok ! $x ;
 368         like $GzipError, "/^$prefix$string/";
 369
 370     }
 371
 372 }
 373
 374 {
 375     # Corrupt ExtraField
 376
 377     my @tests = (
 378         ["Sub-field truncated",
 379             "Error with ExtraField Parameter: FEXTRA Body",
 380             "Header Error: Truncated in FEXTRA Body Section",
 381             ['a', undef, undef]              ],
 382         ["Length of field incorrect",
 383             "Error with ExtraField Parameter: FEXTRA Body",
 384             "Header Error: Truncated in FEXTRA Body Section",
 385             ["ab", 255, "abc"]               ],
 386         ["Length of 2nd field incorrect",
 387             "Error with ExtraField Parameter: FEXTRA Body",
 388             "Header Error: Truncated in FEXTRA Body Section",
 389             ["ab", 3, "abc"], ["de", 7, "x"] ],
 390         ["Length of 2nd field incorrect",
 391             "Error with ExtraField Parameter: SubField ID 2nd byte is 0x00",
 392             "Header Error: Truncated in FEXTRA Body Section",
 393             ["a\x00", 3, "abc"], ["de", 7, "x"] ],
 394         );
 395
 396     foreach my $test (@tests)
 397     {
 398         my $name = shift @$test;
 399         my $gzip_error = shift @$test;
 400         my $gunzip_error = shift @$test;
 401
 402         title "Read Corrupt ExtraField - $name" ;
 403
 404         my $input = '';
 405
 406         for my $field (@$test)
 407         {
 408             my ($id, $len, $data) = @$field;
 409
 410             $input .= $id if defined $id ;
 411             $input .= pack("v", $len) if defined $len ;
 412             $input .= $data if defined $data;
 413         }
 414         #hexDump(\$input);
 415
 416         my $buffer ;
 417         my $x = new IO::Compress::Gzip \$buffer, -ExtraField  => $input, Strict => 1;
 418
 419         ok ! $x, "  IO::Compress::Gzip fails";
 420         like $GzipError, "/^$gzip_error/", "  $name";
 421
 422         foreach my $check (0, 1)
 423         {
 424             ok $x = new IO::Compress::Gzip \$buffer, -ExtraField  => $input, Strict => 0
 425                 or diag "GzipError is $GzipError" ;                            ;
 426             my $string = "abcd" ;
 427             $x->write($string) ;
 428             $x->close ;
 429             is anyUncompress(\$buffer), $string ;
 430
 431             $x = new IO::Uncompress::Gunzip \$buffer, Strict => 0,
 432                                        ParseExtra => $check;
 433             if ($check) {
 434                 ok ! $x ;
 435                 like $GunzipError, "/^$gunzip_error/";
 436             }
 437             else {
 438                 ok $x ;
 439             }
 440
 441         }
 442     }
 443 }
 444
 445
 446 {
 447     title 'Check Minimal';
 448
 449     ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;
 450     my $string = "abcd" ;
 451     ok $x->write($string) ;
 452     ok $x->close ;
 453     is GZreadFile($name), $string ;
 454
 455     ok $x = new IO::Uncompress::Gunzip $name  ;
 456     my $hdr = $x->getHeaderInfo();
 457     ok $hdr;
 458     ok $hdr->{Time} == 0;
 459     is $hdr->{ExtraFlags}, 0;
 460     ok ! defined $hdr->{Name} ;
 461     ok ! defined $hdr->{ExtraFieldRaw} ;
 462     ok ! defined $hdr->{Comment} ;
 463     is $hdr->{OsName}, 'Unknown' ;
 464     is $hdr->{MethodName}, "Deflated";
 465     is $hdr->{Flags}, 0;
 466     ok $hdr->{isMinimalHeader} ;
 467     ok ! $hdr->{TextFlag} ;
 468     ok $x->close ;
 469 }
 470
 471 {
 472     # Check Minimal + no comressed data
 473     # This is the smallest possible gzip file (20 bytes)
 474
 475     ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;
 476     ok $x->close ;
 477     ok GZreadFile($name) eq '' ;
 478
 479     ok $x = new IO::Uncompress::Gunzip $name, -Append => 1 ;
 480     my $data ;
 481     my $status  = 1;
 482
 483     $status = $x->read($data)
 484         while $status >  0;
 485     is $status, 0 ;
 486     is $data, '';
 487     ok ! $x->error() ;
 488     ok $x->eof() ;
 489
 490     my $hdr = $x->getHeaderInfo();
 491     ok $hdr;
 492
 493     ok defined $hdr->{ISIZE} ;
 494     is $hdr->{ISIZE}, 0;
 495
 496     ok defined $hdr->{CRC32} ;
 497     is $hdr->{CRC32}, 0;
 498
 499     is $hdr->{Time}, 0;
 500     ok ! defined $hdr->{Name} ;
 501     ok ! defined $hdr->{ExtraFieldRaw} ;
 502     ok ! defined $hdr->{Comment} ;
 503     is $hdr->{OsName}, 'Unknown' ;
 504     is $hdr->{MethodName}, "Deflated";
 505     is $hdr->{Flags}, 0;
 506     ok $hdr->{isMinimalHeader} ;
 507     ok ! $hdr->{TextFlag} ;
 508     ok $x->close ;
 509 }
 510
 511 {
 512     # Header Corruption Tests
 513
 514     my $string = <<EOM;
 515 some text
 516 EOM
 517
 518     my $good = '';
 519     ok my $x = new IO::Compress::Gzip \$good, -HeaderCRC => 1 ;
 520     ok $x->write($string) ;
 521     ok $x->close ;
 522
 523     {
 524         title "Header Corruption - Fingerprint wrong 1st byte" ;
 525         my $buffer = $good ;
 526         substr($buffer, 0, 1) = 'x' ;
 527
 528         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
 529         ok $GunzipError =~ /Header Error: Bad Magic/;
 530     }
 531
 532     {
 533         title "Header Corruption - Fingerprint wrong 2nd byte" ;
 534         my $buffer = $good ;
 535         substr($buffer, 1, 1) = "\xFF" ;
 536
 537         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
 538         ok $GunzipError =~ /Header Error: Bad Magic/;
 539         #print "$GunzipError\n";
 540     }
 541
 542     {
 543         title "Header Corruption - CM not 8";
 544         my $buffer = $good ;
 545         substr($buffer, 2, 1) = 'x' ;
 546
 547         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
 548         like $GunzipError, '/Header Error: Not Deflate \(CM is \d+\)/';
 549     }
 550
 551     {
 552         title "Header Corruption - Use of Reserved Flags";
 553         my $buffer = $good ;
 554         substr($buffer, 3, 1) = "\xff";
 555
 556         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0  ;
 557         like $GunzipError, '/Header Error: Use of Reserved Bits in FLG field./';
 558     }
 559
 560     {
 561         title "Header Corruption - Fail HeaderCRC";
 562         my $buffer = $good ;
 563         substr($buffer, 10, 1) = chr((ord(substr($buffer, 10, 1)) + 1) & 0xFF);
 564
 565         ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0, Strict => 1
 566          or print "# $GunzipError\n";
 567         like $GunzipError, '/Header Error: CRC16 mismatch/'
 568             #or diag "buffer length " . length($buffer);
 569             or hexDump(\$good), hexDump(\$buffer);
 570     }
 571 }
 572
 573 {
 574     title "ExtraField max raw size";
 575     my $x ;
 576     my $store = "x" x GZIP_FEXTRA_MAX_SIZE ;
 577     my $z = new IO::Compress::Gzip(\$x, ExtraField => $store, Strict => 0) ;
 578     ok $z,  "Created IO::Compress::Gzip object" ;
 579     my $gunz = new IO::Uncompress::Gunzip \$x, Strict => 0;
 580     ok $gunz, "Created IO::Uncompress::Gunzip object" ;
 581     my $hdr = $gunz->getHeaderInfo();
 582     ok $hdr;
 583
 584     is $hdr->{ExtraFieldRaw}, $store ;
 585 }
 586
 587 {
 588     title "Header Corruption - ExtraField too big";
 589     my $x;
 590     ok ! new IO::Compress::Gzip(\$x,
 591                         -ExtraField => "x" x (GZIP_FEXTRA_MAX_SIZE + 1)) ;
 592     like $GzipError, '/Error with ExtraField Parameter: Too Large/';
 593 }
 594
 595 {
 596     title "Header Corruption - Create Name with Illegal Chars";
 597
 598     my $x;
 599     ok ! new IO::Compress::Gzip \$x,
 600                       -Name => "fred\x02" ;
 601     like $GzipError, '/Non ISO 8859-1 Character found in Name/';
 602
 603     ok  my $gz = new IO::Compress::Gzip \$x,
 604                                       -Strict => 0,
 605                                       -Name => "fred\x02" ;
 606     ok $gz->close();
 607
 608     ok ! new IO::Uncompress::Gunzip \$x,
 609                         -Strict => 1;
 610
 611     like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Name/';
 612     ok my $gunzip = new IO::Uncompress::Gunzip \$x,
 613                                    -Strict => 0;
 614
 615     my $hdr = $gunzip->getHeaderInfo() ;
 616
 617     is $hdr->{Name}, "fred\x02";
 618
 619 }
 620
 621 {
 622     title "Header Corruption - Null Chars in Name";
 623     my $x;
 624     ok ! new IO::Compress::Gzip \$x,
 625                       -Name => "\x00" ;
 626     like $GzipError, '/Null Character found in Name/';
 627
 628     ok ! new IO::Compress::Gzip \$x,
 629                       -Name => "abc\x00" ;
 630     like $GzipError, '/Null Character found in Name/';
 631
 632     ok my $gz = new IO::Compress::Gzip \$x,
 633                                      -Strict  => 0,
 634                                      -Name => "abc\x00de" ;
 635     ok $gz->close() ;
 636     ok my $gunzip = new IO::Uncompress::Gunzip \$x,
 637                                    -Strict => 0;
 638
 639     my $hdr = $gunzip->getHeaderInfo() ;
 640
 641     is $hdr->{Name}, "abc";
 642
 643 }
 644
 645 {
 646     title "Header Corruption - Create Comment with Illegal Chars";
 647
 648     my $x;
 649     ok ! new IO::Compress::Gzip \$x,
 650                       -Comment => "fred\x02" ;
 651     like $GzipError, '/Non ISO 8859-1 Character found in Comment/';
 652
 653     ok  my $gz = new IO::Compress::Gzip \$x,
 654                                       -Strict => 0,
 655                                       -Comment => "fred\x02" ;
 656     ok $gz->close();
 657
 658     ok ! new IO::Uncompress::Gunzip \$x, Strict => 1;
 659
 660     like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Comment/';
 661     ok my $gunzip = new IO::Uncompress::Gunzip \$x, Strict => 0;
 662
 663     my $hdr = $gunzip->getHeaderInfo() ;
 664
 665     is $hdr->{Comment}, "fred\x02";
 666
 667 }
 668
 669 {
 670     title "Header Corruption - Null Char in Comment";
 671     my $x;
 672     ok ! new IO::Compress::Gzip \$x,
 673                       -Comment => "\x00" ;
 674     like $GzipError, '/Null Character found in Comment/';
 675
 676     ok ! new IO::Compress::Gzip \$x,
 677                       -Comment => "abc\x00" ;
 678     like $GzipError, '/Null Character found in Comment/';
 679
 680     ok my $gz = new IO::Compress::Gzip \$x,
 681                                      -Strict  => 0,
 682                                      -Comment => "abc\x00de" ;
 683     ok $gz->close() ;
 684     ok my $gunzip = new IO::Uncompress::Gunzip \$x,
 685                                    -Strict => 0;
 686
 687     my $hdr = $gunzip->getHeaderInfo() ;
 688
 689     is $hdr->{Comment}, "abc";
 690
 691 }
 692
 693
 694 for my $index ( GZIP_MIN_HEADER_SIZE + 1 ..  GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1)
 695 {
 696     title "Header Corruption - Truncated in Extra";
 697     my $string = <<EOM;
 698 some text
 699 EOM
 700
 701     my $truncated ;
 702     ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1, Strict => 0,
 703                                 -ExtraField => "hello" x 10  ;
 704     ok $x->write($string) ;
 705     ok $x->close ;
 706
 707     substr($truncated, $index) = '' ;
 708     #my $lex = new LexFile my $name ;
 709     #writeFile($name, $truncated) ;
 710
 711     #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
 712     my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
 713     ok ! $g
 714         or print "# $g\n" ;
 715
 716     like($GunzipError, '/^Header Error: Truncated in FEXTRA/');
 717
 718
 719 }
 720
 721 my $Name = "fred" ;
 722     my $truncated ;
 723 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Name) -1)
 724 {
 725     title "Header Corruption - Truncated in Name";
 726     my $string = <<EOM;
 727 some text
 728 EOM
 729
 730     my $truncated ;
 731     ok my $x = new IO::Compress::Gzip \$truncated, -Name => $Name;
 732     ok $x->write($string) ;
 733     ok $x->close ;
 734
 735     substr($truncated, $index) = '' ;
 736
 737     my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
 738     ok ! $g
 739         or print "# $g\n" ;
 740
 741     like $GunzipError, '/^Header Error: Truncated in FNAME Section/';
 742
 743 }
 744
 745 my $Comment = "comment" ;
 746 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Comment) -1)
 747 {
 748     title "Header Corruption - Truncated in Comment";
 749     my $string = <<EOM;
 750 some text
 751 EOM
 752
 753     my $truncated ;
 754     ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment;
 755     ok $x->write($string) ;
 756     ok $x->close ;
 757
 758     substr($truncated, $index) = '' ;
 759     #my $lex = new LexFile my $name ;
 760     #writeFile($name, $truncated) ;
 761
 762     #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
 763     my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
 764     ok ! $g
 765         or print "# $g\n" ;
 766
 767     like $GunzipError, '/^Header Error: Truncated in FCOMMENT Section/';
 768
 769 }
 770
 771 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
 772 {
 773     title "Header Corruption - Truncated in CRC";
 774     my $string = <<EOM;
 775 some text
 776 EOM
 777
 778     my $truncated ;
 779     ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1;
 780     ok $x->write($string) ;
 781     ok $x->close ;
 782
 783     substr($truncated, $index) = '' ;
 784     my $lex = new LexFile my $name ;
 785     writeFile($name, $truncated) ;
 786
 787     my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
 788     #my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
 789     ok ! $g
 790         or print "# $g\n" ;
 791
 792     like $GunzipError, '/^Header Error: Truncated in FHCRC Section/';
 793
 794 }
 795
 796
 797 {
 798     # Trailer Corruption tests
 799
 800     my $string = <<EOM;
 801 some text
 802 EOM
 803
 804     my $good ;
 805     {
 806         ok my $x = new IO::Compress::Gzip \$good ;
 807         ok $x->write($string) ;
 808         ok $x->close ;
 809     }
 810
 811     writeFile($name, $good) ;
 812     ok my $gunz = new IO::Uncompress::Gunzip $name,
 813                                        -Strict   => 1;
 814     my $uncomp ;
 815     1 while  $gunz->read($uncomp) > 0 ;
 816     ok $gunz->close() ;
 817     ok $uncomp eq $string
 818         or print "# got [$uncomp] wanted [$string]\n";;
 819
 820     foreach my $trim (-8 .. -1)
 821     {
 822         my $got = $trim + 8 ;
 823         title "Trailer Corruption - Trailer truncated to $got bytes" ;
 824         my $buffer = $good ;
 825         my $expected_trailing = substr($good, -8, 8) ;
 826         substr($expected_trailing, $trim) = '';
 827
 828         substr($buffer, $trim) = '';
 829         writeFile($name, $buffer) ;
 830
 831         foreach my $strict (0, 1)
 832         {
 833             ok my $gunz = new IO::Uncompress::Gunzip $name, -Strict   => $strict ;
 834             my $uncomp ;
 835             if ($strict)
 836             {
 837                 ok $gunz->read($uncomp) < 0 ;
 838                 like $GunzipError, "/Trailer Error: trailer truncated. Expected 8 bytes, got $got/";
 839             }
 840             else
 841             {
 842                 ok   $gunz->read($uncomp) > 0 ;
 843                 ok ! $GunzipError ;
 844                 my $expected = substr($buffer, - $got);
 845                 is  ${ $gunz->trailingData() },  $expected_trailing;
 846             }
 847             ok $gunz->eof() ;
 848             ok $uncomp eq $string;
 849             ok $gunz->close ;
 850         }
 851
 852     }
 853
 854     {
 855         title "Trailer Corruption - Length Wrong, CRC Correct" ;
 856         my $buffer = $good ;
 857         my $actual_len = unpack("V", substr($buffer, -4, 4));
 858         substr($buffer, -4, 4) = pack('V', $actual_len + 1);
 859         writeFile($name, $buffer) ;
 860
 861         foreach my $strict (0, 1)
 862         {
 863             ok my $gunz = new IO::Uncompress::Gunzip $name,
 864                                                -Strict   => $strict ;
 865             my $uncomp ;
 866             if ($strict)
 867             {
 868                 ok $gunz->read($uncomp) < 0 ;
 869                 my $got_len = $actual_len + 1;
 870                 like $GunzipError, "/Trailer Error: ISIZE mismatch. Got $got_len, expected $actual_len/";
 871             }
 872             else
 873             {
 874                 ok   $gunz->read($uncomp) > 0 ;
 875                 ok ! $GunzipError ;
 876                 #is   $gunz->trailingData(), substr($buffer, - $got) ;
 877             }
 878             ok ! ${ $gunz->trailingData() } ;
 879             ok $gunz->eof() ;
 880             ok $uncomp eq $string;
 881             ok $gunz->close ;
 882         }
 883
 884     }
 885
 886     {
 887         title "Trailer Corruption - Length Correct, CRC Wrong" ;
 888         my $buffer = $good ;
 889         my $actual_crc = unpack("V", substr($buffer, -8, 4));
 890         substr($buffer, -8, 4) = pack('V', $actual_crc+1);
 891         writeFile($name, $buffer) ;
 892
 893         foreach my $strict (0, 1)
 894         {
 895             ok my $gunz = new IO::Uncompress::Gunzip $name,
 896                                                -Strict   => $strict ;
 897             my $uncomp ;
 898             if ($strict)
 899             {
 900                 ok $gunz->read($uncomp) < 0 ;
 901                 like $GunzipError, '/Trailer Error: CRC mismatch/';
 902             }
 903             else
 904             {
 905                 ok   $gunz->read($uncomp) > 0 ;
 906                 ok ! $GunzipError ;
 907             }
 908             ok ! ${ $gunz->trailingData() } ;
 909             ok $gunz->eof() ;
 910             ok $uncomp eq $string;
 911             ok $gunz->close ;
 912         }
 913
 914     }
 915
 916     {
 917         title "Trailer Corruption - Length Wrong, CRC Wrong" ;
 918         my $buffer = $good ;
 919         my $actual_len = unpack("V", substr($buffer, -4, 4));
 920         my $actual_crc = unpack("V", substr($buffer, -8, 4));
 921         substr($buffer, -4, 4) = pack('V', $actual_len+1);
 922         substr($buffer, -8, 4) = pack('V', $actual_crc+1);
 923         writeFile($name, $buffer) ;
 924
 925         foreach my $strict (0, 1)
 926         {
 927             ok my $gunz = new IO::Uncompress::Gunzip $name,
 928                                                -Strict   => $strict ;
 929             my $uncomp ;
 930             if ($strict)
 931             {
 932                 ok $gunz->read($uncomp) < 0 ;
 933                 like $GunzipError, '/Trailer Error: CRC mismatch/';
 934             }
 935             else
 936             {
 937                 ok   $gunz->read($uncomp) > 0 ;
 938                 ok ! $GunzipError ;
 939             }
 940             ok $gunz->eof() ;
 941             ok $uncomp eq $string;
 942             ok $gunz->close ;
 943         }
 944
 945     }
 946 }
 947
 948
 949