mg.c, Cwd.pm - Empty path is the same as "." which is forbidden under…

… taint Having a relative path, including ".", is forbidden under taint. On *nix an empty PATH or an empty PATH component is equivalent to a PATH of ".", so they should be forbidden as well. Note that on Windows the current working directory is ALWAYS checked first if you try to execute something that does not specify its path, regardless of the PATH. I do not know what happens on VMS and I do not have access to a VMS environment to test. There are totally different codepaths for VMS as well. This patch does not (or rather should not) change behavior for VMS. Note this includes a version bump for all modules in dist/PathTools
Perl · Apr 20, 2022 · 5ede445 · 5ede445
1 parent 33349b5
commit 5ede445
Show file tree

Hide file tree

Showing 15 changed files with 54 additions and 16 deletions.
diff --git a/dist/PathTools/Changes b/dist/PathTools/Changes
@@ -1,5 +1,9 @@
 Revision history for Perl distribution PathTools.
 
+3.85
+
+- Fix issue related to tainting empty PATH
+
 3.84
 
 - Add PerlIO_readlink backcompat defines to Cws.xs

diff --git a/dist/PathTools/Cwd.pm b/dist/PathTools/Cwd.pm
@@ -3,7 +3,7 @@ use strict;
 use Exporter;
 
 
-our $VERSION = '3.84';
+our $VERSION = '3.85';
 my $xs_version = $VERSION;
 $VERSION =~ tr/_//d;
 
@@ -192,8 +192,14 @@ sub _backtick_pwd {
     # Localize %ENV entries in a way that won't create new hash keys.
     # Under AmigaOS we don't want to localize as it stops perl from
     # finding 'sh' in the PATH.
-    my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV) if $^O ne "amigaos";
+    my @localize = grep exists $ENV{$_}, qw(IFS CDPATH ENV BASH_ENV) if $^O ne "amigaos";
     local @ENV{@localize} if @localize;
+    # empty PATH is the same as "." on *nix, so localize it to /something/
+    # we won't *use* the path as code above turns $pwd_cmd into a specific
+    # executable, but it will blow up anyway under taint. We could set it to
+    # anything absolute. Perhaps "/" would be better.
+    local $ENV{PATH}= "/usr/bin"
+        if $^O ne "vms" and $^O ne "amigaos";
 
     my $cwd = `$pwd_cmd`;
     # Belt-and-suspenders in case someone said "undef $/".

diff --git a/dist/PathTools/lib/File/Spec.pm b/dist/PathTools/lib/File/Spec.pm
@@ -2,7 +2,7 @@ package File::Spec;
 
 use strict;
 
