| Subject: | extractTree corrupts internal state of members with negative compression |
I built a zip file, which contains binary file (DEFLATEd).
Those binary files are not compressable any more (either already zipped or random bytes).
Adding them DEFLATEd results in a negative compression ratio.
After using $zip->extractTree() the internal state of the members seems currupted.
Next access via $member->content() returns not the full data.
Please see attached sample code.
I tested with versions 1.30 and 1.37 using Active Perl 5.10.1-1008.
NB0003 > ./zipper.pl
version: 1.30
good: check/500.bin: 500
good: check/500.txt: 500
good: check/5000.bin: 5000
good: check/5000.txt: 5000
bad: check/500.bin: 495
bad: check/500.txt: 500
bad: check/5000.bin: 4995
bad: check/5000.txt: 5000
NB0003 > unzip -lv check.zip
Archive: check.zip
Length Method Size Cmpr Date Time CRC-32 Name
-------- ------ ------- ---- ---------- ----- -------- ----
0 Stored 0 0% 02-06-2014 12:36 00000000 check/
500 Defl:N 505 -1% 02-06-2014 12:36 7ec071d9 check/500.bin
500 Defl:N 8 98% 02-06-2014 12:36 0ab2ce51 check/500.txt
5000 Defl:N 5005 -0% 02-06-2014 12:36 b9fc6c19 check/5000.bin
5000 Defl:N 22 100% 02-06-2014 12:36 00dbf026 check/5000.txt
-------- ------- --- -------
11000 5540 50% 5 files
NB0003 > perl -v
This is perl, v5.10.1 built for MSWin32-x86-multi-thread
(with 4 registered patches, see perl -V for more detail)
Copyright 1987-2009, Larry Wall
Binary build 1008 [294165] provided by ActiveState http://www.ActiveState.com
Built Dec 9 2010 06:00:35
| Subject: | zipper.pl |
#!/opt/ActivePerl-5.10/bin/perl
use strict;
use warnings;
use v5.10.1;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use File::Path qw(rmtree);
say "version: $Archive::Zip::VERSION";
rmtree('check');
mkdir 'check';
sub genfile {
my ($size) = @_;
use bytes;
my $filename_bin = "check/$size.bin";
open my $fh, '>', $filename_bin or die "cannot open $filename_bin: $!";
binmode $fh;
print $fh join('',map {chr(int(rand(256)))} (1..$size));
close $fh;
my $filename_txt = "check/$size.txt";
open $fh, '>', $filename_txt or die "cannot open $filename_txt: $!";
binmode $fh;
print $fh ('x' x $size);
close $fh;
return ($filename_bin, $filename_txt);
}
my @files = map {genfile($_)} 500, 5000;
do {
unlink 'check.zip';
my $zip = Archive::Zip->new();
my $dir_member = $zip->addTree( 'check/' , 'check');
$zip->writeToFileNamed('check.zip');
};
for my $type (qw(good bad)) {
my $dir = "extractcheck-$type";
rmtree($dir);
mkdir($dir);
my $zip = Archive::Zip->new();
$zip->read( 'check.zip' );
if ($type eq 'bad') {
$zip->extractTree( 'check', $dir );
}
for (@files) {
my $member = $zip->memberNamed($_);
# ERROR OCCURS HERE
# if $type eq 'bad' the result of ->contents() is too small
say "$type: $_: ", ($member ? length(scalar($member->contents())) : '?');
}
}