File perl-file_path_rmtree_fchmod.diff of Package perl.33799

--- cpan/ExtUtils-MakeMaker/t/eu_command.t.orig	2017-07-18 22:59:59.000000000 +0000
+++ cpan/ExtUtils-MakeMaker/t/eu_command.t	2022-09-02 14:13:22.736782886 +0000
@@ -151,19 +151,19 @@ BEGIN {
         is( ((stat('testdir'))[2] & 07777) & 0700,
             0100, 'change a dir to execute-only' );
 
-        # change a dir to read-only
-        @ARGV = ( '0400', 'testdir' );
+        # change a dir to write-only
+        @ARGV = ( '0200', 'testdir' );
         ExtUtils::Command::chmod();
 
         is( ((stat('testdir'))[2] & 07777) & 0700,
-            0400, 'change a dir to read-only' );
+            0200, 'change a dir to write-only' );
 
-        # change a dir to write-only
-        @ARGV = ( '0200', 'testdir' );
+        # change a dir to read-only
+        @ARGV = ( '0400', 'testdir' );
         ExtUtils::Command::chmod();
 
         is( ((stat('testdir'))[2] & 07777) & 0700,
-            0200, 'change a dir to write-only' );
+            0400, 'change a dir to read-only' );
 
         @ARGV = ('testdir');
         rm_rf;
--- cpan/File-Path/lib/File/Path.pm.orig	2017-07-18 22:59:59.000000000 +0000
+++ cpan/File-Path/lib/File/Path.pm	2022-09-02 14:09:39.657163146 +0000
@@ -354,21 +354,32 @@ sub _rmtree {
 
                 # see if we can escalate privileges to get in
                 # (e.g. funny protection mask such as -w- instead of rwx)
-                $perm &= oct '7777';
-                my $nperm = $perm | oct '700';
-                if (
-                    !(
-                           $arg->{safe}
-                        or $nperm == $perm
-                        or chmod( $nperm, $root )
-                    )
-                  )
-                {
-                    _error( $arg,
-                        "cannot make child directory read-write-exec", $canon );
-                    next ROOT_DIR;
+                # This uses fchmod to avoid traversing outside of the proper
+                # location (CVE-2017-6512)
+                my $root_fh;
+                if (open($root_fh, '<', $root)) {
+                    my ($fh_dev, $fh_inode) = (stat $root_fh )[0,1];
+                    $perm &= oct '7777';
+                    my $nperm = $perm | oct '700';
+                    local $@;
+                    if (
+                        !(
+                            $arg->{safe}
+                            or $nperm == $perm
+                            or !-d _
+                            or $fh_dev ne $ldev
+                            or $fh_inode ne $lino
+                            or eval { chmod( $nperm, $root_fh ) }
+                         )
+                       )
+                    {
+                        _error($arg,
+                            "cannot make child directory read-write-exec", $canon);
+                        next ROOT_DIR;
+                    }
+                    close $root_fh;
                 }
-                elsif ( !chdir($root) ) {
+                if ( !chdir($root) ) {
                     _error( $arg, "cannot chdir to child", $canon );
                     next ROOT_DIR;
                 }
--- cpan/File-Path/t/Path.t.orig	2017-07-18 22:59:59.000000000 +0000
+++ cpan/File-Path/t/Path.t	2022-09-02 15:26:48.353242370 +0000
@@ -3,7 +3,7 @@
 
 use strict;
 
-use Test::More tests => 127;
+use Test::More tests => 126;
 use Config;
 use Fcntl ':mode';
 use lib 't/';
@@ -301,13 +301,13 @@ is(rmtree($dir, 0, undef), 1, "removed d
 $dir = catdir($tmp_base,'G');
 $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 
-@created = mkpath($dir, undef, 0200);
+@created = mkpath($dir, undef, 0400);
 
-is(scalar(@created), 1, "created write-only dir");
+is(scalar(@created), 1, "created read-only dir");
 
-is($created[0], $dir, "created write-only directory cross-check");
+is($created[0], $dir, "created read-only directory cross-check");
 
-is(rmtree($dir), 1, "removed write-only dir");
+is(rmtree($dir), 1, "removed read-only dir");
 
 # borderline new-style heuristics
 if (chdir $tmp_base) {
@@ -458,11 +458,11 @@ SKIP : {
     my $mode;
     my $octal_mode;
     my @inputs = (
-      0777, 0700, 0070, 0007,
-      0333, 0300, 0030, 0003,
-      0111, 0100, 0010, 0001,
-      0731, 0713, 0317, 0371, 0173, 0137,
-      00 );
+      0777, 0700, 0470, 0407,
+      0433, 0400, 0430, 0403,
+      0111, 0100, 0110, 0101,
+      0731, 0713, 0317, 0371,
+      0173, 0137);
     my $input;
     my $octal_input;
     $dir = catdir($tmp_base, 'chmod_test');
--- t/porting/customized.dat.orig	2022-09-02 15:10:40.758917198 +0000
+++ t/porting/customized.dat	2022-09-02 15:11:32.822828168 +0000
@@ -1,7 +1,7 @@
 Digest cpan/Digest/Digest.pm 43f7f544cb11842b2f55c73e28930da50774e081
 Encode cpan/Encode/Unicode/Unicode.pm 9749692c67f7d69083034de9184a93f070ab4799
 ExtUtils::Constant cpan/ExtUtils-Constant/t/Constant.t a0369c919e216fb02767a637666bb4577ad79b02
-File::Path cpan/File-Path/lib/File/Path.pm fd8ce4420a0c113d3f47dd3223859743655c1da8
+File::Path cpan/File-Path/lib/File/Path.pm ff1817fcd4f88629e7be620f83cdbc4eaaf9211a
 File::Path cpan/File-Path/t/Path_win32.t 94b9276557ce7f80b91f6fd9bfa7a0cd9bf9683e
 JSON::PP cpan/JSON-PP/bin/json_pp a7b8de6c201ef177ee82624ee4ca6a47cc1a3b4f
 JSON::PP cpan/JSON-PP/lib/JSON/PP.pm 86f697dae482106270fdd659b18c95a54af764ba