summaryrefslogtreecommitdiff
blob: c75aa89369a8324cdc328ed53e43aa3f0697b275 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
ExtUtils/Command.pm (among other things) expects to be able to destroy
a strangely-permissioned testdir.  This is a backport of the chdir/chmod
work performed in File::Path released in Perl 5.10.0.

--- perl-5.8.7.orig/lib/File/Path.pm	2008-12-05 13:23:32.000000000 -0800
+++ perl-5.8.7/lib/File/Path.pm	2008-12-05 13:33:13.000000000 -0800
@@ -162,7 +162,7 @@
 {
     my ($path, $prefix, $up, $up_dev, $up_ino, $verbose, $safe) = @_;
 
-    my ($dev, $ino) = lstat $path or return 0;
+    my ($dev, $ino, $perm) = lstat $path or return 0;
     unless (-d _)
     {
 	print "unlink $prefix$path\n" if $verbose;
@@ -175,15 +175,25 @@
 	return 1;
     }
 
-    unless (chdir $path)
-    {
+    if (!chdir($path)) {
+        # see if we can escalate privileges to get in
+        # (e.g. funny protection mask such as -w- instead of rwx)
+        $perm &= 07777;
+        my $nperm = $perm | 0700;
+        if (!($safe or $nperm == $perm or chmod($nperm, $path))) {
+            carp "cannot make $prefix$path read-write-exec";
+            return 0;
+        }
+        elsif (!chdir($path)) {
 	carp "Can't chdir to $prefix$path ($!)";
 	return 0;
+        }
     }
 
     # avoid a race condition where a directory may be replaced by a
     # symlink between the lstat and the chdir
-    my ($new_dev, $new_ino, $perm) = stat '.';
+    my ($new_dev, $new_ino);
+    ($new_dev, $new_ino, $perm) = stat '.';
     unless ("$new_dev:$new_ino" eq "$dev:$ino")
     {
 	croak "Directory $prefix$path changed before chdir, aborting";
--- perl-5.8.8.orig/lib/ExtUtils/t/Command.t
+++ perl-5.8.8/lib/ExtUtils/t/Command.t
@@ -23,7 +23,7 @@
 }
 
 BEGIN {
-    use Test::More tests => 38;
+    use Test::More tests => 39;
     use File::Spec;
 }
 
@@ -148,7 +148,7 @@
             $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin'  ||
             $^O eq 'MacOS'
            ) {
-            skip( "different file permission semantics on $^O", 4);
+            skip( "different file permission semantics on $^O", 5);
         }
 
         @ARGV = ('testdir');
@@ -178,6 +178,7 @@
 
         @ARGV = ('testdir');
         rm_rf;
+        ok( ! -e 'testdir', 'rm_rf can delete a read-only dir' );
     }