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