Line
Link Here
|
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; |