Segfault in Perl_runops_standard in scalar access after some typeglob witchery #14862
Comments
From @dcollinsnGreetings Porters, I have compiled bleadperl with the afl-gcc compiler using: ./Configure -Dusedevel -Dprefix='/usr/local/perl-afl' -Dcc=afl-gcc -Duselongdouble -Duse64bitint -Doptimize=-g -des And then fuzzed the resulting binary using: AFL_NO_VAR_CHECK=1 afl-fuzz -i in -o out bin/perl @@ After reducing testcases using `afl-tmin` and filtering out testcases that are merely iterations of "#!perl -u", I have located the following testcase that triggers a segmentation fault in the perl interpreter. The testcase reduced automatically to: $x=*0;0!=0;$0=*x=$x And further reduced manually to: $x=*0;$0=*x=$x Some more crashing examples that may better illustrate what's going on... $x=*0;*x=$x;$0=*x This testcase emits no warnings nor errors, but causes both perl and miniperl to crash with a segmentation fault. This is a long-standing crash, reproducible back to 5.6.0, which is the earliest version that compiles on my system. Bisect not attempted. ****Debug results for "$x=*0;$0=*x=$x"**** **GDB** GNU gdb (GDB) 7.0.1-debian Program received signal SIGSEGV, Segmentation fault. **VALGRIND** ==30968== Memcheck, a memory error detector ****Debug results for "*x=$x=*a;$a=$x"**** **GDB** GNU gdb (GDB) 7.0.1-debian Program received signal SIGSEGV, Segmentation fault. **VALGRIND** ==3636== Memcheck, a memory error detector **PERL -V** Summary of my perl5 (revision 5 version 23 subversion 2) configuration: Characteristics of this binary (from libperl): |
From @hvdsOn Tue Aug 18 19:25:20 2015, dcollinsn@gmail.com wrote:
Thanks for the report, this was previously reported (also by fuzzers) as RTs 123710, 123804 and 123997; it is currently perceived as unfixable until we address RT 77706 (refcount the stack). Hugo |
|
The RT System itself - Status changed from 'new' to 'open' |
From @rurbanOn Wed Aug 19 12:10:00 2015, hv wrote:
I cannot follow this argumentation. so the simple fix is gp_free(MUTABLE_GV(dstr)); (sans the test for $x=*0;*x=$x) Furthermore, the stack *IS* refcounted, even empty PADTMP entries. |
From @rurbanAttached patch fixes all these glob assigns where the lhs references the rhs. -- |
From @rurban0001-fix-perl-125840-x-0-x-x.patchFrom e2c51c2e8787f9f6edf1f4c4a5e01b132f7f759f Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@cpanel.net>
Date: Tue, 25 Aug 2015 12:53:08 +0200
Subject: [PATCH] fix perl #125840: $x=*0; *x=$x
In this case the lhs of the glob references the rhs, and when
clearing the lhs before the copy of the GP values, the rhs was deleted.
Protect from that.
Furthermore, the result needs to be assigned a fresh GP to fix
the case with -e'*x=$x=*a;$a=$x'
fixup glob_assign_glob
---
sv.c | 8 ++++++--
t/op/gv.t | 7 ++++++-
2 files changed, 12 insertions(+), 3 deletions(-)
diff --git sv.c sv.c
index 906518c..0d3dbb8 100644
--- sv.c
+++ sv.c
@@ -3974,8 +3974,12 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
}
gp_free(MUTABLE_GV(dstr));
- GvINTRO_off(dstr); /* one-shot flag */
- GvGP_set(dstr, gp_ref(GvGP(sstr)));
+ GvINTRO_off(dstr); /* one-shot flag */
+ if (SvIS_FREED(sstr)) { /* dstr could have referenced sstr */
+ GvGP_set(dstr, Perl_newGP(aTHX_ MUTABLE_GV(dstr)));
+ } else {
+ GvGP_set(dstr, gp_ref(GvGP(sstr)));
+ }
if (SvTAINTED(sstr))
SvTAINT(dstr);
if (GvIMPORTED(dstr) != GVf_IMPORTED
diff --git t/op/gv.t t/op/gv.t
index e695923..e368139 100644
--- t/op/gv.t
+++ t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
use warnings;
-plan( tests => 273 );
+plan( tests => 275 );
# type coercion on assignment
$foo = 'foo';
@@ -1132,6 +1132,11 @@ pass "No crash due to CvGV pointing to glob copy in the stash";
is $z, 3, 'list assignment after aliasing [perl #89646]';
}
+eval { $x=*0; *x=$x };
+ok $x, 'no crash glob assign with cross-references w/o accessing the GP [perl #125840]';
+eval { *x=$x=*a;$a=$x };
+ok $x, 'no crash glob assign with cross-references accessing the new GP [perl #125840]';
+
__END__
Perl
--
2.5.0
|
From @rurbanOn Tue Aug 25 04:07:27 2015, rurban wrote:
I see now what you mean that the stack isn't refcounted. My patches fixes that, because this free happened one line above. |
From [Unknown Contact. See original ticket]On Tue Aug 25 04:07:27 2015, rurban wrote:
I see now what you mean that the stack isn't refcounted. My patches fixes that, because this free happened one line above. |
From @iabynOn Tue, Aug 25, 2015 at 04:26:33AM -0700, Reini Urban via RT wrote:
But your patch doesn't really fix anything; it just sometimes just detects This issue is similar to things like The attached patch seems to fix it. -- |
From @iabyn0001-RT-125840-stop-x-x-doing-bad-things.patchFrom 3c62f09f418b63bd79a6cbd20aaec4d992a6cc64 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Sun, 30 Aug 2015 09:48:28 +0100
Subject: [PATCH] RT #125840 stop *x = $x doing bad things
If $x is a GV then *x's GP would be freed before $x's GP is assigned to
it. That would prematurely free $x, so protect it with a temporary ref
count bump.
---
sv.c | 6 ++++++
t/op/gv.t | 20 +++++++++++++++++++-
2 files changed, 25 insertions(+), 1 deletion(-)
diff --git a/sv.c b/sv.c
index cd1bbf5..a10059d 100644
--- a/sv.c
+++ b/sv.c
@@ -3953,9 +3953,15 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
SvREFCNT_inc_simple_void_NN(sv_2mortal(dstr));
}
+ /* freeing dstr's GP might free sstr (e.g. *x = $x),
+ * so temporarily protect it */
+ ENTER;
+ SAVEFREESV(SvREFCNT_inc_simple_NN(sstr));
gp_free(MUTABLE_GV(dstr));
GvINTRO_off(dstr); /* one-shot flag */
GvGP_set(dstr, gp_ref(GvGP(sstr)));
+ LEAVE;
+
if (SvTAINTED(sstr))
SvTAINT(dstr);
if (GvIMPORTED(dstr) != GVf_IMPORTED
diff --git a/t/op/gv.t b/t/op/gv.t
index e695923..2c9cc64 100644
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
use warnings;
-plan( tests => 273 );
+plan(tests => 276 );
# type coercion on assignment
$foo = 'foo';
@@ -1132,6 +1132,24 @@ pass "No crash due to CvGV pointing to glob copy in the stash";
is $z, 3, 'list assignment after aliasing [perl #89646]';
}
+# RT #125840: make sure *x = $x doesn't do bad things by freeing $x before
+# it's assigned.
+
+{
+ $a_125840 = 1;
+ $b_125840 = 2;
+ $a_125840 = *b_125840;
+ *a_125840 = $a_125840;
+ is($a_125840, 2, 'RT #125840: *a = $a');
+
+ $c_125840 = 1;
+ $d_125840 = 2;
+ *d_125840 = $d_125840 = *c_125840;
+ is($d_125840, 1, 'RT #125840: *d=$d=*c');
+ $c_125840 = $d_125840;
+ is($c_125840, 1, 'RT #125840: $c=$d');
+}
+
__END__
Perl
--
1.9.3
|
From @iabynOn Sun, Aug 30, 2015 at 02:03:06AM -0700, Dave Mitchell via RT wrote:
Now pushed as -- |
|
@iabyn - Status changed from 'open' to 'pending release' |
From @bulk88On Sun Aug 30 02:03:05 2015, davem wrote:
Inline Patchdiff --git a/sv.c b/sv.c
index cd1bbf5..a10059d 100644
--- a/sv.c
+++ b/sv.c
@@ -3953,9 +3953,15 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype)
SvREFCNT_inc_simple_void_NN(sv_2mortal(dstr));
}
+ /* freeing dstr's GP might free sstr (e.g. *x = $x),
+ * so temporarily protect it */
+ ENTER;
+ SAVEFREESV(SvREFCNT_inc_simple_NN(sstr));
gp_free(MUTABLE_GV(dstr));
GvINTRO_off(dstr); /* one-shot flag */
GvGP_set(dstr, gp_ref(GvGP(sstr)));
+ LEAVE;
+
if (SvTAINTED(sstr))
SvTAINT(dstr);
if (GvIMPORTED(dstr) != GVf_IMPORTED
----------------------------------------------------------------
-- |
From @iabynOn Tue, Sep 01, 2015 at 03:02:13PM -0700, bulk88 via RT wrote:
It doesn't need to be. glob-to-glob assignments aren't exactly very
Because mortalising it will delay the freeing of the RHS until some future
Well, that's a different use case from what's being addressed in this -- |
From @khwilliamsonThank you for submitting this report. You have helped make Perl better. Perl 5.24.0 may be downloaded via https://metacpan.org/release/RJBS/perl-5.24.0 |
|
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#125840 (status was 'resolved')
Searchable as RT125840$
The text was updated successfully, but these errors were encountered: