Commit | Line | Data |
16816334 |
1 | BEGIN { |
d695c1a1 |
2 | if ($ENV{PERL_CORE}) { |
16816334 |
3 | chdir 't' if -d 't'; |
0ecadccd |
4 | @INC = ("../lib", "lib"); |
16816334 |
5 | } |
6 | } |
642e522c |
7 | |
8 | use lib 't'; |
9 | use strict; |
10 | use warnings; |
11 | use bytes; |
12 | |
13 | use Test::More ; |
14 | use ZlibTestUtils; |
15 | |
16 | BEGIN { |
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 | |
38 | my $ThisOS_code = $Compress::Zlib::gzip_os_code; |
39 | |
40 | my $name = "test.gz" ; |
41 | my $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 |
165 | for 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; |
516 | some text |
517 | EOM |
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 | |
695 | for 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; |
699 | some text |
700 | EOM |
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 | |
723 | my $Name = "fred" ; |
724 | my $truncated ; |
725 | for 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; |
729 | some text |
730 | EOM |
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 | |
747 | my $Comment = "comment" ; |
748 | for 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; |
752 | some text |
753 | EOM |
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 | |
774 | for 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; |
778 | some text |
779 | EOM |
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; |
805 | some text |
806 | EOM |
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 | |