You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
73 lines
2.1 KiB
73 lines
2.1 KiB
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' );
|
|
}
|
|
|
|
|