From b0d55c99a8de16cc4fca0775760e63595cef1d0d Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Thu, 10 Feb 2011 14:04:54 -0800
Subject: Prevent destructors called from gp_free from seeing freed SVs
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

perl5.13.9 -e 'local *foo; $foo = bless[]; (); DESTROY { use Devel::Peek; Dump $foo; }'

This prints:
SV = UNKNOWN(0xff) (0x8044dc) at 0x8044e0
  REFCNT = 0
  FLAGS = ()

If I do anything with $foo inside the destructor, such as
‘local $foo’, it crashes, of course.

gp_free (called when *foo is being unlocalised on scope exit) does
SvREFCNT_dec(gp->gp_xv) on each of its slots.

SvREFCNT_dec(gp->gp_sv) lowers the refcount of $foo to zero, which
causes the object it references to be destroyed, too. The objects
destructor sees the same $foo still there in the typeglob.

This commit changes gp_free to use a loop, the way S_hfreeentries
(in hv.c) does, checking that everything has been freed before exit-
ing the loop.

(The one-liner above is a reduced version of

perl -MWWW::Scripter -e '$w = new WWW::Scripter; $w->use_plugin(JavaScript); $w->get(q|data:text/html,<a href onclick="throw new Error(&quot;XMLHttpRequest&quot;)">|); $w->document->links->[0]->click'

which involved *@ and a destructor localising $@.)
---
 gv.c | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 50 insertions(+), 13 deletions(-)

(limited to 'gv.c')

diff --git a/gv.c b/gv.c
index 9a259e0c8a..5ddfb563e8 100644
--- a/gv.c
+++ b/gv.c
@@ -1694,6 +1694,7 @@ Perl_gp_free(pTHX_ GV *gv)
 {
     dVAR;
     GP* gp;
+    int attempts = 100;
 
     if (!gv || !isGV_with_GP(gv) || !(gp = GvGP(gv)))
 	return;
@@ -1710,22 +1711,58 @@ Perl_gp_free(pTHX_ GV *gv)
         return;
     }
 
-    if (gp->gp_file_hek)
-	unshare_hek(gp->gp_file_hek);
-    SvREFCNT_dec(gp->gp_sv);
-    SvREFCNT_dec(gp->gp_av);
-    /* FIXME - another reference loop GV -> symtab -> GV ?
-       Somehow gp->gp_hv can end up pointing at freed garbage.  */
-    if (gp->gp_hv && SvTYPE(gp->gp_hv) == SVt_PVHV) {
-	const char *hvname = HvNAME_get(gp->gp_hv);
+    while (1) {
+      /* Copy and null out all the glob slots, so destructors do not see
+         freed SVs. */
+      HEK * const file_hek = gp->gp_file_hek;
+      SV  * const sv       = gp->gp_sv;
+      AV  * const av       = gp->gp_av;
+      HV  * const hv       = gp->gp_hv;
+      IO  * const io       = gp->gp_io;
+      CV  * const cv       = gp->gp_cv;
+      CV  * const form     = gp->gp_form;
+
+      gp->gp_file_hek = NULL;
+      gp->gp_sv       = NULL;
+      gp->gp_av       = NULL;
+      gp->gp_hv       = NULL;
+      gp->gp_io       = NULL;
+      gp->gp_cv       = NULL;
+      gp->gp_form     = NULL;
+
+      if (file_hek)
+	unshare_hek(file_hek);
+
+      SvREFCNT_dec(sv);
+      SvREFCNT_dec(av);
+      /* FIXME - another reference loop GV -> symtab -> GV ?
+         Somehow gp->gp_hv can end up pointing at freed garbage.  */
+      if (hv && SvTYPE(hv) == SVt_PVHV) {
+	const char *hvname = HvNAME_get(hv);
 	if (PL_stashcache && hvname)
-	    (void)hv_delete(PL_stashcache, hvname, HvNAMELEN_get(gp->gp_hv),
+	    (void)hv_delete(PL_stashcache, hvname, HvNAMELEN_get(hv),
 		      G_DISCARD);
-	SvREFCNT_dec(gp->gp_hv);
+	SvREFCNT_dec(hv);
+      }
+      SvREFCNT_dec(io);
+      SvREFCNT_dec(cv);
+      SvREFCNT_dec(form);
+
+      if (!gp->gp_file_hek
+       && !gp->gp_sv
+       && !gp->gp_av
+       && !gp->gp_hv
+       && !gp->gp_io
+       && !gp->gp_cv
+       && !gp->gp_form) break;
+
+      if (--attempts == 0) {
+	Perl_die(aTHX_
+	  "panic: gp_free failed to free glob pointer - "
+	  "something is repeatedly re-creating entries"
+	);
+      }
     }
-    SvREFCNT_dec(gp->gp_io);
-    SvREFCNT_dec(gp->gp_cv);
-    SvREFCNT_dec(gp->gp_form);
 
     Safefree(gp);
     GvGP_set(gv, NULL);
-- 
cgit v1.2.1