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

This commit is contained in:
Petr Písař 2019-08-22 11:13:13 +02:00
parent e24a3ce0f2
commit 9eebde9ae4
2 changed files with 109 additions and 0 deletions

View File

@ -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

View File

@ -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)