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