rpms/perl
7
0
Fork 0
Code Issues Pull Requests Releases Activity

Fix tainting of s/// with overloaded replacement

Browse Source
This commit is contained in:
Petr Písař 2018-01-10 10:51:17 +01:00
parent f9337f705b
commit 4440ffe366
2 changed files with 600 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

593
perl-5.27.5-fix-tainting-of-s-with-overloaded-replacement.patch Normal file
View File

@ -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

7
perl.spec
View File

@ -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
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
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
%patch70 -p1
%patch71 -p1
%patch72 -p1
%patch200 -p1
%patch201 -p1
@ -2872,6 +2877,7 @@ perl -x patchlevel.h \
'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 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 Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
%{nil}
@ -5171,6 +5177,7 @@ popd
- Fix stack manipulation when a lexical subroutine is defined in a do block in
a member of an iteration list (RT#132442)
- 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
- Update perl(:MODULE_COMPAT)