From f1d3f3a2923a49d67b36104bb5f7f63383f64831 Mon Sep 17 00:00:00 2001 From: Andrew Fresh Date: Thu, 29 Nov 2018 19:33:17 +0000 Subject: Fix various overflows in perl Addresses: * CVE-2018-18311 (Perl RT #133204) * CVE-2018-18312 (Perl RT #133423) * CVE-2018-18313 (Perl RT #133192) * CVE-2018-18314 (Perl RT #131649) --- gnu/usr.bin/perl/pod/perldiag.pod | 27 +++++++++++- gnu/usr.bin/perl/pod/perlrecharclass.pod | 4 +- gnu/usr.bin/perl/regcomp.c | 40 ++++++++++------- gnu/usr.bin/perl/t/lib/warnings/regcomp | 6 +-- gnu/usr.bin/perl/t/re/reg_mesg.t | 29 ++++++------ gnu/usr.bin/perl/t/re/regex_sets.t | 6 +-- gnu/usr.bin/perl/util.c | 76 ++++++++++++++++++++++---------- 7 files changed, 128 insertions(+), 60 deletions(-) (limited to 'gnu/usr.bin') diff --git a/gnu/usr.bin/perl/pod/perldiag.pod b/gnu/usr.bin/perl/pod/perldiag.pod index 737d3633f67..644b8140086 100644 --- a/gnu/usr.bin/perl/pod/perldiag.pod +++ b/gnu/usr.bin/perl/pod/perldiag.pod @@ -5777,7 +5777,7 @@ yourself. a perl4 interpreter, especially if the next 2 tokens are "use strict" or "my $var" or "our $var". -=item Syntax error in (?[...]) in regex m/%s/ +=item Syntax error in (?[...]) in regex; marked by <-- HERE in m/%s/ (F) Perl could not figure out what you meant inside this construct; this notifies you that it is giving up trying. @@ -6153,6 +6153,31 @@ for example, (F) The unexec() routine failed for some reason. See your local FSF representative, who probably put it there in the first place. +=item Unexpected ']' with no following ')' in (?[... in regex; marked by <-- HERE in m/%s/ + +(F) While parsing an extended character class a ']' character was encountered +at a point in the definition where the only legal use of ']' is to close the +character class definition as part of a '])', you may have forgotten the close +paren, or otherwise confused the parser. + +=item Expecting close paren for nested extended charclass in regex; marked by <-- HERE in m/%s/ + +(F) While parsing a nested extended character class like: + + (?[ ... (?flags:(?[ ... ])) ... ]) + ^ + +we expected to see a close paren ')' (marked by ^) but did not. + +=item Expecting close paren for wrapper for nested extended charclass in regex; marked by <-- HERE in m/%s/ + +(F) While parsing a nested extended character class like: + + (?[ ... (?flags:(?[ ... ])) ... ]) + ^ + +we expected to see a close paren ')' (marked by ^) but did not. + =item Unexpected binary operator '%c' with no preceding operand in regex; marked by S<<-- HERE> in m/%s/ diff --git a/gnu/usr.bin/perl/pod/perlrecharclass.pod b/gnu/usr.bin/perl/pod/perlrecharclass.pod index 89f4a7ef3f9..a557cc0384c 100644 --- a/gnu/usr.bin/perl/pod/perlrecharclass.pod +++ b/gnu/usr.bin/perl/pod/perlrecharclass.pod @@ -1101,8 +1101,8 @@ hence both of the following work: Any contained POSIX character classes, including things like C<\w> and C<\D> respect the Ca> (and Caa>) modifiers. -C<< (?[ ]) >> is a regex-compile-time construct. Any attempt to use -something which isn't knowable at the time the containing regular +Note that C<< (?[ ]) >> is a regex-compile-time construct. Any attempt +to use something which isn't knowable at the time the containing regular expression is compiled is a fatal error. In practice, this means just three limitations: diff --git a/gnu/usr.bin/perl/regcomp.c b/gnu/usr.bin/perl/regcomp.c index d79bd191c90..0a372d0a3e4 100644 --- a/gnu/usr.bin/perl/regcomp.c +++ b/gnu/usr.bin/perl/regcomp.c @@ -11783,7 +11783,8 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, RExC_parse++; /* Skip past the '{' */ - if (! (endbrace = strchr(RExC_parse, '}')) /* no trailing brace */ + endbrace = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse); + if ((! endbrace) /* no trailing brace */ || ! (endbrace == RExC_parse /* nothing between the {} */ || (endbrace - RExC_parse >= 2 /* U+ (bad hex is checked... */ && strnEQ(RExC_parse, "U+", 2)))) /* ... below for a better @@ -12483,9 +12484,11 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) else { STRLEN length; char name = *RExC_parse; - char * endbrace; + char * endbrace = NULL; RExC_parse += 2; - endbrace = strchr(RExC_parse, '}'); + if (RExC_parse < RExC_end) { + endbrace = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse); + } if (! endbrace) { vFAIL2("Missing right brace on \\%c{}", name); @@ -14606,8 +14609,9 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, TRUE /* Force /x */ ); switch (*RExC_parse) { - case '?': - if (RExC_parse[1] == '[') depth++, RExC_parse++; + case '(': + if (RExC_parse[1] == '?' && RExC_parse[2] == '[') + depth++, RExC_parse+=2; /* FALLTHROUGH */ default: break; @@ -14664,9 +14668,9 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, } case ']': - if (depth--) break; - RExC_parse++; - if (*RExC_parse == ')') { + if (RExC_parse[1] == ')') { + RExC_parse++; + if (depth--) break; node = reganode(pRExC_state, ANYOF, 0); RExC_size += ANYOF_SKIP; nextchar(pRExC_state); @@ -14678,20 +14682,25 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, return node; } - goto no_close; + /* We output the messages even if warnings are off, because we'll fail + * the very next thing, and these give a likely diagnosis for that */ + if (posix_warnings && (__ASSERT_(SvTYPE(posix_warnings) == SVt_PVAV) AvFILLp(posix_warnings)) >= 0) { + output_or_return_posix_warnings(pRExC_state, posix_warnings, NULL); + } + RExC_parse++; + vFAIL("Unexpected ']' with no following ')' in (?[..."); } RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1; } - no_close: /* We output the messages even if warnings are off, because we'll fail * the very next thing, and these give a likely diagnosis for that */ if (posix_warnings && av_tindex_nomg(posix_warnings) >= 0) { output_or_return_posix_warnings(pRExC_state, posix_warnings, NULL); } - FAIL("Syntax error in (?[...])"); + vFAIL("Syntax error in (?[...])"); } /* Pass 2 only after this. */ @@ -14865,14 +14874,15 @@ redo_curchar: * inversion list, and RExC_parse points to the trailing * ']'; the next character should be the ')' */ RExC_parse++; - assert(UCHARAT(RExC_parse) == ')'); + if (UCHARAT(RExC_parse) != ')') + vFAIL("Expecting close paren for nested extended charclass"); /* Then the ')' matching the original '(' handled by this * case: statement */ RExC_parse++; - assert(UCHARAT(RExC_parse) == ')'); + if (UCHARAT(RExC_parse) != ')') + vFAIL("Expecting close paren for wrapper for nested extended charclass"); - RExC_parse++; RExC_flags = save_flags; goto handle_operand; } @@ -15938,7 +15948,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, vFAIL2("Empty \\%c", (U8)value); if (*RExC_parse == '{') { const U8 c = (U8)value; - e = strchr(RExC_parse, '}'); + e = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse); if (!e) { RExC_parse++; vFAIL2("Missing right brace on \\%c{}", c); diff --git a/gnu/usr.bin/perl/t/lib/warnings/regcomp b/gnu/usr.bin/perl/t/lib/warnings/regcomp index 08cb27b00f1..367276d0fc8 100644 --- a/gnu/usr.bin/perl/t/lib/warnings/regcomp +++ b/gnu/usr.bin/perl/t/lib/warnings/regcomp @@ -59,21 +59,21 @@ Unmatched [ in regex; marked by <-- HERE in m/abc[ <-- HERE fi[.00./ at - line qr/(?[[[:word]]])/; EXPECT Assuming NOT a POSIX class since there is no terminating ':' in regex; marked by <-- HERE in m/(?[[[:word <-- HERE ]]])/ at - line 2. -syntax error in (?[...]) in regex m/(?[[[:word]]])/ at - line 2. +Unexpected ']' with no following ')' in (?[... in regex; marked by <-- HERE in m/(?[[[:word]] <-- HERE ])/ at - line 2. ######## # NAME qr/(?[ [[:digit: ])/ # OPTION fatal qr/(?[[[:digit: ])/; EXPECT Assuming NOT a POSIX class since no blanks are allowed in one in regex; marked by <-- HERE in m/(?[[[:digit: ] <-- HERE )/ at - line 2. -syntax error in (?[...]) in regex m/(?[[[:digit: ])/ at - line 2. +syntax error in (?[...]) in regex; marked by <-- HERE in m/(?[[[:digit: ]) <-- HERE / at - line 2. ######## # NAME qr/(?[ [:digit: ])/ # OPTION fatal qr/(?[[:digit: ])/ EXPECT Assuming NOT a POSIX class since no blanks are allowed in one in regex; marked by <-- HERE in m/(?[[:digit: ] <-- HERE )/ at - line 2. -syntax error in (?[...]) in regex m/(?[[:digit: ])/ at - line 2. +syntax error in (?[...]) in regex; marked by <-- HERE in m/(?[[:digit: ]) <-- HERE / at - line 2. ######## # NAME [perl #126141] # OPTION fatal diff --git a/gnu/usr.bin/perl/t/re/reg_mesg.t b/gnu/usr.bin/perl/t/re/reg_mesg.t index 08d90c5c40c..7255d514197 100755 --- a/gnu/usr.bin/perl/t/re/reg_mesg.t +++ b/gnu/usr.bin/perl/t/re/reg_mesg.t @@ -200,8 +200,9 @@ my @death = '/\b{gc}/' => "'gc' is an unknown bound type {#} m/\\b{gc{#}}/", '/\B{gc}/' => "'gc' is an unknown bound type {#} m/\\B{gc{#}}/", - '/(?[[[::]]])/' => "Syntax error in (?[...]) in regex m/(?[[[::]]])/", - '/(?[[[:w:]]])/' => "Syntax error in (?[...]) in regex m/(?[[[:w:]]])/", + + '/(?[[[::]]])/' => "Unexpected ']' with no following ')' in (?[... {#} m/(?[[[::]]{#}])/", + '/(?[[[:w:]]])/' => "Unexpected ']' with no following ')' in (?[... {#} m/(?[[[:w:]]{#}])/", '/(?[[:w:]])/' => "", '/[][[:alpha:]]' => "", # [perl #127581] '/([.].*)[.]/' => "", # [perl #127582] @@ -225,11 +226,12 @@ my @death = '/(?[ \p{foo} ])/' => 'Can\'t find Unicode property definition "foo" {#} m/(?[ \p{foo}{#} ])/', '/(?[ \p{ foo = bar } ])/' => 'Can\'t find Unicode property definition "foo = bar" {#} m/(?[ \p{ foo = bar }{#} ])/', '/(?[ \8 ])/' => 'Unrecognized escape \8 in character class {#} m/(?[ \8{#} ])/', - '/(?[ \t ]/' => 'Syntax error in (?[...]) in regex m/(?[ \t ]/', - '/(?[ [ \t ]/' => 'Syntax error in (?[...]) in regex m/(?[ [ \t ]/', - '/(?[ \t ] ]/' => 'Syntax error in (?[...]) in regex m/(?[ \t ] ]/', - '/(?[ [ ] ]/' => 'Syntax error in (?[...]) in regex m/(?[ [ ] ]/', - '/(?[ \t + \e # This was supposed to be a comment ])/' => 'Syntax error in (?[...]) in regex m/(?[ \t + \e # This was supposed to be a comment ])/', + '/(?[ \t ]/' => "Unexpected ']' with no following ')' in (?[... {#} m/(?[ \\t ]{#}/", + '/(?[ [ \t ]/' => "Syntax error in (?[...]) {#} m/(?[ [ \\t ]{#}/", + '/(?[ \t ] ]/' => "Unexpected ']' with no following ')' in (?[... {#} m/(?[ \\t ]{#} ]/", + '/(?[ [ ] ]/' => "Syntax error in (?[...]) {#} m/(?[ [ ] ]{#}/", + '/(?[ \t + \e # This was supposed to be a comment ])/' => + "Syntax error in (?[...]) {#} m/(?[ \\t + \\e # This was supposed to be a comment ]){#}/", '/(?[ ])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[ {#}])/', 'm/(?[[a-\d]])/' => 'False [] range "a-\d" {#} m/(?[[a-\d{#}]])/', 'm/(?[[\w-x]])/' => 'False [] range "\w-" {#} m/(?[[\w-{#}x]])/', @@ -405,10 +407,10 @@ my @death_utf8 = mark_as_utf8( '/ネ\p{}ネ/' => 'Empty \p{} {#} m/ネ\p{{#}}ネ/', - '/ネ(?[[[:ネ]]])ネ/' => "Syntax error in (?[...]) in regex m/ネ(?[[[:ネ]]])ネ/", - '/ネ(?[[[:ネ: ])ネ/' => "Syntax error in (?[...]) in regex m/ネ(?[[[:ネ: ])ネ/", - '/ネ(?[[[::]]])ネ/' => "Syntax error in (?[...]) in regex m/ネ(?[[[::]]])ネ/", - '/ネ(?[[[:ネ:]]])ネ/' => "Syntax error in (?[...]) in regex m/ネ(?[[[:ネ:]]])ネ/", + '/ネ(?[[[:ネ]]])ネ/' => "Unexpected ']' with no following ')' in (?[... {#} m/ネ(?[[[:ネ]]{#}])ネ/", + '/ネ(?[[[:ネ: ])ネ/' => "Syntax error in (?[...]) {#} m/ネ(?[[[:ネ: ])ネ{#}/", + '/ネ(?[[[::]]])ネ/' => "Unexpected ']' with no following ')' in (?[... {#} m/ネ(?[[[::]]{#}])ネ/", + '/ネ(?[[[:ネ:]]])ネ/' => "Unexpected ']' with no following ')' in (?[... {#} m/ネ(?[[[:ネ:]]{#}])ネ/", '/ネ(?[[:ネ:]])ネ/' => "", '/ネ(?[ネ])ネ/' => 'Unexpected character {#} m/ネ(?[ネ{#}])ネ/', '/ネ(?[ + [ネ] ])/' => 'Unexpected binary operator \'+\' with no preceding operand {#} m/ネ(?[ +{#} [ネ] ])/', @@ -421,8 +423,9 @@ my @death_utf8 = mark_as_utf8( '/(?[ \x{ネ} ])ネ/' => 'Non-hex character {#} m/(?[ \x{ネ{#}} ])ネ/', '/(?[ \p{ネ} ])/' => 'Can\'t find Unicode property definition "ネ" {#} m/(?[ \p{ネ}{#} ])/', '/(?[ \p{ ネ = bar } ])/' => 'Can\'t find Unicode property definition "ネ = bar" {#} m/(?[ \p{ ネ = bar }{#} ])/', - '/ネ(?[ \t ]/' => 'Syntax error in (?[...]) in regex m/ネ(?[ \t ]/', - '/(?[ \t + \e # ネ This was supposed to be a comment ])/' => 'Syntax error in (?[...]) in regex m/(?[ \t + \e # ネ This was supposed to be a comment ])/', + '/ネ(?[ \t ]/' => "Unexpected ']' with no following ')' in (?[... {#} m/ネ(?[ \\t ]{#}/", + '/(?[ \t + \e # ネ This was supposed to be a comment ])/' => + "Syntax error in (?[...]) {#} m/(?[ \\t + \\e # ネ This was supposed to be a comment ]){#}/", 'm/(*ネ)ネ/' => q, '/\cネ/' => "Character following \"\\c\" must be printable ASCII", '/\b{ネ}/' => "'ネ' is an unknown bound type {#} m/\\b{ネ{#}}/", diff --git a/gnu/usr.bin/perl/t/re/regex_sets.t b/gnu/usr.bin/perl/t/re/regex_sets.t index 92875677be3..60a126ba3c0 100644 --- a/gnu/usr.bin/perl/t/re/regex_sets.t +++ b/gnu/usr.bin/perl/t/re/regex_sets.t @@ -157,13 +157,13 @@ for my $char ("٠", "٥", "٩") { eval { $_ = '/(?[(\c]) /'; qr/$_/ }; like($@, qr/^Syntax error/, '/(?[(\c]) / should not panic'); eval { $_ = '(?[\c#]' . "\n])"; qr/$_/ }; - like($@, qr/^Syntax error/, '/(?[(\c]) / should not panic'); + like($@, qr/^Unexpected/, '/(?[(\c]) / should not panic'); eval { $_ = '(?[(\c])'; qr/$_/ }; like($@, qr/^Syntax error/, '/(?[(\c])/ should be a syntax error'); eval { $_ = '(?[(\c]) ]\b'; qr/$_/ }; - like($@, qr/^Syntax error/, '/(?[(\c]) ]\b/ should be a syntax error'); + like($@, qr/^Unexpected/, '/(?[(\c]) ]\b/ should be a syntax error'); eval { $_ = '(?[\c[]](])'; qr/$_/ }; - like($@, qr/^Syntax error/, '/(?[\c[]](])/ should be a syntax error'); + like($@, qr/^Unexpected/, '/(?[\c[]](])/ should be a syntax error'); like("\c#", qr/(?[\c#])/, '\c# should match itself'); like("\c[", qr/(?[\c[])/, '\c[ should match itself'); like("\c\ ", qr/(?[\c\])/, '\c\ should match itself'); diff --git a/gnu/usr.bin/perl/util.c b/gnu/usr.bin/perl/util.c index edcf3c8d82d..d45058d2e0e 100644 --- a/gnu/usr.bin/perl/util.c +++ b/gnu/usr.bin/perl/util.c @@ -2160,8 +2160,40 @@ Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits, *(s+(nlen+1+vlen)) = '\0' #ifdef USE_ENVIRON_ARRAY - /* VMS' my_setenv() is in vms.c */ + +/* small wrapper for use by Perl_my_setenv that mallocs, or reallocs if + * 'current' is non-null, with up to three sizes that are added together. + * It handles integer overflow. + */ +static char * +S_env_alloc(void *current, Size_t l1, Size_t l2, Size_t l3, Size_t size) +{ + void *p; + Size_t sl, l = l1 + l2; + + if (l < l2) + goto panic; + l += l3; + if (l < l3) + goto panic; + sl = l * size; + if (sl < l) + goto panic; + + p = current + ? safesysrealloc(current, sl) + : safesysmalloc(sl); + if (p) + return (char*)p; + + panic: + croak_memory_wrap(); +} + + +/* VMS' my_setenv() is in vms.c */ #if !defined(WIN32) && !defined(NETWARE) + void Perl_my_setenv(pTHX_ const char *nam, const char *val) { @@ -2177,28 +2209,27 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) #ifndef PERL_USE_SAFE_PUTENV if (!PL_use_safe_putenv) { /* most putenv()s leak, so we manipulate environ directly */ - I32 i; - const I32 len = strlen(nam); - int nlen, vlen; + UV i; + Size_t vlen, nlen = strlen(nam); /* where does it go? */ for (i = 0; environ[i]; i++) { - if (strnEQ(environ[i],nam,len) && environ[i][len] == '=') + if (strnEQ(environ[i], nam, nlen) && environ[i][nlen] == '=') break; } if (environ == PL_origenviron) { /* need we copy environment? */ - I32 j; - I32 max; + UV j, max; char **tmpenv; max = i; while (environ[max]) max++; - tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*)); + /* XXX shouldn't that be max+1 rather than max+2 ??? - DAPM */ + tmpenv = (char**)S_env_alloc(NULL, max, 2, 0, sizeof(char*)); for (j=0; j