From 1e1229f9142f4af67d3b01e50e844c4a693a4be2 Mon Sep 17 00:00:00 2001 From: h30032433 Date: Mon, 11 Dec 2023 17:32:32 +0800 Subject: [PATCH] Fix CVE-2023-47038, CVE-2023-47100, CVE-2023-47039 --- backport-CVE-2023-47039.patch | 200 +++++++++++++++++++ backport-CVE-2023-47100-CVE-2023-47038.patch | 124 ++++++++++++ perl.spec | 7 +- 3 files changed, 330 insertions(+), 1 deletion(-) create mode 100644 backport-CVE-2023-47039.patch create mode 100644 backport-CVE-2023-47100-CVE-2023-47038.patch diff --git a/backport-CVE-2023-47039.patch b/backport-CVE-2023-47039.patch new file mode 100644 index 0000000..930d193 --- /dev/null +++ b/backport-CVE-2023-47039.patch @@ -0,0 +1,200 @@ +From 906e92715f4ee68ea95086867f4f97b1f4f10ac3 Mon Sep 17 00:00:00 2001 +From: Tony Cook +Date: Tue, 3 Oct 2023 09:40:07 +1100 +Subject: [PATCH] win32: default the shell to cmd.exe in the Windows system + directory + +This prevents picking up cmd.exe from the current directory, or +even from the PATH. + +This protects against a privilege escalation attack where an attacker +in a separate session creates a cmd.exe in a directory where the +target account happens to have its current directory. + +Reference:https://github.com/Perl/perl5/commit/906e92715f4ee68ea95086867f4f97b1f4f10ac3 +Conflict:Context adaptation + +--- + t/win32/system.t | 30 ++++++++++++-------- + win32/win32.c | 71 +++++++++++++++++++++++++++++++++++++++++------- + 2 files changed, 79 insertions(+), 22 deletions(-) + +diff --git a/t/win32/system.t b/t/win32/system.t +index 939a02db55..c885059012 100644 +--- a/t/win32/system.t ++++ b/t/win32/system.t +@@ -82,6 +82,7 @@ close $F; + chdir($testdir); + END { + chdir($cwd) && rmtree("$cwd/$testdir") if -d "$cwd/$testdir"; ++ unlink "cmd.exe"; + } + if (open(my $EIN, "$cwd/win32/${exename}_exe.uu")) { + note "Unpacking $exename.exe"; +@@ -104,21 +105,20 @@ else { + } + note "Compiling $exename.c"; + note "$Config{cc} $Config{ccflags} $exename.c"; +- if (system("$Config{cc} $Config{ccflags} $minus_o $exename.c >log 2>&1") != 0) { ++ if (system("$Config{cc} $Config{ccflags} $minus_o $exename.c >log 2>&1") != 0 || ++ !-f "$exename.exe") { + note "Could not compile $exename.c, status $?"; +- note "Where is your C compiler?"; +- skip_all "can't build test executable"; +- } +- unless (-f "$exename.exe") { +- if (open(LOG,') { +- note $_; +- } +- } ++ note "Where is your C compiler?"; ++ if (open(LOG,') { ++ note $_; ++ } ++ } + else { +- warn "Cannot open log (in $testdir):$!"; ++ warn "Cannot open log (in $testdir):$!"; + } ++ skip_all "can't build test executable"; + } + } + copy("$plxname.bat","$plxname.cmd"); +@@ -128,6 +128,12 @@ unless (-x "$testdir/$exename.exe") { + skip_all "can't build test executable"; + } + ++# test we only look for cmd.exe in the standard place ++delete $ENV{PERLSHELL}; ++copy("$testdir/$exename.exe", "$testdir/cmd.exe") or die $!; ++copy("$testdir/$exename.exe", "cmd.exe") or die $!; ++$ENV{PATH} = qq("$testdir";$ENV{PATH}); ++ + open my $T, "$^X -I../lib -w win32/system_tests |" + or die "Can't spawn win32/system_tests: $!"; + my $expect; +diff --git a/win32/win32.c b/win32/win32.c +index 94248ca168..5d54cf8d4a 100644 +--- a/win32/win32.c ++++ b/win32/win32.c +@@ -117,7 +117,7 @@ static char* win32_get_xlib(const char *pl, + + static BOOL has_shell_metachars(const char *ptr); + static long tokenize(const char *str, char **dest, char ***destv); +-static void get_shell(void); ++static int get_shell(void); + static char* find_next_space(const char *s); + static int do_spawn2(pTHX_ const char *cmd, int exectype); + static int do_spawn2_handles(pTHX_ const char *cmd, int exectype, +@@ -600,7 +600,13 @@ tokenize(const char *str, char **dest, char ***destv) + return items; + } + +-static void ++static const char ++cmd_opts[] = "/x/d/c"; ++ ++static const char ++shell_cmd[] = "cmd.exe"; ++ ++static int + get_shell(void) + { + dTHX; +@@ -612,12 +618,53 @@ get_shell(void) + * interactive use (which is what most programs look in COMSPEC + * for). + */ +- const char* defaultshell = "cmd.exe /x/d/c"; +- const char *usershell = PerlEnv_getenv("PERL5SHELL"); +- w32_perlshell_items = tokenize(usershell ? usershell : defaultshell, +- &w32_perlshell_tokens, +- &w32_perlshell_vec); ++ const char *shell = PerlEnv_getenv("PERL5SHELL"); ++ if (shell) { ++ w32_perlshell_items = tokenize(shell, ++ &w32_perlshell_tokens, ++ &w32_perlshell_vec); ++ } ++ else { ++ /* tokenize does some Unix-ish like things like ++ \\ escaping that don't work well here ++ */ ++ char shellbuf[MAX_PATH]; ++ UINT len = GetSystemDirectoryA(shellbuf, sizeof(shellbuf)); ++ if (len == 0) { ++ translate_to_errno(); ++ return -1; ++ } ++ else if (len >= MAX_PATH) { ++ /* buffer too small */ ++ errno = E2BIG; ++ return -1; ++ } ++ if (shellbuf[len-1] != '\\') { ++ my_strlcat(shellbuf, "\\", sizeof(shellbuf)); ++ ++len; ++ } ++ if (len + sizeof(shell_cmd) > sizeof(shellbuf)) { ++ errno = E2BIG; ++ return -1; ++ } ++ my_strlcat(shellbuf, shell_cmd, sizeof(shellbuf)); ++ len += sizeof(shell_cmd)-1; ++ ++ Newx(w32_perlshell_vec, 3, char *); ++ Newx(w32_perlshell_tokens, len + 1 + sizeof(cmd_opts), char); ++ ++ my_strlcpy(w32_perlshell_tokens, shellbuf, len+1); ++ my_strlcpy(w32_perlshell_tokens + len +1, cmd_opts, ++ sizeof(cmd_opts)); ++ ++ w32_perlshell_vec[0] = w32_perlshell_tokens; ++ w32_perlshell_vec[1] = w32_perlshell_tokens + len + 1; ++ w32_perlshell_vec[2] = NULL; ++ ++ w32_perlshell_items = 2; ++ } + } ++ return 0; + } + + int +@@ -635,7 +682,9 @@ Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp) + if (sp <= mark) + return -1; + +- get_shell(); ++ if (get_shell() < 0) ++ return -1; ++ + Newx(argv, (sp - mark) + w32_perlshell_items + 2, char*); + + if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) { +@@ -765,7 +814,8 @@ do_spawn2_handles(pTHX_ const char *cmd, int exectype, const int *handles) + if (needToTry) { + char **argv; + int i = -1; +- get_shell(); ++ if (get_shell() < 0) ++ return -1; + Newx(argv, w32_perlshell_items + 2, char*); + while (++i < w32_perlshell_items) + argv[i] = w32_perlshell_vec[i]; +@@ -3482,7 +3532,8 @@ win32_pipe(int *pfd, unsigned int size, int mode) + DllExport PerlIO* + win32_popenlist(const char *mode, IV narg, SV **args) + { +- get_shell(); ++ if (get_shell() < 0) ++ return NULL; + + return do_popen(mode, NULL, narg, args); + } +-- +2.33.0 + diff --git a/backport-CVE-2023-47100-CVE-2023-47038.patch b/backport-CVE-2023-47100-CVE-2023-47038.patch new file mode 100644 index 0000000..65c596c --- /dev/null +++ b/backport-CVE-2023-47100-CVE-2023-47038.patch @@ -0,0 +1,124 @@ +From 12c313ce49b36160a7ca2e9b07ad5bd92ee4a010 Mon Sep 17 00:00:00 2001 +From: Karl Williamson +Date: Sat, 9 Sep 2023 11:59:09 -0600 +Subject: [PATCH] Fix read/write past buffer end: perl-security#140 + +A package name may be specified in a \p{...} regular expression +construct. If unspecified, "utf8::" is assumed, which is the package +all official Unicode properties are in. By specifying a different +package, one can create a user-defined property with the same +unqualified name as a Unicode one. Such a property is defined by a sub +whose name begins with "Is" or "In", and if the sub wishes to refer to +an official Unicode property, it must explicitly specify the "utf8::". +S_parse_uniprop_string() is used to parse the interior of both \p{} and +the user-defined sub lines. + +In S_parse_uniprop_string(), it parses the input "name" parameter, +creating a modified copy, "lookup_name", malloc'ed with the same size as +"name". The modifications are essentially to create a canonicalized +version of the input, with such things as extraneous white-space +stripped off. I found it convenient to strip off the package specifier +"utf8::". To to so, the code simply pretends "lookup_name" begins just +after the "utf8::", and adjusts various other values to compensate. +However, it missed the adjustment of one required one. + +This is only a problem when the property name begins with "perl" and +isn't "perlspace" nor "perlword". All such ones are undocumented +internal properties. + +What happens in this case is that the input is reparsed with slightly +different rules in effect as to what is legal versus illegal. The +problem is that "lookup_name" no longer is pointing to its initial +value, but "name" is. Thus the space allocated for filling "lookup_name" +is now shorter than "name", and as this shortened "lookup_name" is +filled by copying suitable portions of "name", the write can be to +unallocated space. + +The solution is to skip the "utf8::" when reparsing "name". Then both +"lookup_name" and "name" are effectively shortened by the same amount, +and there is no going off the end. + +This commit also does white-space adjustment so that things align +vertically for readability. + +This can be easily backported to earlier Perl releases. + +Reference:https://github.com/Perl/perl5/commit/12c313ce49b36160a7ca2e9b07ad5bd92ee4a010 +Conflict:Context adaptation + +--- + regcomp.c | 17 +++++++++++------ + t/re/pat_advanced.t | 8 ++++++++ + 2 files changed, 19 insertions(+), 6 deletions(-) + +diff --git a/regcomp.c b/regcomp.c +index f5e5f58..0d3e9a9 100644 +--- a/regcomp.c ++++ b/regcomp.c +@@ -23815,7 +23815,7 @@ S_parse_uniprop_string(pTHX_ + * compile perl to know about them) */ + bool is_nv_type = FALSE; + +- unsigned int i, j = 0; ++ unsigned int i = 0, i_zero = 0, j = 0; + int equals_pos = -1; /* Where the '=' is found, or negative if none */ + int slash_pos = -1; /* Where the '/' is found, or negative if none */ + int table_index = 0; /* The entry number for this property in the table +@@ -23949,9 +23949,13 @@ S_parse_uniprop_string(pTHX_ + * all of them are considered to be for that package. For the purposes of + * parsing the rest of the property, strip it off */ + if (non_pkg_begin == STRLENs("utf8::") && memBEGINPs(name, name_len, "utf8::")) { +- lookup_name += STRLENs("utf8::"); +- j -= STRLENs("utf8::"); +- equals_pos -= STRLENs("utf8::"); ++ lookup_name += STRLENs("utf8::"); ++ j -= STRLENs("utf8::"); ++ equals_pos -= STRLENs("utf8::"); ++ i_zero = STRLENs("utf8::"); /* When resetting 'i' to reparse ++ from the beginning, it has to be ++ set past what we're stripping ++ off */ + stripped_utf8_pkg = TRUE; + } + +@@ -24356,7 +24360,8 @@ S_parse_uniprop_string(pTHX_ + + /* We set the inputs back to 0 and the code below will reparse, + * using strict */ +- i = j = 0; ++ i = i_zero; ++ j = 0; + } + } + +@@ -24377,7 +24382,7 @@ S_parse_uniprop_string(pTHX_ + * separates two digits */ + if (cur == '_') { + if ( stricter +- && ( i == 0 || (int) i == equals_pos || i == name_len- 1 ++ && ( i == i_zero || (int) i == equals_pos || i == name_len- 1 + || ! isDIGIT_A(name[i-1]) || ! isDIGIT_A(name[i+1]))) + { + lookup_name[j++] = '_'; +diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t +index d679870..3b79eec 100644 +--- a/t/re/pat_advanced.t ++++ b/t/re/pat_advanced.t +@@ -2565,6 +2565,14 @@ EOF + {}, "GH #17278"); + } + ++ { # perl-security#140, read/write past buffer end ++ fresh_perl_like('qr/\p{utf8::perl x}/', ++ qr/Illegal user-defined property name "utf8::perl x" in regex/, ++ {}, "perl-security#140"); ++ fresh_perl_is('qr/\p{utf8::_perl_surrogate}/', "", ++ {}, "perl-security#140"); ++ } ++ + + # !!! NOTE that tests that aren't at all likely to crash perl should go + # a ways above, above these last ones. There's a comment there that, like +-- +2.33.0 + diff --git a/perl.spec b/perl.spec index d1d05f6..3b02d34 100644 --- a/perl.spec +++ b/perl.spec @@ -22,7 +22,7 @@ Name: perl License: (GPL+ or Artistic) and (GPLv2+ or Artistic) and MIT and UCD and Public Domain and BSD Epoch: 4 Version: %{perl_version} -Release: 10 +Release: 11 Summary: A highly capable, feature-rich programming language Url: https://www.perl.org/ Source0: https://www.cpan.org/src/5.0/%{name}-%{version}.tar.xz @@ -41,6 +41,8 @@ Patch6000: backport-CVE-2021-36770.patch Patch6001: backport-CVE-2023-31484.patch Patch6002: backport-CVE-2023-31486.patch Patch6003: backport-CVE-2022-48522.patch +Patch6004: backport-CVE-2023-47100-CVE-2023-47038.patch +Patch6005: backport-CVE-2023-47039.patch BuildRequires: gcc bash findutils coreutils make tar procps bzip2-devel gdbm-devel perl-File-Compare perl-File-Find BuildRequires: zlib-devel systemtap-sdt-devel perl-interpreter perl-generators @@ -491,6 +493,9 @@ make test_harness %{_mandir}/man3/* %changelog +* Mon Dec 11 2023 huyubiao - 4:5.34.0-11 +- Fix CVE-2023-47038, CVE-2023-47100, CVE-2023-47039 + * Fri Sep 8 2023 zhangzikang - 4:5.34.0-10 - Type:bugfix - ID:NA -- Gitee