diff --git a/perl-5.27.5-fix-tainting-of-s-with-overloaded-replacement.patch b/perl-5.27.5-fix-tainting-of-s-with-overloaded-replacement.patch new file mode 100644 index 0000000..3b853ae --- /dev/null +++ b/perl-5.27.5-fix-tainting-of-s-with-overloaded-replacement.patch @@ -0,0 +1,593 @@ +From 3f8a98327dfdb171bd6e447fec23721b0e74c7a6 Mon Sep 17 00:00:00 2001 +From: Zefram +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ř +--- + 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 + diff --git a/perl.spec b/perl.spec index e8193df..d240b74 100644 --- a/perl.spec +++ b/perl.spec @@ -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 - 4:5.26.1-401 - Update perl(:MODULE_COMPAT)