[PATCH 2/2] CVE-2011-1487: lc/uc(first) fail to taint the returned string

Niko Tyni ntyni at debian.org
Fri Apr 15 19:03:06 UTC 2011


Based on the 5.12 patch ported by the Fedora project,
with test cases modified to actually fail without the fix.

 https://bugzilla.redhat.com/show_bug.cgi?id=692900
---
 pp.c         |    7 ++++++-
 t/op/taint.t |   15 ++++++++++++++-
 2 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/pp.c b/pp.c
index 1c8620c..40e512a 100644
--- a/pp.c
+++ b/pp.c
@@ -3616,6 +3616,8 @@ PP(pp_ucfirst)
 	    SvCUR_set(dest, need - 1);
 	}
     }
+    if (dest != source && SvTAINTED(source))
+        SvTAINT(dest);
     SvSETMAGIC(dest);
     RETURN;
 }
@@ -3666,7 +3668,8 @@ PP(pp_uc)
 	SvUPGRADE(dest, SVt_PV);
 	d = (U8*)SvGROW(dest, min);
 	(void)SvPOK_only(dest);
-
+	if (dest != source && SvTAINTED(source))
+	    SvTAINT(dest);
 	SETs(dest);
     }
 
@@ -3835,6 +3838,8 @@ PP(pp_lc)
 	    SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
 	}
     }
+    if (dest != source && SvTAINTED(source))
+        SvTAINT(dest);
     SvSETMAGIC(dest);
     RETURN;
 }
diff --git a/t/op/taint.t b/t/op/taint.t
index 6511fa5..80ac57b 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ use Config;
 use File::Spec::Functions;
 
 BEGIN { require './test.pl'; }
-plan tests => 302;
+plan tests => 306;
 
 $| = 1;
 
@@ -1327,6 +1327,19 @@ foreach my $ord (78, 163, 256) {
 }
 
 
+{
+    # [perl #87336] lc/uc(first) failing to taint the returned string
+    my $source = "foo$TAINT";
+    my $dest = lc $source;
+    test tainted $dest, "lc(tainted) taints its return value";
+    $dest = lcfirst $source;
+    test tainted $dest, "lcfirst(tainted) taints its return value";
+    $dest = uc $source;
+    test tainted $dest, "uc(tainted) taints its return value";
+    $dest = ucfirst $source;
+    test tainted $dest, "ucfirst(tainted) taints its return value";
+}
+
 # This may bomb out with the alarm signal so keep it last
 SKIP: {
     skip "No alarm()"  unless $Config{d_alarm};
-- 
1.7.4.1


--BXVAT5kNtrzKuDFl--






More information about the Perl-maintainers mailing list