(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)
+than VMS is settled. (defaults to FALSE)
=back
-It returns the number of files successfully deleted. Symlinks are
+It returns the number of files successfully deleted. Symlinks are
treated as ordinary files.
+B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
+in the face of failure or interruption. Files and directories which
+were not deleted may be left with permissions reset to allow world
+read and write access. Note also that the occurrence of errors in
+rmtree can be determined I<only> by trapping diagnostic messages
+using C<$SIG{__WARN__}>; it is not apparent from the return value.
+Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0>
+in situations where security is an issue.
+
=head1 AUTHORS
-Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt>
-Charles Bailey E<lt>F<bailey@genetics.upenn.edu>E<gt>
+Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
+Charles Bailey <F<bailey@genetics.upenn.edu>>
=head1 REVISION
-Current $VERSION is 1.02.
+Current $VERSION is 1.04.
=cut
use strict;
use vars qw( $VERSION @ISA @EXPORT );
-$VERSION = "1.02";
+$VERSION = "1.04";
@ISA = qw( Exporter );
@EXPORT = qw( mkpath rmtree );
my $parent = File::Basename::dirname($path);
push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent);
print "mkdir $path\n" if $verbose;
- mkdir($path,$mode) || croak "mkdir $path: $!";
+ unless (mkdir($path,$mode)) {
+ # allow for another process to have created it meanwhile
+ croak "mkdir $path: $!" unless -d $path;
+ }
push(@created, $path);
}
@created;
my($root);
foreach $root (@{$roots}) {
$root =~ s#/$##;
- $count++, next unless -e $root;
- if (not -l $root and -d _) {
+ (undef, undef, my $rp) = lstat $root or next;
+ $rp &= 07777; # don't forget setuid, setgid, sticky bits
+ if ( -d _ ) {
# notabene: 0777 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 0777, $root
+ chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
or carp "Can't make directory $root read+writeable: $!"
unless $safe;
or carp "Can't make directory $root writeable: $!"
if $force_writeable;
print "rmdir $root\n" if $verbose;
- rmdir($root) && ++$count
- or carp "Can't remove directory $root: $!";
+ 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");
+ }
}
else {
if ($safe &&
print "unlink $root\n" if $verbose;
# delete all versions under VMS
while (-e $root || -l $root) {
- unlink($root) && ++$count
- or croak "Can't unlink file $root: $!";
+ if (unlink $root) {
+ ++$count;
+ }
+ else {
+ 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");
+ }
+ }
}
}
}