DateTime results from the CPAN

DateTime

Archive-Zip

view release on metacpan or search on metacpan

lib/Archive/Zip/Member.pm view on Meta::CPAN


    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;
    # Info-Zip 3.0 (I guess) seems to use the following values
    # for the version fields in local and central directory
    # headers, regardless of whether the member has an zip64
    # extended information extra field or not:
    #
    #   version made by:
    #     30
    #
    #   version needed to extract:
    #     10 for directory and stored entries
    #     20 for anything else
    my $self  = {
        'lastModFileDateTime'      => 0,
        'fileAttributeFormat'      => FA_UNIX,
        'zip64'                    => 0,
        'desiredZip64Mode'         => ZIP64_AS_NEEDED,
        '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,
        'password'                 => undef,    # password for encrypted data
        'crc32c'                   => -1,       # crc for decrypted data
        @_
    };
    bless($self, $class);
    $self->unixFileAttributes($self->DEFAULT_FILE_PERMISSIONS);
    return $self;
}

# Morph into given class (do whatever cleanup I need to do)
sub _become {
    return bless($_[0], $_[1]);
}

sub fileAttributeFormat {
    my $self = shift;

    if (@_) {
        $self->{fileAttributeFormat} =
          (ref($_[0]) eq 'HASH') ? $_[0]->{format} : $_[0];
    } else {
        return $self->{fileAttributeFormat};
    }
}

sub zip64 {
    shift->{'zip64'};
}

sub desiredZip64Mode {
    my $self = shift;
    my $desiredZip64Mode = $self->{'desiredZip64Mode'};
    if (@_) {
        $self->{'desiredZip64Mode'} =
          ref($_[0]) eq 'HASH' ? shift->{desiredZip64Mode} : shift;
    }
    return $desiredZip64Mode;
}

sub versionMadeBy {
    shift->{'versionMadeBy'};
}

lib/Archive/Zip/Member.pm view on Meta::CPAN

    $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 =~ y{\\/}{/}s;    # 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
        }
    }

lib/Archive/Zip/Member.pm view on Meta::CPAN

            }
        }
        elsif ($hasDataDescriptor) {
            $crc32            = 0;
            $compressedSize   = 0;
            $uncompressedSize = 0;
        }
        else {
            $crc32            = $self->crc32();
            $compressedSize   = $self->_writeOffset();
            $uncompressedSize = $self->uncompressedSize();
        }
    }
    else {
        return _zip64NotSupported() unless ZIP64_SUPPORTED;

        $versionNeededToExtract = 45 if ($versionNeededToExtract < 45);

        my $zip64CompressedSize;
        my $zip64UncompressedSize;
        if ($refresh) {
            $crc32                 = $self->crc32();
            $compressedSize        = 0xffffffff;
            $uncompressedSize      = 0xffffffff;
            $zip64CompressedSize   = $self->_writeOffset();
            $zip64UncompressedSize = $self->uncompressedSize();
        }
        elsif ($hasDataDescriptor) {
            $crc32                 = 0;
            $compressedSize        = 0xffffffff;
            $uncompressedSize      = 0xffffffff;
            $zip64CompressedSize   = 0;
            $zip64UncompressedSize = 0;
        }
        else {
            $crc32                 = $self->crc32();
            $compressedSize        = 0xffffffff;
            $uncompressedSize      = 0xffffffff;
            $zip64CompressedSize   = $self->_writeOffset();
            $zip64UncompressedSize = $self->uncompressedSize();
        }

        $localExtraField .= pack('S< S< Q< Q<',
                                 0x0001, 16,
                                 $zip64UncompressedSize,
                                 $zip64CompressedSize);
    }

    my $fileNameLength    = length($self->fileNameAsBytes());
    my $localFieldLength  = length($localExtraField);

    my $signatureData = pack(SIGNATURE_FORMAT, LOCAL_FILE_HEADER_SIGNATURE);
    $self->_print($fh, $signatureData)
      or return _ioError("writing local header signature");

    my $header =
      pack(LOCAL_FILE_HEADER_FORMAT,
           $versionNeededToExtract,
           $self->{'bitFlag'},
           $self->desiredCompressionMethod(),
           $self->lastModFileDateTime(),
           $crc32,
           $compressedSize,
           $uncompressedSize,
           $fileNameLength,
           $localFieldLength);
    $self->_print($fh, $header)
      or return _ioError("writing local header");

    # Write these only if required
    if (! $refresh || $zip64) {
        if ($fileNameLength) {
            $self->_print($fh, $self->fileNameAsBytes())
              or return _ioError("writing local header filename");
        }
        if ($localFieldLength) {
            $self->_print($fh, $localExtraField)
              or return _ioError("writing local extra field");
        }
    }

    return
      (AZ_OK,
       LOCAL_FILE_HEADER_LENGTH +
       SIGNATURE_LENGTH +
       $fileNameLength +
       $localFieldLength);
}

# 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(), IO::Seekable::SEEK_SET)
      or return _ioError("seeking to rewrite local header");

    my ($status, undef) = $self->_writeLocalFileHeader($fh, 1);
    return $status if $status != AZ_OK;

    $fh->seek($here, IO::Seekable::SEEK_SET)
      or return _ioError("seeking after rewrite of local header");

    return AZ_OK;
}

