Fix tainting of s/// with overloaded replacement
This commit is contained in:
parent
f9337f705b
commit
4440ffe366
|
@ -0,0 +1,593 @@
|
||||||
|
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
|
||||||
|
|
|
@ -241,6 +241,10 @@ Patch70: perl-5.27.5-perl-132442-Fix-stack-with-do-my-sub-l-1.patch
|
||||||
# in upstream after 5.27.5
|
# in upstream after 5.27.5
|
||||||
Patch71: perl-5.26.1-set-when-statting-a-closed-filehandle.patch
|
Patch71: perl-5.26.1-set-when-statting-a-closed-filehandle.patch
|
||||||
|
|
||||||
|
# Fix tainting of s/// with overloaded replacement, RT#115266,
|
||||||
|
# in upstream after 5.27.5
|
||||||
|
Patch72: perl-5.27.5-fix-tainting-of-s-with-overloaded-replacement.patch
|
||||||
|
|
||||||
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
|
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
|
||||||
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
|
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
|
||||||
|
|
||||||
|
@ -2827,6 +2831,7 @@ Perl extension for Version Objects
|
||||||
%patch69 -p1
|
%patch69 -p1
|
||||||
%patch70 -p1
|
%patch70 -p1
|
||||||
%patch71 -p1
|
%patch71 -p1
|
||||||
|
%patch72 -p1
|
||||||
%patch200 -p1
|
%patch200 -p1
|
||||||
%patch201 -p1
|
%patch201 -p1
|
||||||
|
|
||||||
|
@ -2872,6 +2877,7 @@ perl -x patchlevel.h \
|
||||||
'Fedora Patch69: Fix error reporting on do() on a directory (RT#125774)' \
|
'Fedora Patch69: Fix error reporting on do() on a directory (RT#125774)' \
|
||||||
'Fedora Patch70: Fix stack manipulation when a lexical subroutine is defined in a do block in a member of an iteration list (RT#132442)' \
|
'Fedora Patch70: Fix stack manipulation when a lexical subroutine is defined in a do block in a member of an iteration list (RT#132442)' \
|
||||||
'Fedora Patch71: Fix setting $! when statting a closed filehandle (RT#108288)' \
|
'Fedora Patch71: Fix setting $! when statting a closed filehandle (RT#108288)' \
|
||||||
|
'Fedora Patch72: Fix tainting of s/// with overloaded replacement (RT#115266)' \
|
||||||
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
|
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
|
||||||
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
|
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
|
||||||
%{nil}
|
%{nil}
|
||||||
|
@ -5171,6 +5177,7 @@ popd
|
||||||
- Fix stack manipulation when a lexical subroutine is defined in a do block in
|
- Fix stack manipulation when a lexical subroutine is defined in a do block in
|
||||||
a member of an iteration list (RT#132442)
|
a member of an iteration list (RT#132442)
|
||||||
- Fix setting $! when statting a closed filehandle (RT#108288)
|
- Fix setting $! when statting a closed filehandle (RT#108288)
|
||||||
|
- Fix tainting of s/// with overloaded replacement (RT#115266)
|
||||||
|
|
||||||
* Mon Sep 25 2017 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.26.1-401
|
* Mon Sep 25 2017 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.26.1-401
|
||||||
- Update perl(:MODULE_COMPAT)
|
- Update perl(:MODULE_COMPAT)
|
||||||
|
|
Loading…
Reference in New Issue