summaryrefslogtreecommitdiffstats
path: root/meta/recipes-devtools/perl/files/CVE-2023-47038.patch
diff options
context:
space:
mode:
Diffstat (limited to 'meta/recipes-devtools/perl/files/CVE-2023-47038.patch')
-rw-r--r--meta/recipes-devtools/perl/files/CVE-2023-47038.patch121
1 files changed, 121 insertions, 0 deletions
diff --git a/meta/recipes-devtools/perl/files/CVE-2023-47038.patch b/meta/recipes-devtools/perl/files/CVE-2023-47038.patch
new file mode 100644
index 0000000000..59252c560c
--- /dev/null
+++ b/meta/recipes-devtools/perl/files/CVE-2023-47038.patch
@@ -0,0 +1,121 @@
1as per https://ubuntu.com/security/CVE-2023-47100 , CVE-2023-47100 is duplicate of CVE-2023-47038
2CVE: CVE-2023-47038 CVE-2023-47100
3Upstream-Status: Backport [ import from ubuntu perl_5.30.0-9ubuntu0.5
4upstream https://github.com/Perl/perl5/commit/12c313ce49b36160a7ca2e9b07ad5bd92ee4a010 ]
5Signed-off-by: Lee Chee Yang <chee.yang.lee@intel.com>
6
7Backport of:
8
9From 12c313ce49b36160a7ca2e9b07ad5bd92ee4a010 Mon Sep 17 00:00:00 2001
10From: Karl Williamson <khw@cpan.org>
11Date: Sat, 9 Sep 2023 11:59:09 -0600
12Subject: [PATCH 1/2] Fix read/write past buffer end: perl-security#140
13
14A package name may be specified in a \p{...} regular expression
15construct. If unspecified, "utf8::" is assumed, which is the package
16all official Unicode properties are in. By specifying a different
17package, one can create a user-defined property with the same
18unqualified name as a Unicode one. Such a property is defined by a sub
19whose name begins with "Is" or "In", and if the sub wishes to refer to
20an official Unicode property, it must explicitly specify the "utf8::".
21S_parse_uniprop_string() is used to parse the interior of both \p{} and
22the user-defined sub lines.
23
24In S_parse_uniprop_string(), it parses the input "name" parameter,
25creating a modified copy, "lookup_name", malloc'ed with the same size as
26"name". The modifications are essentially to create a canonicalized
27version of the input, with such things as extraneous white-space
28stripped off. I found it convenient to strip off the package specifier
29"utf8::". To to so, the code simply pretends "lookup_name" begins just
30after the "utf8::", and adjusts various other values to compensate.
31However, it missed the adjustment of one required one.
32
33This is only a problem when the property name begins with "perl" and
34isn't "perlspace" nor "perlword". All such ones are undocumented
35internal properties.
36
37What happens in this case is that the input is reparsed with slightly
38different rules in effect as to what is legal versus illegal. The
39problem is that "lookup_name" no longer is pointing to its initial
40value, but "name" is. Thus the space allocated for filling "lookup_name"
41is now shorter than "name", and as this shortened "lookup_name" is
42filled by copying suitable portions of "name", the write can be to
43unallocated space.
44
45The solution is to skip the "utf8::" when reparsing "name". Then both
46"lookup_name" and "name" are effectively shortened by the same amount,
47and there is no going off the end.
48
49This commit also does white-space adjustment so that things align
50vertically for readability.
51
52This can be easily backported to earlier Perl releases.
53---
54 regcomp.c | 17 +++++++++++------
55 t/re/pat_advanced.t | 8 ++++++++
56 2 files changed, 19 insertions(+), 6 deletions(-)
57
58--- a/regcomp.c
59+++ b/regcomp.c
60@@ -22606,7 +22606,7 @@ Perl_parse_uniprop_string(pTHX_
61 * compile perl to know about them) */
62 bool is_nv_type = FALSE;
63
64- unsigned int i, j = 0;
65+ unsigned int i = 0, i_zero = 0, j = 0;
66 int equals_pos = -1; /* Where the '=' is found, or negative if none */
67 int slash_pos = -1; /* Where the '/' is found, or negative if none */
68 int table_index = 0; /* The entry number for this property in the table
69@@ -22717,9 +22717,13 @@ Perl_parse_uniprop_string(pTHX_
70 * all of them are considered to be for that package. For the purposes of
71 * parsing the rest of the property, strip it off */
72 if (non_pkg_begin == STRLENs("utf8::") && memBEGINPs(name, name_len, "utf8::")) {
73- lookup_name += STRLENs("utf8::");
74- j -= STRLENs("utf8::");
75- equals_pos -= STRLENs("utf8::");
76+ lookup_name += STRLENs("utf8::");
77+ j -= STRLENs("utf8::");
78+ equals_pos -= STRLENs("utf8::");
79+ i_zero = STRLENs("utf8::"); /* When resetting 'i' to reparse
80+ from the beginning, it has to be
81+ set past what we're stripping
82+ off */
83 }
84
85 /* Here, we are either done with the whole property name, if it was simple;
86@@ -22997,7 +23001,8 @@ Perl_parse_uniprop_string(pTHX_
87
88 /* We set the inputs back to 0 and the code below will reparse,
89 * using strict */
90- i = j = 0;
91+ i = i_zero;
92+ j = 0;
93 }
94 }
95
96@@ -23018,7 +23023,7 @@ Perl_parse_uniprop_string(pTHX_
97 * separates two digits */
98 if (cur == '_') {
99 if ( stricter
100- && ( i == 0 || (int) i == equals_pos || i == name_len- 1
101+ && ( i == i_zero || (int) i == equals_pos || i == name_len- 1
102 || ! isDIGIT_A(name[i-1]) || ! isDIGIT_A(name[i+1])))
103 {
104 lookup_name[j++] = '_';
105--- a/t/re/pat_advanced.t
106+++ b/t/re/pat_advanced.t
107@@ -2524,6 +2524,14 @@ EOF
108 "", {}, "*COMMIT caused positioning beyond EOS");
109 }
110
111+ { # perl-security#140, read/write past buffer end
112+ fresh_perl_like('qr/\p{utf8::perl x}/',
113+ qr/Illegal user-defined property name "utf8::perl x" in regex/,
114+ {}, "perl-security#140");
115+ fresh_perl_is('qr/\p{utf8::_perl_surrogate}/', "",
116+ {}, "perl-security#140");
117+ }
118+
119
120 # !!! NOTE that tests that aren't at all likely to crash perl should go
121 # a ways above, above these last ones. There's a comment there that, like