On Tue, 11 Dec 2018 21:49:24 +0100
Charlene Wendling wrote:
> Hi ports,
>
> Here is an update for Archive::Zip, it also fixes CVE-2018-10860 [1]
> (directory traversal).
>
I'm joining a patch for 6.4-stable, that combines the fix and the
new t/25_traversal.t test [1], and another fix for the latter [2].
The new test requires also new zip files from [1] that need to be in
${WRKSRC}/t/data, and i'm not aware of any clean mechanism that could
allow the port to fetch them, so the test fails. When feeded manually,
the test works:
===> Regression tests for p5-Archive-Zip-1.59p0
PERL_DL_NONLAZY=1 "/usr/bin/perl" "-MExtUtils::Command::MM"
"-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness(0,
'blib/lib', 'blib/arch')" t/*.t
[...]
t/25_traversal.t .............. ok
All tests successful.
Files=25, Tests=345, 7 wallclock secs ( 0.00 usr 0.07 sys + 0.00
cusr 0.44 csys = 0.51 CPU) Result: PASS
In case it's fine as-is anyway, the diff is attached.
Charlène.
[1]
https://github.com/redhotpenguin/perl-Archive-Zip/commit/5c79b9faae0f1dd67cc8288964c72c12e03884f8#diff-896a798b3ecb12ed65a94e54ac0b70df
[2]
https://github.com/redhotpenguin/perl-Archive-Zip/commit/50b4003a444e1dc2aa52f802dd718cae10df7c0a
Index: devel/quirks/Makefile
===================================================================
RCS file: /cvs/ports/devel/quirks/Makefile,v
retrieving revision 1.623.2.1
diff -u -p -r1.623.2.1 Makefile
--- devel/quirks/Makefile 15 Nov 2018 22:01:51 -0000 1.623.2.1
+++ devel/quirks/Makefile 12 Dec 2018 01:25:03 -0000
@@ -5,7 +5,7 @@ CATEGORIES = devel databases
DISTFILES =
# API.rev
-PKGNAME = quirks-3.17
+PKGNAME = quirks-3.18
PKG_ARCH = *
MAINTAINER = Marc Espie <espie@openbsd.org>
Index: devel/quirks/files/Quirks.pm
===================================================================
RCS file: /cvs/ports/devel/quirks/files/Quirks.pm,v
retrieving revision 1.637.2.1
diff -u -p -r1.637.2.1 Quirks.pm
--- devel/quirks/files/Quirks.pm 15 Nov 2018 22:01:51 -0000 1.637.2.1
+++ devel/quirks/files/Quirks.pm 12 Dec 2018 01:25:03 -0000
@@ -1152,6 +1152,7 @@ sub tweak_search
# list of
# cat/path => badspec
my $cve = {
+ 'archivers/p5-Archive-Zip' => 'p5-Archive-Zip-<1.59p0',
'audio/flac' => 'flac-<1.3.0p1',
'databases/mariadb,-main' => 'mariadb-client-<10.0.37',
'databases/mariadb,-server' => 'mariadb-server-<10.0.37',
Index: archivers/p5-Archive-Zip/Makefile
===================================================================
RCS file: /cvs/ports/archivers/p5-Archive-Zip/Makefile,v
retrieving revision 1.31
diff -u -p -r1.31 Makefile
--- archivers/p5-Archive-Zip/Makefile 2 Nov 2016 22:28:52 -0000 1.31
+++ archivers/p5-Archive-Zip/Makefile 12 Dec 2018 01:25:03 -0000
@@ -6,15 +6,16 @@ MODULES = cpan
PKG_ARCH = *
DISTNAME = Archive-Zip-1.59
+REVISION = 0
CATEGORIES = archivers
# Perl
PERMIT_PACKAGE_CDROM = Yes
-TEST_DEPENDS = archivers/zip \
- devel/p5-Test-MockModule \
- devel/p5-Test-Pod
+TEST_DEPENDS = archivers/unzip \
+ archivers/zip \
+ devel/p5-Test-MockModule
pre-configure:
find ${WRKSRC} -type f -name \*.orig -exec rm {} \;
Index: archivers/p5-Archive-Zip/patches/patch-MANIFEST
===================================================================
RCS file: archivers/p5-Archive-Zip/patches/patch-MANIFEST
diff -N archivers/p5-Archive-Zip/patches/patch-MANIFEST
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ archivers/p5-Archive-Zip/patches/patch-MANIFEST 12 Dec 2018 01:25:03 -0000
@@ -0,0 +1,30 @@
+$OpenBSD$
+Fix for CVE-2018-10860
+See https://github.com/redhotpenguin/perl-Archive-Zip/commit/5c79b9faae0f1dd67cc8288964c72c12e03884f8
+Index: MANIFEST
+--- MANIFEST.orig
++++ MANIFEST
+@@ -59,6 +59,7 @@ t/21_zip64.t
+ t/22_deflated_dir.t
+ t/23_closed_handle.t
+ t/24_unicode_win32.t
++t/25_traversal.t
+ t/badjpeg/expected.jpg
+ t/badjpeg/source.zip
+ t/common.pm
+@@ -68,6 +69,7 @@ t/data/crypcomp.zip
+ t/data/crypt.zip
+ t/data/def.zip
+ t/data/defstr.zip
++t/data/dotdot-from-unexistant-path.zip
+ t/data/empty.zip
+ t/data/emptydef.zip
+ t/data/emptydefstr.zip
+@@ -75,6 +77,7 @@ t/data/emptystore.zip
+ t/data/emptystorestr.zip
+ t/data/good_github11.zip
+ t/data/jar.zip
++t/data/link-dir.zip
+ t/data/linux.zip
+ t/data/mkzip.pl
+ t/data/perl.zip
Index: archivers/p5-Archive-Zip/patches/patch-lib_Archive_Zip_Archive_pm
===================================================================
RCS file: archivers/p5-Archive-Zip/patches/patch-lib_Archive_Zip_Archive_pm
diff -N archivers/p5-Archive-Zip/patches/patch-lib_Archive_Zip_Archive_pm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ archivers/p5-Archive-Zip/patches/patch-lib_Archive_Zip_Archive_pm 12 Dec 2018 01:25:03 -0000
@@ -0,0 +1,72 @@
+$OpenBSD$
+Fix CVE-2018-10860
+see https://github.com/redhotpenguin/perl-Archive-Zip/commit/5c79b9faae0f1dd67cc8288964c72c12e03884f8
+
+Index: lib/Archive/Zip/Archive.pm
+--- lib/Archive/Zip/Archive.pm.orig
++++ lib/Archive/Zip/Archive.pm
+@@ -185,6 +185,8 @@ sub extractMember {
+ $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);
+@@ -218,6 +220,8 @@ sub extractMemberWithoutPaths {
+ 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, @_);
+@@ -827,6 +831,37 @@ sub addTreeMatching {
+ 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.
+@@ -861,6 +896,8 @@ sub extractTree {
+ $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;
+ }
Index: archivers/p5-Archive-Zip/patches/patch-lib_Archive_Zip_Member_pm
===================================================================
RCS file: /cvs/ports/archivers/p5-Archive-Zip/patches/Attic/patch-lib_Archive_Zip_Member_pm,v
retrieving revision 1.3
diff -u -p -r1.3 patch-lib_Archive_Zip_Member_pm
--- archivers/p5-Archive-Zip/patches/patch-lib_Archive_Zip_Member_pm 2 Nov 2016 22:28:52 -0000 1.3
+++ archivers/p5-Archive-Zip/patches/patch-lib_Archive_Zip_Member_pm 12 Dec 2018 01:25:03 -0000
@@ -1,43 +1,27 @@
$OpenBSD: patch-lib_Archive_Zip_Member_pm,v 1.3 2016/11/02 22:28:52 jasper Exp $
-http://rt.cpan.org/Public/Bug/Display.html?id=61930
-
---- lib/Archive/Zip/Member.pm.orig Thu Aug 11 22:06:33 2016
-+++ lib/Archive/Zip/Member.pm Wed Nov 2 20:27:03 2016
-@@ -304,7 +304,7 @@ sub _mapPermissionsToUnix {
- if ($format == FA_AMIGA) {
- $attribs = $attribs >> 17 & 7; # Amiga RWE bits
- $mode = $attribs << 6 | $attribs << 3 | $attribs;
-- return $mode;
-+ return sprintf("%d", $mode);
- }
+Fix tests for CVE-2018-10860 fixes
+See https://github.com/redhotpenguin/perl-Archive-Zip/commit/50b4003a444e1dc2aa52f802dd718cae10df7c0a
+Index: lib/Archive/Zip/Member.pm
+--- lib/Archive/Zip/Member.pm.orig
++++ lib/Archive/Zip/Member.pm
+@@ -34,6 +34,10 @@ use constant DEFAULT_DIRECTORY_PERMISSIONS => 040755;
+ use constant DEFAULT_FILE_PERMISSIONS => 0100666;
+ use constant DIRECTORY_ATTRIB => 040000;
+ use constant FILE_ATTRIB => 0100000;
++use constant OS_SUPPORTS_SYMLINK => do {
++ local $@;
++ !!eval { symlink("",""); 1 };
++};
- if ($format == FA_THEOS) {
-@@ -324,7 +324,10 @@ sub _mapPermissionsToUnix {
- || $format == FA_QDOS
- || $format == FA_TANDEM) {
- $mode = $attribs >> 16;
-- return $mode if $mode != 0 or not $self->localExtraField;
-+ if( $mode != 0 or not $self->localExtraField) {
-+ $mode = sprintf("%d", $mode);
-+ return sprintf("%d", $mode);
-+ }
+ # Returns self if successful, else undef
+ # Assumes that fh is positioned at beginning of central directory file header.
+@@ -1090,7 +1094,7 @@ sub _writeData {
- # warn("local extra field is: ", $self->localExtraField, "\n");
-
-@@ -360,9 +363,13 @@ sub _mapPermissionsToUnix {
-
- # keep previous $mode setting when its "owner"
- # part appears to be consistent with DOS attribute flags!
-- return $mode if ($mode & 0700) == (0400 | $attribs << 6);
-+ if( ( $mode & 0700 ) == ( 0400 | $attribs << 6 )) {
-+ $mode = sprintf("%d", $mode);
-+ return sprintf("%d", $mode);
-+ }
- $mode = 0444 | $attribs << 6 | $attribs << 3 | $attribs;
-- return $mode;
-+ $mode = sprintf("%d", $mode);
-+ return sprintf("%d", $mode);
- }
-
- sub unixFileAttributes {
+ # 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') {
++ if ($self->{'isSymbolicLink'} == 1 && OS_SUPPORTS_SYMLINK) {
+ my $chunkSize = $Archive::Zip::ChunkSize;
+ my ($outRef, $status) = $self->readChunk($chunkSize);
+ symlink $$outRef, $self->{'newName'};
Index: archivers/p5-Archive-Zip/patches/patch-lib_Archive_Zip_pm
===================================================================
RCS file: archivers/p5-Archive-Zip/patches/patch-lib_Archive_Zip_pm
diff -N archivers/p5-Archive-Zip/patches/patch-lib_Archive_Zip_pm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ archivers/p5-Archive-Zip/patches/patch-lib_Archive_Zip_pm 12 Dec 2018 01:25:03 -0000
@@ -0,0 +1,34 @@
+$OpenBSD$
+Document behaviour changes since the fix for CVE-2018-10860
+Index: lib/Archive/Zip.pm
+--- lib/Archive/Zip.pm.orig
++++ lib/Archive/Zip.pm
+@@ -1145,6 +1145,9 @@ member is used as the name of the extracted file or
+ directory.
+ If you pass C<$extractedName>, it should be in the local file
+ system's format.
++If you do not pass C<$extractedName> and the internal filename traverses
++a parent directory or a symbolic link, the extraction will be aborted with
++C<AC_ERROR> for security reason.
+ All necessary directories will be created. Returns C<AZ_OK>
+ on success.
+
+@@ -1162,6 +1165,9 @@ extracted member (its paths will be deleted too). Othe
+ the internal filename of the member (minus paths) is used as
+ the name of the extracted file or directory. Returns C<AZ_OK>
+ on success.
++If you do not pass C<$extractedName> and the internal filename is equalled
++to a local symbolic link, the extraction will be aborted with C<AC_ERROR> for
++security reason.
+
+ =item addMember( $member )
+
+@@ -1609,6 +1615,8 @@ a/x to f:\d\e\x
+
+ a/b/c to f:\d\e\b\c and ignore ax/d/e and d/e
+
++If the path to the extracted file traverses a parent directory or a symbolic
++link, the extraction will be aborted with C<AC_ERROR> for security reason.
+ Returns an error code or AZ_OK if everything worked OK.
+
+ =back
Index: archivers/p5-Archive-Zip/patches/patch-t_10_chmod_t
===================================================================
RCS file: archivers/p5-Archive-Zip/patches/patch-t_10_chmod_t
diff -N archivers/p5-Archive-Zip/patches/patch-t_10_chmod_t
--- archivers/p5-Archive-Zip/patches/patch-t_10_chmod_t 20 Nov 2015 15:15:21 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,12 +0,0 @@
-$OpenBSD: patch-t_10_chmod_t,v 1.2 2015/11/20 15:15:21 ajacoutot Exp $
-
-http://rt.cpan.org/Public/Bug/Display.html?id=61930
-
---- t/10_chmod.t.orig Wed Jun 17 20:42:51 2015
-+++ t/10_chmod.t Fri Nov 20 16:04:14 2015
-@@ -1,4 +1,4 @@
--#!/usr/bin/perl
-+#!/usr/bin/perl -T
-
- use strict;
-
Index: archivers/p5-Archive-Zip/patches/patch-t_25_traversal_t
===================================================================
RCS file: archivers/p5-Archive-Zip/patches/patch-t_25_traversal_t
diff -N archivers/p5-Archive-Zip/patches/patch-t_25_traversal_t
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ archivers/p5-Archive-Zip/patches/patch-t_25_traversal_t 12 Dec 2018 01:25:03 -0000
@@ -0,0 +1,202 @@
+$OpenBSD$
+
+New traversal test for CVE-2018-10860
+See https://github.com/redhotpenguin/perl-Archive-Zip/commit/5c79b9faae0f1dd67cc8288964c72c12e03884f8#diff-896a798b3ecb12ed65a94e54ac0b70df
+
+Requires unshipped zip files to succeed that can be found at the
+same URL
+
+Index: t/25_traversal.t
+--- t/25_traversal.t.orig
++++ t/25_traversal.t
+@@ -0,0 +1,190 @@
++use strict;
++use warnings;
++
++use Archive::Zip qw( :ERROR_CODES );
++use File::Spec;
++use File::Path;
++use lib 't';
++use common;
++
++use Test::More tests => 41;
++
++# These tests check for CVE-2018-10860 vulnerabilities.
++# If an archive contains a symlink and then a file that traverses that symlink,
++# extracting the archive tree could write into an abitrary file selected by
++# the symlink value.
++# Another issue is if an archive contains a file whose path component refers
++# to a parent direcotory. Then extracting that file could write into a file
++# out of current working directory subtree.
++# These tests check extracting of these files is refuses and that they are
++# indeed not created.
++
++# Suppress croaking errors, the tests produce some.
++Archive::Zip::setErrorHandler(sub {});
++my ($existed, $ret, $zip, $allowed_file, $forbidden_file);
++
++# Change working directory to a temporary directory because some tested
++# functions operarates there and we need prepared symlinks there.
++my @data_path = (File::Spec->splitdir(File::Spec->rel2abs('.')), 't', 'data');
++ok(chdir TESTDIR, "Working directory changed");
++
++# Case 1:
++# link-dir -> /tmp
++# link-dir/gotcha-linkdir
++# writes into /tmp/gotcha-linkdir file.
++SKIP: {
++ # Symlink tests make sense only if a file system supports them.
++ my $link = 'trylink';
++ $ret = eval { symlink('.', $link)};
++ skip 'Symbolic links are not supported', 12 if $@;
++ unlink $link;
++
++ # Extracting an archive tree must fail
++ $zip = Archive::Zip->new();
++ isa_ok($zip, 'Archive::Zip');
++ is($zip->read(File::Spec->catfile(@data_path, 'link-dir.zip')), AZ_OK,
++ 'Archive read');
++ $existed = -e File::Spec->catfile('', 'tmp', 'gotcha-linkdir');
++ $ret = eval { $zip->extractTree() };
++ is($ret, AZ_ERROR, 'Tree extraction aborted');
++ SKIP: {
++ skip 'A canary file existed before the test', 1 if $existed;
++ ok(! -e File::Spec->catfile('link-dir', 'gotcha-linkdir'),
++ 'A file was not created in a symlinked directory');
++ }
++ ok(unlink(File::Spec->catfile('link-dir')), 'link-dir removed');
++
++ # The same applies to extracting an archive member without an explicit
++ # local file name. It must abort.
++ $link = 'link-dir';
++ ok(symlink('.', $link), 'A symlink to a directory created');
++ $forbidden_file = File::Spec->catfile($link, 'gotcha-linkdir');
++ $existed = -e $forbidden_file;
++ $ret = eval { $zip->extractMember('link-dir/gotcha-linkdir') };
++ is($ret, AZ_ERROR, 'Member extraction without a local name aborted');
++ SKIP: {
++ skip 'A canary file existed before the test', 1 if $existed;
++ ok(! -e $forbidden_file,
++ 'A file was not created in a symlinked directory');
++ }
++
++ # But allow extracting an archive member into a supplied file name
++ $allowed_file = File::Spec->catfile($link, 'file');
++ $ret = eval { $zip->extractMember('link-dir/gotcha-linkdir', $allowed_file) };
++ is($ret, AZ_OK, 'Member extraction passed');
++ ok(-e $allowed_file, 'File created');
++ ok(unlink($allowed_file), 'File removed');
++ ok(unlink($link), 'A symlink to a directory removed');
++}
++
++# Case 2:
++# unexisting/../../../../../tmp/gotcha-dotdot-unexistingpath
++# writes into ../../../../tmp/gotcha-dotdot-unexistingpath, that is
++# /tmp/gotcha-dotdot-unexistingpath file if CWD is not deeper than
++# 4 directories.
++$zip = Archive::Zip->new();
++isa_ok($zip, 'Archive::Zip');
++is($zip->read(File::Spec->catfile(@data_path,
++ 'dotdot-from-unexistant-path.zip')), AZ_OK, 'Archive read');
++$forbidden_file = File::Spec->catfile('..', '..', '..', '..', 'tmp',
++ 'gotcha-dotdot-unexistingpath');
++$existed = -e $forbidden_file;
++$ret = eval { $zip->extractTree() };
++is($ret, AZ_ERROR, 'Tree extraction aborted');
++SKIP: {
++ skip 'A canary file existed before the test', 1 if $existed;
++ ok(! -e $forbidden_file, 'A file was not created in a parent directory');
++}
++
++# The same applies to extracting an archive member without an explicit local
++# file name. It must abort.
++$existed = -e $forbidden_file;
++$ret = eval { $zip->extractMember(
++ 'unexisting/../../../../../tmp/gotcha-dotdot-unexistingpath',
++ ) };
++is($ret, AZ_ERROR, 'Member extraction without a local name aborted');
++SKIP: {
++ skip 'A canary file existed before the test', 1 if $existed;
++ ok(! -e $forbidden_file, 'A file was not created in a parent directory');
++}
++
++# But allow extracting an archive member into a supplied file name
++ok(mkdir('directory'), 'Directory created');
++$allowed_file = File::Spec->catfile('directory', '..', 'file');
++$ret = eval { $zip->extractMember(
++ 'unexisting/../../../../../tmp/gotcha-dotdot-unexistingpath',
++ $allowed_file
++ ) };
++is($ret, AZ_OK, 'Member extraction passed');
++ok(-e $allowed_file, 'File created');
++ok(unlink($allowed_file), 'File removed');
++
++# Case 3:
++# link-file -> /tmp/gotcha-samename
++# link-file
++# writes into /tmp/gotcha-samename. It must abort. (Or replace the symlink in
++# more relaxed mode in the future.)
++$zip = Archive::Zip->new();
++isa_ok($zip, 'Archive::Zip');
++is($zip->read(File::Spec->catfile(@data_path, 'link-samename.zip')), AZ_OK,
++ 'Archive read');
++$existed = -e File::Spec->catfile('', 'tmp', 'gotcha-samename');
++$ret = eval { $zip->extractTree() };
++is($ret, AZ_ERROR, 'Tree extraction aborted');
++SKIP: {
++ skip 'A canary file existed before the test', 1 if $existed;
++ ok(! -e File::Spec->catfile('', 'tmp', 'gotcha-samename'),
++ 'A file was not created through a symlinked file');
++}
++ok(unlink(File::Spec->catfile('link-file')), 'link-file removed');
++
++# The same applies to extracting an archive member using extractMember()
++# without an explicit local file name. It must abort.
++my $link = 'link-file';
++my $target = 'target';
++ok(symlink($target, $link), 'A symlink to a file created');
++$forbidden_file = File::Spec->catfile($target);
++$existed = -e $forbidden_file;
++# Select a member by order due to same file names.
++my $member = ${[$zip->members]}[1];
++ok($member, 'A member to extract selected');
++$ret = eval { $zip->extractMember($member) };
++is($ret, AZ_ERROR,
++ 'Member extraction using extractMember() without a local name aborted');
++SKIP: {
++ skip 'A canary file existed before the test', 1 if $existed;
++ ok(! -e $forbidden_file,
++ 'A symlinked target file was not created');
++}
++
++# But allow extracting an archive member using extractMember() into a supplied
++# file name.
++$allowed_file = $target;
++$ret = eval { $zip->extractMember($member, $allowed_file) };
++is($ret, AZ_OK, 'Member extraction using extractMember() passed');
++ok(-e $allowed_file, 'File created');
++ok(unlink($allowed_file), 'File removed');
++
++# The same applies to extracting an archive member using
++# extractMemberWithoutPaths() without an explicit local file name.
++# It must abort.
++$existed = -e $forbidden_file;
++# Select a member by order due to same file names.
++$ret = eval { $zip->extractMemberWithoutPaths($member) };
++is($ret, AZ_ERROR,
++ 'Member extraction using extractMemberWithoutPaths() without a local name aborted');
++SKIP: {
++ skip 'A canary file existed before the test', 1 if $existed;
++ ok(! -e $forbidden_file,
++ 'A symlinked target file was not created');
++}
++
++# But allow extracting an archive member using extractMemberWithoutPaths()
++# into a supplied file name.
++$allowed_file = $target;
++$ret = eval { $zip->extractMemberWithoutPaths($member, $allowed_file) };
++is($ret, AZ_OK, 'Member extraction using extractMemberWithoutPaths() passed');
++ok(-e $allowed_file, 'File created');
++ok(unlink($allowed_file), 'File removed');
++ok(unlink($link), 'A symlink to a file removed');
++
No comments:
Post a Comment