| 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' ); |
| } |
| |
| |