xref: /openbsd-src/gnu/usr.bin/perl/cpan/IO-Compress/t/004gziphdr.t (revision 5486feefcc8cb79b19e014ab332cc5dfd05b3b33) 
1BEGIN {
2    if ($ENV{PERL_CORE}) {
3	chdir 't' if -d 't';
4	@INC = ("../lib", "lib/compress");
5    }
6}
7
8use lib qw(t t/compress);
9use strict;
10use warnings;
11use bytes;
12
13use Test::More ;
14use CompTestUtils;
15
16BEGIN {
17    # use Test::NoWarnings, if available
18    my $extra = 0 ;
19    $extra = 1
20        if eval { require Test::NoWarnings ;  Test::NoWarnings->import; 1 };
21
22
23    plan tests => 918 + $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
38my $ThisOS_code = $Compress::Raw::Zlib::gzip_os_code;
39
40my $lex = LexFile->new( 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
164for 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}, 4;
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}, 2;
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 { IO::Compress::Gzip->new( $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 ! IO::Compress::Gzip->new($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 = IO::Compress::Gzip->new( $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 = IO::Uncompress::Gunzip->new( $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 = IO::Compress::Gzip->new( \$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 = IO::Compress::Gzip->new( \$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 = IO::Compress::Gzip->new( \$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 = IO::Uncompress::Gunzip->new( \$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 = IO::Compress::Gzip->new( $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 = IO::Uncompress::Gunzip->new( $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    title "Check Minimal + no compressed data";
483    # This is the smallest possible gzip file (20 bytes)
484
485    ok my $x = IO::Compress::Gzip->new( $name, -Minimal => 1 );
486    isa_ok $x, "IO::Compress::Gzip";
487    ok $x->close, "closed" ;
488
489    ok $x = IO::Uncompress::Gunzip->new( $name, -Append => 0 );
490    isa_ok $x, "IO::Uncompress::Gunzip";
491    my $data ;
492    my $status  = 1;
493
494    ok $x->eof(), "eof" ;
495    $status = $x->read($data)
496        while $status >  0;
497    is $status, 0, "status == 0" ;
498    is $data, '', "empty string";
499    ok ! $x->error(), "no error" ;
500    ok $x->eof(), "eof" ;
501
502    my $hdr = $x->getHeaderInfo();
503    ok $hdr;
504
505    ok defined $hdr->{ISIZE} ;
506    is $hdr->{ISIZE}, 0;
507
508    ok defined $hdr->{CRC32} ;
509    is $hdr->{CRC32}, 0;
510
511    is $hdr->{Time}, 0;
512    ok ! defined $hdr->{Name} ;
513    ok ! defined $hdr->{ExtraFieldRaw} ;
514    ok ! defined $hdr->{Comment} ;
515    is $hdr->{OsName}, 'Unknown' ;
516    is $hdr->{MethodName}, "Deflated";
517    is $hdr->{Flags}, 0;
518    ok $hdr->{isMinimalHeader} ;
519    ok ! $hdr->{TextFlag} ;
520    ok $x->close ;
521}
522
523{
524    title "Header Corruption Tests";
525
526    my $string = <<EOM;
527some text
528EOM
529
530    my $good = '';
531    ok my $x = IO::Compress::Gzip->new( \$good, -HeaderCRC => 1 );
532    ok $x->write($string) ;
533    ok $x->close ;
534
535    {
536        title "Header Corruption - Fingerprint wrong 1st byte" ;
537        my $buffer = $good ;
538        substr($buffer, 0, 1) = 'x' ;
539
540        ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0 );
541        ok $GunzipError =~ /Header Error: Bad Magic/;
542    }
543
544    {
545        title "Header Corruption - Fingerprint wrong 2nd byte" ;
546        my $buffer = $good ;
547        substr($buffer, 1, 1) = "\xFF" ;
548
549        ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0 );
550        ok $GunzipError =~ /Header Error: Bad Magic/;
551        #print "$GunzipError\n";
552    }
553
554    {
555        title "Header Corruption - CM not 8";
556        my $buffer = $good ;
557        substr($buffer, 2, 1) = 'x' ;
558
559        ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0 );
560        like $GunzipError, '/Header Error: Not Deflate \(CM is \d+\)/';
561    }
562
563    {
564        title "Header Corruption - Use of Reserved Flags";
565        my $buffer = $good ;
566        substr($buffer, 3, 1) = "\xff";
567
568        ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0 );
569        like $GunzipError, '/Header Error: Use of Reserved Bits in FLG field./';
570    }
571
572    {
573        title "Header Corruption - Fail HeaderCRC";
574        my $buffer = $good ;
575        substr($buffer, 10, 1) = chr((ord(substr($buffer, 10, 1)) + 1) & 0xFF);
576
577        ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0, Strict => 1 )
578         or print "# $GunzipError\n";
579        like $GunzipError, '/Header Error: CRC16 mismatch/'
580            #or diag "buffer length " . length($buffer);
581            or hexDump(\$good), hexDump(\$buffer);
582    }
583}
584
585{
586    title "ExtraField max raw size";
587    my $x ;
588    my $store = "x" x GZIP_FEXTRA_MAX_SIZE ;
589    {
590        my $z = IO::Compress::Gzip->new(\$x, ExtraField => $store, Strict => 0) ;
591        ok $z,  "Created IO::Compress::Gzip object" ;
592    }
593    my $gunz = IO::Uncompress::Gunzip->new( \$x, Strict => 0 );
594    ok $gunz, "Created IO::Uncompress::Gunzip object" ;
595    my $hdr = $gunz->getHeaderInfo();
596    ok $hdr;
597
598    is $hdr->{ExtraFieldRaw}, $store ;
599}
600
601{
602    title "Header Corruption - ExtraField too big";
603    my $x;
604    eval { IO::Compress::Gzip->new(\$x, -ExtraField => "x" x (GZIP_FEXTRA_MAX_SIZE + 1)) ;};
605    like $@, mkErr('Error with ExtraField Parameter: Too Large');
606    like $GzipError, '/Error with ExtraField Parameter: Too Large/';
607}
608
609{
610    title "Header Corruption - Create Name with Illegal Chars";
611
612    my $x;
613    eval { IO::Compress::Gzip->new( \$x, -Name => "fred\x02" ) };
614    like $@, mkErr('Non ISO 8859-1 Character found in Name');
615    like $GzipError, '/Non ISO 8859-1 Character found in Name/';
616
617    ok  my $gz = IO::Compress::Gzip->new( \$x,
618		                      -Strict => 0,
619		                      -Name => "fred\x02" );
620    ok $gz->close();
621
622    ok ! IO::Uncompress::Gunzip->new( \$x,
623                        -Transparent => 0,
624                        -Strict => 1 );
625
626    like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Name/';
627    ok my $gunzip = IO::Uncompress::Gunzip->new( \$x,
628                                   -Strict => 0 );
629
630    my $hdr = $gunzip->getHeaderInfo() ;
631
632    is $hdr->{Name}, "fred\x02";
633
634}
635
636{
637    title "Header Corruption - Null Chars in Name";
638    my $x;
639    eval { IO::Compress::Gzip->new( \$x, -Name => "\x00" ) };
640    like $@, mkErr('Null Character found in Name');
641    like $GzipError, '/Null Character found in Name/';
642
643    eval { IO::Compress::Gzip->new( \$x, -Name => "abc\x00" ) };
644    like $@, mkErr('Null Character found in Name');
645    like $GzipError, '/Null Character found in Name/';
646
647    ok my $gz = IO::Compress::Gzip->new( \$x,
648		                     -Strict  => 0,
649		                     -Name => "abc\x00de" );
650    ok $gz->close() ;
651    ok my $gunzip = IO::Uncompress::Gunzip->new( \$x,
652                                   -Strict => 0 );
653
654    my $hdr = $gunzip->getHeaderInfo() ;
655
656    is $hdr->{Name}, "abc";
657
658}
659
660{
661    title "Header Corruption - Create Comment with Illegal Chars";
662
663    my $x;
664    eval { IO::Compress::Gzip->new( \$x, -Comment => "fred\x02" ) };
665    like $@, mkErr('Non ISO 8859-1 Character found in Comment');
666    like $GzipError, '/Non ISO 8859-1 Character found in Comment/';
667
668    ok  my $gz = IO::Compress::Gzip->new( \$x,
669		                      -Strict => 0,
670		                      -Comment => "fred\x02" );
671    ok $gz->close();
672
673    ok ! IO::Uncompress::Gunzip->new( \$x, Strict => 1,
674                        -Transparent => 0 );
675
676    like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Comment/';
677    ok my $gunzip = IO::Uncompress::Gunzip->new( \$x, Strict => 0 );
678
679    my $hdr = $gunzip->getHeaderInfo() ;
680
681    is $hdr->{Comment}, "fred\x02";
682
683}
684
685{
686    title "Header Corruption - Null Char in Comment";
687    my $x;
688    eval { IO::Compress::Gzip->new( \$x, -Comment => "\x00" ) };
689    like $@, mkErr('Null Character found in Comment');
690    like $GzipError, '/Null Character found in Comment/';
691
692    eval { IO::Compress::Gzip->new( \$x, -Comment => "abc\x00" ) } ;
693    like $@, mkErr('Null Character found in Comment');
694    like $GzipError, '/Null Character found in Comment/';
695
696    ok my $gz = IO::Compress::Gzip->new( \$x,
697		                     -Strict  => 0,
698		                     -Comment => "abc\x00de" );
699    ok $gz->close() ;
700    ok my $gunzip = IO::Uncompress::Gunzip->new( \$x,
701                                   -Strict => 0 );
702
703    my $hdr = $gunzip->getHeaderInfo() ;
704
705    is $hdr->{Comment}, "abc";
706
707}
708
709
710for my $index ( GZIP_MIN_HEADER_SIZE + 1 ..  GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1)
711{
712    title "Header Corruption - Truncated in Extra";
713    my $string = <<EOM;
714some text
715EOM
716
717    my $truncated ;
718    ok my $x = IO::Compress::Gzip->new( \$truncated, -HeaderCRC => 1, Strict => 0,
719				-ExtraField => "hello" x 10 );
720    ok $x->write($string) ;
721    ok $x->close ;
722
723    substr($truncated, $index) = '' ;
724    #my $lex = LexFile->new( my $name );
725    #writeFile($name, $truncated) ;
726
727    #my $g = IO::Uncompress::Gunzip->new( $name, -Transparent => 0 );
728    my $g = IO::Uncompress::Gunzip->new( \$truncated, -Transparent => 0 );
729    ok ! $g
730	or print "# $g\n" ;
731
732    like($GunzipError, '/^Header Error: Truncated in FEXTRA/');
733
734
735}
736
737my $Name = "fred" ;
738    my $truncated ;
739for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Name) -1)
740{
741    title "Header Corruption - Truncated in Name";
742    my $string = <<EOM;
743some text
744EOM
745
746    my $truncated ;
747    ok my $x = IO::Compress::Gzip->new( \$truncated, -Name => $Name );
748    ok $x->write($string) ;
749    ok $x->close ;
750
751    substr($truncated, $index) = '' ;
752
753    my $g = IO::Uncompress::Gunzip->new( \$truncated, -Transparent => 0 );
754    ok ! $g
755	or print "# $g\n" ;
756
757    like $GunzipError, '/^Header Error: Truncated in FNAME Section/';
758
759}
760
761my $Comment = "comment" ;
762for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Comment) -1)
763{
764    title "Header Corruption - Truncated in Comment";
765    my $string = <<EOM;
766some text
767EOM
768
769    my $truncated ;
770    ok my $x = IO::Compress::Gzip->new( \$truncated, -Comment => $Comment );
771    ok $x->write($string) ;
772    ok $x->close ;
773
774    substr($truncated, $index) = '' ;
775    #my $lex = LexFile->new( my $name );
776    #writeFile($name, $truncated) ;
777
778    #my $g = IO::Uncompress::Gunzip->new( $name, -Transparent => 0 );
779    my $g = IO::Uncompress::Gunzip->new( \$truncated, -Transparent => 0 );
780    ok ! $g
781	or print "# $g\n" ;
782
783    like $GunzipError, '/^Header Error: Truncated in FCOMMENT Section/';
784
785}
786
787for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
788{
789    title "Header Corruption - Truncated in CRC";
790    my $string = <<EOM;
791some text
792EOM
793
794    my $truncated ;
795    ok my $x = IO::Compress::Gzip->new( \$truncated, -HeaderCRC => 1 );
796    ok $x->write($string) ;
797    ok $x->close ;
798
799    substr($truncated, $index) = '' ;
800    my $lex = LexFile->new( my $name );
801    writeFile($name, $truncated) ;
802
803    my $g = IO::Uncompress::Gunzip->new( $name, -Transparent => 0 );
804    ok ! $g
805	or print "# $g\n" ;
806
807    like $GunzipError, '/^Header Error: Truncated in FHCRC Section/';
808
809}
810
811
812{
813    # Trailer Corruption tests
814
815    my $string = <<EOM;
816some text
817EOM
818    $string = $string x 1000;
819
820    my $good ;
821    {
822        ok my $x = IO::Compress::Gzip->new( \$good );
823        ok $x->write($string) ;
824        ok $x->close ;
825    }
826
827    writeFile($name, $good) ;
828    ok my $gunz = IO::Uncompress::Gunzip->new( $name,
829                                       -Append   => 1,
830                                       -Strict   => 1 );
831    my $uncomp ;
832    1 while  $gunz->read($uncomp) > 0 ;
833    ok $gunz->close() ;
834    ok $uncomp eq $string
835	or print "# got [$uncomp] wanted [$string]\n";;
836
837    foreach my $trim (-8 .. -1)
838    {
839        my $got = $trim + 8 ;
840        title "Trailer Corruption - Trailer truncated to $got bytes" ;
841        my $buffer = $good ;
842        my $expected_trailing = substr($good, -8, 8) ;
843        substr($expected_trailing, $trim) = '';
844
845        substr($buffer, $trim) = '';
846        writeFile($name, $buffer) ;
847
848        foreach my $strict (0, 1)
849        {
850            ok my $gunz = IO::Uncompress::Gunzip->new( $name, Append => 1, -Strict   => $strict );
851            my $uncomp ;
852            my $status = 1;
853            $status = $gunz->read($uncomp) while $status > 0;
854            if ($strict)
855            {
856                cmp_ok $status, '<', 0, "status 0" ;
857                like $GunzipError, "/Trailer Error: trailer truncated. Expected 8 bytes, got $got/", "got Trailer Error";
858            }
859            else
860            {
861                is $status, 0, "status 0";
862                ok ! $GunzipError, "no error"
863                    or diag "$GunzipError";
864                my $expected = substr($buffer, - $got);
865                is  $gunz->trailingData(),  $expected_trailing, "trailing data";
866            }
867            ok $gunz->eof() ;
868            ok $uncomp eq $string;
869            ok $gunz->close ;
870        }
871
872    }
873
874    {
875        title "Trailer Corruption - Length Wrong, CRC Correct" ;
876        my $buffer = $good ;
877        my $actual_len = unpack("V", substr($buffer, -4, 4));
878        substr($buffer, -4, 4) = pack('V', $actual_len + 1);
879        writeFile($name, $buffer) ;
880
881        foreach my $strict (0, 1)
882        {
883            ok my $gunz = IO::Uncompress::Gunzip->new( $name,
884                                               Append   => 1,
885                                               -Strict   => $strict );
886            my $uncomp ;
887            my $status = 1;
888            $status = $gunz->read($uncomp) while $status > 0;
889            if ($strict)
890            {
891                cmp_ok $status, '<', 0 ;
892                my $got_len = $actual_len + 1;
893                like $GunzipError, "/Trailer Error: ISIZE mismatch. Got $got_len, expected $actual_len/";
894            }
895            else
896            {
897                is $status, 0;
898                ok ! $GunzipError ;
899                #is   $gunz->trailingData(), substr($buffer, - $got) ;
900            }
901            ok ! $gunz->trailingData() ;
902            ok $gunz->eof() ;
903            ok $uncomp eq $string;
904            ok $gunz->close ;
905        }
906
907    }
908
909    {
910        title "Trailer Corruption - Length Correct, CRC Wrong" ;
911        my $buffer = $good ;
912        my $actual_crc = unpack("V", substr($buffer, -8, 4));
913        substr($buffer, -8, 4) = pack('V', $actual_crc+1);
914        writeFile($name, $buffer) ;
915
916        foreach my $strict (0, 1)
917        {
918            ok my $gunz = IO::Uncompress::Gunzip->new( $name,
919                                               -Append   => 1,
920                                               -Strict   => $strict );
921            my $uncomp ;
922            my $status = 1;
923            $status = $gunz->read($uncomp) while $status > 0;
924            if ($strict)
925            {
926                cmp_ok $status, '<', 0 ;
927                like $GunzipError, '/Trailer Error: CRC mismatch/';
928            }
929            else
930            {
931                is $status, 0;
932                ok ! $GunzipError ;
933            }
934            ok ! $gunz->trailingData() ;
935            ok $gunz->eof() ;
936            ok $uncomp eq $string;
937            ok $gunz->close ;
938        }
939
940    }
941
942    {
943        title "Trailer Corruption - Length Wrong, CRC Wrong" ;
944        my $buffer = $good ;
945        my $actual_len = unpack("V", substr($buffer, -4, 4));
946        my $actual_crc = unpack("V", substr($buffer, -8, 4));
947        substr($buffer, -4, 4) = pack('V', $actual_len+1);
948        substr($buffer, -8, 4) = pack('V', $actual_crc+1);
949        writeFile($name, $buffer) ;
950
951        foreach my $strict (0, 1)
952        {
953            ok my $gunz = IO::Uncompress::Gunzip->new( $name,
954                                               -Append   => 1,
955                                               -Strict   => $strict );
956            my $uncomp ;
957            my $status = 1;
958            $status = $gunz->read($uncomp) while $status > 0;
959            if ($strict)
960            {
961                cmp_ok $status, '<', 0 ;
962                like $GunzipError, '/Trailer Error: CRC mismatch/';
963            }
964            else
965            {
966                is $status, 0;
967                ok ! $GunzipError ;
968            }
969            ok $gunz->eof() ;
970            ok $uncomp eq $string;
971            ok $gunz->close ;
972        }
973
974    }
975
976    {
977        # RT #72329
978        my $error = 'Error with ExtraField Parameter: ' .
979                    'SubField ID not two chars long' ;
980        my $buffer ;
981        my $x ;
982        eval { $x = IO::Compress::Gzip->new( \$buffer,
983                -ExtraField  => [ at => 'mouse', bad => 'dog'] );
984             };
985        like $@, mkErr("$error");
986        like $GzipError, "/$error/";
987        ok ! $x ;
988    }
989}
990
991
992
993