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