This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Update IO-Compress to CPAN version 2.033
[perl5.git] / cpan / IO-Compress / t / 004gziphdr.t
CommitLineData
25f0751f
PM		 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 => 910 + $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
3006a4e1 168 my $v = pack "h*", $value;
25f0751f
PM		 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 ;
25f0751f
PM		 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};
cd0c0e65 215 is $hdr->{ExtraFlags}, 4;
25f0751f
PM		 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};
cd0c0e65 225 is $hdr->{ExtraFlags}, 2;
25f0751f
PM		 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",
c70c1701 382 "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",
25f0751f
PM		 383 "Header Error: Truncated in FEXTRA Body Section",
384 ['a', undef, undef] ],
385 ["Length of field incorrect",
c70c1701 386 "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",
25f0751f
PM		 387 "Header Error: Truncated in FEXTRA Body Section",
388 ["ab", 255, "abc"] ],
389 ["Length of 2nd field incorrect",
c70c1701 390 "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",
25f0751f
PM		 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",
c70c1701 395 "Header Error: SubField ID 2nd byte is 0x00",
25f0751f
PM		 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 {
c70c1701
PM		 430 ok $x = new IO::Compress::Gzip \$buffer,
431 ExtraField => $input,
432 Strict => 0
433 or diag "GzipError is $GzipError" ;
25f0751f
PM		 434 my $string = "abcd" ;
435 $x->write($string) ;
436 $x->close ;
437 is anyUncompress(\$buffer), $string ;
438
c70c1701
PM		 439 $x = new IO::Uncompress::Gunzip \$buffer,
440 Strict => 0,
25f0751f 441 Transparent => 0,
c70c1701 442 ParseExtra => $check;
25f0751f
PM		 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{
cd0c0e65 482 # Check Minimal + no compressed data
25f0751f
PM		 483 # This is the smallest possible gzip file (20 bytes)
484
485 ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;
486 ok $x->close ;
487 #ok GZreadFile($name) eq '' ;
488
489 ok $x = new IO::Uncompress::Gunzip $name, -Append => 1 ;
490 my $data ;
491 my $status = 1;
492
493 $status = $x->read($data)
494 while $status > 0;
495 is $status, 0 ;
496 is $data, '';
497 ok ! $x->error() ;
498 ok $x->eof() ;
499
500 my $hdr = $x->getHeaderInfo();
501 ok $hdr;
502
503 ok defined $hdr->{ISIZE} ;
504 is $hdr->{ISIZE}, 0;
505
506 ok defined $hdr->{CRC32} ;
507 is $hdr->{CRC32}, 0;
508
509 is $hdr->{Time}, 0;
510 ok ! defined $hdr->{Name} ;
511 ok ! defined $hdr->{ExtraFieldRaw} ;
512 ok ! defined $hdr->{Comment} ;
513 is $hdr->{OsName}, 'Unknown' ;
514 is $hdr->{MethodName}, "Deflated";
515 is $hdr->{Flags}, 0;
516 ok $hdr->{isMinimalHeader} ;
517 ok ! $hdr->{TextFlag} ;
518 ok $x->close ;
519}
520
521{
522 # Header Corruption Tests
523
524 my $string = <<EOM;
525some text
526EOM
527
528 my $good = '';
529 ok my $x = new IO::Compress::Gzip \$good, -HeaderCRC => 1 ;
530 ok $x->write($string) ;
531 ok $x->close ;
532
533 {
534 title "Header Corruption - Fingerprint wrong 1st byte" ;
535 my $buffer = $good ;
536 substr($buffer, 0, 1) = 'x' ;
537
538 ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ;
539 ok $GunzipError =~ /Header Error: Bad Magic/;
540 }
541
542 {
543 title "Header Corruption - Fingerprint wrong 2nd byte" ;
544 my $buffer = $good ;
545 substr($buffer, 1, 1) = "\xFF" ;
546
547 ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ;
548 ok $GunzipError =~ /Header Error: Bad Magic/;
549 #print "$GunzipError\n";
550 }
551
552 {
553 title "Header Corruption - CM not 8";
554 my $buffer = $good ;
555 substr($buffer, 2, 1) = 'x' ;
556
557 ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ;
558 like $GunzipError, '/Header Error: Not Deflate \(CM is \d+\)/';
559 }
560
561 {
562 title "Header Corruption - Use of Reserved Flags";
563 my $buffer = $good ;
564 substr($buffer, 3, 1) = "\xff";
565
566 ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ;
567 like $GunzipError, '/Header Error: Use of Reserved Bits in FLG field./';
568 }
569
570 {
571 title "Header Corruption - Fail HeaderCRC";
572 my $buffer = $good ;
573 substr($buffer, 10, 1) = chr((ord(substr($buffer, 10, 1)) + 1) & 0xFF);
574
575 ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0, Strict => 1
576 or print "# $GunzipError\n";
577 like $GunzipError, '/Header Error: CRC16 mismatch/'
578 #or diag "buffer length " . length($buffer);
579 or hexDump(\$good), hexDump(\$buffer);
580 }
581}
582
583{
584 title "ExtraField max raw size";
585 my $x ;
586 my $store = "x" x GZIP_FEXTRA_MAX_SIZE ;
587 my $z = new IO::Compress::Gzip(\$x, ExtraField => $store, Strict => 0) ;
588 ok $z, "Created IO::Compress::Gzip object" ;
589 my $gunz = new IO::Uncompress::Gunzip \$x, Strict => 0;
590 ok $gunz, "Created IO::Uncompress::Gunzip object" ;
591 my $hdr = $gunz->getHeaderInfo();
592 ok $hdr;
593
594 is $hdr->{ExtraFieldRaw}, $store ;
595}
596
597{
598 title "Header Corruption - ExtraField too big";
599 my $x;
600 eval { new IO::Compress::Gzip(\$x, -ExtraField => "x" x (GZIP_FEXTRA_MAX_SIZE + 1)) ;};
601 like $@, mkErr('Error with ExtraField Parameter: Too Large');
602 like $GzipError, '/Error with ExtraField Parameter: Too Large/';
603}
604
605{
606 title "Header Corruption - Create Name with Illegal Chars";
607
608 my $x;
609 eval { new IO::Compress::Gzip \$x, -Name => "fred\x02" };
610 like $@, mkErr('Non ISO 8859-1 Character found in Name');
611 like $GzipError, '/Non ISO 8859-1 Character found in Name/';
612
613 ok my $gz = new IO::Compress::Gzip \$x,
614 -Strict => 0,
615 -Name => "fred\x02" ;
616 ok $gz->close();
617
618 ok ! new IO::Uncompress::Gunzip \$x,
619 -Transparent => 0,
620 -Strict => 1;
621
622 like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Name/';
623 ok my $gunzip = new IO::Uncompress::Gunzip \$x,
624 -Strict => 0;
625
626 my $hdr = $gunzip->getHeaderInfo() ;
627
628 is $hdr->{Name}, "fred\x02";
629
630}
631
632{
633 title "Header Corruption - Null Chars in Name";
634 my $x;
635 eval { new IO::Compress::Gzip \$x, -Name => "\x00" };
636 like $@, mkErr('Null Character found in Name');
637 like $GzipError, '/Null Character found in Name/';
638
639 eval { new IO::Compress::Gzip \$x, -Name => "abc\x00" };
640 like $@, mkErr('Null Character found in Name');
641 like $GzipError, '/Null Character found in Name/';
642
643 ok my $gz = new IO::Compress::Gzip \$x,
644 -Strict => 0,
645 -Name => "abc\x00de" ;
646 ok $gz->close() ;
647 ok my $gunzip = new IO::Uncompress::Gunzip \$x,
648 -Strict => 0;
649
650 my $hdr = $gunzip->getHeaderInfo() ;
651
652 is $hdr->{Name}, "abc";
653
654}
655
656{
657 title "Header Corruption - Create Comment with Illegal Chars";
658
659 my $x;
660 eval { new IO::Compress::Gzip \$x, -Comment => "fred\x02" };
661 like $@, mkErr('Non ISO 8859-1 Character found in Comment');
662 like $GzipError, '/Non ISO 8859-1 Character found in Comment/';
663
664 ok my $gz = new IO::Compress::Gzip \$x,
665 -Strict => 0,
666 -Comment => "fred\x02" ;
667 ok $gz->close();
668
669 ok ! new IO::Uncompress::Gunzip \$x, Strict => 1,
670 -Transparent => 0;
671
672 like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Comment/';
673 ok my $gunzip = new IO::Uncompress::Gunzip \$x, Strict => 0;
674
675 my $hdr = $gunzip->getHeaderInfo() ;
676
677 is $hdr->{Comment}, "fred\x02";
678
679}
680
681{
682 title "Header Corruption - Null Char in Comment";
683 my $x;
684 eval { new IO::Compress::Gzip \$x, -Comment => "\x00" };
685 like $@, mkErr('Null Character found in Comment');
686 like $GzipError, '/Null Character found in Comment/';
687
688 eval { new IO::Compress::Gzip \$x, -Comment => "abc\x00" } ;
689 like $@, mkErr('Null Character found in Comment');
690 like $GzipError, '/Null Character found in Comment/';
691
692 ok my $gz = new IO::Compress::Gzip \$x,
693 -Strict => 0,
694 -Comment => "abc\x00de" ;
695 ok $gz->close() ;
696 ok my $gunzip = new IO::Uncompress::Gunzip \$x,
697 -Strict => 0;
698
699 my $hdr = $gunzip->getHeaderInfo() ;
700
701 is $hdr->{Comment}, "abc";
702
703}
704
705
706for my $index ( GZIP_MIN_HEADER_SIZE + 1 .. GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1)
707{
708 title "Header Corruption - Truncated in Extra";
709 my $string = <<EOM;
710some text
711EOM
712
713 my $truncated ;
714 ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1, Strict => 0,
715 -ExtraField => "hello" x 10 ;
716 ok $x->write($string) ;
717 ok $x->close ;
718
719 substr($truncated, $index) = '' ;
720 #my $lex = new LexFile my $name ;
721 #writeFile($name, $truncated) ;
722
723 #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
724 my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
725 ok ! $g
726 or print "# $g\n" ;
727
728 like($GunzipError, '/^Header Error: Truncated in FEXTRA/');
729
730
731}
732
733my $Name = "fred" ;
734 my $truncated ;
735for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Name) -1)
736{
737 title "Header Corruption - Truncated in Name";
738 my $string = <<EOM;
739some text
740EOM
741
742 my $truncated ;
743 ok my $x = new IO::Compress::Gzip \$truncated, -Name => $Name;
744 ok $x->write($string) ;
745 ok $x->close ;
746
747 substr($truncated, $index) = '' ;
748
749 my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
750 ok ! $g
751 or print "# $g\n" ;
752
753 like $GunzipError, '/^Header Error: Truncated in FNAME Section/';
754
755}
756
757my $Comment = "comment" ;
758for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Comment) -1)
759{
760 title "Header Corruption - Truncated in Comment";
761 my $string = <<EOM;
762some text
763EOM
764
765 my $truncated ;
766 ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment;
767 ok $x->write($string) ;
768 ok $x->close ;
769
770 substr($truncated, $index) = '' ;
771 #my $lex = new LexFile my $name ;
772 #writeFile($name, $truncated) ;
773
774 #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
775 my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
776 ok ! $g
777 or print "# $g\n" ;
778
779 like $GunzipError, '/^Header Error: Truncated in FCOMMENT Section/';
780
781}
782
783for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
784{
785 title "Header Corruption - Truncated in CRC";
786 my $string = <<EOM;
787some text
788EOM
789
790 my $truncated ;
791 ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1;
792 ok $x->write($string) ;
793 ok $x->close ;
794
795 substr($truncated, $index) = '' ;
796 my $lex = new LexFile my $name ;
797 writeFile($name, $truncated) ;
798
799 my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
800 #my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
801 ok ! $g
802 or print "# $g\n" ;
803
804 like $GunzipError, '/^Header Error: Truncated in FHCRC Section/';
805
806}
807
808
809{
810 # Trailer Corruption tests
811
812 my $string = <<EOM;
813some text
814EOM
815
816 my $good ;
817 {
818 ok my $x = new IO::Compress::Gzip \$good ;
819 ok $x->write($string) ;
820 ok $x->close ;
821 }
822
823 writeFile($name, $good) ;
824 ok my $gunz = new IO::Uncompress::Gunzip $name,
93d092e2 825 -Append => 1,
25f0751f
PM		 826 -Strict => 1;
827 my $uncomp ;
828 1 while $gunz->read($uncomp) > 0 ;
829 ok $gunz->close() ;
830 ok $uncomp eq $string
831 or print "# got [$uncomp] wanted [$string]\n";;
832
833 foreach my $trim (-8 .. -1)
834 {
835 my $got = $trim + 8 ;
836 title "Trailer Corruption - Trailer truncated to $got bytes" ;
837 my $buffer = $good ;
838 my $expected_trailing = substr($good, -8, 8) ;
839 substr($expected_trailing, $trim) = '';
840
841 substr($buffer, $trim) = '';
842 writeFile($name, $buffer) ;
843
844 foreach my $strict (0, 1)
845 {
846 ok my $gunz = new IO::Uncompress::Gunzip $name, -Strict => $strict ;
847 my $uncomp ;
848 if ($strict)
849 {
850 ok $gunz->read($uncomp) < 0 ;
851 like $GunzipError, "/Trailer Error: trailer truncated. Expected 8 bytes, got $got/";
852 }
853 else
854 {
855 ok $gunz->read($uncomp) > 0 ;
856 ok ! $GunzipError ;
857 my $expected = substr($buffer, - $got);
858 is $gunz->trailingData(), $expected_trailing;
859 }
860 ok $gunz->eof() ;
861 ok $uncomp eq $string;
862 ok $gunz->close ;
863 }
864
865 }
866
867 {
868 title "Trailer Corruption - Length Wrong, CRC Correct" ;
869 my $buffer = $good ;
870 my $actual_len = unpack("V", substr($buffer, -4, 4));
871 substr($buffer, -4, 4) = pack('V', $actual_len + 1);
872 writeFile($name, $buffer) ;
873
874 foreach my $strict (0, 1)
875 {
876 ok my $gunz = new IO::Uncompress::Gunzip $name,
877 -Strict => $strict ;
878 my $uncomp ;
879 if ($strict)
880 {
881 ok $gunz->read($uncomp) < 0 ;
882 my $got_len = $actual_len + 1;
883 like $GunzipError, "/Trailer Error: ISIZE mismatch. Got $got_len, expected $actual_len/";
884 }
885 else
886 {
887 ok $gunz->read($uncomp) > 0 ;
888 ok ! $GunzipError ;
889 #is $gunz->trailingData(), substr($buffer, - $got) ;
890 }
891 ok ! $gunz->trailingData() ;
892 ok $gunz->eof() ;
893 ok $uncomp eq $string;
894 ok $gunz->close ;
895 }
896
897 }
898
899 {
900 title "Trailer Corruption - Length Correct, CRC Wrong" ;
901 my $buffer = $good ;
902 my $actual_crc = unpack("V", substr($buffer, -8, 4));
903 substr($buffer, -8, 4) = pack('V', $actual_crc+1);
904 writeFile($name, $buffer) ;
905
906 foreach my $strict (0, 1)
907 {
908 ok my $gunz = new IO::Uncompress::Gunzip $name,
909 -Strict => $strict ;
910 my $uncomp ;
911 if ($strict)
912 {
913 ok $gunz->read($uncomp) < 0 ;
914 like $GunzipError, '/Trailer Error: CRC mismatch/';
915 }
916 else
917 {
918 ok $gunz->read($uncomp) > 0 ;
919 ok ! $GunzipError ;
920 }
921 ok ! $gunz->trailingData() ;
922 ok $gunz->eof() ;
923 ok $uncomp eq $string;
924 ok $gunz->close ;
925 }
926
927 }
928
929 {
930 title "Trailer Corruption - Length Wrong, CRC Wrong" ;
931 my $buffer = $good ;
932 my $actual_len = unpack("V", substr($buffer, -4, 4));
933 my $actual_crc = unpack("V", substr($buffer, -8, 4));
934 substr($buffer, -4, 4) = pack('V', $actual_len+1);
935 substr($buffer, -8, 4) = pack('V', $actual_crc+1);
936 writeFile($name, $buffer) ;
937
938 foreach my $strict (0, 1)
939 {
940 ok my $gunz = new IO::Uncompress::Gunzip $name,
941 -Strict => $strict ;
942 my $uncomp ;
943 if ($strict)
944 {
945 ok $gunz->read($uncomp) < 0 ;
946 like $GunzipError, '/Trailer Error: CRC mismatch/';
947 }
948 else
949 {
950 ok $gunz->read($uncomp) > 0 ;
951 ok ! $GunzipError ;
952 }
953 ok $gunz->eof() ;
954 ok $uncomp eq $string;
955 ok $gunz->close ;
956 }
957
958 }
959}
960
961
962
Unnamed repository; edit this file 'description' to name the repository.