X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCwd.pm;h=db13aab433c3514a44a135adc6367115191024d9;hb=e2ba406b0afaa3ee7f9fb58da681d29a6772e2ed;hp=d85d1ea7dcdda910632f770526e29c0d5f90e581;hpb=926cbafe59ef28067493b902ada7a0be81a77e57;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index d85d1ea..db13aab 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -46,8 +46,6 @@ The cwd() is the most natural form for the current architecture. For
 most systems it is identical to `pwd` (but without the trailing line
 terminator).
 
-Unfortunately, cwd() tends to break if called under taint mode.
-
 =item fastcwd
 
     my $cwd = fastcwd();
@@ -75,7 +73,8 @@ The fastgetcwd() function is provided as a synonym for cwd().
 =head2 abs_path and friends
 
 These functions are exported only on request.  They each take a single
-argument and return the absolute pathname for it.
+argument and return the absolute pathname for it.  If no argument is
+given they'll use the current working directory.
 
 =over 4
 
@@ -139,9 +138,7 @@ L<File::chdir>
 
 use strict;
 
-use Carp;
-
-our $VERSION = '2.06';
+our $VERSION = '2.08';
 
 use base qw/ Exporter /;
 our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -168,7 +165,7 @@ if ($^O eq 'os2' && defined &sys_cwd && defined &sys_abspath) {
 
 eval {
     require XSLoader;
-    undef *Cwd::fastcwd; # avoid redefinition warning
+    local $^W = 0;
     XSLoader::load('Cwd');
 };
 
@@ -183,7 +180,16 @@ foreach my $try (qw(/bin/pwd /usr/bin/pwd)) {
         last;
     }
 }
-$pwd_cmd ||= 'pwd';
+unless ($pwd_cmd) {
+    if (-x '/QOpenSys/bin/pwd') { # OS/400 PASE.
+        $pwd_cmd = '/QOpenSys/bin/pwd' ;
+    } else {
+        # Isn't this wrong?  _backtick_pwd() will fail if somenone has
+        # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
+        # See [perl #16774]. --jhi
+        $pwd_cmd = 'pwd';
+    }
+}
 
 # The 'natural and safe form' for UNIX (pwd may be setuid root)
 sub _backtick_pwd {
@@ -262,9 +268,9 @@ sub fastcwd {
     $path = '/' . join('/', @path);
     if ($^O eq 'apollo') { $path = "/".$path; }
     # At this point $path may be tainted (if tainting) and chdir would fail.
-    # To be more useful we untaint it then check that we landed where we started.
-    $path = $1 if $path =~ /^(.*)\z/s;	# untaint
-    CORE::chdir($path) || return undef;
+    # Untaint it then check that we landed where we started.
+    $path =~ /^(.*)\z/s		# untaint
+	&& CORE::chdir($1) or return undef;
     ($cdev, $cino) = stat('.');
     die "Unstable directory path, current directory changed unexpectedly"
 	if $cdev != $orig_cdev || $cino != $orig_cino;
@@ -352,7 +358,8 @@ sub _perl_abs_path
 
     unless (@cst = stat( $start ))
     {
-	carp "stat($start): $!";
+	require Carp;
+	Carp::carp ("stat($start): $!");
 	return '';
     }
     $cwd = '';
@@ -361,14 +368,17 @@ sub _perl_abs_path
     {
 	$dotdots .= '/..';
 	@pst = @cst;
+	local *PARENT;
 	unless (opendir(PARENT, $dotdots))
 	{
-	    carp "opendir($dotdots): $!";
+	    require Carp;
+	    Carp::carp ("opendir($dotdots): $!");
 	    return '';
 	}
 	unless (@cst = stat($dotdots))
 	{
-	    carp "stat($dotdots): $!";
+	    require Carp;
+	    Carp::carp ("stat($dotdots): $!");
 	    closedir(PARENT);
 	    return '';
 	}
@@ -382,7 +392,8 @@ sub _perl_abs_path
 	    {
 		unless (defined ($dir = readdir(PARENT)))
 	        {
-		    carp "readdir($dotdots): $!";
+		    require Carp;
+		    Carp::carp ("readdir($dotdots): $!");
 		    closedir(PARENT);
 		    return '';
 		}
@@ -403,20 +414,26 @@ sub _perl_abs_path
 # used to the libc function.  --tchrist 27-Jan-00
 *realpath = \&abs_path;
 
+my $Curdir;
 sub fast_abs_path {
     my $cwd = getcwd();
     require File::Spec;
-    my $path = @_ ? shift : File::Spec->curdir;
-    CORE::chdir($path) || croak "Cannot chdir to $path: $!";
+    my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
+
+    # Detaint else we'll explode in taint mode.  This is safe because
+    # we're not doing anything dangerous with it.
+    ($path) = $path =~ /(.*)/;
+    ($cwd)  = $cwd  =~ /(.*)/;
+
+    if (!CORE::chdir($path)) {
+ 	require Carp;
+ 	Carp::croak ("Cannot chdir to $path: $!");
+    }
     my $realpath = getcwd();
-    # I cannot think of an untainting regular expression 
-    # that wouldn't also (a) be unportable (b) disqualify valid pathnames
-    # so just untainting all of it here and relying on -d and CORE::chdir
-    # to verify the validity.
-    # --jhi
-    my ($cwd_untainted) = ($cwd =~ /^(.+)$/);
-    -d $cwd_untainted && CORE::chdir($cwd_untainted) ||
-	croak "Cannot chdir back to $cwd: $!";
+    if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
+ 	require Carp;
+ 	Carp::croak ("Cannot chdir back to $cwd: $!");
+    }
     $realpath;
 }
 
@@ -442,7 +459,11 @@ sub _vms_cwd {
 sub _vms_abs_path {
     return $ENV{'DEFAULT'} unless @_;
     my $path = VMS::Filespec::pathify($_[0]);
-    croak("Invalid path name $_[0]") unless defined $path;
+    if (! defined $path)
+	{
+	require Carp;
+	Carp::croak("Invalid path name $_[0]")
+	}
     return VMS::Filespec::rmsexpand($path);
 }