From 795eb8c825e0362c8f90071503f74e21f38873cc Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Fri, 14 Feb 2014 18:05:47 -0800 Subject: [PATCH] [perl #121242] Fix crash in gp_free when gv is freed Commit 4571f4a caused the gp to have a refcount of 1, not 0, in gp_free when the contents of the glob are freed. This makes gv_try_downgrade see the gv as a candidate for downgrading in this example: sub Fred::AUTOLOAD { $Fred::AUTOLOAD } undef *{"Fred::AUTOLOAD"}; When the glob is undefined, the sub inside it is freed, and the gvop ($Fred::AUTOLOAD), when freed, tries to downgrade the glob (*Fred::AUTOLOAD). Since it is empty, it deletes it completely from the containing stash, so the GV is freed out from under gp_free, which is still using it, causing an assertion failure. We can trigger a similar condition more explicitly: $ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = bless []; undef *{"foo"}' This bug is nothing new. On a non-debugging 5.18.2, I get this: $ perl5.18.2 -e 'DESTROY{delete $::{foo}} ${"foo"} = bless []; undef *{"foo"}' Attempt to free unreferenced glob pointers at -e line 1. Segmentation fault: 11 That crashes in pp_undef after the call to gp_free, becaues pp_undef continues to manipulate the GV. The problem occurs not only with pp_undef, but also with other func- tions calling gp_free: sv_setsv_flags: $ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = bless []; *{"foo"}="bar"' glob_assign_glob: $ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = bless []; *{"foo"}=*bar' sv_unglob, reached through various paths: $ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = do {local *bar}; $${"foo"} = bless []; ${"foo"} = 3' $ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = do {local *bar}; $${"foo"} = bless []; utf8::encode(${"foo"})' $ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = do {local *bar}; $${"foo"} = bless []; open bar, "t/TEST"; ${"foo"} .= ' $ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = do {local *bar}; $${"foo"} = bless []; ${"foo"}++' $ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = do {local *bar}; $${"foo"} = bless []; undef ${"foo"}' $ ./miniperl -e 'DESTROY{delete $::{foo}} ${"foo"} = 3; ${"foo"} =~ s/3/${"foo"} = do {local *bar}; $${"foo"} = bless []; 4/e' And there are probably more ways to trigger this through sv_unglob. (I stopped looking when I thought of the fix.) This patch fixes the problem by protecting the GV using the mortals stack in functions that call gp_free. I did not change gp_free itself, since it is an API function that as yet does not touch the mortals stack, and I am not sure that should change. All of its callers that this patch touches already do sv_2mortal in some cir- cumstances. --- pp.c | 1 + sv.c | 7 ++++++- t/op/gv.t | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 65 insertions(+), 2 deletions(-) diff --git a/pp.c b/pp.c index a5ce2a8..4d7ff09 100644 --- a/pp.c +++ b/pp.c @@ -1024,6 +1024,7 @@ PP(pp_undef) else stash = NULL; } + SvREFCNT_inc_simple_void_NN(sv_2mortal(sv)); gp_free(MUTABLE_GV(sv)); Newxz(gp, 1, GP); GvGP_set(sv, gp_ref(gp)); diff --git a/sv.c b/sv.c index 48f5dc7..4c6f9ad 100644 --- a/sv.c +++ b/sv.c @@ -3773,6 +3773,8 @@ S_glob_assign_glob(pTHX_ SV *const dstr, SV *const sstr, const int dtype) ); } } + + SvREFCNT_inc_simple_void_NN(sv_2mortal(dstr)); } gp_free(MUTABLE_GV(dstr)); @@ -4312,8 +4314,10 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) reset_isa = TRUE; } - if (GvGP(dstr)) + if (GvGP(dstr)) { + SvREFCNT_inc_simple_void_NN(sv_2mortal(dstr)); gp_free(MUTABLE_GV(dstr)); + } GvGP_set(dstr, gp_ref(GvGP(gv))); if (reset_isa) { @@ -9940,6 +9944,7 @@ S_sv_unglob(pTHX_ SV *const sv, U32 flags) if (!(flags & SV_COW_DROP_PV)) gv_efullname3(temp, MUTABLE_GV(sv), "*"); + SvREFCNT_inc_simple_void_NN(sv_2mortal(sv)); if (GvGP(sv)) { if(GvCVu((const GV *)sv) && (stash = GvSTASH(MUTABLE_GV(sv))) && HvNAME_get(stash)) diff --git a/t/op/gv.t b/t/op/gv.t index e1c9fad..6b90864 100644 --- a/t/op/gv.t +++ b/t/op/gv.t @@ -12,7 +12,7 @@ BEGIN { use warnings; -plan( tests => 259 ); +plan( tests => 271 ); # type coercion on assignment $foo = 'foo'; @@ -962,6 +962,63 @@ sub Undefiner::DESTROY { 'undeffing a gv in DESTROY triggered by undeffing the same gv' } +# [perl #121242] +# More gp_free madness. gp_free could call a destructor that frees the gv +# whose gp is being freed. +sub Fred::AUTOLOAD { $Fred::AUTOLOAD } +undef *{"Fred::AUTOLOAD"}; +pass 'no crash from gp_free triggering gv_try_downgrade'; +sub _121242::DESTROY { delete $_121242::{$_[0][0]} }; +${"_121242::foo"} = bless ["foo"], _121242::; +undef *{"_121242::foo"}; +pass 'no crash from pp_undef/gp_free freeing the gv'; +${"_121242::bar"} = bless ["bar"], _121242::; +*{"_121242::bar"} = "bar"; +pass 'no crash from sv_setsv/gp_free freeing the gv'; +${"_121242::baz"} = bless ["baz"], _121242::; +*{"_121242::baz"} = *foo; +pass 'no crash from glob_assign_glob/gp_free freeing the gv'; +{ + my $foo; + undef *_121242::DESTROY; + *_121242::DESTROY = sub { undef $foo }; + my $set_up_foo = sub { + # Make $$foo into a fake glob whose array slot holds a blessed + # array that undefines $foo, freeing the fake glob. + $foo = undef; + $$foo = do {local *bar}; + *$$foo = bless [], _121242::; + }; + &$set_up_foo; + $$foo = 3; + pass 'no crash from sv_setsv/sv_unglob/gp_free freeing the gv'; + &$set_up_foo; + utf8::encode $$foo; + pass 'no crash from sv_utf8_encode/sv_unglob/gp_free freeing the gv'; + &$set_up_foo; + open BAR, "TEST"; + $$foo .= ; + pass 'no crash from do_readline/sv_unglob/gp_free freeing the gv'; + close BAR; + &$set_up_foo; + $$foo .= 3; + pass 'no crash from pp_concat/sv_unglob/gp_free freeing the gv'; + &$set_up_foo; + no warnings; + $$foo++; + pass 'no crash from sv_inc/sv_unglob/gp_free freeing the gv'; + &$set_up_foo; + $$foo--; + pass 'no crash from sv_dec/sv_unglob/gp_free freeing the gv'; + &$set_up_foo; + undef $$foo; + pass 'no crash from pp_undef/sv_unglob/gp_free freeing the gv'; + $foo = undef; + $$foo = 3; + $$foo =~ s/3/$$foo = do {local *bar}; *$$foo = bless [],_121242::; 4/e; + pass 'no crash from pp_substcont/sv_unglob/gp_free freeing the gv'; +} + # *{undef} eval { *{my $undef} = 3 }; like $@, qr/^Can't use an undefined value as a symbol reference at /, -- 1.8.3.1