diff options
author | Natanael Copa <ncopa@alpinelinux.org> | 2018-12-04 14:40:59 +0000 |
---|---|---|
committer | Natanael Copa <ncopa@alpinelinux.org> | 2018-12-04 17:27:53 +0100 |
commit | 17a345542d7049381a2bafa85893bda2cfc61358 (patch) | |
tree | eaab087fb82105f072a90cb22de6e0d08b1f61eb | |
parent | a6a6bcff1f6b6dcf3aa2991d43f73b1948084d66 (diff) | |
download | alpine_aports-17a345542d7049381a2bafa85893bda2cfc61358.tar.bz2 alpine_aports-17a345542d7049381a2bafa85893bda2cfc61358.tar.xz alpine_aports-17a345542d7049381a2bafa85893bda2cfc61358.zip |
main/perl: backport security fixes
CVE-2018-18311, CVE-2018-18312, CVE-2018-18313, CVE-2018-18314
fixes #9730
-rw-r--r-- | main/perl/APKBUILD | 17 | ||||
-rw-r--r-- | main/perl/CVE-2018-18311.patch | 174 | ||||
-rw-r--r-- | main/perl/CVE-2018-18312.patch | 47 | ||||
-rw-r--r-- | main/perl/CVE-2018-18313.patch | 105 | ||||
-rw-r--r-- | main/perl/CVE-2018-18314.patch | 267 |
5 files changed, 608 insertions, 2 deletions
diff --git a/main/perl/APKBUILD b/main/perl/APKBUILD index 71f61d19ec..316430908d 100644 --- a/main/perl/APKBUILD +++ b/main/perl/APKBUILD | |||
@@ -3,7 +3,7 @@ | |||
3 | # Contributor: Valery Kartel <valery.kartel@gmail.com> | 3 | # Contributor: Valery Kartel <valery.kartel@gmail.com> |
4 | pkgname=perl | 4 | pkgname=perl |
5 | pkgver=5.24.4 | 5 | pkgver=5.24.4 |
6 | pkgrel=1 | 6 | pkgrel=2 |
7 | pkgdesc="Larry Wall's Practical Extraction and Report Language" | 7 | pkgdesc="Larry Wall's Practical Extraction and Report Language" |
8 | url="http://www.perl.org/" | 8 | url="http://www.perl.org/" |
9 | arch="all" | 9 | arch="all" |
@@ -15,9 +15,18 @@ makedepends="bzip2-dev zlib-dev" | |||
15 | subpackages="$pkgname-doc $pkgname-dev $pkgname-utils::noarch miniperl" | 15 | subpackages="$pkgname-doc $pkgname-dev $pkgname-utils::noarch miniperl" |
16 | source="http://www.cpan.org/src/5.0/perl-$pkgver.tar.gz | 16 | source="http://www.cpan.org/src/5.0/perl-$pkgver.tar.gz |
17 | CVE-2018-12015.patch | 17 | CVE-2018-12015.patch |
18 | CVE-2018-18311.patch | ||
19 | CVE-2018-18312.patch | ||
20 | CVE-2018-18313.patch | ||
21 | CVE-2018-18314.patch | ||
18 | " | 22 | " |
19 | 23 | ||
20 | # secfixes: | 24 | # secfixes: |
25 | # 5.24.4-r2: | ||
26 | # - CVE-2018-18311 | ||
27 | # - CVE-2018-18312 | ||
28 | # - CVE-2018-18313 | ||
29 | # - CVE-2018-18314 | ||
21 | # 5.24.4-r1: | 30 | # 5.24.4-r1: |
22 | # - CVE-2018-12015 | 31 | # - CVE-2018-12015 |
23 | # 5.24.3-r0: | 32 | # 5.24.3-r0: |
@@ -140,4 +149,8 @@ utils() { | |||
140 | } | 149 | } |
141 | 150 | ||
142 | sha512sums="796d92f47860ac0e3a22d85eb129549c4251445b3cfa8687e305c95f6205ad32a670e0d680e20245e47f0c6567b313748bce1db04208b21ff10595196e37a40b perl-5.24.4.tar.gz | 151 | sha512sums="796d92f47860ac0e3a22d85eb129549c4251445b3cfa8687e305c95f6205ad32a670e0d680e20245e47f0c6567b313748bce1db04208b21ff10595196e37a40b perl-5.24.4.tar.gz |
143 | feda381bd3230443341b99135bac4d6010e9d28b619d9fb57f2dda2c29b8877f012f76d31631e5227ef79e73e0b2b162548fa24704752e61f10c05d015c68916 CVE-2018-12015.patch" | 152 | feda381bd3230443341b99135bac4d6010e9d28b619d9fb57f2dda2c29b8877f012f76d31631e5227ef79e73e0b2b162548fa24704752e61f10c05d015c68916 CVE-2018-12015.patch |
153 | c1af39d5f293cb83b5ce8cea0835a52470cc2aa67cf541bfc20fd25c815cd9124cb6d91df979235868223ba2244ceed1336e304e10df74b40b706268ffc2b8c1 CVE-2018-18311.patch | ||
154 | f785a9b94311a4a8dfdf811006c8eb540808d75922d7d5c48e567c949ebf0dc4fe2641163e1220db3a29d650c2d35ed278bb3867f8ebe626faad05bf75d32ad1 CVE-2018-18312.patch | ||
155 | bcc8438fc8bceef83b23dac2e788ceb5d70f645054b5d04c555004ccfe2f85a83f835b387ee318e1ca8668afb7601eeacfc4355e8a70e98549c15b1521555318 CVE-2018-18313.patch | ||
156 | df59c1cb4ca8d651d544524ae01c092f0451ec27f7d821bc7e61e1b7385161e241797e84ae85782b3869d432bca72a93bfe71590a1cf879f7c5a11b780d3c4dd CVE-2018-18314.patch" | ||
diff --git a/main/perl/CVE-2018-18311.patch b/main/perl/CVE-2018-18311.patch new file mode 100644 index 0000000000..02277e93e2 --- /dev/null +++ b/main/perl/CVE-2018-18311.patch | |||
@@ -0,0 +1,174 @@ | |||
1 | From 5737d31aac51360cc1eb412ef059e36147c9d6d6 Mon Sep 17 00:00:00 2001 | ||
2 | From: David Mitchell <davem@iabyn.com> | ||
3 | Date: Fri, 29 Jun 2018 13:37:03 +0100 | ||
4 | Subject: [PATCH] Perl_my_setenv(); handle integer wrap | ||
5 | |||
6 | RT #133204 | ||
7 | |||
8 | Wean this function off int/I32 and onto UV/Size_t. | ||
9 | Also, replace all malloc-ish calls with a wrapper that does | ||
10 | overflow checks, | ||
11 | |||
12 | In particular, it was doing (nlen + vlen + 2) which could wrap when | ||
13 | the combined length of the environment variable name and value | ||
14 | exceeded around 0x7fffffff. | ||
15 | |||
16 | The wrapper check function is probably overkill, but belt and braces... | ||
17 | |||
18 | NB this function has several variant parts, #ifdef'ed by platform | ||
19 | type; I have blindly changed the parts that aren't compiled under linux. | ||
20 | |||
21 | (cherry picked from commit 34716e2a6ee2af96078d62b065b7785c001194be) | ||
22 | --- | ||
23 | util.c | 76 ++++++++++++++++++++++++++++++++++++++++------------------ | ||
24 | 1 file changed, 53 insertions(+), 23 deletions(-) | ||
25 | |||
26 | diff --git a/util.c b/util.c | ||
27 | index 2e053a7115f..ba5fb2ded8e 100644 | ||
28 | --- a/util.c | ||
29 | +++ b/util.c | ||
30 | @@ -2064,8 +2064,40 @@ Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits, | ||
31 | *(s+(nlen+1+vlen)) = '\0' | ||
32 | |||
33 | #ifdef USE_ENVIRON_ARRAY | ||
34 | - /* VMS' my_setenv() is in vms.c */ | ||
35 | + | ||
36 | +/* small wrapper for use by Perl_my_setenv that mallocs, or reallocs if | ||
37 | + * 'current' is non-null, with up to three sizes that are added together. | ||
38 | + * It handles integer overflow. | ||
39 | + */ | ||
40 | +static char * | ||
41 | +S_env_alloc(void *current, Size_t l1, Size_t l2, Size_t l3, Size_t size) | ||
42 | +{ | ||
43 | + void *p; | ||
44 | + Size_t sl, l = l1 + l2; | ||
45 | + | ||
46 | + if (l < l2) | ||
47 | + goto panic; | ||
48 | + l += l3; | ||
49 | + if (l < l3) | ||
50 | + goto panic; | ||
51 | + sl = l * size; | ||
52 | + if (sl < l) | ||
53 | + goto panic; | ||
54 | + | ||
55 | + p = current | ||
56 | + ? safesysrealloc(current, sl) | ||
57 | + : safesysmalloc(sl); | ||
58 | + if (p) | ||
59 | + return (char*)p; | ||
60 | + | ||
61 | + panic: | ||
62 | + croak_memory_wrap(); | ||
63 | +} | ||
64 | + | ||
65 | + | ||
66 | +/* VMS' my_setenv() is in vms.c */ | ||
67 | #if !defined(WIN32) && !defined(NETWARE) | ||
68 | + | ||
69 | void | ||
70 | Perl_my_setenv(pTHX_ const char *nam, const char *val) | ||
71 | { | ||
72 | @@ -2081,28 +2113,27 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) | ||
73 | #ifndef PERL_USE_SAFE_PUTENV | ||
74 | if (!PL_use_safe_putenv) { | ||
75 | /* most putenv()s leak, so we manipulate environ directly */ | ||
76 | - I32 i; | ||
77 | - const I32 len = strlen(nam); | ||
78 | - int nlen, vlen; | ||
79 | + UV i; | ||
80 | + Size_t vlen, nlen = strlen(nam); | ||
81 | |||
82 | /* where does it go? */ | ||
83 | for (i = 0; environ[i]; i++) { | ||
84 | - if (strnEQ(environ[i],nam,len) && environ[i][len] == '=') | ||
85 | + if (strnEQ(environ[i], nam, nlen) && environ[i][nlen] == '=') | ||
86 | break; | ||
87 | } | ||
88 | |||
89 | if (environ == PL_origenviron) { /* need we copy environment? */ | ||
90 | - I32 j; | ||
91 | - I32 max; | ||
92 | + UV j, max; | ||
93 | char **tmpenv; | ||
94 | |||
95 | max = i; | ||
96 | while (environ[max]) | ||
97 | max++; | ||
98 | - tmpenv = (char**)safesysmalloc((max+2) * sizeof(char*)); | ||
99 | + /* XXX shouldn't that be max+1 rather than max+2 ??? - DAPM */ | ||
100 | + tmpenv = (char**)S_env_alloc(NULL, max, 2, 0, sizeof(char*)); | ||
101 | for (j=0; j<max; j++) { /* copy environment */ | ||
102 | - const int len = strlen(environ[j]); | ||
103 | - tmpenv[j] = (char*)safesysmalloc((len+1)*sizeof(char)); | ||
104 | + const Size_t len = strlen(environ[j]); | ||
105 | + tmpenv[j] = S_env_alloc(NULL, len, 1, 0, 1); | ||
106 | Copy(environ[j], tmpenv[j], len+1, char); | ||
107 | } | ||
108 | tmpenv[max] = NULL; | ||
109 | @@ -2121,15 +2152,15 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) | ||
110 | #endif | ||
111 | } | ||
112 | if (!environ[i]) { /* does not exist yet */ | ||
113 | - environ = (char**)safesysrealloc(environ, (i+2) * sizeof(char*)); | ||
114 | + environ = (char**)S_env_alloc(environ, i, 2, 0, sizeof(char*)); | ||
115 | environ[i+1] = NULL; /* make sure it's null terminated */ | ||
116 | } | ||
117 | else | ||
118 | safesysfree(environ[i]); | ||
119 | - nlen = strlen(nam); | ||
120 | + | ||
121 | vlen = strlen(val); | ||
122 | |||
123 | - environ[i] = (char*)safesysmalloc((nlen+vlen+2) * sizeof(char)); | ||
124 | + environ[i] = S_env_alloc(NULL, nlen, vlen, 2, 1); | ||
125 | /* all that work just for this */ | ||
126 | my_setenv_format(environ[i], nam, nlen, val, vlen); | ||
127 | } else { | ||
128 | @@ -2154,22 +2185,21 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) | ||
129 | if (environ) /* old glibc can crash with null environ */ | ||
130 | (void)unsetenv(nam); | ||
131 | } else { | ||
132 | - const int nlen = strlen(nam); | ||
133 | - const int vlen = strlen(val); | ||
134 | - char * const new_env = | ||
135 | - (char*)safesysmalloc((nlen + vlen + 2) * sizeof(char)); | ||
136 | + const Size_t nlen = strlen(nam); | ||
137 | + const Size_t vlen = strlen(val); | ||
138 | + char * const new_env = S_env_alloc(NULL, nlen, vlen, 2, 1); | ||
139 | my_setenv_format(new_env, nam, nlen, val, vlen); | ||
140 | (void)putenv(new_env); | ||
141 | } | ||
142 | # else /* ! HAS_UNSETENV */ | ||
143 | char *new_env; | ||
144 | - const int nlen = strlen(nam); | ||
145 | - int vlen; | ||
146 | + const Size_t nlen = strlen(nam); | ||
147 | + Size_t vlen; | ||
148 | if (!val) { | ||
149 | val = ""; | ||
150 | } | ||
151 | vlen = strlen(val); | ||
152 | - new_env = (char*)safesysmalloc((nlen + vlen + 2) * sizeof(char)); | ||
153 | + new_env = S_env_alloc(NULL, nlen, vlen, 2, 1); | ||
154 | /* all that work just for this */ | ||
155 | my_setenv_format(new_env, nam, nlen, val, vlen); | ||
156 | (void)putenv(new_env); | ||
157 | @@ -2192,14 +2222,14 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) | ||
158 | { | ||
159 | dVAR; | ||
160 | char *envstr; | ||
161 | - const int nlen = strlen(nam); | ||
162 | - int vlen; | ||
163 | + const Size_t nlen = strlen(nam); | ||
164 | + Size_t vlen; | ||
165 | |||
166 | if (!val) { | ||
167 | val = ""; | ||
168 | } | ||
169 | vlen = strlen(val); | ||
170 | - Newx(envstr, nlen+vlen+2, char); | ||
171 | + envstr = S_env_alloc(NULL, nlen, vlen, 2, 1); | ||
172 | my_setenv_format(envstr, nam, nlen, val, vlen); | ||
173 | (void)PerlEnv_putenv(envstr); | ||
174 | Safefree(envstr); | ||
diff --git a/main/perl/CVE-2018-18312.patch b/main/perl/CVE-2018-18312.patch new file mode 100644 index 0000000000..94a073e211 --- /dev/null +++ b/main/perl/CVE-2018-18312.patch | |||
@@ -0,0 +1,47 @@ | |||
1 | From df2858ea28eb2c7e00a4bd6a5ed95e4782f88333 Mon Sep 17 00:00:00 2001 | ||
2 | From: Karl Williamson <khw@cpan.org> | ||
3 | Date: Mon, 24 Sep 2018 11:54:41 -0600 | ||
4 | Subject: [PATCH 242/242] PATCH: [perl #133423] for 5.26 maint | ||
5 | |||
6 | --- | ||
7 | regcomp.c | 1 - | ||
8 | t/re/reg_mesg.t | 4 ++++ | ||
9 | 2 files changed, 4 insertions(+), 1 deletion(-) | ||
10 | |||
11 | diff --git a/regcomp.c b/regcomp.c | ||
12 | index ca47db7573..431006e855 100644 | ||
13 | --- a/regcomp.c | ||
14 | +++ b/regcomp.c | ||
15 | @@ -15109,7 +15109,6 @@ redo_curchar: | ||
16 | RExC_parse++; | ||
17 | assert(UCHARAT(RExC_parse) == ')'); | ||
18 | |||
19 | - RExC_parse++; | ||
20 | RExC_flags = save_flags; | ||
21 | goto handle_operand; | ||
22 | } | ||
23 | diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t | ||
24 | index 39cfcf7df1..d26a7caf37 100644 | ||
25 | --- a/t/re/reg_mesg.t | ||
26 | +++ b/t/re/reg_mesg.t | ||
27 | @@ -106,6 +106,8 @@ my $high_mixed_digit = ('A' lt '0') ? '0' : 'A'; | ||
28 | my $colon_hex = sprintf "%02X", ord(":"); | ||
29 | my $tab_hex = sprintf "%02X", ord("\t"); | ||
30 | |||
31 | +my $bug133423 = "(?[(?^:(?[\\\x00]))\\]\x00|2[^^]\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80])R.\\670"; | ||
32 | + | ||
33 | ## | ||
34 | ## Key-value pairs of code/error of code that should have fatal errors. | ||
35 | ## | ||
36 | @@ -269,6 +271,8 @@ my @death = | ||
37 | '/(?[()-!])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[(){#}-!])/', # [perl #126204] | ||
38 | '/(?[!()])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[!(){#}])/', # [perl #126404] | ||
39 | '/(?<=/' => 'Sequence (?... not terminated {#} m/(?<={#}/', # [perl #128170] | ||
40 | + "/$bug133423/" => "Operand with no preceding operator {#} m/(?[(?^:(?[\\]))\\{#}]|2[^^]\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80])R.\\670/", | ||
41 | + | ||
42 | ); | ||
43 | |||
44 | # These are messages that are warnings when not strict; death under 'use re | ||
45 | -- | ||
46 | 2.17.1 | ||
47 | |||
diff --git a/main/perl/CVE-2018-18313.patch b/main/perl/CVE-2018-18313.patch new file mode 100644 index 0000000000..dbd97ebf2b --- /dev/null +++ b/main/perl/CVE-2018-18313.patch | |||
@@ -0,0 +1,105 @@ | |||
1 | From ff4e2b11ab19d0c806a3dc09308d1b393971b8aa Mon Sep 17 00:00:00 2001 | ||
2 | From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= <ilmari@ilmari.org> | ||
3 | Date: Mon, 14 Nov 2016 20:05:31 +0100 | ||
4 | Subject: [PATCH] Fix error message for unclosed \N{ in regcomp | ||
5 | |||
6 | An unclosed \N{ that made it through to the regex engine rather than | ||
7 | being handled by the lexer would erroneously trigger the error for | ||
8 | "\N{NAME} must be resolved by the lexer". | ||
9 | |||
10 | This separates the check for the missing trailing } and issues the | ||
11 | correct error message for this. | ||
12 | --- | ||
13 | regcomp.c | 8 +++++--- | ||
14 | t/re/re_tests | 5 ++++- | ||
15 | 2 files changed, 9 insertions(+), 4 deletions(-) | ||
16 | |||
17 | diff --git a/regcomp.c b/regcomp.c | ||
18 | index ac664326f01..332cf00482e 100644 | ||
19 | --- a/regcomp.c | ||
20 | +++ b/regcomp.c | ||
21 | @@ -12005,13 +12005,15 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, | ||
22 | |||
23 | RExC_parse++; /* Skip past the '{' */ | ||
24 | |||
25 | - if (! (endbrace = strchr(RExC_parse, '}')) /* no trailing brace */ | ||
26 | - || ! (endbrace == RExC_parse /* nothing between the {} */ | ||
27 | + if (! (endbrace = strchr(RExC_parse, '}'))) { /* no trailing brace */ | ||
28 | + vFAIL2("Missing right brace on \\%c{}", 'N'); | ||
29 | + } | ||
30 | + else if(!(endbrace == RExC_parse /* nothing between the {} */ | ||
31 | || (endbrace - RExC_parse >= 2 /* U+ (bad hex is checked... */ | ||
32 | && strnEQ(RExC_parse, "U+", 2)))) /* ... below for a better | ||
33 | error msg) */ | ||
34 | { | ||
35 | - if (endbrace) RExC_parse = endbrace; /* position msg's '<--HERE' */ | ||
36 | + RExC_parse = endbrace; /* position msg's '<--HERE' */ | ||
37 | vFAIL("\\N{NAME} must be resolved by the lexer"); | ||
38 | } | ||
39 | |||
40 | diff --git a/t/re/re_tests b/t/re/re_tests | ||
41 | index 046beaa193b..1797ddc09d9 100644 | ||
42 | --- a/t/re/re_tests | ||
43 | +++ b/t/re/re_tests | ||
44 | @@ -1478,7 +1478,10 @@ abc\N abc\n n | ||
45 | [\N{U+}] - c - Invalid hexadecimal number | ||
46 | \N{U+4AG3} - c - Invalid hexadecimal number | ||
47 | [\N{U+4AG3}] - c - Invalid hexadecimal number | ||
48 | -abc\N{def - c - \\N{NAME} must be resolved by the lexer | ||
49 | +abc\N{def} - c - \\N{NAME} must be resolved by the lexer | ||
50 | +abc\N{U+4AG3 - c - Missing right brace on \\N{} | ||
51 | +abc\N{def - c - Missing right brace on \\N{} | ||
52 | +abc\N{ - c - Missing right brace on \\N{} | ||
53 | |||
54 | # Verify that under /x that still cant have space before left brace | ||
55 | /abc\N {U+41}/x - c - Missing braces | ||
56 | From c1c28ce6ba90ee05aa96b11ad551a6063680f3b9 Mon Sep 17 00:00:00 2001 | ||
57 | From: Karl Williamson <khw@cpan.org> | ||
58 | Date: Sat, 25 Mar 2017 15:00:22 -0600 | ||
59 | Subject: [PATCH] regcomp.c: Convert some strchr to memchr | ||
60 | |||
61 | This allows things to work properly in the face of embedded NULs. | ||
62 | See the branch merge message for more information. | ||
63 | |||
64 | (cherry picked from commit 43b2f4ef399e2fd7240b4eeb0658686ad95f8e62) | ||
65 | --- | ||
66 | regcomp.c | 11 +++++++---- | ||
67 | 1 file changed, 7 insertions(+), 4 deletions(-) | ||
68 | |||
69 | diff --git a/regcomp.c b/regcomp.c | ||
70 | index 431006e8551..4ee48ede423 100644 | ||
71 | --- a/regcomp.c | ||
72 | +++ b/regcomp.c | ||
73 | @@ -12023,7 +12023,8 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, | ||
74 | |||
75 | RExC_parse++; /* Skip past the '{' */ | ||
76 | |||
77 | - if (! (endbrace = strchr(RExC_parse, '}'))) { /* no trailing brace */ | ||
78 | + endbrace = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse); | ||
79 | + if (! endbrace) { /* no trailing brace */ | ||
80 | vFAIL2("Missing right brace on \\%c{}", 'N'); | ||
81 | } | ||
82 | else if(!(endbrace == RExC_parse /* nothing between the {} */ | ||
83 | @@ -12692,9 +12693,11 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) | ||
84 | else { | ||
85 | STRLEN length; | ||
86 | char name = *RExC_parse; | ||
87 | - char * endbrace; | ||
88 | + char * endbrace = NULL; | ||
89 | RExC_parse += 2; | ||
90 | - endbrace = strchr(RExC_parse, '}'); | ||
91 | + if (RExC_parse < RExC_end) { | ||
92 | + endbrace = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse); | ||
93 | + } | ||
94 | |||
95 | if (! endbrace) { | ||
96 | vFAIL2("Missing right brace on \\%c{}", name); | ||
97 | @@ -16228,7 +16231,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, | ||
98 | vFAIL2("Empty \\%c", (U8)value); | ||
99 | if (*RExC_parse == '{') { | ||
100 | const U8 c = (U8)value; | ||
101 | - e = strchr(RExC_parse, '}'); | ||
102 | + e = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse); | ||
103 | if (!e) { | ||
104 | RExC_parse++; | ||
105 | vFAIL2("Missing right brace on \\%c{}", c); | ||
diff --git a/main/perl/CVE-2018-18314.patch b/main/perl/CVE-2018-18314.patch new file mode 100644 index 0000000000..3219dbf4af --- /dev/null +++ b/main/perl/CVE-2018-18314.patch | |||
@@ -0,0 +1,267 @@ | |||
1 | From dabe076af345ab4512ea80245b4e4cd7ec0996cd Mon Sep 17 00:00:00 2001 | ||
2 | From: Yves Orton <demerphq@gmail.com> | ||
3 | Date: Mon, 26 Jun 2017 13:19:55 +0200 | ||
4 | Subject: [PATCH] fix #131649 - extended charclass can trigger assert | ||
5 | |||
6 | The extended charclass parser makes some assumptions during the | ||
7 | first pass which are only true on well structured input, and it | ||
8 | does not properly catch various errors. later on the code assumes | ||
9 | that things the first pass will let through are valid, when in | ||
10 | fact they should trigger errors. | ||
11 | |||
12 | (cherry picked from commit 19a498a461d7c81ae3507c450953d1148efecf4f) | ||
13 | --- | ||
14 | pod/perldiag.pod | 27 ++++++++++++++++++++++++++- | ||
15 | pod/perlrecharclass.pod | 4 ++-- | ||
16 | regcomp.c | 28 ++++++++++++++++++---------- | ||
17 | t/lib/warnings/regcomp | 6 +++--- | ||
18 | t/re/reg_mesg.t | 29 ++++++++++++++++------------- | ||
19 | t/re/regex_sets.t | 6 +++--- | ||
20 | 6 files changed, 68 insertions(+), 32 deletions(-) | ||
21 | |||
22 | diff --git a/pod/perldiag.pod b/pod/perldiag.pod | ||
23 | index 106fe41121f..c29925a2a4e 100644 | ||
24 | --- a/pod/perldiag.pod | ||
25 | +++ b/pod/perldiag.pod | ||
26 | @@ -5904,7 +5904,7 @@ yourself. | ||
27 | a perl4 interpreter, especially if the next 2 tokens are "use strict" | ||
28 | or "my $var" or "our $var". | ||
29 | |||
30 | -=item Syntax error in (?[...]) in regex m/%s/ | ||
31 | +=item Syntax error in (?[...]) in regex; marked by <-- HERE in m/%s/ | ||
32 | |||
33 | (F) Perl could not figure out what you meant inside this construct; this | ||
34 | notifies you that it is giving up trying. | ||
35 | @@ -6402,6 +6402,31 @@ to find out why that isn't happening. | ||
36 | (F) The unexec() routine failed for some reason. See your local FSF | ||
37 | representative, who probably put it there in the first place. | ||
38 | |||
39 | +=item Unexpected ']' with no following ')' in (?[... in regex; marked by <-- HERE in m/%s/ | ||
40 | + | ||
41 | +(F) While parsing an extended character class a ']' character was encountered | ||
42 | +at a point in the definition where the only legal use of ']' is to close the | ||
43 | +character class definition as part of a '])', you may have forgotten the close | ||
44 | +paren, or otherwise confused the parser. | ||
45 | + | ||
46 | +=item Expecting close paren for nested extended charclass in regex; marked by <-- HERE in m/%s/ | ||
47 | + | ||
48 | +(F) While parsing a nested extended character class like: | ||
49 | + | ||
50 | + (?[ ... (?flags:(?[ ... ])) ... ]) | ||
51 | + ^ | ||
52 | + | ||
53 | +we expected to see a close paren ')' (marked by ^) but did not. | ||
54 | + | ||
55 | +=item Expecting close paren for wrapper for nested extended charclass in regex; marked by <-- HERE in m/%s/ | ||
56 | + | ||
57 | +(F) While parsing a nested extended character class like: | ||
58 | + | ||
59 | + (?[ ... (?flags:(?[ ... ])) ... ]) | ||
60 | + ^ | ||
61 | + | ||
62 | +we expected to see a close paren ')' (marked by ^) but did not. | ||
63 | + | ||
64 | =item Unexpected binary operator '%c' with no preceding operand in regex; | ||
65 | marked by S<<-- HERE> in m/%s/ | ||
66 | |||
67 | diff --git a/pod/perlrecharclass.pod b/pod/perlrecharclass.pod | ||
68 | index 79480e41312..8c008507d1f 100644 | ||
69 | --- a/pod/perlrecharclass.pod | ||
70 | +++ b/pod/perlrecharclass.pod | ||
71 | @@ -1128,8 +1128,8 @@ hence both of the following work: | ||
72 | Any contained POSIX character classes, including things like C<\w> and C<\D> | ||
73 | respect the C<E<sol>a> (and C<E<sol>aa>) modifiers. | ||
74 | |||
75 | -C<< (?[ ]) >> is a regex-compile-time construct. Any attempt to use | ||
76 | -something which isn't knowable at the time the containing regular | ||
77 | +Note that C<< (?[ ]) >> is a regex-compile-time construct. Any attempt | ||
78 | +to use something which isn't knowable at the time the containing regular | ||
79 | expression is compiled is a fatal error. In practice, this means | ||
80 | just three limitations: | ||
81 | |||
82 | diff --git a/regcomp.c b/regcomp.c | ||
83 | index 4ee48ede423..ddac290d2bf 100644 | ||
84 | --- a/regcomp.c | ||
85 | +++ b/regcomp.c | ||
86 | @@ -14840,8 +14840,9 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, | ||
87 | TRUE /* Force /x */ ); | ||
88 | |||
89 | switch (*RExC_parse) { | ||
90 | - case '?': | ||
91 | - if (RExC_parse[1] == '[') depth++, RExC_parse++; | ||
92 | + case '(': | ||
93 | + if (RExC_parse[1] == '?' && RExC_parse[2] == '[') | ||
94 | + depth++, RExC_parse+=2; | ||
95 | /* FALLTHROUGH */ | ||
96 | default: | ||
97 | break; | ||
98 | @@ -14898,9 +14899,9 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, | ||
99 | } | ||
100 | |||
101 | case ']': | ||
102 | - if (depth--) break; | ||
103 | - RExC_parse++; | ||
104 | - if (*RExC_parse == ')') { | ||
105 | + if (RExC_parse[1] == ')') { | ||
106 | + RExC_parse++; | ||
107 | + if (depth--) break; | ||
108 | node = reganode(pRExC_state, ANYOF, 0); | ||
109 | RExC_size += ANYOF_SKIP; | ||
110 | nextchar(pRExC_state); | ||
111 | @@ -14912,20 +14913,25 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, | ||
112 | |||
113 | return node; | ||
114 | } | ||
115 | - goto no_close; | ||
116 | + /* We output the messages even if warnings are off, because we'll fail | ||
117 | + * the very next thing, and these give a likely diagnosis for that */ | ||
118 | + if (posix_warnings && av_tindex_nomg(posix_warnings) >= 0) { | ||
119 | + output_or_return_posix_warnings(pRExC_state, posix_warnings, NULL); | ||
120 | + } | ||
121 | + RExC_parse++; | ||
122 | + vFAIL("Unexpected ']' with no following ')' in (?[..."); | ||
123 | } | ||
124 | |||
125 | RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1; | ||
126 | } | ||
127 | |||
128 | - no_close: | ||
129 | /* We output the messages even if warnings are off, because we'll fail | ||
130 | * the very next thing, and these give a likely diagnosis for that */ | ||
131 | if (posix_warnings && av_tindex_nomg(posix_warnings) >= 0) { | ||
132 | output_or_return_posix_warnings(pRExC_state, posix_warnings, NULL); | ||
133 | } | ||
134 | |||
135 | - FAIL("Syntax error in (?[...])"); | ||
136 | + vFAIL("Syntax error in (?[...])"); | ||
137 | } | ||
138 | |||
139 | /* Pass 2 only after this. */ | ||
140 | @@ -15105,12 +15111,14 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, | ||
141 | * inversion list, and RExC_parse points to the trailing | ||
142 | * ']'; the next character should be the ')' */ | ||
143 | RExC_parse++; | ||
144 | - assert(UCHARAT(RExC_parse) == ')'); | ||
145 | + if (UCHARAT(RExC_parse) != ')') | ||
146 | + vFAIL("Expecting close paren for nested extended charclass"); | ||
147 | |||
148 | /* Then the ')' matching the original '(' handled by this | ||
149 | * case: statement */ | ||
150 | RExC_parse++; | ||
151 | - assert(UCHARAT(RExC_parse) == ')'); | ||
152 | + if (UCHARAT(RExC_parse) != ')') | ||
153 | + vFAIL("Expecting close paren for wrapper for nested extended charclass"); | ||
154 | |||
155 | RExC_flags = save_flags; | ||
156 | goto handle_operand; | ||
157 | diff --git a/t/lib/warnings/regcomp b/t/lib/warnings/regcomp | ||
158 | index 2b084c59b02..51ad57ccbe3 100644 | ||
159 | --- a/t/lib/warnings/regcomp | ||
160 | +++ b/t/lib/warnings/regcomp | ||
161 | @@ -59,21 +59,21 @@ Unmatched [ in regex; marked by <-- HERE in m/abc[ <-- HERE fi[.00./ at - line | ||
162 | qr/(?[[[:word]]])/; | ||
163 | EXPECT | ||
164 | Assuming NOT a POSIX class since there is no terminating ':' in regex; marked by <-- HERE in m/(?[[[:word <-- HERE ]]])/ at - line 2. | ||
165 | -syntax error in (?[...]) in regex m/(?[[[:word]]])/ at - line 2. | ||
166 | +Unexpected ']' with no following ')' in (?[... in regex; marked by <-- HERE in m/(?[[[:word]] <-- HERE ])/ at - line 2. | ||
167 | ######## | ||
168 | # NAME qr/(?[ [[:digit: ])/ | ||
169 | # OPTION fatal | ||
170 | qr/(?[[[:digit: ])/; | ||
171 | EXPECT | ||
172 | Assuming NOT a POSIX class since no blanks are allowed in one in regex; marked by <-- HERE in m/(?[[[:digit: ] <-- HERE )/ at - line 2. | ||
173 | -syntax error in (?[...]) in regex m/(?[[[:digit: ])/ at - line 2. | ||
174 | +syntax error in (?[...]) in regex; marked by <-- HERE in m/(?[[[:digit: ]) <-- HERE / at - line 2. | ||
175 | ######## | ||
176 | # NAME qr/(?[ [:digit: ])/ | ||
177 | # OPTION fatal | ||
178 | qr/(?[[:digit: ])/ | ||
179 | EXPECT | ||
180 | Assuming NOT a POSIX class since no blanks are allowed in one in regex; marked by <-- HERE in m/(?[[:digit: ] <-- HERE )/ at - line 2. | ||
181 | -syntax error in (?[...]) in regex m/(?[[:digit: ])/ at - line 2. | ||
182 | +syntax error in (?[...]) in regex; marked by <-- HERE in m/(?[[:digit: ]) <-- HERE / at - line 2. | ||
183 | ######## | ||
184 | # NAME [perl #126141] | ||
185 | # OPTION fatal | ||
186 | diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t | ||
187 | index d26a7caf378..5194d937519 100644 | ||
188 | --- a/t/re/reg_mesg.t | ||
189 | +++ b/t/re/reg_mesg.t | ||
190 | @@ -215,8 +215,9 @@ my @death = | ||
191 | '/\b{gc}/' => "'gc' is an unknown bound type {#} m/\\b{gc{#}}/", | ||
192 | '/\B{gc}/' => "'gc' is an unknown bound type {#} m/\\B{gc{#}}/", | ||
193 | |||
194 | - '/(?[[[::]]])/' => "Syntax error in (?[...]) in regex m/(?[[[::]]])/", | ||
195 | - '/(?[[[:w:]]])/' => "Syntax error in (?[...]) in regex m/(?[[[:w:]]])/", | ||
196 | + | ||
197 | + '/(?[[[::]]])/' => "Unexpected ']' with no following ')' in (?[... {#} m/(?[[[::]]{#}])/", | ||
198 | + '/(?[[[:w:]]])/' => "Unexpected ']' with no following ')' in (?[... {#} m/(?[[[:w:]]{#}])/", | ||
199 | '/(?[[:w:]])/' => "", | ||
200 | '/([.].*)[.]/' => "", # [perl #127582] | ||
201 | '/[.].*[.]/' => "", # [perl #127604] | ||
202 | @@ -239,11 +240,12 @@ my @death = | ||
203 | '/(?[ \p{foo} ])/' => 'Can\'t find Unicode property definition "foo" {#} m/(?[ \p{foo}{#} ])/', | ||
204 | '/(?[ \p{ foo = bar } ])/' => 'Can\'t find Unicode property definition "foo = bar" {#} m/(?[ \p{ foo = bar }{#} ])/', | ||
205 | '/(?[ \8 ])/' => 'Unrecognized escape \8 in character class {#} m/(?[ \8{#} ])/', | ||
206 | - '/(?[ \t ]/' => 'Syntax error in (?[...]) in regex m/(?[ \t ]/', | ||
207 | - '/(?[ [ \t ]/' => 'Syntax error in (?[...]) in regex m/(?[ [ \t ]/', | ||
208 | - '/(?[ \t ] ]/' => 'Syntax error in (?[...]) in regex m/(?[ \t ] ]/', | ||
209 | - '/(?[ [ ] ]/' => 'Syntax error in (?[...]) in regex m/(?[ [ ] ]/', | ||
210 | - '/(?[ \t + \e # This was supposed to be a comment ])/' => 'Syntax error in (?[...]) in regex m/(?[ \t + \e # This was supposed to be a comment ])/', | ||
211 | + '/(?[ \t ]/' => "Unexpected ']' with no following ')' in (?[... {#} m/(?[ \\t ]{#}/", | ||
212 | + '/(?[ [ \t ]/' => "Syntax error in (?[...]) {#} m/(?[ [ \\t ]{#}/", | ||
213 | + '/(?[ \t ] ]/' => "Unexpected ']' with no following ')' in (?[... {#} m/(?[ \\t ]{#} ]/", | ||
214 | + '/(?[ [ ] ]/' => "Syntax error in (?[...]) {#} m/(?[ [ ] ]{#}/", | ||
215 | + '/(?[ \t + \e # This was supposed to be a comment ])/' => | ||
216 | + "Syntax error in (?[...]) {#} m/(?[ \\t + \\e # This was supposed to be a comment ]){#}/", | ||
217 | '/(?[ ])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[ {#}])/', | ||
218 | 'm/(?[[a-\d]])/' => 'False [] range "a-\d" {#} m/(?[[a-\d{#}]])/', | ||
219 | 'm/(?[[\w-x]])/' => 'False [] range "\w-" {#} m/(?[[\w-{#}x]])/', | ||
220 | @@ -431,10 +433,10 @@ my @death_utf8 = mark_as_utf8( | ||
221 | |||
222 | '/ネ\p{}ネ/' => 'Empty \p{} {#} m/ネ\p{{#}}ネ/', | ||
223 | |||
224 | - '/ネ(?[[[:ネ]]])ネ/' => "Syntax error in (?[...]) in regex m/ネ(?[[[:ネ]]])ネ/", | ||
225 | - '/ネ(?[[[:ネ: ])ネ/' => "Syntax error in (?[...]) in regex m/ネ(?[[[:ネ: ])ネ/", | ||
226 | - '/ネ(?[[[::]]])ネ/' => "Syntax error in (?[...]) in regex m/ネ(?[[[::]]])ネ/", | ||
227 | - '/ネ(?[[[:ネ:]]])ネ/' => "Syntax error in (?[...]) in regex m/ネ(?[[[:ネ:]]])ネ/", | ||
228 | + '/ネ(?[[[:ネ]]])ネ/' => "Unexpected ']' with no following ')' in (?[... {#} m/ネ(?[[[:ネ]]{#}])ネ/", | ||
229 | + '/ネ(?[[[:ネ: ])ネ/' => "Syntax error in (?[...]) {#} m/ネ(?[[[:ネ: ])ネ{#}/", | ||
230 | + '/ネ(?[[[::]]])ネ/' => "Unexpected ']' with no following ')' in (?[... {#} m/ネ(?[[[::]]{#}])ネ/", | ||
231 | + '/ネ(?[[[:ネ:]]])ネ/' => "Unexpected ']' with no following ')' in (?[... {#} m/ネ(?[[[:ネ:]]{#}])ネ/", | ||
232 | '/ネ(?[[:ネ:]])ネ/' => "", | ||
233 | '/ネ(?[ネ])ネ/' => 'Unexpected character {#} m/ネ(?[ネ{#}])ネ/', | ||
234 | '/ネ(?[ + [ネ] ])/' => 'Unexpected binary operator \'+\' with no preceding operand {#} m/ネ(?[ +{#} [ネ] ])/', | ||
235 | @@ -447,8 +449,9 @@ my @death_utf8 = mark_as_utf8( | ||
236 | '/(?[ \x{ネ} ])ネ/' => 'Non-hex character {#} m/(?[ \x{ネ{#}} ])ネ/', | ||
237 | '/(?[ \p{ネ} ])/' => 'Can\'t find Unicode property definition "ネ" {#} m/(?[ \p{ネ}{#} ])/', | ||
238 | '/(?[ \p{ ネ = bar } ])/' => 'Can\'t find Unicode property definition "ネ = bar" {#} m/(?[ \p{ ネ = bar }{#} ])/', | ||
239 | - '/ネ(?[ \t ]/' => 'Syntax error in (?[...]) in regex m/ネ(?[ \t ]/', | ||
240 | - '/(?[ \t + \e # ネ This was supposed to be a comment ])/' => 'Syntax error in (?[...]) in regex m/(?[ \t + \e # ネ This was supposed to be a comment ])/', | ||
241 | + '/ネ(?[ \t ]/' => "Unexpected ']' with no following ')' in (?[... {#} m/ネ(?[ \\t ]{#}/", | ||
242 | + '/(?[ \t + \e # ネ This was supposed to be a comment ])/' => | ||
243 | + "Syntax error in (?[...]) {#} m/(?[ \\t + \\e # ネ This was supposed to be a comment ]){#}/", | ||
244 | 'm/(*ネ)ネ/' => q<Unknown verb pattern 'ネ' {#} m/(*ネ){#}ネ/>, | ||
245 | '/\cネ/' => "Character following \"\\c\" must be printable ASCII", | ||
246 | '/\b{ネ}/' => "'ネ' is an unknown bound type {#} m/\\b{ネ{#}}/", | ||
247 | diff --git a/t/re/regex_sets.t b/t/re/regex_sets.t | ||
248 | index 6a79f9d6928..e9644bd4e61 100644 | ||
249 | --- a/t/re/regex_sets.t | ||
250 | +++ b/t/re/regex_sets.t | ||
251 | @@ -158,13 +158,13 @@ for my $char ("٠", "٥", "٩") { | ||
252 | eval { $_ = '/(?[(\c]) /'; qr/$_/ }; | ||
253 | like($@, qr/^Syntax error/, '/(?[(\c]) / should not panic'); | ||
254 | eval { $_ = '(?[\c#]' . "\n])"; qr/$_/ }; | ||
255 | - like($@, qr/^Syntax error/, '/(?[(\c]) / should not panic'); | ||
256 | + like($@, qr/^Unexpected/, '/(?[(\c]) / should not panic'); | ||
257 | eval { $_ = '(?[(\c])'; qr/$_/ }; | ||
258 | like($@, qr/^Syntax error/, '/(?[(\c])/ should be a syntax error'); | ||
259 | eval { $_ = '(?[(\c]) ]\b'; qr/$_/ }; | ||
260 | - like($@, qr/^Syntax error/, '/(?[(\c]) ]\b/ should be a syntax error'); | ||
261 | + like($@, qr/^Unexpected/, '/(?[(\c]) ]\b/ should be a syntax error'); | ||
262 | eval { $_ = '(?[\c[]](])'; qr/$_/ }; | ||
263 | - like($@, qr/^Syntax error/, '/(?[\c[]](])/ should be a syntax error'); | ||
264 | + like($@, qr/^Unexpected/, '/(?[\c[]](])/ should be a syntax error'); | ||
265 | like("\c#", qr/(?[\c#])/, '\c# should match itself'); | ||
266 | like("\c[", qr/(?[\c[])/, '\c[ should match itself'); | ||
267 | like("\c\ ", qr/(?[\c\])/, '\c\ should match itself'); | ||