123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985 |
- package File::Path;
- use 5.005_04;
- use strict;
- use Cwd 'getcwd';
- use File::Basename ();
- use File::Spec ();
- BEGIN {
- if ($] < 5.006) {
- # can't say 'opendir my $dh, $dirname'
- # need to initialise $dh
- eval "use Symbol";
- }
- }
- use Exporter ();
- use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
- $VERSION = '2.09';
- @ISA = qw(Exporter);
- @EXPORT = qw(mkpath rmtree);
- @EXPORT_OK = qw(make_path remove_tree);
- my $Is_VMS = $^O eq 'VMS';
- my $Is_MacOS = $^O eq 'MacOS';
- # These OSes complain if you want to remove a file that you have no
- # write permission to:
- my $Force_Writeable = grep {$^O eq $_} qw(amigaos dos epoc MSWin32 MacOS os2);
- # Unix-like systems need to stat each directory in order to detect
- # race condition. MS-Windows is immune to this particular attack.
- my $Need_Stat_Check = !($^O eq 'MSWin32');
- sub _carp {
- require Carp;
- goto &Carp::carp;
- }
- sub _croak {
- require Carp;
- goto &Carp::croak;
- }
- sub _error {
- my $arg = shift;
- my $message = shift;
- my $object = shift;
- if ($arg->{error}) {
- $object = '' unless defined $object;
- $message .= ": $!" if $!;
- push @{${$arg->{error}}}, {$object => $message};
- }
- else {
- _carp(defined($object) ? "$message for $object: $!" : "$message: $!");
- }
- }
- sub make_path {
- push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH');
- goto &mkpath;
- }
- sub mkpath {
- my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH'));
- my $arg;
- my $paths;
- if ($old_style) {
- my ($verbose, $mode);
- ($paths, $verbose, $mode) = @_;
- $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY');
- $arg->{verbose} = $verbose;
- $arg->{mode} = defined $mode ? $mode : 0777;
- }
- else {
- $arg = pop @_;
- $arg->{mode} = delete $arg->{mask} if exists $arg->{mask};
- $arg->{mode} = 0777 unless exists $arg->{mode};
- ${$arg->{error}} = [] if exists $arg->{error};
- $arg->{owner} = delete $arg->{user} if exists $arg->{user};
- $arg->{owner} = delete $arg->{uid} if exists $arg->{uid};
- if (exists $arg->{owner} and $arg->{owner} =~ /\D/) {
- my $uid = (getpwnam $arg->{owner})[2];
- if (defined $uid) {
- $arg->{owner} = $uid;
- }
- else {
- _error($arg, "unable to map $arg->{owner} to a uid, ownership not changed");
- delete $arg->{owner};
- }
- }
- if (exists $arg->{group} and $arg->{group} =~ /\D/) {
- my $gid = (getgrnam $arg->{group})[2];
- if (defined $gid) {
- $arg->{group} = $gid;
- }
- else {
- _error($arg, "unable to map $arg->{group} to a gid, group ownership not changed");
- delete $arg->{group};
- }
- }
- if (exists $arg->{owner} and not exists $arg->{group}) {
- $arg->{group} = -1; # chown will leave group unchanged
- }
- if (exists $arg->{group} and not exists $arg->{owner}) {
- $arg->{owner} = -1; # chown will leave owner unchanged
- }
- $paths = [@_];
- }
- return _mkpath($arg, $paths);
- }
- sub _mkpath {
- my $arg = shift;
- my $paths = shift;
- my(@created,$path);
- foreach $path (@$paths) {
- next unless defined($path) and length($path);
- $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
- # Logic wants Unix paths, so go with the flow.
- if ($Is_VMS) {
- next if $path eq '/';
- $path = VMS::Filespec::unixify($path);
- }
- next if -d $path;
- my $parent = File::Basename::dirname($path);
- unless (-d $parent or $path eq $parent) {
- push(@created,_mkpath($arg, [$parent]));
- }
- print "mkdir $path\n" if $arg->{verbose};
- if (mkdir($path,$arg->{mode})) {
- push(@created, $path);
- if (exists $arg->{owner}) {
- # NB: $arg->{group} guaranteed to be set during initialisation
- if (!chown $arg->{owner}, $arg->{group}, $path) {
- _error($arg, "Cannot change ownership of $path to $arg->{owner}:$arg->{group}");
- }
- }
- }
- else {
- my $save_bang = $!;
- my ($e, $e1) = ($save_bang, $^E);
- $e .= "; $e1" if $e ne $e1;
- # allow for another process to have created it meanwhile
- if (!-d $path) {
- $! = $save_bang;
- if ($arg->{error}) {
- push @{${$arg->{error}}}, {$path => $e};
- }
- else {
- _croak("mkdir $path: $e");
- }
- }
- }
- }
- return @created;
- }
- sub remove_tree {
- push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH');
- goto &rmtree;
- }
- sub _is_subdir {
- my($dir, $test) = @_;
- my($dv, $dd) = File::Spec->splitpath($dir, 1);
- my($tv, $td) = File::Spec->splitpath($test, 1);
- # not on same volume
- return 0 if $dv ne $tv;
- my @d = File::Spec->splitdir($dd);
- my @t = File::Spec->splitdir($td);
- # @t can't be a subdir if it's shorter than @d
- return 0 if @t < @d;
- return join('/', @d) eq join('/', splice @t, 0, +@d);
- }
- sub rmtree {
- my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH'));
- my $arg;
- my $paths;
- if ($old_style) {
- my ($verbose, $safe);
- ($paths, $verbose, $safe) = @_;
- $arg->{verbose} = $verbose;
- $arg->{safe} = defined $safe ? $safe : 0;
- if (defined($paths) and length($paths)) {
- $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY');
- }
- else {
- _carp ("No root path(s) specified\n");
- return 0;
- }
- }
- else {
- $arg = pop @_;
- ${$arg->{error}} = [] if exists $arg->{error};
- ${$arg->{result}} = [] if exists $arg->{result};
- $paths = [@_];
- }
- $arg->{prefix} = '';
- $arg->{depth} = 0;
- my @clean_path;
- $arg->{cwd} = getcwd() or do {
- _error($arg, "cannot fetch initial working directory");
- return 0;
- };
- for ($arg->{cwd}) { /\A(.*)\Z/; $_ = $1 } # untaint
- for my $p (@$paths) {
- # need to fixup case and map \ to / on Windows
- my $ortho_root = $^O eq 'MSWin32' ? _slash_lc($p) : $p;
- my $ortho_cwd = $^O eq 'MSWin32' ? _slash_lc($arg->{cwd}) : $arg->{cwd};
- my $ortho_root_length = length($ortho_root);
- $ortho_root_length-- if $^O eq 'VMS'; # don't compare '.' with ']'
- if ($ortho_root_length && _is_subdir($ortho_root, $ortho_cwd)) {
- local $! = 0;
- _error($arg, "cannot remove path when cwd is $arg->{cwd}", $p);
- next;
- }
- if ($Is_MacOS) {
- $p = ":$p" unless $p =~ /:/;
- $p .= ":" unless $p =~ /:\z/;
- }
- elsif ($^O eq 'MSWin32') {
- $p =~ s{[/\\]\z}{};
- }
- else {
- $p =~ s{/\z}{};
- }
- push @clean_path, $p;
- }
- @{$arg}{qw(device inode perm)} = (lstat $arg->{cwd})[0,1] or do {
- _error($arg, "cannot stat initial working directory", $arg->{cwd});
- return 0;
- };
- return _rmtree($arg, \@clean_path);
- }
- sub _rmtree {
- my $arg = shift;
- my $paths = shift;
- my $count = 0;
- my $curdir = File::Spec->curdir();
- my $updir = File::Spec->updir();
- my (@files, $root);
- ROOT_DIR:
- foreach $root (@$paths) {
- # since we chdir into each directory, it may not be obvious
- # to figure out where we are if we generate a message about
- # a file name. We therefore construct a semi-canonical
- # filename, anchored from the directory being unlinked (as
- # opposed to being truly canonical, anchored from the root (/).
- my $canon = $arg->{prefix}
- ? File::Spec->catfile($arg->{prefix}, $root)
- : $root
- ;
- my ($ldev, $lino, $perm) = (lstat $root)[0,1,2] or next ROOT_DIR;
- if ( -d _ ) {
- $root = VMS::Filespec::vmspath(VMS::Filespec::pathify($root)) if $Is_VMS;
- if (!chdir($root)) {
- # see if we can escalate privileges to get in
- # (e.g. funny protection mask such as -w- instead of rwx)
- $perm &= 07777;
- my $nperm = $perm | 0700;
- if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $root))) {
- _error($arg, "cannot make child directory read-write-exec", $canon);
- next ROOT_DIR;
- }
- elsif (!chdir($root)) {
- _error($arg, "cannot chdir to child", $canon);
- next ROOT_DIR;
- }
- }
- my ($cur_dev, $cur_inode, $perm) = (stat $curdir)[0,1,2] or do {
- _error($arg, "cannot stat current working directory", $canon);
- next ROOT_DIR;
- };
- if ($Need_Stat_Check) {
- ($ldev eq $cur_dev and $lino eq $cur_inode)
- or _croak("directory $canon changed before chdir, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting.");
- }
- $perm &= 07777; # don't forget setuid, setgid, sticky bits
- my $nperm = $perm | 0700;
- # notabene: 0700 is for making readable in the first place,
- # it's also intended to change it to writable in case we have
- # to recurse in which case we are better than rm -rf for
- # subtrees with strange permissions
- if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $curdir))) {
- _error($arg, "cannot make directory read+writeable", $canon);
- $nperm = $perm;
- }
- my $d;
- $d = gensym() if $] < 5.006;
- if (!opendir $d, $curdir) {
- _error($arg, "cannot opendir", $canon);
- @files = ();
- }
- else {
- no strict 'refs';
- if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
- # Blindly untaint dir names if taint mode is
- # active, or any perl < 5.006
- @files = map { /\A(.*)\z/s; $1 } readdir $d;
- }
- else {
- @files = readdir $d;
- }
- closedir $d;
- }
- if ($Is_VMS) {
- # Deleting large numbers of files from VMS Files-11
- # filesystems is faster if done in reverse ASCIIbetical order.
- # include '.' to '.;' from blead patch #31775
- @files = map {$_ eq '.' ? '.;' : $_} reverse @files;
- }
- @files = grep {$_ ne $updir and $_ ne $curdir} @files;
- if (@files) {
- # remove the contained files before the directory itself
- my $narg = {%$arg};
- @{$narg}{qw(device inode cwd prefix depth)}
- = ($cur_dev, $cur_inode, $updir, $canon, $arg->{depth}+1);
- $count += _rmtree($narg, \@files);
- }
- # restore directory permissions of required now (in case the rmdir
- # below fails), while we are still in the directory and may do so
- # without a race via '.'
- if ($nperm != $perm and not chmod($perm, $curdir)) {
- _error($arg, "cannot reset chmod", $canon);
- }
- # don't leave the client code in an unexpected directory
- chdir($arg->{cwd})
- or _croak("cannot chdir to $arg->{cwd} from $canon: $!, aborting.");
- # ensure that a chdir upwards didn't take us somewhere other
- # than we expected (see CVE-2002-0435)
- ($cur_dev, $cur_inode) = (stat $curdir)[0,1]
- or _croak("cannot stat prior working directory $arg->{cwd}: $!, aborting.");
- if ($Need_Stat_Check) {
- ($arg->{device} eq $cur_dev and $arg->{inode} eq $cur_inode)
- or _croak("previous directory $arg->{cwd} changed before entering $canon, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting.");
- }
- if ($arg->{depth} or !$arg->{keep_root}) {
- if ($arg->{safe} &&
- ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
- print "skipped $root\n" if $arg->{verbose};
- next ROOT_DIR;
- }
- if ($Force_Writeable and !chmod $perm | 0700, $root) {
- _error($arg, "cannot make directory writeable", $canon);
- }
- print "rmdir $root\n" if $arg->{verbose};
- if (rmdir $root) {
- push @{${$arg->{result}}}, $root if $arg->{result};
- ++$count;
- }
- else {
- _error($arg, "cannot remove directory", $canon);
- if ($Force_Writeable && !chmod($perm, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
- ) {
- _error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon);
- }
- }
- }
- }
- else {
- # not a directory
- $root = VMS::Filespec::vmsify("./$root")
- if $Is_VMS
- && !File::Spec->file_name_is_absolute($root)
- && ($root !~ m/(?<!\^)[\]>]+/); # not already in VMS syntax
- if ($arg->{safe} &&
- ($Is_VMS ? !&VMS::Filespec::candelete($root)
- : !(-l $root || -w $root)))
- {
- print "skipped $root\n" if $arg->{verbose};
- next ROOT_DIR;
- }
- my $nperm = $perm & 07777 | 0600;
- if ($Force_Writeable and $nperm != $perm and not chmod $nperm, $root) {
- _error($arg, "cannot make file writeable", $canon);
- }
- print "unlink $canon\n" if $arg->{verbose};
- # delete all versions under VMS
- for (;;) {
- if (unlink $root) {
- push @{${$arg->{result}}}, $root if $arg->{result};
- }
- else {
- _error($arg, "cannot unlink file", $canon);
- $Force_Writeable and chmod($perm, $root) or
- _error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon);
- last;
- }
- ++$count;
- last unless $Is_VMS && lstat $root;
- }
- }
- }
- return $count;
- }
- sub _slash_lc {
- # fix up slashes and case on MSWin32 so that we can determine that
- # c:\path\to\dir is underneath C:/Path/To
- my $path = shift;
- $path =~ tr{\\}{/};
- return lc($path);
- }
- 1;
- __END__
- =head1 NAME
- File::Path - Create or remove directory trees
- =head1 VERSION
- This document describes version 2.09 of File::Path, released
- 2013-01-17.
- =head1 SYNOPSIS
- use File::Path qw(make_path remove_tree);
- make_path('foo/bar/baz', '/zug/zwang');
- make_path('foo/bar/baz', '/zug/zwang', {
- verbose => 1,
- mode => 0711,
- });
- remove_tree('foo/bar/baz', '/zug/zwang');
- remove_tree('foo/bar/baz', '/zug/zwang', {
- verbose => 1,
- error => \my $err_list,
- });
- # legacy (interface promoted before v2.00)
- mkpath('/foo/bar/baz');
- mkpath('/foo/bar/baz', 1, 0711);
- mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
- rmtree('foo/bar/baz', 1, 1);
- rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
- # legacy (interface promoted before v2.06)
- mkpath('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 });
- rmtree('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 });
- =head1 DESCRIPTION
- This module provide a convenient way to create directories of
- arbitrary depth and to delete an entire directory subtree from the
- filesystem.
- The following functions are provided:
- =over
- =item make_path( $dir1, $dir2, .... )
- =item make_path( $dir1, $dir2, ...., \%opts )
- The C<make_path> function creates the given directories if they don't
- exists before, much like the Unix command C<mkdir -p>.
- The function accepts a list of directories to be created. Its
- behaviour may be tuned by an optional hashref appearing as the last
- parameter on the call.
- The function returns the list of directories actually created during
- the call; in scalar context the number of directories created.
- The following keys are recognised in the option hash:
- =over
- =item mode => $num
- The numeric permissions mode to apply to each created directory
- (defaults to 0777), to be modified by the current C<umask>. If the
- directory already exists (and thus does not need to be created),
- the permissions will not be modified.
- C<mask> is recognised as an alias for this parameter.
- =item verbose => $bool
- If present, will cause C<make_path> to print the name of each directory
- as it is created. By default nothing is printed.
- =item error => \$err
- If present, it should be a reference to a scalar.
- This scalar will be made to reference an array, which will
- be used to store any errors that are encountered. See the L</"ERROR
- HANDLING"> section for more information.
- If this parameter is not used, certain error conditions may raise
- a fatal error that will cause the program will halt, unless trapped
- in an C<eval> block.
- =item owner => $owner
- =item user => $owner
- =item uid => $owner
- If present, will cause any created directory to be owned by C<$owner>.
- If the value is numeric, it will be interpreted as a uid, otherwise
- as username is assumed. An error will be issued if the username cannot be
- mapped to a uid, or the uid does not exist, or the process lacks the
- privileges to change ownership.
- Ownwership of directories that already exist will not be changed.
- C<user> and C<uid> are aliases of C<owner>.
- =item group => $group
- If present, will cause any created directory to be owned by the group C<$group>.
- If the value is numeric, it will be interpreted as a gid, otherwise
- as group name is assumed. An error will be issued if the group name cannot be
- mapped to a gid, or the gid does not exist, or the process lacks the
- privileges to change group ownership.
- Group ownwership of directories that already exist will not be changed.
- make_path '/var/tmp/webcache', {owner=>'nobody', group=>'nogroup'};
- =back
- =item mkpath( $dir )
- =item mkpath( $dir, $verbose, $mode )
- =item mkpath( [$dir1, $dir2,...], $verbose, $mode )
- =item mkpath( $dir1, $dir2,..., \%opt )
- The mkpath() function provide the legacy interface of make_path() with
- a different interpretation of the arguments passed. The behaviour and
- return value of the function is otherwise identical to make_path().
- =item remove_tree( $dir1, $dir2, .... )
- =item remove_tree( $dir1, $dir2, ...., \%opts )
- The C<remove_tree> function deletes the given directories and any
- files and subdirectories they might contain, much like the Unix
- command C<rm -r> or C<del /s> on Windows.
- The function accepts a list of directories to be
- removed. Its behaviour may be tuned by an optional hashref
- appearing as the last parameter on the call.
- The functions returns the number of files successfully deleted.
- The following keys are recognised in the option hash:
- =over
- =item verbose => $bool
- If present, will cause C<remove_tree> to print the name of each file as
- it is unlinked. By default nothing is printed.
- =item safe => $bool
- When set to a true value, will cause C<remove_tree> to skip the files
- for which the process lacks the required privileges needed to delete
- files, such as delete privileges on VMS. In other words, the code
- will make no attempt to alter file permissions. Thus, if the process
- is interrupted, no filesystem object will be left in a more
- permissive mode.
- =item keep_root => $bool
- When set to a true value, will cause all files and subdirectories
- to be removed, except the initially specified directories. This comes
- in handy when cleaning out an application's scratch directory.
- remove_tree( '/tmp', {keep_root => 1} );
- =item result => \$res
- If present, it should be a reference to a scalar.
- This scalar will be made to reference an array, which will
- be used to store all files and directories unlinked
- during the call. If nothing is unlinked, the array will be empty.
- remove_tree( '/tmp', {result => \my $list} );
- print "unlinked $_\n" for @$list;
- This is a useful alternative to the C<verbose> key.
- =item error => \$err
- If present, it should be a reference to a scalar.
- This scalar will be made to reference an array, which will
- be used to store any errors that are encountered. See the L</"ERROR
- HANDLING"> section for more information.
- Removing things is a much more dangerous proposition than
- creating things. As such, there are certain conditions that
- C<remove_tree> may encounter that are so dangerous that the only
- sane action left is to kill the program.
- Use C<error> to trap all that is reasonable (problems with
- permissions and the like), and let it die if things get out
- of hand. This is the safest course of action.
- =back
- =item rmtree( $dir )
- =item rmtree( $dir, $verbose, $safe )
- =item rmtree( [$dir1, $dir2,...], $verbose, $safe )
- =item rmtree( $dir1, $dir2,..., \%opt )
- The rmtree() function provide the legacy interface of remove_tree()
- with a different interpretation of the arguments passed. The behaviour
- and return value of the function is otherwise identical to
- remove_tree().
- =back
- =head2 ERROR HANDLING
- =over 4
- =item B<NOTE:>
- The following error handling mechanism is considered
- experimental and is subject to change pending feedback from
- users.
- =back
- If C<make_path> or C<remove_tree> encounter an error, a diagnostic
- message will be printed to C<STDERR> via C<carp> (for non-fatal
- errors), or via C<croak> (for fatal errors).
- If this behaviour is not desirable, the C<error> attribute may be
- used to hold a reference to a variable, which will be used to store
- the diagnostics. The variable is made a reference to an array of hash
- references. Each hash contain a single key/value pair where the key
- is the name of the file, and the value is the error message (including
- the contents of C<$!> when appropriate). If a general error is
- encountered the diagnostic key will be empty.
- An example usage looks like:
- remove_tree( 'foo/bar', 'bar/rat', {error => \my $err} );
- if (@$err) {
- for my $diag (@$err) {
- my ($file, $message) = %$diag;
- if ($file eq '') {
- print "general error: $message\n";
- }
- else {
- print "problem unlinking $file: $message\n";
- }
- }
- }
- else {
- print "No error encountered\n";
- }
- Note that if no errors are encountered, C<$err> will reference an
- empty array. This means that C<$err> will always end up TRUE; so you
- need to test C<@$err> to determine if errors occured.
- =head2 NOTES
- C<File::Path> blindly exports C<mkpath> and C<rmtree> into the
- current namespace. These days, this is considered bad style, but
- to change it now would break too much code. Nonetheless, you are
- invited to specify what it is you are expecting to use:
- use File::Path 'rmtree';
- The routines C<make_path> and C<remove_tree> are B<not> exported
- by default. You must specify which ones you want to use.
- use File::Path 'remove_tree';
- Note that a side-effect of the above is that C<mkpath> and C<rmtree>
- are no longer exported at all. This is due to the way the C<Exporter>
- module works. If you are migrating a codebase to use the new
- interface, you will have to list everything explicitly. But that's
- just good practice anyway.
- use File::Path qw(remove_tree rmtree);
- =head3 API CHANGES
- The API was changed in the 2.0 branch. For a time, C<mkpath> and
- C<rmtree> tried, unsuccessfully, to deal with the two different
- calling mechanisms. This approach was considered a failure.
- The new semantics are now only available with C<make_path> and
- C<remove_tree>. The old semantics are only available through
- C<mkpath> and C<rmtree>. Users are strongly encouraged to upgrade
- to at least 2.08 in order to avoid surprises.
- =head3 SECURITY CONSIDERATIONS
- There were race conditions 1.x implementations of File::Path's
- C<rmtree> function (although sometimes patched depending on the OS
- distribution or platform). The 2.0 version contains code to avoid the
- problem mentioned in CVE-2002-0435.
- See the following pages for more information:
- http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=286905
- http://www.nntp.perl.org/group/perl.perl5.porters/2005/01/msg97623.html
- http://www.debian.org/security/2005/dsa-696
- Additionally, unless the C<safe> parameter is set (or the
- third parameter in the traditional interface is TRUE), should a
- C<remove_tree> be interrupted, files that were originally in read-only
- mode may now have their permissions set to a read-write (or "delete
- OK") mode.
- =head1 DIAGNOSTICS
- FATAL errors will cause the program to halt (C<croak>), since the
- problem is so severe that it would be dangerous to continue. (This
- can always be trapped with C<eval>, but it's not a good idea. Under
- the circumstances, dying is the best thing to do).
- SEVERE errors may be trapped using the modern interface. If the
- they are not trapped, or the old interface is used, such an error
- will cause the program will halt.
- All other errors may be trapped using the modern interface, otherwise
- they will be C<carp>ed about. Program execution will not be halted.
- =over 4
- =item mkdir [path]: [errmsg] (SEVERE)
- C<make_path> was unable to create the path. Probably some sort of
- permissions error at the point of departure, or insufficient resources
- (such as free inodes on Unix).
- =item No root path(s) specified
- C<make_path> was not given any paths to create. This message is only
- emitted if the routine is called with the traditional interface.
- The modern interface will remain silent if given nothing to do.
- =item No such file or directory
- On Windows, if C<make_path> gives you this warning, it may mean that
- you have exceeded your filesystem's maximum path length.
- =item cannot fetch initial working directory: [errmsg]
- C<remove_tree> attempted to determine the initial directory by calling
- C<Cwd::getcwd>, but the call failed for some reason. No attempt
- will be made to delete anything.
- =item cannot stat initial working directory: [errmsg]
- C<remove_tree> attempted to stat the initial directory (after having
- successfully obtained its name via C<getcwd>), however, the call
- failed for some reason. No attempt will be made to delete anything.
- =item cannot chdir to [dir]: [errmsg]
- C<remove_tree> attempted to set the working directory in order to
- begin deleting the objects therein, but was unsuccessful. This is
- usually a permissions issue. The routine will continue to delete
- other things, but this directory will be left intact.
- =item directory [dir] changed before chdir, expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL)
- C<remove_tree> recorded the device and inode of a directory, and then
- moved into it. It then performed a C<stat> on the current directory
- and detected that the device and inode were no longer the same. As
- this is at the heart of the race condition problem, the program
- will die at this point.
- =item cannot make directory [dir] read+writeable: [errmsg]
- C<remove_tree> attempted to change the permissions on the current directory
- to ensure that subsequent unlinkings would not run into problems,
- but was unable to do so. The permissions remain as they were, and
- the program will carry on, doing the best it can.
- =item cannot read [dir]: [errmsg]
- C<remove_tree> tried to read the contents of the directory in order
- to acquire the names of the directory entries to be unlinked, but
- was unsuccessful. This is usually a permissions issue. The
- program will continue, but the files in this directory will remain
- after the call.
- =item cannot reset chmod [dir]: [errmsg]
- C<remove_tree>, after having deleted everything in a directory, attempted
- to restore its permissions to the original state but failed. The
- directory may wind up being left behind.
- =item cannot remove [dir] when cwd is [dir]
- The current working directory of the program is F</some/path/to/here>
- and you are attempting to remove an ancestor, such as F</some/path>.
- The directory tree is left untouched.
- The solution is to C<chdir> out of the child directory to a place
- outside the directory tree to be removed.
- =item cannot chdir to [parent-dir] from [child-dir]: [errmsg], aborting. (FATAL)
- C<remove_tree>, after having deleted everything and restored the permissions
- of a directory, was unable to chdir back to the parent. The program
- halts to avoid a race condition from occurring.
- =item cannot stat prior working directory [dir]: [errmsg], aborting. (FATAL)
- C<remove_tree> was unable to stat the parent directory after have returned
- from the child. Since there is no way of knowing if we returned to
- where we think we should be (by comparing device and inode) the only
- way out is to C<croak>.
- =item previous directory [parent-dir] changed before entering [child-dir], expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL)
- When C<remove_tree> returned from deleting files in a child directory, a
- check revealed that the parent directory it returned to wasn't the one
- it started out from. This is considered a sign of malicious activity.
- =item cannot make directory [dir] writeable: [errmsg]
- Just before removing a directory (after having successfully removed
- everything it contained), C<remove_tree> attempted to set the permissions
- on the directory to ensure it could be removed and failed. Program
- execution continues, but the directory may possibly not be deleted.
- =item cannot remove directory [dir]: [errmsg]
- C<remove_tree> attempted to remove a directory, but failed. This may because
- some objects that were unable to be removed remain in the directory, or
- a permissions issue. The directory will be left behind.
- =item cannot restore permissions of [dir] to [0nnn]: [errmsg]
- After having failed to remove a directory, C<remove_tree> was unable to
- restore its permissions from a permissive state back to a possibly
- more restrictive setting. (Permissions given in octal).
- =item cannot make file [file] writeable: [errmsg]
- C<remove_tree> attempted to force the permissions of a file to ensure it
- could be deleted, but failed to do so. It will, however, still attempt
- to unlink the file.
- =item cannot unlink file [file]: [errmsg]
- C<remove_tree> failed to remove a file. Probably a permissions issue.
- =item cannot restore permissions of [file] to [0nnn]: [errmsg]
- After having failed to remove a file, C<remove_tree> was also unable
- to restore the permissions on the file to a possibly less permissive
- setting. (Permissions given in octal).
- =item unable to map [owner] to a uid, ownership not changed");
- C<make_path> was instructed to give the ownership of created
- directories to the symbolic name [owner], but C<getpwnam> did
- not return the corresponding numeric uid. The directory will
- be created, but ownership will not be changed.
- =item unable to map [group] to a gid, group ownership not changed
- C<make_path> was instructed to give the group ownership of created
- directories to the symbolic name [group], but C<getgrnam> did
- not return the corresponding numeric gid. The directory will
- be created, but group ownership will not be changed.
- =back
- =head1 SEE ALSO
- =over 4
- =item *
- L<File::Remove>
- Allows files and directories to be moved to the Trashcan/Recycle
- Bin (where they may later be restored if necessary) if the operating
- system supports such functionality. This feature may one day be
- made available directly in C<File::Path>.
- =item *
- L<File::Find::Rule>
- When removing directory trees, if you want to examine each file to
- decide whether to delete it (and possibly leaving large swathes
- alone), F<File::Find::Rule> offers a convenient and flexible approach
- to examining directory trees.
- =back
- =head1 BUGS
- Please report all bugs on the RT queue:
- L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Path>
- You can also send pull requests to the Github repository:
- L<https://github.com/dland/File-Path>
- =head1 ACKNOWLEDGEMENTS
- Paul Szabo identified the race condition originally, and Brendan
- O'Dea wrote an implementation for Debian that addressed the problem.
- That code was used as a basis for the current code. Their efforts
- are greatly appreciated.
- Gisle Aas made a number of improvements to the documentation for
- 2.07 and his advice and assistance is also greatly appreciated.
- =head1 AUTHORS
- Tim Bunce and Charles Bailey. Currently maintained by David Landgren
- <F<david@landgren.net>>.
- =head1 COPYRIGHT
- This module is copyright (C) Charles Bailey, Tim Bunce and
- David Landgren 1995-2013. All rights reserved.
- =head1 LICENSE
- This library is free software; you can redistribute it and/or modify
- it under the same terms as Perl itself.
- =cut
|