... and fix up its caller, pp_vec().
This is part of a fix for RT #130915.
pp_vec() is responsible for extracting out the offset and size from SVs on
the stack, and then calling do_vecget() with those values. (Sometimes the
call is done indirectly by storing the offset in the LvTARGOFF() field of
a SVt_PVLV, then later Perl_magic_getvec() passes the LvTARGOFF() value to
do_vecget().)
Now SvCUR, SvLEN and LvTARGOFF are all of type STRLEN (a.k.a Size_t),
while the offset arg of do_vecget() is of type SSize_t (i.e. there's a
signed/unsigned mismatch). It makes more sense to make the arg of type
STRLEN. So that is what this commit does.
At the same time this commit fixes up pp_vec() to handle all the
possibilities where the offset value can't fit into a STRLEN, returning 0
or croaking accordingly, so that do_vecget() is never called with a
truncated or wrapped offset.
The next commit will fix up the internals of do_vecget() and do_vecset(),
which have to worry about offset*(2^n) wrapping or being > SvCUR().
This commit is based on an earlier proposed fix by Aaron Crane.
/* currently converts input to bytes if possible, but doesn't sweat failure */
UV
-Perl_do_vecget(pTHX_ SV *sv, SSize_t offset, int size)
+Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size)
{
STRLEN srclen, len, uoffset, bitoffs = 0;
const I32 svpv_flags = ((PL_op->op_flags & OPf_MOD || LVRET)
PERL_ARGS_ASSERT_DO_VECGET;
- if (offset < 0)
- return 0;
if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */
Perl_croak(aTHX_ "Illegal number of bits in vec");
(void)SvPOK_only(targ);
lval = SvUV(sv);
offset = LvTARGOFF(sv);
- if (offset < 0)
- Perl_croak(aTHX_ "Negative offset to vec in lvalue context");
size = LvTARGLEN(sv);
if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */
Perl_croak(aTHX_ "Illegal number of bits in vec");
: Defined in doop.c, used only in pp.c
p |I32 |do_trans |NN SV* sv
: Used in my.c and pp.c
-p |UV |do_vecget |NN SV* sv|SSize_t offset|int size
+p |UV |do_vecget |NN SV* sv|STRLEN offset|int size
: Defined in doop.c, used only in mg.c (with /* XXX slurp this routine */)
p |void |do_vecset |NN SV* sv
: Defined in doop.c, used only in pp.c
{
dSP;
const IV size = POPi;
- const IV offset = POPi;
+ SV* offsetsv = POPs;
SV * const src = POPs;
const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
SV * ret;
+ UV retuv = 0;
+ STRLEN offset;
+
+ /* extract a STRLEN-ranged integer value from offsetsv into offset,
+ * or die trying */
+ {
+ IV iv = SvIV(offsetsv);
+
+ /* avoid a large UV being wrapped to a negative value */
+ if (SvIOK_UV(offsetsv) && SvUVX(offsetsv) > (UV)IV_MAX) {
+ if (!lvalue)
+ goto return_val; /* out of range: return 0 */
+ Perl_croak_nocontext("Out of memory!");
+ }
+
+ if (iv < 0) {
+ if (!lvalue)
+ goto return_val; /* out of range: return 0 */
+ Perl_croak_nocontext("Negative offset to vec in lvalue context");
+ }
+
+#if PTRSIZE < IVSIZE
+ if (iv > Size_t_MAX) {
+ if (!lvalue)
+ goto return_val; /* out of range: return 0 */
+ Perl_croak_nocontext("Out of memory!");
+ }
+#endif
+
+ offset = (STRLEN)iv;
+ }
+
+ retuv = do_vecget(src, offset, size);
+
+ return_val:
if (lvalue) { /* it's an lvalue! */
ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */
ret = TARG;
}
- sv_setuv(ret, do_vecget(src, offset, size));
+
+ sv_setuv(ret, retuv);
if (!lvalue)
SvSETMAGIC(ret);
PUSHs(ret);
PERL_CALLCONV I32 Perl_do_trans(pTHX_ SV* sv);
#define PERL_ARGS_ASSERT_DO_TRANS \
assert(sv)
-PERL_CALLCONV UV Perl_do_vecget(pTHX_ SV* sv, SSize_t offset, int size);
+PERL_CALLCONV UV Perl_do_vecget(pTHX_ SV* sv, STRLEN offset, int size);
#define PERL_ARGS_ASSERT_DO_VECGET \
assert(sv)
PERL_CALLCONV void Perl_do_vecset(pTHX_ SV* sv);
set_up_inc('../lib');
}
-plan( tests => 37 );
+use Config;
+
+plan( tests => 43 );
is(vec($foo,0,1), 0);
is ${\vec %h, 0, 1}, vec(scalar %h, 0, 1), '\vec %h';
is ${\vec @a, 0, 1}, vec(scalar @a, 0, 1), '\vec @a';
}
+
+
+# [perl #130915] heap-buffer-overflow in Perl_do_vecget
+
+{
+ # ensure that out-of-STRLEN-range offsets are handled correctly. This
+ # partially duplicates some tests above, but those cases are repeated
+ # here for completeness.
+ #
+ # Note that all the 'Out of memory!' errors trapped eval {} are 'fake'
+ # croaks generated by pp_vec() etc when they have detected something
+ # that would have otherwise overflowed. The real 'Out of memory!'
+ # error thrown by safesysrealloc() etc is not trappable. If it were
+ # accidentally triggered in this test script, the script would exit at
+ # that point.
+
+
+ my $s = "abcdefghijklmnopqrstuvwxyz";
+ my $x;
+
+ # offset is SvIOK_UV
+
+ $x = vec($s, ~0, 8);
+ is($x, 0, "RT 130915: UV_MAX rval");
+ eval { vec($s, ~0, 8) = 1 };
+ like($@, qr/^Out of memory!/, "RT 130915: UV_MAX lval");
+
+ # offset is negative
+
+ $x = vec($s, -1, 8);
+ is($x, 0, "RT 130915: -1 rval");
+ eval { vec($s, -1, 8) = 1 };
+ like($@, qr/^Negative offset to vec in lvalue context/,
+ "RT 130915: -1 lval");
+
+ # offset positive but doesn't fit in a STRLEN
+
+ SKIP: {
+ skip 'IV is no longer than size_t', 2
+ if $Config{ivsize} <= $Config{sizesize};
+
+ my $size_max = (1 << (8 *$Config{sizesize})) - 1;
+ my $sm2 = $size_max * 2;
+
+ $x = vec($s, $sm2, 8);
+ is($x, 0, "RT 130915: size_max*2 rval");
+ eval { vec($s, $sm2, 8) = 1 };
+ like($@, qr/^Out of memory!/, "RT 130915: size_max*2 lval");
+ }
+}