untrusted comment: signature from openbsd 6.1 base secret key RWQEQa33SgQSEmJiJU4pCbplUJGAH3bxzMn4oiciZBpI4Ucc/NjDa/520Z1YRn0Urt20os6PMAx3V3V+bUWzsdKP8faDOhGCHQg= OpenBSD 6.1 errata 039, 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-61-base.pub -x 039_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:18 -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.22.4.1 diff -u -p -r1.22.4.1 regcomp.c --- gnu/usr.bin/perl/regcomp.c 22 Sep 2017 23:15:26 -0000 1.22.4.1 +++ gnu/usr.bin/perl/regcomp.c 24 Mar 2018 22:25:19 -0000 @@ -13319,6 +13319,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.21 diff -u -p -r1.21 regexec.c --- gnu/usr.bin/perl/regexec.c 5 Feb 2017 00:31:53 -0000 1.21 +++ gnu/usr.bin/perl/regexec.c 24 Mar 2018 22:25:20 -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:20 -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:21 -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)"); }