Skip to content
This repository has been archived by the owner on Jan 31, 2020. It is now read-only.

Commit

Permalink
perl: security fixes; fix #61
Browse files Browse the repository at this point in the history
  • Loading branch information
@MingcongBai
MingcongBai committed Apr 15, 2018
1 parent 687e639 commit 46963ba
Show file tree
Hide file tree
Showing 6 changed files with 314 additions and 9 deletions.
9 changes: 0 additions & 9 deletions core-perl/perl/autobuild/patch
View file

This file was deleted.

39 changes: 39 additions & 0 deletions core-perl/perl/autobuild/patches/CVE-2018-6797.patch
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,39 @@
From 510cc261d965ccfa427900ebb368fc4d337442d2 Mon Sep 17 00:00:00 2001
From: Karl Williamson <[email protected]>
Date: Fri, 2 Feb 2018 15:14:27 -0700
Subject: [PATCH] (perl #132227) restart a node if we change to uni rules
within the node and encounter a sharp S

This could lead to a buffer overflow.

(cherry picked from commit 190b97e86cd07d984ea2e9f0c844d33cd3399d21)
---
regcomp.c | 12 ++++++++++++
1 file changed, 12 insertions(+)

diff --git a/regcomp.c b/regcomp.c
index c6c7cb4925..d79bd191c9 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -13323,6 +13323,18 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
* /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;
}
--
2.15.1-424-g9478a660812

125 changes: 125 additions & 0 deletions core-perl/perl/autobuild/patches/CVE-2018-6798.patch
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,125 @@
From 0abf1e8d89aecd32dbdabda5da4d52a2d57a7cff Mon Sep 17 00:00:00 2001
From: Karl Williamson <[email protected]>
Date: Tue, 6 Feb 2018 14:50:48 -0700
Subject: [PATCH] [perl #132063]: Heap buffer overflow

The proximal cause is several instances in regexec.c of the code
assuming that the input was valid UTF-8, whereas the input was too short
for what the start byte claimed it would be.

I grepped through the core for any other similar uses, and did not find
any.

(cherry picked from commit fe7d8ba0a1bf567af8fa8fea128e2b9f4c553e84)
---
regexec.c | 29 ++++++++++++++++-------------
t/lib/warnings/regexec | 7 +++++++
2 files changed, 23 insertions(+), 13 deletions(-)

diff --git a/regexec.c b/regexec.c
index 5735b997fd..ea432c39d3 100644
--- a/regexec.c
+++ b/regexec.c
@@ -1466,7 +1466,9 @@ Perl_re_intuit_start(pTHX_
? trie_utf8_fold \
: trie_latin_utf8_fold)))

