This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl_newLISTOP() allocate OP_PUSHMARK safely
authorDavid Mitchell <davem@iabyn.com>
Thu, 11 Apr 2019 16:19:31 +0000 (17:19 +0100)
committerDavid Mitchell <davem@iabyn.com>
Fri, 12 Apr 2019 14:58:04 +0000 (15:58 +0100)
This commit is a prelude to allowing op_free() to make use the parent
pointer at the end of an op_sibling chain to walk a sub-tree to be freed.

newLISTOP() converts 0..2 ops into a list, adding a new parent list op
and possibly a pushmark op. However, under Safe.pm, and specifically in
dist/Safe/t/safeops.t, allocating a pushmark can croak. If the optree
under construct at this point isn't consistent (specifically the parent
pointer not yet set), then this can crash op_free() while trying to walk
the new list to free it.

The fix is to allocate the OP_PUSHMARK if needed *before* messing with
the structure of the list sub-tree.

op.c

diff --git a/op.c b/op.c
index 350032a..98633b9 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6101,12 +6101,15 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
 {
     dVAR;
     LISTOP *listop;
+    /* Note that allocating an OP_PUSHMARK can die under Safe.pm if
+     * pushmark is banned. So do it now while existing ops are in a
+     * consistent state, in case they suddenly get freed */
+    OP* const pushop = type == OP_LIST ? newOP(OP_PUSHMARK, 0) : NULL;
 
     assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LISTOP
        || type == OP_CUSTOM);
 
     NewOp(1101, listop, 1, LISTOP);
-
     OpTYPE_set(listop, type);
     if (first || last)
        flags |= OPf_KIDS;
@@ -6120,8 +6123,8 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
        OpMORESIB_set(first, last);
     listop->op_first = first;
     listop->op_last = last;
-    if (type == OP_LIST) {
-       OP* const pushop = newOP(OP_PUSHMARK, 0);
+
+    if (pushop) {
        OpMORESIB_set(pushop, first);
        listop->op_first = pushop;
        listop->op_flags |= OPf_KIDS;