Front page | perl.perl5.porters |
Postings from March 2010
Re: [perl #67962] spamassassin and tainted mode
Thread Previous
|
Thread Next
From:
Dave Mitchell
Date:
March 25, 2010 04:10
Subject:
Re: [perl #67962] spamassassin and tainted mode
Message ID:
20100325111010.GW2960@iabyn.com
On Thu, Nov 05, 2009 at 09:28:10PM +0100, Mark Martinec wrote:
> Yves,
>
>
> > > I'm running 5.10.1 on our mailers now. I suppose I could
> > > remove these localizations of $1,$2,etc and see what happens.
> > > Will let you know if I can reproduce it on 5.10.1.
>
> Done. And I believe I have it distilled now to a small test case.
>
> > Also it would be really nice to get to the bottom of this.
> >
> > I have looked at the regex code and i have looked at the $1 fetch
> > logic and i dont see how it possibly could ever be tainted.
> >
> > At the very least we should assert that it isnt.
>
> #!/usr/bin/perl -T
>
> use strict;
> use re 'taint';
> use Scalar::Util qw(tainted);
>
> my $mailbox = 'abc@example.com';
> $mailbox .= substr($ENV{PATH},0,0); # make it tainted
>
> # $1 and $2 become tainted
> my(@r) = $mailbox =~ /^(.*?)(\@.*)$/ ? ($1,$2) : ($mailbox,'');
> printf("%d %d\n", tainted($1), tainted($2));
>
> my($nm) = 'aaa-ccc'; # not tainted
> printf("%d\n", tainted($nm));
>
> $nm =~ s/^aaa-(.*)$/$1/; # $nm becomes tainted
> printf("%d\n", tainted($nm));
Now fixed by commit 447ee1343739cf8e34c4ff1ba9b30eae75c3f1ab
in branch davem/post-5.12, which should be merged back into blead
once 5.12 has been released, and thus appear in 5.13 onwards:
commit 447ee1343739cf8e34c4ff1ba9b30eae75c3f1ab
Author: David Mitchell <davem@iabyn.com>
AuthorDate: Thu Mar 25 10:56:35 2010 +0000
Commit: David Mitchell <davem@iabyn.com>
CommitDate: Thu Mar 25 10:56:35 2010 +0000
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.
Affected files ...
M pp_ctl.c
M t/op/taint.t
Differences ...
diff --git a/pp_ctl.c b/pp_ctl.c
index de34879..a35cd43 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -278,9 +278,11 @@ PP(pp_substcont)
if (cx->sb_iters > cx->sb_maxiters)
DIE(aTHX_ "Substitution loop");
+ SvGETMAGIC(TOPs); /* possibly clear taint on $1 etc: #67962 */
+
if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
cx->sb_rxtainted |= 2;
- sv_catsv(dstr, POPs);
+ 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 f601552..e3a5712 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: {
--
In the 70's we wore flares because we didn't know any better.
What possible excuse does the current generation have?
Thread Previous
|
Thread Next