fix integer overflows in Perl_do_vecget()/set

RT #130915

In something like

    vec($str, $bignum, 16)

(i.e. where $str is treated as a series of 16-bit words), Perl_do_vecget()
and Perl_do_vecset() end up doing calculations equivalent to:

    $start = $bignum*2;
    $end = $start + 2;

Currently both these calculations can wrap if $bignum is near the maximum
value of a STRLEN (the previous commit already fixed cases for $bignum >
max(STRLEN)).

So this commit makes them check for potential overflow before doing such
calculations.

It also takes account of the fact that the previous commit changed the
type of offset from signed to unsigned.

Finally, it also adds some tests to t/op/vec.t for where the 'word'
overlaps the end of the string, for example

    $x = vec("ab", 0, 64)

should behave the same as:

    $x = vec("ab\0\0\0\0\0\0", 0, 64)

This uses a separate code path, and I couldn't see any tests for it.

This commit is based on an earlier proposed fix by Aaron Crane.

diff --git a/doop.c b/doop.c
index 87e854a..7674af5 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -746,7 +746,7 @@ Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg)
 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 *)
@@ -772,29 +772,37 @@ Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size)
        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);
@@ -808,34 +816,33 @@ Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size)
            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) +
@@ -898,7 +905,7 @@ Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size)
 void
 Perl_do_vecset(pTHX_ SV *sv)
 {
-    SSize_t offset, bitoffs = 0;
+    STRLEN offset, bitoffs = 0;
     int size;
     unsigned char *s;
     UV lval;
@@ -925,6 +932,7 @@ Perl_do_vecset(pTHX_ SV *sv)
     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");
 
@@ -932,14 +940,20 @@ Perl_do_vecset(pTHX_ SV *sv)
        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) {

diff --git a/t/op/vec.t b/t/op/vec.t
index 9bea548..e50ffb7 100644 (file)
--- a/t/op/vec.t
+++ b/t/op/vec.t
@@ -8,7 +8,7 @@ BEGIN {
 
 use Config;
 
-plan( tests => 43 );
+plan(tests => 74);
 
 
 is(vec($foo,0,1), 0);
@@ -186,4 +186,40 @@ like($@, qr/^Modification of a read-only value attempted at /,
         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");
+        }
+    }
 }