File perl-Archive-Zip-CVE-2018-10860.patch of Package perl-Archive-Zip.8321

Index: Archive-Zip-1.60/lib/Archive/Zip/Archive.pm
===================================================================
--- Archive-Zip-1.60.orig/lib/Archive/Zip/Archive.pm	2017-12-19 19:41:58.000000000 +0100
+++ Archive-Zip-1.60/lib/Archive/Zip/Archive.pm	2018-08-10 17:29:41.678672685 +0200
@@ -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;
     }