[perl #6758] tainted values become untainted in tied hashes

2 files changed, 52 insertions, 2 deletions

diff --git a/mg.c b/mg.c
index 06c899e35e..137026d8d0 100644
--- a/mg.c
+++ b/mg.c
@@ -1701,12 +1701,33 @@ int
 Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR; dSP;
+    MAGIC *tmg;
+    SV    *val;
 
     PERL_ARGS_ASSERT_MAGIC_SETPACK;
 
+    /* in the code C<$tied{foo} = $val>, the "thing" that gets passed to
+     * STORE() is not $val, but rather a PVLV (the sv in this call), whose
+     * public flags indicate its value based on copying from $val. Doing
+     * mg_set() on the PVLV temporarily does SvMAGICAL_off(), then calls us.
+     * So STORE()'s $_[2] arg is a temporarily disarmed PVLV. This goes
+     * wrong if $val happened to be tainted, as sv hasn't got magic
+     * enabled, even though taint magic is in the chain. In which case,
+     * fake up a temporary tainted value (this is easier than temporarily
+     * re-enabling magic on sv). */
+
+    if (PL_tainting && (tmg = mg_find(sv, PERL_MAGIC_taint))
+	&& (tmg->mg_len & 1))
+    {
+	val = sv_mortalcopy(sv);
+	SvTAINTED_on(val);
+    }
+    else
+	val = sv;
+
     ENTER;
     PUSHSTACKi(PERLSI_MAGIC);
-    magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
+    magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, val);
     POPSTACK;
     LEAVE;
     return 0;
diff --git a/t/op/taint.t b/t/op/taint.t
index 161073deb6..c947044568 100644
--- 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 => 307;
 
 $| = 1;
 
@@ -1318,6 +1318,35 @@ foreach my $ord (78, 163, 256) {
     unlike($err, qr/^\d+$/, 'tainted $!');
 }
 
+{
+    # #6758: tainted values become untainted in tied hashes
+    #         (also applies to other value magic such as pos)
+
+
+    package P6758;
+
+    sub TIEHASH { bless {} }
+    sub TIEARRAY { bless {} }
+
+    my $i = 0;
+
+    sub STORE {
+	main::ok(main::tainted($_[1]), "tied arg1 tainted");
+	main::ok(main::tainted($_[2]), "tied arg2 tainted");
+        $i++;
+    }
+
+    package main;
+
+    my ($k,$v) = qw(1111 val);
+    taint_these($k,$v);
+    tie my @array, 'P6758';
+    tie my %hash , 'P6758';
+    $array[$k] = $v;
+    $hash{$k} = $v;
+    ok $i == 2, "tied STORE called correct number of times";
+}
+
 
 # This may bomb out with the alarm signal so keep it last
 SKIP: {