|
From b6307f728a4f842a54ea96959e386c7daa92ece1 Mon Sep 17 00:00:00 2001
|
|
From: Tony Cook <tony@develop-help.com>
|
|
Date: Tue, 15 Dec 2015 10:56:54 +1100
|
|
Subject: [perl #126862] 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.
|
|
---
|
|
dist/PathTools/Cwd.xs | 1 +
|
|
dist/PathTools/t/taint.t | 19 ++++++++++++++++++-
|
|
2 files changed, 19 insertions(+), 1 deletion(-)
|
|
|
|
--- 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;
|
|
}
|
|
|
|
--- 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";
|
|
+}
|