summaryrefslogtreecommitdiffstats
path: root/meta/recipes-devtools/perl/files
diff options
context:
space:
mode:
Diffstat (limited to 'meta/recipes-devtools/perl/files')
-rw-r--r--meta/recipes-devtools/perl/files/CVE-2020-12723.patch302
-rw-r--r--meta/recipes-devtools/perl/files/CVE-2023-31484.patch27
-rw-r--r--meta/recipes-devtools/perl/files/CVE-2023-47038.patch121
3 files changed, 450 insertions, 0 deletions
diff --git a/meta/recipes-devtools/perl/files/CVE-2020-12723.patch b/meta/recipes-devtools/perl/files/CVE-2020-12723.patch
new file mode 100644
index 0000000000..d25f4d4a74
--- /dev/null
+++ b/meta/recipes-devtools/perl/files/CVE-2020-12723.patch
@@ -0,0 +1,302 @@
+From da9ec461e22915ccabb06785bf39ec34577ada12 Mon Sep 17 00:00:00 2001
+From: Hugo van der Sanden <hv@crypt.org>
+Date: Sat, 11 Apr 2020 14:10:24 +0100
+Subject: [PATCH] study_chunk: avoid mutating regexp program within GOSUB
+
+gh16947 and gh17743: studying GOSUB may restudy in an inner call
+(via a mix of recursion and enframing) something that an outer call
+is in the middle of looking at. Let the outer frame deal with it.
+
+(CVE-2020-12723)
+
+(cherry picked from commit c4033e740bd18d9fbe3456a9db2ec2053cdc5271)
+
+Upstream-Status: Backport [https://github.com/perl/perl5/commit/66bbb51b93253a3f87d11c2695cfb7bdb782184a]
+CVE: CVE-2020-12723
+Signed-off-by: Chee Yang Lee <chee.yang.lee@intel.com>
+
+---
+ embed.fnc | 2 +-
+ embed.h | 2 +-
+ proto.h | 2 +-
+ regcomp.c | 54 +++++++++++++++++++++++++++++++++++-------------------
+ t/re/pat.t | 26 +++++++++++++++++++++++++-
+ 5 files changed, 63 insertions(+), 23 deletions(-)
+
+diff --git a/embed.fnc b/embed.fnc
+index f45c127..eff4a50 100644
+--- a/embed.fnc
++++ b/embed.fnc
+@@ -2480,7 +2480,7 @@ Es |SSize_t|study_chunk |NN RExC_state_t *pRExC_state \
+ |NULLOK struct scan_data_t *data \
+ |I32 stopparen|U32 recursed_depth \
+ |NULLOK regnode_ssc *and_withp \
+- |U32 flags|U32 depth
++ |U32 flags|U32 depth|bool was_mutate_ok
+ Es |void |rck_elide_nothing|NN regnode *node
+ EsR |SV * |get_ANYOFM_contents|NN const regnode * n
+ EsRn |U32 |add_data |NN RExC_state_t* const pRExC_state \
+diff --git a/embed.h b/embed.h
+index 356a8b9..5346ec5 100644
+--- a/embed.h
++++ b/embed.h
+@@ -1239,7 +1239,7 @@
+ #define ssc_is_cp_posixl_init S_ssc_is_cp_posixl_init
+ #define ssc_or(a,b,c) S_ssc_or(aTHX_ a,b,c)
+ #define ssc_union(a,b,c) S_ssc_union(aTHX_ a,b,c)
+-#define study_chunk(a,b,c,d,e,f,g,h,i,j,k) S_study_chunk(aTHX_ a,b,c,d,e,f,g,h,i,j,k)
++#define study_chunk(a,b,c,d,e,f,g,h,i,j,k,l) S_study_chunk(aTHX_ a,b,c,d,e,f,g,h,i,j,k,l)
+ # endif
+ # if defined(PERL_IN_REGCOMP_C) || defined (PERL_IN_DUMP_C)
+ #define _invlist_dump(a,b,c,d) Perl__invlist_dump(aTHX_ a,b,c,d)
+diff --git a/proto.h b/proto.h
+index 91530b1..1bda01f 100644
+--- a/proto.h
++++ b/proto.h
+@@ -5655,7 +5655,7 @@ PERL_STATIC_INLINE void S_ssc_union(pTHX_ regnode_ssc *ssc, SV* const invlist, c
+ #define PERL_ARGS_ASSERT_SSC_UNION \
+ assert(ssc); assert(invlist)
+ #endif
+-STATIC SSize_t S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, SSize_t *minlenp, SSize_t *deltap, regnode *last, struct scan_data_t *data, I32 stopparen, U32 recursed_depth, regnode_ssc *and_withp, U32 flags, U32 depth);
++STATIC SSize_t S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, SSize_t *minlenp, SSize_t *deltap, regnode *last, struct scan_data_t *data, I32 stopparen, U32 recursed_depth, regnode_ssc *and_withp, U32 flags, U32 depth, bool was_mutate_ok);
+ #define PERL_ARGS_ASSERT_STUDY_CHUNK \
+ assert(pRExC_state); assert(scanp); assert(minlenp); assert(deltap); assert(last)
+ #endif
+diff --git a/regcomp.c b/regcomp.c
+index 5a9adee..8d7df1f 100644
+--- a/regcomp.c
++++ b/regcomp.c
+@@ -106,6 +106,7 @@ typedef struct scan_frame {
+ regnode *next_regnode; /* next node to process when last is reached */
+ U32 prev_recursed_depth;
+ I32 stopparen; /* what stopparen do we use */
++ bool in_gosub; /* this or an outer frame is for GOSUB */
+
+ struct scan_frame *this_prev_frame; /* this previous frame */
+ struct scan_frame *prev_frame; /* previous frame */
+@@ -4466,7 +4467,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
+ I32 stopparen,
+ U32 recursed_depth,
+ regnode_ssc *and_withp,
+- U32 flags, U32 depth)
++ U32 flags, U32 depth, bool was_mutate_ok)
+ /* scanp: Start here (read-write). */
+ /* deltap: Write maxlen-minlen here. */
+ /* last: Stop before this one. */
+@@ -4545,6 +4546,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
+ node length to get a real minimum (because
+ the folded version may be shorter) */
+ bool unfolded_multi_char = FALSE;
++ /* avoid mutating ops if we are anywhere within the recursed or
++ * enframed handling for a GOSUB: the outermost level will handle it.
++ */
++ bool mutate_ok = was_mutate_ok && !(frame && frame->in_gosub);
+ /* Peephole optimizer: */
+ DEBUG_STUDYDATA("Peep", data, depth, is_inf);
+ DEBUG_PEEP("Peep", scan, depth, flags);
+@@ -4555,7 +4560,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
+ * parsing code, as each (?:..) is handled by a different invocation of
+ * reg() -- Yves
+ */
+- JOIN_EXACT(scan,&min_subtract, &unfolded_multi_char, 0);
++ if (mutate_ok)
++ JOIN_EXACT(scan,&min_subtract, &unfolded_multi_char, 0);
+
+ /* Follow the next-chain of the current node and optimize
+ away all the NOTHINGs from it.
+@@ -4587,7 +4593,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
+ /* DEFINEP study_chunk() recursion */
+ (void)study_chunk(pRExC_state, &scan, &minlen,
+ &deltanext, next, &data_fake, stopparen,
+- recursed_depth, NULL, f, depth+1);
++ recursed_depth, NULL, f, depth+1, mutate_ok);
+
+ scan = next;
+ } else
+@@ -4655,7 +4661,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
+ /* recurse study_chunk() for each BRANCH in an alternation */
+ minnext = study_chunk(pRExC_state, &scan, minlenp,
+ &deltanext, next, &data_fake, stopparen,
+- recursed_depth, NULL, f, depth+1);
++ recursed_depth, NULL, f, depth+1,
++ mutate_ok);
+
+ if (min1 > minnext)
+ min1 = minnext;
+@@ -4722,9 +4729,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
+ }
+ }
+
+- if (PERL_ENABLE_TRIE_OPTIMISATION &&
+- OP( startbranch ) == BRANCH )
+- {
++ if (PERL_ENABLE_TRIE_OPTIMISATION
++ && OP(startbranch) == BRANCH
++ && mutate_ok
++ ) {
+ /* demq.
+
+ Assuming this was/is a branch we are dealing with: 'scan'
+@@ -5179,6 +5187,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
+ newframe->stopparen = stopparen;
+ newframe->prev_recursed_depth = recursed_depth;
+ newframe->this_prev_frame= frame;
++ newframe->in_gosub = (
++ (frame && frame->in_gosub) || OP(scan) == GOSUB
++ );
+
+ DEBUG_STUDYDATA("frame-new", data, depth, is_inf);
+ DEBUG_PEEP("fnew", scan, depth, flags);
+@@ -5336,7 +5347,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
+
+ /* This temporary node can now be turned into EXACTFU, and
+ * must, as regexec.c doesn't handle it */
+- if (OP(next) == EXACTFU_S_EDGE) {
++ if (OP(next) == EXACTFU_S_EDGE && mutate_ok) {
+ OP(next) = EXACTFU;
+ }
+
+@@ -5344,8 +5355,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
+ && isALPHA_A(* STRING(next))
+ && ( OP(next) == EXACTFAA
+ || ( OP(next) == EXACTFU
+- && ! HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(* STRING(next)))))
+- {
++ && ! HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(* STRING(next))))
++ && mutate_ok
++ ) {
+ /* These differ in just one bit */
+ U8 mask = ~ ('A' ^ 'a');
+
+@@ -5432,7 +5444,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
+ (mincount == 0
+ ? (f & ~SCF_DO_SUBSTR)
+ : f)
+- ,depth+1);
++ , depth+1, mutate_ok);
+
+ if (flags & SCF_DO_STCLASS)
+ data->start_class = oclass;
+@@ -5498,7 +5510,9 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
+ if ( OP(oscan) == CURLYX && data
+ && data->flags & SF_IN_PAR
+ && !(data->flags & SF_HAS_EVAL)
+- && !deltanext && minnext == 1 ) {
++ && !deltanext && minnext == 1
++ && mutate_ok
++ ) {
+ /* Try to optimize to CURLYN. */
+ regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS;
+ regnode * const nxt1 = nxt;
+@@ -5548,10 +5562,10 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
+ && !(data->flags & SF_HAS_EVAL)
+ && !deltanext /* atom is fixed width */
+ && minnext != 0 /* CURLYM can't handle zero width */
+-
+ /* Nor characters whose fold at run-time may be
+ * multi-character */
+ && ! (RExC_seen & REG_UNFOLDED_MULTI_SEEN)
++ && mutate_ok
+ ) {
+ /* XXXX How to optimize if data == 0? */
+ /* Optimize to a simpler form. */
+@@ -5604,7 +5618,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
+ /* recurse study_chunk() on optimised CURLYX => CURLYM */
+ study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt,
+ NULL, stopparen, recursed_depth, NULL, 0,
+- depth+1);
++ depth+1, mutate_ok);
+ }
+ else
+ oscan->flags = 0;
+@@ -6009,7 +6023,8 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n",
+ /* recurse study_chunk() for lookahead body */
+ minnext = study_chunk(pRExC_state, &nscan, minlenp, &deltanext,
+ last, &data_fake, stopparen,
+- recursed_depth, NULL, f, depth+1);
++ recursed_depth, NULL, f, depth+1,
++ mutate_ok);
+ if (scan->flags) {
+ if ( deltanext < 0
+ || deltanext > (I32) U8_MAX
+@@ -6114,7 +6129,7 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n",
+ *minnextp = study_chunk(pRExC_state, &nscan, minnextp,
+ &deltanext, last, &data_fake,
+ stopparen, recursed_depth, NULL,
+- f, depth+1);
++ f, depth+1, mutate_ok);
+ if (scan->flags) {
+ assert(0); /* This code has never been tested since this
+ is normally not compiled */
+@@ -6282,7 +6297,8 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n",
+ /* optimise study_chunk() for TRIE */
+ minnext = study_chunk(pRExC_state, &scan, minlenp,
+ &deltanext, (regnode *)nextbranch, &data_fake,
+- stopparen, recursed_depth, NULL, f, depth+1);
++ stopparen, recursed_depth, NULL, f, depth+1,
++ mutate_ok);
+ }
+ if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH)
+ nextbranch= regnext((regnode*)nextbranch);
+@@ -8075,7 +8091,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
+ &data, -1, 0, NULL,
+ SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag
+ | (restudied ? SCF_TRIE_DOING_RESTUDY : 0),
+- 0);
++ 0, TRUE);
+
+
+ CHECK_RESTUDY_GOTO_butfirst(LEAVE_with_name("study_chunk"));
+@@ -8204,7 +8220,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
+ SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS|(restudied
+ ? SCF_TRIE_DOING_RESTUDY
+ : 0),
+- 0);
++ 0, TRUE);
+
+ CHECK_RESTUDY_GOTO_butfirst(NOOP);
+
+diff --git a/t/re/pat.t b/t/re/pat.t
+index 6a868f4..2869b58 100644
+--- a/t/re/pat.t
++++ b/t/re/pat.t
+@@ -25,7 +25,7 @@ BEGIN {
+ skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
+ skip_all_without_unicode_tables();
+
+-plan tests => 864; # Update this when adding/deleting tests.
++plan tests => 868; # Update this when adding/deleting tests.
+
+ run_tests() unless caller;
+
+@@ -2115,6 +2115,30 @@ x{0c!}\;\;îçÿ
+ like(runperl(prog => "$s", stderr => 1), qr/Unmatched \(/);
+ }
+
++ # gh16947: test regexp corruption (GOSUB)
++ {
++ fresh_perl_is(q{
++ 'xy' =~ /x(?0)|x(?|y|y)/ && print 'ok'
++ }, 'ok', {}, 'gh16947: test regexp corruption (GOSUB)');
++ }
++ # gh16947: test fix doesn't break SUSPEND
++ {
++ fresh_perl_is(q{ 'sx' =~ m{ss++}i; print 'ok' },
++ 'ok', {}, "gh16947: test fix doesn't break SUSPEND");
++ }
++
++ # gh17743: more regexp corruption via GOSUB
++ {
++ fresh_perl_is(q{
++ "0" =~ /((0(?0)|000(?|0000|0000)(?0))|)/; print "ok"
++ }, 'ok', {}, 'gh17743: test regexp corruption (1)');
++
++ fresh_perl_is(q{
++ "000000000000" =~ /(0(())(0((?0)())|000(?|\x{ef}\x{bf}\x{bd}|\x{ef}\x{bf}\x{bd}))|)/;
++ print "ok"
++ }, 'ok', {}, 'gh17743: test regexp corruption (2)');
++ }
++
+ } # End of sub run_tests
+
+ 1;
diff --git a/meta/recipes-devtools/perl/files/CVE-2023-31484.patch b/meta/recipes-devtools/perl/files/CVE-2023-31484.patch
new file mode 100644
index 0000000000..0fea7bf8a8
--- /dev/null
+++ b/meta/recipes-devtools/perl/files/CVE-2023-31484.patch
@@ -0,0 +1,27 @@
+CVE: CVE-2023-31484
+Upstream-Status: Backport [ import from Ubuntu perl_5.30.0-9ubuntu0.5
+upstream https://github.com/andk/cpanpm/commit/9c98370287f4e709924aee7c58ef21c85289a7f0 ]
+Signed-off-by: Lee Chee Yang <chee.yang.lee@intel.com>
+
+From 9c98370287f4e709924aee7c58ef21c85289a7f0 Mon Sep 17 00:00:00 2001
+From: Stig Palmquist <git@stig.io>
+Date: Tue, 28 Feb 2023 11:54:06 +0100
+Subject: [PATCH] Add verify_SSL=>1 to HTTP::Tiny to verify https server
+ identity
+
+---
+ lib/CPAN/HTTP/Client.pm | 1 +
+ 1 file changed, 1 insertion(+)
+
+diff --git a/cpan/CPAN/lib/CPAN/HTTP/Client.pm b/cpan/CPAN/lib/CPAN/HTTP/Client.pm
+index 4fc792c26..a616fee20 100644
+--- a/cpan/CPAN/lib/CPAN/HTTP/Client.pm
++++ b/cpan/CPAN/lib/CPAN/HTTP/Client.pm
+@@ -32,6 +32,7 @@ sub mirror {
+
+ my $want_proxy = $self->_want_proxy($uri);
+ my $http = HTTP::Tiny->new(
++ verify_SSL => 1,
+ $want_proxy ? (proxy => $self->{proxy}) : ()
+ );
+
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 @@
+as per https://ubuntu.com/security/CVE-2023-47100 , CVE-2023-47100 is duplicate of CVE-2023-47038
+CVE: CVE-2023-47038 CVE-2023-47100
+Upstream-Status: Backport [ import from ubuntu perl_5.30.0-9ubuntu0.5
+upstream https://github.com/Perl/perl5/commit/12c313ce49b36160a7ca2e9b07ad5bd92ee4a010 ]
+Signed-off-by: Lee Chee Yang <chee.yang.lee@intel.com>
+
+Backport of:
+
+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 1/2] 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.
+---
+ regcomp.c | 17 +++++++++++------
+ t/re/pat_advanced.t | 8 ++++++++
+ 2 files changed, 19 insertions(+), 6 deletions(-)
+
+--- a/regcomp.c
++++ b/regcomp.c
+@@ -22606,7 +22606,7 @@ Perl_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
+@@ -22717,9 +22717,13 @@ Perl_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 */
+ }
+
+ /* Here, we are either done with the whole property name, if it was simple;
+@@ -22997,7 +23001,8 @@ Perl_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;
+ }
+ }
+
+@@ -23018,7 +23023,7 @@ Perl_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++] = '_';
+--- a/t/re/pat_advanced.t
++++ b/t/re/pat_advanced.t
+@@ -2524,6 +2524,14 @@ EOF
+ "", {}, "*COMMIT caused positioning beyond EOS");
+ }
+
++ { # 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