From 2c205b5406a70a5753a289ca1b05dace7c12727a Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Fri, 2 Jul 2021 09:55:00 +0000 Subject: [PATCH] In Perl_gp_free() use PL_tmps_stack to avoid freeing glob entries immediately. 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 | 136 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++------ t/op/gv.t | 17 +++++++- 2 files changed, 139 insertions(+), 14 deletions(-) diff --git a/gv.c b/gv.c index 9bc10a3..2b8f2d1 100644 --- 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); diff --git a/t/op/gv.t b/t/op/gv.t index 4136ca2..9e2ce52 100644 --- 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 -- 1.8.3.1