Commit | Line | Data |
25f0751f |
1 | BEGIN { |
2 | if ($ENV{PERL_CORE}) { |
3 | chdir 't' if -d 't'; |
4 | @INC = ("../lib", "lib/compress"); |
5 | } |
6 | } |
7 | |
8 | use lib qw(t t/compress); |
9 | use strict; |
10 | use warnings; |
11 | use bytes; |
12 | |
13 | use Test::More ; |
14 | use CompTestUtils; |
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 => 910 + $extra ; |
24 | |
25 | use_ok('Compress::Raw::Zlib') ; |
26 | use_ok('IO::Compress::Gzip::Constants') ; |
27 | |
28 | use_ok('IO::Compress::Gzip', qw($GzipError)) ; |
29 | use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ; |
30 | |
31 | } |
32 | |
33 | |
34 | |
35 | # Check the Gzip Header Parameters |
36 | #======================================== |
37 | |
38 | my $ThisOS_code = $Compress::Raw::Zlib::gzip_os_code; |
39 | |
40 | my $lex = new LexFile my $name ; |
41 | |
42 | { |
43 | title "Check Defaults"; |
44 | # Check Name defaults undef, no name, no comment |
45 | # and Time can be explicitly set. |
46 | |
47 | my $hdr = readHeaderInfo($name, -Time => 1234); |
48 | |
49 | is $hdr->{Time}, 1234; |
50 | ok ! defined $hdr->{Name}; |
51 | is $hdr->{MethodName}, 'Deflated'; |
52 | is $hdr->{ExtraFlags}, 0; |
53 | is $hdr->{MethodID}, Z_DEFLATED; |
54 | is $hdr->{OsID}, $ThisOS_code ; |
55 | ok ! defined $hdr->{Comment} ; |
56 | ok ! defined $hdr->{ExtraFieldRaw} ; |
57 | ok ! defined $hdr->{HeaderCRC} ; |
58 | ok ! $hdr->{isMinimalHeader} ; |
59 | } |
60 | |
61 | { |
62 | |
63 | title "Check name can be different from filename" ; |
64 | # Check Name can be different from filename |
65 | # Comment and Extra can be set |
66 | # Can specify a zero Time |
67 | |
68 | my $comment = "This is a Comment" ; |
69 | my $extra = "A little something extra" ; |
70 | my $aname = "a new name" ; |
71 | my $hdr = readHeaderInfo $name, |
72 | -Strict => 0, |
73 | -Name => $aname, |
74 | -Comment => $comment, |
75 | -ExtraField => $extra, |
76 | -Time => 0 ; |
77 | |
78 | ok $hdr->{Time} == 0; |
79 | ok $hdr->{Name} eq $aname; |
80 | ok $hdr->{MethodName} eq 'Deflated'; |
81 | ok $hdr->{MethodID} == 8; |
82 | is $hdr->{ExtraFlags}, 0; |
83 | ok $hdr->{Comment} eq $comment ; |
84 | is $hdr->{OsID}, $ThisOS_code ; |
85 | ok ! $hdr->{isMinimalHeader} ; |
86 | ok ! defined $hdr->{HeaderCRC} ; |
87 | } |
88 | |
89 | { |
90 | title "Check Time defaults to now" ; |
91 | |
92 | # Check Time defaults to now |
93 | # and that can have empty name, comment and extrafield |
94 | my $before = time ; |
95 | my $hdr = readHeaderInfo $name, |
96 | -TextFlag => 1, |
97 | -Name => "", |
98 | -Comment => "", |
99 | -ExtraField => ""; |
100 | my $after = time ; |
101 | |
102 | ok $hdr->{Time} >= $before ; |
103 | ok $hdr->{Time} <= $after ; |
104 | |
105 | ok defined $hdr->{Name} ; |
106 | ok $hdr->{Name} eq ""; |
107 | ok defined $hdr->{Comment} ; |
108 | ok $hdr->{Comment} eq ""; |
109 | ok defined $hdr->{ExtraFieldRaw} ; |
110 | ok $hdr->{ExtraFieldRaw} eq ""; |
111 | is $hdr->{ExtraFlags}, 0; |
112 | |
113 | ok ! $hdr->{isMinimalHeader} ; |
114 | ok $hdr->{TextFlag} ; |
115 | ok ! defined $hdr->{HeaderCRC} ; |
116 | is $hdr->{OsID}, $ThisOS_code ; |
117 | |
118 | } |
119 | |
120 | { |
121 | title "can have null extrafield" ; |
122 | |
123 | my $before = time ; |
124 | my $hdr = readHeaderInfo $name, |
125 | -strict => 0, |
126 | -Name => "a", |
127 | -Comment => "b", |
128 | -ExtraField => "\x00"; |
129 | my $after = time ; |
130 | |
131 | ok $hdr->{Time} >= $before ; |
132 | ok $hdr->{Time} <= $after ; |
133 | ok $hdr->{Name} eq "a"; |
134 | ok $hdr->{Comment} eq "b"; |
135 | is $hdr->{ExtraFlags}, 0; |
136 | ok $hdr->{ExtraFieldRaw} eq "\x00"; |
137 | ok ! $hdr->{isMinimalHeader} ; |
138 | ok ! $hdr->{TextFlag} ; |
139 | ok ! defined $hdr->{HeaderCRC} ; |
140 | is $hdr->{OsID}, $ThisOS_code ; |
141 | |
142 | } |
143 | |
144 | { |
145 | title "can have undef name, comment, time and extrafield" ; |
146 | |
147 | my $hdr = readHeaderInfo $name, |
148 | -Name => undef, |
149 | -Comment => undef, |
150 | -ExtraField => undef, |
151 | -Time => undef; |
152 | |
153 | ok $hdr->{Time} == 0; |
154 | ok ! defined $hdr->{Name} ; |
155 | ok ! defined $hdr->{Comment} ; |
156 | ok ! defined $hdr->{ExtraFieldRaw} ; |
157 | ok ! $hdr->{isMinimalHeader} ; |
158 | ok ! $hdr->{TextFlag} ; |
159 | ok ! defined $hdr->{HeaderCRC} ; |
160 | is $hdr->{OsID}, $ThisOS_code ; |
161 | |
162 | } |
163 | |
164 | for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") |
165 | { |
166 | title "Comment with $value" ; |
167 | |
3006a4e1 |
168 | my $v = pack "h*", $value; |
25f0751f |
169 | my $comment = "my${v}comment$v"; |
170 | my $hdr = readHeaderInfo $name, |
171 | Time => 0, |
172 | -TextFlag => 1, |
173 | -Name => "", |
174 | -Comment => $comment, |
175 | -ExtraField => ""; |
176 | my $after = time ; |
177 | |
178 | is $hdr->{Time}, 0 ; |
179 | |
180 | ok defined $hdr->{Name} ; |
181 | ok $hdr->{Name} eq ""; |
182 | ok defined $hdr->{Comment} ; |
183 | is $hdr->{Comment}, $comment; |
184 | ok defined $hdr->{ExtraFieldRaw} ; |
185 | ok $hdr->{ExtraFieldRaw} eq ""; |
186 | is $hdr->{ExtraFlags}, 0; |
187 | |
188 | ok ! $hdr->{isMinimalHeader} ; |
189 | ok $hdr->{TextFlag} ; |
190 | ok ! defined $hdr->{HeaderCRC} ; |
191 | is $hdr->{OsID}, $ThisOS_code ; |
25f0751f |
192 | } |
193 | |
194 | { |
195 | title "Check crchdr" ; |
196 | |
197 | my $hdr = readHeaderInfo $name, -HeaderCRC => 1; |
198 | |
199 | ok ! defined $hdr->{Name}; |
200 | is $hdr->{ExtraFlags}, 0; |
201 | ok ! defined $hdr->{ExtraFieldRaw} ; |
202 | ok ! defined $hdr->{Comment} ; |
203 | ok ! $hdr->{isMinimalHeader} ; |
204 | ok ! $hdr->{TextFlag} ; |
205 | ok defined $hdr->{HeaderCRC} ; |
206 | is $hdr->{OsID}, $ThisOS_code ; |
207 | } |
208 | |
209 | { |
210 | title "Check ExtraFlags" ; |
211 | |
212 | my $hdr = readHeaderInfo $name, -Level => Z_BEST_SPEED; |
213 | |
214 | ok ! defined $hdr->{Name}; |
215 | is $hdr->{ExtraFlags}, 2; |
216 | ok ! defined $hdr->{ExtraFieldRaw} ; |
217 | ok ! defined $hdr->{Comment} ; |
218 | ok ! $hdr->{isMinimalHeader} ; |
219 | ok ! $hdr->{TextFlag} ; |
220 | ok ! defined $hdr->{HeaderCRC} ; |
221 | |
222 | $hdr = readHeaderInfo $name, -Level => Z_BEST_COMPRESSION; |
223 | |
224 | ok ! defined $hdr->{Name}; |
225 | is $hdr->{ExtraFlags}, 4; |
226 | ok ! defined $hdr->{ExtraFieldRaw} ; |
227 | ok ! defined $hdr->{Comment} ; |
228 | ok ! $hdr->{isMinimalHeader} ; |
229 | ok ! $hdr->{TextFlag} ; |
230 | ok ! defined $hdr->{HeaderCRC} ; |
231 | |
232 | $hdr = readHeaderInfo $name, -Level => Z_BEST_COMPRESSION, |
233 | -ExtraFlags => 42; |
234 | |
235 | ok ! defined $hdr->{Name}; |
236 | is $hdr->{ExtraFlags}, 42; |
237 | ok ! defined $hdr->{ExtraFieldRaw} ; |
238 | ok ! defined $hdr->{Comment} ; |
239 | ok ! $hdr->{isMinimalHeader} ; |
240 | ok ! $hdr->{TextFlag} ; |
241 | ok ! defined $hdr->{HeaderCRC} ; |
242 | |
243 | |
244 | } |
245 | |
246 | { |
247 | title "OS Code" ; |
248 | |
249 | for my $code ( -1, undef, '', 'fred' ) |
250 | { |
251 | my $code_name = defined $code ? "'$code'" : "'undef'"; |
252 | eval { new IO::Compress::Gzip $name, -OS_Code => $code } ; |
253 | like $@, mkErr("^IO::Compress::Gzip: Parameter 'OS_Code' must be an unsigned int, got $code_name"), |
254 | " Trap OS Code $code_name"; |
255 | } |
256 | |
257 | for my $code ( qw( 256 ) ) |
258 | { |
259 | eval { ok ! new IO::Compress::Gzip($name, OS_Code => $code) }; |
260 | like $@, mkErr("OS_Code must be between 0 and 255, got '$code'"), |
261 | " Trap OS Code $code"; |
262 | like $GzipError, "/OS_Code must be between 0 and 255, got '$code'/", |
263 | " Trap OS Code $code"; |
264 | } |
265 | |
266 | for my $code ( qw(0 1 12 254 255) ) |
267 | { |
268 | my $hdr = readHeaderInfo $name, OS_Code => $code; |
269 | |
270 | is $hdr->{OsID}, $code, " Code is $code" ; |
271 | } |
272 | |
273 | |
274 | |
275 | } |
276 | |
277 | { |
278 | title 'Check ExtraField'; |
279 | |
280 | my @tests = ( |
281 | [1, ['AB' => ''] => [['AB'=>'']] ], |
282 | [1, {'AB' => ''} => [['AB'=>'']] ], |
283 | [1, ['AB' => 'Fred'] => [['AB'=>'Fred']] ], |
284 | [1, {'AB' => 'Fred'} => [['AB'=>'Fred']] ], |
285 | [1, ['Xx' => '','AB' => 'Fred'] => [['Xx' => ''],['AB'=>'Fred']] ], |
286 | [1, ['Xx' => '','Xx' => 'Fred'] => [['Xx' => ''],['Xx'=>'Fred']] ], |
287 | [1, ['Xx' => '', |
288 | 'Xx' => 'Fred', |
289 | 'Xx' => 'Fred'] => [['Xx' => ''],['Xx'=>'Fred'], |
290 | ['Xx'=>'Fred']] ], |
291 | [1, [ ['Xx' => 'a'], |
292 | ['AB' => 'Fred'] ] => [['Xx' => 'a'],['AB'=>'Fred']] ], |
293 | [0, {'AB' => 'Fred', |
294 | 'Pq' => 'r', |
295 | "\x01\x02" => "\x03"} => [['AB'=>'Fred'], |
296 | ['Pq'=>'r'], |
297 | ["\x01\x02"=>"\x03"]] ], |
298 | [1, ['AB' => 'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE] => |
299 | [['AB'=>'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE]] ], |
300 | ); |
301 | |
302 | foreach my $test (@tests) { |
303 | my ($order, $input, $result) = @$test ; |
304 | ok my $x = new IO::Compress::Gzip $name, |
305 | -ExtraField => $input, |
306 | -HeaderCRC => 1 |
307 | or diag "GzipError is $GzipError" ; ; |
308 | my $string = "abcd" ; |
309 | ok $x->write($string) ; |
310 | ok $x->close ; |
311 | #is GZreadFile($name), $string ; |
312 | |
313 | ok $x = new IO::Uncompress::Gunzip $name, |
314 | #-Strict => 1, |
315 | -ParseExtra => 1 |
316 | or diag "GunzipError is $GunzipError" ; ; |
317 | my $hdr = $x->getHeaderInfo(); |
318 | ok $hdr; |
319 | ok ! defined $hdr->{Name}; |
320 | ok ! defined $hdr->{Comment} ; |
321 | ok ! $hdr->{isMinimalHeader} ; |
322 | ok ! $hdr->{TextFlag} ; |
323 | ok defined $hdr->{HeaderCRC} ; |
324 | |
325 | ok defined $hdr->{ExtraFieldRaw} ; |
326 | ok defined $hdr->{ExtraField} ; |
327 | |
328 | my $extra = $hdr->{ExtraField} ; |
329 | |
330 | if ($order) { |
331 | eq_array $extra, $result; |
332 | } else { |
333 | eq_set $extra, $result; |
334 | } |
335 | } |
336 | |
337 | } |
338 | |
339 | { |
340 | title 'Write Invalid ExtraField'; |
341 | |
342 | my $prefix = 'Error with ExtraField Parameter: '; |
343 | my @tests = ( |
344 | [ sub{ "abc" } => "Not a scalar, array ref or hash ref"], |
345 | [ [ "a" ] => "Not even number of elements"], |
346 | [ [ "a" => "fred" ] => 'SubField ID not two chars long'], |
347 | [ [ "a\x00" => "fred" ] => 'SubField ID 2nd byte is 0x00'], |
348 | [ [ [ {}, "abc" ]] => "SubField ID is a reference"], |
349 | [ [ [ "ab", \1 ]] => "SubField Data is a reference"], |
350 | [ [ {"a" => "fred"} ] => "Not list of lists"], |
351 | [ [ ['ab'=>'x'],{"a" => "fred"} ] => "Not list of lists"], |
352 | [ [ ["aa"] ] => "SubField must have two parts"], |
353 | [ [ ["aa", "b", "c"] ] => "SubField must have two parts"], |
354 | [ [ ["ab" => 'x' x (GZIP_FEXTRA_SUBFIELD_MAX_SIZE + 1) ] ] |
355 | => "SubField Data too long"], |
356 | |
357 | [ { 'abc', 1 } => "SubField ID not two chars long"], |
358 | [ { \1 , "abc" } => "SubField ID not two chars long"], |
359 | [ { "ab", \1 } => "SubField Data is a reference"], |
360 | ); |
361 | |
362 | |
363 | |
364 | foreach my $test (@tests) { |
365 | my ($input, $string) = @$test ; |
366 | my $buffer ; |
367 | my $x ; |
368 | eval { $x = new IO::Compress::Gzip \$buffer, -ExtraField => $input; }; |
369 | like $@, mkErr("$prefix$string"); |
370 | like $GzipError, "/$prefix$string/"; |
371 | ok ! $x ; |
372 | |
373 | } |
374 | |
375 | } |
376 | |
377 | { |
378 | # Corrupt ExtraField |
379 | |
380 | my @tests = ( |
381 | ["Sub-field truncated", |
c70c1701 |
382 | "Error with ExtraField Parameter: Truncated in FEXTRA Body Section", |
25f0751f |
383 | "Header Error: Truncated in FEXTRA Body Section", |
384 | ['a', undef, undef] ], |
385 | ["Length of field incorrect", |
c70c1701 |
386 | "Error with ExtraField Parameter: Truncated in FEXTRA Body Section", |
25f0751f |
387 | "Header Error: Truncated in FEXTRA Body Section", |
388 | ["ab", 255, "abc"] ], |
389 | ["Length of 2nd field incorrect", |
c70c1701 |
390 | "Error with ExtraField Parameter: Truncated in FEXTRA Body Section", |
25f0751f |
391 | "Header Error: Truncated in FEXTRA Body Section", |
392 | ["ab", 3, "abc"], ["de", 7, "x"] ], |
393 | ["Length of 2nd field incorrect", |
394 | "Error with ExtraField Parameter: SubField ID 2nd byte is 0x00", |
c70c1701 |
395 | "Header Error: SubField ID 2nd byte is 0x00", |
25f0751f |
396 | ["a\x00", 3, "abc"], ["de", 7, "x"] ], |
397 | ); |
398 | |
399 | foreach my $test (@tests) |
400 | { |
401 | my $name = shift @$test; |
402 | my $gzip_error = shift @$test; |
403 | my $gunzip_error = shift @$test; |
404 | |
405 | title "Read Corrupt ExtraField - $name" ; |
406 | |
407 | my $input = ''; |
408 | |
409 | for my $field (@$test) |
410 | { |
411 | my ($id, $len, $data) = @$field; |
412 | |
413 | $input .= $id if defined $id ; |
414 | $input .= pack("v", $len) if defined $len ; |
415 | $input .= $data if defined $data; |
416 | } |
417 | #hexDump(\$input); |
418 | |
419 | my $buffer ; |
420 | my $x ; |
421 | eval {$x = new IO::Compress::Gzip \$buffer, -ExtraField => $input, Strict => 1; }; |
422 | like $@, mkErr("$gzip_error"), " $name"; |
423 | like $GzipError, "/$gzip_error/", " $name"; |
424 | |
425 | ok ! $x, " IO::Compress::Gzip fails"; |
426 | like $GzipError, "/$gzip_error/", " $name"; |
427 | |
428 | foreach my $check (0, 1) |
429 | { |
c70c1701 |
430 | ok $x = new IO::Compress::Gzip \$buffer, |
431 | ExtraField => $input, |
432 | Strict => 0 |
433 | or diag "GzipError is $GzipError" ; |
25f0751f |
434 | my $string = "abcd" ; |
435 | $x->write($string) ; |
436 | $x->close ; |
437 | is anyUncompress(\$buffer), $string ; |
438 | |
c70c1701 |
439 | $x = new IO::Uncompress::Gunzip \$buffer, |
440 | Strict => 0, |
25f0751f |
441 | Transparent => 0, |
c70c1701 |
442 | ParseExtra => $check; |
25f0751f |
443 | if ($check) { |
444 | ok ! $x ; |
445 | like $GunzipError, "/^$gunzip_error/"; |
446 | } |
447 | else { |
448 | ok $x ; |
449 | } |
450 | |
451 | } |
452 | } |
453 | } |
454 | |
455 | |
456 | { |
457 | title 'Check Minimal'; |
458 | |
459 | ok my $x = new IO::Compress::Gzip $name, -Minimal => 1; |
460 | my $string = "abcd" ; |
461 | ok $x->write($string) ; |
462 | ok $x->close ; |
463 | #is GZreadFile($name), $string ; |
464 | |
465 | ok $x = new IO::Uncompress::Gunzip $name ; |
466 | my $hdr = $x->getHeaderInfo(); |
467 | ok $hdr; |
468 | ok $hdr->{Time} == 0; |
469 | is $hdr->{ExtraFlags}, 0; |
470 | ok ! defined $hdr->{Name} ; |
471 | ok ! defined $hdr->{ExtraFieldRaw} ; |
472 | ok ! defined $hdr->{Comment} ; |
473 | is $hdr->{OsName}, 'Unknown' ; |
474 | is $hdr->{MethodName}, "Deflated"; |
475 | is $hdr->{Flags}, 0; |
476 | ok $hdr->{isMinimalHeader} ; |
477 | ok ! $hdr->{TextFlag} ; |
478 | ok $x->close ; |
479 | } |
480 | |
481 | { |
482 | # Check Minimal + no comressed data |
483 | # This is the smallest possible gzip file (20 bytes) |
484 | |
485 | ok my $x = new IO::Compress::Gzip $name, -Minimal => 1; |
486 | ok $x->close ; |
487 | #ok GZreadFile($name) eq '' ; |
488 | |
489 | ok $x = new IO::Uncompress::Gunzip $name, -Append => 1 ; |
490 | my $data ; |
491 | my $status = 1; |
492 | |
493 | $status = $x->read($data) |
494 | while $status > 0; |
495 | is $status, 0 ; |
496 | is $data, ''; |
497 | ok ! $x->error() ; |
498 | ok $x->eof() ; |
499 | |
500 | my $hdr = $x->getHeaderInfo(); |
501 | ok $hdr; |
502 | |
503 | ok defined $hdr->{ISIZE} ; |
504 | is $hdr->{ISIZE}, 0; |
505 | |
506 | ok defined $hdr->{CRC32} ; |
507 | is $hdr->{CRC32}, 0; |
508 | |
509 | is $hdr->{Time}, 0; |
510 | ok ! defined $hdr->{Name} ; |
511 | ok ! defined $hdr->{ExtraFieldRaw} ; |
512 | ok ! defined $hdr->{Comment} ; |
513 | is $hdr->{OsName}, 'Unknown' ; |
514 | is $hdr->{MethodName}, "Deflated"; |
515 | is $hdr->{Flags}, 0; |
516 | ok $hdr->{isMinimalHeader} ; |
517 | ok ! $hdr->{TextFlag} ; |
518 | ok $x->close ; |
519 | } |
520 | |
521 | { |
522 | # Header Corruption Tests |
523 | |
524 | my $string = <<EOM; |
525 | some text |
526 | EOM |
527 | |
528 | my $good = ''; |
529 | ok my $x = new IO::Compress::Gzip \$good, -HeaderCRC => 1 ; |
530 | ok $x->write($string) ; |
531 | ok $x->close ; |
532 | |
533 | { |
534 | title "Header Corruption - Fingerprint wrong 1st byte" ; |
535 | my $buffer = $good ; |
536 | substr($buffer, 0, 1) = 'x' ; |
537 | |
538 | ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ; |
539 | ok $GunzipError =~ /Header Error: Bad Magic/; |
540 | } |
541 | |
542 | { |
543 | title "Header Corruption - Fingerprint wrong 2nd byte" ; |
544 | my $buffer = $good ; |
545 | substr($buffer, 1, 1) = "\xFF" ; |
546 | |
547 | ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ; |
548 | ok $GunzipError =~ /Header Error: Bad Magic/; |
549 | #print "$GunzipError\n"; |
550 | } |
551 | |
552 | { |
553 | title "Header Corruption - CM not 8"; |
554 | my $buffer = $good ; |
555 | substr($buffer, 2, 1) = 'x' ; |
556 | |
557 | ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ; |
558 | like $GunzipError, '/Header Error: Not Deflate \(CM is \d+\)/'; |
559 | } |
560 | |
561 | { |
562 | title "Header Corruption - Use of Reserved Flags"; |
563 | my $buffer = $good ; |
564 | substr($buffer, 3, 1) = "\xff"; |
565 | |
566 | ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ; |
567 | like $GunzipError, '/Header Error: Use of Reserved Bits in FLG field./'; |
568 | } |
569 | |
570 | { |
571 | title "Header Corruption - Fail HeaderCRC"; |
572 | my $buffer = $good ; |
573 | substr($buffer, 10, 1) = chr((ord(substr($buffer, 10, 1)) + 1) & 0xFF); |
574 | |
575 | ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0, Strict => 1 |
576 | or print "# $GunzipError\n"; |
577 | like $GunzipError, '/Header Error: CRC16 mismatch/' |
578 | #or diag "buffer length " . length($buffer); |
579 | or hexDump(\$good), hexDump(\$buffer); |
580 | } |
581 | } |
582 | |
583 | { |
584 | title "ExtraField max raw size"; |
585 | my $x ; |
586 | my $store = "x" x GZIP_FEXTRA_MAX_SIZE ; |
587 | my $z = new IO::Compress::Gzip(\$x, ExtraField => $store, Strict => 0) ; |
588 | ok $z, "Created IO::Compress::Gzip object" ; |
589 | my $gunz = new IO::Uncompress::Gunzip \$x, Strict => 0; |
590 | ok $gunz, "Created IO::Uncompress::Gunzip object" ; |
591 | my $hdr = $gunz->getHeaderInfo(); |
592 | ok $hdr; |
593 | |
594 | is $hdr->{ExtraFieldRaw}, $store ; |
595 | } |
596 | |
597 | { |
598 | title "Header Corruption - ExtraField too big"; |
599 | my $x; |
600 | eval { new IO::Compress::Gzip(\$x, -ExtraField => "x" x (GZIP_FEXTRA_MAX_SIZE + 1)) ;}; |
601 | like $@, mkErr('Error with ExtraField Parameter: Too Large'); |
602 | like $GzipError, '/Error with ExtraField Parameter: Too Large/'; |
603 | } |
604 | |
605 | { |
606 | title "Header Corruption - Create Name with Illegal Chars"; |
607 | |
608 | my $x; |
609 | eval { new IO::Compress::Gzip \$x, -Name => "fred\x02" }; |
610 | like $@, mkErr('Non ISO 8859-1 Character found in Name'); |
611 | like $GzipError, '/Non ISO 8859-1 Character found in Name/'; |
612 | |
613 | ok my $gz = new IO::Compress::Gzip \$x, |
614 | -Strict => 0, |
615 | -Name => "fred\x02" ; |
616 | ok $gz->close(); |
617 | |
618 | ok ! new IO::Uncompress::Gunzip \$x, |
619 | -Transparent => 0, |
620 | -Strict => 1; |
621 | |
622 | like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Name/'; |
623 | ok my $gunzip = new IO::Uncompress::Gunzip \$x, |
624 | -Strict => 0; |
625 | |
626 | my $hdr = $gunzip->getHeaderInfo() ; |
627 | |
628 | is $hdr->{Name}, "fred\x02"; |
629 | |
630 | } |
631 | |
632 | { |
633 | title "Header Corruption - Null Chars in Name"; |
634 | my $x; |
635 | eval { new IO::Compress::Gzip \$x, -Name => "\x00" }; |
636 | like $@, mkErr('Null Character found in Name'); |
637 | like $GzipError, '/Null Character found in Name/'; |
638 | |
639 | eval { new IO::Compress::Gzip \$x, -Name => "abc\x00" }; |
640 | like $@, mkErr('Null Character found in Name'); |
641 | like $GzipError, '/Null Character found in Name/'; |
642 | |
643 | ok my $gz = new IO::Compress::Gzip \$x, |
644 | -Strict => 0, |
645 | -Name => "abc\x00de" ; |
646 | ok $gz->close() ; |
647 | ok my $gunzip = new IO::Uncompress::Gunzip \$x, |
648 | -Strict => 0; |
649 | |
650 | my $hdr = $gunzip->getHeaderInfo() ; |
651 | |
652 | is $hdr->{Name}, "abc"; |
653 | |
654 | } |
655 | |
656 | { |
657 | title "Header Corruption - Create Comment with Illegal Chars"; |
658 | |
659 | my $x; |
660 | eval { new IO::Compress::Gzip \$x, -Comment => "fred\x02" }; |
661 | like $@, mkErr('Non ISO 8859-1 Character found in Comment'); |
662 | like $GzipError, '/Non ISO 8859-1 Character found in Comment/'; |
663 | |
664 | ok my $gz = new IO::Compress::Gzip \$x, |
665 | -Strict => 0, |
666 | -Comment => "fred\x02" ; |
667 | ok $gz->close(); |
668 | |
669 | ok ! new IO::Uncompress::Gunzip \$x, Strict => 1, |
670 | -Transparent => 0; |
671 | |
672 | like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Comment/'; |
673 | ok my $gunzip = new IO::Uncompress::Gunzip \$x, Strict => 0; |
674 | |
675 | my $hdr = $gunzip->getHeaderInfo() ; |
676 | |
677 | is $hdr->{Comment}, "fred\x02"; |
678 | |
679 | } |
680 | |
681 | { |
682 | title "Header Corruption - Null Char in Comment"; |
683 | my $x; |
684 | eval { new IO::Compress::Gzip \$x, -Comment => "\x00" }; |
685 | like $@, mkErr('Null Character found in Comment'); |
686 | like $GzipError, '/Null Character found in Comment/'; |
687 | |
688 | eval { new IO::Compress::Gzip \$x, -Comment => "abc\x00" } ; |
689 | like $@, mkErr('Null Character found in Comment'); |
690 | like $GzipError, '/Null Character found in Comment/'; |
691 | |
692 | ok my $gz = new IO::Compress::Gzip \$x, |
693 | -Strict => 0, |
694 | -Comment => "abc\x00de" ; |
695 | ok $gz->close() ; |
696 | ok my $gunzip = new IO::Uncompress::Gunzip \$x, |
697 | -Strict => 0; |
698 | |
699 | my $hdr = $gunzip->getHeaderInfo() ; |
700 | |
701 | is $hdr->{Comment}, "abc"; |
702 | |
703 | } |
704 | |
705 | |
706 | for my $index ( GZIP_MIN_HEADER_SIZE + 1 .. GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1) |
707 | { |
708 | title "Header Corruption - Truncated in Extra"; |
709 | my $string = <<EOM; |
710 | some text |
711 | EOM |
712 | |
713 | my $truncated ; |
714 | ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1, Strict => 0, |
715 | -ExtraField => "hello" x 10 ; |
716 | ok $x->write($string) ; |
717 | ok $x->close ; |
718 | |
719 | substr($truncated, $index) = '' ; |
720 | #my $lex = new LexFile my $name ; |
721 | #writeFile($name, $truncated) ; |
722 | |
723 | #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0; |
724 | my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; |
725 | ok ! $g |
726 | or print "# $g\n" ; |
727 | |
728 | like($GunzipError, '/^Header Error: Truncated in FEXTRA/'); |
729 | |
730 | |
731 | } |
732 | |
733 | my $Name = "fred" ; |
734 | my $truncated ; |
735 | for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Name) -1) |
736 | { |
737 | title "Header Corruption - Truncated in Name"; |
738 | my $string = <<EOM; |
739 | some text |
740 | EOM |
741 | |
742 | my $truncated ; |
743 | ok my $x = new IO::Compress::Gzip \$truncated, -Name => $Name; |
744 | ok $x->write($string) ; |
745 | ok $x->close ; |
746 | |
747 | substr($truncated, $index) = '' ; |
748 | |
749 | my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; |
750 | ok ! $g |
751 | or print "# $g\n" ; |
752 | |
753 | like $GunzipError, '/^Header Error: Truncated in FNAME Section/'; |
754 | |
755 | } |
756 | |
757 | my $Comment = "comment" ; |
758 | for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Comment) -1) |
759 | { |
760 | title "Header Corruption - Truncated in Comment"; |
761 | my $string = <<EOM; |
762 | some text |
763 | EOM |
764 | |
765 | my $truncated ; |
766 | ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment; |
767 | ok $x->write($string) ; |
768 | ok $x->close ; |
769 | |
770 | substr($truncated, $index) = '' ; |
771 | #my $lex = new LexFile my $name ; |
772 | #writeFile($name, $truncated) ; |
773 | |
774 | #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0; |
775 | my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; |
776 | ok ! $g |
777 | or print "# $g\n" ; |
778 | |
779 | like $GunzipError, '/^Header Error: Truncated in FCOMMENT Section/'; |
780 | |
781 | } |
782 | |
783 | for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1) |
784 | { |
785 | title "Header Corruption - Truncated in CRC"; |
786 | my $string = <<EOM; |
787 | some text |
788 | EOM |
789 | |
790 | my $truncated ; |
791 | ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1; |
792 | ok $x->write($string) ; |
793 | ok $x->close ; |
794 | |
795 | substr($truncated, $index) = '' ; |
796 | my $lex = new LexFile my $name ; |
797 | writeFile($name, $truncated) ; |
798 | |
799 | my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0; |
800 | #my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; |
801 | ok ! $g |
802 | or print "# $g\n" ; |
803 | |
804 | like $GunzipError, '/^Header Error: Truncated in FHCRC Section/'; |
805 | |
806 | } |
807 | |
808 | |
809 | { |
810 | # Trailer Corruption tests |
811 | |
812 | my $string = <<EOM; |
813 | some text |
814 | EOM |
815 | |
816 | my $good ; |
817 | { |
818 | ok my $x = new IO::Compress::Gzip \$good ; |
819 | ok $x->write($string) ; |
820 | ok $x->close ; |
821 | } |
822 | |
823 | writeFile($name, $good) ; |
824 | ok my $gunz = new IO::Uncompress::Gunzip $name, |
93d092e2 |
825 | -Append => 1, |
25f0751f |
826 | -Strict => 1; |
827 | my $uncomp ; |
828 | 1 while $gunz->read($uncomp) > 0 ; |
829 | ok $gunz->close() ; |
830 | ok $uncomp eq $string |
831 | or print "# got [$uncomp] wanted [$string]\n";; |
832 | |
833 | foreach my $trim (-8 .. -1) |
834 | { |
835 | my $got = $trim + 8 ; |
836 | title "Trailer Corruption - Trailer truncated to $got bytes" ; |
837 | my $buffer = $good ; |
838 | my $expected_trailing = substr($good, -8, 8) ; |
839 | substr($expected_trailing, $trim) = ''; |
840 | |
841 | substr($buffer, $trim) = ''; |
842 | writeFile($name, $buffer) ; |
843 | |
844 | foreach my $strict (0, 1) |
845 | { |
846 | ok my $gunz = new IO::Uncompress::Gunzip $name, -Strict => $strict ; |
847 | my $uncomp ; |
848 | if ($strict) |
849 | { |
850 | ok $gunz->read($uncomp) < 0 ; |
851 | like $GunzipError, "/Trailer Error: trailer truncated. Expected 8 bytes, got $got/"; |
852 | } |
853 | else |
854 | { |
855 | ok $gunz->read($uncomp) > 0 ; |
856 | ok ! $GunzipError ; |
857 | my $expected = substr($buffer, - $got); |
858 | is $gunz->trailingData(), $expected_trailing; |
859 | } |
860 | ok $gunz->eof() ; |
861 | ok $uncomp eq $string; |
862 | ok $gunz->close ; |
863 | } |
864 | |
865 | } |
866 | |
867 | { |
868 | title "Trailer Corruption - Length Wrong, CRC Correct" ; |
869 | my $buffer = $good ; |
870 | my $actual_len = unpack("V", substr($buffer, -4, 4)); |
871 | substr($buffer, -4, 4) = pack('V', $actual_len + 1); |
872 | writeFile($name, $buffer) ; |
873 | |
874 | foreach my $strict (0, 1) |
875 | { |
876 | ok my $gunz = new IO::Uncompress::Gunzip $name, |
877 | -Strict => $strict ; |
878 | my $uncomp ; |
879 | if ($strict) |
880 | { |
881 | ok $gunz->read($uncomp) < 0 ; |
882 | my $got_len = $actual_len + 1; |
883 | like $GunzipError, "/Trailer Error: ISIZE mismatch. Got $got_len, expected $actual_len/"; |
884 | } |
885 | else |
886 | { |
887 | ok $gunz->read($uncomp) > 0 ; |
888 | ok ! $GunzipError ; |
889 | #is $gunz->trailingData(), substr($buffer, - $got) ; |
890 | } |
891 | ok ! $gunz->trailingData() ; |
892 | ok $gunz->eof() ; |
893 | ok $uncomp eq $string; |
894 | ok $gunz->close ; |
895 | } |
896 | |
897 | } |
898 | |
899 | { |
900 | title "Trailer Corruption - Length Correct, CRC Wrong" ; |
901 | my $buffer = $good ; |
902 | my $actual_crc = unpack("V", substr($buffer, -8, 4)); |
903 | substr($buffer, -8, 4) = pack('V', $actual_crc+1); |
904 | writeFile($name, $buffer) ; |
905 | |
906 | foreach my $strict (0, 1) |
907 | { |
908 | ok my $gunz = new IO::Uncompress::Gunzip $name, |
909 | -Strict => $strict ; |
910 | my $uncomp ; |
911 | if ($strict) |
912 | { |
913 | ok $gunz->read($uncomp) < 0 ; |
914 | like $GunzipError, '/Trailer Error: CRC mismatch/'; |
915 | } |
916 | else |
917 | { |
918 | ok $gunz->read($uncomp) > 0 ; |
919 | ok ! $GunzipError ; |
920 | } |
921 | ok ! $gunz->trailingData() ; |
922 | ok $gunz->eof() ; |
923 | ok $uncomp eq $string; |
924 | ok $gunz->close ; |
925 | } |
926 | |
927 | } |
928 | |
929 | { |
930 | title "Trailer Corruption - Length Wrong, CRC Wrong" ; |
931 | my $buffer = $good ; |
932 | my $actual_len = unpack("V", substr($buffer, -4, 4)); |
933 | my $actual_crc = unpack("V", substr($buffer, -8, 4)); |
934 | substr($buffer, -4, 4) = pack('V', $actual_len+1); |
935 | substr($buffer, -8, 4) = pack('V', $actual_crc+1); |
936 | writeFile($name, $buffer) ; |
937 | |
938 | foreach my $strict (0, 1) |
939 | { |
940 | ok my $gunz = new IO::Uncompress::Gunzip $name, |
941 | -Strict => $strict ; |
942 | my $uncomp ; |
943 | if ($strict) |
944 | { |
945 | ok $gunz->read($uncomp) < 0 ; |
946 | like $GunzipError, '/Trailer Error: CRC mismatch/'; |
947 | } |
948 | else |
949 | { |
950 | ok $gunz->read($uncomp) > 0 ; |
951 | ok ! $GunzipError ; |
952 | } |
953 | ok $gunz->eof() ; |
954 | ok $uncomp eq $string; |
955 | ok $gunz->close ; |
956 | } |
957 | |
958 | } |
959 | } |
960 | |
961 | |
962 | |