From 052a7c766b9640ee847979cb9d2351a63e23a378 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Mon, 21 Sep 2015 14:49:22 +0100 Subject: [PATCH] fix up EXTEND() callers The previous commit made it clear that the N argument to EXTEND() is supposed to be signed, in particular SSize_t, and now typically triggers compiler warnings where this isn't the case. This commit fixes the various places in core that passed the wrong sort of N to EXTEND(). The fixes are in three broad categories. First, where sensible, I've changed the relevant var to be SSize_t. Second, where its expected that N could never be large enough to wrap, I've just added an assert and a cast. Finally, I've added extra code to detect whether the cast could wrap/truncate, and if so set N to -1, which will trigger a panic in stack_grow(). This also fixes [perl #125937] 'x' operator on list causes segfault with possible stack corruption --- doop.c | 6 +++++- ext/B/B.pm | 2 +- ext/B/B.xs | 10 ++++++++-- ext/XS-APItest/APItest.xs | 4 ++-- lib/ExtUtils/typemap | 6 +++++- mg.c | 4 +++- pp.c | 29 ++++++++++++++++------------- pp_sys.c | 8 +++++++- 8 files changed, 47 insertions(+), 22 deletions(-) diff --git a/doop.c b/doop.c index 19fe310..5dbd8a2 100644 --- a/doop.c +++ b/doop.c @@ -1220,6 +1220,7 @@ Perl_do_kv(pTHX) dSP; HV * const keys = MUTABLE_HV(POPs); HE *entry; + SSize_t extend_size; const I32 gimme = GIMME_V; const I32 dokv = (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV); /* op_type is OP_RKEYS/OP_RVALUES if pp_rkeys delegated to here */ @@ -1255,7 +1256,10 @@ Perl_do_kv(pTHX) RETURN; } - EXTEND(SP, HvUSEDKEYS(keys) * (dokeys + dovalues)); + /* 2*HvUSEDKEYS() should never be big enough to truncate or wrap */ + assert(HvUSEDKEYS(keys) <= (SSize_t_MAX >> 1)); + extend_size = (SSize_t)HvUSEDKEYS(keys) * (dokeys + dovalues); + EXTEND(SP, extend_size); while ((entry = hv_iternext(keys))) { if (dokeys) { diff --git a/ext/B/B.pm b/ext/B/B.pm index 706e19a..13ab3c9 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -15,7 +15,7 @@ require Exporter; # walkoptree comes from B.xs BEGIN { - $B::VERSION = '1.59'; + $B::VERSION = '1.60'; @B::EXPORT_OK = (); # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. diff --git a/ext/B/B.xs b/ext/B/B.xs index 5d15d80..eb21103 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -1370,7 +1370,9 @@ aux_list(o, cv) PAD *comppad = PadlistARRAY(padlist)[1]; #endif - EXTEND(SP, len); + /* len should never be big enough to truncate or wrap */ + assert(len <= SSize_t_MAX); + EXTEND(SP, (SSize_t)len); PUSHs(sv_2mortal(newSViv(actions))); while (!last) { @@ -2139,8 +2141,12 @@ HvARRAY(hv) PPCODE: if (HvUSEDKEYS(hv) > 0) { HE *he; + SSize_t extend_size; (void)hv_iterinit(hv); - EXTEND(sp, HvUSEDKEYS(hv) * 2); + /* 2*HvUSEDKEYS() should never be big enough to truncate or wrap */ + assert(HvUSEDKEYS(hv) <= (SSize_t_MAX >> 1)); + extend_size = (SSize_t)HvUSEDKEYS(hv) * 2; + EXTEND(sp, extend_size); while ((he = hv_iternext(hv))) { if (HeSVKEY(he)) { mPUSHs(HeSVKEY(he)); diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 7bb7ceb..85824f8 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -1738,7 +1738,7 @@ void test_force_keys(HV *hv) PREINIT: HE *he; - STRLEN count = 0; + SSize_t count = 0; PPCODE: hv_iterinit(hv); he = hv_iternext(hv); @@ -3551,7 +3551,7 @@ CODE: CV *cv; AV *av; SV **p; - Size_t i, size; + SSize_t i, size; cv = sv_2cv(block, &stash, &gv, 0); if (cv == Nullcv) { diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap index 5f61527..1cdb846 100644 --- a/lib/ExtUtils/typemap +++ b/lib/ExtUtils/typemap @@ -378,7 +378,11 @@ T_PACKEDARRAY T_ARRAY { U32 ix_$var; - EXTEND(SP,size_$var); + SSize_t extend_size = + sizeof(size_$var) > sizeof(SSize_t) && size_$var > SSize_t_MAX + ? -1 /* might wrap; -1 triggers a panic in EXTEND() */ + : (SSize_t)size_$var; + EXTEND(SP, extend_size); for (ix_$var = 0; ix_$var < size_$var; ix_$var++) { ST(ix_$var) = sv_newmortal(); DO_ARRAY_ELEM diff --git a/mg.c b/mg.c index 8ebb6a3..ea39a67 100644 --- a/mg.c +++ b/mg.c @@ -1810,7 +1810,9 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags, PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); - EXTEND(SP, argc+1); + /* EXTEND() expects a signed argc; don't wrap when casting */ + assert(argc <= I32_MAX); + EXTEND(SP, (I32)argc+1); PUSHs(SvTIED_obj(sv, mg)); if (flags & G_UNDEF_FILL) { while (argc--) { diff --git a/pp.c b/pp.c index 34e4a4e..05268f4 100644 --- a/pp.c +++ b/pp.c @@ -88,18 +88,18 @@ PP(pp_padav) gimme = GIMME_V; if (gimme == G_ARRAY) { /* XXX see also S_pushav in pp_hot.c */ - const Size_t maxarg = AvFILL(MUTABLE_AV(TARG)) + 1; + const SSize_t maxarg = AvFILL(MUTABLE_AV(TARG)) + 1; EXTEND(SP, maxarg); if (SvMAGICAL(TARG)) { - Size_t i; + SSize_t i; for (i=0; i < maxarg; i++) { SV * const * const svp = av_fetch(MUTABLE_AV(TARG), i, FALSE); SP[i+1] = (svp) ? *svp : &PL_sv_undef; } } else { - PADOFFSET i; - for (i=0; i < (PADOFFSET)maxarg; i++) { + SSize_t i; + for (i=0; i < maxarg; i++) { SV * const sv = AvARRAY((const AV *)TARG)[i]; SP[i+1] = sv ? sv : &PL_sv_undef; } @@ -1718,14 +1718,15 @@ PP(pp_repeat) if (GIMME_V == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) { dMARK; - const Size_t items = SP - MARK; + const SSize_t items = SP - MARK; const U8 mod = PL_op->op_flags & OPf_MOD; if (count > 1) { - Size_t max; + SSize_t max; - if ( items > MEM_SIZE_MAX / (UV)count /* max would overflow */ - || items > (U32)I32_MAX / sizeof(SV *) /* repeatcpy would overflow */ + if ( items > SSize_t_MAX / count /* max would overflow */ + /* repeatcpy would overflow */ + || items > I32_MAX / (I32)sizeof(SV *) ) Perl_croak(aTHX_ "%s","Out of memory during list extend"); max = items * count; @@ -1746,7 +1747,7 @@ PP(pp_repeat) SP += max; } else if (count <= 0) - SP -= items; + SP = MARK; } else { /* Note: mark already snarfed by pp_list */ SV * const tmpstr = POPs; @@ -5660,7 +5661,7 @@ PP(pp_split) SSize_t maxiters = slen + 10; I32 trailing_empty = 0; const char *orig; - const I32 origlimit = limit; + const IV origlimit = limit; I32 realarray = 0; I32 base; const I32 gimme = GIMME_V; @@ -5834,11 +5835,13 @@ PP(pp_split) split //, $str, $i; */ if (!gimme_scalar) { - const U32 items = limit - 1; - if (items < slen) + const IV items = limit - 1; + /* setting it to -1 will trigger a panic in EXTEND() */ + const SSize_t sslen = slen > SSize_t_MAX ? -1 : (SSize_t)slen; + if (items >=0 && items < sslen) EXTEND(SP, items); else - EXTEND(SP, slen); + EXTEND(SP, sslen); } if (do_utf8) { diff --git a/pp_sys.c b/pp_sys.c index f1e2902..f9579af 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -533,6 +533,7 @@ Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv, { SV **orig_sp = sp; I32 ret_args; + SSize_t extend_size; PERL_ARGS_ASSERT_TIED_METHOD; @@ -543,7 +544,12 @@ Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv, PUTBACK; /* sp is at *foot* of args, so this pops args from old stack */ PUSHSTACKi(PERLSI_MAGIC); - EXTEND(SP, argc+1); /* object + args */ + /* extend for object + args. If argc might wrap/truncate when cast + * to SSize_t, set to -1 which will trigger a panic in EXTEND() */ + extend_size = + sizeof(argc) >= sizeof(SSize_t) && argc > SSize_t_MAX - 1 + ? -1 : (SSize_t)argc + 1; + EXTEND(SP, extend_size); PUSHMARK(sp); PUSHs(SvTIED_obj(sv, mg)); if (flags & TIED_METHOD_ARGUMENTS_ON_STACK) { -- 1.8.3.1