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