��ѧۧݧ�ӧ�� ާ֧ߧ֧էا֧�

��ѧۧݧ�ӧ�� ާ֧ߧ֧էا֧� - ��֧էѧܧ�ڧ��ӧѧ�� - /home/ukubnwwtacc0unt/chapelbellstudios.com/uploads/cover/Zip.tar

��ѧ٧ѧ�
Constants.pm��0000644��00000007410�15204276132�0007062 0��ustar�00��package IO::Compress::Zip::Constants; use strict ; use warnings; require Exporter; our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS); $VERSION = '2.081'; @ISA = qw(Exporter); @EXPORT= qw( ZIP_CM_STORE ZIP_CM_DEFLATE ZIP_CM_BZIP2 ZIP_CM_LZMA ZIP_CM_PPMD ZIP_LOCAL_HDR_SIG ZIP_DATA_HDR_SIG ZIP_CENTRAL_HDR_SIG ZIP_END_CENTRAL_HDR_SIG ZIP64_END_CENTRAL_REC_HDR_SIG ZIP64_END_CENTRAL_LOC_HDR_SIG ZIP64_ARCHIVE_EXTRA_SIG ZIP64_DIGITAL_SIGNATURE_SIG ZIP_GP_FLAG_ENCRYPTED_MASK ZIP_GP_FLAG_STREAMING_MASK ZIP_GP_FLAG_PATCHED_MASK ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK ZIP_GP_FLAG_LZMA_EOS_PRESENT ZIP_GP_FLAG_LANGUAGE_ENCODING ZIP_EXTRA_ID_ZIP64 ZIP_EXTRA_ID_EXT_TIMESTAMP ZIP_EXTRA_ID_INFO_ZIP_UNIX2 ZIP_EXTRA_ID_INFO_ZIP_UNIXN ZIP_EXTRA_ID_INFO_ZIP_Upath ZIP_EXTRA_ID_INFO_ZIP_Ucom ZIP_EXTRA_ID_JAVA_EXE ZIP_OS_CODE_UNIX ZIP_OS_CODE_DEFAULT ZIP_IFA_TEXT_MASK %ZIP_CM_MIN_VERSIONS ZIP64_MIN_VERSION ZIP_A_RONLY ZIP_A_HIDDEN ZIP_A_SYSTEM ZIP_A_LABEL ZIP_A_DIR ZIP_A_ARCHIVE ); # Compression types supported use constant ZIP_CM_STORE => 0 ; use constant ZIP_CM_DEFLATE => 8 ; use constant ZIP_CM_BZIP2 => 12 ; use constant ZIP_CM_LZMA => 14 ; # Not Supported yet use constant ZIP_CM_PPMD => 98 ; # Not Supported yet # General Purpose Flag use constant ZIP_GP_FLAG_ENCRYPTED_MASK => (1 << 0) ; use constant ZIP_GP_FLAG_STREAMING_MASK => (1 << 3) ; use constant ZIP_GP_FLAG_PATCHED_MASK => (1 << 5) ; use constant ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK => (1 << 6) ; use constant ZIP_GP_FLAG_LZMA_EOS_PRESENT => (1 << 1) ; use constant ZIP_GP_FLAG_LANGUAGE_ENCODING => (1 << 11) ; # Internal File Attributes use constant ZIP_IFA_TEXT_MASK => 1; # Signatures for each of the headers use constant ZIP_LOCAL_HDR_SIG => 0x04034b50; use constant ZIP_DATA_HDR_SIG => 0x08074b50; use constant packed_ZIP_DATA_HDR_SIG => pack "V", ZIP_DATA_HDR_SIG; use constant ZIP_CENTRAL_HDR_SIG => 0x02014b50; use constant ZIP_END_CENTRAL_HDR_SIG => 0x06054b50; use constant ZIP64_END_CENTRAL_REC_HDR_SIG => 0x06064b50; use constant ZIP64_END_CENTRAL_LOC_HDR_SIG => 0x07064b50; use constant ZIP64_ARCHIVE_EXTRA_SIG => 0x08064b50; use constant ZIP64_DIGITAL_SIGNATURE_SIG => 0x05054b50; use constant ZIP_OS_CODE_UNIX => 3; use constant ZIP_OS_CODE_DEFAULT => 3; # Extra Field ID's use constant ZIP_EXTRA_ID_ZIP64 => pack "v", 1; use constant ZIP_EXTRA_ID_EXT_TIMESTAMP => "UT"; use constant ZIP_EXTRA_ID_INFO_ZIP_UNIX2 => "Ux"; use constant ZIP_EXTRA_ID_INFO_ZIP_UNIXN => "ux"; use constant ZIP_EXTRA_ID_INFO_ZIP_Upath => "up"; use constant ZIP_EXTRA_ID_INFO_ZIP_Ucom => "uc"; use constant ZIP_EXTRA_ID_JAVA_EXE => pack "v", 0xCAFE; # DOS Attributes use constant ZIP_A_RONLY => 0x01; use constant ZIP_A_HIDDEN => 0x02; use constant ZIP_A_SYSTEM => 0x04; use constant ZIP_A_LABEL => 0x08; use constant ZIP_A_DIR => 0x10; use constant ZIP_A_ARCHIVE => 0x20; use constant ZIP64_MIN_VERSION => 45; %ZIP_CM_MIN_VERSIONS = ( ZIP_CM_STORE() => 20, ZIP_CM_DEFLATE() => 20, ZIP_CM_BZIP2() => 46, ZIP_CM_LZMA() => 63, ZIP_CM_PPMD() => 63, ); 1; __END__ ��FileMember.pm��0000644��00000002472�15204347723�0007125 0��ustar�00��package Archive::Zip::FileMember; use strict; use vars qw( $VERSION @ISA ); BEGIN { $VERSION = '1.60'; @ISA = qw ( Archive::Zip::Member ); } use Archive::Zip qw( :UTILITY_METHODS ); sub externalFileName { shift->{'externalFileName'}; } # Return true if I depend on the named file sub _usesFileNamed { my $self = shift; my $fileName = shift; my $xfn = $self->externalFileName(); return undef if ref($xfn); return $xfn eq $fileName; } sub fh { my $self = shift; $self->_openFile() if !defined($self->{'fh'}) \|\| !$self->{'fh'}->opened(); return $self->{'fh'}; } # opens my file handle from my file name sub _openFile { my $self = shift; my ($status, $fh) = _newFileHandle($self->externalFileName(), 'r'); if (!$status) { _ioError("Can't open", $self->externalFileName()); return undef; } $self->{'fh'} = $fh; _binmode($fh); return $fh; } # Make sure I close my file handle sub endRead { my $self = shift; undef $self->{'fh'}; # _closeFile(); return $self->SUPER::endRead(@_); } sub _become { my $self = shift; my $newClass = shift; return $self if ref($self) eq $newClass; delete($self->{'externalFileName'}); delete($self->{'fh'}); return $self->SUPER::_become($newClass); } 1; ��NewFileMember.pm��0000644��00000004212�15204347723�0007571 0��ustar�00��package Archive::Zip::NewFileMember; use strict; use vars qw( $VERSION @ISA ); BEGIN { $VERSION = '1.60'; @ISA = qw ( Archive::Zip::FileMember ); } use Archive::Zip qw( :CONSTANTS :ERROR_CODES :UTILITY_METHODS ); # Given a file name, set up for eventual writing. sub _newFromFileNamed { my $class = shift; my $fileName = shift; # local FS format my $newName = shift; $newName = _asZipDirName($fileName) unless defined($newName); return undef unless (stat($fileName) && -r _ && !-d _ ); my $self = $class->new(@_); $self->{'fileName'} = $newName; $self->{'externalFileName'} = $fileName; $self->{'compressionMethod'} = COMPRESSION_STORED; my @stat = stat(_); $self->{'compressedSize'} = $self->{'uncompressedSize'} = $stat[7]; $self->desiredCompressionMethod( ($self->compressedSize() > 0) ? COMPRESSION_DEFLATED : COMPRESSION_STORED ); $self->unixFileAttributes($stat[2]); $self->setLastModFileDateTimeFromUnix($stat[9]); $self->isTextFile(-T _ ); return $self; } sub rewindData { my $self = shift; my $status = $self->SUPER::rewindData(@_); return $status unless $status == AZ_OK; return AZ_IO_ERROR unless $self->fh(); $self->fh()->clearerr(); $self->fh()->seek(0, IO::Seekable::SEEK_SET) or return _ioError("rewinding", $self->externalFileName()); return AZ_OK; } # Return bytes read. Note that first parameter is a ref to a buffer. # my $data; # my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize ); sub _readRawChunk { my ($self, $dataRef, $chunkSize) = @_; return (0, AZ_OK) unless $chunkSize; my $bytesRead = $self->fh()->read($$dataRef, $chunkSize) or return (0, _ioError("reading data")); return ($bytesRead, AZ_OK); } # If I already exist, extraction is a no-op. sub extractToFileNamed { my $self = shift; my $name = shift; # local FS name if (File::Spec->rel2abs($name) eq File::Spec->rel2abs($self->externalFileName()) and -r $name) { return AZ_OK; } else { return $self->SUPER::extractToFileNamed($name, @_); } } 1; ��BufferedFileHandle.pm��0000644��00000005272�15204347723�0010555 0��ustar�00��package Archive::Zip::BufferedFileHandle; # File handle that uses a string internally and can seek # This is given as a demo for getting a zip file written # to a string. # I probably should just use IO::Scalar instead. # Ned Konz, March 2000 use strict; use IO::File; use Carp; use vars qw{$VERSION}; BEGIN { $VERSION = '1.60'; $VERSION = eval $VERSION; } sub new { my $class = shift \|\| __PACKAGE__; $class = ref($class) \|\| $class; my $self = bless( { content => '', position => 0, size => 0 }, $class ); return $self; } # Utility method to read entire file sub readFromFile { my $self = shift; my $fileName = shift; my $fh = IO::File->new($fileName, "r"); CORE::binmode($fh); if (!$fh) { Carp::carp("Can't open $fileName: $!\n"); return undef; } local $/ = undef; $self->{content} = <$fh>; $self->{size} = length($self->{content}); return $self; } sub contents { my $self = shift; if (@_) { $self->{content} = shift; $self->{size} = length($self->{content}); } return $self->{content}; } sub binmode { 1 } sub close { 1 } sub opened { 1 } sub eof { my $self = shift; return $self->{position} >= $self->{size}; } sub seek { my $self = shift; my $pos = shift; my $whence = shift; # SEEK_SET if ($whence == 0) { $self->{position} = $pos; } # SEEK_CUR elsif ($whence == 1) { $self->{position} += $pos; } # SEEK_END elsif ($whence == 2) { $self->{position} = $self->{size} + $pos; } else { return 0; } return 1; } sub tell { return shift->{position}; } # Copy my data to given buffer sub read { my $self = shift; my $buf = \($_[0]); shift; my $len = shift; my $offset = shift \|\| 0; $$buf = '' if not defined($$buf); my $bytesRead = ($self->{position} + $len > $self->{size}) ? ($self->{size} - $self->{position}) : $len; substr($$buf, $offset, $bytesRead) = substr($self->{content}, $self->{position}, $bytesRead); $self->{position} += $bytesRead; return $bytesRead; } # Copy given buffer to me sub write { my $self = shift; my $buf = \($_[0]); shift; my $len = shift; my $offset = shift \|\| 0; $$buf = '' if not defined($$buf); my $bufLen = length($$buf); my $bytesWritten = ($offset + $len > $bufLen) ? $bufLen - $offset : $len; substr($self->{content}, $self->{position}, $bytesWritten) = substr($$buf, $offset, $bytesWritten); $self->{size} = length($self->{content}); return $bytesWritten; } sub clearerr() { 1 } 1; ��StringMember.pm��0000644��00000003264�15204347723�0007514 0��ustar�00��package Archive::Zip::StringMember; use strict; use vars qw( $VERSION @ISA ); BEGIN { $VERSION = '1.60'; @ISA = qw( Archive::Zip::Member ); } use Archive::Zip qw( :CONSTANTS :ERROR_CODES ); # Create a new string member. Default is COMPRESSION_STORED. # Can take a ref to a string as well. sub _newFromString { my $class = shift; my $string = shift; my $name = shift; my $self = $class->new(@_); $self->contents($string); $self->fileName($name) if defined($name); # Set the file date to now $self->setLastModFileDateTimeFromUnix(time()); $self->unixFileAttributes($self->DEFAULT_FILE_PERMISSIONS); return $self; } sub _become { my $self = shift; my $newClass = shift; return $self if ref($self) eq $newClass; delete($self->{'contents'}); return $self->SUPER::_become($newClass); } # Get or set my contents. Note that we do not call the superclass # version of this, because it calls us. sub contents { my $self = shift; my $string = shift; if (defined($string)) { $self->{'contents'} = pack('C0a', (ref($string) eq 'SCALAR') ? $$string : $string); $self->{'uncompressedSize'} = $self->{'compressedSize'} = length($self->{'contents'}); $self->{'compressionMethod'} = COMPRESSION_STORED; } return $self->{'contents'}; } # Return bytes read. Note that first parameter is a ref to a buffer. # my $data; # my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize ); sub _readRawChunk { my ($self, $dataRef, $chunkSize) = @_; $$dataRef = substr($self->contents(), $self->_readOffset(), $chunkSize); return (length($$dataRef), AZ_OK); } 1; ��DirectoryMember.pm��0000644��00000003676�15204347723�0010221 0��ustar�00��package Archive::Zip::DirectoryMember; use strict; use File::Path; use vars qw( $VERSION @ISA ); BEGIN { $VERSION = '1.60'; @ISA = qw( Archive::Zip::Member ); } use Archive::Zip qw( :ERROR_CODES :UTILITY_METHODS ); sub _newNamed { my $class = shift; my $fileName = shift; # FS name my $newName = shift; # Zip name $newName = _asZipDirName($fileName) unless $newName; my $self = $class->new(@_); $self->{'externalFileName'} = $fileName; $self->fileName($newName); if (-e $fileName) { # -e does NOT do a full stat, so we need to do one now if (-d _ ) { my @stat = stat(_); $self->unixFileAttributes($stat[2]); my $mod_t = $stat[9]; if ($^O eq 'MSWin32' and !$mod_t) { $mod_t = time(); } $self->setLastModFileDateTimeFromUnix($mod_t); } else { # hmm.. trying to add a non-directory? _error($fileName, ' exists but is not a directory'); return undef; } } else { $self->unixFileAttributes($self->DEFAULT_DIRECTORY_PERMISSIONS); $self->setLastModFileDateTimeFromUnix(time()); } return $self; } sub externalFileName { shift->{'externalFileName'}; } sub isDirectory { return 1; } sub extractToFileNamed { my $self = shift; my $name = shift; # local FS name my $attribs = $self->unixFileAttributes() & 07777; mkpath($name, 0, $attribs); # croaks on error utime($self->lastModTime(), $self->lastModTime(), $name); return AZ_OK; } sub fileName { my $self = shift; my $newName = shift; $newName =~ s{/?$}{/} if defined($newName); return $self->SUPER::fileName($newName); } # So people don't get too confused. This way it looks like the problem # is in their code... sub contents { return wantarray ? (undef, AZ_OK) : undef; } 1; ��Archive.pm��0000644��00000077125�15204347723�0006506 0��ustar�00��package Archive::Zip::Archive; # Represents a generic ZIP archive use strict; use File::Path; use File::Find (); use File::Spec (); use File::Copy (); use File::Basename; use Cwd; use Encode qw(encode_utf8 decode_utf8); use vars qw( $VERSION @ISA ); BEGIN { $VERSION = '1.60'; @ISA = qw( Archive::Zip ); } use Archive::Zip qw( :CONSTANTS :ERROR_CODES :PKZIP_CONSTANTS :UTILITY_METHODS ); our $UNICODE; # Note that this returns undef on read errors, else new zip object. sub new { my $class = shift; my $self = bless( { 'diskNumber' => 0, 'diskNumberWithStartOfCentralDirectory' => 0, 'numberOfCentralDirectoriesOnThisDisk' => 0, # should be # of members 'numberOfCentralDirectories' => 0, # should be # of members 'centralDirectorySize' => 0, # must re-compute on write 'centralDirectoryOffsetWRTStartingDiskNumber' => 0, # must re-compute 'writeEOCDOffset' => 0, 'writeCentralDirectoryOffset' => 0, 'zipfileComment' => '', 'eocdOffset' => 0, 'fileName' => '' }, $class ); $self->{'members'} = []; my $fileName = (ref($_[0]) eq 'HASH') ? shift->{filename} : shift; if ($fileName) { my $status = $self->read($fileName); return $status == AZ_OK ? $self : undef; } return $self; } sub storeSymbolicLink { my $self = shift; $self->{'storeSymbolicLink'} = shift; } sub members { @{shift->{'members'}}; } sub numberOfMembers { scalar(shift->members()); } sub memberNames { my $self = shift; return map { $_->fileName() } $self->members(); } # return ref to member with given name or undef sub memberNamed { my $self = shift; my $fileName = (ref($_[0]) eq 'HASH') ? shift->{zipName} : shift; foreach my $member ($self->members()) { return $member if $member->fileName() eq $fileName; } return undef; } sub membersMatching { my $self = shift; my $pattern = (ref($_[0]) eq 'HASH') ? shift->{regex} : shift; return grep { $_->fileName() =~ /$pattern/ } $self->members(); } sub diskNumber { shift->{'diskNumber'}; } sub diskNumberWithStartOfCentralDirectory { shift->{'diskNumberWithStartOfCentralDirectory'}; } sub numberOfCentralDirectoriesOnThisDisk { shift->{'numberOfCentralDirectoriesOnThisDisk'}; } sub numberOfCentralDirectories { shift->{'numberOfCentralDirectories'}; } sub centralDirectorySize { shift->{'centralDirectorySize'}; } sub centralDirectoryOffsetWRTStartingDiskNumber { shift->{'centralDirectoryOffsetWRTStartingDiskNumber'}; } sub zipfileComment { my $self = shift; my $comment = $self->{'zipfileComment'}; if (@_) { my $new_comment = (ref($_[0]) eq 'HASH') ? shift->{comment} : shift; $self->{'zipfileComment'} = pack('C0a', $new_comment); # avoid Unicode } return $comment; } sub eocdOffset { shift->{'eocdOffset'}; } # Return the name of the file last read. sub fileName { shift->{'fileName'}; } sub removeMember { my $self = shift; my $member = (ref($_[0]) eq 'HASH') ? shift->{memberOrZipName} : shift; $member = $self->memberNamed($member) unless ref($member); return undef unless $member; my @newMembers = grep { $_ != $member } $self->members(); $self->{'members'} = \@newMembers; return $member; } sub replaceMember { my $self = shift; my ($oldMember, $newMember); if (ref($_[0]) eq 'HASH') { $oldMember = $_[0]->{memberOrZipName}; $newMember = $_[0]->{newMember}; } else { ($oldMember, $newMember) = @_; } $oldMember = $self->memberNamed($oldMember) unless ref($oldMember); return undef unless $oldMember; return undef unless $newMember; my @newMembers = map { ($_ == $oldMember) ? $newMember : $_ } $self->members(); $self->{'members'} = \@newMembers; return $oldMember; } sub extractMember { my $self = shift; my ($member, $name); if (ref($_[0]) eq 'HASH') { $member = $_[0]->{memberOrZipName}; $name = $_[0]->{name}; } else { ($member, $name) = @_; } $member = $self->memberNamed($member) unless ref($member); return _error('member not found') unless $member; my $originalSize = $member->compressedSize(); my ($volumeName, $dirName, $fileName); if (defined($name)) { ($volumeName, $dirName, $fileName) = File::Spec->splitpath($name); $dirName = File::Spec->catpath($volumeName, $dirName, ''); } else { $name = $member->fileName(); if ((my $ret = _extractionNameIsSafe($name)) != AZ_OK) { return $ret; } ($dirName = $name) =~ s{[^/]$}{}; $dirName = Archive::Zip::_asLocalName($dirName); $name = Archive::Zip::_asLocalName($name); } if ($dirName && !-d $dirName) { mkpath($dirName); return _ioError("can't create dir $dirName") if (!-d $dirName); } my $rc = $member->extractToFileNamed($name, @_); # TODO refactor this fix into extractToFileNamed() $member->{'compressedSize'} = $originalSize; return $rc; } sub extractMemberWithoutPaths { my $self = shift; my ($member, $name); if (ref($_[0]) eq 'HASH') { $member = $_[0]->{memberOrZipName}; $name = $_[0]->{name}; } else { ($member, $name) = @_; } $member = $self->memberNamed($member) unless ref($member); return _error('member not found') unless $member; my $originalSize = $member->compressedSize(); return AZ_OK if $member->isDirectory(); unless ($name) { $name = $member->fileName(); $name =~ s{./}{}; # strip off directories, if any if ((my $ret = _extractionNameIsSafe($name)) != AZ_OK) { return $ret; } $name = Archive::Zip::_asLocalName($name); } my $rc = $member->extractToFileNamed($name, @_); $member->{'compressedSize'} = $originalSize; return $rc; } sub addMember { my $self = shift; my $newMember = (ref($_[0]) eq 'HASH') ? shift->{member} : shift; push(@{$self->{'members'}}, $newMember) if $newMember; if($newMember && ($newMember->{bitFlag} & 0x800) && !utf8::is_utf8($newMember->{fileName})){ $newMember->{fileName} = Encode::decode_utf8( $newMember->{fileName} ); } return $newMember; } sub addFile { my $self = shift; my ($fileName, $newName, $compressionLevel); if (ref($_[0]) eq 'HASH') { $fileName = $_[0]->{filename}; $newName = $_[0]->{zipName}; $compressionLevel = $_[0]->{compressionLevel}; } else { ($fileName, $newName, $compressionLevel) = @_; } if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { $fileName = Win32::GetANSIPathName($fileName); } my $newMember = Archive::Zip::Member->newFromFile($fileName, $newName); $newMember->desiredCompressionLevel($compressionLevel); if ($self->{'storeSymbolicLink'} && -l $fileName) { my $newMember = Archive::Zip::Member->newFromString(readlink $fileName, $newName); # For symbolic links, External File Attribute is set to 0xA1FF0000 by Info-ZIP $newMember->{'externalFileAttributes'} = 0xA1FF0000; $self->addMember($newMember); } else { $self->addMember($newMember); } return $newMember; } sub addString { my $self = shift; my ($stringOrStringRef, $name, $compressionLevel); if (ref($_[0]) eq 'HASH') { $stringOrStringRef = $_[0]->{string}; $name = $_[0]->{zipName}; $compressionLevel = $_[0]->{compressionLevel}; } else { ($stringOrStringRef, $name, $compressionLevel) = @_; } my $newMember = Archive::Zip::Member->newFromString($stringOrStringRef, $name); $newMember->desiredCompressionLevel($compressionLevel); return $self->addMember($newMember); } sub addDirectory { my $self = shift; my ($name, $newName); if (ref($_[0]) eq 'HASH') { $name = $_[0]->{directoryName}; $newName = $_[0]->{zipName}; } else { ($name, $newName) = @_; } if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { $name = Win32::GetANSIPathName($name); } my $newMember = Archive::Zip::Member->newDirectoryNamed($name, $newName); if ($self->{'storeSymbolicLink'} && -l $name) { my $link = readlink $name; ($newName =~ s{/$}{}) if $newName; # Strip trailing / my $newMember = Archive::Zip::Member->newFromString($link, $newName); # For symbolic links, External File Attribute is set to 0xA1FF0000 by Info-ZIP $newMember->{'externalFileAttributes'} = 0xA1FF0000; $self->addMember($newMember); } else { $self->addMember($newMember); } return $newMember; } # add either a file or a directory. sub addFileOrDirectory { my $self = shift; my ($name, $newName, $compressionLevel); if (ref($_[0]) eq 'HASH') { $name = $_[0]->{name}; $newName = $_[0]->{zipName}; $compressionLevel = $_[0]->{compressionLevel}; } else { ($name, $newName, $compressionLevel) = @_; } if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { $name = Win32::GetANSIPathName($name); } $name =~ s{/$}{}; if ($newName) { $newName =~ s{/$}{}; } else { $newName = $name; } if (-f $name) { return $self->addFile($name, $newName, $compressionLevel); } elsif (-d $name) { return $self->addDirectory($name, $newName); } else { return _error("$name is neither a file nor a directory"); } } sub contents { my $self = shift; my ($member, $newContents); if (ref($_[0]) eq 'HASH') { $member = $_[0]->{memberOrZipName}; $newContents = $_[0]->{contents}; } else { ($member, $newContents) = @_; } return _error('No member name given') unless $member; $member = $self->memberNamed($member) unless ref($member); return undef unless $member; return $member->contents($newContents); } sub writeToFileNamed { my $self = shift; my $fileName = (ref($_[0]) eq 'HASH') ? shift->{filename} : shift; # local FS format foreach my $member ($self->members()) { if ($member->_usesFileNamed($fileName)) { return _error("$fileName is needed by member " . $member->fileName() . "; consider using overwrite() or overwriteAs() instead."); } } my ($status, $fh) = _newFileHandle($fileName, 'w'); return _ioError("Can't open $fileName for write") unless $status; my $retval = $self->writeToFileHandle($fh, 1); $fh->close(); $fh = undef; return $retval; } # It is possible to write data to the FH before calling this, # perhaps to make a self-extracting archive. sub writeToFileHandle { my $self = shift; my ($fh, $fhIsSeekable); if (ref($_[0]) eq 'HASH') { $fh = $_[0]->{fileHandle}; $fhIsSeekable = exists($_[0]->{seek}) ? $_[0]->{seek} : _isSeekable($fh); } else { $fh = shift; $fhIsSeekable = @_ ? shift : _isSeekable($fh); } return _error('No filehandle given') unless $fh; return _ioError('filehandle not open') unless $fh->opened(); _binmode($fh); # Find out where the current position is. my $offset = $fhIsSeekable ? $fh->tell() : 0; $offset = 0 if $offset < 0; foreach my $member ($self->members()) { my $retval = $member->_writeToFileHandle($fh, $fhIsSeekable, $offset); $member->endRead(); return $retval if $retval != AZ_OK; $offset += $member->_localHeaderSize() + $member->_writeOffset(); $offset += $member->hasDataDescriptor() ? DATA_DESCRIPTOR_LENGTH + SIGNATURE_LENGTH : 0; # changed this so it reflects the last successful position $self->{'writeCentralDirectoryOffset'} = $offset; } return $self->writeCentralDirectory($fh); } # Write zip back to the original file, # as safely as possible. # Returns AZ_OK if successful. sub overwrite { my $self = shift; return $self->overwriteAs($self->{'fileName'}); } # Write zip to the specified file, # as safely as possible. # Returns AZ_OK if successful. sub overwriteAs { my $self = shift; my $zipName = (ref($_[0]) eq 'HASH') ? $_[0]->{filename} : shift; return _error("no filename in overwriteAs()") unless defined($zipName); my ($fh, $tempName) = Archive::Zip::tempFile(); return _error("Can't open temp file", $!) unless $fh; (my $backupName = $zipName) =~ s{(\.[^.])?$}{.zbk}; my $status = $self->writeToFileHandle($fh); $fh->close(); $fh = undef; if ($status != AZ_OK) { unlink($tempName); _printError("Can't write to $tempName"); return $status; } my $err; # rename the zip if (-f $zipName && !rename($zipName, $backupName)) { $err = $!; unlink($tempName); return _error("Can't rename $zipName as $backupName", $err); } # move the temp to the original name (possibly copying) unless (File::Copy::move($tempName, $zipName) \|\| File::Copy::copy($tempName, $zipName)) { $err = $!; rename($backupName, $zipName); unlink($tempName); return _error("Can't move $tempName to $zipName", $err); } # unlink the backup if (-f $backupName && !unlink($backupName)) { $err = $!; return _error("Can't unlink $backupName", $err); } return AZ_OK; } # Used only during writing sub _writeCentralDirectoryOffset { shift->{'writeCentralDirectoryOffset'}; } sub _writeEOCDOffset { shift->{'writeEOCDOffset'}; } # Expects to have _writeEOCDOffset() set sub _writeEndOfCentralDirectory { my ($self, $fh) = @_; $self->_print($fh, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING) or return _ioError('writing EOCD Signature'); my $zipfileCommentLength = length($self->zipfileComment()); my $header = pack( END_OF_CENTRAL_DIRECTORY_FORMAT, 0, # {'diskNumber'}, 0, # {'diskNumberWithStartOfCentralDirectory'}, $self->numberOfMembers(), # {'numberOfCentralDirectoriesOnThisDisk'}, $self->numberOfMembers(), # {'numberOfCentralDirectories'}, $self->_writeEOCDOffset() - $self->_writeCentralDirectoryOffset(), $self->_writeCentralDirectoryOffset(), $zipfileCommentLength ); $self->_print($fh, $header) or return _ioError('writing EOCD header'); if ($zipfileCommentLength) { $self->_print($fh, $self->zipfileComment()) or return _ioError('writing zipfile comment'); } return AZ_OK; } # $offset can be specified to truncate a zip file. sub writeCentralDirectory { my $self = shift; my ($fh, $offset); if (ref($_[0]) eq 'HASH') { $fh = $_[0]->{fileHandle}; $offset = $_[0]->{offset}; } else { ($fh, $offset) = @_; } if (defined($offset)) { $self->{'writeCentralDirectoryOffset'} = $offset; $fh->seek($offset, IO::Seekable::SEEK_SET) or return _ioError('seeking to write central directory'); } else { $offset = $self->_writeCentralDirectoryOffset(); } foreach my $member ($self->members()) { my $status = $member->_writeCentralDirectoryFileHeader($fh); return $status if $status != AZ_OK; $offset += $member->_centralDirectoryHeaderSize(); $self->{'writeEOCDOffset'} = $offset; } return $self->_writeEndOfCentralDirectory($fh); } sub read { my $self = shift; my $fileName = (ref($_[0]) eq 'HASH') ? shift->{filename} : shift; return _error('No filename given') unless $fileName; my ($status, $fh) = _newFileHandle($fileName, 'r'); return _ioError("opening $fileName for read") unless $status; $status = $self->readFromFileHandle($fh, $fileName); return $status if $status != AZ_OK; $fh->close(); $self->{'fileName'} = $fileName; return AZ_OK; } sub readFromFileHandle { my $self = shift; my ($fh, $fileName); if (ref($_[0]) eq 'HASH') { $fh = $_[0]->{fileHandle}; $fileName = $_[0]->{filename}; } else { ($fh, $fileName) = @_; } $fileName = $fh unless defined($fileName); return _error('No filehandle given') unless $fh; return _ioError('filehandle not open') unless $fh->opened(); _binmode($fh); $self->{'fileName'} = "$fh"; # TODO: how to support non-seekable zips? return _error('file not seekable') unless _isSeekable($fh); $fh->seek(0, 0); # rewind the file my $status = $self->_findEndOfCentralDirectory($fh); return $status if $status != AZ_OK; my $eocdPosition = $fh->tell(); $status = $self->_readEndOfCentralDirectory($fh); return $status if $status != AZ_OK; $fh->seek($eocdPosition - $self->centralDirectorySize(), IO::Seekable::SEEK_SET) or return _ioError("Can't seek $fileName"); # Try to detect garbage at beginning of archives # This should be 0 $self->{'eocdOffset'} = $eocdPosition - $self->centralDirectorySize() # here - $self->centralDirectoryOffsetWRTStartingDiskNumber(); for (; ;) { my $newMember = Archive::Zip::Member->_newFromZipFile($fh, $fileName, $self->eocdOffset()); my $signature; ($status, $signature) = _readSignature($fh, $fileName); return $status if $status != AZ_OK; last if $signature == END_OF_CENTRAL_DIRECTORY_SIGNATURE; $status = $newMember->_readCentralDirectoryFileHeader(); return $status if $status != AZ_OK; $status = $newMember->endRead(); return $status if $status != AZ_OK; $newMember->_becomeDirectoryIfNecessary(); if(($newMember->{bitFlag} & 0x800) && !utf8::is_utf8($newMember->{fileName})){ $newMember->{fileName} = Encode::decode_utf8($newMember->{fileName}); } push(@{$self->{'members'}}, $newMember); } return AZ_OK; } # Read EOCD, starting from position before signature. # Return AZ_OK on success. sub _readEndOfCentralDirectory { my $self = shift; my $fh = shift; # Skip past signature $fh->seek(SIGNATURE_LENGTH, IO::Seekable::SEEK_CUR) or return _ioError("Can't seek past EOCD signature"); my $header = ''; my $bytesRead = $fh->read($header, END_OF_CENTRAL_DIRECTORY_LENGTH); if ($bytesRead != END_OF_CENTRAL_DIRECTORY_LENGTH) { return _ioError("reading end of central directory"); } my $zipfileCommentLength; ( $self->{'diskNumber'}, $self->{'diskNumberWithStartOfCentralDirectory'}, $self->{'numberOfCentralDirectoriesOnThisDisk'}, $self->{'numberOfCentralDirectories'}, $self->{'centralDirectorySize'}, $self->{'centralDirectoryOffsetWRTStartingDiskNumber'}, $zipfileCommentLength ) = unpack(END_OF_CENTRAL_DIRECTORY_FORMAT, $header); if ($self->{'diskNumber'} == 0xFFFF \|\| $self->{'diskNumberWithStartOfCentralDirectory'} == 0xFFFF \|\| $self->{'numberOfCentralDirectoriesOnThisDisk'} == 0xFFFF \|\| $self->{'numberOfCentralDirectories'} == 0xFFFF \|\| $self->{'centralDirectorySize'} == 0xFFFFFFFF \|\| $self->{'centralDirectoryOffsetWRTStartingDiskNumber'} == 0xFFFFFFFF) { return _formatError("zip64 not supported" . Dumper($self)); } use Data::Dumper; if ($zipfileCommentLength) { my $zipfileComment = ''; $bytesRead = $fh->read($zipfileComment, $zipfileCommentLength); if ($bytesRead != $zipfileCommentLength) { return _ioError("reading zipfile comment"); } $self->{'zipfileComment'} = $zipfileComment; } return AZ_OK; } # Seek in my file to the end, then read backwards until we find the # signature of the central directory record. Leave the file positioned right # before the signature. Returns AZ_OK if success. sub _findEndOfCentralDirectory { my $self = shift; my $fh = shift; my $data = ''; $fh->seek(0, IO::Seekable::SEEK_END) or return _ioError("seeking to end"); my $fileLength = $fh->tell(); if ($fileLength < END_OF_CENTRAL_DIRECTORY_LENGTH + 4) { return _formatError("file is too short"); } my $seekOffset = 0; my $pos = -1; for (; ;) { $seekOffset += 512; $seekOffset = $fileLength if ($seekOffset > $fileLength); $fh->seek(-$seekOffset, IO::Seekable::SEEK_END) or return _ioError("seek failed"); my $bytesRead = $fh->read($data, $seekOffset); if ($bytesRead != $seekOffset) { return _ioError("read failed"); } $pos = rindex($data, END_OF_CENTRAL_DIRECTORY_SIGNATURE_STRING); last if ( $pos >= 0 or $seekOffset == $fileLength or $seekOffset >= $Archive::Zip::ChunkSize); } if ($pos >= 0) { $fh->seek($pos - $seekOffset, IO::Seekable::SEEK_CUR) or return _ioError("seeking to EOCD"); return AZ_OK; } else { return _formatError("can't find EOCD signature"); } } # Used to avoid taint problems when chdir'ing. # Not intended to increase security in any way; just intended to shut up the -T # complaints. If your Cwd module is giving you unreliable returns from cwd() # you have bigger problems than this. sub _untaintDir { my $dir = shift; $dir =~ m/\A(.+)\z/s; return $1; } sub addTree { my $self = shift; my ($root, $dest, $pred, $compressionLevel); if (ref($_[0]) eq 'HASH') { $root = $_[0]->{root}; $dest = $_[0]->{zipName}; $pred = $_[0]->{select}; $compressionLevel = $_[0]->{compressionLevel}; } else { ($root, $dest, $pred, $compressionLevel) = @_; } return _error("root arg missing in call to addTree()") unless defined($root); $dest = '' unless defined($dest); $pred = sub { -r } unless defined($pred); my @files; my $startDir = _untaintDir(cwd()); return _error('undef returned by _untaintDir on cwd ', cwd()) unless $startDir; # This avoids chdir'ing in Find, in a way compatible with older # versions of File::Find. my $wanted = sub { local $main::_ = $File::Find::name; my $dir = _untaintDir($File::Find::dir); chdir($startDir); if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { push(@files, Win32::GetANSIPathName($File::Find::name)) if (&$pred); $dir = Win32::GetANSIPathName($dir); } else { push(@files, $File::Find::name) if (&$pred); } chdir($dir); }; if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { $root = Win32::GetANSIPathName($root); } File::Find::find($wanted, $root); my $rootZipName = _asZipDirName($root, 1); # with trailing slash my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E"; $dest = _asZipDirName($dest, 1); # with trailing slash foreach my $fileName (@files) { my $isDir; if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { $isDir = -d Win32::GetANSIPathName($fileName); } else { $isDir = -d $fileName; } # normalize, remove leading ./ my $archiveName = _asZipDirName($fileName, $isDir); if ($archiveName eq $rootZipName) { $archiveName = $dest } else { $archiveName =~ s{$pattern}{$dest} } next if $archiveName =~ m{^\.?/?$}; # skip current dir my $member = $isDir ? $self->addDirectory($fileName, $archiveName) : $self->addFile($fileName, $archiveName); $member->desiredCompressionLevel($compressionLevel); return _error("add $fileName failed in addTree()") if !$member; } return AZ_OK; } sub addTreeMatching { my $self = shift; my ($root, $dest, $pattern, $pred, $compressionLevel); if (ref($_[0]) eq 'HASH') { $root = $_[0]->{root}; $dest = $_[0]->{zipName}; $pattern = $_[0]->{pattern}; $pred = $_[0]->{select}; $compressionLevel = $_[0]->{compressionLevel}; } else { ($root, $dest, $pattern, $pred, $compressionLevel) = @_; } return _error("root arg missing in call to addTreeMatching()") unless defined($root); $dest = '' unless defined($dest); return _error("pattern missing in call to addTreeMatching()") unless defined($pattern); my $matcher = $pred ? sub { m{$pattern} && &$pred } : sub { m{$pattern} && -r }; return $self->addTree($root, $dest, $matcher, $compressionLevel); } # Check if one of the components of a path to the file or the file name # itself is an already existing symbolic link. If yes then return an # error. Continuing and writing to a file traversing a link posseses # a security threat, especially if the link was extracted from an # attacker-supplied archive. This would allow writing to an arbitrary # file. The same applies when using ".." to escape from a working # directory. <https://bugzilla.redhat.com/show_bug.cgi?id=1591449> sub _extractionNameIsSafe { my $name = shift; my ($volume, $directories) = File::Spec->splitpath($name, 1); my @directories = File::Spec->splitdir($directories); if (grep '..' eq $_, @directories) { return _error( "Could not extract $name safely: a parent directory is used"); } my @path; my $path; for my $directory (@directories) { push @path, $directory; $path = File::Spec->catpath($volume, File::Spec->catdir(@path), ''); if (-l $path) { return _error( "Could not extract $name safely: $path is an existing symbolic link"); } if (!-e $path) { last; } } return AZ_OK; } # $zip->extractTree( $root, $dest [, $volume] ); # # $root and $dest are Unix-style. # $volume is in local FS format. # sub extractTree { my $self = shift; my ($root, $dest, $volume); if (ref($_[0]) eq 'HASH') { $root = $_[0]->{root}; $dest = $_[0]->{zipName}; $volume = $_[0]->{volume}; } else { ($root, $dest, $volume) = @_; } $root = '' unless defined($root); if (defined $dest) { if ($dest !~ m{/$}) { $dest .= '/'; } } else { $dest = './'; } my $pattern = "^\Q$root"; my @members = $self->membersMatching($pattern); foreach my $member (@members) { my $fileName = $member->fileName(); # in Unix format $fileName =~ s{$pattern}{$dest}; # in Unix format # convert to platform format: $fileName = Archive::Zip::_asLocalName($fileName, $volume); if ((my $ret = _extractionNameIsSafe($fileName)) != AZ_OK) { return $ret; } my $status = $member->extractToFileNamed($fileName); return $status if $status != AZ_OK; } return AZ_OK; } # $zip->updateMember( $memberOrName, $fileName ); # Returns (possibly updated) member, if any; undef on errors. sub updateMember { my $self = shift; my ($oldMember, $fileName); if (ref($_[0]) eq 'HASH') { $oldMember = $_[0]->{memberOrZipName}; $fileName = $_[0]->{name}; } else { ($oldMember, $fileName) = @_; } if (!defined($fileName)) { _error("updateMember(): missing fileName argument"); return undef; } my @newStat = stat($fileName); if (!@newStat) { _ioError("Can't stat $fileName"); return undef; } my $isDir = -d _; my $memberName; if (ref($oldMember)) { $memberName = $oldMember->fileName(); } else { $oldMember = $self->memberNamed($memberName = $oldMember) \|\| $self->memberNamed($memberName = _asZipDirName($oldMember, $isDir)); } unless (defined($oldMember) && $oldMember->lastModTime() == $newStat[9] && $oldMember->isDirectory() == $isDir && ($isDir \|\| ($oldMember->uncompressedSize() == $newStat[7]))) { # create the new member my $newMember = $isDir ? Archive::Zip::Member->newDirectoryNamed($fileName, $memberName) : Archive::Zip::Member->newFromFile($fileName, $memberName); unless (defined($newMember)) { _error("creation of member $fileName failed in updateMember()"); return undef; } # replace old member or append new one if (defined($oldMember)) { $self->replaceMember($oldMember, $newMember); } else { $self->addMember($newMember); } return $newMember; } return $oldMember; } # $zip->updateTree( $root, [ $dest, [ $pred [, $mirror]]] ); # # This takes the same arguments as addTree, but first checks to see # whether the file or directory already exists in the zip file. # # If the fourth argument $mirror is true, then delete all my members # if corresponding files were not found. sub updateTree { my $self = shift; my ($root, $dest, $pred, $mirror, $compressionLevel); if (ref($_[0]) eq 'HASH') { $root = $_[0]->{root}; $dest = $_[0]->{zipName}; $pred = $_[0]->{select}; $mirror = $_[0]->{mirror}; $compressionLevel = $_[0]->{compressionLevel}; } else { ($root, $dest, $pred, $mirror, $compressionLevel) = @_; } return _error("root arg missing in call to updateTree()") unless defined($root); $dest = '' unless defined($dest); $pred = sub { -r } unless defined($pred); $dest = _asZipDirName($dest, 1); my $rootZipName = _asZipDirName($root, 1); # with trailing slash my $pattern = $rootZipName eq './' ? '^' : "^\Q$rootZipName\E"; my @files; my $startDir = _untaintDir(cwd()); return _error('undef returned by _untaintDir on cwd ', cwd()) unless $startDir; # This avoids chdir'ing in Find, in a way compatible with older # versions of File::Find. my $wanted = sub { local $main::_ = $File::Find::name; my $dir = _untaintDir($File::Find::dir); chdir($startDir); push(@files, $File::Find::name) if (&$pred); chdir($dir); }; File::Find::find($wanted, $root); # Now @files has all the files that I could potentially be adding to # the zip. Only add the ones that are necessary. # For each file (updated or not), add its member name to @done. my %done; foreach my $fileName (@files) { my @newStat = stat($fileName); my $isDir = -d _; # normalize, remove leading ./ my $memberName = _asZipDirName($fileName, $isDir); if ($memberName eq $rootZipName) { $memberName = $dest } else { $memberName =~ s{$pattern}{$dest} } next if $memberName =~ m{^\.?/?$}; # skip current dir $done{$memberName} = 1; my $changedMember = $self->updateMember($memberName, $fileName); $changedMember->desiredCompressionLevel($compressionLevel); return _error("updateTree failed to update $fileName") unless ref($changedMember); } # @done now has the archive names corresponding to all the found files. # If we're mirroring, delete all those members that aren't in @done. if ($mirror) { foreach my $member ($self->members()) { $self->removeMember($member) unless $done{$member->fileName()}; } } return AZ_OK; } 1; ��MockFileHandle.pm��0000644��00000002465�15204347723�0007725 0��ustar�00��package Archive::Zip::MockFileHandle; # Output file handle that calls a custom write routine # Ned Konz, March 2000 # This is provided to help with writing zip files # when you have to process them a chunk at a time. use strict; use vars qw{$VERSION}; BEGIN { $VERSION = '1.60'; $VERSION = eval $VERSION; } sub new { my $class = shift \|\| __PACKAGE__; $class = ref($class) \|\| $class; my $self = bless( { 'position' => 0, 'size' => 0 }, $class ); return $self; } sub eof { my $self = shift; return $self->{'position'} >= $self->{'size'}; } # Copy given buffer to me sub print { my $self = shift; my $bytes = join('', @_); my $bytesWritten = $self->writeHook($bytes); if ($self->{'position'} + $bytesWritten > $self->{'size'}) { $self->{'size'} = $self->{'position'} + $bytesWritten; } $self->{'position'} += $bytesWritten; return $bytesWritten; } # Called on each write. # Override in subclasses. # Return number of bytes written (0 on error). sub writeHook { my $self = shift; my $bytes = shift; return length($bytes); } sub binmode { 1 } sub close { 1 } sub clearerr { 1 } # I'm write-only! sub read { 0 } sub tell { return shift->{'position'} } sub opened { 1 } 1; ��Tree.pm��0000644��00000001460�15204347723�0006011 0��ustar�00��package Archive::Zip::Tree; use strict; use vars qw{$VERSION}; BEGIN { $VERSION = '1.60'; } use Archive::Zip; warn( "Archive::Zip::Tree is deprecated; its methods have been moved into Archive::Zip." ) if $^W; 1; __END__ =head1 NAME Archive::Zip::Tree - (DEPRECATED) methods for adding/extracting trees using Archive::Zip =head1 DESCRIPTION This module is deprecated, because all its methods were moved into the main Archive::Zip module. It is included in the distribution merely to avoid breaking old code. See L<Archive::Zip>. =head1 AUTHOR Ned Konz, perl@bike-nomad.com =head1 COPYRIGHT Copyright (c) 2000-2002 Ned Konz. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L<Archive::Zip> =cut ��FAQ.pod��0000644��00000030556�15204347723�0005677 0��ustar�00��=head1 NAME Archive::Zip::FAQ - Answers to a few frequently asked questions about Archive::Zip =head1 DESCRIPTION It seems that I keep answering the same questions over and over again. I assume that this is because my documentation is deficient, rather than that people don't read the documentation. So this FAQ is an attempt to cut down on the number of personal answers I have to give. At least I can now say "You I<did> read the FAQ, right?". The questions are not in any particular order. The answers assume the current version of Archive::Zip; some of the answers depend on newly added/fixed functionality. =head1 Install problems on RedHat 8 or 9 with Perl 5.8.0 B<Q:> Archive::Zip won't install on my RedHat 9 system! It's broke! B<A:> This has become something of a FAQ. Basically, RedHat broke some versions of Perl by setting LANG to UTF8. They apparently have a fixed version out as an update. You might try running CPAN or creating your Makefile after exporting the LANG environment variable as C<LANG=C> L<https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=87682> =head1 Why is my zip file so big? B<Q:> My zip file is actually bigger than what I stored in it! Why? B<A:> Some things to make sure of: =over 4 =item Make sure that you are requesting COMPRESSION_DEFLATED if you are storing strings. $member->desiredCompressionMethod( COMPRESSION_DEFLATED ); =item Don't make lots of little files if you can help it. Since zip computes the compression tables for each member, small members without much entropy won't compress well. Instead, if you've got lots of repeated strings in your data, try to combine them into one big member. =item Make sure that you are requesting COMPRESSION_STORED if you are storing things that are already compressed. If you're storing a .zip, .jpg, .mp3, or other compressed file in a zip, then don't compress them again. They'll get bigger. =back =head1 Sample code? B<Q:> Can you send me code to do (whatever)? B<A:> Have you looked in the C<examples/> directory yet? It contains: =over 4 =item examples/calcSizes.pl -- How to find out how big a Zip file will be before writing it =item examples/copy.pl -- Copies one Zip file to another =item examples/extract.pl -- extract file(s) from a Zip =item examples/mailZip.pl -- make and mail a zip file =item examples/mfh.pl -- demo for use of MockFileHandle =item examples/readScalar.pl -- shows how to use IO::Scalar as the source of a Zip read =item examples/selfex.pl -- a brief example of a self-extracting Zip =item examples/unzipAll.pl -- uses Archive::Zip::Tree to unzip an entire Zip =item examples/updateZip.pl -- shows how to read/modify/write a Zip =item examples/updateTree.pl -- shows how to update a Zip in place =item examples/writeScalar.pl -- shows how to use IO::Scalar as the destination of a Zip write =item examples/writeScalar2.pl -- shows how to use IO::String as the destination of a Zip write =item examples/zip.pl -- Constructs a Zip file =item examples/zipcheck.pl -- One way to check a Zip file for validity =item examples/zipinfo.pl -- Prints out information about a Zip archive file =item examples/zipGrep.pl -- Searches for text in Zip files =item examples/ziptest.pl -- Lists a Zip file and checks member CRCs =item examples/ziprecent.pl -- Puts recent files into a zipfile =item examples/ziptest.pl -- Another way to check a Zip file for validity =back =head1 Can't Read/modify/write same Zip file B<Q:> Why can't I open a Zip file, add a member, and write it back? I get an error message when I try. B<A:> Because Archive::Zip doesn't (and can't, generally) read file contents into memory, the original Zip file is required to stay around until the writing of the new file is completed. The best way to do this is to write the Zip to a temporary file and then rename the temporary file to have the old name (possibly after deleting the old one). Archive::Zip v1.02 added the archive methods C<overwrite()> and C<overwriteAs()> to do this simply and carefully. See C<examples/updateZip.pl> for an example of this technique. =head1 File creation time not set B<Q:> Upon extracting files, I see that their modification (and access) times are set to the time in the Zip archive. However, their creation time is not set to the same time. Why? B<A:> Mostly because Perl doesn't give cross-platform access to I<creation time>. Indeed, many systems (like Unix) don't support such a concept. However, if yours does, you can easily set it. Get the modification time from the member using C<lastModTime()>. =head1 Can't use Archive::Zip on gzip files B<Q:> Can I use Archive::Zip to extract Unix gzip files? B<A:> No. There is a distinction between Unix gzip files, and Zip archives that also can use the gzip compression. Depending on the format of the gzip file, you can use L<Compress::Raw::Zlib>, or L<Archive::Tar> to decompress it (and de-archive it in the case of Tar files). You can unzip PKZIP/WinZip/etc/ archives using Archive::Zip (that's what it's for) as long as any compressed members are compressed using Deflate compression. =head1 Add a directory/tree to a Zip B<Q:> How can I add a directory (or tree) full of files to a Zip? B<A:> You can use the Archive::Zip::addTree() methods: use Archive::Zip; my $zip = Archive::Zip->new(); # add all readable files and directories below . as xyz/* $zip->addTree( '.', 'xyz' ); # add all readable plain files below /abc as def/* $zip->addTree( '/abc', 'def', sub { -f && -r } ); # add all .c files below /tmp as stuff/* $zip->addTreeMatching( '/tmp', 'stuff', '\.c$' ); # add all .o files below /tmp as stuff/* if they aren't writable $zip->addTreeMatching( '/tmp', 'stuff', '\.o$', sub { ! -w } ); # add all .so files below /tmp that are smaller than 200 bytes as stuff/* $zip->addTreeMatching( '/tmp', 'stuff', '\.o$', sub { -s < 200 } ); # and write them into a file $zip->writeToFileNamed('xxx.zip'); =head1 Extract a directory/tree B<Q:> How can I extract some (or all) files from a Zip into a different directory? B<A:> You can use the Archive::Zip::extractTree() method: ??? \|\| # now extract the same files into /tmpx $zip->extractTree( 'stuff', '/tmpx' ); =head1 Update a directory/tree B<Q:> How can I update a Zip from a directory tree, adding or replacing only the newer files? B<A:> You can use the Archive::Zip::updateTree() method that was added in version 1.09. =head1 Zip times might be off by 1 second B<Q:> It bothers me greatly that my file times are wrong by one second about half the time. Why don't you do something about it? B<A:> Get over it. This is a result of the Zip format storing times in DOS format, which has a resolution of only two seconds. =head1 Zip times don't include time zone information B<Q:> My file times don't respect time zones. What gives? B<A:> If this is important to you, please submit patches to read the various Extra Fields that encode times with time zones. I'm just using the DOS Date/Time, which doesn't have a time zone. =head1 How do I make a self-extracting Zip B<Q:> I want to make a self-extracting Zip file. Can I do this? B<A:> Yes. You can write a self-extracting archive stub (that is, a version of unzip) to the output filehandle that you pass to writeToFileHandle(). See examples/selfex.pl for how to write a self-extracting archive. However, you should understand that this will only work on one kind of platform (the one for which the stub was compiled). =head1 How can I deal with Zips with prepended garbage (i.e. from Sircam) B<Q:> How can I tell if a Zip has been damaged by adding garbage to the beginning or inside the file? B<A:> I added code for this for the Amavis virus scanner. You can query archives for their 'eocdOffset' property, which should be 0: if ($zip->eocdOffset > 0) { warn($zip->eocdOffset . " bytes of garbage at beginning or within Zip") } When members are extracted, this offset will be used to adjust the start of the member if necessary. =head1 Can't extract Shrunk files B<Q:> I'm trying to extract a file out of a Zip produced by PKZIP, and keep getting this error message: error: Unsupported compression combination: read 6, write 0 B<A:> You can't uncompress this archive member. Archive::Zip only supports uncompressed members, and compressed members that are compressed using the compression supported by Compress::Raw::Zlib. That means only Deflated and Stored members. Your file is compressed using the Shrink format, which is not supported by Compress::Raw::Zlib. You could, perhaps, use a command-line UnZip program (like the Info-Zip one) to extract this. =head1 Can't do decryption B<Q:> How do I decrypt encrypted Zip members? B<A:> With some other program or library. Archive::Zip doesn't support decryption, and probably never will (unless I<you> write it). =head1 How to test file integrity? B<Q:> How can Archive::Zip can test the validity of a Zip file? B<A:> If you try to decompress the file, the gzip streams will report errors if you have garbage. Most of the time. If you try to open the file and a central directory structure can't be found, an error will be reported. When a file is being read, if we can't find a proper PK.. signature in the right places we report a format error. If there is added garbage at the beginning of a Zip file (as inserted by some viruses), you can find out about it, but Archive::Zip will ignore it, and you can still use the archive. When it gets written back out the added stuff will be gone. There are two ready-to-use utilities in the examples directory that can be used to test file integrity, or that you can use as examples for your own code: =over 4 =item examples/zipcheck.pl shows how to use an attempted extraction to test a file. =item examples/ziptest.pl shows how to test CRCs in a file. =back =head1 Duplicate files in Zip? B<Q:> Archive::Zip let me put the same file in my Zip twice! Why don't you prevent this? B<A:> As far as I can tell, this is not disallowed by the Zip spec. If you think it's a bad idea, check for it yourself: $zip->addFile($someFile, $someName) unless $zip->memberNamed($someName); I can even imagine cases where this might be useful (for instance, multiple versions of files). =head1 File ownership/permissions/ACLS/etc B<Q:> Why doesn't Archive::Zip deal with file ownership, ACLs, etc.? B<A:> There is no standard way to represent these in the Zip file format. If you want to send me code to properly handle the various extra fields that have been used to represent these through the years, I'll look at it. =head1 I can't compile but ActiveState only has an old version of Archive::Zip B<Q:> I've only installed modules using ActiveState's PPM program and repository. But they have a much older version of Archive::Zip than is in CPAN. Will you send me a newer PPM? B<A:> Probably not, unless I get lots of extra time. But there's no reason you can't install the version from CPAN. Archive::Zip is pure Perl, so all you need is NMAKE, which you can get for free from Microsoft (see the FAQ in the ActiveState documentation for details on how to install CPAN modules). =head1 My JPEGs (or MP3's) don't compress when I put them into Zips! B<Q:> How come my JPEGs and MP3's don't compress much when I put them into Zips? B<A:> Because they're already compressed. =head1 Under Windows, things lock up/get damaged B<Q:> I'm using Windows. When I try to use Archive::Zip, my machine locks up/makes funny sounds/displays a BSOD/corrupts data. How can I fix this? B<A:> First, try the newest version of Compress::Raw::Zlib. I know of Windows-related problems prior to v1.14 of that library. =head1 Zip contents in a scalar B<Q:> I want to read a Zip file from (or write one to) a scalar variable instead of a file. How can I do this? B<A:> Use C<IO::String> and the C<readFromFileHandle()> and C<writeToFileHandle()> methods. See C<examples/readScalar.pl> and C<examples/writeScalar.pl>. =head1 Reading from streams B<Q:> How do I read from a stream (like for the Info-Zip C<funzip> program)? B<A:> This is not currently supported, though writing to a stream is. ��MemberRead.pm��0000644��00000017213�15204347724�0007121 0��ustar�00��package Archive::Zip::MemberRead; =head1 NAME Archive::Zip::MemberRead - A wrapper that lets you read Zip archive members as if they were files. =cut =head1 SYNOPSIS use Archive::Zip; use Archive::Zip::MemberRead; $zip = Archive::Zip->new("file.zip"); $fh = Archive::Zip::MemberRead->new($zip, "subdir/abc.txt"); while (defined($line = $fh->getline())) { print $fh->input_line_number . "#: $line\n"; } $read = $fh->read($buffer, 321024); print "Read $read bytes as :$buffer:\n"; =head1 DESCRIPTION The Archive::Zip::MemberRead module lets you read Zip archive member data just like you read data from files. =head1 METHODS =over 4 =cut use strict; use Archive::Zip qw( :ERROR_CODES :CONSTANTS ); use vars qw{$VERSION}; my $nl; BEGIN { $VERSION = '1.60'; $VERSION = eval $VERSION; # Requirement for newline conversion. Should check for e.g., DOS and OS/2 as well, but am too lazy. $nl = $^O eq 'MSWin32' ? "\r\n" : "\n"; } =item Archive::Zip::Member::readFileHandle() You can get a C<Archive::Zip::MemberRead> from an archive member by calling C<readFileHandle()>: my $member = $zip->memberNamed('abc/def.c'); my $fh = $member->readFileHandle(); while (defined($line = $fh->getline())) { # ... } $fh->close(); =cut sub Archive::Zip::Member::readFileHandle { return Archive::Zip::MemberRead->new(shift()); } =item Archive::Zip::MemberRead->new($zip, $fileName) =item Archive::Zip::MemberRead->new($zip, $member) =item Archive::Zip::MemberRead->new($member) Construct a new Archive::Zip::MemberRead on the specified member. my $fh = Archive::Zip::MemberRead->new($zip, 'fred.c') =cut sub new { my ($class, $zip, $file) = @_; my ($self, $member); if ($zip && $file) # zip and filename, or zip and member { $member = ref($file) ? $file : $zip->memberNamed($file); } elsif ($zip && !$file && ref($zip)) # just member { $member = $zip; } else { die( 'Archive::Zip::MemberRead::new needs a zip and filename, zip and member, or member' ); } $self = {}; bless($self, $class); $self->set_member($member); return $self; } sub set_member { my ($self, $member) = @_; $self->{member} = $member; $self->set_compression(COMPRESSION_STORED); $self->rewind(); } sub set_compression { my ($self, $compression) = @_; $self->{member}->desiredCompressionMethod($compression) if $self->{member}; } =item setLineEnd(expr) Set the line end character to use. This is set to \n by default except on Windows systems where it is set to \r\n. You will only need to set this on systems which are not Windows or Unix based and require a line end different from \n. This is a class method so call as C<Archive::Zip::MemberRead>->C<setLineEnd($nl)> =cut sub setLineEnd { shift; $nl = shift; } =item rewind() Rewinds an C<Archive::Zip::MemberRead> so that you can read from it again starting at the beginning. =cut sub rewind { my $self = shift; $self->_reset_vars(); $self->{member}->rewindData() if $self->{member}; } sub _reset_vars { my $self = shift; $self->{line_no} = 0; $self->{at_end} = 0; delete $self->{buffer}; } =item input_record_separator(expr) If the argument is given, input_record_separator for this instance is set to it. The current setting (which may be the global $/) is always returned. =cut sub input_record_separator { my $self = shift; if (@_) { $self->{sep} = shift; $self->{sep_re} = _sep_as_re($self->{sep}); # Cache the RE as an optimization } return exists $self->{sep} ? $self->{sep} : $/; } # Return the input_record_separator in use as an RE fragment # Note that if we have a per-instance input_record_separator # we can just return the already converted value. Otherwise, # the conversion must be done on $/ every time since we cannot # know whether it has changed or not. sub _sep_re { my $self = shift; # Important to phrase this way: sep's value may be undef. return exists $self->{sep} ? $self->{sep_re} : _sep_as_re($/); } # Convert the input record separator into an RE and return it. sub _sep_as_re { my $sep = shift; if (defined $sep) { if ($sep eq '') { return "(?:$nl){2,}"; } else { $sep =~ s/\n/$nl/og; return quotemeta $sep; } } else { return undef; } } =item input_line_number() Returns the current line number, but only if you're using C<getline()>. Using C<read()> will not update the line number. =cut sub input_line_number { my $self = shift; return $self->{line_no}; } =item close() Closes the given file handle. =cut sub close { my $self = shift; $self->_reset_vars(); $self->{member}->endRead(); } =item buffer_size([ $size ]) Gets or sets the buffer size used for reads. Default is the chunk size used by Archive::Zip. =cut sub buffer_size { my ($self, $size) = @_; if (!$size) { return $self->{chunkSize} \|\| Archive::Zip::chunkSize(); } else { $self->{chunkSize} = $size; } } =item getline() Returns the next line from the currently open member. Makes sense only for text files. A read error is considered fatal enough to die. Returns undef on eof. All subsequent calls would return undef, unless a rewind() is called. Note: The line returned has the input_record_separator (default: newline) removed. =item getline( { preserve_line_ending => 1 } ) Returns the next line including the line ending. =cut sub getline { my ($self, $argref) = @_; my $size = $self->buffer_size(); my $sep = $self->_sep_re(); my $preserve_line_ending; if (ref $argref eq 'HASH') { $preserve_line_ending = $argref->{'preserve_line_ending'}; $sep =~ s/\\([^A-Za-z_0-9])+/$1/g; } for (; ;) { if ( $sep && defined($self->{buffer}) && $self->{buffer} =~ s/^(.?)$sep//s) { my $line = $1; $self->{line_no}++; if ($preserve_line_ending) { return $line . $sep; } else { return $line; } } elsif ($self->{at_end}) { $self->{line_no}++ if $self->{buffer}; return delete $self->{buffer}; } my ($temp, $status) = $self->{member}->readChunk($size); if ($status != AZ_OK && $status != AZ_STREAM_END) { die "ERROR: Error reading chunk from archive - $status"; } $self->{at_end} = $status == AZ_STREAM_END; $self->{buffer} .= $$temp; } } =item read($buffer, $num_bytes_to_read) Simulates a normal C<read()> system call. Returns the no. of bytes read. C<undef> on error, 0 on eof, I<e.g.>: $fh = Archive::Zip::MemberRead->new($zip, "sreeji/secrets.bin"); while (1) { $read = $fh->read($buffer, 1024); die "FATAL ERROR reading my secrets !\n" if (!defined($read)); last if (!$read); # Do processing. .... } =cut # # All these $_ are required to emulate read(). # sub read { my $self = $_[0]; my $size = $_[2]; my ($temp, $status, $ret); ($temp, $status) = $self->{member}->readChunk($size); if ($status != AZ_OK && $status != AZ_STREAM_END) { $_[1] = undef; $ret = undef; } else { $_[1] = $$temp; $ret = length($$temp); } return $ret; } 1; =back =head1 AUTHOR Sreeji K. Das E<lt>sreeji_k@yahoo.comE<gt> See L<Archive::Zip> by Ned Konz without which this module does not make any sense! Minor mods by Ned Konz. =head1 COPYRIGHT Copyright 2002 Sreeji K. Das. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut ��Member.pm��0000644��00000111437�15204347724�0006330 0��ustar�00��package Archive::Zip::Member; # A generic member of an archive use strict; use vars qw( $VERSION @ISA ); BEGIN { $VERSION = '1.60'; @ISA = qw( Archive::Zip ); if ($^O eq 'MSWin32') { require Win32; require Encode; Encode->import(qw{ decode_utf8 }); } } use Archive::Zip qw( :CONSTANTS :MISC_CONSTANTS :ERROR_CODES :PKZIP_CONSTANTS :UTILITY_METHODS ); use Time::Local (); use Compress::Raw::Zlib qw( Z_OK Z_STREAM_END MAX_WBITS ); use File::Path; use File::Basename; # Unix perms for default creation of files/dirs. use constant DEFAULT_DIRECTORY_PERMISSIONS => 040755; use constant DEFAULT_FILE_PERMISSIONS => 0100666; use constant DIRECTORY_ATTRIB => 040000; use constant FILE_ATTRIB => 0100000; # Returns self if successful, else undef # Assumes that fh is positioned at beginning of central directory file header. # Leaves fh positioned immediately after file header or EOCD signature. sub _newFromZipFile { my $class = shift; my $self = Archive::Zip::ZipFileMember->_newFromZipFile(@_); return $self; } sub newFromString { my $class = shift; my ($stringOrStringRef, $fileName); if (ref($_[0]) eq 'HASH') { $stringOrStringRef = $_[0]->{string}; $fileName = $_[0]->{zipName}; } else { ($stringOrStringRef, $fileName) = @_; } my $self = Archive::Zip::StringMember->_newFromString($stringOrStringRef, $fileName); return $self; } sub newFromFile { my $class = shift; my ($fileName, $zipName); if (ref($_[0]) eq 'HASH') { $fileName = $_[0]->{fileName}; $zipName = $_[0]->{zipName}; } else { ($fileName, $zipName) = @_; } my $self = Archive::Zip::NewFileMember->_newFromFileNamed($fileName, $zipName); return $self; } sub newDirectoryNamed { my $class = shift; my ($directoryName, $newName); if (ref($_[0]) eq 'HASH') { $directoryName = $_[0]->{directoryName}; $newName = $_[0]->{zipName}; } else { ($directoryName, $newName) = @_; } my $self = Archive::Zip::DirectoryMember->_newNamed($directoryName, $newName); return $self; } sub new { my $class = shift; my $self = { 'lastModFileDateTime' => 0, 'fileAttributeFormat' => FA_UNIX, 'versionMadeBy' => 20, 'versionNeededToExtract' => 20, 'bitFlag' => ($Archive::Zip::UNICODE ? 0x0800 : 0), 'compressionMethod' => COMPRESSION_STORED, 'desiredCompressionMethod' => COMPRESSION_STORED, 'desiredCompressionLevel' => COMPRESSION_LEVEL_NONE, 'internalFileAttributes' => 0, 'externalFileAttributes' => 0, # set later 'fileName' => '', 'cdExtraField' => '', 'localExtraField' => '', 'fileComment' => '', 'crc32' => 0, 'compressedSize' => 0, 'uncompressedSize' => 0, 'isSymbolicLink' => 0, 'password' => undef, # password for encrypted data 'crc32c' => -1, # crc for decrypted data @_ }; bless($self, $class); $self->unixFileAttributes($self->DEFAULT_FILE_PERMISSIONS); return $self; } sub _becomeDirectoryIfNecessary { my $self = shift; $self->_become('Archive::Zip::DirectoryMember') if $self->isDirectory(); return $self; } # Morph into given class (do whatever cleanup I need to do) sub _become { return bless($_[0], $_[1]); } sub versionMadeBy { shift->{'versionMadeBy'}; } sub fileAttributeFormat { my $self = shift; if (@_) { $self->{fileAttributeFormat} = (ref($_[0]) eq 'HASH') ? $_[0]->{format} : $_[0]; } else { return $self->{fileAttributeFormat}; } } sub versionNeededToExtract { shift->{'versionNeededToExtract'}; } sub bitFlag { my $self = shift; # Set General Purpose Bit Flags according to the desiredCompressionLevel setting if ( $self->desiredCompressionLevel == 1 \|\| $self->desiredCompressionLevel == 2) { $self->{'bitFlag'} \|= DEFLATING_COMPRESSION_FAST; } elsif ($self->desiredCompressionLevel == 3 \|\| $self->desiredCompressionLevel == 4 \|\| $self->desiredCompressionLevel == 5 \|\| $self->desiredCompressionLevel == 6 \|\| $self->desiredCompressionLevel == 7) { $self->{'bitFlag'} \|= DEFLATING_COMPRESSION_NORMAL; } elsif ($self->desiredCompressionLevel == 8 \|\| $self->desiredCompressionLevel == 9) { $self->{'bitFlag'} \|= DEFLATING_COMPRESSION_MAXIMUM; } if ($Archive::Zip::UNICODE) { $self->{'bitFlag'} \|= 0x0800; } $self->{'bitFlag'}; } sub password { my $self = shift; $self->{'password'} = shift if @_; $self->{'password'}; } sub compressionMethod { shift->{'compressionMethod'}; } sub desiredCompressionMethod { my $self = shift; my $newDesiredCompressionMethod = (ref($_[0]) eq 'HASH') ? shift->{compressionMethod} : shift; my $oldDesiredCompressionMethod = $self->{'desiredCompressionMethod'}; if (defined($newDesiredCompressionMethod)) { $self->{'desiredCompressionMethod'} = $newDesiredCompressionMethod; if ($newDesiredCompressionMethod == COMPRESSION_STORED) { $self->{'desiredCompressionLevel'} = 0; $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK if $self->uncompressedSize() == 0; } elsif ($oldDesiredCompressionMethod == COMPRESSION_STORED) { $self->{'desiredCompressionLevel'} = COMPRESSION_LEVEL_DEFAULT; } } return $oldDesiredCompressionMethod; } sub desiredCompressionLevel { my $self = shift; my $newDesiredCompressionLevel = (ref($_[0]) eq 'HASH') ? shift->{compressionLevel} : shift; my $oldDesiredCompressionLevel = $self->{'desiredCompressionLevel'}; if (defined($newDesiredCompressionLevel)) { $self->{'desiredCompressionLevel'} = $newDesiredCompressionLevel; $self->{'desiredCompressionMethod'} = ( $newDesiredCompressionLevel ? COMPRESSION_DEFLATED : COMPRESSION_STORED ); } return $oldDesiredCompressionLevel; } sub fileName { my $self = shift; my $newName = shift; if (defined $newName) { $newName =~ s{[\\/]+}{/}g; # deal with dos/windoze problems $self->{'fileName'} = $newName; } return $self->{'fileName'}; } sub fileNameAsBytes { my $self = shift; my $bytes = $self->{'fileName'}; if($self->{'bitFlag'} & 0x800){ $bytes = Encode::encode_utf8($bytes); } return $bytes; } sub lastModFileDateTime { my $modTime = shift->{'lastModFileDateTime'}; $modTime =~ m/^(\d+)$/; # untaint return $1; } sub lastModTime { my $self = shift; return _dosToUnixTime($self->lastModFileDateTime()); } sub setLastModFileDateTimeFromUnix { my $self = shift; my $time_t = shift; $self->{'lastModFileDateTime'} = _unixToDosTime($time_t); } sub internalFileAttributes { shift->{'internalFileAttributes'}; } sub externalFileAttributes { shift->{'externalFileAttributes'}; } # Convert UNIX permissions into proper value for zip file # Usable as a function or a method sub _mapPermissionsFromUnix { my $self = shift; my $mode = shift; my $attribs = $mode << 16; # Microsoft Windows Explorer needs this bit set for directories if ($mode & DIRECTORY_ATTRIB) { $attribs \|= 16; } return $attribs; # TODO: map more MS-DOS perms } # Convert ZIP permissions into Unix ones # # This was taken from Info-ZIP group's portable UnZip # zipfile-extraction program, version 5.50. # http://www.info-zip.org/pub/infozip/ # # See the mapattr() function in unix/unix.c # See the attribute format constants in unzpriv.h # # XXX Note that there's one situation that is not implemented # yet that depends on the "extra field." sub _mapPermissionsToUnix { my $self = shift; my $format = $self->{'fileAttributeFormat'}; my $attribs = $self->{'externalFileAttributes'}; my $mode = 0; if ($format == FA_AMIGA) { $attribs = $attribs >> 17 & 7; # Amiga RWE bits $mode = $attribs << 6 \| $attribs << 3 \| $attribs; return $mode; } if ($format == FA_THEOS) { $attribs &= 0xF1FFFFFF; if (($attribs & 0xF0000000) != 0x40000000) { $attribs &= 0x01FFFFFF; # not a dir, mask all ftype bits } else { $attribs &= 0x41FFFFFF; # leave directory bit as set } } if ( $format == FA_UNIX \|\| $format == FA_VAX_VMS \|\| $format == FA_ACORN \|\| $format == FA_ATARI_ST \|\| $format == FA_BEOS \|\| $format == FA_QDOS \|\| $format == FA_TANDEM) { $mode = $attribs >> 16; return $mode if $mode != 0 or not $self->localExtraField; # warn("local extra field is: ", $self->localExtraField, "\n"); # XXX This condition is not implemented # I'm just including the comments from the info-zip section for now. # Some (non-Info-ZIP) implementations of Zip for Unix and # VMS (and probably others ??) leave 0 in the upper 16-bit # part of the external_file_attributes field. Instead, they # store file permission attributes in some extra field. # As a work-around, we search for the presence of one of # these extra fields and fall back to the MSDOS compatible # part of external_file_attributes if one of the known # e.f. types has been detected. # Later, we might implement extraction of the permission # bits from the VMS extra field. But for now, the work-around # should be sufficient to provide "readable" extracted files. # (For ASI Unix e.f., an experimental remap from the e.f. # mode value IS already provided!) } # PKWARE's PKZip for Unix marks entries as FA_MSDOS, but stores the # Unix attributes in the upper 16 bits of the external attributes # field, just like Info-ZIP's Zip for Unix. We try to use that # value, after a check for consistency with the MSDOS attribute # bits (see below). if ($format == FA_MSDOS) { $mode = $attribs >> 16; } # FA_MSDOS, FA_OS2_HPFS, FA_WINDOWS_NTFS, FA_MACINTOSH, FA_TOPS20 $attribs = !($attribs & 1) << 1 \| ($attribs & 0x10) >> 4; # keep previous $mode setting when its "owner" # part appears to be consistent with DOS attribute flags! return $mode if ($mode & 0700) == (0400 \| $attribs << 6); $mode = 0444 \| $attribs << 6 \| $attribs << 3 \| $attribs; return $mode; } sub unixFileAttributes { my $self = shift; my $oldPerms = $self->_mapPermissionsToUnix; my $perms; if (@_) { $perms = (ref($_[0]) eq 'HASH') ? $_[0]->{attributes} : $_[0]; if ($self->isDirectory) { $perms &= ~FILE_ATTRIB; $perms \|= DIRECTORY_ATTRIB; } else { $perms &= ~DIRECTORY_ATTRIB; $perms \|= FILE_ATTRIB; } $self->{externalFileAttributes} = $self->_mapPermissionsFromUnix($perms); } return $oldPerms; } sub localExtraField { my $self = shift; if (@_) { $self->{localExtraField} = (ref($_[0]) eq 'HASH') ? $_[0]->{field} : $_[0]; } else { return $self->{localExtraField}; } } sub cdExtraField { my $self = shift; if (@_) { $self->{cdExtraField} = (ref($_[0]) eq 'HASH') ? $_[0]->{field} : $_[0]; } else { return $self->{cdExtraField}; } } sub extraFields { my $self = shift; return $self->localExtraField() . $self->cdExtraField(); } sub fileComment { my $self = shift; if (@_) { $self->{fileComment} = (ref($_[0]) eq 'HASH') ? pack('C0a', $_[0]->{comment}) : pack('C0a', $_[0]); } else { return $self->{fileComment}; } } sub hasDataDescriptor { my $self = shift; if (@_) { my $shouldHave = shift; if ($shouldHave) { $self->{'bitFlag'} \|= GPBF_HAS_DATA_DESCRIPTOR_MASK; } else { $self->{'bitFlag'} &= ~GPBF_HAS_DATA_DESCRIPTOR_MASK; } } return $self->{'bitFlag'} & GPBF_HAS_DATA_DESCRIPTOR_MASK; } sub crc32 { shift->{'crc32'}; } sub crc32String { sprintf("%08x", shift->{'crc32'}); } sub compressedSize { shift->{'compressedSize'}; } sub uncompressedSize { shift->{'uncompressedSize'}; } sub isEncrypted { shift->{'bitFlag'} & GPBF_ENCRYPTED_MASK; } sub isTextFile { my $self = shift; my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK; if (@_) { my $flag = (ref($_[0]) eq 'HASH') ? shift->{flag} : shift; $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK; $self->{'internalFileAttributes'} \|= ($flag ? IFA_TEXT_FILE : IFA_BINARY_FILE); } return $bit == IFA_TEXT_FILE; } sub isBinaryFile { my $self = shift; my $bit = $self->internalFileAttributes() & IFA_TEXT_FILE_MASK; if (@_) { my $flag = shift; $self->{'internalFileAttributes'} &= ~IFA_TEXT_FILE_MASK; $self->{'internalFileAttributes'} \|= ($flag ? IFA_BINARY_FILE : IFA_TEXT_FILE); } return $bit == IFA_BINARY_FILE; } sub extractToFileNamed { my $self = shift; # local FS name my $name = (ref($_[0]) eq 'HASH') ? $_[0]->{name} : $_[0]; $self->{'isSymbolicLink'} = 0; # Check if the file / directory is a symbolic link or not if ($self->{'externalFileAttributes'} == 0xA1FF0000) { $self->{'isSymbolicLink'} = 1; $self->{'newName'} = $name; my ($status, $fh) = _newFileHandle($name, 'r'); my $retval = $self->extractToFileHandle($fh); $fh->close(); } else { #return _writeSymbolicLink($self, $name) if $self->isSymbolicLink(); my ($status, $fh); if ($^O eq 'MSWin32' && $Archive::Zip::UNICODE) { $name = decode_utf8(Win32::GetFullPathName($name)); mkpath_win32($name); Win32::CreateFile($name); ($status, $fh) = _newFileHandle(Win32::GetANSIPathName($name), 'w'); } else { mkpath(dirname($name)); # croaks on error ($status, $fh) = _newFileHandle($name, 'w'); } return _ioError("Can't open file $name for write") unless $status; my $retval = $self->extractToFileHandle($fh); $fh->close(); chmod($self->unixFileAttributes(), $name) or return _error("Can't chmod() ${name}: $!"); utime($self->lastModTime(), $self->lastModTime(), $name); return $retval; } } sub mkpath_win32 { my $path = shift; use File::Spec; my ($volume, @path) = File::Spec->splitdir($path); $path = File::Spec->catfile($volume, shift @path); pop @path; while (@path) { $path = File::Spec->catfile($path, shift @path); Win32::CreateDirectory($path); } } sub _writeSymbolicLink { my $self = shift; my $name = shift; my $chunkSize = $Archive::Zip::ChunkSize; #my ( $outRef, undef ) = $self->readChunk($chunkSize); my $fh; my $retval = $self->extractToFileHandle($fh); my ($outRef, undef) = $self->readChunk(100); } sub isSymbolicLink { my $self = shift; if ($self->{'externalFileAttributes'} == 0xA1FF0000) { $self->{'isSymbolicLink'} = 1; } else { return 0; } 1; } sub isDirectory { return 0; } sub externalFileName { return undef; } # The following are used when copying data sub _writeOffset { shift->{'writeOffset'}; } sub _readOffset { shift->{'readOffset'}; } sub writeLocalHeaderRelativeOffset { shift->{'writeLocalHeaderRelativeOffset'}; } sub wasWritten { shift->{'wasWritten'} } sub _dataEnded { shift->{'dataEnded'}; } sub _readDataRemaining { shift->{'readDataRemaining'}; } sub _inflater { shift->{'inflater'}; } sub _deflater { shift->{'deflater'}; } # Return the total size of my local header sub _localHeaderSize { my $self = shift; { use bytes; return SIGNATURE_LENGTH + LOCAL_FILE_HEADER_LENGTH + length($self->fileName()) + length($self->localExtraField()); } } # Return the total size of my CD header sub _centralDirectoryHeaderSize { my $self = shift; { use bytes; return SIGNATURE_LENGTH + CENTRAL_DIRECTORY_FILE_HEADER_LENGTH + length($self->fileName()) + length($self->cdExtraField()) + length($self->fileComment()); } } # DOS date/time format # 0-4 (5) Second divided by 2 # 5-10 (6) Minute (0-59) # 11-15 (5) Hour (0-23 on a 24-hour clock) # 16-20 (5) Day of the month (1-31) # 21-24 (4) Month (1 = January, 2 = February, etc.) # 25-31 (7) Year offset from 1980 (add 1980 to get actual year) # Convert DOS date/time format to unix time_t format # NOT AN OBJECT METHOD! sub _dosToUnixTime { my $dt = shift; return time() unless defined($dt); my $year = (($dt >> 25) & 0x7f) + 80; my $mon = (($dt >> 21) & 0x0f) - 1; my $mday = (($dt >> 16) & 0x1f); my $hour = (($dt >> 11) & 0x1f); my $min = (($dt >> 5) & 0x3f); my $sec = (($dt << 1) & 0x3e); # catch errors my $time_t = eval { Time::Local::timelocal($sec, $min, $hour, $mday, $mon, $year); }; return time() if ($@); return $time_t; } # Note, this is not exactly UTC 1980, it's 1980 + 12 hours and 1 # minute so that nothing timezoney can muck us up. my $safe_epoch = 31.606060; # convert a unix time to DOS date/time # NOT AN OBJECT METHOD! sub _unixToDosTime { my $time_t = shift; unless ($time_t) { _error("Tried to add member with zero or undef value for time"); $time_t = $safe_epoch; } if ($time_t < $safe_epoch) { _ioError("Unsupported date before 1980 encountered, moving to 1980"); $time_t = $safe_epoch; } my ($sec, $min, $hour, $mday, $mon, $year) = localtime($time_t); my $dt = 0; $dt += ($sec >> 1); $dt += ($min << 5); $dt += ($hour << 11); $dt += ($mday << 16); $dt += (($mon + 1) << 21); $dt += (($year - 80) << 25); return $dt; } sub head { my ($self, $mode) = (@_, 0); use bytes; return pack LOCAL_FILE_HEADER_FORMAT, $self->versionNeededToExtract(), $self->{'bitFlag'}, $self->desiredCompressionMethod(), $self->lastModFileDateTime(), $self->hasDataDescriptor() ? (0,0,0) # crc, compr & uncompr all zero if data descriptor present : ( $self->crc32(), $mode ? $self->_writeOffset() # compressed size : $self->compressedSize(), # may need to be re-written later $self->uncompressedSize(), ), length($self->fileNameAsBytes()), length($self->localExtraField()); } # Write my local header to a file handle. # Stores the offset to the start of the header in my # writeLocalHeaderRelativeOffset member. # Returns AZ_OK on success. sub _writeLocalFileHeader { my $self = shift; my $fh = shift; my $signatureData = pack(SIGNATURE_FORMAT, LOCAL_FILE_HEADER_SIGNATURE); $self->_print($fh, $signatureData) or return _ioError("writing local header signature"); my $header = $self->head(1); $self->_print($fh, $header) or return _ioError("writing local header"); # Check for a valid filename or a filename equal to a literal `0' if ($self->fileName() \|\| $self->fileName eq '0') { $self->_print($fh, $self->fileNameAsBytes()) or return _ioError("writing local header filename"); } if ($self->localExtraField()) { $self->_print($fh, $self->localExtraField()) or return _ioError("writing local extra field"); } return AZ_OK; } sub _writeCentralDirectoryFileHeader { my $self = shift; my $fh = shift; my $sigData = pack(SIGNATURE_FORMAT, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE); $self->_print($fh, $sigData) or return _ioError("writing central directory header signature"); my ($fileNameLength, $extraFieldLength, $fileCommentLength); { use bytes; $fileNameLength = length($self->fileNameAsBytes()); $extraFieldLength = length($self->cdExtraField()); $fileCommentLength = length($self->fileComment()); } my $header = pack( CENTRAL_DIRECTORY_FILE_HEADER_FORMAT, $self->versionMadeBy(), $self->fileAttributeFormat(), $self->versionNeededToExtract(), $self->bitFlag(), $self->desiredCompressionMethod(), $self->lastModFileDateTime(), $self->crc32(), # these three fields should have been updated $self->_writeOffset(), # by writing the data stream out $self->uncompressedSize(), # $fileNameLength, $extraFieldLength, $fileCommentLength, 0, # {'diskNumberStart'}, $self->internalFileAttributes(), $self->externalFileAttributes(), $self->writeLocalHeaderRelativeOffset()); $self->_print($fh, $header) or return _ioError("writing central directory header"); if ($fileNameLength) { $self->_print($fh, $self->fileNameAsBytes()) or return _ioError("writing central directory header signature"); } if ($extraFieldLength) { $self->_print($fh, $self->cdExtraField()) or return _ioError("writing central directory extra field"); } if ($fileCommentLength) { $self->_print($fh, $self->fileComment()) or return _ioError("writing central directory file comment"); } return AZ_OK; } # This writes a data descriptor to the given file handle. # Assumes that crc32, writeOffset, and uncompressedSize are # set correctly (they should be after a write). # Further, the local file header should have the # GPBF_HAS_DATA_DESCRIPTOR_MASK bit set. sub _writeDataDescriptor { my $self = shift; my $fh = shift; my $header = pack( SIGNATURE_FORMAT . DATA_DESCRIPTOR_FORMAT, DATA_DESCRIPTOR_SIGNATURE, $self->crc32(), $self->_writeOffset(), # compressed size $self->uncompressedSize()); $self->_print($fh, $header) or return _ioError("writing data descriptor"); return AZ_OK; } # Re-writes the local file header with new crc32 and compressedSize fields. # To be called after writing the data stream. # Assumes that filename and extraField sizes didn't change since last written. sub _refreshLocalFileHeader { my $self = shift; my $fh = shift; my $here = $fh->tell(); $fh->seek($self->writeLocalHeaderRelativeOffset() + SIGNATURE_LENGTH, IO::Seekable::SEEK_SET) or return _ioError("seeking to rewrite local header"); my $header = $self->head(1); $self->_print($fh, $header) or return _ioError("re-writing local header"); $fh->seek($here, IO::Seekable::SEEK_SET) or return _ioError("seeking after rewrite of local header"); return AZ_OK; } sub readChunk { my $self = shift; my $chunkSize = (ref($_[0]) eq 'HASH') ? $_[0]->{chunkSize} : $_[0]; if ($self->readIsDone()) { $self->endRead(); my $dummy = ''; return (\$dummy, AZ_STREAM_END); } $chunkSize = $Archive::Zip::ChunkSize if not defined($chunkSize); $chunkSize = $self->_readDataRemaining() if $chunkSize > $self->_readDataRemaining(); my $buffer = ''; my $outputRef; my ($bytesRead, $status) = $self->_readRawChunk(\$buffer, $chunkSize); return (\$buffer, $status) unless $status == AZ_OK; $buffer && $self->isEncrypted and $buffer = $self->_decode($buffer); $self->{'readDataRemaining'} -= $bytesRead; $self->{'readOffset'} += $bytesRead; if ($self->compressionMethod() == COMPRESSION_STORED) { $self->{'crc32'} = $self->computeCRC32($buffer, $self->{'crc32'}); } ($outputRef, $status) = &{$self->{'chunkHandler'}}($self, \$buffer); $self->{'writeOffset'} += length($$outputRef); $self->endRead() if $self->readIsDone(); return ($outputRef, $status); } # Read the next raw chunk of my data. Subclasses MUST implement. # my ( $bytesRead, $status) = $self->_readRawChunk( \$buffer, $chunkSize ); sub _readRawChunk { my $self = shift; return $self->_subclassResponsibility(); } # A place holder to catch rewindData errors if someone ignores # the error code. sub _noChunk { my $self = shift; return (\undef, _error("trying to copy chunk when init failed")); } # Basically a no-op so that I can have a consistent interface. # ( $outputRef, $status) = $self->_copyChunk( \$buffer ); sub _copyChunk { my ($self, $dataRef) = @_; return ($dataRef, AZ_OK); } # ( $outputRef, $status) = $self->_deflateChunk( \$buffer ); sub _deflateChunk { my ($self, $buffer) = @_; my ($status) = $self->_deflater()->deflate($buffer, my $out); if ($self->_readDataRemaining() == 0) { my $extraOutput; ($status) = $self->_deflater()->flush($extraOutput); $out .= $extraOutput; $self->endRead(); return (\$out, AZ_STREAM_END); } elsif ($status == Z_OK) { return (\$out, AZ_OK); } else { $self->endRead(); my $retval = _error('deflate error', $status); my $dummy = ''; return (\$dummy, $retval); } } # ( $outputRef, $status) = $self->_inflateChunk( \$buffer ); sub _inflateChunk { my ($self, $buffer) = @_; my ($status) = $self->_inflater()->inflate($buffer, my $out); my $retval; $self->endRead() unless $status == Z_OK; if ($status == Z_OK \|\| $status == Z_STREAM_END) { $retval = ($status == Z_STREAM_END) ? AZ_STREAM_END : AZ_OK; return (\$out, $retval); } else { $retval = _error('inflate error', $status); my $dummy = ''; return (\$dummy, $retval); } } sub rewindData { my $self = shift; my $status; # set to trap init errors $self->{'chunkHandler'} = $self->can('_noChunk'); # Work around WinZip bug with 0-length DEFLATED files $self->desiredCompressionMethod(COMPRESSION_STORED) if $self->uncompressedSize() == 0; # assume that we're going to read the whole file, and compute the CRC anew. $self->{'crc32'} = 0 if ($self->compressionMethod() == COMPRESSION_STORED); # These are the only combinations of methods we deal with right now. if ( $self->compressionMethod() == COMPRESSION_STORED and $self->desiredCompressionMethod() == COMPRESSION_DEFLATED) { ($self->{'deflater'}, $status) = Compress::Raw::Zlib::Deflate->new( '-Level' => $self->desiredCompressionLevel(), '-WindowBits' => -MAX_WBITS(), # necessary magic '-Bufsize' => $Archive::Zip::ChunkSize, @_ ); # pass additional options return _error('deflateInit error:', $status) unless $status == Z_OK; $self->{'chunkHandler'} = $self->can('_deflateChunk'); } elsif ($self->compressionMethod() == COMPRESSION_DEFLATED and $self->desiredCompressionMethod() == COMPRESSION_STORED) { ($self->{'inflater'}, $status) = Compress::Raw::Zlib::Inflate->new( '-WindowBits' => -MAX_WBITS(), # necessary magic '-Bufsize' => $Archive::Zip::ChunkSize, @_ ); # pass additional options return _error('inflateInit error:', $status) unless $status == Z_OK; $self->{'chunkHandler'} = $self->can('_inflateChunk'); } elsif ($self->compressionMethod() == $self->desiredCompressionMethod()) { $self->{'chunkHandler'} = $self->can('_copyChunk'); } else { return _error( sprintf( "Unsupported compression combination: read %d, write %d", $self->compressionMethod(), $self->desiredCompressionMethod())); } $self->{'readDataRemaining'} = ($self->compressionMethod() == COMPRESSION_STORED) ? $self->uncompressedSize() : $self->compressedSize(); $self->{'dataEnded'} = 0; $self->{'readOffset'} = 0; return AZ_OK; } sub endRead { my $self = shift; delete $self->{'inflater'}; delete $self->{'deflater'}; $self->{'dataEnded'} = 1; $self->{'readDataRemaining'} = 0; return AZ_OK; } sub readIsDone { my $self = shift; return ($self->_dataEnded() or !$self->_readDataRemaining()); } sub contents { my $self = shift; my $newContents = shift; if (defined($newContents)) { # change our type and call the subclass contents method. $self->_become('Archive::Zip::StringMember'); return $self->contents(pack('C0a', $newContents)); # in case of Unicode } else { my $oldCompression = $self->desiredCompressionMethod(COMPRESSION_STORED); my $status = $self->rewindData(@_); if ($status != AZ_OK) { $self->endRead(); return $status; } my $retval = ''; while ($status == AZ_OK) { my $ref; ($ref, $status) = $self->readChunk($self->_readDataRemaining()); # did we get it in one chunk? if (length($$ref) == $self->uncompressedSize()) { $retval = $$ref; } else { $retval .= $$ref } } $self->desiredCompressionMethod($oldCompression); $self->endRead(); $status = AZ_OK if $status == AZ_STREAM_END; $retval = undef unless $status == AZ_OK; return wantarray ? ($retval, $status) : $retval; } } sub extractToFileHandle { my $self = shift; my $fh = (ref($_[0]) eq 'HASH') ? shift->{fileHandle} : shift; _binmode($fh); my $oldCompression = $self->desiredCompressionMethod(COMPRESSION_STORED); my $status = $self->rewindData(@_); $status = $self->_writeData($fh) if $status == AZ_OK; $self->desiredCompressionMethod($oldCompression); $self->endRead(); return $status; } # write local header and data stream to file handle sub _writeToFileHandle { my $self = shift; my $fh = shift; my $fhIsSeekable = shift; my $offset = shift; return _error("no member name given for $self") if $self->fileName() eq ''; $self->{'writeLocalHeaderRelativeOffset'} = $offset; $self->{'wasWritten'} = 0; # Determine if I need to write a data descriptor # I need to do this if I can't refresh the header # and I don't know compressed size or crc32 fields. my $headerFieldsUnknown = ( ($self->uncompressedSize() > 0) and ($self->compressionMethod() == COMPRESSION_STORED or $self->desiredCompressionMethod() == COMPRESSION_DEFLATED)); my $shouldWriteDataDescriptor = ($headerFieldsUnknown and not $fhIsSeekable); $self->hasDataDescriptor(1) if ($shouldWriteDataDescriptor); $self->{'writeOffset'} = 0; my $status = $self->rewindData(); ($status = $self->_writeLocalFileHeader($fh)) if $status == AZ_OK; ($status = $self->_writeData($fh)) if $status == AZ_OK; if ($status == AZ_OK) { $self->{'wasWritten'} = 1; if ($self->hasDataDescriptor()) { $status = $self->_writeDataDescriptor($fh); } elsif ($headerFieldsUnknown) { $status = $self->_refreshLocalFileHeader($fh); } } return $status; } # Copy my (possibly compressed) data to given file handle. # Returns C<AZ_OK> on success sub _writeData { my $self = shift; my $writeFh = shift; # If symbolic link, just create one if the operating system is Linux, Unix, BSD or VMS # TODO: Add checks for other operating systems if ($self->{'isSymbolicLink'} == 1 && $^O eq 'linux') { my $chunkSize = $Archive::Zip::ChunkSize; my ($outRef, $status) = $self->readChunk($chunkSize); symlink $$outRef, $self->{'newName'}; } else { return AZ_OK if ($self->uncompressedSize() == 0); my $status; my $chunkSize = $Archive::Zip::ChunkSize; while ($self->_readDataRemaining() > 0) { my $outRef; ($outRef, $status) = $self->readChunk($chunkSize); return $status if ($status != AZ_OK and $status != AZ_STREAM_END); if (length($$outRef) > 0) { $self->_print($writeFh, $$outRef) or return _ioError("write error during copy"); } last if $status == AZ_STREAM_END; } } return AZ_OK; } # Return true if I depend on the named file sub _usesFileNamed { return 0; } # ############################################################################## # # Decrypt section # # H.Merijn Brand (Tux) 2011-06-28 # # ############################################################################## # This code is derived from the crypt source of unzip-6.0 dated 05 Jan 2007 # Its license states: # # --8<--- # Copyright (c) 1990-2007 Info-ZIP. All rights reserved. # See the accompanying file LICENSE, version 2005-Feb-10 or later # (the contents of which are also included in (un)zip.h) for terms of use. # If, for some reason, all these files are missing, the Info-ZIP license # also may be found at: ftp://ftp.info-zip.org/pub/infozip/license.html # # crypt.c (full version) by Info-ZIP. Last revised: [see crypt.h] # The main encryption/decryption source code for Info-Zip software was # originally written in Europe. To the best of our knowledge, it can # be freely distributed in both source and object forms from any country, # including the USA under License Exception TSU of the U.S. Export # Administration Regulations (section 740.13(e)) of 6 June 2002. # NOTE on copyright history: # Previous versions of this source package (up to version 2.8) were # not copyrighted and put in the public domain. If you cannot comply # with the Info-Zip LICENSE, you may want to look for one of those # public domain versions. # # This encryption code is a direct transcription of the algorithm from # Roger Schlafly, described by Phil Katz in the file appnote.txt. This # file (appnote.txt) is distributed with the PKZIP program (even in the # version without encryption capabilities). # -->8--- # As of January 2000, US export regulations were amended to allow export # of free encryption source code from the US. As of June 2002, these # regulations were further relaxed to allow export of encryption binaries # associated with free encryption source code. The Zip 2.31, UnZip 5.52 # and Wiz 5.02 archives now include full crypto source code. As of the # Zip 2.31 release, all official binaries include encryption support; the # former "zcr" archives ceased to exist. # (Note that restrictions may still exist in other countries, of course.) # For now, we just support the decrypt stuff # All below methods are supposed to be private # use Data::Peek; my @keys; my @crct = do { my $xor = 0xedb88320; my @crc = (0) x 1024; # generate a crc for every 8-bit value foreach my $n (0 .. 255) { my $c = $n; $c = $c & 1 ? $xor ^ ($c >> 1) : $c >> 1 for 1 .. 8; $crc[$n] = _revbe($c); } # generate crc for each value followed by one, two, and three zeros / foreach my $n (0 .. 255) { my $c = ($crc[($crc[$n] >> 24) ^ 0] ^ ($crc[$n] << 8)) & 0xffffffff; $crc[$_ * 256 + $n] = $c for 1 .. 3; } map { _revbe($crc[$_]) } 0 .. 1023; }; sub _crc32 { my ($c, $b) = @_; return ($crct[($c ^ $b) & 0xff] ^ ($c >> 8)); } # _crc32 sub _revbe { my $w = shift; return (($w >> 24) + (($w >> 8) & 0xff00) + (($w & 0xff00) << 8) + (($w & 0xff) << 24)); } # _revbe sub _update_keys { use integer; my $c = shift; # signed int $keys[0] = _crc32($keys[0], $c); $keys[1] = (($keys[1] + ($keys[0] & 0xff)) * 0x08088405 + 1) & 0xffffffff; my $keyshift = $keys[1] >> 24; $keys[2] = _crc32($keys[2], $keyshift); } # _update_keys sub _zdecode ($) { my $c = shift; my $t = ($keys[2] & 0xffff) \| 2; _update_keys($c ^= ((($t * ($t ^ 1)) >> 8) & 0xff)); return $c; } # _zdecode sub _decode { my $self = shift; my $buff = shift; $self->isEncrypted or return $buff; my $pass = $self->password; defined $pass or return ""; @keys = (0x12345678, 0x23456789, 0x34567890); _update_keys($_) for unpack "C", $pass; # DDumper { uk => [ @keys ] }; my $head = substr $buff, 0, 12, ""; my @head = map { _zdecode($_) } unpack "C", $head; my $x = $self->{externalFileAttributes} ? ($self->{lastModFileDateTime} >> 8) & 0xff : $self->{crc32} >> 24; $head[-1] == $x or return ""; # Password fail # Worth checking ... $self->{crc32c} = (unpack LOCAL_FILE_HEADER_FORMAT, pack "C", @head)[3]; # DHexDump ($buff); $buff = pack "C" => map { _zdecode($_) } unpack "C*" => $buff; # DHexDump ($buff); return $buff; } # _decode 1; ��ZipFileMember.pm��0000644��00000032710�15204347725�0007610 0��ustar�00��package Archive::Zip::ZipFileMember; use strict; use vars qw( $VERSION @ISA ); BEGIN { $VERSION = '1.60'; @ISA = qw ( Archive::Zip::FileMember ); } use Archive::Zip qw( :CONSTANTS :ERROR_CODES :PKZIP_CONSTANTS :UTILITY_METHODS ); # Create a new Archive::Zip::ZipFileMember # given a filename and optional open file handle # sub _newFromZipFile { my $class = shift; my $fh = shift; my $externalFileName = shift; my $possibleEocdOffset = shift; # normally 0 my $self = $class->new( 'crc32' => 0, 'diskNumberStart' => 0, 'localHeaderRelativeOffset' => 0, 'dataOffset' => 0, # localHeaderRelativeOffset + header length @_ ); $self->{'externalFileName'} = $externalFileName; $self->{'fh'} = $fh; $self->{'possibleEocdOffset'} = $possibleEocdOffset; return $self; } sub isDirectory { my $self = shift; return (substr($self->fileName, -1, 1) eq '/' and $self->uncompressedSize == 0); } # Seek to the beginning of the local header, just past the signature. # Verify that the local header signature is in fact correct. # Update the localHeaderRelativeOffset if necessary by adding the possibleEocdOffset. # Returns status. sub _seekToLocalHeader { my $self = shift; my $where = shift; # optional my $previousWhere = shift; # optional $where = $self->localHeaderRelativeOffset() unless defined($where); # avoid loop on certain corrupt files (from Julian Field) return _formatError("corrupt zip file") if defined($previousWhere) && $where == $previousWhere; my $status; my $signature; $status = $self->fh()->seek($where, IO::Seekable::SEEK_SET); return _ioError("seeking to local header") unless $status; ($status, $signature) = _readSignature($self->fh(), $self->externalFileName(), LOCAL_FILE_HEADER_SIGNATURE); return $status if $status == AZ_IO_ERROR; # retry with EOCD offset if any was given. if ($status == AZ_FORMAT_ERROR && $self->{'possibleEocdOffset'}) { $status = $self->_seekToLocalHeader( $self->localHeaderRelativeOffset() + $self->{'possibleEocdOffset'}, $where ); if ($status == AZ_OK) { $self->{'localHeaderRelativeOffset'} += $self->{'possibleEocdOffset'}; $self->{'possibleEocdOffset'} = 0; } } return $status; } # Because I'm going to delete the file handle, read the local file # header if the file handle is seekable. If it is not, I assume that # I've already read the local header. # Return ( $status, $self ) sub _become { my $self = shift; my $newClass = shift; return $self if ref($self) eq $newClass; my $status = AZ_OK; if (_isSeekable($self->fh())) { my $here = $self->fh()->tell(); $status = $self->_seekToLocalHeader(); $status = $self->_readLocalFileHeader() if $status == AZ_OK; $self->fh()->seek($here, IO::Seekable::SEEK_SET); return $status unless $status == AZ_OK; } delete($self->{'eocdCrc32'}); delete($self->{'diskNumberStart'}); delete($self->{'localHeaderRelativeOffset'}); delete($self->{'dataOffset'}); return $self->SUPER::_become($newClass); } sub diskNumberStart { shift->{'diskNumberStart'}; } sub localHeaderRelativeOffset { shift->{'localHeaderRelativeOffset'}; } sub dataOffset { shift->{'dataOffset'}; } # Skip local file header, updating only extra field stuff. # Assumes that fh is positioned before signature. sub _skipLocalFileHeader { my $self = shift; my $header; my $bytesRead = $self->fh()->read($header, LOCAL_FILE_HEADER_LENGTH); if ($bytesRead != LOCAL_FILE_HEADER_LENGTH) { return _ioError("reading local file header"); } my $fileNameLength; my $extraFieldLength; my $bitFlag; ( undef, # $self->{'versionNeededToExtract'}, $bitFlag, undef, # $self->{'compressionMethod'}, undef, # $self->{'lastModFileDateTime'}, undef, # $crc32, undef, # $compressedSize, undef, # $uncompressedSize, $fileNameLength, $extraFieldLength ) = unpack(LOCAL_FILE_HEADER_FORMAT, $header); if ($fileNameLength) { $self->fh()->seek($fileNameLength, IO::Seekable::SEEK_CUR) or return _ioError("skipping local file name"); } if ($extraFieldLength) { $bytesRead = $self->fh()->read($self->{'localExtraField'}, $extraFieldLength); if ($bytesRead != $extraFieldLength) { return _ioError("reading local extra field"); } } $self->{'dataOffset'} = $self->fh()->tell(); if ($bitFlag & GPBF_HAS_DATA_DESCRIPTOR_MASK) { # Read the crc32, compressedSize, and uncompressedSize from the # extended data descriptor, which directly follows the compressed data. # # Skip over the compressed file data (assumes that EOCD compressedSize # was correct) $self->fh()->seek($self->{'compressedSize'}, IO::Seekable::SEEK_CUR) or return _ioError("seeking to extended local header"); # these values should be set correctly from before. my $oldCrc32 = $self->{'eocdCrc32'}; my $oldCompressedSize = $self->{'compressedSize'}; my $oldUncompressedSize = $self->{'uncompressedSize'}; my $status = $self->_readDataDescriptor(); return $status unless $status == AZ_OK; # The buffer withe encrypted data is prefixed with a new # encrypted 12 byte header. The size only changes when # the buffer is also compressed $self->isEncrypted && $oldUncompressedSize > $self->{uncompressedSize} and $oldUncompressedSize -= DATA_DESCRIPTOR_LENGTH; return _formatError( "CRC or size mismatch while skipping data descriptor") if ( $oldCrc32 != $self->{'crc32'} \|\| $oldUncompressedSize != $self->{'uncompressedSize'}); $self->{'crc32'} = 0 if $self->compressionMethod() == COMPRESSION_STORED ; } return AZ_OK; } # Read from a local file header into myself. Returns AZ_OK if successful. # Assumes that fh is positioned after signature. # Note that crc32, compressedSize, and uncompressedSize will be 0 if # GPBF_HAS_DATA_DESCRIPTOR_MASK is set in the bitFlag. sub _readLocalFileHeader { my $self = shift; my $header; my $bytesRead = $self->fh()->read($header, LOCAL_FILE_HEADER_LENGTH); if ($bytesRead != LOCAL_FILE_HEADER_LENGTH) { return _ioError("reading local file header"); } my $fileNameLength; my $crc32; my $compressedSize; my $uncompressedSize; my $extraFieldLength; ( $self->{'versionNeededToExtract'}, $self->{'bitFlag'}, $self->{'compressionMethod'}, $self->{'lastModFileDateTime'}, $crc32, $compressedSize, $uncompressedSize, $fileNameLength, $extraFieldLength ) = unpack(LOCAL_FILE_HEADER_FORMAT, $header); if ($fileNameLength) { my $fileName; $bytesRead = $self->fh()->read($fileName, $fileNameLength); if ($bytesRead != $fileNameLength) { return _ioError("reading local file name"); } $self->fileName($fileName); } if ($extraFieldLength) { $bytesRead = $self->fh()->read($self->{'localExtraField'}, $extraFieldLength); if ($bytesRead != $extraFieldLength) { return _ioError("reading local extra field"); } } $self->{'dataOffset'} = $self->fh()->tell(); if ($self->hasDataDescriptor()) { # Read the crc32, compressedSize, and uncompressedSize from the # extended data descriptor. # Skip over the compressed file data (assumes that EOCD compressedSize # was correct) $self->fh()->seek($self->{'compressedSize'}, IO::Seekable::SEEK_CUR) or return _ioError("seeking to extended local header"); my $status = $self->_readDataDescriptor(); return $status unless $status == AZ_OK; } else { return _formatError( "CRC or size mismatch after reading data descriptor") if ( $self->{'crc32'} != $crc32 \|\| $self->{'uncompressedSize'} != $uncompressedSize); } return AZ_OK; } # This will read the data descriptor, which is after the end of compressed file # data in members that have GPBF_HAS_DATA_DESCRIPTOR_MASK set in their bitFlag. # The only reliable way to find these is to rely on the EOCD compressedSize. # Assumes that file is positioned immediately after the compressed data. # Returns status; sets crc32, compressedSize, and uncompressedSize. sub _readDataDescriptor { my $self = shift; my $signatureData; my $header; my $crc32; my $compressedSize; my $uncompressedSize; my $bytesRead = $self->fh()->read($signatureData, SIGNATURE_LENGTH); return _ioError("reading header signature") if $bytesRead != SIGNATURE_LENGTH; my $signature = unpack(SIGNATURE_FORMAT, $signatureData); # unfortunately, the signature appears to be optional. if ($signature == DATA_DESCRIPTOR_SIGNATURE && ($signature != $self->{'crc32'})) { $bytesRead = $self->fh()->read($header, DATA_DESCRIPTOR_LENGTH); return _ioError("reading data descriptor") if $bytesRead != DATA_DESCRIPTOR_LENGTH; ($crc32, $compressedSize, $uncompressedSize) = unpack(DATA_DESCRIPTOR_FORMAT, $header); } else { $bytesRead = $self->fh()->read($header, DATA_DESCRIPTOR_LENGTH_NO_SIG); return _ioError("reading data descriptor") if $bytesRead != DATA_DESCRIPTOR_LENGTH_NO_SIG; $crc32 = $signature; ($compressedSize, $uncompressedSize) = unpack(DATA_DESCRIPTOR_FORMAT_NO_SIG, $header); } $self->{'eocdCrc32'} = $self->{'crc32'} unless defined($self->{'eocdCrc32'}); $self->{'crc32'} = $crc32; $self->{'compressedSize'} = $compressedSize; $self->{'uncompressedSize'} = $uncompressedSize; return AZ_OK; } # Read a Central Directory header. Return AZ_OK on success. # Assumes that fh is positioned right after the signature. sub _readCentralDirectoryFileHeader { my $self = shift; my $fh = $self->fh(); my $header = ''; my $bytesRead = $fh->read($header, CENTRAL_DIRECTORY_FILE_HEADER_LENGTH); if ($bytesRead != CENTRAL_DIRECTORY_FILE_HEADER_LENGTH) { return _ioError("reading central dir header"); } my ($fileNameLength, $extraFieldLength, $fileCommentLength); ( $self->{'versionMadeBy'}, $self->{'fileAttributeFormat'}, $self->{'versionNeededToExtract'}, $self->{'bitFlag'}, $self->{'compressionMethod'}, $self->{'lastModFileDateTime'}, $self->{'crc32'}, $self->{'compressedSize'}, $self->{'uncompressedSize'}, $fileNameLength, $extraFieldLength, $fileCommentLength, $self->{'diskNumberStart'}, $self->{'internalFileAttributes'}, $self->{'externalFileAttributes'}, $self->{'localHeaderRelativeOffset'} ) = unpack(CENTRAL_DIRECTORY_FILE_HEADER_FORMAT, $header); $self->{'eocdCrc32'} = $self->{'crc32'}; if ($fileNameLength) { $bytesRead = $fh->read($self->{'fileName'}, $fileNameLength); if ($bytesRead != $fileNameLength) { _ioError("reading central dir filename"); } } if ($extraFieldLength) { $bytesRead = $fh->read($self->{'cdExtraField'}, $extraFieldLength); if ($bytesRead != $extraFieldLength) { return _ioError("reading central dir extra field"); } } if ($fileCommentLength) { $bytesRead = $fh->read($self->{'fileComment'}, $fileCommentLength); if ($bytesRead != $fileCommentLength) { return _ioError("reading central dir file comment"); } } # NK 10/21/04: added to avoid problems with manipulated headers if ( $self->{'uncompressedSize'} != $self->{'compressedSize'} and $self->{'compressionMethod'} == COMPRESSION_STORED) { $self->{'uncompressedSize'} = $self->{'compressedSize'}; } $self->desiredCompressionMethod($self->compressionMethod()); return AZ_OK; } sub rewindData { my $self = shift; my $status = $self->SUPER::rewindData(@_); return $status unless $status == AZ_OK; return AZ_IO_ERROR unless $self->fh(); $self->fh()->clearerr(); # Seek to local file header. # The only reason that I'm doing this this way is that the extraField # length seems to be different between the CD header and the LF header. $status = $self->_seekToLocalHeader(); return $status unless $status == AZ_OK; # skip local file header $status = $self->_skipLocalFileHeader(); return $status unless $status == AZ_OK; # Seek to beginning of file data $self->fh()->seek($self->dataOffset(), IO::Seekable::SEEK_SET) or return _ioError("seeking to beginning of file data"); return AZ_OK; } # Return bytes read. Note that first parameter is a ref to a buffer. # my $data; # my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize ); sub _readRawChunk { my ($self, $dataRef, $chunkSize) = @_; return (0, AZ_OK) unless $chunkSize; my $bytesRead = $self->fh()->read($$dataRef, $chunkSize) or return (0, _ioError("reading data")); return ($bytesRead, AZ_OK); } 1; ��

| ver. 1.4 | Github | . | PHP 8.1.34 | ��֧ߧ֧�ѧ�ڧ� ��ѧߧڧ��: 0.1 | proxy | phpinfo | ��ѧ��ۧܧ