import perl-5.24.4-403.module+el8+2770+c759b41a

This commit is contained in:
CentOS Sources 2019-05-07 07:02:12 -04:00 committed by Andrew Lukoshko
parent 80a9263a5a
commit 7b4965ae13
6 changed files with 613 additions and 7 deletions

View File

@ -0,0 +1,270 @@
From 10ce49389ea9ee26a3b02b6494b0a3849d56c6fa Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
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(-)
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 106fe41121..c29925a2a4 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -5904,7 +5904,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.
@@ -6402,6 +6402,31 @@ to find out why that isn't happening.
(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/pod/perlrecharclass.pod b/pod/perlrecharclass.pod
index 79480e4131..8c008507d1 100644
--- a/pod/perlrecharclass.pod
+++ b/pod/perlrecharclass.pod
@@ -1128,8 +1128,8 @@ hence both of the following work:
Any contained POSIX character classes, including things like C<\w> and C<\D>
respect the C<E<sol>a> (and C<E<sol>aa>) 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/regcomp.c b/regcomp.c
index 4ee48ede42..ddac290d2b 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -14840,8 +14840,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;
@@ -14898,9 +14899,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);
@@ -14912,20 +14913,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 && av_tindex_nomg(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. */
@@ -15105,12 +15111,14 @@ 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;
diff --git a/t/lib/warnings/regcomp b/t/lib/warnings/regcomp
index 2b084c59b0..51ad57ccbe 100644
--- a/t/lib/warnings/regcomp
+++ b/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/t/re/reg_mesg.t b/t/re/reg_mesg.t
index d26a7caf37..5194d93751 100644
--- a/t/re/reg_mesg.t
+++ b/t/re/reg_mesg.t
@@ -215,8 +215,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:]])/' => "",
'/([.].*)[.]/' => "", # [perl #127582]
'/[.].*[.]/' => "", # [perl #127604]
@@ -239,11 +240,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]])/',
@@ -431,10 +433,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/ネ(?[ +{#} [ネ] ])/',
@@ -447,8 +449,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<Unknown verb pattern 'ネ' {#} m/(*ネ){#}ネ/>,
'/\cネ/' => "Character following \"\\c\" must be printable ASCII",
'/\b{ネ}/' => "'ネ' is an unknown bound type {#} m/\\b{ネ{#}}/",
diff --git a/t/re/regex_sets.t b/t/re/regex_sets.t
index 6a79f9d692..e9644bd4e6 100644
--- a/t/re/regex_sets.t
+++ b/t/re/regex_sets.t
@@ -158,13 +158,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');
--
2.11.0

View File

@ -0,0 +1,44 @@
diff -up perl-5.24.4/Makefile.SH.orig perl-5.24.4/Makefile.SH
--- perl-5.24.4/Makefile.SH.orig 2018-10-02 12:18:23.627226701 +0200
+++ perl-5.24.4/Makefile.SH 2018-10-02 13:35:03.858920366 +0200
@@ -451,6 +451,8 @@ CCCMD = sh $(shellflags) cflags "opti
CCCMDSRC = sh $(shellflags) cflags "optimize='$(OPTIMIZE)'" $<
+DTRACEFLAGS = sh $(shellflags) cflags "optimize='$(OPTIMIZE)'" $@
+
CONFIGPM_FROM_CONFIG_SH = lib/Config.pm lib/Config_heavy.pl
CONFIGPM = $(CONFIGPM_FROM_CONFIG_SH) lib/Config_git.pl
@@ -865,13 +867,13 @@ mydtrace.h: $(DTRACE_H)
define)
$spitshell >>$Makefile <<'!NO!SUBS!'
$(DTRACE_MINI_O): perldtrace.d $(miniperl_objs_nodt)
- $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MINI_O) $(miniperl_objs_nodt)
+ CFLAGS="`$(DTRACEFLAGS)`" $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MINI_O) $(miniperl_objs_nodt)
$(DTRACE_PERLLIB_O): perldtrace.d $(perllib_objs_nodt)
- $(DTRACE) -G -s perldtrace.d -o $(DTRACE_PERLLIB_O) $(perllib_objs_nodt)
+ CFLAGS="`$(DTRACEFLAGS)`" $(DTRACE) -G -s perldtrace.d -o $(DTRACE_PERLLIB_O) $(perllib_objs_nodt)
$(DTRACE_MAIN_O): perldtrace.d perlmain$(OBJ_EXT)
- $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MAIN_O) perlmain$(OBJ_EXT)
+ CFLAGS="`$(DTRACEFLAGS)`" $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MAIN_O) perlmain$(OBJ_EXT)
!NO!SUBS!
;;
diff -up perl-5.24.4/cflags.SH.orig perl-5.24.4/cflags.SH
--- perl-5.24.4/cflags.SH.orig 2018-10-02 14:37:09.368649895 +0200
+++ perl-5.24.4/cflags.SH 2018-10-02 14:39:10.785695193 +0200
@@ -518,7 +518,10 @@ for file do
esac
# Can we perhaps use $ansi2knr here
- echo "$cc -c -DPERL_CORE $ccflags $stdflags $optimize $warn $extra"
+ case "$file" in
+ dtrace_*) echo "$ccflags $stdflags $optimize $warn $extra";;
+ *) echo "$cc -c -DPERL_CORE $ccflags $stdflags $optimize $warn $extra"
+ esac
. $TOP/config.sh

