Fix out-of-bound read in case of unmatched regexp backreference
This commit is contained in:
parent
abd9ed8e7e
commit
7123c928a4
@ -0,0 +1,107 @@
|
||||
From a08fa6fd157fd0d61da7f20f07b939fbc302c2c6 Mon Sep 17 00:00:00 2001
|
||||
From: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Wed, 5 Oct 2016 12:56:05 +0100
|
||||
Subject: [PATCH] [perl #129377] don't read past start of string for unmatched
|
||||
backref
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
Ported to 5.24.1:
|
||||
|
||||
commit 2dfc11ec3af312f4fa3eb244077c79dbb5fc2d85
|
||||
Author: Hugo van der Sanden <hv@crypt.org>
|
||||
Date: Wed Oct 5 12:56:05 2016 +0100
|
||||
|
||||
[perl #129377] don't read past start of string for unmatched backref
|
||||
|
||||
We can have (start, end) == (0, -1) for an unmatched backref, we must
|
||||
check for that.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
regexec.c | 10 ++++++----
|
||||
t/re/pat.t | 16 +++++++++++++++-
|
||||
2 files changed, 21 insertions(+), 5 deletions(-)
|
||||
|
||||
diff --git a/regexec.c b/regexec.c
|
||||
index a5d5db4..a7bc0c3 100644
|
||||
--- a/regexec.c
|
||||
+++ b/regexec.c
|
||||
@@ -5179,6 +5179,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
|
||||
regnode *next;
|
||||
U32 n = 0; /* general value; init to avoid compiler warning */
|
||||
SSize_t ln = 0; /* len or last; init to avoid compiler warning */
|
||||
+ SSize_t endref = 0; /* offset of end of backref when ln is start */
|
||||
char *locinput = startpos;
|
||||
char *pushinput; /* where to continue after a PUSH */
|
||||
I32 nextchr; /* is always set to UCHARAT(locinput), or -1 at EOS */
|
||||
@@ -6489,10 +6490,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
|
||||
|
||||
do_nref_ref_common:
|
||||
ln = rex->offs[n].start;
|
||||
+ endref = rex->offs[n].end;
|
||||
reginfo->poscache_iter = reginfo->poscache_maxiter; /* Void cache */
|
||||
- if (rex->lastparen < n || ln == -1)
|
||||
+ if (rex->lastparen < n || ln == -1 || endref == -1)
|
||||
sayNO; /* Do not match unless seen CLOSEn. */
|
||||
- if (ln == rex->offs[n].end)
|
||||
+ if (ln == endref)
|
||||
break;
|
||||
|
||||
s = reginfo->strbeg + ln;
|
||||
@@ -6506,7 +6508,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
|
||||
* not going off the end given by reginfo->strend, and
|
||||
* returns in <limit> upon success, how much of the
|
||||
* current input was matched */
|
||||
- if (! foldEQ_utf8_flags(s, NULL, rex->offs[n].end - ln, utf8_target,
|
||||
+ if (! foldEQ_utf8_flags(s, NULL, endref - ln, utf8_target,
|
||||
locinput, &limit, 0, utf8_target, utf8_fold_flags))
|
||||
{
|
||||
sayNO;
|
||||
@@ -6521,7 +6523,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
|
||||
(type == REF ||
|
||||
UCHARAT(s) != fold_array[nextchr]))
|
||||
sayNO;
|
||||
- ln = rex->offs[n].end - ln;
|
||||
+ ln = endref - ln;
|
||||
if (locinput + ln > reginfo->strend)
|
||||
sayNO;
|
||||
if (ln > 1 && (type == REF
|
||||
diff --git a/t/re/pat.t b/t/re/pat.t
|
||||
index 4aa77cf..749edd0 100644
|
||||
--- a/t/re/pat.t
|
||||
+++ b/t/re/pat.t
|
||||
@@ -23,7 +23,7 @@ BEGIN {
|
||||
skip_all_without_unicode_tables();
|
||||
}
|
||||
|
||||
-plan tests => 791; # Update this when adding/deleting tests.
|
||||
+plan tests => 792; # Update this when adding/deleting tests.
|
||||
|
||||
run_tests() unless caller;
|
||||
|
||||
@@ -1765,6 +1765,20 @@ EOP
|
||||
utf8::upgrade($str);
|
||||
ok( $str =~ m{^(a|a\x{e4})$}, "fix [perl #129950] - utf8 case" );
|
||||
}
|
||||
+ {
|
||||
+ # [perl #129377] backref to an unmatched capture should not cause
|
||||
+ # reading before start of string.
|
||||
+ SKIP: {
|
||||
+ skip "no re-debug under miniperl" if is_miniperl;
|
||||
+ my $prog = <<'EOP';
|
||||
+use re qw(Debug EXECUTE);
|
||||
+"x" =~ m{ () y | () \1 }x;
|
||||
+EOP
|
||||
+ fresh_perl_like($prog, qr{
|
||||
+ \A (?! .* ^ \s+ - )
|
||||
+ }msx, { stderr => 1 }, "Offsets in debug output are not negative");
|
||||
+ }
|
||||
+ }
|
||||
} # End of sub run_tests
|
||||
|
||||
1;
|
||||
--
|
||||
2.7.4
|
||||
|
@ -252,6 +252,10 @@ Patch69: perl-5.24.1-perl-129125-copy-form-data-if-it-might-be-freed.patc
|
||||
# transliteration expression, RT#129342, in upstream after 5.25.8
|
||||
Patch70: perl-5.24.1-perl-129342-ensure-range-start-is-set-after-error-in.patch
|
||||
|
||||
# Fix out-of-bound read in case of unmatched regexp backreference, RT#129377,
|
||||
# in upstream after 5.25.8
|
||||
Patch71: perl-5.24.1-perl-129377-don-t-read-past-start-of-string-for-unma.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
|
||||
|
||||
@ -2946,6 +2950,7 @@ Perl extension for Version Objects
|
||||
%patch68 -p1
|
||||
%patch69 -p1
|
||||
%patch70 -p1
|
||||
%patch71 -p1
|
||||
%patch200 -p1
|
||||
%patch201 -p1
|
||||
|
||||
@ -3004,6 +3009,7 @@ perl -x patchlevel.h \
|
||||
'Fedora Patch67: Fix a heap overflow with pack "W" (RT129149)' \
|
||||
'Fedora Patch69: Fix a use-after-free when processing scalar variables in forms (RT#129125)' \
|
||||
'Fedora Patch70: Fix a heap overflow if invalid octal or hexadecimal number is used in transliteration expression (RT#129342)' \
|
||||
'Fedora Patch71: Fix out-of-bound read in case of unmatched regexp backreference (RT#129377)' \
|
||||
'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}
|
||||
@ -5286,6 +5292,7 @@ popd
|
||||
- Fix a use-after-free when processing scalar variables in forms (RT#129125)
|
||||
- Fix a heap overflow if invalid octal or hexadecimal number is used in
|
||||
transliteration expression (RT#129342)
|
||||
- Fix out-of-bound read in case of unmatched regexp backreference (RT#129377)
|
||||
|
||||
* Mon Jan 16 2017 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.24.1-385
|
||||
- 5.24.1 bump (see <http://search.cpan.org/dist/perl-5.24.1/pod/perldelta.pod>
|
||||
|
Loading…
Reference in New Issue
Block a user