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