path: root/dev-perl/Archive-Zip/files/Archive-Zip-1.60-CVE-2018-10860.patch

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