untrusted comment: signature from openbsd 6.3 base secret key

untrusted comment: signature from openbsd 6.3 base secret key
RWRxzbLwAd76ZTObQY7HOmQ+VKZdvmQb1cF7qN9gqYqmrbzeLyZtd+NLMdegPgXay3/j5cn2wu4CfSvXPHNkdUzth/2N9E6IIgM=

OpenBSD 6.3 errata 001, April 14, 2018:

Heap overflows exist in perl which can lead to segmentation faults,
crashes, and reading memory past the buffer. Embargoed by perl for 53 days.

Apply by doing:
signify -Vep /etc/signify/openbsd-63-base.pub -x 001_perl.patch.sig \
-m - | (cd /usr/src && patch -p0)

And then rebuild and install perl:
cd /usr/src/gnu/usr.bin/perl/
make -f Makefile.bsd-wrapper obj
make -f Makefile.bsd-wrapper depend
make -f Makefile.bsd-wrapper
make -f Makefile.bsd-wrapper install

Index: gnu/usr.bin/perl/pp_pack.c
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/pp_pack.c,v
retrieving revision 1.2
diff -u -p -r1.2 pp_pack.c
--- gnu/usr.bin/perl/pp_pack.c 5 Feb 2017 00:31:53 -0000 1.2
+++ gnu/usr.bin/perl/pp_pack.c 24 Mar 2018 22:25:16 -0000
@@ -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* sym
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);
}
}

Index: gnu/usr.bin/perl/regcomp.c
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/regcomp.c,v
retrieving revision 1.24
diff -u -p -r1.24 regcomp.c
--- gnu/usr.bin/perl/regcomp.c 29 Oct 2017 22:37:16 -0000 1.24
+++ gnu/usr.bin/perl/regcomp.c 24 Mar 2018 22:25:18 -0000
@@ -13323,6 +13323,18 @@ S_regatom(pTHX_ RExC_state_t *pRExC_stat
* /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;
}
Index: gnu/usr.bin/perl/regexec.c
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/regexec.c,v
retrieving revision 1.22
diff -u -p -r1.22 regexec.c
--- gnu/usr.bin/perl/regexec.c 14 Aug 2017 13:48:45 -0000 1.22
+++ gnu/usr.bin/perl/regexec.c 24 Mar 2018 22:25:19 -0000
@@ -1451,7 +1451,7 @@ Perl_re_intuit_start(pTHX_
#define DECL_TRIE_TYPE(scan) \
const enum { trie_plain, trie_utf8, trie_utf8_fold, trie_latin_utf8_fold, \
trie_utf8_exactfa_fold, trie_latin_utf8_exactfa_fold, \
- trie_utf8l, trie_flu8 } \
+ trie_utf8l, trie_flu8, trie_flu8_latin } \
trie_type = ((scan->flags == EXACT) \
? (utf8_target ? trie_utf8 : trie_plain) \
: (scan->flags == EXACTL) \
@@ -1461,20 +1461,24 @@ Perl_re_intuit_start(pTHX_
? trie_utf8_exactfa_fold \
: trie_latin_utf8_exactfa_fold) \
: (scan->flags == EXACTFLU8 \
- ? trie_flu8 \
+ ? (utf8_target \
+ ? trie_flu8 \
+ : trie_flu8_latin) \
: (utf8_target \
? trie_utf8_fold \
- : trie_latin_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; \
switch (trie_type) { \
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)); \
+ if (UTF8_IS_ABOVE_LATIN1(*uc)) { \
+ _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(uc, uc_end - uc); \
} \
goto do_trie_utf8_fold; \
case trie_utf8_exactfa_fold: \
@@ -1483,7 +1487,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; \
@@ -1495,12 +1499,16 @@ STMT_START {
uscan = foldbuf + skiplen; \
} \
break; \
+ case trie_flu8_latin: \
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE; \
+ goto do_trie_latin_utf8_fold; \
case trie_latin_utf8_exactfa_fold: \
flags |= FOLD_FLAGS_NOMIX_ASCII; \
/* FALLTHROUGH */ \
case trie_latin_utf8_fold: \
+ do_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 +1527,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 +2607,10 @@ S_find_byclass(pTHX_ regexp * prog, cons
}
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 +5519,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo,
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 +5651,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo,
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;
}
Index: gnu/usr.bin/perl/t/lib/warnings/regexec
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/t/lib/warnings/regexec,v
retrieving revision 1.2
diff -u -p -r1.2 regexec
--- gnu/usr.bin/perl/t/lib/warnings/regexec 5 Feb 2017 00:32:20 -0000 1.2
+++ gnu/usr.bin/perl/t/lib/warnings/regexec 24 Mar 2018 22:25:19 -0000
@@ -260,3 +260,7 @@ setlocale(&POSIX::LC_CTYPE, $utf8_locale
"k" =~ /(?[ \N{KELVIN SIGN} ])/i;
":" =~ /(?[ \: ])/;
EXPECT
+########
+# NAME perl #132063, read beyond buffer end
+"\xff" =~ /(?il)\x{100}|\x{100}/;
+EXPECT
Index: gnu/usr.bin/perl/t/op/pack.t
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/t/op/pack.t,v
retrieving revision 1.14
diff -u -p -r1.14 pack.t
--- gnu/usr.bin/perl/t/op/pack.t 5 Feb 2017 00:32:20 -0000 1.14
+++ gnu/usr.bin/perl/t/op/pack.t 24 Mar 2018 22:25:19 -0000
@@ -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);
@@ -2043,4 +2043,26 @@ ok(1, "argument underflow did not crash"
"check pack H zero fills (utf8 none)");
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)");
}
Index: gnu/usr.bin/perl/t/re/re_tests
===================================================================
RCS file: /cvs/src/gnu/usr.bin/perl/t/re/re_tests,v
retrieving revision 1.4
diff -u -p -r1.4 re_tests
--- gnu/usr.bin/perl/t/re/re_tests 29 Oct 2017 22:37:24 -0000 1.4
+++ gnu/usr.bin/perl/t/re/re_tests 24 Mar 2018 22:25:20 -0000
@@ -1968,6 +1968,7 @@ ab(?#Comment){2}c abbc y $& abbc
(?:.||)(?|)000000000@ 000000000@ y $& 000000000@ # [perl #126405]
aa$|a(?R)a|a aaa y $& aaa # [perl 128420] recursive matches
(?:\1|a)([bcd])\1(?:(?R)|e)\1 abbaccaddedcb y $& abbaccaddedcb # [perl 128420] recursive match with backreferences
+(?il)\x{100}|\x{100}|\x{FF} \xFF y $& \xFF

# Keep these lines at the end of the file
# vim: softtabstop=0 noexpandtab