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