View File

@ -0,0 +1,175 @@
From 34716e2a6ee2af96078d62b065b7785c001194be Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
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(-)
diff --git a/util.c b/util.c
index 7282dd9cfe..c5c7becc0f 100644
--- a/util.c
+++ b/util.c
@@ -2162,8 +2162,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)
{
@@ -2179,28 +2211,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<max; j++) { /* copy environment */
- const int len = strlen(environ[j]);
- tmpenv[j] = (char*)safesysmalloc((len+1)*sizeof(char));
+ const Size_t len = strlen(environ[j]);
+ tmpenv[j] = S_env_alloc(NULL, len, 1, 0, 1);
Copy(environ[j], tmpenv[j], len+1, char);
}
tmpenv[max] = NULL;
@@ -2219,15 +2250,15 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
#endif
}
if (!environ[i]) { /* does not exist yet */
- environ = (char**)safesysrealloc(environ, (i+2) * sizeof(char*));
+ environ = (char**)S_env_alloc(environ, i, 2, 0, sizeof(char*));
environ[i+1] = NULL; /* make sure it's null terminated */
}
else
safesysfree(environ[i]);
- nlen = strlen(nam);
+
vlen = strlen(val);
- environ[i] = (char*)safesysmalloc((nlen+vlen+2) * sizeof(char));
+ environ[i] = S_env_alloc(NULL, nlen, vlen, 2, 1);
/* all that work just for this */
my_setenv_format(environ[i], nam, nlen, val, vlen);
} else {
@@ -2252,22 +2283,21 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
if (environ) /* old glibc can crash with null environ */
(void)unsetenv(nam);
} else {
- const int nlen = strlen(nam);
- const int vlen = strlen(val);
- char * const new_env =
- (char*)safesysmalloc((nlen + vlen + 2) * sizeof(char));
+ const Size_t nlen = strlen(nam);
+ const Size_t vlen = strlen(val);
+ char * const new_env = S_env_alloc(NULL, nlen, vlen, 2, 1);
my_setenv_format(new_env, nam, nlen, val, vlen);
(void)putenv(new_env);
}
# else /* ! HAS_UNSETENV */
char *new_env;
- const int nlen = strlen(nam);
- int vlen;
+ const Size_t nlen = strlen(nam);
+ Size_t vlen;
if (!val) {
val = "";
}
vlen = strlen(val);
- new_env = (char*)safesysmalloc((nlen + vlen + 2) * sizeof(char));
+ new_env = S_env_alloc(NULL, nlen, vlen, 2, 1);
/* all that work just for this */
my_setenv_format(new_env, nam, nlen, val, vlen);
(void)putenv(new_env);
@@ -2290,14 +2320,14 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
{
dVAR;
char *envstr;
- const int nlen = strlen(nam);
- int vlen;
+ const Size_t nlen = strlen(nam);
+ Size_t vlen;
if (!val) {
val = "";
}
vlen = strlen(val);
- Newx(envstr, nlen+vlen+2, char);
+ envstr = S_env_alloc(NULL, nlen, vlen, 2, 1);
my_setenv_format(envstr, nam, nlen, val, vlen);
(void)PerlEnv_putenv(envstr);
Safefree(envstr);
--
2.17.1

View File

@ -0,0 +1,53 @@
From cc56be313c7d4e7c266c01dabc762a153d5b2c28 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
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(-)
diff --git a/regcomp.c b/regcomp.c
index d0d08352c0..2bee9d4460 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -11793,7 +11793,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
@@ -12493,9 +12494,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);
@@ -15963,7 +15966,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);
--
2.11.0

View File

