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