In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/f8fb8615ddc5a80e3bbd4386a8914497f921b62d?hp=3ed3004ae659b0360a49bd586680461ab3b6a6b7>
- Log -----------------------------------------------------------------
commit f8fb8615ddc5a80e3bbd4386a8914497f921b62d
Author: Karl Williamson <k...@cpan.org>
Date: Mon Apr 16 22:13:30 2018 -0600
heap-buffer-overflow
The fix is simpler than in the maintenance releases due to prior changes
in 5.27.
The problem is that under some circumstances the sharp s takes up two
bytes when space for only one had been allocated. Just the right set of
circumstances are required for this to happen.
commit 5927ddccd733e5d8252ce3866c027c042d2f98aa
Author: Karl Williamson <k...@cpan.org>
Date: Mon Apr 16 21:12:03 2018 -0600
Revert "PATCH: (perl #132227 CVE-2018-6797] heap-buffer-overflow"
This reverts commit 2407a17ad5d780a1625dddfb668056ab05459194.
It turns out that I applied the wrong patch, which was a preliminary one
that did not solve the entire problem. The next commit will apply a
correct fix, with test.
-----------------------------------------------------------------------
Summary of changes:
regcomp.c | 41 +++++++++++++++++++++++------------------
t/re/pat.t | 10 ++++++----
2 files changed, 29 insertions(+), 22 deletions(-)
diff --git a/regcomp.c b/regcomp.c
index 374131cfd4..b69b2c9f6f 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -13925,24 +13925,11 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32
*flagp, U32 depth)
* is_PROBLEMATIC_LOCALE_FOLD_cp) */
if (! IS_IN_SOME_FOLD_L1(ender)) {
- /* See if the character's fold differs between /d and
- * /u. This includes the multi-char fold SHARP S to
- * 'ss' */
- if (UNLIKELY(ender == LATIN_SMALL_LETTER_SHARP_S)) {
-
- /* If the node started out having uni rules, we
- * wouldn't have gotten here. So this means
- * something in the middle has changed it, but
- * didn't think it needed to reparse. But this
- * sharp s now does indicate the need for
- * reparsing. */
- if (RExC_uni_semantics) {
- p = oldp;
- goto loopdone;
- }
-
- RExC_seen_unfolded_sharp_s = 1;
- maybe_exactfu = FALSE;
+ /* Start a new node for this non-folding character if
+ * previous ones in the node were folded */
+ if (len && node_type != EXACT) {
+ p = oldp;
+ goto loopdone;
}
*(s++) = (char) ender;
@@ -13981,6 +13968,24 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp,
U32 depth)
ender = 's';
added_len = 2;
}
+ else if (RExC_uni_semantics) {
+
+ /* Here, we are supossed to be using Unicode
+ * rules, but this folding node is not. This
+ * happens during pass 1 when the node started
+ * out not under Unicode rules, but a \N{} was
+ * encountered during the processing of it,
+ * causing Unicode rules to be switched into.
+ * Pass 1 continues uninteruppted, as by the
+ * time we get to pass 2, we will know enough
+ * to generate the correct folds. Except in
+ * this one case, we need to restart the node,
+ * because the fold of the sharp s requires 2
+ * characters, and the sizing needs to account
+ * for that. */
+ p = oldp;
+ goto loopdone;
+ }
else {
RExC_seen_unfolded_sharp_s = 1;
maybe_exactfu = FALSE;
diff --git a/t/re/pat.t b/t/re/pat.t
index d327a36475..066ac96257 100644
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -23,7 +23,7 @@ BEGIN {
skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
skip_all_without_unicode_tables();
-plan tests => 846; # Update this when adding/deleting tests.
+plan tests => 847; # Update this when adding/deleting tests.
run_tests() unless caller;
@@ -32,6 +32,8 @@ run_tests() unless caller;
#
sub run_tests {
+ my $sharp_s = uni_to_native("\xdf");
+
{
my $x = "abc\ndef\n";
(my $x_pretty = $x) =~ s/\n/\\n/g;
@@ -1409,9 +1411,6 @@ EOP
{ # Various flags weren't being set when a [] is optimized into an
# EXACTish node
- ;
- ;
- my $sharp_s = uni_to_native("\xdf");
ok("\x{017F}\x{017F}" =~ qr/^[$sharp_s]?$/i, "[] to EXACTish
optimization");
}
@@ -1941,6 +1940,9 @@ EOP
{
fresh_perl_is('$_="0\x{1000000}";/^000?\0000/','',{},"dont throw
assert errors trying to fbm past end of string");
}
+ { # [perl $132227]
+ fresh_perl_is("('0ba' . ('ss' x 300)) =~ m/0B\\N{U+41}" . $sharp_s x
150 . '/i and print "1\n"', 1,{},"Use of sharp s under /di that changes to
/ui");
+ }
} # End of sub run_tests
--
Perl5 Master Repository
