From: Hugo van der Sanden <hv@crypt.org>
Date: Sun, 4 Aug 2002 17:40:30 +0000 (+0100)
Subject: Re: [ID 20020704.001] my $foo = $1 won't taint $foo (with use re 'taint')
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a8c7c11a510ba1b065a5e57da04d34c2f89e233b;p=p5sagit%2Fp5-mst-13.2.git

Re: [ID 20020704.001] my $foo = $1 won't taint $foo (with use re 'taint')
Message-id: <200208041640.g74GeUU25061@crypt.compulink.co.uk>

p4raw-id: //depot/perl@17678
---

diff --git a/mg.c b/mg.c
index 63de612..a3ce4c5 100644
--- a/mg.c
+++ b/mg.c
@@ -693,18 +693,24 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 
 	      getrx:
 		if (i >= 0) {
-		    bool was_tainted = FALSE;
-		    if (PL_tainting) {
-			was_tainted = PL_tainted;
-			PL_tainted = FALSE;
-		    }
 		    sv_setpvn(sv, s, i);
-                   if (PL_reg_match_utf8 && is_utf8_string((U8*)s, i))
+		    if (PL_reg_match_utf8 && is_utf8_string((U8*)s, i))
 			SvUTF8_on(sv);
 		    else
 			SvUTF8_off(sv);
 		    if (PL_tainting)
-			PL_tainted = (was_tainted || RX_MATCH_TAINTED(rx));
+			PL_tainted = PL_tainted || !!RX_MATCH_TAINTED(rx);
+		    if (RX_MATCH_TAINTED(rx)) {
+			MAGIC* mg = SvMAGIC(sv);
+			MAGIC* mgt;
+			SvMAGIC(sv) = mg->mg_moremagic;
+			SvTAINT(sv);
+			if ((mgt = SvMAGIC(sv))) {
+			    mg->mg_moremagic = mgt;
+			    SvMAGIC(sv) = mg;
+			}
+		    } else
+			SvTAINTED_off(sv);
 		    break;
 		}
 	    }
diff --git a/t/op/taint.t b/t/op/taint.t
index 18b39dc..7e8d4c4 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -124,7 +124,7 @@ my $echo = "$Invoke_Perl $ECHO";
 
 my $TEST = catfile(curdir(), 'TEST');
 
-print "1..205\n";
+print "1..206\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -971,3 +971,10 @@ else
 
     # If you add tests here update also the above skip block for VMS.
 }
+
+{
+    # [ID 20020704.001] taint propagation failure
+    use re 'taint';
+    $TAINT =~ /(.*)/;
+    test 206, tainted(my $foo = $1);
+}