This is mostly an FYI. The patch below might not yet be suitable for blead as the MacOS and VMS special cases found in the old rmtree are not taken care of.
For ActivePerl we have updated File::Path's rmtree based on Debian's patch <http://www.debian.org/security/2005/dsa-696> with these enhancements: - restore '$force_writeable' behaviour (for Windows) - make rmtree able to delete directories lacking 'x' permissions (the old rmtree could do this). - avoid loading of Errno (so that miniperl can use the function) - some stylistic and typo fixes This is how our File::Path now differs from the one found at rsync://ftp.linux.activestate.com/perl-5.8.x: --- lib/File/Path.pm 2005-05-05 09:16:20.000000000 -0700 +++ lib/File/Path.pm 2005-07-15 13:33:15.000000000 -0700 @@ -33,7 +33,7 @@ =item * the numeric mode to use when creating the directories -(defaults to 0777), to be modified by the current umask. +(defaults to 0777) =back @@ -72,33 +72,17 @@ =item * -a boolean value, which if TRUE will cause C<rmtree> to -skip any files to which you do not have delete access -(if running under VMS) or write access (if running -under another OS). This will change in the future when -a criterion for 'delete permission' under OSs other -than VMS is settled. (defaults to FALSE) +a boolean value, which if FALSE (the default for non-root users) will +cause C<rmtree> to adjust the mode of directories (if required) prior +to attempting to remove the contents. Note that on interruption or +failure of C<rmtree>, directories may be left with more permissive +modes for the owner. =back It returns the number of files successfully deleted. Symlinks are simply deleted and not followed. -B<NOTE:> There are race conditions internal to the implementation of -C<rmtree> making it unsafe to use on directory trees which may be -altered or moved while C<rmtree> is running, and in particular on any -directory trees with any path components or subdirectories potentially -writable by untrusted users. - -Additionally, if the third parameter is not TRUE and C<rmtree> is -interrupted, it may leave files and directories with permissions altered -to allow deletion (and older versions of this module would even set -files and directories to world-read/writable!) - -Note also that the occurrence of errors in C<rmtree> can be determined I<only> -by trapping diagnostic messages using C<$SIG{__WARN__}>; it is not apparent -from the return value. - =head1 DIAGNOSTICS =over 4 @@ -124,8 +108,9 @@ use Exporter (); use strict; use warnings; +use Cwd 'getcwd'; -our $VERSION = "1.07"; +our $VERSION = "1.06"; our @ISA = qw( Exporter ); our @EXPORT = qw( mkpath rmtree ); @@ -172,111 +157,150 @@ @created; } -sub rmtree { - my($roots, $verbose, $safe) = @_; - my(@files); - my($count) = 0; - $verbose ||= 0; - $safe ||= 0; - - if ( defined($roots) && length($roots) ) { - $roots = [$roots] unless ref $roots; - } - else { - carp "No root path(s) specified\n"; - return 0; - } - - my($root); - foreach $root (@{$roots}) { - if ($Is_MacOS) { - $root = ":$root" if $root !~ /:/; - $root =~ s#([^:])\z#$1:#; - } else { - $root =~ s#/\z##; - } - (undef, undef, my $rp) = lstat $root or next; - $rp &= 07777; # don't forget setuid, setgid, sticky bits - if ( -d _ ) { - # notabene: 0700 is for making readable in the first place, - # it's also intended to change it to writable in case we have - # to recurse in which case we are better than rm -rf for - # subtrees with strange permissions - chmod($rp | 0700, ($Is_VMS ? VMS::Filespec::fileify($root) : $root)) - or carp "Can't make directory $root read+writeable: $!" - unless $safe; - - if (opendir my $d, $root) { - no strict 'refs'; - if (!defined ${"\cTAINT"} or ${"\cTAINT"}) { - # Blindly untaint dir names - @files = map { /^(.*)$/s ; $1 } readdir $d; - } else { - @files = readdir $d; - } - closedir $d; - } - else { - carp "Can't read $root: $!"; - @files = (); - } - - # Deleting large numbers of files from VMS Files-11 filesystems - # is faster if done in reverse ASCIIbetical order - @files = reverse @files if $Is_VMS; - ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS; - if ($Is_MacOS) { - @files = map("$root$_", @files); - } else { - @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files); - } - $count += rmtree([EMAIL PROTECTED],$verbose,$safe); - if ($safe && - ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) { - print "skipped $root\n" if $verbose; - next; - } - chmod $rp | 0700, $root - or carp "Can't make directory $root writeable: $!" - if $force_writeable; - print "rmdir $root\n" if $verbose; - if (rmdir $root) { - ++$count; - } - else { - carp "Can't remove directory $root: $!"; - chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root)) - or carp("and can't restore permissions to " - . sprintf("0%o",$rp) . "\n"); +sub _rmtree +{ + my ($path, $prefix, $up, $up_dev, $up_ino, $verbose, $safe) = @_; + + my ($dev, $ino, $perm) = lstat $path or do { + return 0; + }; + $perm &= 07777; + + unless (-d _) + { + my $nperm; + if ($force_writeable) { + # make the file writable + $nperm = $perm | 0600; + unless ($safe or $nperm == $perm or chmod $nperm, $path) { + carp "Can't make file $prefix$path writeable: $!"; } } - else { - if ($safe && - ($Is_VMS ? !&VMS::Filespec::candelete($root) - : !(-l $root || -w $root))) - { - print "skipped $root\n" if $verbose; - next; - } - chmod $rp | 0600, $root - or carp "Can't make file $root writeable: $!" - if $force_writeable; - print "unlink $root\n" if $verbose; - # delete all versions under VMS - for (;;) { - unless (unlink $root) { - carp "Can't unlink file $root: $!"; - if ($force_writeable) { - chmod $rp, $root - or carp("and can't restore permissions to " - . sprintf("0%o",$rp) . "\n"); - } - last; + print "unlink $prefix$path\n" if $verbose; + unless (unlink $path) + { + carp "Can't remove file $prefix$path ($!)"; + if ($force_writeable) { + unless ($safe or $nperm == $perm or chmod $perm, $path) { + carp("and can't restore permissions to " + . sprintf("0%o",$perm) . "\n"); } - ++$count; - last unless $Is_VMS && lstat $root; } + return 0; + } + return 1; + } + + CHDIR: { + last CHDIR if chdir $path; + my $err = $!; + unless ($safe || ($perm & 0100)) { + # might be able to succeed by tweaking the permission + # before we chdir + last CHDIR if chmod(0700, $path) && chdir($path); + } + carp "Can't chdir to $prefix$path ($err)"; + return 0; + } + + # avoid a race condition where a directory may be replaced by a + # symlink between the initial lstat and the chdir + my ($new_dev, $new_ino) = stat '.'; + unless ("$new_dev:$new_ino" eq "$dev:$ino") + { + croak "Directory $prefix$path changed before chdir, aborting"; + } + + my $nperm = $perm | 0700; + unless ($safe or $nperm == $perm or chmod $nperm, '.') + { + carp "Can't make directory $prefix$path read+writeable ($!)"; + $nperm = $perm; + } + + my $count = 0; + if (opendir my $dir, '.') + { + my $entry; + while (defined ($entry = readdir $dir)) + { + next if $entry =~ /^\.\.?$/; + $entry =~ /^(.*)$/s; $entry = $1; # untaint + $count += _rmtree($entry, "$prefix$path/", '..', $dev, $ino, + $verbose, $safe); } + + closedir $dir; + } + + # restore directory permissions is required (in case the rmdir + # below fails) now, while we're still in the directory and may do + # so without a race via '.' + unless ($force_writeable or $safe or $nperm == $perm or chmod $perm, '.') + { + carp "Can't restore permissions on directory $prefix$path ($!)"; + } + + # don't leave the caller in an unexpected directory + unless (chdir $up) + { + croak "Can't return to $up from $prefix$path ($!)"; + } + + # ensure that a chdir .. didn't take us somewhere other than + # where we expected (see CVE-2002-0435) + unless (($new_dev, $new_ino) = stat '.' + and "$new_dev:$new_ino" eq "$up_dev:$up_ino") + { + croak "Previous directory $up changed since entering $prefix$path"; + } + + print "rmdir $prefix$path\n" if $verbose; + if (rmdir $path) + { + $count++; + } + else + { + carp "Can't remove directory $prefix$path ($!)"; + } + + return $count; +} + +sub rmtree +{ + my ($p, $verbose, $safe) = @_; + $p = [] unless defined $p and length $p; + $p = [ $p ] unless ref $p; + my @paths = grep defined && length, @$p; + + # default to "unsafe" for non-root (will chmod dirs) + $safe = ($> || $force_writeable) ? 0 : 1 unless defined $safe; + + unless (@paths) + { + carp "No root path(s) specified"; + return 0; + } + + my $oldpwd = getcwd or do { + carp "Can't fetch initial working directory"; + return 0; + }; + + my ($dev, $ino) = stat '.' or do { + carp "Can't stat initial working directory"; + return 0; + }; + + # untaint + for ($oldpwd) { /^(.*)$/s; $_ = $1 } + + my $count = 0; + for my $path (@paths) + { + $count += _rmtree($path, '', $oldpwd, $dev, $ino, $verbose, $safe); } $count; -- Gisle Aas, ActiveState
