31 lines
1.1 KiB
Diff
31 lines
1.1 KiB
Diff
|
A simple test case for this bug is:
|
||
|
|
||
|
touch foo # permissions 0666 & ~umask
|
||
|
ln -s foo bar
|
||
|
perl -e 'use File::Path rmtree; rmtree bar'
|
||
|
ls -l foo # permissions 0777
|
||
|
|
||
|
The following patch fixes that and the originally reported problem. I
|
||
|
believe the other chmod() calls in the _rmtree subroutine will never be
|
||
|
applied to a sym-link if either (1) no concurrent modifications of the
|
||
|
directory tree or (2) the 'safe' option is used. It would be worthwhile
|
||
|
for someone else to double-check that, though.
|
||
|
|
||
|
Ben.
|
||
|
|
||
|
--- lib/File/Path.pm.orig
|
||
|
+++ lib/File/Path.pm
|
||
|
@@ -351,10 +351,8 @@
|
||
|
}
|
||
|
|
||
|
my $nperm = $perm & 07777 | 0600;
|
||
|
- if ($nperm != $perm and not chmod $nperm, $root) {
|
||
|
- if ($Force_Writeable) {
|
||
|
- _error($arg, "cannot make file writeable", $canon);
|
||
|
- }
|
||
|
+ if ($Force_Writeable && $nperm != $perm and not chmod $nperm, $root) {
|
||
|
+ _error($arg, "cannot make file writeable", $canon);
|
||
|
}
|
||
|
print "unlink $canon\n" if $arg->{verbose};
|
||
|
# delete all versions under VMS
|