dev-perl/Archive-Zip: Add fix for CVE-2018-10860 bug #660466

This includes upstreams fixes and tests including binary files
presented as textual diffs, which appears to work.

Upstream testing indicates there are potential issues with tests on
some systems, and so it may not be suitable as-is for stabilization

See Github PR mentioned below for additional details.

Bug: https://bugs.gentoo.org/660466
Bug: https://bugzilla.redhat.com/show_bug.cgi?id=1591449
Bug: https://github.com/redhotpenguin/perl-Archive-Zip/pull/33
Package-Manager: Portage-2.3.40, Repoman-2.3.9

2 files changed, 430 insertions, 0 deletions

diff --git a/dev-perl/Archive-Zip/Archive-Zip-1.600.0-r1.ebuild b/dev-perl/Archive-Zip/Archive-Zip-1.600.0-r1.ebuild
new file mode 100644
index 000000000000..2b727f01eb34
--- /dev/null
+++ b/dev-perl/Archive-Zip/Archive-Zip-1.600.0-r1.ebuild
@@ -0,0 +1,35 @@
+# Copyright 1999-2018 Gentoo Foundation
+# Distributed under the terms of the GNU General Public License v2
+
+EAPI=6
+
+DIST_AUTHOR=PHRED
+DIST_VERSION=1.60
+DIST_EXAMPLES=("examples/*")
+inherit perl-module
+
+DESCRIPTION="A wrapper that lets you read Zip archive members as if they were files"
+
+SLOT="0"
+KEYWORDS="~alpha ~amd64 ~arm ~arm64 ~hppa ~ia64 ~ppc ~ppc64 ~sparc ~x86 ~x86-fbsd ~amd64-linux ~x86-linux ~ppc-macos ~x64-macos ~x86-macos ~sparc-solaris ~x64-solaris ~x86-solaris"
+IUSE="test"
+
+RDEPEND="
+	>=virtual/perl-Compress-Raw-Zlib-2.17.0
+	virtual/perl-File-Path
+	>=virtual/perl-File-Spec-0.800.0
+	virtual/perl-File-Temp
+	virtual/perl-IO
+	virtual/perl-Time-Local
+"
+DEPEND="${RDEPEND}
+	virtual/perl-ExtUtils-MakeMaker
+	test? (
+		dev-perl/Test-MockModule
+		>=virtual/perl-Test-Simple-0.880.0
+	)
+"
+
+PATCHES=(
+	"${FILESDIR}/${PN}-1.60-CVE-2018-10860.patch"
+)
diff --git a/dev-perl/Archive-Zip/files/Archive-Zip-1.60-CVE-2018-10860.patch b/dev-perl/Archive-Zip/files/Archive-Zip-1.60-CVE-2018-10860.patch
new file mode 100644
index 000000000000..94ade1abdfb4
--- /dev/null
+++ b/dev-perl/Archive-Zip/files/Archive-Zip-1.60-CVE-2018-10860.patch
@@ -0,0 +1,395 @@
+From 4c200ada6595c0add0de2c450cc44cebd1dbb609 Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
+Date: Fri, 15 Jun 2018 14:49:47 +0200
+Subject: Prevent from traversing symlinks and parent directories when
+ extracting
+
+If an attacker-supplied archive contains symbolic links and files that
+referes to the symbolic links in their path components, the user can
+be tricked into overwriting any arbitrary file.
+
+The same issue is with archives whose members refer to a parent
+directory (..) in their path components.
+
+This patch fixes it by aborting an extraction (extractTree(),
+extractMember(), extractMemberWithoutPaths()) in those cases by not
+traversing the dangerous paths and returning AZ_ERORR instead.
+
+However, if a user supplies a local file name, the security checks are
+not performed. This is based on the assumption that a user knows
+what's on his local file system.
+
+CVE-2018-10860
+Bug: https://bugzilla.redhat.com/show_bug.cgi?id=1591449
+Bug: https://bugs.gentoo.org/660466
+Bug: https://github.com/redhotpenguin/perl-Archive-Zip/pull/33
+---
+ MANIFEST                               |   3 +
+ lib/Archive/Zip.pm                     |   8 ++
+ lib/Archive/Zip/Archive.pm             |  37 +++++
+ t/25_traversal.t                       | 189 +++++++++++++++++++++++++
+ t/data/dotdot-from-unexistant-path.zip | Bin 0 -> 245 bytes
+ t/data/link-dir.zip                    | Bin 0 -> 260 bytes
+ t/data/link-samename.zip               | Bin 0 -> 257 bytes
+ 7 files changed, 237 insertions(+)
+ create mode 100644 t/25_traversal.t
+ create mode 100644 t/data/dotdot-from-unexistant-path.zip
+ create mode 100644 t/data/link-dir.zip
+ create mode 100644 t/data/link-samename.zip
+
+diff --git a/MANIFEST b/MANIFEST
+index 37d8b8d..dd9675a 100644
+--- a/MANIFEST
++++ b/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
+diff --git a/lib/Archive/Zip.pm b/lib/Archive/Zip.pm
+index ca82e31..907808b 100644
+--- a/lib/Archive/Zip.pm
++++ b/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). Otherwise,
+ 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
+diff --git a/lib/Archive/Zip/Archive.pm b/lib/Archive/Zip/Archive.pm
+index 48f0d1a..b0d3e46 100644
+--- a/lib/Archive/Zip/Archive.pm
++++ b/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;
+     }
+diff --git a/t/25_traversal.t b/t/25_traversal.t
+new file mode 100644
+index 0000000..d03dede
+--- /dev/null
++++ b/t/25_traversal.t
+@@ -0,0 +1,189 @@
++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');
+diff --git a/t/data/dotdot-from-unexistant-path.zip b/t/data/dotdot-from-unexistant-path.zip
+new file mode 100644
+index 0000000..faaa5bb
+--- /dev/null
++++ b/t/data/dotdot-from-unexistant-path.zip
+@@ -0,0 +1 @@
++PK
+\ No newline at end of file
+diff --git a/t/data/link-dir.zip b/t/data/link-dir.zip
+new file mode 100644
+index 0000000..99fbb43
+--- /dev/null
++++ b/t/data/link-dir.zip
+@@ -0,0 +1,4 @@
++PK
++
++PK

++
+\ No newline at end of file
+diff --git a/t/data/link-samename.zip b/t/data/link-samename.zip
+new file mode 100644
+index 0000000..e9036c0
+--- /dev/null
++++ b/t/data/link-samename.zip
+@@ -0,0 +1,2 @@
++PK
++PK

+\ No newline at end of file
+-- 
+2.17.1
+