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.14
[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.14';
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.14 - released June 07 2016.
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>. The
778 only exception to the function similarity is that C<remove_tree> accepts
779 only directories whereas C<rm -rf> also accepts files.
780
781 The function accepts a list of directories to be
782 removed. Its behaviour may be tuned by an optional hashref
783 appearing as the last parameter on the call.  If an empty string is
784 passed to C<remove_tree>, an error will occur.
785
786 B<NOTE:>  For security reasons, we strongly advise use of the
787 hashref-as-final-argument syntax -- specifically, with a setting of the C<safe>
788 element to a true value.
789
790     remove_tree( $dir1, $dir2, ....,
791         {
792             safe => 1,
793             ...         # other key-value pairs
794         },
795     );
796
797 The function returns the number of files successfully deleted.
798
799 The following keys are recognised in the option hash:
800
801 =over
802
803 =item verbose => $bool
804
805 If present, will cause C<remove_tree> to print the name of each file as
806 it is unlinked. By default nothing is printed.
807
808 =item safe => $bool
809
810 When set to a true value, will cause C<remove_tree> to skip the files
811 for which the process lacks the required privileges needed to delete
812 files, such as delete privileges on VMS. In other words, the code
813 will make no attempt to alter file permissions. Thus, if the process
814 is interrupted, no filesystem object will be left in a more
815 permissive mode.
816
817 =item keep_root => $bool
818
819 When set to a true value, will cause all files and subdirectories
820 to be removed, except the initially specified directories. This comes
821 in handy when cleaning out an application's scratch directory.
822
823     remove_tree( '/tmp', {keep_root => 1} );
824
825 =item result => \$res
826
827 If present, it should be a reference to a scalar.
828 This scalar will be made to reference an array, which will
829 be used to store all files and directories unlinked
830 during the call. If nothing is unlinked, the array will be empty.
831
832     remove_tree( '/tmp', {result => \my $list} );
833     print "unlinked $_\n" for @$list;
834
835 This is a useful alternative to the C<verbose> key.
836
837 =item error => \$err
838
839 If present, it should be a reference to a scalar.
840 This scalar will be made to reference an array, which will
841 be used to store any errors that are encountered.  See the L</"ERROR
842 HANDLING"> section for more information.
843
844 Removing things is a much more dangerous proposition than
845 creating things. As such, there are certain conditions that
846 C<remove_tree> may encounter that are so dangerous that the only
847 sane action left is to kill the program.
848
849 Use C<error> to trap all that is reasonable (problems with
850 permissions and the like), and let it die if things get out
851 of hand. This is the safest course of action.
852
853 =back
854
855 =item rmtree( $dir )
856
857 =item rmtree( $dir, $verbose, $safe )
858
859 =item rmtree( [$dir1, $dir2,...], $verbose, $safe )
860
861 =item rmtree( $dir1, $dir2,..., \%opt )
862
863 The C<rmtree()> function provide the legacy interface of
864 C<remove_tree()> with a different interpretation of the arguments
865 passed. The behaviour and return value of the function is otherwise
866 identical to C<remove_tree()>.
867
868 B<NOTE:>  For security reasons, we strongly advise use of the
869 hashref-as-final-argument syntax, specifically with a setting of the C<safe>
870 element to a true value.
871
872     rmtree( $dir1, $dir2, ....,
873         {
874             safe => 1,
875             ...         # other key-value pairs
876         },
877     );
878
879 =back
880
881 =head2 ERROR HANDLING
882
883 =over 4
884
885 =item B<NOTE:>
886
887 The following error handling mechanism is consistent throughout all
888 code paths EXCEPT in cases where the ROOT node is nonexistent.  In
889 version 2.11 the maintainers attempted to rectify this inconsistency
890 but too many downstream modules encountered problems.  In such case,
891 if you require root node evaluation or error checking prior to calling
892 C<make_path> or C<remove_tree>, you should take additional precautions.
893
894 =back
895
896 If C<make_path> or C<remove_tree> encounters an error, a diagnostic
897 message will be printed to C<STDERR> via C<carp> (for non-fatal
898 errors) or via C<croak> (for fatal errors).
899
900 If this behaviour is not desirable, the C<error> attribute may be
901 used to hold a reference to a variable, which will be used to store
902 the diagnostics. The variable is made a reference to an array of hash
903 references.  Each hash contain a single key/value pair where the key
904 is the name of the file, and the value is the error message (including
905 the contents of C<$!> when appropriate).  If a general error is
906 encountered the diagnostic key will be empty.
907
908 An example usage looks like:
909
910   remove_tree( 'foo/bar', 'bar/rat', {error => \my $err} );
911   if ($err && @$err) {
912       for my $diag (@$err) {
913           my ($file, $message) = %$diag;
914           if ($file eq '') {
915               print "general error: $message\n";
916           }
917           else {
918               print "problem unlinking $file: $message\n";
919           }
920       }
921   }
922   else {
923       print "No error encountered\n";
924   }
925
926 Note that if no errors are encountered, C<$err> will reference an
927 empty array.  This means that C<$err> will always end up TRUE; so you
928 need to test C<@$err> to determine if errors occurred.
929
930 =head2 NOTES
931
932 C<File::Path> blindly exports C<mkpath> and C<rmtree> into the
933 current namespace. These days, this is considered bad style, but
934 to change it now would break too much code. Nonetheless, you are
935 invited to specify what it is you are expecting to use:
936
937   use File::Path 'rmtree';
938
939 The routines C<make_path> and C<remove_tree> are B<not> exported
940 by default. You must specify which ones you want to use.
941
942   use File::Path 'remove_tree';
943
944 Note that a side-effect of the above is that C<mkpath> and C<rmtree>
945 are no longer exported at all. This is due to the way the C<Exporter>
946 module works. If you are migrating a codebase to use the new
947 interface, you will have to list everything explicitly. But that's
948 just good practice anyway.
949
950   use File::Path qw(remove_tree rmtree);
951
952 =head3 API CHANGES
953
954 The API was changed in the 2.0 branch. For a time, C<mkpath> and
955 C<rmtree> tried, unsuccessfully, to deal with the two different
956 calling mechanisms. This approach was considered a failure.
957
958 The new semantics are now only available with C<make_path> and
959 C<remove_tree>. The old semantics are only available through
960 C<mkpath> and C<rmtree>. Users are strongly encouraged to upgrade
961 to at least 2.08 in order to avoid surprises.
962
963 =head3 SECURITY CONSIDERATIONS
964
965 There were race conditions in the 1.x implementations of File::Path's
966 C<rmtree> function (although sometimes patched depending on the OS
967 distribution or platform). The 2.0 version contains code to avoid the
968 problem mentioned in CVE-2002-0435.
969
970 See the following pages for more information:
971
972     http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=286905
973     http://www.nntp.perl.org/group/perl.perl5.porters/2005/01/msg97623.html
974     http://www.debian.org/security/2005/dsa-696
975
976 Additionally, unless the C<safe> parameter is set (or the
977 third parameter in the traditional interface is TRUE), should a
978 C<remove_tree> be interrupted, files that were originally in read-only
979 mode may now have their permissions set to a read-write (or "delete
980 OK") mode.
981
982 The following CVE reports were previously filed against File-Path and are
983 believed to have been addressed:
984
985 =over 4
986
987 =item * L<http://cve.circl.lu/cve/CVE-2004-0452>
988
989 =item * L<http://cve.circl.lu/cve/CVE-2005-0448>
990
991 =back
992
993 In February 2017 the cPanel Security Team reported an additional vulnerability
994 in File-Path.  The C<chmod()> logic to make directories traversable can be
995 abused to set the mode on an attacker-chosen file to an attacker-chosen value.
996 This is due to the time-of-check-to-time-of-use (TOCTTOU) race condition
997 (L<https://en.wikipedia.org/wiki/Time_of_check_to_time_of_use>) between the
998 C<stat()> that decides the inode is a directory and the C<chmod()> that tries
999 to make it user-rwx.  CPAN versions 2.13 and later incorporate a patch
1000 provided by John Lightsey to address this problem.  This vulnerability has
1001 been reported as CVE-2017-6512.
1002
1003 =head1 DIAGNOSTICS
1004
1005 FATAL errors will cause the program to halt (C<croak>), since the
1006 problem is so severe that it would be dangerous to continue. (This
1007 can always be trapped with C<eval>, but it's not a good idea. Under
1008 the circumstances, dying is the best thing to do).
1009
1010 SEVERE errors may be trapped using the modern interface. If the
1011 they are not trapped, or if the old interface is used, such an error
1012 will cause the program will halt.
1013
1014 All other errors may be trapped using the modern interface, otherwise
1015 they will be C<carp>ed about. Program execution will not be halted.
1016
1017 =over 4
1018
1019 =item mkdir [path]: [errmsg] (SEVERE)
1020
1021 C<make_path> was unable to create the path. Probably some sort of
1022 permissions error at the point of departure or insufficient resources
1023 (such as free inodes on Unix).
1024
1025 =item No root path(s) specified
1026
1027 C<make_path> was not given any paths to create. This message is only
1028 emitted if the routine is called with the traditional interface.
1029 The modern interface will remain silent if given nothing to do.
1030
1031 =item No such file or directory
1032
1033 On Windows, if C<make_path> gives you this warning, it may mean that
1034 you have exceeded your filesystem's maximum path length.
1035
1036 =item cannot fetch initial working directory: [errmsg]
1037
1038 C<remove_tree> attempted to determine the initial directory by calling
1039 C<Cwd::getcwd>, but the call failed for some reason. No attempt
1040 will be made to delete anything.
1041
1042 =item cannot stat initial working directory: [errmsg]
1043
1044 C<remove_tree> attempted to stat the initial directory (after having
1045 successfully obtained its name via C<getcwd>), however, the call
1046 failed for some reason. No attempt will be made to delete anything.
1047
1048 =item cannot chdir to [dir]: [errmsg]
1049
1050 C<remove_tree> attempted to set the working directory in order to
1051 begin deleting the objects therein, but was unsuccessful. This is
1052 usually a permissions issue. The routine will continue to delete
1053 other things, but this directory will be left intact.
1054
1055 =item directory [dir] changed before chdir, expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL)
1056
1057 C<remove_tree> recorded the device and inode of a directory, and then
1058 moved into it. It then performed a C<stat> on the current directory
1059 and detected that the device and inode were no longer the same. As
1060 this is at the heart of the race condition problem, the program
1061 will die at this point.
1062
1063 =item cannot make directory [dir] read+writeable: [errmsg]
1064
1065 C<remove_tree> attempted to change the permissions on the current directory
1066 to ensure that subsequent unlinkings would not run into problems,
1067 but was unable to do so. The permissions remain as they were, and
1068 the program will carry on, doing the best it can.
1069
1070 =item cannot read [dir]: [errmsg]
1071
1072 C<remove_tree> tried to read the contents of the directory in order
1073 to acquire the names of the directory entries to be unlinked, but
1074 was unsuccessful. This is usually a permissions issue. The
1075 program will continue, but the files in this directory will remain
1076 after the call.
1077
1078 =item cannot reset chmod [dir]: [errmsg]
1079
1080 C<remove_tree>, after having deleted everything in a directory, attempted
1081 to restore its permissions to the original state but failed. The
1082 directory may wind up being left behind.
1083
1084 =item cannot remove [dir] when cwd is [dir]
1085
1086 The current working directory of the program is F</some/path/to/here>
1087 and you are attempting to remove an ancestor, such as F</some/path>.
1088 The directory tree is left untouched.
1089
1090 The solution is to C<chdir> out of the child directory to a place
1091 outside the directory tree to be removed.
1092
1093 =item cannot chdir to [parent-dir] from [child-dir]: [errmsg], aborting. (FATAL)
1094
1095 C<remove_tree>, after having deleted everything and restored the permissions
1096 of a directory, was unable to chdir back to the parent. The program
1097 halts to avoid a race condition from occurring.
1098
1099 =item cannot stat prior working directory [dir]: [errmsg], aborting. (FATAL)
1100
1101 C<remove_tree> was unable to stat the parent directory after having returned
1102 from the child. Since there is no way of knowing if we returned to
1103 where we think we should be (by comparing device and inode) the only
1104 way out is to C<croak>.
1105
1106 =item previous directory [parent-dir] changed before entering [child-dir], expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL)
1107
1108 When C<remove_tree> returned from deleting files in a child directory, a
1109 check revealed that the parent directory it returned to wasn't the one
1110 it started out from. This is considered a sign of malicious activity.
1111
1112 =item cannot make directory [dir] writeable: [errmsg]
1113
1114 Just before removing a directory (after having successfully removed
1115 everything it contained), C<remove_tree> attempted to set the permissions
1116 on the directory to ensure it could be removed and failed. Program
1117 execution continues, but the directory may possibly not be deleted.
1118
1119 =item cannot remove directory [dir]: [errmsg]
1120
1121 C<remove_tree> attempted to remove a directory, but failed. This may be because
1122 some objects that were unable to be removed remain in the directory, or
1123 it could be a permissions issue. The directory will be left behind.
1124
1125 =item cannot restore permissions of [dir] to [0nnn]: [errmsg]
1126
1127 After having failed to remove a directory, C<remove_tree> was unable to
1128 restore its permissions from a permissive state back to a possibly
1129 more restrictive setting. (Permissions given in octal).
1130
1131 =item cannot make file [file] writeable: [errmsg]
1132
1133 C<remove_tree> attempted to force the permissions of a file to ensure it
1134 could be deleted, but failed to do so. It will, however, still attempt
1135 to unlink the file.
1136
1137 =item cannot unlink file [file]: [errmsg]
1138
1139 C<remove_tree> failed to remove a file. Probably a permissions issue.
1140
1141 =item cannot restore permissions of [file] to [0nnn]: [errmsg]
1142
1143 After having failed to remove a file, C<remove_tree> was also unable
1144 to restore the permissions on the file to a possibly less permissive
1145 setting. (Permissions given in octal).
1146
1147 =item unable to map [owner] to a uid, ownership not changed");
1148
1149 C<make_path> was instructed to give the ownership of created
1150 directories to the symbolic name [owner], but C<getpwnam> did
1151 not return the corresponding numeric uid. The directory will
1152 be created, but ownership will not be changed.
1153
1154 =item unable to map [group] to a gid, group ownership not changed
1155
1156 C<make_path> was instructed to give the group ownership of created
1157 directories to the symbolic name [group], but C<getgrnam> did
1158 not return the corresponding numeric gid. The directory will
1159 be created, but group ownership will not be changed.
1160
1161 =back
1162
1163 =head1 SEE ALSO
1164
1165 =over 4
1166
1167 =item *
1168
1169 L<File::Remove>
1170
1171 Allows files and directories to be moved to the Trashcan/Recycle
1172 Bin (where they may later be restored if necessary) if the operating
1173 system supports such functionality. This feature may one day be
1174 made available directly in C<File::Path>.
1175
1176 =item *
1177
1178 L<File::Find::Rule>
1179
1180 When removing directory trees, if you want to examine each file to
1181 decide whether to delete it (and possibly leaving large swathes
1182 alone), F<File::Find::Rule> offers a convenient and flexible approach
1183 to examining directory trees.
1184
1185 =back
1186
1187 =head1 BUGS AND LIMITATIONS
1188
1189 The following describes F<File::Path> limitations and how to report bugs.
1190
1191 =head2 MULTITHREADED APPLICATIONS
1192
1193 F<File::Path> C<rmtree> and C<remove_tree> will not work with
1194 multithreaded applications due to its use of C<chdir>.  At this time,
1195 no warning or error is generated in this situation.  You will
1196 certainly encounter unexpected results.
1197
1198 The implementation that surfaces this limitation will not be changed. See the
1199 F<File::Path::Tiny> module for functionality similar to F<File::Path> but which does
1200 not C<chdir>.
1201
1202 =head2 NFS Mount Points
1203
1204 F<File::Path> is not responsible for triggering the automounts, mirror mounts,
1205 and the contents of network mounted filesystems.  If your NFS implementation
1206 requires an action to be performed on the filesystem in order for
1207 F<File::Path> to perform operations, it is strongly suggested you assure
1208 filesystem availability by reading the root of the mounted filesystem.
1209
1210 =head2 REPORTING BUGS
1211
1212 Please report all bugs on the RT queue, either via the web interface:
1213
1214 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Path>
1215
1216 or by email:
1217
1218     bug-File-Path@rt.cpan.org
1219
1220 In either case, please B<attach> patches to the bug report rather than
1221 including them inline in the web post or the body of the email.
1222
1223 You can also send pull requests to the Github repository:
1224
1225 L<https://github.com/rpcme/File-Path>
1226
1227 =head1 ACKNOWLEDGEMENTS
1228
1229 Paul Szabo identified the race condition originally, and Brendan
1230 O'Dea wrote an implementation for Debian that addressed the problem.
1231 That code was used as a basis for the current code. Their efforts
1232 are greatly appreciated.
1233
1234 Gisle Aas made a number of improvements to the documentation for
1235 2.07 and his advice and assistance is also greatly appreciated.
1236
1237 =head1 AUTHORS
1238
1239 Prior authors and maintainers: Tim Bunce, Charles Bailey, and
1240 David Landgren <F<david@landgren.net>>.
1241
1242 Current maintainers are Richard Elberger <F<riche@cpan.org>> and
1243 James (Jim) Keenan <F<jkeenan@cpan.org>>.
1244
1245 =head1 CONTRIBUTORS
1246
1247 Contributors to File::Path, in alphabetical order by first name.
1248
1249 =over 1
1250
1251 =item <F<bulkdd@cpan.org>>
1252
1253 =item Charlie Gonzalez <F<itcharlie@cpan.org>>
1254
1255 =item Craig A. Berry <F<craigberry@mac.com>>
1256
1257 =item James E Keenan <F<jkeenan@cpan.org>>
1258
1259 =item John Lightsey <F<john@perlsec.org>>
1260
1261 =item Nigel Horne <F<njh@bandsman.co.uk>>
1262
1263 =item Richard Elberger <F<riche@cpan.org>>
1264
1265 =item Ryan Yee <F<ryee@cpan.org>>
1266
1267 =item Skye Shaw <F<shaw@cpan.org>>
1268
1269 =item Tom Lutz <F<tommylutz@gmail.com>>
1270
1271 =item Will Sheppard <F<willsheppard@github>>
1272
1273 =back
1274
1275 =head1 COPYRIGHT
1276
1277 This module is copyright (C) Charles Bailey, Tim Bunce, David Landgren,
1278 James Keenan and Richard Elberger 1995-2017. All rights reserved.
1279
1280 =head1 LICENSE
1281
1282 This library is free software; you can redistribute it and/or modify
1283 it under the same terms as Perl itself.
1284
1285 =cut