packages/perl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix CVE-2023-47038, CVE-2023-47100, CVE-2023-47039

Browse Source
This commit is contained in:
h30032433 2023-12-11 17:32:32 +08:00
parent bb3d3ef271
commit 1e1229f914
3 changed files with 330 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

200
backport-CVE-2023-47039.patch Normal file
View File

@ -0,0 +1,200 @@
From 906e92715f4ee68ea95086867f4f97b1f4f10ac3 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
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,'<log'))
- {
- while(<LOG>) {
- note $_;
- }
- }
+ note "Where is your C compiler?";
+ if (open(LOG,'<log'))
+ {
+ while(<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

124
backport-CVE-2023-47100-CVE-2023-47038.patch Normal file
View File

@ -0,0 +1,124 @@
From 12c313ce49b36160a7ca2e9b07ad5bd92ee4a010 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
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

7
perl.spec
View File

@ -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 <huyubiao@huawei.com> - 4:5.34.0-11
- Fix CVE-2023-47038, CVE-2023-47100, CVE-2023-47039
* Fri Sep 8 2023 zhangzikang <zhangzikang@kylinos.cn> - 4:5.34.0-10
- Type:bugfix
- ID:NA