Join GitHub today
GitHub is home to over 50 million developers working together to host and review code, manage projects, and build software together.
Sign upstack-overflow (can't grow stack) in Perl_sv_vcatpvfn_flags #17083
Comments
From imdb95@gmail.comHi, **********Compilation********** root@instance-2:~/fuzz_perl# ./perl/perl -v This is perl 5, version 31, subversion 2 (v5.31.2 OS: Ubuntu 16.04 LTS 64bit AFL_USE_ASAN=1 afl-clang-fast++ perl_crash.cpp -o perl_crash `./perl/perl **********Reproduce********** root@instance-2:~/fuzz_perl# ./perl_crash a '${*@=\_})'
|
From imdb95@gmail.comSorry for not attaching source code of perl_crash.cpp. On Sun, Jun 23, 2019 at 12:05 AM Peter Nguyen <imdb95@gmail.com> wrote:
|
From imdb95@gmail.com#include <fstream> typedef const char* CONSTCSTR; int main(int argc, char** argv) PerlInterpreter *my_perl = perl_alloc(); perl_parse(my_perl, NULL, 3, (char**)embedding, NULL); return 0; |
From imdb95@gmail.comHi, **********Compilation********** root@instance-2:~# ./perl/perl -v This is perl 5, version 31, subversion 2 (v5.31.2) built for x86_64-linux OS: Ubuntu 16.04 LTS 64bit **********Reproduce********** root@instance-2:~# cat test.pl ==31123== ==31123== HEAP SUMMARY: ************************** Also crashes happen with perl v5.22.1 (default on Ubuntu) or perlembed Please confirm this. Thanks, Manh Nguyen |
From imdb95@gmail.comI have another payload producing the same output: |
From @iabynOn Fri, Jul 05, 2019 at 09:45:28PM -0700, Nguyen Duc Manh wrote:
This code is making $@ an alias of the read-only constant string "_". I can't see that its a security issue. -- |
|
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Sat, 22 Jun 2019 10:05:42 -0700, imdb95@gmail.com wrote:
What's the contents of perl_crash.cpp ? Tony |
|
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Mon, 08 Jul 2019 02:03:17 -0700, davem wrote:
Agreed, now public. Tony |
From imdb95@gmail.comSorry, |
From imdb95@gmail.com#include <fstream> typedef const char* CONSTCSTR; int main(int argc, char** argv) PerlInterpreter *my_perl = perl_alloc(); perl_parse(my_perl, NULL, 3, (char**)embedding, NULL); return 0; |
From @tonycozOn Mon, 08 Jul 2019 02:03:17 -0700, davem wrote:
Something like this should fix at least this case. Tony |
From @tonycoz0001-perl-134266-make-sure-is-writable-when-we-write-to-i.patchFrom f8856ec9d9337c7414d9ba885bb04497c22febc3 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 5 Aug 2019 15:23:45 +1000
Subject: (perl #134266) make sure $@ is writable when we write to it
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).
---
perl.h | 24 ++++++++++++++++++++++++
pp_ctl.c | 10 ++++++++--
t/lib/croak/pp_ctl | 8 ++++++++
3 files changed, 40 insertions(+), 2 deletions(-)
diff --git a/perl.h b/perl.h
index b47587cf2a..443534a95a 100644
--- a/perl.h
+++ b/perl.h
@@ -1380,6 +1380,13 @@ Clear the contents of C<$@>, setting it to the empty string.
This replaces any read-only SV with a fresh SV and removes any magic.
+=for apidoc Am|void|SANE_ERRSV
+
+Clean up ERRSV so we can safely set it.
+
+This replaces any read-only SV with a fresh writable copy and removes
+any magic.
+
=cut
*/
@@ -1403,6 +1410,23 @@ This replaces any read-only SV with a fresh SV and removes any magic.
} \
} 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 a38b9c19b2..1f2d81296c 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 b1e754c356..de0221b57d 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.11.0
|
From @tonycozOn Sun, 04 Aug 2019 20:55:19 -0700, imdb95@gmail.com wrote:
This is the same issue as #134266, merging it. Tony |
From @tonycozOn Sun, 04 Aug 2019 22:31:58 -0700, tonyc wrote:
Applied as 933e3e6. Tony |
|
@tonycoz - Status changed from 'open' to 'pending release' |
Migrated from rt.perl.org#134266 (status was 'pending release')
Searchable as RT134266$