ensure File::Spec::canonpath() preserves taint

Previously the unix specific XS implementation of canonpath() would
return an untainted path when supplied a tainted path.

For the empty string case, newSVpvs() already sets taint as needed on
its result.

This issue was assigned CVE-2015-8607.  [perl #126862]

diff --git a/dist/PathTools/Cwd.xs b/dist/PathTools/Cwd.xs
index 9d4dcf0..3d018dc 100644 (file)
--- a/dist/PathTools/Cwd.xs
+++ b/dist/PathTools/Cwd.xs
@@ -535,6 +535,7 @@ THX_unix_canonpath(pTHX_ SV *path)
     *o = 0;
     SvPOK_on(retval);
     SvCUR_set(retval, o - SvPVX(retval));
+    SvTAINT(retval);
     return retval;
 }
 

diff --git a/dist/PathTools/t/taint.t b/dist/PathTools/t/taint.t
index 309b3e5..48f8c5b 100644 (file)
--- a/dist/PathTools/t/taint.t
+++ b/dist/PathTools/t/taint.t
@@ -12,7 +12,7 @@ use Test::More;
 BEGIN {
     plan(
         ${^TAINT}
-        ? (tests => 17)
+        ? (tests => 21)
         : (skip_all => "A perl without taint support")
     );
 }
@@ -34,3 +34,20 @@ foreach my $func (@Functions) {
 
 # Previous versions of Cwd tainted $^O
 is !tainted($^O), 1, "\$^O should not be tainted";
+
+{
+    # [perl #126862] canonpath() loses taint
+    my $tainted = substr($ENV{PATH}, 0, 0);
+    # yes, getcwd()'s result should be tainted, and is tested above
+    # but be sure
+    ok tainted(File::Spec->canonpath($tainted . Cwd::getcwd)),
+        "canonpath() keeps taint on non-empty string";
+    ok tainted(File::Spec->canonpath($tainted)),
+        "canonpath() keeps taint on empty string";
+
+    (Cwd::getcwd() =~ /^(.*)/);
+    my $untainted = $1;
+    ok !tainted($untainted), "make sure our untainted value is untainted";
+    ok !tainted(File::Spec->canonpath($untainted)),
+        "canonpath() doesn't add taint to untainted string";
+}