diff options
Diffstat (limited to 'meta/recipes-devtools/perl/files/CVE-2023-47038.patch')
-rw-r--r-- | meta/recipes-devtools/perl/files/CVE-2023-47038.patch | 121 |
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 @@ | |||
1 | as per https://ubuntu.com/security/CVE-2023-47100 , CVE-2023-47100 is duplicate of CVE-2023-47038 | ||
2 | CVE: CVE-2023-47038 CVE-2023-47100 | ||
3 | Upstream-Status: Backport [ import from ubuntu perl_5.30.0-9ubuntu0.5 | ||
4 | upstream https://github.com/Perl/perl5/commit/12c313ce49b36160a7ca2e9b07ad5bd92ee4a010 ] | ||
5 | Signed-off-by: Lee Chee Yang <chee.yang.lee@intel.com> | ||
6 | |||
7 | Backport of: | ||
8 | |||
9 | From 12c313ce49b36160a7ca2e9b07ad5bd92ee4a010 Mon Sep 17 00:00:00 2001 | ||
10 | From: Karl Williamson <khw@cpan.org> | ||
11 | Date: Sat, 9 Sep 2023 11:59:09 -0600 | ||
12 | Subject: [PATCH 1/2] Fix read/write past buffer end: perl-security#140 | ||
13 | |||
14 | A package name may be specified in a \p{...} regular expression | ||
15 | construct. If unspecified, "utf8::" is assumed, which is the package | ||
16 | all official Unicode properties are in. By specifying a different | ||
17 | package, one can create a user-defined property with the same | ||
18 | unqualified name as a Unicode one. Such a property is defined by a sub | ||
19 | whose name begins with "Is" or "In", and if the sub wishes to refer to | ||
20 | an official Unicode property, it must explicitly specify the "utf8::". | ||
21 | S_parse_uniprop_string() is used to parse the interior of both \p{} and | ||
22 | the user-defined sub lines. | ||
23 | |||
24 | In S_parse_uniprop_string(), it parses the input "name" parameter, | ||
25 | creating a modified copy, "lookup_name", malloc'ed with the same size as | ||
26 | "name". The modifications are essentially to create a canonicalized | ||
27 | version of the input, with such things as extraneous white-space | ||
28 | stripped off. I found it convenient to strip off the package specifier | ||
29 | "utf8::". To to so, the code simply pretends "lookup_name" begins just | ||
30 | after the "utf8::", and adjusts various other values to compensate. | ||
31 | However, it missed the adjustment of one required one. | ||
32 | |||
33 | This is only a problem when the property name begins with "perl" and | ||
34 | isn't "perlspace" nor "perlword". All such ones are undocumented | ||
35 | internal properties. | ||
36 | |||
37 | What happens in this case is that the input is reparsed with slightly | ||
38 | different rules in effect as to what is legal versus illegal. The | ||
39 | problem is that "lookup_name" no longer is pointing to its initial | ||
40 | value, but "name" is. Thus the space allocated for filling "lookup_name" | ||
41 | is now shorter than "name", and as this shortened "lookup_name" is | ||
42 | filled by copying suitable portions of "name", the write can be to | ||
43 | unallocated space. | ||
44 | |||
45 | The solution is to skip the "utf8::" when reparsing "name". Then both | ||
46 | "lookup_name" and "name" are effectively shortened by the same amount, | ||
47 | and there is no going off the end. | ||
48 | |||
49 | This commit also does white-space adjustment so that things align | ||
50 | vertically for readability. | ||
51 | |||
52 | This 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 | ||