Commit | Line | Data |
16816334 |
1 | BEGIN { |
2 | if ($ENV{PERL_CORE} { |
3 | chdir 't' if -d 't'; |
4 | @INC = '../lib'; |
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 | |
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 | |
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 | |
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; |
485 | some text |
486 | EOM |
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 | |
664 | for 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; |
668 | some text |
669 | EOM |
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 | |
692 | my $Name = "fred" ; |
693 | my $truncated ; |
694 | for 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; |
698 | some text |
699 | EOM |
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 | |
716 | my $Comment = "comment" ; |
717 | for 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; |
721 | some text |
722 | EOM |
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 | |
743 | for 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; |
747 | some text |
748 | EOM |
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; |
774 | some text |
775 | EOM |
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 | |