This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In Perl_gp_free() use PL_tmps_stack to avoid freeing glob entries immediately.
[perl5.git] / gv.c
diff --git a/gv.c b/gv.c
index 9bc10a3..2b8f2d1 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -2738,6 +2738,7 @@ Perl_gp_free(pTHX_ GV *gv)
 {
     GP* gp;
     int attempts = 100;
+    bool in_global_destruction = PL_phase == PERL_PHASE_DESTRUCT;
 
     if (!gv || !isGV_with_GP(gv) || !(gp = GvGP(gv)))
         return;
@@ -2760,12 +2761,14 @@ Perl_gp_free(pTHX_ GV *gv)
       /* 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;
+      SV  * sv             = gp->gp_sv;
+      AV  * av             = gp->gp_av;
+      HV  * hv             = gp->gp_hv;
+      IO  * io             = gp->gp_io;
+      CV  * cv             = gp->gp_cv;
+      CV  * form           = gp->gp_form;
+
+      int need = 0;
 
       gp->gp_file_hek = NULL;
       gp->gp_sv       = NULL;
@@ -2778,8 +2781,54 @@ Perl_gp_free(pTHX_ GV *gv)
       if (file_hek)
         unshare_hek(file_hek);
 
-      SvREFCNT_dec(sv);
-      SvREFCNT_dec(av);
+      /* Storing the SV on the temps stack (instead of freeing it immediately)
+         is an admitted bodge that attempt to compensate for the lack of
+         reference counting on the stack. The motivation is that typeglob syntax
+         is extremely short hence programs such as '$a += (*a = 2)' are often
+         found randomly by researchers running fuzzers. Previously these
+         programs would trigger errors, that the researchers would
+         (legitimately) report, and then we would spend time figuring out that
+         the cause was "stack not reference counted" and so not a dangerous
+         security hole. This consumed a lot of researcher time, our time, and
+         prevents "interesting" security holes being uncovered.
+
+         Typeglob assignment is rarely used in performance critical production
+         code, so we aren't causing much slowdown by doing extra work here.
+
+         In turn, the need to check for SvOBJECT (and references to objects) is
+         because we have regression tests that rely on timely destruction that
+         happens *within this while loop* to demonstrate behaviour, and
+         potentially there is also *working* code in the wild that relies on
+         such behaviour.
+
+         And we need to avoid doing this in global destruction else we can end
+         up with "Attempt to free temp prematurely ... Unbalanced string table
+         refcount".
+
+         Hence the whole thing is a heuristic intended to mitigate against
+         simple problems likely found by fuzzers but never written by humans,
+         whilst leaving working code unchanged. */
+      if (sv) {
+          SV *referant;
+          if (SvREFCNT(sv) > 1 || SvOBJECT(sv) || UNLIKELY(in_global_destruction)) {
+              SvREFCNT_dec_NN(sv);
+              sv = NULL;
+          } else if (SvROK(sv) && (referant = SvRV(sv))
+                     && (SvREFCNT(referant) > 1 || SvOBJECT(referant))) {
+              SvREFCNT_dec_NN(sv);
+              sv = NULL;
+          } else {
+              ++need;
+          }
+      }
+      if (av) {
+          if (SvREFCNT(av) > 1 || SvOBJECT(av) || UNLIKELY(in_global_destruction)) {
+              SvREFCNT_dec_NN(av);
+              av = NULL;
+          } else {
+              ++need;
+          }
+      }
       /* FIXME - another reference loop GV -> symtab -> GV ?
          Somehow gp->gp_hv can end up pointing at freed garbage.  */
       if (hv && SvTYPE(hv) == SVt_PVHV) {
@@ -2790,7 +2839,12 @@ Perl_gp_free(pTHX_ GV *gv)
                            HEKfARG(hvname_hek)));
            (void)hv_deletehek(PL_stashcache, hvname_hek, G_DISCARD);
         }
-        SvREFCNT_dec(hv);
+        if (SvREFCNT(hv) > 1 || SvOBJECT(hv) || UNLIKELY(in_global_destruction)) {
+          SvREFCNT_dec_NN(hv);
+          hv = NULL;
+        } else {
+          ++need;
+        }
       }
       if (io && SvREFCNT(io) == 1 && IoIFP(io)
              && (IoTYPE(io) == IoTYPE_WRONLY ||
@@ -2802,9 +2856,67 @@ Perl_gp_free(pTHX_ GV *gv)
              && IoIFP(io) != PerlIO_stderr()
              && !(IoFLAGS(io) & IOf_FAKE_DIRP))
         io_close(io, gv, FALSE, TRUE);
-      SvREFCNT_dec(io);
-      SvREFCNT_dec(cv);
-      SvREFCNT_dec(form);
+      if (io) {
+          if (SvREFCNT(io) > 1 || SvOBJECT(io) || UNLIKELY(in_global_destruction)) {
+              SvREFCNT_dec_NN(io);
+              io = NULL;
+          } else {
+              ++need;
+          }
+      }
+      if (cv) {
+          if (SvREFCNT(cv) > 1 || SvOBJECT(cv) || UNLIKELY(in_global_destruction)) {
+              SvREFCNT_dec_NN(cv);
+              cv = NULL;
+          } else {
+              ++need;
+          }
+      }
+      if (form) {
+          if (SvREFCNT(form) > 1 || SvOBJECT(form) || UNLIKELY(in_global_destruction)) {
+              SvREFCNT_dec_NN(form);
+              form = NULL;
+          } else {
+              ++need;
+          }
+      }
+
+      if (need) {
+          /* We don't strictly need to defer all this to the end, but it's
+             easiest to do so. The subtle problems we have are
+             1) any of the actions triggered by the various SvREFCNT_dec()s in
+                any of the intermediate blocks can cause more items to be added
+                to the temps stack. So we can't "cache" its state locally
+             2) We'd have to re-check the "extend by 1?" for each time.
+                Whereas if we don't NULL out the values that we want to put onto
+                the save stack until here, we can do it in one go, with one
+                one size check. */
+
+          SSize_t max_ix = PL_tmps_ix + need;
+
+          if (max_ix >= PL_tmps_max) {
+              tmps_grow_p(max_ix);
+          }
+
+          if (sv) {
+              PL_tmps_stack[++PL_tmps_ix] = sv;
+          }
+          if (av) {
+              PL_tmps_stack[++PL_tmps_ix] = (SV *) av;
+          }
+          if (hv) {
+              PL_tmps_stack[++PL_tmps_ix] = (SV *) hv;
+          }
+          if (io) {
+              PL_tmps_stack[++PL_tmps_ix] = (SV *) io;
+          }
+          if (cv) {
+              PL_tmps_stack[++PL_tmps_ix] = (SV *) cv;
+          }
+          if (form) {
+              PL_tmps_stack[++PL_tmps_ix] = (SV *) form;
+          }
+      }
 
       /* Possibly reallocated by a destructor */
       gp = GvGP(gv);