Upgrade File::Path to 2.08 (and add taint.t test)

1 files changed, 91 insertions, 4 deletions

diff --git a/cpan/File-Path/lib/File/Path.pm b/cpan/File-Path/lib/File/Path.pm
index e31191f5ba..387cdb19cb 100644
--- a/cpan/File-Path/lib/File/Path.pm
+++ b/cpan/File-Path/lib/File/Path.pm
@@ -17,7 +17,7 @@ BEGIN {
 
 use Exporter ();
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION   = '2.07_03';
+$VERSION   = '2.08';
 @ISA       = qw(Exporter);
 @EXPORT    = qw(mkpath rmtree);
 @EXPORT_OK = qw(make_path remove_tree);
@@ -81,6 +81,34 @@ sub mkpath {
         $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);
@@ -107,6 +135,12 @@ sub _mkpath {
         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 = $!;
@@ -422,8 +456,8 @@ File::Path - Create or remove directory trees
 
 =head1 VERSION
 
-This document describes version 2.07 of File::Path, released
-2008-11-09.
+This document describes version 2.08 of File::Path, released
+2009-10-04.
 
 =head1 SYNOPSIS
 
@@ -505,6 +539,34 @@ 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 )
@@ -672,6 +734,17 @@ 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
@@ -835,6 +908,20 @@ 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
@@ -885,7 +972,7 @@ Tim Bunce and Charles Bailey. Currently maintained by David Landgren
 =head1 COPYRIGHT
 
 This module is copyright (C) Charles Bailey, Tim Bunce and
-David Landgren 1995-2008. All rights reserved.
+David Landgren 1995-2009. All rights reserved.
 
 =head1 LICENSE