Skip Menu |
Report information
Id: 115266
Status: resolved
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: sprout <sprout [at] cpan.org>
Cc:
AdminCc:

Operating System: darwin
PatchStatus: (no value)
Severity: low
Type: core
Perl Version: 5.17.5
Fixed In: 5.27.6



Subject: s//$obj/ does not propagated taintedness of overloaded object
Date: Sun, 14 Oct 2012 14:54:54 -0700
To: perlbug [...] perl.org
From: Father Chrysostomos <sprout [...] cpan.org>
Download (untitled) / with headers
text/plain 4.8k
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: 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: 451f421fe4742646fa2efbed0f45a19f0713d00f 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
Date: Sun, 19 Nov 2017 09:31:19 +0000
Subject: Re: [perl #115266] s//$obj/ does not propagated taintedness of overloaded object
To: perl5-porters [...] perl.org
From: Zefram <zefram [...] fysh.org>
Fixed in commit c4f4b223e71713a6e8ae2141274c91f4ce821405. -zefram
Download (untitled) / with headers
text/plain 317b
Thank you for filing this report. You have helped make Perl better. With the release yesterday of Perl 5.28.0, this and 185 other issues have been resolved. Perl 5.28.0 may be downloaded via: https://metacpan.org/release/XSAWYERX/perl-5.28.0 If you find that the problem persists, feel free to reopen this ticket.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org