-our $VERSION = '3.84';
+our $VERSION = '3.85';
 $VERSION =~ tr/_//d;
 
 my %module = (

diff --git a/dist/PathTools/lib/File/Spec/AmigaOS.pm b/dist/PathTools/lib/File/Spec/AmigaOS.pm
@@ -3,7 +3,7 @@ package File::Spec::AmigaOS;
 use strict;
 require File::Spec::Unix;
 
-our $VERSION = '3.84';
+our $VERSION = '3.85';
 $VERSION =~ tr/_//d;
 
 our @ISA = qw(File::Spec::Unix);

diff --git a/dist/PathTools/lib/File/Spec/Cygwin.pm b/dist/PathTools/lib/File/Spec/Cygwin.pm
@@ -3,7 +3,7 @@ package File::Spec::Cygwin;
 use strict;
 require File::Spec::Unix;
 
-our $VERSION = '3.84';
+our $VERSION = '3.85';
 $VERSION =~ tr/_//d;
 
 our @ISA = qw(File::Spec::Unix);

diff --git a/dist/PathTools/lib/File/Spec/Epoc.pm b/dist/PathTools/lib/File/Spec/Epoc.pm
@@ -2,7 +2,7 @@ package File::Spec::Epoc;
 
 use strict;
 
-our $VERSION = '3.84';
+our $VERSION = '3.85';
 $VERSION =~ tr/_//d;
 
 require File::Spec::Unix;

diff --git a/dist/PathTools/lib/File/Spec/Functions.pm b/dist/PathTools/lib/File/Spec/Functions.pm
@@ -3,7 +3,7 @@ package File::Spec::Functions;
 use File::Spec;
 use strict;
 
-our $VERSION = '3.84';
+our $VERSION = '3.85';
 $VERSION =~ tr/_//d;
 
 require Exporter;

diff --git a/dist/PathTools/lib/File/Spec/Mac.pm b/dist/PathTools/lib/File/Spec/Mac.pm
@@ -4,7 +4,7 @@ use strict;
 use Cwd ();
 require File::Spec::Unix;
 
-our $VERSION = '3.84';
+our $VERSION = '3.85';
 $VERSION =~ tr/_//d;
 
 our @ISA = qw(File::Spec::Unix);

diff --git a/dist/PathTools/lib/File/Spec/OS2.pm b/dist/PathTools/lib/File/Spec/OS2.pm
@@ -4,7 +4,7 @@ use strict;
 use Cwd ();
 require File::Spec::Unix;
 
-our $VERSION = '3.84';
+our $VERSION = '3.85';
 $VERSION =~ tr/_//d;
 
 our @ISA = qw(File::Spec::Unix);

diff --git a/dist/PathTools/lib/File/Spec/Unix.pm b/dist/PathTools/lib/File/Spec/Unix.pm
@@ -3,7 +3,7 @@ package File::Spec::Unix;
 use strict;
 use Cwd ();
 
-our $VERSION = '3.84';
+our $VERSION = '3.85';
 $VERSION =~ tr/_//d;
 
 =head1 NAME

diff --git a/dist/PathTools/lib/File/Spec/VMS.pm b/dist/PathTools/lib/File/Spec/VMS.pm
@@ -4,7 +4,7 @@ use strict;
 use Cwd ();
 require File::Spec::Unix;
 
-our $VERSION = '3.84';
+our $VERSION = '3.85';
 $VERSION =~ tr/_//d;
 
 our @ISA = qw(File::Spec::Unix);

diff --git a/dist/PathTools/lib/File/Spec/Win32.pm b/dist/PathTools/lib/File/Spec/Win32.pm
@@ -5,7 +5,7 @@ use strict;
 use Cwd ();
 require File::Spec::Unix;
 
-our $VERSION = '3.84';
+our $VERSION = '3.85';
 $VERSION =~ tr/_//d;
 
 our @ISA = qw(File::Spec::Unix);

diff --git a/mg.c b/mg.c
@@ -1356,6 +1356,15 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
             const char path_sep = ':';
 #endif
 
+#ifndef __VMS
+            /* Does this apply for VMS?
+             * Empty PATH on linux is treated same as ".", which is forbidden
+             * under taint. So check if the PATH variable is empty. */
+            if (!len) {
+                MgTAINTEDDIR_on(mg);
+                return 0;
+            }
+#endif
             /* set MGf_TAINTEDDIR if any component of the new path is
              * relative or world-writeable */
             while (s < strend) {
@@ -1372,7 +1381,8 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
                       /* Using Unix separator, e.g. under bash, so act line Unix */
                       || (PL_perllib_sep == ':' && *tmpbuf != '/')
 #else
-                      || *tmpbuf != '/'       /* no starting slash -- assume relative path */
+                      || *tmpbuf != '/' /* no starting slash -- assume relative path */
+                      || s == strend    /* trailing empty component -- same as "." */
 #endif
                       || (PerlLIO_stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) {
                     MgTAINTEDDIR_on(mg);

diff --git a/t/op/taint.t b/t/op/taint.t
@@ -18,7 +18,7 @@ use strict;
 use warnings;
 use Config;
 
-plan tests => 1054;
+plan tests => 1061;
 
 $| = 1;
 
@@ -138,14 +138,17 @@ my $TEST = 'TEST';
 {
     $ENV{'DCL$PATH'} = '' if $Is_VMS;
 
-    $ENV{PATH} = ($Is_Cygwin) ? '/usr/bin' : '';
+    # Empty path is the same as "." on *nix, so we have to set it
+    # to something or we will fail taint tests. perhaps setting it
+    # to "/" would be better. Anything absolute will do.
+    $ENV{PATH} = '/usr/bin';
     delete @ENV{@MoreEnv};
     $ENV{TERM} = 'dumb';
 
     is(eval { `$echo 1` }, "1\n");
 
     SKIP: {
-        skip "Environment tainting tests skipped", 4
+        skip "Environment tainting tests skipped", 11
           if $Is_MSWin32 || $Is_VMS;
 
 	my @vars = ('PATH', @MoreEnv);
@@ -157,6 +160,16 @@ my $TEST = 'TEST';
 	}
 	is("@vars", "");
 
+        # make sure that the empty path or empty path components
+        # trigger an "Insecure directory in $ENV{PATH}" error.
+        for my $path ("", ".", "/:", ":/", "/::/", ".:/", "/:.") {
+            local $ENV{PATH} = $path;
+            eval {`$echo 1`};
+            ok($@ =~ /Insecure directory in \$ENV\{PATH\}/,
+                "path '$path' is insecure as expected")
+                or diag "$@";
+        }
+
 	# tainted $TERM is unsafe only if it contains metachars
 	local $ENV{TERM};
 	$ENV{TERM} = 'e=mc2';

diff --git a/t/test.pl b/t/test.pl
@@ -776,6 +776,11 @@ sub untaint_path {
             $path = $path . $sep;
         }
         $path = $path . '/bin';
+    } elsif (!$is_vms and !length $path) {
+        # empty PATH is the same as a path of "." on *nix so to prevent
+        # tests from dieing under taint we need to return something
+        # absolute. Perhaps "/" would be better? Anything absolute will do.
+        $path = "/usr/bin";
     }
 
     $path;