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.
authorNicholas Clark <nick@ccl4.org>
Fri, 2 Jul 2021 09:55:00 +0000 (09:55 +0000)
committerNicholas Clark <nick@ccl4.org>
Wed, 22 Sep 2021 06:53:03 +0000 (06:53 +0000)
Typeglob assignment causes the current GP to be freed, and hence any package
variables it contains. As Perl's (data) stack is not reference counted, SVs
put on it are assumed to be owned by something else. For package variables,
this assumed owner is the typeglob. Hence if a single statement contains
both assignment to a typeglob and use of one of its variables, the
interpreter can read garbage (with all the usual explosive consequences).

This is yet another manifestation of "the stack is not reference counted",
and whilst troubling from a correctness perspective, can't be exploited
unless one can already run arbitrary code, in which case any attacker has
already won.

Whilst this problematic code doesn't turn up very often in real programs,
let alone hot paths, it is found quite often by researchers running
automated 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.

Hence add code to use the temps stack to paper over the lack of stack
reference counting in this specific case. This should avoid a lot of time
spent on assessing and responding to legitimate but uninteresting security
reports, at a small cost in code complexity.

gv.c
t/op/gv.t

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);
index 4136ca2..9e2ce52 100644 (file)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,8 +12,6 @@ BEGIN {
 
 use warnings;
 
-plan(tests => 284);
-
 # type coercion on assignment
 $foo = 'foo';
 $bar = *main::foo;
@@ -317,6 +315,9 @@ is($j[0], 1);
 {
     # Need some sort of die or warn to get the global destruction text if the
     # bug is still present
+    # This test is "interesting" because the cleanup is triggered by the call
+    # op_free(PL_main_root) in perl_destruct, which is *just* before this:
+    # PERL_SET_PHASE(PERL_PHASE_DESTRUCT);
     my $output = runperl(prog => <<'EOPROG');
 package M;
 $| = 1;
@@ -1225,6 +1226,18 @@ eval << '--';
 --
 like $@, qr /^Use of inherited AUTOLOAD for non-method main::f\x{1543}\x{18c}\(\) is no longer allowed/, "Cannot inherit AUTOLOAD";
 
+# ASAN used to get very excited about this:
+runperl(prog => '$a += (*a = 2)');
+is ($?, 0,
+    "work around lack of stack reference counting during typeglob assignment");
+
+# and this
+runperl(prog => '$$ |= (*$ = $$)');
+is ($?, 0,
+    "work around lack of stack reference counting during typeglob assignment");
+
+done_testing();
+
 __END__
 Perl
 Rules