From 3ee63918b283f8dc009c331f172f83c394ed2bb6 Mon Sep 17 00:00:00 2001
From: "Michael G. Schwern" <schwern@pobox.com>
Date: Fri, 15 Aug 2003 11:43:45 -0700
Subject: [PATCH] Taint problems in Cwd::abs_path Message-ID:
 <20030816014345.GE4023@windhund.schwern.org>

p4raw-id: //depot/perl@20734
---
 ext/Cwd/t/taint.t | 27 ++++++++++++++-------------
 lib/Cwd.pm        | 27 ++++++++++++---------------
 2 files changed, 26 insertions(+), 28 deletions(-)

diff --git a/ext/Cwd/t/taint.t b/ext/Cwd/t/taint.t
index 3f6aa52..2cd7d19 100644
--- a/ext/Cwd/t/taint.t
+++ b/ext/Cwd/t/taint.t
@@ -3,22 +3,23 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    unshift @INC, '../lib';
 }
 
+use strict;
 use Cwd;
-use Test::More tests => 6;
+use Test::More tests => 16;
 use Scalar::Util qw/tainted/;
 
-my $cwd;
-eval { $cwd = getcwd; };
-is( $@, '',		'getcwd() does not explode under taint mode' );
-ok( tainted($cwd),	"its return value is tainted" );
+my @Functions = qw(getcwd cwd fastcwd fastgetcwd
+                   abs_path fast_abs_path
+                   realpath fast_realpath
+                  );
 
-eval { $cwd = cwd; };
-is( $@, '',		'cwd() does not explode under taint mode' );
-ok( tainted($cwd),	"its return value is tainted" );
-
-eval { $cwd = fastcwd; };
-is( $@, '',		'fastcwd() does not explode under taint mode' );
-ok( tainted($cwd),	"its return value is tainted" );
+foreach my $func (@Functions) {
+    no strict 'refs';
+    my $cwd;
+    eval { $cwd = &{'Cwd::'.$func} };
+    is( $@, '',		"$func() does not explode under taint mode" );
+    ok( tainted($cwd),	"its return value is tainted" );
+}
diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index baeb05c..2b5f85e 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -38,8 +38,6 @@ Returns the current working directory.
 
 Re-implements the getcwd(3) (or getwd(3)) functions in Perl.
 
-Taint-safe.
-
 =item cwd
 
     my $cwd = cwd();
@@ -48,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).
 
-Taint-safe.
-
 =item fastcwd
 
     my $cwd = fastcwd();
@@ -77,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
 
@@ -89,25 +86,18 @@ Uses the same algorithm as getcwd().  Symbolic links and relative-path
 components ("." and "..") are resolved to return the canonical
 pathname, just like realpath(3).
 
-Taint-safe.
-
 =item realpath
 
   my $abs_path = realpath($file);
 
 A synonym for abs_path().
 
-Taint-safe.
-
 =item fast_abs_path
 
   my $abs_path = fast_abs_path($file);
 
 A more dangerous, but potentially faster version of abs_path.
 
-This function is B<Not> taint-safe : you can't use it in programs
-that work under taint mode.
-
 =back
 
 =head2 $ENV{PWD}
@@ -150,7 +140,7 @@ use strict;
 
 use Carp;
 
-our $VERSION = '2.07';
+our $VERSION = '2.08';
 
 use base qw/ Exporter /;
 our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
@@ -177,7 +167,7 @@ if ($^O eq 'os2' && defined &sys_cwd && defined &sys_abspath) {
 
 eval {
     require XSLoader;
-    undef *Cwd::fastcwd; # avoid redefinition warning
+    no warnings 'redefine';
     XSLoader::load('Cwd');
 };
 
@@ -422,10 +412,17 @@ 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;
+    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  =~ /(.*)/;
+
     CORE::chdir($path) || croak "Cannot chdir to $path: $!";
     my $realpath = getcwd();
     -d $cwd && CORE::chdir($cwd) ||
-- 
2.7.4