From 89d9dddd8681e4728ac5ea3b8fa3b60913083a46 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar(a)redhat.com>
Date: Fri, 20 Jan 2017 10:37:35 +0100
Subject: Fix out-of-bound read in case of unmatched regexp backreference
---
...-don-t-read-past-start-of-string-for-unma.patch | 107 +++++++++++++++++++++
perl.spec | 7 ++
2 files changed, 114 insertions(+)
create mode 100644
perl-5.24.1-perl-129377-don-t-read-past-start-of-string-for-unma.patch
diff --git a/perl-5.24.1-perl-129377-don-t-read-past-start-of-string-for-unma.patch
b/perl-5.24.1-perl-129377-don-t-read-past-start-of-string-for-unma.patch
new file mode 100644
index 0000000..cbf5a73
--- /dev/null
+++ b/perl-5.24.1-perl-129377-don-t-read-past-start-of-string-for-unma.patch
@@ -0,0 +1,107 @@
+From a08fa6fd157fd0d61da7f20f07b939fbc302c2c6 Mon Sep 17 00:00:00 2001
+From: Hugo van der Sanden <hv(a)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(a)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(a)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
+
diff --git a/perl.spec b/perl.spec
index dfb0cf4..1d3f15e 100644
--- a/perl.spec
+++ b/perl.spec
@@ -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
@@ -2945,6 +2949,7 @@ Perl extension for Version Objects
%patch68 -p1
%patch69 -p1
%patch70 -p1
+%patch71 -p1
%patch200 -p1
%patch201 -p1
@@ -3003,6 +3008,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}
@@ -5287,6 +5293,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(a)redhat.com> - 4:5.24.1-381
- 5.24.1 bump (see <
http://search.cpan.org/dist/perl-5.24.1/pod/perldelta.pod>
--
cgit v0.12
http://pkgs.fedoraproject.org/cgit/perl.git/commit/?h=f25&id=89d9dddd...