X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCwd.pm;h=8b00543e1e9801a51f34472b36cad6f4c3dbfcea;hb=08411240a1e5278b0232e1455d984110b1c5343b;hp=88afca2232df6bc5cc3fc47e7487181ddc05d115;hpb=a0c9c202edde87fa4f6c175b545b8b4d311d45b9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 88afca2..8b00543 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -1,5 +1,5 @@ package Cwd; -require 5.6.0; +use 5.006; =head1 NAME @@ -38,6 +38,8 @@ Returns the current working directory. Re-implements the getcwd(3) (or getwd(3)) functions in Perl. +Taint-safe. + =item cwd my $cwd = cwd(); @@ -46,7 +48,7 @@ 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. +Taint-safe. =item fastcwd @@ -87,18 +89,25 @@ 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 = abs_path($file); + my $abs_path = fast_abs_path($file); A more dangerous, but potentially faster version of abs_path. +This function is B taint-safe : you can't use it in programs +that work under taint mode. + =back =head2 $ENV{PWD} @@ -168,6 +177,7 @@ if ($^O eq 'os2' && defined &sys_cwd && defined &sys_abspath) { eval { require XSLoader; + undef *Cwd::fastcwd; # avoid redefinition warning XSLoader::load('Cwd'); }; @@ -186,7 +196,10 @@ $pwd_cmd ||= 'pwd'; # The 'natural and safe form' for UNIX (pwd may be setuid root) sub _backtick_pwd { + local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; my $cwd = `$pwd_cmd`; + # Belt-and-suspenders in case someone said "undef $/". + local $/ = "\n"; # `pwd` may fail e.g. if the disk is full chomp($cwd) if defined $cwd; $cwd; @@ -197,7 +210,9 @@ sub _backtick_pwd { unless(defined &cwd) { # The pwd command is not available in some chroot(2)'ed environments - if($^O eq 'MacOS' || grep { -x "$_/pwd" } split(':', $ENV{PATH})) { + if( $^O eq 'MacOS' || (defined $ENV{PATH} && + grep { -x "$_/pwd" } split(':', $ENV{PATH})) ) + { *cwd = \&_backtick_pwd; } else { @@ -256,9 +271,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; @@ -401,9 +416,10 @@ sub fast_abs_path { my $cwd = getcwd(); require File::Spec; my $path = @_ ? shift : File::Spec->curdir; - CORE::chdir($path) || croak "Cannot chdir to $path:$!"; + CORE::chdir($path) || croak "Cannot chdir to $path: $!"; my $realpath = getcwd(); - CORE::chdir($cwd) || croak "Cannot chdir back to $cwd:$!"; + -d $cwd && CORE::chdir($cwd) || + croak "Cannot chdir back to $cwd: $!"; $realpath; } @@ -463,12 +479,18 @@ sub _dos_cwd { } sub _qnx_cwd { + local $ENV{PATH} = ''; + local $ENV{CDPATH} = ''; + local $ENV{ENV} = ''; $ENV{'PWD'} = `/usr/bin/fullpath -t`; chop $ENV{'PWD'}; return $ENV{'PWD'}; } sub _qnx_abs_path { + local $ENV{PATH} = ''; + local $ENV{CDPATH} = ''; + local $ENV{ENV} = ''; my $path = @_ ? shift : '.'; my $realpath=`/usr/bin/fullpath -t $path`; chop $realpath; @@ -498,6 +520,7 @@ sub _epoc_cwd { *fastcwd = \&_NT_cwd; *fastgetcwd = \&_NT_cwd; *abs_path = \&fast_abs_path; + *realpath = \&fast_abs_path; } elsif ($^O eq 'os2') { # sys_cwd may keep the builtin command