From @cpansprout

This little bit of code in pp_ctl.c:pp_substcont seemed suspicious:

SvGETMAGIC(TOPs); /* possibly clear taint on $1 etc: #67962 */

/* See "how taint works" above pp_subst() */
if (SvTAINTED(TOPs))
cx->sb_rxtainted |= SUBST_TAINT_REPL;
sv_catsv_nomg(dstr, POPs);

So I tried testing it, and, indeed, taintedness is not propagated:

package o { use overload '""' => sub { $^X } }

bless $o=[],o;
$x = "hello";
$x =~ s/h/($o)[0]/e;
use Devel::Peek; Dump $x;
"$o";
Dump $o;

I thought this would fix it, but it does not:

Inline Patch

diff --git a/pp_ctl.c b/pp_ctl.c
index 23847c4..5bb4901 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -203,12 +203,10 @@ PP(pp_substcont)
 	if (cx->sb_iters > cx->sb_maxiters)
 	    DIE(aTHX_ "Substitution loop");
 
-	SvGETMAGIC(TOPs); /* possibly clear taint on $1 etc: #67962 */
-
+	sv_catsv(dstr, POPs);
     	/* See "how taint works" above pp_subst() */
-	if (SvTAINTED(TOPs))
+	if (SvTAINTED(TOPp1s))
 	    cx->sb_rxtainted |= SUBST_TAINT_REPL;
-	sv_catsv_nomg(dstr, POPs);
 	/* XXX: adjust for positive offsets of \G for instance s/(.)\G//g with positive pos() */
 	s -= RX_GOFS(rx);
 
diff --git a/t/op/taint.t b/t/op/taint.t
index d621de6..69c0832 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -17,7 +17,7 @@ BEGIN {
 use strict;
 use Config;
 
-plan tests => 797;
+plan tests => 805;
 
 $| = 1;
 
@@ -579,6 +579,17 @@ my $TEST = 'TEST';
     is($res, 'xyz',    "$desc: res value");
     is($one, 'abcd',   "$desc: \$1 value");
 
+    $desc = 's//complex expr returning overload obj that taints on ""/e';
+
+    package o { use overload '""' => sub { $TAINT } }
+    bless my $o = [], o::;
+    $s = 'hello';
+    $res = $s =~ s/h/($o)[0]/e;
+    is_tainted($s,     "$desc: s tainted");
+    isnt_tainted($res, "$desc: res not tainted");
+    is($s,   'ello',   "$desc: s value");
+    is($res, '1',      "$desc: res value");
+
     {
 	# now do them all again with "use re 'taint"
 
@@ -935,6 +946,17 @@ my $TEST = 'TEST';
 	is($s,   'abcd',   "$desc: s value");
 	is($res, 'xyz',    "$desc: res value");
 	is($one, 'abcd',   "$desc: \$1 value");
+
+	$desc = 'use re "taint": s//complex expr returning overload obj '
+	       .'that taints on ""/e';
+
+	bless my $o = [], o::;
+	$s = 'hello';
+	$res = $s =~ s/h/($o)[0]/e;
+	is_tainted($s,     "$desc: s tainted");
+	isnt_tainted($res, "$desc: res not tainted");
+	is($s,   'ello',   "$desc: s value");
+	is($res, '1',      "$desc: res value");
     }
 
     $foo = $1 if 'bar' =~ /(.+)$TAINT/;

---

Flags: category=core severity=low

Site configuration information for perl 5.17.5:

Configured by sprout at Sat Sep 22 18:51:23 PDT 2012.

Summary of my perl5 (revision 5 version 17 subversion 5) configuration:
Snapshot of: 451f421
Platform:
osname=darwin, osvers=10.5.0, archname=darwin-2level
uname='darwin pint.local 10.5.0 darwin kernel version 10.5.0: fri nov 5 23:20:39 pdt 2010; root:xnu-1504.9.17~1release_i386 i386 '
config_args='-de -Dusedevel -DDEBUGGING'
hint=recommended, useposix=true, d_sigaction=define
useithreads=undef, usemultiplicity=undef
useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
use64bitint=undef, use64bitall=undef, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-fno-common -DPERL_DARWIN -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include',
optimize='-O3 -g',
cppflags='-fno-common -DPERL_DARWIN -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
ccversion='', gccversion='4.2.1 (Apple Inc. build 5664)', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags =' -fstack-protector -L/usr/local/lib'
libpth=/usr/local/lib /usr/lib
libs=-ldbm -ldl -lm -lutil -lc
perllibs=-ldl -lm -lutil -lc
libc=, so=dylib, useshrplib=false, libperl=libperl.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup -L/usr/local/lib -fstack-protector'

Locally applied patches:

@INC for perl 5.17.5:
/usr/local/lib/perl5/site_perl/5.17.5/darwin-2level
/usr/local/lib/perl5/site_perl/5.17.5
/usr/local/lib/perl5/5.17.5/darwin-2level
/usr/local/lib/perl5/5.17.5
/usr/local/lib/perl5/site_perl
.

Environment for perl 5.17.5:
DYLD_LIBRARY_PATH (unset)
HOME=/Users/sprout
LANG=en_US.UTF-8
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=/usr/bin:/bin:/usr/sbin:/sbin:/usr/local/bin:/usr/X11/bin:/usr/local/bin
PERL_BADLANG (unset)
SHELL=/bin/bash

s//$obj/ does not propagated taintedness of overloaded object #12495

Description

Metadata

Metadata

Assignees

Labels

Type

Projects

Milestone

Relationships

Development

Issue actions