diff options
author | David Mitchell <davem@iabyn.com> | 2010-03-25 10:56:35 +0000 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2010-03-25 10:56:35 +0000 |
commit | 447ee1343739cf8e34c4ff1ba9b30eae75c3f1ab (patch) | |
tree | b713c83f9510652e10e27b68b31c2a0d45e49149 /t | |
parent | fd69380d5d5b95ef16e2521cf4251b34ee0ce151 (diff) | |
download | perl-447ee1343739cf8e34c4ff1ba9b30eae75c3f1ab.tar.gz |
RT #67962: $1 treated as tainted in untainted match
Fix the issue in the following:
use re 'taint';
$tainted =~ /(...)/;
# $1 now correctly tainted
$untainted =~ s/(...)/$1/;
# $untainted now incorrectly tainted
The problem stems from when $1 is updated.
pp_substcont, which is called after the replacement expression has been
evaluated, checks the returned expression for taintedness, and if so,
taints the variable being substituted. For a substitution like
s/(...)/x$1/ this works fine: the expression "x".$1 causes $1's get magic
to be called, which sets $1 based on the recent match, and is marked as
not tainted. Thus the returned expression is untainted. In the variant
s/(...)/$1/, the returned value on the stack is $1 itself, and its get
magic hasn't been called yet. So it still has the tainted flag from the
previous pattern.
The solution is to mg_get the returned expression *before* testing for
taintedness.
Diffstat (limited to 't')
-rw-r--r-- | t/op/taint.t | 18 |
1 files changed, 17 insertions, 1 deletions
diff --git a/t/op/taint.t b/t/op/taint.t index f601552e28..e3a5712913 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 => 321; +plan tests => 325; $| = 1; @@ -1380,6 +1380,22 @@ foreach my $ord (78, 163, 256) { } +# Bug RT #67962: old tainted $1 gets treated as tainted +# in next untainted # match + +{ + use re 'taint'; + "abc".$TAINT =~ /(.*)/; # make $1 tainted + ok(tainted($1), '$1 should be tainted'); + + my $untainted = "abcdef"; + ok(!tainted($untainted), '$untainted should be untainted'); + $untainted =~ s/(abc)/$1/; + ok(!tainted($untainted), '$untainted should still be untainted'); + $untainted =~ s/(abc)/x$1/; + ok(!tainted($untainted), '$untainted should yet still be untainted'); +} + # This may bomb out with the alarm signal so keep it last SKIP: { |