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

Index: Archive-Zip-1.34/lib/Archive/Zip/Archive.pm
===================================================================
--- Archive-Zip-1.34.orig/lib/Archive/Zip/Archive.pm	2013-12-02 19:38:54.000000000 +0100
+++ Archive-Zip-1.34/lib/Archive/Zip/Archive.pm	2018-08-08 15:30:03.751453047 +0200
@@ -192,6 +192,8 @@ sub extractMember {
     }
     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);
@@ -226,6 +228,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, @_ );
@@ -832,6 +836,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.
@@ -868,6 +903,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;
     }