-#define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len, uvc, charid, foldlen, foldbuf, uniflags) \
+/* 'uscan' is set to foldbuf, and incremented, so below the end of uscan is
+ * 'foldbuf+sizeof(foldbuf)' */
+#define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uc_end, uscan, len, uvc, charid, foldlen, foldbuf, uniflags) \
STMT_START { \
STRLEN skiplen; \
U8 flags = FOLD_FLAGS_FULL; \
@@ -1474,7 +1476,7 @@ STMT_START {
case trie_flu8: \
_CHECK_AND_WARN_PROBLEMATIC_LOCALE; \
if (utf8_target && UTF8_IS_ABOVE_LATIN1(*uc)) { \
- _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(uc, uc + UTF8SKIP(uc)); \
+ _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(uc, uc_end - uc); \
} \
goto do_trie_utf8_fold; \
case trie_utf8_exactfa_fold: \
@@ -1483,7 +1485,7 @@ STMT_START {
case trie_utf8_fold: \
do_trie_utf8_fold: \
if ( foldlen>0 ) { \
- uvc = utf8n_to_uvchr( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \
+ uvc = utf8n_to_uvchr( (const U8*) uscan, foldlen, &len, uniflags ); \
foldlen -= len; \
uscan += len; \
len=0; \
@@ -1500,7 +1502,7 @@ STMT_START {
/* FALLTHROUGH */ \
case trie_latin_utf8_fold: \
if ( foldlen>0 ) { \
- uvc = utf8n_to_uvchr( (const U8*) uscan, UTF8_MAXLEN, &len, uniflags ); \
+ uvc = utf8n_to_uvchr( (const U8*) uscan, foldlen, &len, uniflags ); \
foldlen -= len; \
uscan += len; \
len=0; \
@@ -1519,7 +1521,7 @@ STMT_START {
} \
/* FALLTHROUGH */ \
case trie_utf8: \
- uvc = utf8n_to_uvchr( (const U8*) uc, UTF8_MAXLEN, &len, uniflags ); \
+ uvc = utf8n_to_uvchr( (const U8*) uc, uc_end - uc, &len, uniflags ); \
break; \
case trie_plain: \
uvc = (UV)*uc; \
@@ -2599,10 +2601,10 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
}
points[pointpos++ % maxlen]= uc;
if (foldlen || uc < (U8*)strend) {
- REXEC_TRIE_READ_CHAR(trie_type, trie,
- widecharmap, uc,
- uscan, len, uvc, charid, foldlen,
- foldbuf, uniflags);
+ REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
+ (U8 *) strend, uscan, len, uvc,
+ charid, foldlen, foldbuf,
+ uniflags);
DEBUG_TRIE_EXECUTE_r({
dump_exec_pos( (char *)uc, c, strend,
real_start, s, utf8_target, 0);
@@ -5511,8 +5513,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
if ( base && (foldlen || uc < (U8*)(reginfo->strend))) {
I32 offset;
REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc,
- uscan, len, uvc, charid, foldlen,
- foldbuf, uniflags);
+ (U8 *) reginfo->strend, uscan,
+ len, uvc, charid, foldlen,
+ foldbuf, uniflags);
charcount++;
if (foldlen>0)
ST.longfold = TRUE;
@@ -5642,8 +5645,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
while (foldlen) {
if (!--chars)
break;
- uvc = utf8n_to_uvchr(uscan, UTF8_MAXLEN, &len,
- uniflags);
+ uvc = utf8n_to_uvchr(uscan, foldlen, &len,
+ uniflags);
uscan += len;
foldlen -= len;
}
diff --git a/t/lib/warnings/regexec b/t/lib/warnings/regexec
index 900dd6ee7f..6635142dea 100644
--- a/t/lib/warnings/regexec
+++ b/t/lib/warnings/regexec
@@ -260,3 +260,10 @@ setlocale(&POSIX::LC_CTYPE, $utf8_locale);
"k" =~ /(?[ \N{KELVIN SIGN} ])/i;
":" =~ /(?[ \: ])/;
EXPECT
+########
+# NAME perl #132063, read beyond buffer end
+# OPTION fatal
+"\xff" =~ /(?il)\x{100}|\x{100}/;
+EXPECT
+Malformed UTF-8 character: \xff (too short; 1 byte available, need 13) in pattern match (m//) at - line 2.
+Malformed UTF-8 character (fatal) at - line 2.
--
2.15.1-424-g9478a660812

143 changes: 143 additions & 0 deletions core-perl/perl/autobuild/patches/CVE-2018-6913.patch
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,143 @@
From a9d5c6e11891b48be06d4e06eeed18642bc98527 Mon Sep 17 00:00:00 2001
From: Tony Cook <[email protected]>
Date: Tue, 8 Aug 2017 09:32:58 +1000
Subject: [PATCH] (perl #131844) fix various space calculation issues in
pp_pack.c

- for the originally reported case, if the start/cur pointer is in the
top 75% of the address space the add (cur) + glen addition would
overflow, resulting in the condition failing incorrectly.

- the addition of the existing space used to the space needed could
overflow, resulting in too small an allocation and a buffer overflow.

- the scaling for UTF8 could overflow.

- the multiply to calculate the space needed for many items could
overflow.

For the first case, do a space calculation without making new pointers.

For the other cases, detect the overflow and croak if there's an
overflow.

Originally this used Size_t_MAX as the maximum size of a memory
allocation, but for -DDEBUGGING builds realloc() throws a panic for
allocations over half the address space in size, changing the error
reported for the allocation.

For non-DEBUGGING builds the Size_t_MAX limit has the small chance
of finding a system that has 3GB of contiguous space available, and
allocating that space, which could be a denial of servce in some cases.

Unfortunately changing the limit to half the address space means that
the exact case with the original issue can no longer occur, so the
test is no longer testing against the address + length issue that
caused the original problem, since the allocation is failing earlier.

One option would be to change the test so the size request by pack is
just under 2GB, but this has a higher (but still low) probability that
the system has the address space available, and will actually try to
allocate the memory, so let's not do that.

(cherry picked from commit f5506feddde8546eabb69d71569d856c7e9c615b)
---
pp_pack.c | 25 +++++++++++++++++++++----
t/op/pack.t | 24 +++++++++++++++++++++++-
2 files changed, 44 insertions(+), 5 deletions(-)

diff --git a/pp_pack.c b/pp_pack.c
index f6964c3f30..c0de5ab82b 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -358,11 +358,28 @@ STMT_START { \
} \
} STMT_END

+#define SAFE_UTF8_EXPAND(var) \
+STMT_START { \
+ if ((var) > SSize_t_MAX / UTF8_EXPAND) \
+ Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+ (var) = (var) * UTF8_EXPAND; \
+} STMT_END
+
+#define GROWING2(utf8, cat, start, cur, item_size, item_count) \
+STMT_START { \
+ if (SSize_t_MAX / (item_size) < (item_count)) \
+ Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+ GROWING((utf8), (cat), (start), (cur), (item_size) * (item_count)); \
+} STMT_END
+
#define GROWING(utf8, cat, start, cur, in_len) \
STMT_START { \
STRLEN glen = (in_len); \
- if (utf8) glen *= UTF8_EXPAND; \
- if ((cur) + glen >= (start) + SvLEN(cat)) { \
+ STRLEN catcur = (STRLEN)((cur) - (start)); \
+ if (utf8) SAFE_UTF8_EXPAND(glen); \
+ if (SSize_t_MAX - glen < catcur) \
+ Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+ if (catcur + glen >= SvLEN(cat)) { \
(start) = sv_exp_grow(cat, glen); \
(cur) = (start) + SvCUR(cat); \
} \
@@ -372,7 +389,7 @@ STMT_START { \
STMT_START { \
const STRLEN glen = (in_len); \
STRLEN gl = glen; \
- if (utf8) gl *= UTF8_EXPAND; \
+ if (utf8) SAFE_UTF8_EXPAND(gl); \
if ((cur) + gl >= (start) + SvLEN(cat)) { \
*cur = '\0'; \
SvCUR_set((cat), (cur) - (start)); \
@@ -2126,7 +2143,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
if (props && !(props & PACK_SIZE_UNPREDICTABLE)) {
/* We can process this letter. */
STRLEN size = props & PACK_SIZE_MASK;
- GROWING(utf8, cat, start, cur, (STRLEN) len * size);
+ GROWING2(utf8, cat, start, cur, size, (STRLEN)len);
}
}

diff --git a/t/op/pack.t b/t/op/pack.t
index a2da63689b..a480c3ad7f 100644
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' :
my $no_signedness = $] > 5.009 ? '' :
"Signed/unsigned pack modifiers not available on this perl";

-plan tests => 14712;
+plan tests => 14716;

use strict;
use warnings qw(FATAL all);
@@ -2044,3 +2044,25 @@ ok(1, "argument underflow did not crash");
is(pack("H40", $up_nul), $twenty_nuls,
"check pack H zero fills (utf8 source)");
}
+
+SKIP:
+{
+ # [perl #131844] pointer addition overflow
+ $Config{ptrsize} == 4
+ or skip "[perl #131844] need 32-bit build for this test", 4;
+ # prevent ASAN just crashing on the allocation failure
+ local $ENV{ASAN_OPTIONS} = $ENV{ASAN_OPTIONS};
+ $ENV{ASAN_OPTIONS} .= ",allocator_may_return_null=1";
+ fresh_perl_like('pack "f999999999"', qr/Out of memory during pack/, { stderr => 1 },
+ "pointer addition overflow");
+
+ # integer (STRLEN) overflow from addition of glen to current length
+ fresh_perl_like('pack "c10f1073741823"', qr/Out of memory during pack/, { stderr => 1 },
+ "integer overflow calculating allocation (addition)");
+
+ fresh_perl_like('pack "W10f536870913", 256', qr/Out of memory during pack/, { stderr => 1 },
+ "integer overflow calculating allocation (utf8)");
+
+ fresh_perl_like('pack "c10f1073741824"', qr/Out of memory during pack/, { stderr => 1 },
+ "integer overflow calculating allocation (multiply)");
+}
--
2.15.1-424-g9478a660812

6 changes: 6 additions & 0 deletions core-perl/perl/autobuild/prepare
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,3 +3,9 @@
# with AB_FLAGS_SPECS=0.
export CFLAGS="${CFLAGS} -fPIC"
export CXXFLAGS="${CXXFLAGS} -fPIC"

# Use system dependencies.
sed -i -e "s|BUILD_ZLIB\s*= True|BUILD_ZLIB = False|" \
-e "s|INCLUDE\s*= ./zlib-src|INCLUDE = /usr/include|" \
-e "s|LIB\s*= ./zlib-src|LIB = /usr/lib|" \
cpan/Compress-Raw-Zlib/config.in
1 change: 1 addition & 0 deletions core-perl/perl/spec
View file
Original file line number Diff line number Diff line change
@@ -1,2 +1,3 @@
VER=5.24.3
REL=1
SRCTBL="http://search.cpan.org/CPAN/authors/id/S/SH/SHAY/perl-$VER.tar.gz"

0 comments on commit 46963ba

Please sign in to comment.