Fix a crash when setting $@ on unwinding a call stack

perl-5.30.0-perl-134266-make-sure-is-writable-when-we-write-to-i.patch

@@ -0,0 +1,102 @@
+From 3f8dbf40138bd2bcb569b23c88888a41ede9c355 Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Mon, 5 Aug 2019 15:23:45 +1000
+Subject: [PATCH] (perl #134266) make sure $@ is writable when we write to it
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+when unwinding.
+
+Since except_sv might be ERRSV we try to preserve it's value,
+if not the actual SV (which we have an extra refcount on if it is
+except_sv).
+
+Petr Písař: Ported to 5.30.0 from
+933e3e630076d4fdbe32a101eeb5f12e37ec4ac2.
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ perl.h             | 17 +++++++++++++++++
+ pp_ctl.c           | 10 ++++++++--
+ t/lib/croak/pp_ctl |  8 ++++++++
+ 3 files changed, 33 insertions(+), 2 deletions(-)
+
+diff --git a/perl.h b/perl.h
+index e5a5585..383487c 100644
+--- a/perl.h
++++ b/perl.h
+@@ -1357,6 +1357,23 @@ EXTERN_C char *crypt(const char *, const char *);
+     }									\
+     } STMT_END
+ 
++/* contains inlined gv_add_by_type */
++#define SANE_ERRSV() STMT_START {					\
++    SV ** const svp = &GvSV(PL_errgv);					\
++    if (!*svp) {							\
++        *svp = newSVpvs("");                                            \
++    } else if (SvREADONLY(*svp)) {					\
++        SV *dupsv = newSVsv(*svp);					\
++	SvREFCNT_dec_NN(*svp);						\
++	*svp = dupsv;							\
++    } else {								\
++	SV *const errsv = *svp;						\
++	if (SvMAGICAL(errsv)) {						\
++	    mg_free(errsv);						\
++	}								\
++    }									\
++    } STMT_END
++
+ 
+ #ifdef PERL_CORE
+ # define DEFSV (0 + GvSVn(PL_defgv))
+diff --git a/pp_ctl.c b/pp_ctl.c
+index a38b9c1..1f2d812 100644
+--- a/pp_ctl.c
++++ b/pp_ctl.c
+@@ -1720,9 +1720,13 @@ Perl_die_unwind(pTHX_ SV *msv)
+ 	 * perls 5.13.{1..7} which had late setting of $@ without this
+ 	 * early-setting hack.
+ 	 */
+-	if (!(in_eval & EVAL_KEEPERR))
++	if (!(in_eval & EVAL_KEEPERR)) {
++            /* remove any read-only/magic from the SV, so we don't
++               get infinite recursion when setting ERRSV */
++            SANE_ERRSV();
+ 	    sv_setsv_flags(ERRSV, exceptsv,
+                         (SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL));
++        }
+ 
+ 	if (in_eval & EVAL_KEEPERR) {
+ 	    Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %" SVf,
+@@ -1784,8 +1788,10 @@ Perl_die_unwind(pTHX_ SV *msv)
+              */
+             S_pop_eval_context_maybe_croak(aTHX_ cx, exceptsv, 2);
+ 
+-	    if (!(in_eval & EVAL_KEEPERR))
++	    if (!(in_eval & EVAL_KEEPERR)) {
++                SANE_ERRSV();
+ 		sv_setsv(ERRSV, exceptsv);
++            }
+ 	    PL_restartjmpenv = restartjmpenv;
+ 	    PL_restartop = restartop;
+ 	    JMPENV_JUMP(3);
+diff --git a/t/lib/croak/pp_ctl b/t/lib/croak/pp_ctl
+index b1e754c..de0221b 100644
+--- a/t/lib/croak/pp_ctl
++++ b/t/lib/croak/pp_ctl
+@@ -51,3 +51,11 @@ use 5.01;
+ default{}
+ EXPECT
+ Can't "default" outside a topicalizer at - line 2.
++########
++# NAME croak with read only $@
++eval '"a" =~ /${*@=\_})/';
++die;
++# this would previously recurse infinitely in the eval
++EXPECT
++Unmatched ) in regex; marked by <-- HERE in m/_) <-- HERE / at (eval 1) line 1.
++	...propagated at - line 2.
+-- 
+2.21.0
+

perl.spec

@@ -249,6 +249,10 @@ Patch48:        perl-5.31.2-locale.c-Stop-Coverity-warning.patch
 # Fix a NULL pointer dereference in PerlIOVia_pushed(), fixed after 5.31.2
 Patch49:        perl-5.31.2-PerlIO-Via-check-arg-is-non-NULL-before-using-it.patch
 
+# Fix a crash when setting $@ on unwinding a call stack, RT#134266,
+# fixed after 5.31.2
+Patch50:        perl-5.30.0-perl-134266-make-sure-is-writable-when-we-write-to-i.patch
+
 # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
 Patch200:       perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
 
@@ -2820,6 +2824,7 @@ Perl extension for Version Objects
 %patch47 -p1
 %patch48 -p1
 %patch49 -p1
+%patch50 -p1
 %patch200 -p1
 %patch201 -p1
 
@@ -2876,6 +2881,7 @@ perl -x patchlevel.h \
     'Fedora Patch47: Fix a use after free in /(?{...})/ (RT#134208)' \
     'Fedora Patch48: Fix a use after free in debugging output of a collation' \
     'Fedora Patch49: Fix a NULL pointer dereference in PerlIOVia_pushed()' \
+    'Fedora Patch50: Fix a crash when setting $@ on unwinding a call stack (RT#134266)' \
     'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
     'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
     %{nil}
@@ -5123,6 +5129,7 @@ popd
 %changelog
 * Thu Aug 22 2019 Petr Pisar <ppisar@redhat.com> - 4:5.30.0-444
 - Fix a NULL pointer dereference in PerlIOVia_pushed()
+- Fix a crash when setting $@ on unwinding a call stack (RT#134266)
 
 * Wed Aug 07 2019 Petr Pisar <ppisar@redhat.com> - 4:5.30.0-443
 - Fix propagating non-string variables in an exception value (RT#134291)