xref: /openbsd-src/gnu/usr.bin/perl/cpan/IO-Compress/t/004gziphdr.t (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c) 
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 ;  import Test::NoWarnings; 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 = 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
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 { 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    title "Check Minimal + no compressed data";
483    # This is the smallest possible gzip file (20 bytes)
484
485    ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;
486    isa_ok $x, "IO::Compress::Gzip";
487    ok $x->close, "closed" ;
488
489    ok $x = new IO::Uncompress::Gunzip $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 = new IO::Compress::Gzip \$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 ! new IO::Uncompress::Gunzip \$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 ! new IO::Uncompress::Gunzip \$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 ! new IO::Uncompress::Gunzip \$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 ! new IO::Uncompress::Gunzip \$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 ! new IO::Uncompress::Gunzip \$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 = new IO::Compress::Gzip(\$x, ExtraField => $store, Strict => 0) ;
591        ok $z,  "Created IO::Compress::Gzip object" ;
592    }
593    my $gunz = new IO::Uncompress::Gunzip \$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 { new IO::Compress::Gzip(\$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 { new IO::Compress::Gzip \$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 = new IO::Compress::Gzip \$x,
618		                      -Strict => 0,
619		                      -Name => "fred\x02" ;
620    ok $gz->close();
621
622    ok ! new IO::Uncompress::Gunzip \$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 = new IO::Uncompress::Gunzip \$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 { new IO::Compress::Gzip \$x, -Name => "\x00" };
640    like $@, mkErr('Null Character found in Name');
641    like $GzipError, '/Null Character found in Name/';
642
643    eval { new IO::Compress::Gzip \$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 = new IO::Compress::Gzip \$x,
648		                     -Strict  => 0,
649		                     -Name => "abc\x00de" ;
650    ok $gz->close() ;
651    ok my $gunzip = new IO::Uncompress::Gunzip \$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 { new IO::Compress::Gzip \$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 = new IO::Compress::Gzip \$x,
669		                      -Strict => 0,
670		                      -Comment => "fred\x02" ;
671    ok $gz->close();
672
673    ok ! new IO::Uncompress::Gunzip \$x, Strict => 1,
674                        -Transparent => 0;
675
676    like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Comment/';
677    ok my $gunzip = new IO::Uncompress::Gunzip \$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 { new IO::Compress::Gzip \$x, -Comment => "\x00" };
689    like $@, mkErr('Null Character found in Comment');
690    like $GzipError, '/Null Character found in Comment/';
691
692    eval { new IO::Compress::Gzip \$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 = new IO::Compress::Gzip \$x,
697		                     -Strict  => 0,
698		                     -Comment => "abc\x00de" ;
699    ok $gz->close() ;
700    ok my $gunzip = new IO::Uncompress::Gunzip \$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 = new IO::Compress::Gzip \$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 = new LexFile my $name ;
725    #writeFile($name, $truncated) ;
726
727    #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
728    my $g = new IO::Uncompress::Gunzip \$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 = new IO::Compress::Gzip \$truncated, -Name => $Name;
748    ok $x->write($string) ;
749    ok $x->close ;
750
751    substr($truncated, $index) = '' ;
752
753    my $g = new IO::Uncompress::Gunzip \$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 = new IO::Compress::Gzip \$truncated, -Comment => $Comment;
771    ok $x->write($string) ;
772    ok $x->close ;
773
774    substr($truncated, $index) = '' ;
775    #my $lex = new LexFile my $name ;
776    #writeFile($name, $truncated) ;
777
778    #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
779    my $g = new IO::Uncompress::Gunzip \$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 = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1;
796    ok $x->write($string) ;
797    ok $x->close ;
798
799    substr($truncated, $index) = '' ;
800    my $lex = new LexFile my $name ;
801    writeFile($name, $truncated) ;
802
803    my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
804    #my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
805    ok ! $g
806	or print "# $g\n" ;
807
808    like $GunzipError, '/^Header Error: Truncated in FHCRC Section/';
809
810}
811
812
813{
814    # Trailer Corruption tests
815
816    my $string = <<EOM;
817some text
818EOM
819    $string = $string x 1000;
820
821    my $good ;
822    {
823        ok my $x = new IO::Compress::Gzip \$good ;
824        ok $x->write($string) ;
825        ok $x->close ;
826    }
827
828    writeFile($name, $good) ;
829    ok my $gunz = new IO::Uncompress::Gunzip $name,
830                                       -Append   => 1,
831                                       -Strict   => 1;
832    my $uncomp ;
833    1 while  $gunz->read($uncomp) > 0 ;
834    ok $gunz->close() ;
835    ok $uncomp eq $string
836	or print "# got [$uncomp] wanted [$string]\n";;
837
838    foreach my $trim (-8 .. -1)
839    {
840        my $got = $trim + 8 ;
841        title "Trailer Corruption - Trailer truncated to $got bytes" ;
842        my $buffer = $good ;
843        my $expected_trailing = substr($good, -8, 8) ;
844        substr($expected_trailing, $trim) = '';
845
846        substr($buffer, $trim) = '';
847        writeFile($name, $buffer) ;
848
849        foreach my $strict (0, 1)
850        {
851            ok my $gunz = new IO::Uncompress::Gunzip $name, Append => 1, -Strict   => $strict ;
852            my $uncomp ;
853            my $status = 1;
854            $status = $gunz->read($uncomp) while $status > 0;
855            if ($strict)
856            {
857                cmp_ok $status, '<', 0 ;
858                like $GunzipError, "/Trailer Error: trailer truncated. Expected 8 bytes, got $got/";
859            }
860            else
861            {
862                is $status, 0, "status 0";
863                ok ! $GunzipError, "no error"
864                    or diag "$GunzipError";
865                my $expected = substr($buffer, - $got);
866                is  $gunz->trailingData(),  $expected_trailing, "trailing data";
867            }
868            ok $gunz->eof() ;
869            ok $uncomp eq $string;
870            ok $gunz->close ;
871        }
872
873    }
874
875    {
876        title "Trailer Corruption - Length Wrong, CRC Correct" ;
877        my $buffer = $good ;
878        my $actual_len = unpack("V", substr($buffer, -4, 4));
879        substr($buffer, -4, 4) = pack('V', $actual_len + 1);
880        writeFile($name, $buffer) ;
881
882        foreach my $strict (0, 1)
883        {
884            ok my $gunz = new IO::Uncompress::Gunzip $name,
885                                               Append   => 1,
886                                               -Strict   => $strict ;
887            my $uncomp ;
888            my $status = 1;
889            $status = $gunz->read($uncomp) while $status > 0;
890            if ($strict)
891            {
892                cmp_ok $status, '<', 0 ;
893                my $got_len = $actual_len + 1;
894                like $GunzipError, "/Trailer Error: ISIZE mismatch. Got $got_len, expected $actual_len/";
895            }
896            else
897            {
898                is $status, 0;
899                ok ! $GunzipError ;
900                #is   $gunz->trailingData(), substr($buffer, - $got) ;
901            }
902            ok ! $gunz->trailingData() ;
903            ok $gunz->eof() ;
904            ok $uncomp eq $string;
905            ok $gunz->close ;
906        }
907
908    }
909
910    {
911        title "Trailer Corruption - Length Correct, CRC Wrong" ;
912        my $buffer = $good ;
913        my $actual_crc = unpack("V", substr($buffer, -8, 4));
914        substr($buffer, -8, 4) = pack('V', $actual_crc+1);
915        writeFile($name, $buffer) ;
916
917        foreach my $strict (0, 1)
918        {
919            ok my $gunz = new IO::Uncompress::Gunzip $name,
920                                               -Append   => 1,
921                                               -Strict   => $strict ;
922            my $uncomp ;
923            my $status = 1;
924            $status = $gunz->read($uncomp) while $status > 0;
925            if ($strict)
926            {
927                cmp_ok $status, '<', 0 ;
928                like $GunzipError, '/Trailer Error: CRC mismatch/';
929            }
930            else
931            {
932                is $status, 0;
933                ok ! $GunzipError ;
934            }
935            ok ! $gunz->trailingData() ;
936            ok $gunz->eof() ;
937            ok $uncomp eq $string;
938            ok $gunz->close ;
939        }
940
941    }
942
943    {
944        title "Trailer Corruption - Length Wrong, CRC Wrong" ;
945        my $buffer = $good ;
946        my $actual_len = unpack("V", substr($buffer, -4, 4));
947        my $actual_crc = unpack("V", substr($buffer, -8, 4));
948        substr($buffer, -4, 4) = pack('V', $actual_len+1);
949        substr($buffer, -8, 4) = pack('V', $actual_crc+1);
950        writeFile($name, $buffer) ;
951
952        foreach my $strict (0, 1)
953        {
954            ok my $gunz = new IO::Uncompress::Gunzip $name,
955                                               -Append   => 1,
956                                               -Strict   => $strict ;
957            my $uncomp ;
958            my $status = 1;
959            $status = $gunz->read($uncomp) while $status > 0;
960            if ($strict)
961            {
962                cmp_ok $status, '<', 0 ;
963                like $GunzipError, '/Trailer Error: CRC mismatch/';
964            }
965            else
966            {
967                is $status, 0;
968                ok ! $GunzipError ;
969            }
970            ok $gunz->eof() ;
971            ok $uncomp eq $string;
972            ok $gunz->close ;
973        }
974
975    }
976
977    {
978        # RT #72329
979        my $error = 'Error with ExtraField Parameter: ' .
980                    'SubField ID not two chars long' ;
981        my $buffer ;
982        my $x ;
983        eval { $x = new IO::Compress::Gzip \$buffer,
984                -ExtraField  => [ at => 'mouse', bad => 'dog'] ;
985             };
986        like $@, mkErr("$error");
987        like $GzipError, "/$error/";
988        ok ! $x ;
989    }
990}
991
992
993
994