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 | |
9f2e3514 |
40 | my $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 |
164 | for 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; |
515 | some text |
516 | EOM |
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 | |
694 | for 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; |
698 | some text |
699 | EOM |
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 | |
721 | my $Name = "fred" ; |
722 | my $truncated ; |
723 | for 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; |
727 | some text |
728 | EOM |
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 | |
745 | my $Comment = "comment" ; |
746 | for 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; |
750 | some text |
751 | EOM |
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 | |
771 | for 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; |
775 | some text |
776 | EOM |
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; |
801 | some text |
802 | EOM |
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 | |