594 lines
20 KiB
Diff
594 lines
20 KiB
Diff
From 3f8a98327dfdb171bd6e447fec23721b0e74c7a6 Mon Sep 17 00:00:00 2001
|
|
From: Zefram <zefram@fysh.org>
|
|
Date: Sun, 19 Nov 2017 09:15:53 +0000
|
|
Subject: [PATCH] fix tainting of s/// with overloaded replacement
|
|
MIME-Version: 1.0
|
|
Content-Type: text/plain; charset=UTF-8
|
|
Content-Transfer-Encoding: 8bit
|
|
|
|
The substitution code was trying to track the taintedness of the
|
|
replacement string itself, but it didn't account for the replacement
|
|
being an untainted object with overloading that returns a tainted
|
|
stringification. It looked at the taintedness of the object value, not
|
|
realising that taint could arise during the string concatenation per se.
|
|
Change the taint checks to look at the actual TAINT_get flag after string
|
|
concatenation. This may falsely ascribe to the replacement taint that
|
|
actually came from somewhere else, but the end result is the same anyway:
|
|
there's no visible behaviour that distinguishes taint specifically from
|
|
the replacement. Also remove a related taint check that seems to be
|
|
not needed at all. Fixes [perl #115266].
|
|
|
|
Petr Písař: Ported to 5.26.1.
|
|
|
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
---
|
|
pp_ctl.c | 4 +-
|
|
pp_hot.c | 4 +-
|
|
t/op/taint.t | 428 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
|
|
3 files changed, 422 insertions(+), 14 deletions(-)
|
|
|
|
diff --git a/pp_ctl.c b/pp_ctl.c
|
|
index f136f91..15c193b 100644
|
|
--- a/pp_ctl.c
|
|
+++ b/pp_ctl.c
|
|
@@ -219,9 +219,9 @@ PP(pp_substcont)
|
|
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);
|
|
+ if (UNLIKELY(TAINT_get))
|
|
+ cx->sb_rxtainted |= SUBST_TAINT_REPL;
|
|
if (CxONCE(cx) || s < orig ||
|
|
!CALLREGEXEC(rx, s, cx->sb_strend, orig,
|
|
(s == m), cx->sb_targ, NULL,
|
|
diff --git a/pp_hot.c b/pp_hot.c
|
|
index f445fd9..5899413 100644
|
|
--- a/pp_hot.c
|
|
+++ b/pp_hot.c
|
|
@@ -3250,7 +3250,7 @@ PP(pp_subst)
|
|
doutf8 = DO_UTF8(dstr);
|
|
}
|
|
|
|
- if (SvTAINTED(dstr))
|
|
+ if (UNLIKELY(TAINT_get))
|
|
rxtainted |= SUBST_TAINT_REPL;
|
|
}
|
|
else {
|
|
@@ -3421,8 +3421,6 @@ PP(pp_subst)
|
|
}
|
|
else {
|
|
sv_catsv(dstr, repl);
|
|
- if (UNLIKELY(SvTAINTED(repl)))
|
|
- rxtainted |= SUBST_TAINT_REPL;
|
|
}
|
|
if (once)
|
|
break;
|
|
diff --git a/t/op/taint.t b/t/op/taint.t
|
|
index c13eaf6..be5eaa8 100644
|
|
--- a/t/op/taint.t
|
|
+++ b/t/op/taint.t
|
|
@@ -17,7 +17,7 @@ BEGIN {
|
|
use strict;
|
|
use Config;
|
|
|
|
-plan tests => 828;
|
|
+plan tests => 1040;
|
|
|
|
$| = 1;
|
|
|
|
@@ -83,6 +83,8 @@ EndOfCleanup
|
|
# Sources of taint:
|
|
# The empty tainted value, for tainting strings
|
|
my $TAINT = substr($^X, 0, 0);
|
|
+# A tainted non-empty string
|
|
+my $TAINTXYZ = "xyz".$TAINT;
|
|
# A tainted zero, useful for tainting numbers
|
|
my $TAINT0;
|
|
{
|
|
@@ -565,7 +567,7 @@ my $TEST = 'TEST';
|
|
is($one, 'abcd', "$desc: \$1 value");
|
|
}
|
|
|
|
- $desc = "substitution with replacement tainted";
|
|
+ $desc = "substitution with partial replacement tainted";
|
|
|
|
$s = 'abcd';
|
|
$res = $s =~ s/(.+)/xyz$TAINT/;
|
|
@@ -577,7 +579,7 @@ my $TEST = 'TEST';
|
|
is($res, 1, "$desc: res value");
|
|
is($one, 'abcd', "$desc: \$1 value");
|
|
|
|
- $desc = "substitution /g with replacement tainted";
|
|
+ $desc = "substitution /g with partial replacement tainted";
|
|
|
|
$s = 'abcd';
|
|
$res = $s =~ s/(.)/x$TAINT/g;
|
|
@@ -589,7 +591,7 @@ my $TEST = 'TEST';
|
|
is($res, 4, "$desc: res value");
|
|
is($one, 'd', "$desc: \$1 value");
|
|
|
|
- $desc = "substitution /ge with replacement tainted";
|
|
+ $desc = "substitution /ge with partial replacement tainted";
|
|
|
|
$s = 'abc';
|
|
{
|
|
@@ -618,7 +620,7 @@ my $TEST = 'TEST';
|
|
is($res, 3, "$desc: res value");
|
|
is($one, 'c', "$desc: \$1 value");
|
|
|
|
- $desc = "substitution /r with replacement tainted";
|
|
+ $desc = "substitution /r with partial replacement tainted";
|
|
|
|
$s = 'abcd';
|
|
$res = $s =~ s/(.+)/xyz$TAINT/r;
|
|
@@ -630,6 +632,71 @@ my $TEST = 'TEST';
|
|
is($res, 'xyz', "$desc: res value");
|
|
is($one, 'abcd', "$desc: \$1 value");
|
|
|
|
+ $desc = "substitution with whole replacement tainted";
|
|
+
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/$TAINTXYZ/;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xyz', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /g with whole replacement tainted";
|
|
+
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.)/$TAINTXYZ/g;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xyz' x 4, "$desc: s value");
|
|
+ is($res, 4, "$desc: res value");
|
|
+ is($one, 'd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /ge with whole replacement tainted";
|
|
+
|
|
+ $s = 'abc';
|
|
+ {
|
|
+ my $i = 0;
|
|
+ my $j;
|
|
+ $res = $s =~ s{(.)}{
|
|
+ $j = $i; # make sure code not tainted
|
|
+ $one = $1;
|
|
+ isnt_tainted($j, "$desc: code not tainted within /e");
|
|
+ $i++;
|
|
+ if ($i == 1) {
|
|
+ isnt_tainted($s, "$desc: s not tainted loop 1");
|
|
+ }
|
|
+ else {
|
|
+ is_tainted($s, "$desc: s tainted loop $i");
|
|
+ }
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted within /e");
|
|
+ $TAINTXYZ;
|
|
+ }ge;
|
|
+ $one = $1;
|
|
+ }
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xyz' x 3, "$desc: s value");
|
|
+ is($res, 3, "$desc: res value");
|
|
+ is($one, 'c', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /r with whole replacement tainted";
|
|
+
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/$TAINTXYZ/r;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ is_tainted($res, "$desc: res tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'abcd', "$desc: s value");
|
|
+ is($res, 'xyz', "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
{
|
|
# now do them all again with "use re 'taint"
|
|
|
|
@@ -955,7 +1022,7 @@ my $TEST = 'TEST';
|
|
is($one, 'abcd', "$desc: \$1 value");
|
|
}
|
|
|
|
- $desc = "use re 'taint': substitution with replacement tainted";
|
|
+ $desc = "use re 'taint': substitution with partial replacement tainted";
|
|
|
|
$s = 'abcd';
|
|
$res = $s =~ s/(.+)/xyz$TAINT/;
|
|
@@ -967,7 +1034,7 @@ my $TEST = 'TEST';
|
|
is($res, 1, "$desc: res value");
|
|
is($one, 'abcd', "$desc: \$1 value");
|
|
|
|
- $desc = "use re 'taint': substitution /g with replacement tainted";
|
|
+ $desc = "use re 'taint': substitution /g with partial replacement tainted";
|
|
|
|
$s = 'abcd';
|
|
$res = $s =~ s/(.)/x$TAINT/g;
|
|
@@ -979,7 +1046,7 @@ my $TEST = 'TEST';
|
|
is($res, 4, "$desc: res value");
|
|
is($one, 'd', "$desc: \$1 value");
|
|
|
|
- $desc = "use re 'taint': substitution /ge with replacement tainted";
|
|
+ $desc = "use re 'taint': substitution /ge with partial replacement tainted";
|
|
|
|
$s = 'abc';
|
|
{
|
|
@@ -1008,7 +1075,7 @@ my $TEST = 'TEST';
|
|
is($res, 3, "$desc: res value");
|
|
is($one, 'c', "$desc: \$1 value");
|
|
|
|
- $desc = "use re 'taint': substitution /r with replacement tainted";
|
|
+ $desc = "use re 'taint': substitution /r with partial replacement tainted";
|
|
|
|
$s = 'abcd';
|
|
$res = $s =~ s/(.+)/xyz$TAINT/r;
|
|
@@ -1020,6 +1087,71 @@ my $TEST = 'TEST';
|
|
is($res, 'xyz', "$desc: res value");
|
|
is($one, 'abcd', "$desc: \$1 value");
|
|
|
|
+ $desc = "use re 'taint': substitution with whole replacement tainted";
|
|
+
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/$TAINTXYZ/;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xyz', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "use re 'taint': substitution /g with whole replacement tainted";
|
|
+
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.)/$TAINTXYZ/g;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xyz' x 4, "$desc: s value");
|
|
+ is($res, 4, "$desc: res value");
|
|
+ is($one, 'd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "use re 'taint': substitution /ge with whole replacement tainted";
|
|
+
|
|
+ $s = 'abc';
|
|
+ {
|
|
+ my $i = 0;
|
|
+ my $j;
|
|
+ $res = $s =~ s{(.)}{
|
|
+ $j = $i; # make sure code not tainted
|
|
+ $one = $1;
|
|
+ isnt_tainted($j, "$desc: code not tainted within /e");
|
|
+ $i++;
|
|
+ if ($i == 1) {
|
|
+ isnt_tainted($s, "$desc: s not tainted loop 1");
|
|
+ }
|
|
+ else {
|
|
+ is_tainted($s, "$desc: s tainted loop $i");
|
|
+ }
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ $TAINTXYZ;
|
|
+ }ge;
|
|
+ $one = $1;
|
|
+ }
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xyz' x 3, "$desc: s value");
|
|
+ is($res, 3, "$desc: res value");
|
|
+ is($one, 'c', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "use re 'taint': substitution /r with whole replacement tainted";
|
|
+
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/$TAINTXYZ/r;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ is_tainted($res, "$desc: res tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'abcd', "$desc: s value");
|
|
+ is($res, 'xyz', "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
# [perl #121854] match taintedness became sticky
|
|
# when one match has a taintess result, subseqent matches
|
|
# using the same pattern shouldn't necessarily be tainted
|
|
@@ -2448,6 +2580,284 @@ is eval { eval $::x.1 }, 1, 'reset does not taint undef';
|
|
isnt_tainted $b, "list assign post tainted expression b";
|
|
}
|
|
|
|
+# taint passing through overloading
|
|
+package OvTaint {
|
|
+ sub new { bless({ t => $_[1] }, $_[0]) }
|
|
+ use overload '""' => sub { $_[0]->{t} ? "hi".$TAINT : "hello" };
|
|
+}
|
|
+my $ovclean = OvTaint->new(0);
|
|
+my $ovtaint = OvTaint->new(1);
|
|
+isnt_tainted("$ovclean", "overload preserves cleanliness");
|
|
+is_tainted("$ovtaint", "overload preserves taint");
|
|
+
|
|
+# substitutions with overloaded replacement
|
|
+{
|
|
+ my ($desc, $s, $res, $one);
|
|
+
|
|
+ $desc = "substitution with partial replacement overloaded and clean";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/xyz$ovclean/;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xyzhello', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution with partial replacement overloaded and tainted";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/xyz$ovtaint/;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xyzhi', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution with whole replacement overloaded and clean";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/$ovclean/;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'hello', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution with whole replacement overloaded and tainted";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/$ovtaint/;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'hi', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /e with partial replacement overloaded and clean";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/"xyz".$ovclean/e;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xyzhello', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /e with partial replacement overloaded and tainted";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/"xyz".$ovtaint/e;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xyzhi', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /e with whole replacement overloaded and clean";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/$ovclean/e;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'hello', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /e with whole replacement overloaded and tainted";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/$ovtaint/e;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'hi', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /e with extra code and partial replacement overloaded and clean";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/(my $z++), "xyz".$ovclean/e;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xyzhello', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /e with extra code and partial replacement overloaded and tainted";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/(my $z++), "xyz".$ovtaint/e;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xyzhi', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /e with extra code and whole replacement overloaded and clean";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/(my $z++), $ovclean/e;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'hello', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /e with extra code and whole replacement overloaded and tainted";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/(my $z++), $ovtaint/e;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'hi', "$desc: s value");
|
|
+ is($res, 1, "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /r with partial replacement overloaded and clean";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/xyz$ovclean/r;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'abcd', "$desc: s value");
|
|
+ is($res, 'xyzhello', "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /r with partial replacement overloaded and tainted";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/xyz$ovtaint/r;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ is_tainted($res, "$desc: res tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'abcd', "$desc: s value");
|
|
+ is($res, 'xyzhi', "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /r with whole replacement overloaded and clean";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/$ovclean/r;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'abcd', "$desc: s value");
|
|
+ is($res, 'hello', "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /r with whole replacement overloaded and tainted";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.+)/$ovtaint/r;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ is_tainted($res, "$desc: res tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'abcd', "$desc: s value");
|
|
+ is($res, 'hi', "$desc: res value");
|
|
+ is($one, 'abcd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /g with partial replacement overloaded and clean";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.)/x$ovclean/g;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xhello' x 4, "$desc: s value");
|
|
+ is($res, 4, "$desc: res value");
|
|
+ is($one, 'd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /g with partial replacement overloaded and tainted";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.)/x$ovtaint/g;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xhi' x 4, "$desc: s value");
|
|
+ is($res, 4, "$desc: res value");
|
|
+ is($one, 'd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /g with whole replacement overloaded and clean";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.)/$ovclean/g;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'hello' x 4, "$desc: s value");
|
|
+ is($res, 4, "$desc: res value");
|
|
+ is($one, 'd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /g with whole replacement overloaded and tainted";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.)/$ovtaint/g;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'hi' x 4, "$desc: s value");
|
|
+ is($res, 4, "$desc: res value");
|
|
+ is($one, 'd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /ge with partial replacement overloaded and clean";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.)/"x".$ovclean/ge;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xhello' x 4, "$desc: s value");
|
|
+ is($res, 4, "$desc: res value");
|
|
+ is($one, 'd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /ge with partial replacement overloaded and tainted";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.)/"x".$ovtaint/ge;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'xhi' x 4, "$desc: s value");
|
|
+ is($res, 4, "$desc: res value");
|
|
+ is($one, 'd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /ge with whole replacement overloaded and clean";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.)/$ovclean/ge;
|
|
+ $one = $1;
|
|
+ isnt_tainted($s, "$desc: s not tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'hello' x 4, "$desc: s value");
|
|
+ is($res, 4, "$desc: res value");
|
|
+ is($one, 'd', "$desc: \$1 value");
|
|
+
|
|
+ $desc = "substitution /ge with whole replacement overloaded and tainted";
|
|
+ $s = 'abcd';
|
|
+ $res = $s =~ s/(.)/$ovtaint/ge;
|
|
+ $one = $1;
|
|
+ is_tainted($s, "$desc: s tainted");
|
|
+ isnt_tainted($res, "$desc: res not tainted");
|
|
+ isnt_tainted($one, "$desc: \$1 not tainted");
|
|
+ is($s, 'hi' x 4, "$desc: s value");
|
|
+ is($res, 4, "$desc: res value");
|
|
+ is($one, 'd', "$desc: \$1 value");
|
|
+}
|
|
|
|
# This may bomb out with the alarm signal so keep it last
|
|
SKIP: {
|
|
--
|
|
2.13.6
|
|
|