aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNatanael Copa <ncopa@alpinelinux.org>2018-12-04 14:40:59 +0000
committerNatanael Copa <ncopa@alpinelinux.org>2018-12-04 17:27:53 +0100
commit17a345542d7049381a2bafa85893bda2cfc61358 (patch)
treeeaab087fb82105f072a90cb22de6e0d08b1f61eb
parenta6a6bcff1f6b6dcf3aa2991d43f73b1948084d66 (diff)
downloadalpine_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/APKBUILD17
-rw-r--r--main/perl/CVE-2018-18311.patch174
-rw-r--r--main/perl/CVE-2018-18312.patch47
-rw-r--r--main/perl/CVE-2018-18313.patch105
-rw-r--r--main/perl/CVE-2018-18314.patch267
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>
4pkgname=perl 4pkgname=perl
5pkgver=5.24.4 5pkgver=5.24.4
6pkgrel=1 6pkgrel=2
7pkgdesc="Larry Wall's Practical Extraction and Report Language" 7pkgdesc="Larry Wall's Practical Extraction and Report Language"
8url="http://www.perl.org/" 8url="http://www.perl.org/"
9arch="all" 9arch="all"
@@ -15,9 +15,18 @@ makedepends="bzip2-dev zlib-dev"
15subpackages="$pkgname-doc $pkgname-dev $pkgname-utils::noarch miniperl" 15subpackages="$pkgname-doc $pkgname-dev $pkgname-utils::noarch miniperl"
16source="http://www.cpan.org/src/5.0/perl-$pkgver.tar.gz 16source="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
142sha512sums="796d92f47860ac0e3a22d85eb129549c4251445b3cfa8687e305c95f6205ad32a670e0d680e20245e47f0c6567b313748bce1db04208b21ff10595196e37a40b perl-5.24.4.tar.gz 151sha512sums="796d92f47860ac0e3a22d85eb129549c4251445b3cfa8687e305c95f6205ad32a670e0d680e20245e47f0c6567b313748bce1db04208b21ff10595196e37a40b perl-5.24.4.tar.gz
143feda381bd3230443341b99135bac4d6010e9d28b619d9fb57f2dda2c29b8877f012f76d31631e5227ef79e73e0b2b162548fa24704752e61f10c05d015c68916 CVE-2018-12015.patch" 152feda381bd3230443341b99135bac4d6010e9d28b619d9fb57f2dda2c29b8877f012f76d31631e5227ef79e73e0b2b162548fa24704752e61f10c05d015c68916 CVE-2018-12015.patch
153c1af39d5f293cb83b5ce8cea0835a52470cc2aa67cf541bfc20fd25c815cd9124cb6d91df979235868223ba2244ceed1336e304e10df74b40b706268ffc2b8c1 CVE-2018-18311.patch
154f785a9b94311a4a8dfdf811006c8eb540808d75922d7d5c48e567c949ebf0dc4fe2641163e1220db3a29d650c2d35ed278bb3867f8ebe626faad05bf75d32ad1 CVE-2018-18312.patch
155bcc8438fc8bceef83b23dac2e788ceb5d70f645054b5d04c555004ccfe2f85a83f835b387ee318e1ca8668afb7601eeacfc4355e8a70e98549c15b1521555318 CVE-2018-18313.patch
156df59c1cb4ca8d651d544524ae01c092f0451ec27f7d821bc7e61e1b7385161e241797e84ae85782b3869d432bca72a93bfe71590a1cf879f7c5a11b780d3c4dd 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 @@
1From 5737d31aac51360cc1eb412ef059e36147c9d6d6 Mon Sep 17 00:00:00 2001
2From: David Mitchell <davem@iabyn.com>
3Date: Fri, 29 Jun 2018 13:37:03 +0100
4Subject: [PATCH] Perl_my_setenv(); handle integer wrap
5
6RT #133204
7
8Wean this function off int/I32 and onto UV/Size_t.
9Also, replace all malloc-ish calls with a wrapper that does
10overflow checks,
11
12In particular, it was doing (nlen + vlen + 2) which could wrap when
13the combined length of the environment variable name and value
14exceeded around 0x7fffffff.
15
16The wrapper check function is probably overkill, but belt and braces...
17
18NB this function has several variant parts, #ifdef'ed by platform
19type; 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
26diff --git a/util.c b/util.c
27index 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 @@
1From df2858ea28eb2c7e00a4bd6a5ed95e4782f88333 Mon Sep 17 00:00:00 2001
2From: Karl Williamson <khw@cpan.org>
3Date: Mon, 24 Sep 2018 11:54:41 -0600
4Subject: [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
11diff --git a/regcomp.c b/regcomp.c
12index 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 }
23diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
24index 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--
462.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 @@
1From ff4e2b11ab19d0c806a3dc09308d1b393971b8aa Mon Sep 17 00:00:00 2001
2From: =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= <ilmari@ilmari.org>
3Date: Mon, 14 Nov 2016 20:05:31 +0100
4Subject: [PATCH] Fix error message for unclosed \N{ in regcomp
5
6An unclosed \N{ that made it through to the regex engine rather than
7being handled by the lexer would erroneously trigger the error for
8"\N{NAME} must be resolved by the lexer".
9
10This separates the check for the missing trailing } and issues the
11correct error message for this.
12---
13 regcomp.c | 8 +++++---
14 t/re/re_tests | 5 ++++-
15 2 files changed, 9 insertions(+), 4 deletions(-)
16
17diff --git a/regcomp.c b/regcomp.c
18index 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
40diff --git a/t/re/re_tests b/t/re/re_tests
41index 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
56From c1c28ce6ba90ee05aa96b11ad551a6063680f3b9 Mon Sep 17 00:00:00 2001
57From: Karl Williamson <khw@cpan.org>
58Date: Sat, 25 Mar 2017 15:00:22 -0600
59Subject: [PATCH] regcomp.c: Convert some strchr to memchr
60
61This allows things to work properly in the face of embedded NULs.
62See 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
69diff --git a/regcomp.c b/regcomp.c
70index 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 @@
1From dabe076af345ab4512ea80245b4e4cd7ec0996cd Mon Sep 17 00:00:00 2001
2From: Yves Orton <demerphq@gmail.com>
3Date: Mon, 26 Jun 2017 13:19:55 +0200
4Subject: [PATCH] fix #131649 - extended charclass can trigger assert
5
6The extended charclass parser makes some assumptions during the
7first pass which are only true on well structured input, and it
8does not properly catch various errors. later on the code assumes
9that things the first pass will let through are valid, when in
10fact 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
22diff --git a/pod/perldiag.pod b/pod/perldiag.pod
23index 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
67diff --git a/pod/perlrecharclass.pod b/pod/perlrecharclass.pod
68index 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
82diff --git a/regcomp.c b/regcomp.c
83index 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;
157diff --git a/t/lib/warnings/regcomp b/t/lib/warnings/regcomp
158index 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
186diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
187index 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{ネ{#}}/",
247diff --git a/t/re/regex_sets.t b/t/re/regex_sets.t
248index 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');