Use SSize_t for tmps stack offsets

This is a partial fix for #119161.

On 64-bit platforms, I32 is too small to hold offsets into a stack
that can grow larger than I32_MAX.  What happens is the offsets can
wrap so we end up referencing and modifying elements with negative
indices, corrupting memory, and causing crashes.

With this commit, ()=1..1000000000000 stops crashing immediately.
Instead, it gobbles up all your memory first, and then, if your com-
puter still survives, crashes.  The second crash happesn bcause of
a similar bug with the argument stack, which the next commit will
take care of.

diff --git a/dump.c b/dump.c
index 6c4ae04..0f2db6b 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -504,7 +504,7 @@ Perl_sv_peek(pTHX_ SV *sv)
     }
     else if (DEBUG_R_TEST_) {
        int is_tmp = 0;
-       I32 ix;
+       SSize_t ix;
        /* is this SV on the tmps stack? */
        for (ix=PL_tmps_ix; ix>=0; ix--) {
            if (PL_tmps_stack[ix] == sv) {
@@ -2757,7 +2757,7 @@ Perl_sv_xmlpeek(pTHX_ SV *sv)
     }
     else if (DEBUG_R_TEST_) {
        int is_tmp = 0;
-       I32 ix;
+       SSize_t ix;
        /* is this SV on the tmps stack? */
        for (ix=PL_tmps_ix; ix>=0; ix--) {
            if (PL_tmps_stack[ix] == sv) {

diff --git a/embed.fnc b/embed.fnc
index 5cd5daa..ff88193 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1226,6 +1226,7 @@ Ap        |void   |save_vptr      |NN void *ptr
 Ap     |void   |save_re_context
 Ap     |void   |save_padsv_and_mortalize|PADOFFSET off
 Ap     |void   |save_sptr      |NN SV** sptr
+Xp     |void   |save_strlen    |NN STRLEN* ptr
 Ap     |SV*    |save_svref     |NN SV** sptr
 Ap     |void   |save_pushptr   |NULLOK void *const ptr|const int type
 Ap     |void   |save_pushi32ptr|const I32 i|NULLOK void *const ptr|const int type
@@ -1692,7 +1693,7 @@ Apd       |void   |sv_utf8_encode |NN SV *const sv
 ApdM   |bool   |sv_utf8_decode |NN SV *const sv
 Apdmb  |void   |sv_force_normal|NN SV *sv
 Apd    |void   |sv_force_normal_flags|NN SV *const sv|const U32 flags
-Ap     |void   |tmps_grow      |I32 n
+Ap     |void   |tmps_grow      |SSize_t n
 Apd    |SV*    |sv_rvweaken    |NN SV *const sv
 : This is indirectly referenced by globals.c. This is somewhat annoying.
 p      |int    |magic_killbackrefs|NN SV *sv|NN MAGIC *mg

diff --git a/embed.h b/embed.h
index 6cdcf82..4c62a83 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1217,6 +1217,7 @@
 #define rsignal_restore(a,b)   Perl_rsignal_restore(aTHX_ a,b)
 #define rsignal_save(a,b,c)    Perl_rsignal_save(aTHX_ a,b,c)
 #define rxres_save(a,b)                Perl_rxres_save(aTHX_ a,b)
+#define save_strlen(a)         Perl_save_strlen(aTHX_ a)
 #define sawparens(a)           Perl_sawparens(aTHX_ a)
 #define scalar(a)              Perl_scalar(aTHX_ a)
 #define scalarvoid(a)          Perl_scalarvoid(aTHX_ a)

diff --git a/intrpvar.h b/intrpvar.h
index 8021728..c6ee593 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -53,9 +53,9 @@ PERLVAR(I, scopestack_ix, I32)
 PERLVAR(I, scopestack_max, I32)
 
 PERLVAR(I, tmps_stack, SV **)          /* mortals we've made */
-PERLVARI(I, tmps_ix,   I32,    -1)
-PERLVARI(I, tmps_floor,        I32,    -1)
-PERLVAR(I, tmps_max,   I32)
+PERLVARI(I, tmps_ix,   SSize_t,        -1)
+PERLVARI(I, tmps_floor,        SSize_t,        -1)
+PERLVAR(I, tmps_max,   SSize_t)
 
 PERLVARI(I, sub_generation, U32, 1)    /* incr to invalidate method cache */
 

diff --git a/op.c b/op.c
index 6776dc7..3b990e2 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3355,7 +3355,7 @@ S_gen_constant_list(pTHX_ OP *o)
 {
     dVAR;
     OP *curop;
-    const I32 oldtmps_floor = PL_tmps_floor;
+    const SSize_t oldtmps_floor = PL_tmps_floor;
     SV **svp;
     AV *av;
 

diff --git a/proto.h b/proto.h
index 48723db..4d5db7f 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3667,6 +3667,11 @@ PERL_CALLCONV void       Perl_save_sptr(pTHX_ SV** sptr)
 #define PERL_ARGS_ASSERT_SAVE_SPTR     \
        assert(sptr)
 
+PERL_CALLCONV void     Perl_save_strlen(pTHX_ STRLEN* ptr)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_SAVE_STRLEN   \
+       assert(ptr)
+
 PERL_CALLCONV SV*      Perl_save_svref(pTHX_ SV** sptr)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_SAVE_SVREF    \
@@ -4576,7 +4581,7 @@ PERL_CALLCONV OP *        Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv, c
 #define PERL_ARGS_ASSERT_TIED_METHOD   \
        assert(methname); assert(sp); assert(sv); assert(mg)
 
-PERL_CALLCONV void     Perl_tmps_grow(pTHX_ I32 n);
+PERL_CALLCONV void     Perl_tmps_grow(pTHX_ SSize_t n);
 /* PERL_CALLCONV UV    Perl_to_uni_fold(pTHX_ UV c, U8 *p, STRLEN *lenp)
                        __attribute__nonnull__(pTHX_2)
                        __attribute__nonnull__(pTHX_3); */

diff --git a/scope.c b/scope.c
index 4939441..08ecc30 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -141,7 +141,7 @@ Perl_savestack_grow_cnt(pTHX_ I32 need)
 #undef GROW
 
 void
-Perl_tmps_grow(pTHX_ I32 n)
+Perl_tmps_grow(pTHX_ SSize_t n)
 {
     dVAR;
 #ifndef STRESS_REALLOC
@@ -158,7 +158,7 @@ Perl_free_tmps(pTHX)
 {
     dVAR;
     /* XXX should tmps_floor live in cxstack? */
-    const I32 myfloor = PL_tmps_floor;
+    const SSize_t myfloor = PL_tmps_floor;
     while (PL_tmps_ix > myfloor) {      /* clean up after last statement */
        SV* const sv = PL_tmps_stack[PL_tmps_ix--];
 #ifdef PERL_POISON
@@ -457,6 +457,20 @@ Perl_save_I32(pTHX_ I32 *intp)
     SS_ADD_END(size);
 }
 
+void
+Perl_save_strlen(pTHX_ STRLEN *ptr)
+{
+    dVAR;
+    dSS_ADD;
+
+    PERL_ARGS_ASSERT_SAVE_STRLEN;
+
+    SS_ADD_IV(*ptr);
+    SS_ADD_PTR(ptr);
+    SS_ADD_UV(SAVEt_STRLEN);
+    SS_ADD_END(3);
+}
+
 /* Cannot use save_sptr() to store a char* since the SV** cast will
  * force word-alignment and we'll miss the pointer.
  */
@@ -914,6 +928,9 @@ Perl_leave_scope(pTHX_ I32 base)
        case SAVEt_INT:                         /* int reference */
            *(int*)ARG0_PTR = (int)ARG1_I32;
            break;
+       case SAVEt_STRLEN:                      /* STRLEN/size_t ref */
+           *(STRLEN*)ARG0_PTR = (STRLEN)arg1.any_iv;
+           break;
        case SAVEt_BOOL:                        /* bool reference */
            *(bool*)ARG0_PTR = cBOOL(uv >> 8);
 #ifdef NO_TAINT_SUPPORT

diff --git a/scope.h b/scope.h
index 6afee09..97d7f83 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -64,7 +64,7 @@
 #define SAVEt_SAVESWITCHSTACK  39
 #define SAVEt_SHARED_PVREF     40
 #define SAVEt_SPTR             41
-/*     UNUSED                  42 */
+#define SAVEt_STRLEN           42
 #define SAVEt_SV               43
 #define SAVEt_SVREF            44
 #define SAVEt_VPTR             45
@@ -186,7 +186,8 @@ scope has the given name. Name must be a literal string.
 =cut
 */
 
-#define SAVETMPS save_int((int*)&PL_tmps_floor), PL_tmps_floor = PL_tmps_ix
+#define SAVETMPS Perl_save_strlen(aTHX_ (STRLEN *)&PL_tmps_floor), \
+                PL_tmps_floor = PL_tmps_ix
 #define FREETMPS if (PL_tmps_ix > PL_tmps_floor) free_tmps()
 
 #ifdef DEBUGGING

diff --git a/sv.c b/sv.c
index b47697f..4e4a917 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12891,6 +12891,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
            TOPINT(nss,ix) = i;
            break;
        case SAVEt_IV:                          /* IV reference */
+       case SAVEt_STRLEN:                      /* STRLEN/size_t ref */
            ptr = POPPTR(ss,ix);
            TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
            iv = POPIV(ss,ix);