Attachment #52935 for bug #79685

View | Details | Raw Unified | Return to bug 79685
Collapse All | Expand All




++ perl-5.8.4/lib/File/Path.pm


=item *

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.
than VMS is settled.  (defaults to FALSE)

=back

It returns the number of files successfully deleted.  Symlinks are
simply deleted and not followed.

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 DIAGNOSTICS

=over 4

use Exporter ();
use strict;
use warnings;
use Cwd 'getcwd';

our $VERSION = "1.06";
our @ISA = qw( Exporter );

    @created;
}

sub _rmtree;
sub _rmtree
{
    my ($path, $prefix, $up, $up_dev, $up_ino, $verbose, $safe) = @_;

    my ($dev, $ino) = lstat $path or do {
    	carp "Can't stat $prefix$path ($!)" unless $!{ENOENT};
	return 0;
    };

    unless (-d _)
    {
	print "unlink $prefix$path\n" if $verbose;
	unless (unlink $path)
	{
	    carp "Can't remove file $prefix$path ($!)";
	    return 0;
    	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: 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, ($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 = ();
	    }

	return 1;
    }

    unless (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 '.';
    unless ("$new_dev:$new_ino" eq "$dev:$ino")
    {
	croak "Directory $prefix$path changed before chdir, aborting";
    }

    $perm &= 07777;
    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;
		next;
	    }
	    chmod 0666, $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;
		}
		++$count;
		last unless $Is_VMS && lstat $root;
	    }
	}

	closedir $dir;
    }

    # restore directory permissions if required (in case the rmdir
    # below fails) now, while we're still in the directory and may do
    # so without a race via '.'
    unless ($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 = $> ? 0 : 1 unless defined $safe;

    unless (@paths)
    {
	carp "No root path(s) specified";
	return;
    }

    my $oldpwd = getcwd or do {
	carp "Can't fetch initial working directory";
	return;
    };

    my ($dev, $ino) = stat '.' or do {
	carp "Can't stat initial working directory";
	return;
    };

    # untaint
    for ($oldpwd) { /^(.*)$/s; $_ = $1 }

    my $count = 0;
    for my $path (@paths)
    {
	$count += _rmtree $path, '', $oldpwd, $dev, $ino, $verbose, $safe;
    }

    $count;

Return to bug 79685

Line Link Here

(-)file_not_specified_in_diff (-118 / +131 lines)
0	-- perl-5.8.4.orig/lib/File/Path.pm	0	++ perl-5.8.4/lib/File/Path.pm
Lines 72-98 Link Here
72		72
73	=item *	73	=item *
74		74
75	a boolean value, which if TRUE will cause C<rmtree> to	75	a boolean value, which if FALSE (the default for non-root users) will
76	skip any files to which you do not have delete access	76	cause C<rmtree> to adjust the mode of directories (if required) prior
77	(if running under VMS) or write access (if running	77	to attempting to remove the contents. Note that on interruption or
78	under another OS). This will change in the future when	78	failure of C<rmtree>, directories may be left with more permissive
79	a criterion for 'delete permission' under OSs other	79	modes for the owner.
80	than VMS is settled. (defaults to FALSE)
81		80
82	=back	81	=back
83		82
84	It returns the number of files successfully deleted. Symlinks are	83	It returns the number of files successfully deleted. Symlinks are
85	simply deleted and not followed.	84	simply deleted and not followed.
86		85
87	B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
88	in the face of failure or interruption. Files and directories which
89	were not deleted may be left with permissions reset to allow world
90	read and write access. Note also that the occurrence of errors in
91	rmtree can be determined I<only> by trapping diagnostic messages
92	using C<$SIG{__WARN__}>; it is not apparent from the return value.
93	Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0)>
94	in situations where security is an issue.
95
96	=head1 DIAGNOSTICS	86	=head1 DIAGNOSTICS
97		87
98	=over 4	88	=over 4
Lines 118-123 Link Here
118	use Exporter ();	108	use Exporter ();
119	use strict;	109	use strict;
120	use warnings;	110	use warnings;
		111	use Cwd 'getcwd';
