This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update File-Path to CPAN version 2.15
[perl5.git] / cpan / File-Path / lib / File / Path.pm
1 package File::Path;
2
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
13         # can't say 'opendir my $dh, $dirname'
14         # need to initialise $dh
15         eval 'use Symbol';
16     }
17 }
18
19 use Exporter ();
20 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
21 $VERSION   = '2.15';
22 $VERSION   = eval $VERSION;
23 @ISA       = qw(Exporter);
24 @EXPORT    = qw(mkpath rmtree);
25 @EXPORT_OK = qw(make_path remove_tree);
26
27 BEGIN {
28   for (qw(VMS MacOS MSWin32 os2)) {
29     no strict 'refs';
30     *{"_IS_\U$_"} = $^O eq $_ ? sub () { 1 } : sub () { 0 };
31   }
32
33   # These OSes complain if you want to remove a file that you have no
34   # write permission to:
35   *_FORCE_WRITABLE = (
36     grep { $^O eq $_ } qw(amigaos dos epoc MSWin32 MacOS os2)
37   ) ? sub () { 1 } : sub () { 0 };
38
39   # Unix-like systems need to stat each directory in order to detect
40   # race condition. MS-Windows is immune to this particular attack.
41   *_NEED_STAT_CHECK = !(_IS_MSWIN32()) ? sub () { 1 } : sub () { 0 };
42 }
43
44 sub _carp {
45     require Carp;
46     goto &Carp::carp;
47 }
48
49 sub _croak {
50     require Carp;
51     goto &Carp::croak;
52 }
53
54 sub _error {
55     my $arg     = shift;
56     my $message = shift;
57     my $object  = shift;
58
59     if ( $arg->{error} ) {
60         $object = '' unless defined $object;
61         $message .= ": $!" if $!;
62         push @{ ${ $arg->{error} } }, { $object => $message };
63     }
64     else {
65         _carp( defined($object) ? "$message for $object: $!" : "$message: $!" );
66     }
67 }
68
69 sub __is_arg {
70     my ($arg) = @_;
71
72     # If client code blessed an array ref to HASH, this will not work
73     # properly. We could have done $arg->isa() wrapped in eval, but
74     # that would be expensive. This implementation should suffice.
75     # We could have also used Scalar::Util:blessed, but we choose not
76     # to add this dependency
77     return ( ref $arg eq 'HASH' );
78 }
79
80 sub make_path {
81     push @_, {} unless @_ and __is_arg( $_[-1] );
82     goto &mkpath;
83 }
84
85 sub mkpath {
86     my $old_style = !( @_ and __is_arg( $_[-1] ) );
87
88     my $data;
89     my $paths;
90
91     if ($old_style) {
92         my ( $verbose, $mode );
93         ( $paths, $verbose, $mode ) = @_;
94         $paths = [$paths] unless UNIVERSAL::isa( $paths, 'ARRAY' );
95         $data->{verbose} = $verbose;
96         $data->{mode} = defined $mode ? $mode : oct '777';
97     }
98     else {
99         my %args_permitted = map { $_ => 1 } ( qw|
100             chmod
101             error
102             group
103             mask
104             mode
105             owner
106             uid
107             user
108             verbose
109         | );
110         my %not_on_win32_args = map { $_ => 1 } ( qw|
111             group
112             owner
113             uid
114             user
115         | );
116         my @bad_args = ();
117         my @win32_implausible_args = ();
118         my $arg = pop @_;
119         for my $k (sort keys %{$arg}) {
120             if (! $args_permitted{$k}) {
121                 push @bad_args, $k;
122             }
123             elsif ($not_on_win32_args{$k} and _IS_MSWIN32) {
124                 push @win32_implausible_args, $k;
125             }
126             else {
127                 $data->{$k} = $arg->{$k};
128             }
129         }
130         _carp("Unrecognized option(s) passed to mkpath() or make_path(): @bad_args")
131             if @bad_args;
132         _carp("Option(s) implausible on Win32 passed to mkpath() or make_path(): @win32_implausible_args")
133             if @win32_implausible_args;
134         $data->{mode} = delete $data->{mask} if exists $data->{mask};
135         $data->{mode} = oct '777' unless exists $data->{mode};
136         ${ $data->{error} } = [] if exists $data->{error};
137         unless (@win32_implausible_args) {
138             $data->{owner} = delete $data->{user} if exists $data->{user};
139             $data->{owner} = delete $data->{uid}  if exists $data->{uid};
140             if ( exists $data->{owner} and $data->{owner} =~ /\D/ ) {
141                 my $uid = ( getpwnam $data->{owner} )[2];
142                 if ( defined $uid ) {
143                     $data->{owner} = $uid;
144                 }
145                 else {
146                     _error( $data,
147                             "unable to map $data->{owner} to a uid, ownership not changed"
148                           );
149                     delete $data->{owner};
150                 }
151             }
152             if ( exists $data->{group} and $data->{group} =~ /\D/ ) {
153                 my $gid = ( getgrnam $data->{group} )[2];
154                 if ( defined $gid ) {
155                     $data->{group} = $gid;
156                 }
157                 else {
158                     _error( $data,
159                             "unable to map $data->{group} to a gid, group ownership not changed"
160                     );
161                     delete $data->{group};
162                 }
163             }
164             if ( exists $data->{owner} and not exists $data->{group} ) {
165                 $data->{group} = -1;    # chown will leave group unchanged
166             }
167             if ( exists $data->{group} and not exists $data->{owner} ) {
168                 $data->{owner} = -1;    # chown will leave owner unchanged
169             }
170         }
171         $paths = [@_];
172     }
173     return _mkpath( $data, $paths );
174 }
175
176 sub _mkpath {
177     my $data   = shift;
178     my $paths = shift;
179
180     my ( @created );
181     foreach my $path ( @{$paths} ) {
182         next unless defined($path) and length($path);
183         $path .= '/' if _IS_OS2 and $path =~ /^\w:\z/s; # feature of CRT
184
185         # Logic wants Unix paths, so go with the flow.
186         if (_IS_VMS) {
187             next if $path eq '/';
188             $path = VMS::Filespec::unixify($path);
189         }
190         next if -d $path;
191         my $parent = File::Basename::dirname($path);
192         # Coverage note:  It's not clear how we would test the condition:
193         # '-d $parent or $path eq $parent'
194         unless ( -d $parent or $path eq $parent ) {
195             push( @created, _mkpath( $data, [$parent] ) );
196         }
197         print "mkdir $path\n" if $data->{verbose};
198         if ( mkdir( $path, $data->{mode} ) ) {
199             push( @created, $path );
200             if ( exists $data->{owner} ) {
201
202                 # NB: $data->{group} guaranteed to be set during initialisation
203                 if ( !chown $data->{owner}, $data->{group}, $path ) {
204                     _error( $data,
205                         "Cannot change ownership of $path to $data->{owner}:$data->{group}"
206                     );
207                 }
208             }
209             if ( exists $data->{chmod} ) {
210                 # Coverage note:  It's not clear how we would trigger the next
211                 # 'if' block.  Failure of 'chmod' might first result in a
212                 # system error: "Permission denied".
213                 if ( !chmod $data->{chmod}, $path ) {
214                     _error( $data,
215                         "Cannot change permissions of $path to $data->{chmod}" );
216                 }
217             }
218         }
219         else {
220             my $save_bang = $!;
221
222             # From 'perldoc perlvar': $EXTENDED_OS_ERROR ($^E) is documented
223             # as:
224             # Error information specific to the current operating system. At the
225             # moment, this differs from "$!" under only VMS, OS/2, and Win32
226             # (and for MacPerl). On all other platforms, $^E is always just the
227             # same as $!.
228
229             my ( $e, $e1 ) = ( $save_bang, $^E );
230             $e .= "; $e1" if $e ne $e1;
231
232             # allow for another process to have created it meanwhile
233             if ( ! -d $path ) {
234                 $! = $save_bang;
235                 if ( $data->{error} ) {
236                     push @{ ${ $data->{error} } }, { $path => $e };
237                 }
238                 else {
239                     _croak("mkdir $path: $e");
240                 }
241             }
242         }
243     }
244     return @created;
245 }
246
247 sub remove_tree {
248     push @_, {} unless @_ and __is_arg( $_[-1] );
249     goto &rmtree;
250 }
251
252 sub _is_subdir {
253     my ( $dir, $test ) = @_;
254
255     my ( $dv, $dd ) = File::Spec->splitpath( $dir,  1 );
256     my ( $tv, $td ) = File::Spec->splitpath( $test, 1 );
257
258     # not on same volume
259     return 0 if $dv ne $tv;
260
261     my @d = File::Spec->splitdir($dd);
262     my @t = File::Spec->splitdir($td);
263
264     # @t can't be a subdir if it's shorter than @d
265     return 0 if @t < @d;
266
267     return join( '/', @d ) eq join( '/', splice @t, 0, +@d );
268 }
269
270 sub rmtree {
271     my $old_style = !( @_ and __is_arg( $_[-1] ) );
272
273     my ($arg, $data, $paths);
274
275     if ($old_style) {
276         my ( $verbose, $safe );
277         ( $paths, $verbose, $safe ) = @_;
278         $data->{verbose} = $verbose;
279         $data->{safe} = defined $safe ? $safe : 0;
280
281         if ( defined($paths) and length($paths) ) {
282             $paths = [$paths] unless UNIVERSAL::isa( $paths, 'ARRAY' );
283         }
284         else {
285             _carp("No root path(s) specified\n");
286             return 0;
287         }
288     }
289     else {
290         my %args_permitted = map { $_ => 1 } ( qw|
291             error
292             keep_root
293             result
294             safe
295             verbose
296         | );
297         my @bad_args = ();
298         my $arg = pop @_;
299         for my $k (sort keys %{$arg}) {
300             if (! $args_permitted{$k}) {
301                 push @bad_args, $k;
302             }
303             else {
304                 $data->{$k} = $arg->{$k};
305             }
306         }
307         _carp("Unrecognized option(s) passed to remove_tree(): @bad_args")
308             if @bad_args;
309         ${ $data->{error} }  = [] if exists $data->{error};
310         ${ $data->{result} } = [] if exists $data->{result};
311
312         # Wouldn't it make sense to do some validation on @_ before assigning
313         # to $paths here?
314         # In the $old_style case we guarantee that each path is both defined
315         # and non-empty.  We don't check that here, which means we have to
316         # check it later in the first condition in this line:
317         #     if ( $ortho_root_length && _is_subdir( $ortho_root, $ortho_cwd ) ) {
318         # Granted, that would be a change in behavior for the two
319         # non-old-style interfaces.
320
321         $paths = [@_];
322     }
323
324     $data->{prefix} = '';
325     $data->{depth}  = 0;
326
327     my @clean_path;
328     $data->{cwd} = getcwd() or do {
329         _error( $data, "cannot fetch initial working directory" );
330         return 0;
331     };
332     for ( $data->{cwd} ) { /\A(.*)\Z/s; $_ = $1 }    # untaint
333
334     for my $p (@$paths) {
335
336         # need to fixup case and map \ to / on Windows
337         my $ortho_root = _IS_MSWIN32 ? _slash_lc($p) : $p;
338         my $ortho_cwd =
339           _IS_MSWIN32 ? _slash_lc( $data->{cwd} ) : $data->{cwd};
340         my $ortho_root_length = length($ortho_root);
341         $ortho_root_length-- if _IS_VMS;   # don't compare '.' with ']'
342         if ( $ortho_root_length && _is_subdir( $ortho_root, $ortho_cwd ) ) {
343             local $! = 0;
344             _error( $data, "cannot remove path when cwd is $data->{cwd}", $p );
345             next;
346         }
347
348         if (_IS_MACOS) {
349             $p = ":$p" unless $p =~ /:/;
350             $p .= ":" unless $p =~ /:\z/;
351         }
352         elsif ( _IS_MSWIN32 ) {
353             $p =~ s{[/\\]\z}{};
354         }
355         else {
356             $p =~ s{/\z}{};
357         }
358         push @clean_path, $p;
359     }
360
361     @{$data}{qw(device inode)} = ( lstat $data->{cwd} )[ 0, 1 ] or do {
362         _error( $data, "cannot stat initial working directory", $data->{cwd} );
363         return 0;
364     };
365
366     return _rmtree( $data, \@clean_path );
367 }
368
369 sub _rmtree {
370     my $data   = shift;
371     my $paths = shift;
372
373     my $count  = 0;
374     my $curdir = File::Spec->curdir();
375     my $updir  = File::Spec->updir();
376
377     my ( @files, $root );
378   ROOT_DIR:
379     foreach my $root (@$paths) {
380
381         # since we chdir into each directory, it may not be obvious
382         # to figure out where we are if we generate a message about
383         # a file name. We therefore construct a semi-canonical
384         # filename, anchored from the directory being unlinked (as
385         # opposed to being truly canonical, anchored from the root (/).
386
387         my $canon =
388           $data->{prefix}
389           ? File::Spec->catfile( $data->{prefix}, $root )
390           : $root;
391
392         my ( $ldev, $lino, $perm ) = ( lstat $root )[ 0, 1, 2 ]
393           or next ROOT_DIR;
394
395         if ( -d _ ) {
396             $root = VMS::Filespec::vmspath( VMS::Filespec::pathify($root) )
397               if _IS_VMS;
398
399             if ( !chdir($root) ) {
400
401                 # see if we can escalate privileges to get in
402                 # (e.g. funny protection mask such as -w- instead of rwx)
403                 # This uses fchmod to avoid traversing outside of the proper
404                 # location (CVE-2017-6512)
405                 my $root_fh;
406                 if (open($root_fh, '<', $root)) {
407                     my ($fh_dev, $fh_inode) = (stat $root_fh )[0,1];
408                     $perm &= oct '7777';
409                     my $nperm = $perm | oct '700';
410                     local $@;
411                     if (
412                         !(
413                             $data->{safe}
414                            or $nperm == $perm
415                            or !-d _
416                            or $fh_dev ne $ldev
417                            or $fh_inode ne $lino
418                            or eval { chmod( $nperm, $root_fh ) }
419                         )
420                       )
421                     {
422                         _error( $data,
423                             "cannot make child directory read-write-exec", $canon );
424                         next ROOT_DIR;
425                     }
426                     close $root_fh;
427                 }
428                 if ( !chdir($root) ) {
429                     _error( $data, "cannot chdir to child", $canon );
430                     next ROOT_DIR;
431                 }
432             }
433
434             my ( $cur_dev, $cur_inode, $perm ) = ( stat $curdir )[ 0, 1, 2 ]
435               or do {
436                 _error( $data, "cannot stat current working directory", $canon );
437                 next ROOT_DIR;
438               };
439
440             if (_NEED_STAT_CHECK) {
441                 ( $ldev eq $cur_dev and $lino eq $cur_inode )
442                   or _croak(
443 "directory $canon changed before chdir, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting."
444                   );
445             }
446
447             $perm &= oct '7777';    # don't forget setuid, setgid, sticky bits
448             my $nperm = $perm | oct '700';
449
450             # notabene: 0700 is for making readable in the first place,
451             # it's also intended to change it to writable in case we have
452             # to recurse in which case we are better than rm -rf for
453             # subtrees with strange permissions
454
455             if (
456                 !(
457                        $data->{safe}
458                     or $nperm == $perm
459                     or chmod( $nperm, $curdir )
460                 )
461               )
462             {
463                 _error( $data, "cannot make directory read+writeable", $canon );
464                 $nperm = $perm;
465             }
466
467             my $d;
468             $d = gensym() if $] < 5.006;
469             if ( !opendir $d, $curdir ) {
470                 _error( $data, "cannot opendir", $canon );
471                 @files = ();
472             }
473             else {
474                 if ( !defined ${^TAINT} or ${^TAINT} ) {
475                     # Blindly untaint dir names if taint mode is active
476                     @files = map { /\A(.*)\z/s; $1 } readdir $d;
477                 }
478                 else {
479                     @files = readdir $d;
480                 }
481                 closedir $d;
482             }
483
484             if (_IS_VMS) {
485
486                 # Deleting large numbers of files from VMS Files-11
487                 # filesystems is faster if done in reverse ASCIIbetical order.
488                 # include '.' to '.;' from blead patch #31775
489                 @files = map { $_ eq '.' ? '.;' : $_ } reverse @files;
490             }
491
492             @files = grep { $_ ne $updir and $_ ne $curdir } @files;
493
494             if (@files) {
495
496                 # remove the contained files before the directory itself
497                 my $narg = {%$data};
498                 @{$narg}{qw(device inode cwd prefix depth)} =
499                   ( $cur_dev, $cur_inode, $updir, $canon, $data->{depth} + 1 );
500                 $count += _rmtree( $narg, \@files );
501             }
502
503             # restore directory permissions of required now (in case the rmdir
504             # below fails), while we are still in the directory and may do so
505             # without a race via '.'
506             if ( $nperm != $perm and not chmod( $perm, $curdir ) ) {
507                 _error( $data, "cannot reset chmod", $canon );
508             }
509
510             # don't leave the client code in an unexpected directory
511             chdir( $data->{cwd} )
512               or
513               _croak("cannot chdir to $data->{cwd} from $canon: $!, aborting.");
514
515             # ensure that a chdir upwards didn't take us somewhere other
516             # than we expected (see CVE-2002-0435)
517             ( $cur_dev, $cur_inode ) = ( stat $curdir )[ 0, 1 ]
518               or _croak(
519                 "cannot stat prior working directory $data->{cwd}: $!, aborting."
520               );
521
522             if (_NEED_STAT_CHECK) {
523                 ( $data->{device} eq $cur_dev and $data->{inode} eq $cur_inode )
524                   or _croak(  "previous directory $data->{cwd} "
525                             . "changed before entering $canon, "
526                             . "expected dev=$ldev ino=$lino, "
527                             . "actual dev=$cur_dev ino=$cur_inode, aborting."
528                   );
529             }
530
531             if ( $data->{depth} or !$data->{keep_root} ) {
532                 if ( $data->{safe}
533                     && ( _IS_VMS
534                         ? !&VMS::Filespec::candelete($root)
535                         : !-w $root ) )
536                 {
537                     print "skipped $root\n" if $data->{verbose};
538                     next ROOT_DIR;
539                 }
540                 if ( _FORCE_WRITABLE and !chmod $perm | oct '700', $root ) {
541                     _error( $data, "cannot make directory writeable", $canon );
542                 }
543                 print "rmdir $root\n" if $data->{verbose};
544                 if ( rmdir $root ) {
545                     push @{ ${ $data->{result} } }, $root if $data->{result};
546                     ++$count;
547                 }
548                 else {
549                     _error( $data, "cannot remove directory", $canon );
550                     if (
551                         _FORCE_WRITABLE
552                         && !chmod( $perm,
553                             ( _IS_VMS ? VMS::Filespec::fileify($root) : $root )
554                         )
555                       )
556                     {
557                         _error(
558                             $data,
559                             sprintf( "cannot restore permissions to 0%o",
560                                 $perm ),
561                             $canon
562                         );
563                     }
564                 }
565             }
566         }
567         else {
568             # not a directory
569             $root = VMS::Filespec::vmsify("./$root")
570               if _IS_VMS
571               && !File::Spec->file_name_is_absolute($root)
572               && ( $root !~ m/(?<!\^)[\]>]+/ );    # not already in VMS syntax
573
574             if (
575                 $data->{safe}
576                 && (
577                     _IS_VMS
578                     ? !&VMS::Filespec::candelete($root)
579                     : !( -l $root || -w $root )
580                 )
581               )
582             {
583                 print "skipped $root\n" if $data->{verbose};
584                 next ROOT_DIR;
585             }
586
587             my $nperm = $perm & oct '7777' | oct '600';
588             if (    _FORCE_WRITABLE
589                 and $nperm != $perm
590                 and not chmod $nperm, $root )
591             {
592                 _error( $data, "cannot make file writeable", $canon );
593             }
594             print "unlink $canon\n" if $data->{verbose};
595
596             # delete all versions under VMS
597             for ( ; ; ) {
598                 if ( unlink $root ) {
599                     push @{ ${ $data->{result} } }, $root if $data->{result};
600                 }
601                 else {
602                     _error( $data, "cannot unlink file", $canon );
603                     _FORCE_WRITABLE and chmod( $perm, $root )
604                       or _error( $data,
605                         sprintf( "cannot restore permissions to 0%o", $perm ),
606                         $canon );
607                     last;
608                 }
609                 ++$count;
610                 last unless _IS_VMS && lstat $root;
611             }
612         }
613     }
614     return $count;
615 }
616
617 sub _slash_lc {
618
619     # fix up slashes and case on MSWin32 so that we can determine that
620     # c:\path\to\dir is underneath C:/Path/To
621     my $path = shift;
622     $path =~ tr{\\}{/};
623     return lc($path);
624 }
625
626 1;
627
628 __END__
629
630 =head1 NAME
631
632 File::Path - Create or remove directory trees
633
634 =head1 VERSION
635
636 2.15 - released June 07 2017.
637
638 =head1 SYNOPSIS
639
640     use File::Path qw(make_path remove_tree);
641
642     @created = make_path('foo/bar/baz', '/zug/zwang');
643     @created = make_path('foo/bar/baz', '/zug/zwang', {
644         verbose => 1,
645         mode => 0711,
646     });
647     make_path('foo/bar/baz', '/zug/zwang', {
648         chmod => 0777,
649     });
650
651     $removed_count = remove_tree('foo/bar/baz', '/zug/zwang', {
652         verbose => 1,
653         error  => \my $err_list,
654         safe => 1,
655     });
656
657     # legacy (interface promoted before v2.00)
658     @created = mkpath('/foo/bar/baz');
659     @created = mkpath('/foo/bar/baz', 1, 0711);
660     @created = mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
661     $removed_count = rmtree('foo/bar/baz', 1, 1);
662     $removed_count = rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
663
664     # legacy (interface promoted before v2.06)
665     @created = mkpath('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 });
666     $removed_count = rmtree('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 });
667
668 =head1 DESCRIPTION
669
670 This module provides a convenient way to create directories of
671 arbitrary depth and to delete an entire directory subtree from the
672 filesystem.
673
674 The following functions are provided:
675
676 =over
677
678 =item make_path( $dir1, $dir2, .... )
679
680 =item make_path( $dir1, $dir2, ...., \%opts )
681
682 The C<make_path> function creates the given directories if they don't
683 exist before, much like the Unix command C<mkdir -p>.
684
685 The function accepts a list of directories to be created. Its
686 behaviour may be tuned by an optional hashref appearing as the last
687 parameter on the call.
688
689 The function returns the list of directories actually created during
690 the call; in scalar context the number of directories created.
691
692 The following keys are recognised in the option hash:
693
694 =over
695
696 =item mode => $num
697
698 The numeric permissions mode to apply to each created directory
699 (defaults to C<0777>), to be modified by the current C<umask>. If the
700 directory already exists (and thus does not need to be created),
701 the permissions will not be modified.
702
703 C<mask> is recognised as an alias for this parameter.
704
705 =item chmod => $num
706
707 Takes a numeric mode to apply to each created directory (not
708 modified by the current C<umask>). If the directory already exists
709 (and thus does not need to be created), the permissions will
710 not be modified.
711
712 =item verbose => $bool
713
714 If present, will cause C<make_path> to print the name of each directory
715 as it is created. By default nothing is printed.
716
717 =item error => \$err
718
719 If present, it should be a reference to a scalar.
720 This scalar will be made to reference an array, which will
721 be used to store any errors that are encountered.  See the L</"ERROR
722 HANDLING"> section for more information.
723
724 If this parameter is not used, certain error conditions may raise
725 a fatal error that will cause the program to halt, unless trapped
726 in an C<eval> block.
727
728 =item owner => $owner
729
730 =item user => $owner
731
732 =item uid => $owner
733
734 If present, will cause any created directory to be owned by C<$owner>.
735 If the value is numeric, it will be interpreted as a uid; otherwise a
736 username is assumed. An error will be issued if the username cannot be
737 mapped to a uid, the uid does not exist or the process lacks the
738 privileges to change ownership.
739
740 Ownership of directories that already exist will not be changed.
741
742 C<user> and C<uid> are aliases of C<owner>.
743
744 =item group => $group
745
746 If present, will cause any created directory to be owned by the group
747 C<$group>.  If the value is numeric, it will be interpreted as a gid;
748 otherwise a group name is assumed. An error will be issued if the
749 group name cannot be mapped to a gid, the gid does not exist or the
750 process lacks the privileges to change group ownership.
751
752 Group ownership of directories that already exist will not be changed.
753
754     make_path '/var/tmp/webcache', {owner=>'nobody', group=>'nogroup'};
755
756 =back
757
758 =item mkpath( $dir )
759
760 =item mkpath( $dir, $verbose, $mode )
761
762 =item mkpath( [$dir1, $dir2,...], $verbose, $mode )
763
764 =item mkpath( $dir1, $dir2,..., \%opt )
765
766 The C<mkpath()> function provide the legacy interface of
767 C<make_path()> with a different interpretation of the arguments
768 passed.  The behaviour and return value of the function is otherwise
769 identical to C<make_path()>.
770
771 =item remove_tree( $dir1, $dir2, .... )
772
773 =item remove_tree( $dir1, $dir2, ...., \%opts )
774
775 The C<remove_tree> function deletes the given directories and any
776 files and subdirectories they might contain, much like the Unix
777 command C<rm -rf> or the Windows commands C<rmdir /s> and C<rd /s>.
778
779 The function accepts a list of directories to be removed. (In point of fact,
780 it will also accept filesystem entries which are not directories, such as
781 regular files and symlinks.  But, as its name suggests, its intent is to
782 remove trees rather than individual files.)
783
784 C<remove_tree()>'s behaviour may be tuned by an optional hashref
785 appearing as the last parameter on the call.  If an empty string is
786 passed to C<remove_tree>, an error will occur.
787
788 B<NOTE:>  For security reasons, we strongly advise use of the
789 hashref-as-final-argument syntax -- specifically, with a setting of the C<safe>
790 element to a true value.
791
792     remove_tree( $dir1, $dir2, ....,
793         {
794             safe => 1,
795             ...         # other key-value pairs
796         },
797     );
798
799 The function returns the number of files successfully deleted.
800
801 The following keys are recognised in the option hash:
802
803 =over
804
805 =item verbose => $bool
806
807 If present, will cause C<remove_tree> to print the name of each file as
808 it is unlinked. By default nothing is printed.
809
810 =item safe => $bool
811
812 When set to a true value, will cause C<remove_tree> to skip the files
813 for which the process lacks the required privileges needed to delete
814 files, such as delete privileges on VMS. In other words, the code
815 will make no attempt to alter file permissions. Thus, if the process
816 is interrupted, no filesystem object will be left in a more
817 permissive mode.
818
819 =item keep_root => $bool
820
821 When set to a true value, will cause all files and subdirectories
822 to be removed, except the initially specified directories. This comes
823 in handy when cleaning out an application's scratch directory.
824
825     remove_tree( '/tmp', {keep_root => 1} );
826
827 =item result => \$res
828
829 If present, it should be a reference to a scalar.
830 This scalar will be made to reference an array, which will
831 be used to store all files and directories unlinked
832 during the call. If nothing is unlinked, the array will be empty.
833
834     remove_tree( '/tmp', {result => \my $list} );
835     print "unlinked $_\n" for @$list;
836
837 This is a useful alternative to the C<verbose> key.
838
839 =item error => \$err
840
841 If present, it should be a reference to a scalar.
842 This scalar will be made to reference an array, which will
843 be used to store any errors that are encountered.  See the L</"ERROR
844 HANDLING"> section for more information.
845
846 Removing things is a much more dangerous proposition than
847 creating things. As such, there are certain conditions that
848 C<remove_tree> may encounter that are so dangerous that the only
849 sane action left is to kill the program.
850
851 Use C<error> to trap all that is reasonable (problems with
852 permissions and the like), and let it die if things get out
853 of hand. This is the safest course of action.
854
855 =back
856
857 =item rmtree( $dir )
858
859 =item rmtree( $dir, $verbose, $safe )
860
861 =item rmtree( [$dir1, $dir2,...], $verbose, $safe )
862
863 =item rmtree( $dir1, $dir2,..., \%opt )
864
865 The C<rmtree()> function provide the legacy interface of
866 C<remove_tree()> with a different interpretation of the arguments
867 passed. The behaviour and return value of the function is otherwise
868 identical to C<remove_tree()>.
869
870 B<NOTE:>  For security reasons, we strongly advise use of the
871 hashref-as-final-argument syntax, specifically with a setting of the C<safe>
872 element to a true value.
873
874     rmtree( $dir1, $dir2, ....,
875         {
876             safe => 1,
877             ...         # other key-value pairs
878         },
879     );
880
881 =back
882
883 =head2 ERROR HANDLING
884
885 =over 4
886
887 =item B<NOTE:>
888
889 The following error handling mechanism is consistent throughout all
890 code paths EXCEPT in cases where the ROOT node is nonexistent.  In
891 version 2.11 the maintainers attempted to rectify this inconsistency
892 but too many downstream modules encountered problems.  In such case,
893 if you require root node evaluation or error checking prior to calling
894 C<make_path> or C<remove_tree>, you should take additional precautions.
895
896 =back
897
898 If C<make_path> or C<remove_tree> encounters an error, a diagnostic
899 message will be printed to C<STDERR> via C<carp> (for non-fatal
900 errors) or via C<croak> (for fatal errors).
901
902 If this behaviour is not desirable, the C<error> attribute may be
903 used to hold a reference to a variable, which will be used to store
904 the diagnostics. The variable is made a reference to an array of hash
905 references.  Each hash contain a single key/value pair where the key
906 is the name of the file, and the value is the error message (including
907 the contents of C<$!> when appropriate).  If a general error is
908 encountered the diagnostic key will be empty.
909
910 An example usage looks like:
911
912   remove_tree( 'foo/bar', 'bar/rat', {error => \my $err} );
913   if ($err && @$err) {
914       for my $diag (@$err) {
915           my ($file, $message) = %$diag;
916           if ($file eq '') {
917               print "general error: $message\n";
918           }
919           else {
920               print "problem unlinking $file: $message\n";
921           }
922       }
923   }
924   else {
925       print "No error encountered\n";
926   }
927
928 Note that if no errors are encountered, C<$err> will reference an
929 empty array.  This means that C<$err> will always end up TRUE; so you
930 need to test C<@$err> to determine if errors occurred.
931
932 =head2 NOTES
933
934 C<File::Path> blindly exports C<mkpath> and C<rmtree> into the
935 current namespace. These days, this is considered bad style, but
936 to change it now would break too much code. Nonetheless, you are
937 invited to specify what it is you are expecting to use:
938
939   use File::Path 'rmtree';
940
941 The routines C<make_path> and C<remove_tree> are B<not> exported
942 by default. You must specify which ones you want to use.
943
944   use File::Path 'remove_tree';
945
946 Note that a side-effect of the above is that C<mkpath> and C<rmtree>
947 are no longer exported at all. This is due to the way the C<Exporter>
948 module works. If you are migrating a codebase to use the new
949 interface, you will have to list everything explicitly. But that's
950 just good practice anyway.
951
952   use File::Path qw(remove_tree rmtree);
953
954 =head3 API CHANGES
955
956 The API was changed in the 2.0 branch. For a time, C<mkpath> and
957 C<rmtree> tried, unsuccessfully, to deal with the two different
958 calling mechanisms. This approach was considered a failure.
959
960 The new semantics are now only available with C<make_path> and
961 C<remove_tree>. The old semantics are only available through
962 C<mkpath> and C<rmtree>. Users are strongly encouraged to upgrade
963 to at least 2.08 in order to avoid surprises.
964
965 =head3 SECURITY CONSIDERATIONS
966
967 There were race conditions in the 1.x implementations of File::Path's
968 C<rmtree> function (although sometimes patched depending on the OS
969 distribution or platform). The 2.0 version contains code to avoid the
970 problem mentioned in CVE-2002-0435.
971
972 See the following pages for more information:
973
974     http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=286905
975     http://www.nntp.perl.org/group/perl.perl5.porters/2005/01/msg97623.html
976     http://www.debian.org/security/2005/dsa-696
977
978 Additionally, unless the C<safe> parameter is set (or the
979 third parameter in the traditional interface is TRUE), should a
980 C<remove_tree> be interrupted, files that were originally in read-only
981 mode may now have their permissions set to a read-write (or "delete
982 OK") mode.
983
984 The following CVE reports were previously filed against File-Path and are
985 believed to have been addressed:
986
987 =over 4
988
989 =item * L<http://cve.circl.lu/cve/CVE-2004-0452>
990
991 =item * L<http://cve.circl.lu/cve/CVE-2005-0448>
992
993 =back
994
995 In February 2017 the cPanel Security Team reported an additional vulnerability
996 in File-Path.  The C<chmod()> logic to make directories traversable can be
997 abused to set the mode on an attacker-chosen file to an attacker-chosen value.
998 This is due to the time-of-check-to-time-of-use (TOCTTOU) race condition
999 (L<https://en.wikipedia.org/wiki/Time_of_check_to_time_of_use>) between the
1000 C<stat()> that decides the inode is a directory and the C<chmod()> that tries
1001 to make it user-rwx.  CPAN versions 2.13 and later incorporate a patch
1002 provided by John Lightsey to address this problem.  This vulnerability has
1003 been reported as CVE-2017-6512.
1004
1005 =head1 DIAGNOSTICS
1006
1007 FATAL errors will cause the program to halt (C<croak>), since the
1008 problem is so severe that it would be dangerous to continue. (This
1009 can always be trapped with C<eval>, but it's not a good idea. Under
1010 the circumstances, dying is the best thing to do).
1011
1012 SEVERE errors may be trapped using the modern interface. If the
1013 they are not trapped, or if the old interface is used, such an error
1014 will cause the program will halt.
1015
1016 All other errors may be trapped using the modern interface, otherwise
1017 they will be C<carp>ed about. Program execution will not be halted.
1018
1019 =over 4
1020
1021 =item mkdir [path]: [errmsg] (SEVERE)
1022
1023 C<make_path> was unable to create the path. Probably some sort of
1024 permissions error at the point of departure or insufficient resources
1025 (such as free inodes on Unix).
1026
1027 =item No root path(s) specified
1028
1029 C<make_path> was not given any paths to create. This message is only
1030 emitted if the routine is called with the traditional interface.
1031 The modern interface will remain silent if given nothing to do.
1032
1033 =item No such file or directory
1034
1035 On Windows, if C<make_path> gives you this warning, it may mean that
1036 you have exceeded your filesystem's maximum path length.
1037
1038 =item cannot fetch initial working directory: [errmsg]
1039
1040 C<remove_tree> attempted to determine the initial directory by calling
1041 C<Cwd::getcwd>, but the call failed for some reason. No attempt
1042 will be made to delete anything.
1043
1044 =item cannot stat initial working directory: [errmsg]
1045
1046 C<remove_tree> attempted to stat the initial directory (after having
1047 successfully obtained its name via C<getcwd>), however, the call
1048 failed for some reason. No attempt will be made to delete anything.
1049
1050 =item cannot chdir to [dir]: [errmsg]
1051
1052 C<remove_tree> attempted to set the working directory in order to
1053 begin deleting the objects therein, but was unsuccessful. This is
1054 usually a permissions issue. The routine will continue to delete
1055 other things, but this directory will be left intact.
1056
1057 =item directory [dir] changed before chdir, expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL)
1058
1059 C<remove_tree> recorded the device and inode of a directory, and then
1060 moved into it. It then performed a C<stat> on the current directory
1061 and detected that the device and inode were no longer the same. As
1062 this is at the heart of the race condition problem, the program
1063 will die at this point.
1064
1065 =item cannot make directory [dir] read+writeable: [errmsg]
1066
1067 C<remove_tree> attempted to change the permissions on the current directory
1068 to ensure that subsequent unlinkings would not run into problems,
1069 but was unable to do so. The permissions remain as they were, and
1070 the program will carry on, doing the best it can.
1071
1072 =item cannot read [dir]: [errmsg]
1073
1074 C<remove_tree> tried to read the contents of the directory in order
1075 to acquire the names of the directory entries to be unlinked, but
1076 was unsuccessful. This is usually a permissions issue. The
1077 program will continue, but the files in this directory will remain
1078 after the call.
1079
1080 =item cannot reset chmod [dir]: [errmsg]
1081
1082 C<remove_tree>, after having deleted everything in a directory, attempted
1083 to restore its permissions to the original state but failed. The
1084 directory may wind up being left behind.
1085
1086 =item cannot remove [dir] when cwd is [dir]
1087
1088 The current working directory of the program is F</some/path/to/here>
1089 and you are attempting to remove an ancestor, such as F</some/path>.
1090 The directory tree is left untouched.
1091
1092 The solution is to C<chdir> out of the child directory to a place
1093 outside the directory tree to be removed.
1094
1095 =item cannot chdir to [parent-dir] from [child-dir]: [errmsg], aborting. (FATAL)
1096
1097 C<remove_tree>, after having deleted everything and restored the permissions
1098 of a directory, was unable to chdir back to the parent. The program
1099 halts to avoid a race condition from occurring.
1100
1101 =item cannot stat prior working directory [dir]: [errmsg], aborting. (FATAL)
1102
1103 C<remove_tree> was unable to stat the parent directory after having returned
1104 from the child. Since there is no way of knowing if we returned to
1105 where we think we should be (by comparing device and inode) the only
1106 way out is to C<croak>.
1107
1108 =item previous directory [parent-dir] changed before entering [child-dir], expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL)
1109
1110 When C<remove_tree> returned from deleting files in a child directory, a
1111 check revealed that the parent directory it returned to wasn't the one
1112 it started out from. This is considered a sign of malicious activity.
1113
1114 =item cannot make directory [dir] writeable: [errmsg]
1115
1116 Just before removing a directory (after having successfully removed
1117 everything it contained), C<remove_tree> attempted to set the permissions
1118 on the directory to ensure it could be removed and failed. Program
1119 execution continues, but the directory may possibly not be deleted.
1120
1121 =item cannot remove directory [dir]: [errmsg]
1122
1123 C<remove_tree> attempted to remove a directory, but failed. This may be because
1124 some objects that were unable to be removed remain in the directory, or
1125 it could be a permissions issue. The directory will be left behind.
1126
1127 =item cannot restore permissions of [dir] to [0nnn]: [errmsg]
1128
1129 After having failed to remove a directory, C<remove_tree> was unable to
1130 restore its permissions from a permissive state back to a possibly
1131 more restrictive setting. (Permissions given in octal).
1132
1133 =item cannot make file [file] writeable: [errmsg]
1134
1135 C<remove_tree> attempted to force the permissions of a file to ensure it
1136 could be deleted, but failed to do so. It will, however, still attempt
1137 to unlink the file.
1138
1139 =item cannot unlink file [file]: [errmsg]
1140
1141 C<remove_tree> failed to remove a file. Probably a permissions issue.
1142
1143 =item cannot restore permissions of [file] to [0nnn]: [errmsg]
1144
1145 After having failed to remove a file, C<remove_tree> was also unable
1146 to restore the permissions on the file to a possibly less permissive
1147 setting. (Permissions given in octal).
1148
1149 =item unable to map [owner] to a uid, ownership not changed");
1150
1151 C<make_path> was instructed to give the ownership of created
1152 directories to the symbolic name [owner], but C<getpwnam> did
1153 not return the corresponding numeric uid. The directory will
1154 be created, but ownership will not be changed.
1155
1156 =item unable to map [group] to a gid, group ownership not changed
1157
1158 C<make_path> was instructed to give the group ownership of created
1159 directories to the symbolic name [group], but C<getgrnam> did
1160 not return the corresponding numeric gid. The directory will
1161 be created, but group ownership will not be changed.
1162
1163 =back
1164
1165 =head1 SEE ALSO
1166
1167 =over 4
1168
1169 =item *
1170
1171 L<File::Remove>
1172
1173 Allows files and directories to be moved to the Trashcan/Recycle
1174 Bin (where they may later be restored if necessary) if the operating
1175 system supports such functionality. This feature may one day be
1176 made available directly in C<File::Path>.
1177
1178 =item *
1179
1180 L<File::Find::Rule>
1181
1182 When removing directory trees, if you want to examine each file to
1183 decide whether to delete it (and possibly leaving large swathes
1184 alone), F<File::Find::Rule> offers a convenient and flexible approach
1185 to examining directory trees.
1186
1187 =back
1188
1189 =head1 BUGS AND LIMITATIONS
1190
1191 The following describes F<File::Path> limitations and how to report bugs.
1192
1193 =head2 MULTITHREADED APPLICATIONS
1194
1195 F<File::Path> C<rmtree> and C<remove_tree> will not work with
1196 multithreaded applications due to its use of C<chdir>.  At this time,
1197 no warning or error is generated in this situation.  You will
1198 certainly encounter unexpected results.
1199
1200 The implementation that surfaces this limitation will not be changed. See the
1201 F<File::Path::Tiny> module for functionality similar to F<File::Path> but which does
1202 not C<chdir>.
1203
1204 =head2 NFS Mount Points
1205
1206 F<File::Path> is not responsible for triggering the automounts, mirror mounts,
1207 and the contents of network mounted filesystems.  If your NFS implementation
1208 requires an action to be performed on the filesystem in order for
1209 F<File::Path> to perform operations, it is strongly suggested you assure
1210 filesystem availability by reading the root of the mounted filesystem.
1211
1212 =head2 REPORTING BUGS
1213
1214 Please report all bugs on the RT queue, either via the web interface:
1215
1216 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Path>
1217
1218 or by email:
1219
1220     bug-File-Path@rt.cpan.org
1221
1222 In either case, please B<attach> patches to the bug report rather than
1223 including them inline in the web post or the body of the email.
1224
1225 You can also send pull requests to the Github repository:
1226
1227 L<https://github.com/rpcme/File-Path>
1228
1229 =head1 ACKNOWLEDGEMENTS
1230
1231 Paul Szabo identified the race condition originally, and Brendan
1232 O'Dea wrote an implementation for Debian that addressed the problem.
1233 That code was used as a basis for the current code. Their efforts
1234 are greatly appreciated.
1235
1236 Gisle Aas made a number of improvements to the documentation for
1237 2.07 and his advice and assistance is also greatly appreciated.
1238
1239 =head1 AUTHORS
1240
1241 Prior authors and maintainers: Tim Bunce, Charles Bailey, and
1242 David Landgren <F<david@landgren.net>>.
1243
1244 Current maintainers are Richard Elberger <F<riche@cpan.org>> and
1245 James (Jim) Keenan <F<jkeenan@cpan.org>>.
1246
1247 =head1 CONTRIBUTORS
1248
1249 Contributors to File::Path, in alphabetical order by first name.
1250
1251 =over 1
1252
1253 =item <F<bulkdd@cpan.org>>
1254
1255 =item Charlie Gonzalez <F<itcharlie@cpan.org>>
1256
1257 =item Craig A. Berry <F<craigberry@mac.com>>
1258
1259 =item James E Keenan <F<jkeenan@cpan.org>>
1260
1261 =item John Lightsey <F<john@perlsec.org>>
1262
1263 =item Nigel Horne <F<njh@bandsman.co.uk>>
1264
1265 =item Richard Elberger <F<riche@cpan.org>>
1266
1267 =item Ryan Yee <F<ryee@cpan.org>>
1268
1269 =item Skye Shaw <F<shaw@cpan.org>>
1270
1271 =item Tom Lutz <F<tommylutz@gmail.com>>
1272
1273 =item Will Sheppard <F<willsheppard@github>>
1274
1275 =back
1276
1277 =head1 COPYRIGHT
1278
1279 This module is copyright (C) Charles Bailey, Tim Bunce, David Landgren,
1280 James Keenan and Richard Elberger 1995-2017. All rights reserved.
1281
1282 =head1 LICENSE
1283
1284 This library is free software; you can redistribute it and/or modify
1285 it under the same terms as Perl itself.
1286
1287 =cut