@ -37,7 +37,7 @@
Name: perl Name: perl
Version: %{perl_version} Version: %{perl_version}
# release number must be even higher, because dual-lived modules will be broken otherwise # release number must be even higher, because dual-lived modules will be broken otherwise
Release: 398%{?dist} Release: 403%{?dist}
Epoch: %{perl_epoch} Epoch: %{perl_epoch}
Summary: Practical Extraction and Report Language Summary: Practical Extraction and Report Language
# These are all found licenses. They are distributed among various # These are all found licenses. They are distributed among various
@ -411,6 +411,22 @@ Patch127: perl-5.24.3-fix-parsing-of-braced-subscript-after-parens.patch
# Adjust tests to gdbm-1.15, RT#133295 # Adjust tests to gdbm-1.15, RT#133295
Patch128: perl-5.24.4-Remove-ext-GDBM_File-t-fatal.t.patch Patch128: perl-5.24.4-Remove-ext-GDBM_File-t-fatal.t.patch
# Pass the correct CFLAGS to dtrace
Patch129: perl-5.24.4-Pass-CFLAGS-to-dtrace.patch
# Fix an integer wrap when allocating memory for an environment variable,
# RT#133204, in upstream after 5.29.0 - CVE-2018-18311
Patch130: perl-5.24.4-Perl_my_setenv-handle-integer-wrap.patch
# Fix heap-buffer-overflow write in S_regatom (regcomp.c) CVE-2018-18314
Patch131: perl-5.24.4-Fix-131649-extended-charclass-can-trigger-assert.patch
# Fix heap-buffer-overflow write in S_regatom (regcomp.c) CVE-2018-18312
Patch132: perl-5.24.4-Fix-heap-buffer-overflow-write-reg_node-overrun.patch
# Fix heap-buffer-overflow read in S_grok_bslash_N (regcomp.c) - CVE-2018-18313
Patch133: perl-5.28.1-regcomp.c-Convert-some-strchr-to-memchr.patch
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048 # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
@ -464,11 +480,6 @@ BuildRequires: rsyslog
# compat macro needed for rebuild # compat macro needed for rebuild
%global perl_compat perl(:MODULE_COMPAT_5.24.4) %global perl_compat perl(:MODULE_COMPAT_5.24.4)
# perl-interpreter denotes a package with the perl executable.
# Full EVR is for compatibility with systems that swapped perl and perl-core
# <https://fedoraproject.org/wiki/Changes/perl_Package_to_Install_Core_Modules>.
Provides: perl-interpreter = %{perl_epoch}:%{perl_version}-%{release}
# File provides # File provides
Provides: perl(bytes_heavy.pl) Provides: perl(bytes_heavy.pl)
Provides: perl(dumpvar.pl) Provides: perl(dumpvar.pl)
@ -480,6 +491,9 @@ Obsoletes: perl-suidperl <= 4:5.12.2
Requires: perl-libs%{?_isa} = %{perl_epoch}:%{perl_version}-%{release} Requires: perl-libs%{?_isa} = %{perl_epoch}:%{perl_version}-%{release}
# Require this till perl sub-package requires any modules # Require this till perl sub-package requires any modules
Requires: %perl_compat Requires: %perl_compat
# Require perl-interpreter to maintain compatibility (previous perl
# package provided perl-interpreter symbol), bug #1670435
Requires: perl-interpreter%{?_isa} = %{perl_epoch}:%{perl_version}-%{release}
%if %{defined perl_bootstrap} %if %{defined perl_bootstrap}
%gendep_perl %gendep_perl
%endif %endif
@ -661,11 +675,12 @@ Requires: perl-Compress-Raw-Bzip2,
Requires: perl-Carp, perl-Compress-Raw-Zlib, perl-Config-Perl-V, Requires: perl-Carp, perl-Compress-Raw-Zlib, perl-Config-Perl-V,
Requires: perl-constant, Requires: perl-constant,
Requires: perl-CPAN, perl-CPAN-Meta, perl-CPAN-Meta-Requirements, Requires: perl-CPAN, perl-CPAN-Meta, perl-CPAN-Meta-Requirements,
Requires: perl-CPAN-Meta-YAML, perl-Encode, perl-encoding Requires: perl-CPAN-Meta-YAML
Requires: perl-Data-Dumper, perl-DB_File, Requires: perl-Data-Dumper, perl-DB_File,
Requires: perl-Devel-Peek, perl-Devel-PPPort, perl-Devel-SelfStubber, Requires: perl-Devel-Peek, perl-Devel-PPPort, perl-Devel-SelfStubber,
Requires: perl-Digest, perl-Digest-MD5, Requires: perl-Digest, perl-Digest-MD5,
Requires: perl-Digest-SHA, Requires: perl-Digest-SHA,
Requires: perl-Encode, perl-Encode-devel, perl-encoding
Requires: perl-Env, perl-Errno, perl-Exporter, perl-experimental Requires: perl-Env, perl-Errno, perl-Exporter, perl-experimental
Requires: perl-ExtUtils-CBuilder, perl-ExtUtils-Command, Requires: perl-ExtUtils-CBuilder, perl-ExtUtils-Command,
Requires: perl-ExtUtils-Embed, Requires: perl-ExtUtils-Embed,
@ -711,6 +726,26 @@ Requires: perl-version, perl-threads, perl-threads-shared, perl-parent
A metapackage which requires all of the perl bits and modules in the upstream A metapackage which requires all of the perl bits and modules in the upstream
tarball from perl.org. tarball from perl.org.
%package interpreter
Summary: Standalone executable Perl interpreter
# This package doesn't contain any copyrightable material.
# Nevertheless, it needs a License tag, so we'll use the generic
# "perl" license.
License: GPL+ or Artistic
# perl-interpreter denotes a package with the perl executable.
# Full EVR is for compatibility with systems that swapped perl and perl-core
# <https://fedoraproject.org/wiki/Changes/perl_Package_to_Install_Core_Modules>,
# bug #1464903.
# This dummy package exists to mask same-named non-modular package. Otherwise
# package manager can see non-modular package that coincidently obsoletes
# perl package and that confuses the manager, bug #1670435.
Version: %{perl_version}
Epoch: %{perl_epoch}
Requires: perl%{?_isa} = %{perl_epoch}:%{perl_version}-%{release}
%description interpreter
This is a dummy package to improve a compatibility with future Perls that will use
this package to deliver %{_bindir}/perl Perl interpreter.
%if %{dual_life} || %{rebuild_from_scratch} %if %{dual_life} || %{rebuild_from_scratch}
%package Archive-Tar %package Archive-Tar
@ -3058,6 +3093,11 @@ popd
%patch126 -p1 %patch126 -p1
%patch127 -p1 %patch127 -p1
%patch128 -p1 %patch128 -p1
%patch129 -p1
%patch130 -p1
%patch131 -p1
%patch132 -p1
%patch133 -p1
%patch200 -p1 %patch200 -p1
%patch201 -p1 %patch201 -p1
@ -3149,6 +3189,7 @@ perl -x patchlevel.h \
'Fedora Patch126: Link XS modules to pthread library to fix linking with -z defs' \ 'Fedora Patch126: Link XS modules to pthread library to fix linking with -z defs' \
'Fedora Patch127: Fix parsing braced subscript after parentheses (RT#8045)' \ 'Fedora Patch127: Fix parsing braced subscript after parentheses (RT#8045)' \
'Fedora Patch128: Adjust tests to gdbm-1.15 (RT#133295)' \ 'Fedora Patch128: Adjust tests to gdbm-1.15 (RT#133295)' \
'Fedora Patch129: Pass the correct CFLAGS to dtrace' \
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \ 'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \ 'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
%{nil} %{nil}
@ -5441,8 +5482,31 @@ popd
%files core %files core
# Nothing. Nada. Zilch. Zarro. Uh uh. Nope. Sorry. # Nothing. Nada. Zilch. Zarro. Uh uh. Nope. Sorry.
%files interpreter
# Empty on purpose.
# Old changelog entries are preserved in CVS. # Old changelog entries are preserved in CVS.
%changelog %changelog
* Thu Feb 07 2019 Petr Pisar <ppisar@redhat.com> - 4:5.24.4-403
- Require perl-interpreter from perl (bug #1670435)
* Thu Jan 31 2019 Petr Pisar <ppisar@redhat.com> - 4:5.24.4-402
- Add a dummy perl-interpreter package to mask non-modular one (bug #1670435)
* Wed Dec 05 2018 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.24.4-401
- Resolves: #1656293
- Fix CVE-2018-18311 Integer overflow leading to buffer overflow
- Fix CVE-2018-18312 Heap-buffer-overflow write in regcomp.c
- Fix CVE-2018-18313 Heap-buffer-overflow read in regcomp.c
- Fix CVE-2018-18314 Heap-buffer-overflow write in regcomp.c
* Fri Nov 02 2018 Petr Pisar <ppisar@redhat.com> - 4:5.24.4-400
- Install Encode developmental files when installing complete Perl
(bug #1645225)
* Tue Oct 02 2018 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.24.4-399
- Fix annocheck failure by passing CFLAGS to dtrace (bug #1630617)
* Mon Jul 09 2018 Petr Pisar <ppisar@redhat.com> - 4:5.24.4-398 * Mon Jul 09 2018 Petr Pisar <ppisar@redhat.com> - 4:5.24.4-398
- Adjust tests to gdbm-1.15 (RT#133295) - Adjust tests to gdbm-1.15 (RT#133295)