HCoop / jackhill / guix / guix.git / blame
| Commit | Line | Data |
|---|---|---|
| 203795ac MW |
1 | From 3a629609084d147838368262171b923f0770e564 Mon Sep 17 00:00:00 2001 |
| 2 | From: Tony Cook <tony@develop-help.com> | |
| 3 | Date: Tue, 15 Dec 2015 10:56:54 +1100 | |
| 4 | Subject: ensure File::Spec::canonpath() preserves taint | |
| 5 | ||
| 6 | Previously the unix specific XS implementation of canonpath() would | |
| 7 | return an untainted path when supplied a tainted path. | |
| 8 | ||
| 9 | For the empty string case, newSVpvs() already sets taint as needed on | |
| 10 | its result. | |
| 11 | ||
| 12 | This issue was assigned CVE-2015-8607. | |
| 13 | ||
| 14 | Bug: https://rt.perl.org/Ticket/Display.html?id=126862 | |
| 15 | Bug-Debian: https://bugs.debian.org/810719 | |
| 16 | Origin: upstream | |
| 17 | Patch-Name: fixes/CVE-2015-8607_file_spec_taint_fix.diff | |
| 18 | --- | |
| 19 | dist/PathTools/Cwd.xs | 1 + | |
| 20 | dist/PathTools/t/taint.t | 19 ++++++++++++++++++- | |
| 21 | 2 files changed, 19 insertions(+), 1 deletion(-) | |
| 22 | ||
| 23 | diff --git a/dist/PathTools/Cwd.xs b/dist/PathTools/Cwd.xs | |
| 24 | index 9d4dcf0..3d018dc 100644 | |
| 25 | --- a/dist/PathTools/Cwd.xs | |
| 26 | +++ b/dist/PathTools/Cwd.xs | |
| 27 | @@ -535,6 +535,7 @@ THX_unix_canonpath(pTHX_ SV *path) | |
| 28 | *o = 0; | |
| 29 | SvPOK_on(retval); | |
| 30 | SvCUR_set(retval, o - SvPVX(retval)); | |
| 31 | + SvTAINT(retval); | |
| 32 | return retval; | |
| 33 | } | |
| 34 | ||
| 35 | diff --git a/dist/PathTools/t/taint.t b/dist/PathTools/t/taint.t | |
| 36 | index 309b3e5..48f8c5b 100644 | |
| 37 | --- a/dist/PathTools/t/taint.t | |
| 38 | +++ b/dist/PathTools/t/taint.t | |
| 39 | @@ -12,7 +12,7 @@ use Test::More; | |
| 40 | BEGIN { | |
| 41 | plan( | |
| 42 | ${^TAINT} | |
| 43 | - ? (tests => 17) | |
| 44 | + ? (tests => 21) | |
| 45 | : (skip_all => "A perl without taint support") | |
| 46 | ); | |
| 47 | } | |
| 48 | @@ -34,3 +34,20 @@ foreach my $func (@Functions) { | |
| 49 | ||
| 50 | # Previous versions of Cwd tainted $^O | |
| 51 | is !tainted($^O), 1, "\$^O should not be tainted"; | |
| 52 | + | |
| 53 | +{ | |
| 54 | + # [perl #126862] canonpath() loses taint | |
| 55 | + my $tainted = substr($ENV{PATH}, 0, 0); | |
| 56 | + # yes, getcwd()'s result should be tainted, and is tested above | |
| 57 | + # but be sure | |
| 58 | + ok tainted(File::Spec->canonpath($tainted . Cwd::getcwd)), | |
| 59 | + "canonpath() keeps taint on non-empty string"; | |
| 60 | + ok tainted(File::Spec->canonpath($tainted)), | |
| 61 | + "canonpath() keeps taint on empty string"; | |
| 62 | + | |
| 63 | + (Cwd::getcwd() =~ /^(.*)/); | |
| 64 | + my $untainted = $1; | |
| 65 | + ok !tainted($untainted), "make sure our untainted value is untainted"; | |
| 66 | + ok !tainted(File::Spec->canonpath($untainted)), | |
| 67 | + "canonpath() doesn't add taint to untainted string"; | |
| 68 | +} |