Commit | Line | Data |
1fc4cb55 |
1 | package File::Path; |
fed7345c |
2 | |
cac619e8 |
3 | use 5.005_04; |
4 | use strict; |
5 | |
6 | use Cwd 'getcwd'; |
7 | use File::Basename (); |
8 | use File::Spec (); |
9 | |
10 | BEGIN { |
11 | if ($] < 5.006) { |
12 | # can't say 'opendir my $dh, $dirname' |
13 | # need to initialise $dh |
14 | eval "use Symbol"; |
15 | } |
16 | } |
17 | |
18 | use Exporter (); |
3f083399 |
19 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); |
839bc55a |
20 | $VERSION = '2.07_03'; |
30cf951a |
21 | @ISA = qw(Exporter); |
22 | @EXPORT = qw(mkpath rmtree); |
3f083399 |
23 | @EXPORT_OK = qw(make_path remove_tree); |
cac619e8 |
24 | |
30cf951a |
25 | my $Is_VMS = $^O eq 'VMS'; |
26 | my $Is_MacOS = $^O eq 'MacOS'; |
cac619e8 |
27 | |
28 | # These OSes complain if you want to remove a file that you have no |
29 | # write permission to: |
351a5cfe |
30 | my $Force_Writeable = grep {$^O eq $_} qw(amigaos dos epoc MSWin32 MacOS os2); |
cac619e8 |
31 | |
839bc55a |
32 | # Unix-like systems need to stat each directory in order to detect |
33 | # race condition. MS-Windows is immune to this particular attack. |
34 | my $Need_Stat_Check = !($^O eq 'MSWin32'); |
35 | |
cac619e8 |
36 | sub _carp { |
37 | require Carp; |
38 | goto &Carp::carp; |
39 | } |
40 | |
41 | sub _croak { |
42 | require Carp; |
43 | goto &Carp::croak; |
44 | } |
45 | |
46 | sub _error { |
47 | my $arg = shift; |
48 | my $message = shift; |
49 | my $object = shift; |
50 | |
51 | if ($arg->{error}) { |
52 | $object = '' unless defined $object; |
3f083399 |
53 | $message .= ": $!" if $!; |
54 | push @{${$arg->{error}}}, {$object => $message}; |
cac619e8 |
55 | } |
56 | else { |
57 | _carp(defined($object) ? "$message for $object: $!" : "$message: $!"); |
58 | } |
59 | } |
60 | |
3f083399 |
61 | sub make_path { |
2f9d49b4 |
62 | push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH'); |
3f083399 |
63 | goto &mkpath; |
64 | } |
65 | |
cac619e8 |
66 | sub mkpath { |
2f9d49b4 |
67 | my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH')); |
cac619e8 |
68 | |
69 | my $arg; |
70 | my $paths; |
71 | |
72 | if ($old_style) { |
73 | my ($verbose, $mode); |
74 | ($paths, $verbose, $mode) = @_; |
75 | $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY'); |
2f9d49b4 |
76 | $arg->{verbose} = $verbose; |
30cf951a |
77 | $arg->{mode} = defined $mode ? $mode : 0777; |
cac619e8 |
78 | } |
79 | else { |
30cf951a |
80 | $arg = pop @_; |
3f083399 |
81 | $arg->{mode} = delete $arg->{mask} if exists $arg->{mask}; |
30cf951a |
82 | $arg->{mode} = 0777 unless exists $arg->{mode}; |
83 | ${$arg->{error}} = [] if exists $arg->{error}; |
cac619e8 |
84 | $paths = [@_]; |
85 | } |
86 | return _mkpath($arg, $paths); |
87 | } |
88 | |
89 | sub _mkpath { |
90 | my $arg = shift; |
91 | my $paths = shift; |
92 | |
cac619e8 |
93 | my(@created,$path); |
94 | foreach $path (@$paths) { |
3f083399 |
95 | next unless defined($path) and length($path); |
cac619e8 |
96 | $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT |
97 | # Logic wants Unix paths, so go with the flow. |
98 | if ($Is_VMS) { |
99 | next if $path eq '/'; |
100 | $path = VMS::Filespec::unixify($path); |
101 | } |
102 | next if -d $path; |
103 | my $parent = File::Basename::dirname($path); |
104 | unless (-d $parent or $path eq $parent) { |
105 | push(@created,_mkpath($arg, [$parent])); |
106 | } |
107 | print "mkdir $path\n" if $arg->{verbose}; |
108 | if (mkdir($path,$arg->{mode})) { |
109 | push(@created, $path); |
110 | } |
111 | else { |
112 | my $save_bang = $!; |
113 | my ($e, $e1) = ($save_bang, $^E); |
114 | $e .= "; $e1" if $e ne $e1; |
115 | # allow for another process to have created it meanwhile |
116 | if (!-d $path) { |
117 | $! = $save_bang; |
118 | if ($arg->{error}) { |
119 | push @{${$arg->{error}}}, {$path => $e}; |
120 | } |
121 | else { |
122 | _croak("mkdir $path: $e"); |
123 | } |
124 | } |
125 | } |
126 | } |
127 | return @created; |
128 | } |
129 | |
3f083399 |
130 | sub remove_tree { |
2f9d49b4 |
131 | push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH'); |
3f083399 |
132 | goto &rmtree; |
133 | } |
134 | |
0e5b5e32 |
135 | sub _is_subdir { |
136 | my($dir, $test) = @_; |
137 | |
138 | my($dv, $dd) = File::Spec->splitpath($dir, 1); |
139 | my($tv, $td) = File::Spec->splitpath($test, 1); |
140 | |
141 | # not on same volume |
142 | return 0 if $dv ne $tv; |
143 | |
144 | my @d = File::Spec->splitdir($dd); |
145 | my @t = File::Spec->splitdir($td); |
146 | |
147 | # @t can't be a subdir if it's shorter than @d |
148 | return 0 if @t < @d; |
149 | |
150 | return join('/', @d) eq join('/', splice @t, 0, +@d); |
151 | } |
152 | |
cac619e8 |
153 | sub rmtree { |
2f9d49b4 |
154 | my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH')); |
cac619e8 |
155 | |
156 | my $arg; |
157 | my $paths; |
158 | |
159 | if ($old_style) { |
160 | my ($verbose, $safe); |
161 | ($paths, $verbose, $safe) = @_; |
2f9d49b4 |
162 | $arg->{verbose} = $verbose; |
cac619e8 |
163 | $arg->{safe} = defined $safe ? $safe : 0; |
164 | |
165 | if (defined($paths) and length($paths)) { |
166 | $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY'); |
167 | } |
168 | else { |
169 | _carp ("No root path(s) specified\n"); |
170 | return 0; |
171 | } |
172 | } |
173 | else { |
30cf951a |
174 | $arg = pop @_; |
175 | ${$arg->{error}} = [] if exists $arg->{error}; |
176 | ${$arg->{result}} = [] if exists $arg->{result}; |
cac619e8 |
177 | $paths = [@_]; |
178 | } |
179 | |
180 | $arg->{prefix} = ''; |
181 | $arg->{depth} = 0; |
182 | |
3f083399 |
183 | my @clean_path; |
cac619e8 |
184 | $arg->{cwd} = getcwd() or do { |
185 | _error($arg, "cannot fetch initial working directory"); |
186 | return 0; |
187 | }; |
188 | for ($arg->{cwd}) { /\A(.*)\Z/; $_ = $1 } # untaint |
189 | |
3f083399 |
190 | for my $p (@$paths) { |
c42ebacb |
191 | # need to fixup case and map \ to / on Windows |
192 | my $ortho_root = $^O eq 'MSWin32' ? _slash_lc($p) : $p; |
193 | my $ortho_cwd = $^O eq 'MSWin32' ? _slash_lc($arg->{cwd}) : $arg->{cwd}; |
194 | my $ortho_root_length = length($ortho_root); |
195 | $ortho_root_length-- if $^O eq 'VMS'; # don't compare '.' with ']' |
0e5b5e32 |
196 | if ($ortho_root_length && _is_subdir($ortho_root, $ortho_cwd)) { |
c42ebacb |
197 | local $! = 0; |
198 | _error($arg, "cannot remove path when cwd is $arg->{cwd}", $p); |
199 | next; |
200 | } |
201 | |
3f083399 |
202 | if ($Is_MacOS) { |
203 | $p = ":$p" unless $p =~ /:/; |
204 | $p .= ":" unless $p =~ /:\z/; |
205 | } |
206 | elsif ($^O eq 'MSWin32') { |
207 | $p =~ s{[/\\]\z}{}; |
208 | } |
209 | else { |
210 | $p =~ s{/\z}{}; |
211 | } |
212 | push @clean_path, $p; |
213 | } |
214 | |
215 | @{$arg}{qw(device inode perm)} = (lstat $arg->{cwd})[0,1] or do { |
cac619e8 |
216 | _error($arg, "cannot stat initial working directory", $arg->{cwd}); |
217 | return 0; |
218 | }; |
219 | |
3f083399 |
220 | return _rmtree($arg, \@clean_path); |
cac619e8 |
221 | } |
222 | |
223 | sub _rmtree { |
224 | my $arg = shift; |
225 | my $paths = shift; |
226 | |
227 | my $count = 0; |
228 | my $curdir = File::Spec->curdir(); |
229 | my $updir = File::Spec->updir(); |
230 | |
231 | my (@files, $root); |
232 | ROOT_DIR: |
233 | foreach $root (@$paths) { |
cac619e8 |
234 | # since we chdir into each directory, it may not be obvious |
235 | # to figure out where we are if we generate a message about |
236 | # a file name. We therefore construct a semi-canonical |
237 | # filename, anchored from the directory being unlinked (as |
238 | # opposed to being truly canonical, anchored from the root (/). |
239 | |
240 | my $canon = $arg->{prefix} |
241 | ? File::Spec->catfile($arg->{prefix}, $root) |
242 | : $root |
243 | ; |
244 | |
245 | my ($ldev, $lino, $perm) = (lstat $root)[0,1,2] or next ROOT_DIR; |
246 | |
247 | if ( -d _ ) { |
248 | $root = VMS::Filespec::pathify($root) if $Is_VMS; |
839bc55a |
249 | |
cac619e8 |
250 | if (!chdir($root)) { |
251 | # see if we can escalate privileges to get in |
252 | # (e.g. funny protection mask such as -w- instead of rwx) |
253 | $perm &= 07777; |
254 | my $nperm = $perm | 0700; |
255 | if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $root))) { |
256 | _error($arg, "cannot make child directory read-write-exec", $canon); |
257 | next ROOT_DIR; |
258 | } |
259 | elsif (!chdir($root)) { |
260 | _error($arg, "cannot chdir to child", $canon); |
261 | next ROOT_DIR; |
262 | } |
263 | } |
264 | |
3f083399 |
265 | my ($cur_dev, $cur_inode, $perm) = (stat $curdir)[0,1,2] or do { |
cac619e8 |
266 | _error($arg, "cannot stat current working directory", $canon); |
267 | next ROOT_DIR; |
268 | }; |
269 | |
839bc55a |
270 | if ($Need_Stat_Check) { |
271 | ($ldev eq $cur_dev and $lino eq $cur_inode) |
272 | or _croak("directory $canon changed before chdir, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting."); |
273 | } |
cac619e8 |
274 | |
275 | $perm &= 07777; # don't forget setuid, setgid, sticky bits |
276 | my $nperm = $perm | 0700; |
277 | |
278 | # notabene: 0700 is for making readable in the first place, |
279 | # it's also intended to change it to writable in case we have |
280 | # to recurse in which case we are better than rm -rf for |
281 | # subtrees with strange permissions |
282 | |
283 | if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $curdir))) { |
284 | _error($arg, "cannot make directory read+writeable", $canon); |
285 | $nperm = $perm; |
286 | } |
287 | |
288 | my $d; |
289 | $d = gensym() if $] < 5.006; |
290 | if (!opendir $d, $curdir) { |
291 | _error($arg, "cannot opendir", $canon); |
292 | @files = (); |
293 | } |
294 | else { |
295 | no strict 'refs'; |
296 | if (!defined ${"\cTAINT"} or ${"\cTAINT"}) { |
297 | # Blindly untaint dir names if taint mode is |
298 | # active, or any perl < 5.006 |
299 | @files = map { /\A(.*)\z/s; $1 } readdir $d; |
300 | } |
301 | else { |
302 | @files = readdir $d; |
303 | } |
304 | closedir $d; |
305 | } |
306 | |
307 | if ($Is_VMS) { |
308 | # Deleting large numbers of files from VMS Files-11 |
309 | # filesystems is faster if done in reverse ASCIIbetical order. |
310 | # include '.' to '.;' from blead patch #31775 |
311 | @files = map {$_ eq '.' ? '.;' : $_} reverse @files; |
312 | ($root = VMS::Filespec::unixify($root)) =~ s/\.dir\z//; |
313 | } |
839bc55a |
314 | |
cac619e8 |
315 | @files = grep {$_ ne $updir and $_ ne $curdir} @files; |
316 | |
317 | if (@files) { |
318 | # remove the contained files before the directory itself |
319 | my $narg = {%$arg}; |
320 | @{$narg}{qw(device inode cwd prefix depth)} |
3f083399 |
321 | = ($cur_dev, $cur_inode, $updir, $canon, $arg->{depth}+1); |
cac619e8 |
322 | $count += _rmtree($narg, \@files); |
323 | } |
324 | |
325 | # restore directory permissions of required now (in case the rmdir |
326 | # below fails), while we are still in the directory and may do so |
327 | # without a race via '.' |
328 | if ($nperm != $perm and not chmod($perm, $curdir)) { |
329 | _error($arg, "cannot reset chmod", $canon); |
330 | } |
331 | |
332 | # don't leave the client code in an unexpected directory |
333 | chdir($arg->{cwd}) |
334 | or _croak("cannot chdir to $arg->{cwd} from $canon: $!, aborting."); |
335 | |
336 | # ensure that a chdir upwards didn't take us somewhere other |
337 | # than we expected (see CVE-2002-0435) |
3f083399 |
338 | ($cur_dev, $cur_inode) = (stat $curdir)[0,1] |
cac619e8 |
339 | or _croak("cannot stat prior working directory $arg->{cwd}: $!, aborting."); |
340 | |
839bc55a |
341 | if ($Need_Stat_Check) { |
342 | ($arg->{device} eq $cur_dev and $arg->{inode} eq $cur_inode) |
343 | or _croak("previous directory $arg->{cwd} changed before entering $canon, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting."); |
344 | } |
cac619e8 |
345 | |
346 | if ($arg->{depth} or !$arg->{keep_root}) { |
347 | if ($arg->{safe} && |
348 | ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) { |
349 | print "skipped $root\n" if $arg->{verbose}; |
350 | next ROOT_DIR; |
351 | } |
3f083399 |
352 | if ($Force_Writeable and !chmod $perm | 0700, $root) { |
30cf951a |
353 | _error($arg, "cannot make directory writeable", $canon); |
354 | } |
cac619e8 |
355 | print "rmdir $root\n" if $arg->{verbose}; |
356 | if (rmdir $root) { |
357 | push @{${$arg->{result}}}, $root if $arg->{result}; |
358 | ++$count; |
359 | } |
360 | else { |
361 | _error($arg, "cannot remove directory", $canon); |
21070700 |
362 | if ($Force_Writeable && !chmod($perm, ($Is_VMS ? VMS::Filespec::fileify($root) : $root)) |
cac619e8 |
363 | ) { |
364 | _error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon); |
365 | } |
366 | } |
367 | } |
368 | } |
369 | else { |
370 | # not a directory |
cac619e8 |
371 | $root = VMS::Filespec::vmsify("./$root") |
30cf951a |
372 | if $Is_VMS |
8b0a9f85 |
373 | && !File::Spec->file_name_is_absolute($root) |
374 | && ($root !~ m/(?<!\^)[\]>]+/); # not already in VMS syntax |
cac619e8 |
375 | |
376 | if ($arg->{safe} && |
377 | ($Is_VMS ? !&VMS::Filespec::candelete($root) |
378 | : !(-l $root || -w $root))) |
379 | { |
380 | print "skipped $root\n" if $arg->{verbose}; |
381 | next ROOT_DIR; |
382 | } |
383 | |
384 | my $nperm = $perm & 07777 | 0600; |
3f083399 |
385 | if ($Force_Writeable and $nperm != $perm and not chmod $nperm, $root) { |
30cf951a |
386 | _error($arg, "cannot make file writeable", $canon); |
387 | } |
cac619e8 |
388 | print "unlink $canon\n" if $arg->{verbose}; |
389 | # delete all versions under VMS |
390 | for (;;) { |
391 | if (unlink $root) { |
392 | push @{${$arg->{result}}}, $root if $arg->{result}; |
393 | } |
394 | else { |
395 | _error($arg, "cannot unlink file", $canon); |
396 | $Force_Writeable and chmod($perm, $root) or |
397 | _error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon); |
398 | last; |
399 | } |
400 | ++$count; |
401 | last unless $Is_VMS && lstat $root; |
402 | } |
403 | } |
404 | } |
cac619e8 |
405 | return $count; |
406 | } |
407 | |
3f083399 |
408 | sub _slash_lc { |
409 | # fix up slashes and case on MSWin32 so that we can determine that |
410 | # c:\path\to\dir is underneath C:/Path/To |
411 | my $path = shift; |
412 | $path =~ tr{\\}{/}; |
413 | return lc($path); |
414 | } |
415 | |
cac619e8 |
416 | 1; |
417 | __END__ |
418 | |
fed7345c |
419 | =head1 NAME |
420 | |
12c2e016 |
421 | File::Path - Create or remove directory trees |
422 | |
423 | =head1 VERSION |
424 | |
867b93c3 |
425 | This document describes version 2.07 of File::Path, released |
426 | 2008-11-09. |
fed7345c |
427 | |
428 | =head1 SYNOPSIS |
429 | |
2f9d49b4 |
430 | use File::Path qw(make_path remove_tree); |
fed7345c |
431 | |
2f9d49b4 |
432 | make_path('foo/bar/baz', '/zug/zwang'); |
433 | make_path('foo/bar/baz', '/zug/zwang', { |
434 | verbose => 1, |
435 | mode => 0711, |
436 | }); |
12c2e016 |
437 | |
2f9d49b4 |
438 | remove_tree('foo/bar/baz', '/zug/zwang'); |
439 | remove_tree('foo/bar/baz', '/zug/zwang', { |
440 | verbose => 1, |
441 | error => \my $err_list, |
442 | }); |
12c2e016 |
443 | |
30cf951a |
444 | # legacy (interface promoted before v2.00) |
2f9d49b4 |
445 | mkpath('/foo/bar/baz'); |
446 | mkpath('/foo/bar/baz', 1, 0711); |
30cf951a |
447 | mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711); |
2f9d49b4 |
448 | rmtree('foo/bar/baz', 1, 1); |
30cf951a |
449 | rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1); |
fed7345c |
450 | |
30cf951a |
451 | # legacy (interface promoted before v2.06) |
2f9d49b4 |
452 | mkpath('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 }); |
453 | rmtree('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 }); |
12c2e016 |
454 | |
2f9d49b4 |
455 | =head1 DESCRIPTION |
12c2e016 |
456 | |
2f9d49b4 |
457 | This module provide a convenient way to create directories of |
458 | arbitrary depth and to delete an entire directory subtree from the |
459 | filesystem. |
3f083399 |
460 | |
2f9d49b4 |
461 | The following functions are provided: |
3f083399 |
462 | |
2f9d49b4 |
463 | =over |
12c2e016 |
464 | |
2f9d49b4 |
465 | =item make_path( $dir1, $dir2, .... ) |
12c2e016 |
466 | |
2f9d49b4 |
467 | =item make_path( $dir1, $dir2, ...., \%opts ) |
3f083399 |
468 | |
2f9d49b4 |
469 | The C<make_path> function creates the given directories if they don't |
470 | exists before, much like the Unix command C<mkdir -p>. |
3f083399 |
471 | |
2f9d49b4 |
472 | The function accepts a list of directories to be created. Its |
473 | behaviour may be tuned by an optional hashref appearing as the last |
474 | parameter on the call. |
12c2e016 |
475 | |
3f083399 |
476 | The function returns the list of directories actually created during |
2f9d49b4 |
477 | the call; in scalar context the number of directories created. |
3f083399 |
478 | |
2f9d49b4 |
479 | The following keys are recognised in the option hash: |
3f083399 |
480 | |
2f9d49b4 |
481 | =over |
12c2e016 |
482 | |
2f9d49b4 |
483 | =item mode => $num |
12c2e016 |
484 | |
0b3d36bd |
485 | The numeric permissions mode to apply to each created directory |
486 | (defaults to 0777), to be modified by the current C<umask>. If the |
487 | directory already exists (and thus does not need to be created), |
488 | the permissions will not be modified. |
489 | |
490 | C<mask> is recognised as an alias for this parameter. |
12c2e016 |
491 | |
2f9d49b4 |
492 | =item verbose => $bool |
12c2e016 |
493 | |
30cf951a |
494 | If present, will cause C<make_path> to print the name of each directory |
12c2e016 |
495 | as it is created. By default nothing is printed. |
496 | |
2f9d49b4 |
497 | =item error => \$err |
12c2e016 |
498 | |
2f9d49b4 |
499 | If present, it should be a reference to a scalar. |
500 | This scalar will be made to reference an array, which will |
867b93c3 |
501 | be used to store any errors that are encountered. See the L</"ERROR |
502 | HANDLING"> section for more information. |
12c2e016 |
503 | |
0b3d36bd |
504 | If this parameter is not used, certain error conditions may raise |
505 | a fatal error that will cause the program will halt, unless trapped |
506 | in an C<eval> block. |
12c2e016 |
507 | |
508 | =back |
509 | |
30cf951a |
510 | =item mkpath( $dir ) |
511 | |
2f9d49b4 |
512 | =item mkpath( $dir, $verbose, $mode ) |
3f083399 |
513 | |
2f9d49b4 |
514 | =item mkpath( [$dir1, $dir2,...], $verbose, $mode ) |
3f083399 |
515 | |
2f9d49b4 |
516 | =item mkpath( $dir1, $dir2,..., \%opt ) |
3f083399 |
517 | |
867b93c3 |
518 | The mkpath() function provide the legacy interface of make_path() with |
519 | a different interpretation of the arguments passed. The behaviour and |
520 | return value of the function is otherwise identical to make_path(). |
12c2e016 |
521 | |
2f9d49b4 |
522 | =item remove_tree( $dir1, $dir2, .... ) |
3f083399 |
523 | |
2f9d49b4 |
524 | =item remove_tree( $dir1, $dir2, ...., \%opts ) |
3f083399 |
525 | |
2f9d49b4 |
526 | The C<remove_tree> function deletes the given directories and any |
527 | files and subdirectories they might contain, much like the Unix |
528 | command C<rm -r> or C<del /s> on Windows. |
12c2e016 |
529 | |
2f9d49b4 |
530 | The function accepts a list of directories to be |
531 | removed. Its behaviour may be tuned by an optional hashref |
532 | appearing as the last parameter on the call. |
533 | |
534 | The functions returns the number of files successfully deleted. |
535 | |
536 | The following keys are recognised in the option hash: |
537 | |
538 | =over |
539 | |
540 | =item verbose => $bool |
12c2e016 |
541 | |
30cf951a |
542 | If present, will cause C<remove_tree> to print the name of each file as |
12c2e016 |
543 | it is unlinked. By default nothing is printed. |
544 | |
2f9d49b4 |
545 | =item safe => $bool |
12c2e016 |
546 | |
30cf951a |
547 | When set to a true value, will cause C<remove_tree> to skip the files |
0b3d36bd |
548 | for which the process lacks the required privileges needed to delete |
5808899a |
549 | files, such as delete privileges on VMS. In other words, the code |
550 | will make no attempt to alter file permissions. Thus, if the process |
551 | is interrupted, no filesystem object will be left in a more |
552 | permissive mode. |
12c2e016 |
553 | |
2f9d49b4 |
554 | =item keep_root => $bool |
12c2e016 |
555 | |
0b3d36bd |
556 | When set to a true value, will cause all files and subdirectories |
557 | to be removed, except the initially specified directories. This comes |
558 | in handy when cleaning out an application's scratch directory. |
12c2e016 |
559 | |
3f083399 |
560 | remove_tree( '/tmp', {keep_root => 1} ); |
12c2e016 |
561 | |
2f9d49b4 |
562 | =item result => \$res |
12c2e016 |
563 | |
2f9d49b4 |
564 | If present, it should be a reference to a scalar. |
565 | This scalar will be made to reference an array, which will |
566 | be used to store all files and directories unlinked |
867b93c3 |
567 | during the call. If nothing is unlinked, the array will be empty. |
12c2e016 |
568 | |
3f083399 |
569 | remove_tree( '/tmp', {result => \my $list} ); |
12c2e016 |
570 | print "unlinked $_\n" for @$list; |
571 | |
0b3d36bd |
572 | This is a useful alternative to the C<verbose> key. |
573 | |
2f9d49b4 |
574 | =item error => \$err |
12c2e016 |
575 | |
2f9d49b4 |
576 | If present, it should be a reference to a scalar. |
577 | This scalar will be made to reference an array, which will |
867b93c3 |
578 | be used to store any errors that are encountered. See the L</"ERROR |
579 | HANDLING"> section for more information. |
12c2e016 |
580 | |
0b3d36bd |
581 | Removing things is a much more dangerous proposition than |
582 | creating things. As such, there are certain conditions that |
30cf951a |
583 | C<remove_tree> may encounter that are so dangerous that the only |
0b3d36bd |
584 | sane action left is to kill the program. |
585 | |
586 | Use C<error> to trap all that is reasonable (problems with |
587 | permissions and the like), and let it die if things get out |
588 | of hand. This is the safest course of action. |
12c2e016 |
589 | |
590 | =back |
591 | |
2f9d49b4 |
592 | =item rmtree( $dir ) |
fed7345c |
593 | |
2f9d49b4 |
594 | =item rmtree( $dir, $verbose, $safe ) |
fed7345c |
595 | |
2f9d49b4 |
596 | =item rmtree( [$dir1, $dir2,...], $verbose, $safe ) |
fed7345c |
597 | |
2f9d49b4 |
598 | =item rmtree( $dir1, $dir2,..., \%opt ) |
fed7345c |
599 | |
867b93c3 |
600 | The rmtree() function provide the legacy interface of remove_tree() |
601 | with a different interpretation of the arguments passed. The behaviour |
602 | and return value of the function is otherwise identical to |
603 | remove_tree(). |
fed7345c |
604 | |
605 | =back |
606 | |
12c2e016 |
607 | =head2 ERROR HANDLING |
608 | |
30cf951a |
609 | =over 4 |
610 | |
611 | =item B<NOTE:> |
612 | |
613 | The following error handling mechanism is considered |
614 | experimental and is subject to change pending feedback from |
615 | users. |
616 | |
617 | =back |
618 | |
619 | If C<make_path> or C<remove_tree> encounter an error, a diagnostic |
620 | message will be printed to C<STDERR> via C<carp> (for non-fatal |
621 | errors), or via C<croak> (for fatal errors). |
12c2e016 |
622 | |
623 | If this behaviour is not desirable, the C<error> attribute may be |
624 | used to hold a reference to a variable, which will be used to store |
867b93c3 |
625 | the diagnostics. The variable is made a reference to an array of hash |
626 | references. Each hash contain a single key/value pair where the key |
627 | is the name of the file, and the value is the error message (including |
628 | the contents of C<$!> when appropriate). If a general error is |
629 | encountered the diagnostic key will be empty. |
630 | |
631 | An example usage looks like: |
12c2e016 |
632 | |
3f083399 |
633 | remove_tree( 'foo/bar', 'bar/rat', {error => \my $err} ); |
867b93c3 |
634 | if (@$err) { |
635 | for my $diag (@$err) { |
636 | my ($file, $message) = %$diag; |
637 | if ($file eq '') { |
638 | print "general error: $message\n"; |
639 | } |
640 | else { |
641 | print "problem unlinking $file: $message\n"; |
642 | } |
643 | } |
12c2e016 |
644 | } |
867b93c3 |
645 | else { |
646 | print "No error encountered\n"; |
12c2e016 |
647 | } |
648 | |
867b93c3 |
649 | Note that if no errors are encountered, C<$err> will reference an |
650 | empty array. This means that C<$err> will always end up TRUE; so you |
651 | need to test C<@$err> to determine if errors occured. |
652 | |
12c2e016 |
653 | =head2 NOTES |
654 | |
0b3d36bd |
655 | C<File::Path> blindly exports C<mkpath> and C<rmtree> into the |
656 | current namespace. These days, this is considered bad style, but |
657 | to change it now would break too much code. Nonetheless, you are |
658 | invited to specify what it is you are expecting to use: |
659 | |
660 | use File::Path 'rmtree'; |
661 | |
3f083399 |
662 | The routines C<make_path> and C<remove_tree> are B<not> exported |
663 | by default. You must specify which ones you want to use. |
e2ba98a1 |
664 | |
3f083399 |
665 | use File::Path 'remove_tree'; |
e2ba98a1 |
666 | |
3f083399 |
667 | Note that a side-effect of the above is that C<mkpath> and C<rmtree> |
668 | are no longer exported at all. This is due to the way the C<Exporter> |
669 | module works. If you are migrating a codebase to use the new |
670 | interface, you will have to list everything explicitly. But that's |
671 | just good practice anyway. |
12c2e016 |
672 | |
3f083399 |
673 | use File::Path qw(remove_tree rmtree); |
12c2e016 |
674 | |
0b3d36bd |
675 | =head3 SECURITY CONSIDERATIONS |
12c2e016 |
676 | |
0b3d36bd |
677 | There were race conditions 1.x implementations of File::Path's |
678 | C<rmtree> function (although sometimes patched depending on the OS |
679 | distribution or platform). The 2.0 version contains code to avoid the |
680 | problem mentioned in CVE-2002-0435. |
12c2e016 |
681 | |
0b3d36bd |
682 | See the following pages for more information: |
12c2e016 |
683 | |
0b3d36bd |
684 | http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=286905 |
685 | http://www.nntp.perl.org/group/perl.perl5.porters/2005/01/msg97623.html |
686 | http://www.debian.org/security/2005/dsa-696 |
12c2e016 |
687 | |
5808899a |
688 | Additionally, unless the C<safe> parameter is set (or the |
37b1cd44 |
689 | third parameter in the traditional interface is TRUE), should a |
30cf951a |
690 | C<remove_tree> be interrupted, files that were originally in read-only |
0b3d36bd |
691 | mode may now have their permissions set to a read-write (or "delete |
692 | OK") mode. |
96e4d5b1 |
693 | |
b8d5f521 |
694 | =head1 DIAGNOSTICS |
695 | |
0b3d36bd |
696 | FATAL errors will cause the program to halt (C<croak>), since the |
697 | problem is so severe that it would be dangerous to continue. (This |
698 | can always be trapped with C<eval>, but it's not a good idea. Under |
699 | the circumstances, dying is the best thing to do). |
700 | |
701 | SEVERE errors may be trapped using the modern interface. If the |
702 | they are not trapped, or the old interface is used, such an error |
703 | will cause the program will halt. |
704 | |
705 | All other errors may be trapped using the modern interface, otherwise |
706 | they will be C<carp>ed about. Program execution will not be halted. |
707 | |
b8d5f521 |
708 | =over 4 |
709 | |
37b1cd44 |
710 | =item mkdir [path]: [errmsg] (SEVERE) |
0b3d36bd |
711 | |
867b93c3 |
712 | C<make_path> was unable to create the path. Probably some sort of |
0b3d36bd |
713 | permissions error at the point of departure, or insufficient resources |
714 | (such as free inodes on Unix). |
715 | |
716 | =item No root path(s) specified |
717 | |
867b93c3 |
718 | C<make_path> was not given any paths to create. This message is only |
0b3d36bd |
719 | emitted if the routine is called with the traditional interface. |
720 | The modern interface will remain silent if given nothing to do. |
721 | |
722 | =item No such file or directory |
723 | |
867b93c3 |
724 | On Windows, if C<make_path> gives you this warning, it may mean that |
0b3d36bd |
725 | you have exceeded your filesystem's maximum path length. |
726 | |
727 | =item cannot fetch initial working directory: [errmsg] |
728 | |
30cf951a |
729 | C<remove_tree> attempted to determine the initial directory by calling |
0b3d36bd |
730 | C<Cwd::getcwd>, but the call failed for some reason. No attempt |
731 | will be made to delete anything. |
732 | |
733 | =item cannot stat initial working directory: [errmsg] |
734 | |
30cf951a |
735 | C<remove_tree> attempted to stat the initial directory (after having |
0b3d36bd |
736 | successfully obtained its name via C<getcwd>), however, the call |
737 | failed for some reason. No attempt will be made to delete anything. |
738 | |
739 | =item cannot chdir to [dir]: [errmsg] |
740 | |
30cf951a |
741 | C<remove_tree> attempted to set the working directory in order to |
0b3d36bd |
742 | begin deleting the objects therein, but was unsuccessful. This is |
743 | usually a permissions issue. The routine will continue to delete |
744 | other things, but this directory will be left intact. |
745 | |
3f083399 |
746 | =item directory [dir] changed before chdir, expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL) |
0b3d36bd |
747 | |
30cf951a |
748 | C<remove_tree> recorded the device and inode of a directory, and then |
0b3d36bd |
749 | moved into it. It then performed a C<stat> on the current directory |
750 | and detected that the device and inode were no longer the same. As |
751 | this is at the heart of the race condition problem, the program |
752 | will die at this point. |
753 | |
754 | =item cannot make directory [dir] read+writeable: [errmsg] |
755 | |
30cf951a |
756 | C<remove_tree> attempted to change the permissions on the current directory |
0b3d36bd |
757 | to ensure that subsequent unlinkings would not run into problems, |
758 | but was unable to do so. The permissions remain as they were, and |
759 | the program will carry on, doing the best it can. |
760 | |
761 | =item cannot read [dir]: [errmsg] |
762 | |
30cf951a |
763 | C<remove_tree> tried to read the contents of the directory in order |
0b3d36bd |
764 | to acquire the names of the directory entries to be unlinked, but |
765 | was unsuccessful. This is usually a permissions issue. The |
766 | program will continue, but the files in this directory will remain |
767 | after the call. |
768 | |
769 | =item cannot reset chmod [dir]: [errmsg] |
770 | |
30cf951a |
771 | C<remove_tree>, after having deleted everything in a directory, attempted |
cac619e8 |
772 | to restore its permissions to the original state but failed. The |
773 | directory may wind up being left behind. |
12c2e016 |
774 | |
c42ebacb |
775 | =item cannot remove [dir] when cwd is [dir] |
776 | |
777 | The current working directory of the program is F</some/path/to/here> |
778 | and you are attempting to remove an ancestor, such as F</some/path>. |
779 | The directory tree is left untouched. |
780 | |
781 | The solution is to C<chdir> out of the child directory to a place |
782 | outside the directory tree to be removed. |
783 | |
cac619e8 |
784 | =item cannot chdir to [parent-dir] from [child-dir]: [errmsg], aborting. (FATAL) |
12c2e016 |
785 | |
30cf951a |
786 | C<remove_tree>, after having deleted everything and restored the permissions |
3f083399 |
787 | of a directory, was unable to chdir back to the parent. The program |
788 | halts to avoid a race condition from occurring. |
fed7345c |
789 | |
cac619e8 |
790 | =item cannot stat prior working directory [dir]: [errmsg], aborting. (FATAL) |
0b3d36bd |
791 | |
30cf951a |
792 | C<remove_tree> was unable to stat the parent directory after have returned |
cac619e8 |
793 | from the child. Since there is no way of knowing if we returned to |
794 | where we think we should be (by comparing device and inode) the only |
795 | way out is to C<croak>. |
0b3d36bd |
796 | |
3f083399 |
797 | =item previous directory [parent-dir] changed before entering [child-dir], expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL) |
0b3d36bd |
798 | |
30cf951a |
799 | When C<remove_tree> returned from deleting files in a child directory, a |
cac619e8 |
800 | check revealed that the parent directory it returned to wasn't the one |
801 | it started out from. This is considered a sign of malicious activity. |
0b3d36bd |
802 | |
cac619e8 |
803 | =item cannot make directory [dir] writeable: [errmsg] |
ee79a11f |
804 | |
cac619e8 |
805 | Just before removing a directory (after having successfully removed |
30cf951a |
806 | everything it contained), C<remove_tree> attempted to set the permissions |
cac619e8 |
807 | on the directory to ensure it could be removed and failed. Program |
808 | execution continues, but the directory may possibly not be deleted. |
0b3d36bd |
809 | |
cac619e8 |
810 | =item cannot remove directory [dir]: [errmsg] |
0b3d36bd |
811 | |
30cf951a |
812 | C<remove_tree> attempted to remove a directory, but failed. This may because |
cac619e8 |
813 | some objects that were unable to be removed remain in the directory, or |
814 | a permissions issue. The directory will be left behind. |
0b3d36bd |
815 | |
cac619e8 |
816 | =item cannot restore permissions of [dir] to [0nnn]: [errmsg] |
0b3d36bd |
817 | |
30cf951a |
818 | After having failed to remove a directory, C<remove_tree> was unable to |
cac619e8 |
819 | restore its permissions from a permissive state back to a possibly |
820 | more restrictive setting. (Permissions given in octal). |
0b3d36bd |
821 | |
cac619e8 |
822 | =item cannot make file [file] writeable: [errmsg] |
b5400373 |
823 | |
30cf951a |
824 | C<remove_tree> attempted to force the permissions of a file to ensure it |
cac619e8 |
825 | could be deleted, but failed to do so. It will, however, still attempt |
826 | to unlink the file. |
0b3d36bd |
827 | |
cac619e8 |
828 | =item cannot unlink file [file]: [errmsg] |
0b3d36bd |
829 | |
30cf951a |
830 | C<remove_tree> failed to remove a file. Probably a permissions issue. |
0b3d36bd |
831 | |
cac619e8 |
832 | =item cannot restore permissions of [file] to [0nnn]: [errmsg] |
0b3d36bd |
833 | |
30cf951a |
834 | After having failed to remove a file, C<remove_tree> was also unable |
cac619e8 |
835 | to restore the permissions on the file to a possibly less permissive |
836 | setting. (Permissions given in octal). |
0b3d36bd |
837 | |
cac619e8 |
838 | =back |
12c2e016 |
839 | |
cac619e8 |
840 | =head1 SEE ALSO |
037c8c09 |
841 | |
cac619e8 |
842 | =over 4 |
0b3d36bd |
843 | |
cac619e8 |
844 | =item * |
0b3d36bd |
845 | |
351a5cfe |
846 | L<File::Remove> |
847 | |
848 | Allows files and directories to be moved to the Trashcan/Recycle |
849 | Bin (where they may later be restored if necessary) if the operating |
850 | system supports such functionality. This feature may one day be |
851 | made available directly in C<File::Path>. |
852 | |
853 | =item * |
854 | |
cac619e8 |
855 | L<File::Find::Rule> |
0b3d36bd |
856 | |
cac619e8 |
857 | When removing directory trees, if you want to examine each file to |
858 | decide whether to delete it (and possibly leaving large swathes |
859 | alone), F<File::Find::Rule> offers a convenient and flexible approach |
860 | to examining directory trees. |
0b3d36bd |
861 | |
cac619e8 |
862 | =back |
0b3d36bd |
863 | |
cac619e8 |
864 | =head1 BUGS |
0b3d36bd |
865 | |
cac619e8 |
866 | Please report all bugs on the RT queue: |
b5400373 |
867 | |
cac619e8 |
868 | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Path> |
b5400373 |
869 | |
cac619e8 |
870 | =head1 ACKNOWLEDGEMENTS |
0b3d36bd |
871 | |
cac619e8 |
872 | Paul Szabo identified the race condition originally, and Brendan |
873 | O'Dea wrote an implementation for Debian that addressed the problem. |
874 | That code was used as a basis for the current code. Their efforts |
875 | are greatly appreciated. |
fed7345c |
876 | |
867b93c3 |
877 | Gisle Aas made a number of improvements to the documentation for |
878 | 2.07 and his advice and assistance is also greatly appreciated. |
879 | |
cac619e8 |
880 | =head1 AUTHORS |
fed7345c |
881 | |
3f083399 |
882 | Tim Bunce and Charles Bailey. Currently maintained by David Landgren |
cac619e8 |
883 | <F<david@landgren.net>>. |
884 | |
885 | =head1 COPYRIGHT |
886 | |
887 | This module is copyright (C) Charles Bailey, Tim Bunce and |
3f083399 |
888 | David Landgren 1995-2008. All rights reserved. |
cac619e8 |
889 | |
890 | =head1 LICENSE |
891 | |
892 | This library is free software; you can redistribute it and/or modify |
893 | it under the same terms as Perl itself. |
894 | |
895 | =cut |