Skip Menu |
 

This queue is for tickets about the Archive-Zip CPAN distribution.

Report information
The Basics
Id: 92782
Status: new
Priority: 0/
Queue: Archive-Zip

People
Owner: Nobody in particular
Requestors: spuelrich [...] posteo.de
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in:
  • 1.30
  • 1.37
Fixed in: (no value)



Subject: extractTree corrupts internal state of members with negative compression
Download (untitled) / with headers
text/plain 1.5k
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
Download zipper.pl
text/x-perl 1.4k
#!/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())) : '?'); } }


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.