The lib/Cwd.pm diet part of

[p5sagit/p5-mst-13.2.git] / lib / Cwd.pm

diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index d85d1ea..db13aab 100644 (file)
--- 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);
 }