view release on metacpan or  search on metacpan

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

        }
        $self->{'zipfileComment'} = $zipfileComment;
    }

    if (! $self->{'zip64'}) {
        return
          wantarray
          ? (AZ_OK, $eocdPosition)
          : AZ_OK;
    }
    else {
        return
          wantarray
          ? (AZ_OK, $zip64EOCDPosition)
          : 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/$UNTAINT/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 will not untaint unless you explicitly pass the flag and regex pattern.
    File::Find::find({ wanted => $wanted, untaint => 1, untaint_pattern => $UNTAINT }, $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

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

        && $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;