diff -Nru perl-5.22.1/debian/changelog perl-5.22.1/debian/changelog --- perl-5.22.1/debian/changelog 2018-06-13 12:22:39.000000000 +0000 +++ perl-5.22.1/debian/changelog 2018-11-19 18:30:29.000000000 +0000 @@ -1,3 +1,24 @@ +perl (5.22.1-9ubuntu0.6) xenial-security; urgency=medium + + * SECURITY UPDATE: Integer overflow leading to buffer overflow + - debian/patches/fixes/CVE-2018-18311.patch: handle integer wrap in + util.c. + - CVE-2018-18311 + * SECURITY UPDATE: Heap-buffer-overflow write / reg_node overrun + - debian/patches/fixes/CVE-2018-18312.patch: fix logic in regcomp.c. + - CVE-2018-18312 + * SECURITY UPDATE: Heap-buffer-overflow read + - debian/patches/fixes/CVE-2018-18313.patch: convert some strchr to + memchr in regcomp.c. + - CVE-2018-18313 + * SECURITY UPDATE: Heap-based buffer overflow + - debian/patches/fixes/CVE-2018-18314.patch: fix extended charclass in + pod/perldiag.pod, pod/perlrecharclass.pod, regcomp.c, + t/re/reg_mesg.t, t/re/regex_sets.t. + - CVE-2018-18314 + + -- Marc Deslauriers Mon, 19 Nov 2018 13:29:35 -0500 + perl (5.22.1-9ubuntu0.5) xenial-security; urgency=medium * SECURITY UPDATE: Directory traversal vulnerability diff -Nru perl-5.22.1/debian/patches/fixes/CVE-2018-18311.patch perl-5.22.1/debian/patches/fixes/CVE-2018-18311.patch --- perl-5.22.1/debian/patches/fixes/CVE-2018-18311.patch 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.22.1/debian/patches/fixes/CVE-2018-18311.patch 2018-11-19 18:10:23.000000000 +0000 @@ -0,0 +1,172 @@ +From 34716e2a6ee2af96078d62b065b7785c001194be Mon Sep 17 00:00:00 2001 +From: David Mitchell +Date: Fri, 29 Jun 2018 13:37:03 +0100 +Subject: [PATCH] Perl_my_setenv(); handle integer wrap + +RT #133204 + +Wean this function off int/I32 and onto UV/Size_t. +Also, replace all malloc-ish calls with a wrapper that does +overflow checks, + +In particular, it was doing (nlen + vlen + 2) which could wrap when +the combined length of the environment variable name and value +exceeded around 0x7fffffff. + +The wrapper check function is probably overkill, but belt and braces... + +NB this function has several variant parts, #ifdef'ed by platform +type; I have blindly changed the parts that aren't compiled under linux. +--- + util.c | 76 ++++++++++++++++++++++++++++++++++++++++------------------ + 1 file changed, 53 insertions(+), 23 deletions(-) + +Index: perl-5.22.1/util.c +=================================================================== +--- perl-5.22.1.orig/util.c 2018-11-19 13:10:21.146603078 -0500 ++++ perl-5.22.1/util.c 2018-11-19 13:10:21.146603078 -0500 +@@ -2043,8 +2043,40 @@ Perl_new_warnings_bitfield(pTHX_ STRLEN + *(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) + { +@@ -2057,28 +2089,27 @@ Perl_my_setenv(pTHX_ const char *nam, co + #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 +Date: Mon, 24 Sep 2018 11:54:41 -0600 +Subject: [PATCH 242/242] PATCH: [perl #133423] for 5.26 maint + +--- + regcomp.c | 1 - + t/re/reg_mesg.t | 4 ++++ + 2 files changed, 4 insertions(+), 1 deletion(-) + +Index: perl-5.22.1/regcomp.c +=================================================================== +--- perl-5.22.1.orig/regcomp.c 2018-11-19 13:10:48.986608390 -0500 ++++ perl-5.22.1/regcomp.c 2018-11-19 13:10:48.986608390 -0500 +@@ -13613,7 +13613,6 @@ redo_curchar: + RExC_parse++; + assert(RExC_parse < RExC_end && UCHARAT(RExC_parse) == ')'); + +- RExC_parse++; + RExC_flags = save_flags; + goto handle_operand; + } diff -Nru perl-5.22.1/debian/patches/fixes/CVE-2018-18313.patch perl-5.22.1/debian/patches/fixes/CVE-2018-18313.patch --- perl-5.22.1/debian/patches/fixes/CVE-2018-18313.patch 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.22.1/debian/patches/fixes/CVE-2018-18313.patch 2018-11-19 21:42:32.000000000 +0000 @@ -0,0 +1,58 @@ +Backport of: + +From cc56be313c7d4e7c266c01dabc762a153d5b2c28 Mon Sep 17 00:00:00 2001 +From: Karl Williamson +Date: Sat, 25 Mar 2017 15:00:22 -0600 +Subject: [PATCH] regcomp.c: Convert some strchr to memchr + +This allows things to work properly in the face of embedded NULs. +See the branch merge message for more information. + +(cherry picked from commit 43b2f4ef399e2fd7240b4eeb0658686ad95f8e62) +--- + regcomp.c | 11 +++++++---- + 1 file changed, 7 insertions(+), 4 deletions(-) + +Index: perl-5.22.1/regcomp.c +=================================================================== +--- perl-5.22.1.orig/regcomp.c 2018-11-19 15:59:16.688526872 -0500 ++++ perl-5.22.1/regcomp.c 2018-11-19 16:42:21.583888907 -0500 +@@ -11165,7 +11165,7 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pREx + + RExC_parse++; /* Skip past the '{' */ + +- if (! (endbrace = strchr(RExC_parse, '}')) /* no trailing brace */ ++ if (! (endbrace = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse)) /* 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 +@@ -11847,9 +11847,11 @@ S_regatom(pTHX_ RExC_state_t *pRExC_stat + 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); +@@ -14484,9 +14486,13 @@ S_regclass(pTHX_ RExC_state_t *pRExC_sta + vFAIL2("Empty \\%c{}", (U8)value); + if (*RExC_parse == '{') { + const U8 c = (U8)value; +- e = strchr(RExC_parse++, '}'); +- if (!e) ++ e = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse); ++ if (!e) { ++ RExC_parse++; + vFAIL2("Missing right brace on \\%c{}", c); ++ } ++ ++ RExC_parse++; + while (isSPACE(*RExC_parse)) + RExC_parse++; + if (e == RExC_parse) diff -Nru perl-5.22.1/debian/patches/fixes/CVE-2018-18314.patch perl-5.22.1/debian/patches/fixes/CVE-2018-18314.patch --- perl-5.22.1/debian/patches/fixes/CVE-2018-18314.patch 1970-01-01 00:00:00.000000000 +0000 +++ perl-5.22.1/debian/patches/fixes/CVE-2018-18314.patch 2018-11-19 18:54:10.000000000 +0000 @@ -0,0 +1,213 @@ +Backport of: + +From 10ce49389ea9ee26a3b02b6494b0a3849d56c6fa Mon Sep 17 00:00:00 2001 +From: Yves Orton +Date: Mon, 26 Jun 2017 13:19:55 +0200 +Subject: [PATCH] fix #131649 - extended charclass can trigger assert + +The extended charclass parser makes some assumptions during the +first pass which are only true on well structured input, and it +does not properly catch various errors. later on the code assumes +that things the first pass will let through are valid, when in +fact they should trigger errors. + +(cherry picked from commit 19a498a461d7c81ae3507c450953d1148efecf4f) +--- + pod/perldiag.pod | 27 ++++++++++++++++++++++++++- + pod/perlrecharclass.pod | 4 ++-- + regcomp.c | 28 ++++++++++++++++++---------- + t/lib/warnings/regcomp | 6 +++--- + t/re/reg_mesg.t | 29 ++++++++++++++++------------- + t/re/regex_sets.t | 6 +++--- + 6 files changed, 68 insertions(+), 32 deletions(-) + +Index: perl-5.22.1/pod/perldiag.pod +=================================================================== +--- perl-5.22.1.orig/pod/perldiag.pod 2018-11-19 13:51:46.445780460 -0500 ++++ perl-5.22.1/pod/perldiag.pod 2018-11-19 13:51:46.441780444 -0500 +@@ -5704,7 +5704,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. +@@ -6085,6 +6085,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/ + +Index: perl-5.22.1/pod/perlrecharclass.pod +=================================================================== +--- perl-5.22.1.orig/pod/perlrecharclass.pod 2018-11-19 13:51:46.445780460 -0500 ++++ perl-5.22.1/pod/perlrecharclass.pod 2018-11-19 13:51:46.441780444 -0500 +@@ -1097,8 +1097,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: + +Index: perl-5.22.1/regcomp.c +=================================================================== +--- perl-5.22.1.orig/regcomp.c 2018-11-19 13:51:46.445780460 -0500 ++++ perl-5.22.1/regcomp.c 2018-11-19 13:54:03.330357901 -0500 +@@ -13357,8 +13357,9 @@ S_handle_regex_sets(pTHX_ RExC_state_t * + RExC_parse = regpatws(pRExC_state, RExC_parse, + TRUE); /* means recognize comments */ + 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; +@@ -13413,11 +13414,10 @@ S_handle_regex_sets(pTHX_ RExC_state_t * + } + + case ']': +- if (depth--) break; +- RExC_parse++; +- if (RExC_parse < RExC_end +- && *RExC_parse == ')') ++ if (RExC_parse[1] == ')') + { ++ RExC_parse++; ++ if (depth--) break; + node = reganode(pRExC_state, ANYOF, 0); + RExC_size += ANYOF_SKIP; + nextchar(pRExC_state); +@@ -13425,13 +13425,13 @@ S_handle_regex_sets(pTHX_ RExC_state_t * + RExC_parse - oregcomp_parse + 1); /* MJD */ + return node; + } +- goto no_close; ++ RExC_parse++; ++ vFAIL("Unexpected ']' with no following ')' in (?[..."); + } + RExC_parse++; + } + +- no_close: +- FAIL("Syntax error in (?[...])"); ++ vFAIL("Syntax error in (?[...])"); + } + + /* Pass 2 only after this. */ +@@ -13552,7 +13552,8 @@ redo_curchar: + + case '(': + +- if (RExC_parse < RExC_end && (UCHARAT(RExC_parse + 1) == '?')) ++ if ( RExC_parse < RExC_end - 1 ++ && (UCHARAT(RExC_parse + 1) == '?')) + { + /* If is a '(?', could be an embedded '(?flags:(?[...])'. + * This happens when we have some thing like +@@ -13608,12 +13609,14 @@ redo_curchar: + * inversion list, and RExC_parse points to the trailing + * ']'; the next character should be the ')' */ + RExC_parse++; +- assert(RExC_parse < RExC_end && 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(RExC_parse < RExC_end && UCHARAT(RExC_parse) == ')'); ++ if (UCHARAT(RExC_parse) != ')') ++ vFAIL("Expecting close paren for wrapper for nested extended charclass"); + + RExC_flags = save_flags; + goto handle_operand; +Index: perl-5.22.1/t/re/reg_mesg.t +=================================================================== +--- perl-5.22.1.orig/t/re/reg_mesg.t 2018-11-19 13:51:46.445780460 -0500 ++++ perl-5.22.1/t/re/reg_mesg.t 2018-11-19 13:51:46.441780444 -0500 +@@ -224,11 +224,12 @@ my @death = + '/(?[ \p{foo} ])/' => 'Property \'foo\' is unknown {#} m/(?[ \p{foo}{#} ])/', + '/(?[ \p{ foo = bar } ])/' => 'Property \'foo = bar\' is unknown {#} 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]])/', +@@ -424,8 +425,9 @@ my @death_utf8 = mark_as_utf8( + '/(?[ \x{ネ} ])ネ/' => 'Non-hex character {#} m/(?[ \x{ネ{#}} ])ネ/', + '/(?[ \p{ネ} ])/' => 'Property \'ネ\' is unknown {#} m/(?[ \p{ネ}{#} ])/', + '/(?[ \p{ ネ = bar } ])/' => 'Property \'ネ = bar\' is unknown {#} 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{ネ{#}}/", +Index: perl-5.22.1/t/re/regex_sets.t +=================================================================== +--- perl-5.22.1.orig/t/re/regex_sets.t 2018-11-19 13:51:46.445780460 -0500 ++++ perl-5.22.1/t/re/regex_sets.t 2018-11-19 13:51:46.441780444 -0500 +@@ -105,13 +105,13 @@ like("B", qr/(?[ [B] | ! ( [^B] ) ])/, " + 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 -Nru perl-5.22.1/debian/patches/series perl-5.22.1/debian/patches/series --- perl-5.22.1/debian/patches/series 2018-06-13 12:22:10.000000000 +0000 +++ perl-5.22.1/debian/patches/series 2018-11-19 18:28:51.000000000 +0000 @@ -67,3 +67,7 @@ fixes/CVE-2018-6798-3.patch fixes/CVE-2018-6913.patch fixes/CVE-2018-12015.patch +fixes/CVE-2018-18311.patch +fixes/CVE-2018-18312.patch +fixes/CVE-2018-18313.patch +fixes/CVE-2018-18314.patch