UV
Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size)
{
- STRLEN srclen, len, uoffset, bitoffs = 0;
+ STRLEN srclen, len, avail, uoffset, bitoffs = 0;
const I32 svpv_flags = ((PL_op->op_flags & OPf_MOD || LVRET)
? SV_UNDEF_RETURNS_NULL : 0);
unsigned char *s = (unsigned char *)
bitoffs = ((offset%8)*size)%8;
uoffset = offset/(8/size);
}
- else if (size > 8)
- uoffset = offset*(size/8);
+ else if (size > 8) {
+ int n = size/8;
+ if (offset > Size_t_MAX / n - 1) /* would overflow */
+ return 0;
+ uoffset = offset*n;
+ }
else
uoffset = offset;
- len = uoffset + (bitoffs + size + 7)/8; /* required number of bytes */
- if (len > srclen) {
+ if (uoffset >= srclen)
+ return 0;
+
+ len = (bitoffs + size + 7)/8; /* required number of bytes */
+ avail = srclen - uoffset; /* available number of bytes */
+
+ /* Does the byte range overlap the end of the string? If so,
+ * handle specially. */
+ if (avail < len) {
if (size <= 8)
retnum = 0;
else {
if (size == 16) {
- if (uoffset >= srclen)
- retnum = 0;
- else
- retnum = (UV) s[uoffset] << 8;
+ assert(avail == 1);
+ retnum = (UV) s[uoffset] << 8;
}
else if (size == 32) {
- if (uoffset >= srclen)
- retnum = 0;
- else if (uoffset + 1 >= srclen)
+ assert(avail >= 1 && avail <= 3);
+ if (avail == 1)
retnum =
((UV) s[uoffset ] << 24);
- else if (uoffset + 2 >= srclen)
+ else if (avail == 2)
retnum =
((UV) s[uoffset ] << 24) +
((UV) s[uoffset + 1] << 16);
else if (size == 64) {
Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
"Bit vector size > 32 non-portable");
- if (uoffset >= srclen)
- retnum = 0;
- else if (uoffset + 1 >= srclen)
+ assert(avail >= 1 && avail <= 7);
+ if (avail == 1)
retnum =
(UV) s[uoffset ] << 56;
- else if (uoffset + 2 >= srclen)
+ else if (avail == 2)
retnum =
((UV) s[uoffset ] << 56) +
((UV) s[uoffset + 1] << 48);
- else if (uoffset + 3 >= srclen)
+ else if (avail == 3)
retnum =
((UV) s[uoffset ] << 56) +
((UV) s[uoffset + 1] << 48) +
((UV) s[uoffset + 2] << 40);
- else if (uoffset + 4 >= srclen)
+ else if (avail == 4)
retnum =
((UV) s[uoffset ] << 56) +
((UV) s[uoffset + 1] << 48) +
((UV) s[uoffset + 2] << 40) +
((UV) s[uoffset + 3] << 32);
- else if (uoffset + 5 >= srclen)
+ else if (avail == 5)
retnum =
((UV) s[uoffset ] << 56) +
((UV) s[uoffset + 1] << 48) +
((UV) s[uoffset + 2] << 40) +
((UV) s[uoffset + 3] << 32) +
((UV) s[uoffset + 4] << 24);
- else if (uoffset + 6 >= srclen)
+ else if (avail == 6)
retnum =
((UV) s[uoffset ] << 56) +
((UV) s[uoffset + 1] << 48) +
void
Perl_do_vecset(pTHX_ SV *sv)
{
- SSize_t offset, bitoffs = 0;
+ STRLEN offset, bitoffs = 0;
int size;
unsigned char *s;
UV lval;
lval = SvUV(sv);
offset = LvTARGOFF(sv);
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");
bitoffs = ((offset%8)*size)%8;
offset /= 8/size;
}
- else if (size > 8)
- offset *= size/8;
-
- len = offset + (bitoffs + size + 7)/8; /* required number of bytes */
- if (len > targlen) {
- s = (unsigned char*)SvGROW(targ, len + 1);
- (void)memzero((char *)(s + targlen), len - targlen + 1);
- SvCUR_set(targ, len);
+ else if (size > 8) {
+ int n = size/8;
+ if (offset > Size_t_MAX / n - 1) /* would overflow */
+ Perl_croak_nocontext("Out of memory!");
+ offset *= n;
+ }
+
+ len = (bitoffs + size + 7)/8; /* required number of bytes */
+ if (targlen < offset || targlen - offset < len) {
+ STRLEN newlen = offset > Size_t_MAX - len - 1 ? /* avoid overflow */
+ Size_t_MAX : offset + len + 1;
+ s = (unsigned char*)SvGROW(targ, newlen);
+ (void)memzero((char *)(s + targlen), newlen - targlen);
+ SvCUR_set(targ, newlen - 1);
}
if (size < 8) {
use Config;
-plan( tests => 43 );
+plan(tests => 74);
is(vec($foo,0,1), 0);
eval { vec($s, $sm2, 8) = 1 };
like($@, qr/^Out of memory!/, "RT 130915: size_max*2 lval");
}
+
+ # (offset * num-bytes) could overflow
+
+ for my $power (1..3) {
+ my $bytes = (1 << $power);
+ my $biglog2 = $Config{sizesize} * 8 - $power;
+ for my $i (0..1) {
+ my $offset = (1 << $biglog2) - $i;
+ $x = vec($s, $offset, $bytes*8);
+ is($x, 0, "large offset: bytes=$bytes biglog2=$biglog2 i=$i: rval");
+ eval { vec($s, $offset, $bytes*8) = 1; };
+ like($@, qr/^Out of memory!/,
+ "large offset: bytes=$bytes biglog2=$biglog2 i=$i: rval");
+ }
+ }
+}
+
+# Test multi-byte gets partially beyond the end of the string.
+# It's supposed to pretend there is a stream of \0's following the string.
+
+{
+ my $s = "\x01\x02\x03\x04\x05\x06\x07";
+ my $s0 = $s . ("\0" x 8);
+
+ for my $bytes (1, 2, 4, 8) {
+ for my $offset (0..$bytes) {
+ if ($Config{ivsize} < $bytes) {
+ pass("skipping multi-byte bytes=$bytes offset=$offset");
+ next;
+ }
+ no warnings 'portable';
+ is (vec($s, 8 - $offset, $bytes*8),
+ vec($s0, 8 - $offset, $bytes*8),
+ "multi-byte bytes=$bytes offset=$offset");
+ }
+ }
}