INSTALL - document how to build a perl without taint support

[perl5.git] / av.c

diff --git a/av.c b/av.c
index d807c86..d9868f4 100644 (file)
--- a/av.c
+++ b/av.c
@@ -177,7 +177,8 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
                 PL_stack_max = PL_stack_base + newmax;
             }
         } else { /* there is no SV* array yet */
-            *maxp = key < 3 ? 3 : key;
+            *maxp = key < PERL_ARRAY_NEW_MIN_KEY ?
+                          PERL_ARRAY_NEW_MIN_KEY : key;
             {
                 /* see comment above about newmax+1*/
                 MEM_WRAP_CHECK_s(*maxp, SV*,
@@ -286,11 +287,11 @@ Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
     if ((Size_t)key >= (Size_t)size) {
         if (UNLIKELY(neg))
             return NULL;
-        goto emptyness;
+        goto emptiness;
     }
 
     if (!AvARRAY(av)[key]) {
-      emptyness:
+      emptiness:
         return lval ? av_store(av,key,newSV_type(SVt_NULL)) : NULL;
     }
 
@@ -372,10 +373,47 @@ Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
     }
     else if (AvREAL(av))
         SvREFCNT_dec(ary[key]);
+
+    /* store the val into the AV before we call magic so that the magic can
+     * "see" the new value. Especially set magic on the AV itself. */
     ary[key] = val;
+
     if (SvSMAGICAL(av)) {
         const MAGIC *mg = SvMAGIC(av);
         bool set = TRUE;
+        /* We have to increment the refcount on val before we call any magic,
+         * as it is now stored in the AV (just before this block), we will
+         * then call the magic handlers which might die/Perl_croak, and
+         * longjmp up the stack to the most recent exception trap. Which means
+         * the caller code that would be expected to handle the refcount
+         * increment likely would never be executed, leading to a double free.
+         * This can happen in a case like
+         *
+         * @ary = (1);
+         *
+         * or this:
+         *
+         * if (av_store(av,n,sv)) SvREFCNT_inc(sv);
+         *
+         * where @ary/av has set magic applied to it which can die. In the
+         * first case the sv representing 1 would be mortalized, so when the
+         * set magic threw an exception it would be freed as part of the
+         * normal stack unwind. However this leaves the av structure still
+         * holding a valid visible pointer to the now freed value. In practice
+         * the next SV created will reuse the same reference, but without the
+         * refcount to account for the previous ownership and we end up with
+         * warnings about a totally different variable being double freed in
+         * the form of "attempt to free unreferenced variable"
+         * warnings/errors.
+         *
+         * https://github.com/Perl/perl5/issues/20675
+         *
+         * Arguably the API for av_store is broken in the face of magic. Instead
+         * av_store should be responsible for the refcount increment, and only
+         * not do it when specifically told to do so (eg, when storing an
+         * otherwise unreferenced scalar into an AV).
+         */
+        SvREFCNT_inc(val);  /* see comment above */
         for (; mg; mg = mg->mg_moremagic) {
           if (!isUPPER(mg->mg_type)) continue;
           if (val) {
@@ -388,6 +426,10 @@ Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
         }
         if (set)
            mg_set(MUTABLE_SV(av));
+        /* And now we are done the magic, we have to decrement it back as the av_store() api
+         * says the caller is responsible for the refcount increment, assuming
+         * av_store returns true. */
+        SvREFCNT_dec(val);
     }
     return &ary[key];
 }
@@ -527,7 +569,7 @@ Perl_newAVhv(pTHX_ HV *ohv)
     /* This number isn't perfect but it doesn't matter; it only has to be
      * close to make the initial allocation about the right size
      */
-    AV *ret = newAV_alloc_xz( nkeys ? nkeys * 2 : 2);
+    AV *ret = newAV_alloc_xz(nkeys ? nkeys * 2 : 2);
 
     /* avoid ret being leaked if croak when calling magic below */
     EXTEND_MORTAL(1);
@@ -654,7 +696,7 @@ void
 Perl_av_undef(pTHX_ AV *av)
 {
     bool real;
-    SSize_t orig_ix = PL_tmps_ix; /* silence bogus warning about possible unitialized use */
+    SSize_t orig_ix = PL_tmps_ix; /* silence bogus warning about possible uninitialized use */
 
     PERL_ARGS_ASSERT_AV_UNDEF;
     assert(SvTYPE(av) == SVt_PVAV);