From: Andrew Pimlott <pimlott@idiomtech.com>
Date: Wed, 4 Oct 2000 23:17:44 +0000 (-0400)
Subject: Fix for
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=27c9684d3c5aa5a9dfb043ed1fc98a708d464c22;p=p5sagit%2Fp5-mst-13.2.git

Fix for

Subject: [ID 20001004.007] taint propogation is inconsistent
Message-Id: <m13h1XU-000SEmC@nolfolan.idiomtech.com>

The culprit was sv_setsv() which was rather blindly
propagating taint, which lead to behaviour where if
a tainted anon hash value was seen all the hash values
from then on at that level became tainted, or at any
upper levels in the case of nested anon hashes.

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

diff --git a/sv.c b/sv.c
index 6feb489..9e6a336 100644
--- a/sv.c
+++ b/sv.c
@@ -2570,7 +2570,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	    SvIVX(dstr) = SvIVX(sstr);
 	    if (SvIsUV(sstr))
 		SvIsUV_on(dstr);
-	    SvTAINT(dstr);
+	    if (SvTAINTED(sstr))
+		SvTAINT(dstr);
 	    return;
 	}
 	goto undef_sstr;
@@ -2590,7 +2591,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	    }
 	    SvNVX(dstr) = SvNVX(sstr);
 	    (void)SvNOK_only(dstr);
-	    SvTAINT(dstr);
+	    if (SvTAINTED(sstr))
+		SvTAINT(dstr);
 	    return;
 	}
 	goto undef_sstr;
@@ -2659,7 +2661,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	    GvINTRO_off(dstr);		/* one-shot flag */
 	    gp_free((GV*)dstr);
 	    GvGP(dstr) = gp_ref(GvGP(sstr));
-	    SvTAINT(dstr);
+	    if (SvTAINTED(sstr))
+		SvTAINT(dstr);
 	    if (GvIMPORTED(dstr) != GVf_IMPORTED
 		&& CopSTASH_ne(PL_curcop, GvSTASH(dstr)))
 	    {
@@ -2816,7 +2819,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 		    SvREFCNT_dec(dref);
 		if (intro)
 		    SAVEFREESV(sref);
-		SvTAINT(dstr);
+		if (SvTAINTED(sstr))
+		    SvTAINT(dstr);
 		return;
 	    }
 	    if (SvPVX(dstr)) {
@@ -2925,7 +2929,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 	else
 	    (void)SvOK_off(dstr);
     }
-    SvTAINT(dstr);
+    if (SvTAINTED(sstr))
+	SvTAINT(dstr);
 }
 
 /*
diff --git a/t/op/taint.t b/t/op/taint.t
index fc3a595..1e3d396 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -99,7 +99,7 @@ print PROG 'print "@ARGV\n"', "\n";
 close PROG;
 my $echo = "$Invoke_Perl $ECHO";
 
-print "1..152\n";
+print "1..155\n";
 
 # First, let's make sure that Perl is checking the dangerous
 # environment variables. Maybe they aren't set yet, so we'll
@@ -690,4 +690,33 @@ else {
     my $b = <IN>;
     print "not " unless tainted($a) && tainted($b) && !defined($b);
     print "ok 152\n";
+    close IN;
 }
+
+{
+    # bug id 20001004.007
+
+    open IN, "./TEST" or warn "$0: cannot read ./TEST: $!" ;
+    my $a = <IN>;
+
+    my $c = { a => 42,
+	      b => $a };
+    print "not " unless !tainted($c->{a}) && tainted($c->{b});
+    print "ok 153\n";
+
+    my $d = { a => $a,
+	      b => 42 };
+    print "not " unless tainted($d->{a}) && !tainted($d->{b});
+    print "ok 154\n";
+
+    my $e = { a => 42,
+	      b => { c => $a, d => 42 } };
+    print "not " unless !tainted($e->{a}) &&
+	                !tainted($e->{b}) &&
+	                 tainted($e->{b}->{c}) &&
+	                !tainted($e->{b}->{d});
+    print "ok 155\n";
+
+    close IN;
+}
+