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.
diff -u perl-5.10.0/patches-applied perl-5.10.0/patches-applied
--- perl-5.10.0/patches-applied
+++ perl-5.10.0/patches-applied
@@ -10,6 +10,7 @@
debian/patches/09_fix_memory_debugging
debian/patches/10_fix_h2ph_include_quote
debian/patches/11_disable_vstring_warning
+debian/patches/12_fix_file_path_rmtree_chmod
debian/patches/50_debian_use_gdbm
debian/patches/51_debian_ld_run_path
debian/patches/52_debian_extutils_hacks
only in patch2:
unchanged:
--- perl-5.10.0.orig/debian/patches/12_fix_file_path_rmtree_chmod
+++ perl-5.10.0/debian/patches/12_fix_file_path_rmtree_chmod
@@ -0,0 +1,15 @@
+--- perl.orig/lib/File/Path.pm 2007-12-18 10:47:07.000000000 +0000
++++ perl/lib/File/Path.pm 2008-06-21 00:08:45.000000000 +0100
+@@ -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
only in patch2:
unchanged:
--- perl-5.10.0.orig/lib/File/Path.pm
+++ perl-5.10.0/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
--- END ---
--
Ben Hutchings
Design a system any fool can use, and only a fool will want to use it.
signature.asc
Description: This is a digitally signed message part
