summaryrefslogtreecommitdiff
path: root/mg.c
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2010-03-20 15:41:13 +0000
committerDavid Mitchell <davem@iabyn.com>2010-03-20 15:41:13 +0000
commitb112cff9879ef9e20ee30b1a9ec813b1336a3093 (patch)
treea6f232bf55d00fbd76f8cc928463264ff40dd49e /mg.c
parentec2eb4bd361a09e57e604554de76134547bd4457 (diff)
downloadperl-b112cff9879ef9e20ee30b1a9ec813b1336a3093.tar.gz
[perl #6758] tainted values become untainted in tied hashes
Diffstat (limited to 'mg.c')
-rw-r--r--mg.c23
1 files changed, 22 insertions, 1 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;