# Write central directory file header.
# Returns a pair (AZ_OK, $headerSize) on success.
sub _writeCentralDirectoryFileHeader {
    my $self   = shift;
    my $fh     = shift;
    my $adz64m = shift;         # $archiveDesiredZip64Mode

    # (Re-)Determine whether to write zip64 format.  Assume
    # {'diskNumberStart'} is always zero.
    my $zip64 = $adz64m == ZIP64_HEADERS
             || $self->desiredZip64Mode() == ZIP64_HEADERS
             || $self->_writeOffset() > 0xffffffff

lib/Archive/Zip/Member.pm view on Meta::CPAN

    my $versionNeededToExtract    = $self->versionNeededToExtract();
    my $compressedSize            = $self->_writeOffset();
    my $uncompressedSize          = $self->uncompressedSize();
    my $localHeaderRelativeOffset = $self->writeLocalHeaderRelativeOffset();
    my $cdExtraField              = $self->cdExtraField();

    if (!$zip64) {
        # no-op
    }
    else {
        return _zip64NotSupported() unless ZIP64_SUPPORTED;

        $versionNeededToExtract = 45 if ($versionNeededToExtract < 45);

        my $extraFieldFormat = '';
        my @extraFieldValues = ();
        my $extraFieldSize   = 0;
        if ($uncompressedSize > 0xffffffff) {
            $extraFieldFormat .= 'Q< ';
            push(@extraFieldValues, $uncompressedSize);
            $extraFieldSize += 8;
            $uncompressedSize = 0xffffffff;
        }
        if ($compressedSize > 0xffffffff) {
            $extraFieldFormat .= 'Q< ';
            push(@extraFieldValues, $compressedSize);
            $extraFieldSize += 8;
            $compressedSize = 0xffffffff;
        }
        # Avoid empty zip64 extended information extra fields
        if (   $localHeaderRelativeOffset > 0xffffffff
            || @extraFieldValues == 0) {
            $extraFieldFormat .= 'Q< ';
            push(@extraFieldValues, $localHeaderRelativeOffset);
            $extraFieldSize += 8;
            $localHeaderRelativeOffset = 0xffffffff;
        }

        $cdExtraField .=
          pack("S< S< $extraFieldFormat",
               0x0001, $extraFieldSize,
               @extraFieldValues);
    }

    my $fileNameLength    = length($self->fileNameAsBytes());
    my $extraFieldLength  = length($cdExtraField);
    my $fileCommentLength = length($self->fileComment());

    my $sigData =
      pack(SIGNATURE_FORMAT, CENTRAL_DIRECTORY_FILE_HEADER_SIGNATURE);
    $self->_print($fh, $sigData)
      or return _ioError("writing central directory header signature");

    my $header = pack(
        CENTRAL_DIRECTORY_FILE_HEADER_FORMAT,
        $versionMadeBy,
        $self->fileAttributeFormat(),
        $versionNeededToExtract,
        $self->bitFlag(),
        $self->desiredCompressionMethod(),
        $self->lastModFileDateTime(),
        $self->crc32(),            # these three fields should have been updated
        $compressedSize,           # by writing the data stream out
        $uncompressedSize,         #
        $fileNameLength,
        $extraFieldLength,
        $fileCommentLength,
        0,                         # {'diskNumberStart'},
        $self->internalFileAttributes(),
        $self->externalFileAttributes(),
        $localHeaderRelativeOffset);

    $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, $cdExtraField)
          or return _ioError("writing central directory extra field");
    }
    if ($fileCommentLength) {
        $self->_print($fh, $self->fileComment())
          or return _ioError("writing central directory file comment");
    }

    # Update object members with information which might have
    # changed while writing this member.  We already did the
    # zip64 flag.  We must not update the extra fields with any
    # zip64 information, since we consider that internal.
    $self->{'versionNeededToExtract'} = $versionNeededToExtract;
    $self->{'compressedSize'}         = $self->_writeOffset();

    return
      (AZ_OK,
       CENTRAL_DIRECTORY_FILE_HEADER_LENGTH +
       SIGNATURE_LENGTH +
       $fileNameLength +
       $extraFieldLength +
       $fileCommentLength)
}

# 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).
# Returns a pair (AZ_OK, $dataDescriptorSize) on success.
# Further, the local file header should have the
# GPBF_HAS_DATA_DESCRIPTOR_MASK bit set.
sub _writeDataDescriptor {
    my $self   = shift;
    my $fh     = shift;

    my $descriptor;
    if (! $self->zip64()) {
        $descriptor =
          pack(SIGNATURE_FORMAT . DATA_DESCRIPTOR_FORMAT,
               DATA_DESCRIPTOR_SIGNATURE,
               $self->crc32(),
               $self->_writeOffset(),   # compressed size

lib/Archive/Zip/Member.pm view on Meta::CPAN

        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;

( run in 0.496 second using v1.01-cache-2.11-cpan-39bf76dae61 )