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

2 files changed, 40 insertions, 6 deletions

diff --git a/sv.c b/sv.c
index 6feb4890af..9e6a3361ae 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 fc3a595c4e..1e3d3964c2 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;
+}
+