121		112
122	our $VERSION = "1.06";	113	our $VERSION = "1.06";
123	our @ISA = qw( Exporter );	114	our @ISA = qw( Exporter );
Lines 166-276 Link Here
166	@created;	157	@created;
167	}	158	}
168		159
169	sub rmtree {	160	sub _rmtree;
170	my($roots, $verbose, $safe) = @_;	161	sub _rmtree
171	my(@files);	162	{
172	my($count) = 0;	163	my ($path, $prefix, $up, $up_dev, $up_ino, $verbose, $safe) = @_;
173	$verbose \|\|= 0;	164
174	$safe \|\|= 0;	165	my ($dev, $ino) = lstat $path or do {
175		166	carp "Can't stat $prefix$path ($!)" unless $!{ENOENT};
176	if ( defined($roots) && length($roots) ) {	167	return 0;
177	$roots = [$roots] unless ref $roots;	168	};
178	}	169
179	else {	170	unless (-d _)
180	carp "No root path(s) specified\n";	171	{
181	return 0;	172	print "unlink $prefix$path\n" if $verbose;
182	}	173	unless (unlink $path)
183		174	{
184	my($root);	175	carp "Can't remove file $prefix$path ($!)";
185	foreach $root (@{$roots}) {	176	return 0;
186	if ($Is_MacOS) {
187	$root = ":$root" if $root !~ /:/;
188	$root =~ s#([^:])\z#$1:#;
189	} else {
190	$root =~ s#/\z##;
191	}	177	}
192	(undef, undef, my $rp) = lstat $root or next;
193	$rp &= 07777; # don't forget setuid, setgid, sticky bits
194	if ( -d _ ) {
195	# notabene: 0777 is for making readable in the first place,
196	# it's also intended to change it to writable in case we have
197	# to recurse in which case we are better than rm -rf for
198	# subtrees with strange permissions
199	chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
200	or carp "Can't make directory $root read+writeable: $!"
201	unless $safe;
202
203	if (opendir my $d, $root) {
204	no strict 'refs';
205	if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
206	# Blindly untaint dir names
207	@files = map { /^(.*)$/s ; $1 } readdir $d;
208	} else {
209	@files = readdir $d;
210	}
211	closedir $d;
212	}
213	else {
214	carp "Can't read $root: $!";
215	@files = ();
216	}
217		178
218	# Deleting large numbers of files from VMS Files-11 filesystems	179	return 1;
219	# is faster if done in reverse ASCIIbetical order	180	}
220	@files = reverse @files if $Is_VMS;	181
221	($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;	182	unless (chdir $path)
222	if ($Is_MacOS) {	183	{
223	@files = map("$root$_", @files);	184	carp "Can't chdir to $prefix$path ($!)";
224	} else {	185	return 0;
225	@files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);	186	}
226	}	187
227	$count += rmtree(\@files,$verbose,$safe);	188	# avoid a race condition where a directory may be replaced by a
228	if ($safe &&	189	# symlink between the lstat and the chdir
229	($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {	190	my ($new_dev, $new_ino, $perm) = stat '.';
230	print "skipped $root\n" if $verbose;	191	unless ("$new_dev:$new_ino" eq "$dev:$ino")
231	next;	192	{
232	}	193	croak "Directory $prefix$path changed before chdir, aborting";
233	chmod 0777, $root	194	}
234	or carp "Can't make directory $root writeable: $!"	195
235	if $force_writeable;	196	$perm &= 07777;
236	print "rmdir $root\n" if $verbose;	197	my $nperm = $perm \| 0700;
237	if (rmdir $root) {	198	unless ($safe or $nperm == $perm or chmod $nperm, '.')
238	++$count;	199	{
239	}	200	carp "Can't make directory $prefix$path read+writeable ($!)";
240	else {	201	$nperm = $perm;
241	carp "Can't remove directory $root: $!";	202	}
242	chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))	203
243	or carp("and can't restore permissions to "	204	my $count = 0;
244	. sprintf("0%o",$rp) . "\n");	205	if (opendir my $dir, '.')
245	}	206	{
246	}	207	my $entry;
247	else {	208	while (defined ($entry = readdir $dir))
248	if ($safe &&	209	{
249	($Is_VMS ? !&VMS::Filespec::candelete($root)	210	next if $entry =~ /^\.\.?$/;
250	: !(-l $root \|\| -w $root)))	211	$entry =~ /^(.*)$/s; $entry = $1; # untaint
251	{	212	$count += _rmtree $entry, "$prefix$path/", '..', $dev, $ino,
252	print "skipped $root\n" if $verbose;	213	$verbose, $safe;
253	next;
254	}
255	chmod 0666, $root
256	or carp "Can't make file $root writeable: $!"
257	if $force_writeable;
258	print "unlink $root\n" if $verbose;
259	# delete all versions under VMS
260	for (;;) {
261	unless (unlink $root) {
262	carp "Can't unlink file $root: $!";
263	if ($force_writeable) {
264	chmod $rp, $root
265	or carp("and can't restore permissions to "
266	. sprintf("0%o",$rp) . "\n");
267	}
268	last;
269	}
270	++$count;
271	last unless $Is_VMS && lstat $root;
272	}
273	}	214	}
		215
		216	closedir $dir;
		217	}
		218
		219	# restore directory permissions if required (in case the rmdir
		220	# below fails) now, while we're still in the directory and may do
		221	# so without a race via '.'
		222	unless ($nperm == $perm or chmod $perm, '.')
		223	{
		224	carp "Can't restore permissions on directory $prefix$path ($!)";
		225	}
		226
		227	# don't leave the caller in an unexpected directory
		228	unless (chdir $up)
		229	{
		230	croak "Can't return to $up from $prefix$path ($!)";
		231	}
		232
		233	# ensure that a chdir .. didn't take us somewhere other than
		234	# where we expected (see CVE-2002-0435)
		235	unless (($new_dev, $new_ino) = stat '.'
		236	and "$new_dev:$new_ino" eq "$up_dev:$up_ino")
		237	{
		238	croak "Previous directory $up changed since entering $prefix$path";
		239	}
		240
		241	print "rmdir $prefix$path\n" if $verbose;
		242	if (rmdir $path)
		243	{
		244	$count++;
		245	}
		246	else
		247	{
		248	carp "Can't remove directory $prefix$path ($!)";
		249	}
		250
		251	return $count;
		252	}
		253
		254	sub rmtree
		255	{
		256	my ($p, $verbose, $safe) = @_;
		257	$p = [] unless defined $p and length $p;
		258	$p = [ $p ] unless ref $p;
		259	my @paths = grep defined && length, @$p;
		260
		261	# default to "unsafe" for non-root (will chmod dirs)
		262	$safe = $> ? 0 : 1 unless defined $safe;
		263
		264	unless (@paths)
		265	{
		266	carp "No root path(s) specified";
		267	return;
		268	}
		269
		270	my $oldpwd = getcwd or do {
		271	carp "Can't fetch initial working directory";
		272	return;
		273	};
		274
		275	my ($dev, $ino) = stat '.' or do {
		276	carp "Can't stat initial working directory";
		277	return;
		278	};
279
280	# untaint
281	for ($oldpwd) { /^(.*)$/s; $_ = $1 }
282
283	my $count = 0;
284	for my $path (@paths)
285	{
286	$count += _rmtree $path, '', $oldpwd, $dev, $ino, $verbose, $safe;
274	}	287	}
275		288
276	$count;	289	$count;