projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
PATCH: 2 vms specific build files in perl @ 27383
[p5sagit/p5-mst-13.2.git] / ext / Compress / Zlib / t / 09gziphdr.t
CommitLineData
16816334 1BEGIN {
d695c1a1 2 if ($ENV{PERL_CORE}) {
16816334 3 chdir 't' if -d 't';
1a6a8453 4 @INC = ("../lib", "lib/compress");
16816334 5 }
6}
642e522c 7
8use lib 't';
9use strict;
10use warnings;
11use bytes;
12
13use Test::More ;
14use ZlibTestUtils;
15
16BEGIN {
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
38my $ThisOS_code = $Compress::Zlib::gzip_os_code;
39
9f2e3514 40my $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 164for 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;
523some text
524EOM
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
704for 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;
708some text
709EOM
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
731my $Name = "fred" ;
732 my $truncated ;
733for 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;
737some text
738EOM
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
755my $Comment = "comment" ;
756for 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;
760some text
761EOM
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
781for 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;
785some text
786EOM
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;
811some text
812EOM
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
Unnamed repository; edit this file to name it for gitweb.