AddressSanitizer: heap-buffer-overflow in Perl_do_vecget

[p5pRT]

Migrated from rt.perl.org#130915 (status was 'resolved')

Searchable as RT130915$

[p5pRT]

From mtowalski@pentest.net.pl

Hello\,

I've attached the poc and the asan log. Tested on git version of perl.

Configure options​:

“./Configure -des -Dusedevel -DDEBUGGING -Dcc=clang -Doptimize=-O2 -Accflags="-fsanitize=address -fsanitize-coverage=edge" -Aldflags="-fsanitize=address -fsanitize-coverage=edge" -Alddlflags=-shared"

Information about configuration​:

Distributor ID​: Ubuntu Description​: Ubuntu 16.10 Release​: 16.10 Codename​: yakkety Arch​: x86_64

Best Regards\, Marcin T.

[p5pRT]

From mtowalski@pentest.net.pl

heap-buffer-overflow-beb-0fe-c44

[p5pRT]

From mtowalski@pentest.net.pl

/usr/bin/llvm-symbolizer perl​: warning​: Setting locale failed. perl​: warning​: Please check that your locale settings​:   LANGUAGE = (unset)\,   LC_ALL = (unset)\,   LC_CTYPE = "UTF-8"\,   LANG = "en_US.UTF-8"   are supported and installed on your system. perl​: warning​: Falling back to a fallback locale ("en_US.UTF-8").

==11621==ERROR​: AddressSanitizer​: heap-buffer-overflow on address 0x6020000011c8 at pc 0x000000ad3bec bp 0x7ffc300e3670 sp 0x7ffc300e3668 READ of size 1 at 0x6020000011c8 thread T0   #0 0xad3beb in Perl_do_vecget /home/mtowalski/Fuzzing/Programs/perl-git/doop.c​:881​:9   #1 0x9c20fe in Perl_pp_vec /home/mtowalski/Fuzzing/Programs/perl-git/pp.c​:3495​:5   #2 0x7fbc44 in Perl_runops_debug /home/mtowalski/Fuzzing/Programs/perl-git/dump.c​:2451​:23   #3 0x5e7bb3 in perl_run /home/mtowalski/Fuzzing/Programs/perl-git/perl.c   #4 0x524302 in main /home/mtowalski/Fuzzing/Programs/perl-git/perlmain.c​:123​:9   #5 0x7f3f6106b3f0 in __libc_start_main /build/glibc-jxM2Ev/glibc-2.24/csu/../csu/libc-start.c​:291   #6 0x4356f9 in _start (/home/mtowalski/Fuzzing/Programs/perl-git/perl+0x4356f9)

0x6020000011c8 is located 8 bytes to the left of 10-byte region [0x6020000011d0\,0x6020000011da) allocated by thread T0 here​:   #0 0x4eb0a8 in malloc (/home/mtowalski/Fuzzing/Programs/perl-git/perl+0x4eb0a8)   #1 0x80087e in Perl_safesysmalloc /home/mtowalski/Fuzzing/Programs/perl-git/util.c​:153​:21

SUMMARY​: AddressSanitizer​: heap-buffer-overflow /home/mtowalski/Fuzzing/Programs/perl-git/doop.c​:881​:9 in Perl_do_vecget Shadow bytes around the buggy address​:   0x0c047fff81e0​: fa fa 00 02 fa fa 07 fa fa fa 02 fa fa fa fd fd   0x0c047fff81f0​: fa fa fd fd fa fa fd fd fa fa fd fd fa fa fd fd   0x0c047fff8200​: fa fa 00 fa fa fa 00 00 fa fa fd fd fa fa fd fd   0x0c047fff8210​: fa fa fd fd fa fa 00 fa fa fa 00 04 fa fa 00 02   0x0c047fff8220​: fa fa 00 03 fa fa 00 fa fa fa 00 00 fa fa fd fd =>0x0c047fff8230​: fa fa fd fa fa fa 00 02 fa[fa]00 02 fa fa fd fa   0x0c047fff8240​: fa fa 00 02 fa fa fa fa fa fa fa fa fa fa fa fa   0x0c047fff8250​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa   0x0c047fff8260​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa   0x0c047fff8270​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa   0x0c047fff8280​: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa Shadow byte legend (one shadow byte represents 8 application bytes)​:   Addressable​: 00   Partially addressable​: 01 02 03 04 05 06 07   Heap left redzone​: fa   Freed heap region​: fd   Stack left redzone​: f1   Stack mid redzone​: f2   Stack right redzone​: f3   Stack after return​: f5   Stack use after scope​: f8   Global redzone​: f9   Global init order​: f6   Poisoned by user​: f7   Container overflow​: fc   Array cookie​: ac   Intra object redzone​: bb   ASan internal​: fe   Left alloca redzone​: ca   Right alloca redzone​: cb ==11621==ABORTING

[p5pRT]

From @arc

via RT \perl5\-security\-report@​perl\.org wrote​:

I've attached the poc and the asan log.

This reduces to​:

vec($x = ""\, 9223372036854775807\, 16)

(where the large constant is 2**63 - 1) and is caused by an integer overflow in Perl_do_vecget.

For this to be a security vulnerability\, the attacker must be able to control the offset of a vec() call with size > 8. (Or to control both offset and size\, but since the size is constrained to positive powers of two no greater than the number of bits in an IV\, that's less of an issue.) The consequence is an arbitrary memory read\, afaict.

However\, there's also a related bug in Perl_do_vecset; this further requires the vec() to be in lvalue context\, but I think it allows writing to arbitrary attacker-controlled memory locations. This seems like a greater hazard; does it need a CVE?

I've attached the following series of patches​:

1. Fix the Perl_do_vecget overflow reported in this ticket

2. Fix the related Perl_do_vecset overflow\, by throwing an exception in that case

3. Fix another vec() bug\, found by inspection\, that happens for large offsets when IV is wider than size_t

4. Fix the equivalent case for lvalue vec(); not only does this throw an exception\, but the exception must be thrown when doing the initial read (so calling the vec() in lvalue context will throw an exception even if you don't subsequently write through the result)

5. Simplify do_vecget and do_vecset by removing a level of nesting in three places

6. Reindent do_vecget and do_vecset to account for the previous change

I suggest that 1\, 2\, 3\, and 4 (or other fixes for those bugs) should go into (frozen) blead in time for 5.26.0.

However\, patches 2 and 4 are slightly tricky from the point of view of the freeze\, in that they add a new exception. An alternative approach would be to silently do nothing in such situations\, but I don't think that's actually helpful for users.

I also think that 5 and 6 should go in too​: the risk they present is negligible\, and they make it easier to see what the code is doing. But I accept that they aren't technically necessary during the freeze\, so I'm OK with holding them over to 5.27.

-- Aaron Crane ** http​://aaroncrane.co.uk/

[p5pRT]

From @arc

0001-RT-130915-heap-buffer-overflow-in-Perl_do_vecget.patch

```diff From 19334fc96b88235e312708c8ee51077d8f0afc26 Mon Sep 17 00:00:00 2001 From: Aaron Crane Date: Sun, 5 Mar 2017 11:40:52 +0000 Subject: [PATCH 1/6] RT#130915: heap-buffer-overflow in Perl_do_vecget() Fuzzer-found, and detected by asan. The underlying cause is an integer overflow. Fix by detecting an out-of-bounds offset earlier; this also simplifies the code somewhat. --- doop.c | 16 ++++++---------- t/op/vec.t | 17 ++++++++++++++++- 2 files changed, 22 insertions(+), 11 deletions(-) diff --git a/doop.c b/doop.c index b5c10039b6..77ebe00927 100644 --- a/doop.c +++ b/doop.c @@ -779,21 +779,19 @@ Perl_do_vecget(pTHX_ SV *sv, SSize_t offset, int size) else uoffset = offset; + if (uoffset >= srclen) + return 0; + len = uoffset + (bitoffs + size + 7)/8; /* required number of bytes */ if (len > srclen) { if (size <= 8) retnum = 0; else { if (size == 16) { - if (uoffset >= srclen) - retnum = 0; - else - retnum = (UV) s[uoffset] << 8; + retnum = (UV) s[uoffset] << 8; } else if (size == 32) { - if (uoffset >= srclen) - retnum = 0; - else if (uoffset + 1 >= srclen) + if (uoffset + 1 >= srclen) retnum = ((UV) s[uoffset ] << 24); else if (uoffset + 2 >= srclen) @@ -810,9 +808,7 @@ Perl_do_vecget(pTHX_ SV *sv, SSize_t 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) + if (uoffset + 1 >= srclen) retnum = (UV) s[uoffset ] << 56; else if (uoffset + 2 >= srclen) diff --git a/t/op/vec.t b/t/op/vec.t index ea63317ad0..90aedaf03e 100644 --- a/t/op/vec.t +++ b/t/op/vec.t @@ -6,7 +6,9 @@ BEGIN { set_up_inc('../lib'); } -plan( tests => 37 ); +use Config; + +plan( tests => 38 ); is(vec($foo,0,1), 0); @@ -135,3 +137,16 @@ like($@, qr/^Modification of a read-only value attempted at /, 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 +# asan-detected; caused by integer overflow +{ + # 0x7fff_ffff on 32-bit, 0x7fff_ffff_ffff_ffff on 64-bit + my $large = do { + my $n = 'ff' x $Config{ivsize}; + substr $n, 0, 1, '7'; + hex $n; + }; + is vec(my $x = "", $large, 16), 0, + 'RT#130915: heap-buffer-overflow in Perl_do_vecget'; +} -- 2.11.0 ```

[p5pRT]

From @arc

0002-Integer-buffer-overflow-in-Perl_do_vecset.patch

```diff From e82b4b79606debf9a2965b800946a4a011ee343c Mon Sep 17 00:00:00 2001 From: Aaron Crane Date: Sun, 5 Mar 2017 13:23:48 +0000 Subject: [PATCH 2/6] Integer/buffer overflow in Perl_do_vecset This is a variant on the equivalent bug fixed in the previous commit. --- doop.c | 8 ++++++-- pod/perldiag.pod | 5 +++++ t/op/vec.t | 13 +++++++++++-- 3 files changed, 22 insertions(+), 4 deletions(-) diff --git a/doop.c b/doop.c index 77ebe00927..8e459738d4 100644 --- a/doop.c +++ b/doop.c @@ -932,8 +932,12 @@ Perl_do_vecset(pTHX_ SV *sv) bitoffs = ((offset%8)*size)%8; offset /= 8/size; } - else if (size > 8) - offset *= size/8; + else if (size > 8) { + STRLEN uoffset = offset * (unsigned)(size/8); + if (UNLIKELY(uoffset < (STRLEN)offset || uoffset >= SSize_t_MAX)) + Perl_croak(aTHX_ "Offset too large for vec in lvalue context"); + offset = uoffset; + } len = offset + (bitoffs + size + 7)/8; /* required number of bytes */ if (len > targlen) { diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 390ba81e09..d4b9ce2b79 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -4268,6 +4268,11 @@ Cing a file, or when seeking past the end of a scalar opened for I/O (in anticipation of future reads and to imitate the behavior with real files). +=item Offset too large for vec in lvalue context + +(F) You tried to assign to the result of vec() with an offset that points +outside the addressable memory in your computer. + =item %s() on unopened %s (W unopened) An I/O operation was attempted on a filehandle that was diff --git a/t/op/vec.t b/t/op/vec.t index 90aedaf03e..55a8706df6 100644 --- a/t/op/vec.t +++ b/t/op/vec.t @@ -8,7 +8,7 @@ BEGIN { use Config; -plan( tests => 38 ); +plan( tests => 40 ); is(vec($foo,0,1), 0); @@ -147,6 +147,15 @@ like($@, qr/^Modification of a read-only value attempted at /, substr $n, 0, 1, '7'; hex $n; }; - is vec(my $x = "", $large, 16), 0, + my $x = ""; + is vec($x, $large, 16), 0, 'RT#130915: heap-buffer-overflow in Perl_do_vecget'; + + # This related bug was found by inspection after seeing RT#130915: + local $@; + my $result = eval { vec($x, $large, 16) = 0xdead }; + my $err = $@; + is $result, undef; + like $err, qr/^Offset too large for vec in lvalue context/, + 'no integer overflow in Perl_do_vecset' } -- 2.11.0 ```

[p5pRT]

From @arc

0003-pp_vec-fix-bug-on-32-bit-systems-with-64-bit-IV.patch

```diff From 92ae790fd46b30ba40ad3c558d9778dcd050a757 Mon Sep 17 00:00:00 2001 From: Aaron Crane Date: Sun, 5 Mar 2017 11:59:22 +0000 Subject: [PATCH 3/6] pp_vec(): fix bug on 32-bit systems with 64-bit IV --- pp.c | 5 ++++- t/op/vec.t | 21 ++++++++++++++++++++- 2 files changed, 24 insertions(+), 2 deletions(-) diff --git a/pp.c b/pp.c index a640995e31..81ab717067 100644 --- a/pp.c +++ b/pp.c @@ -3492,7 +3492,10 @@ PP(pp_vec) ret = TARG; } - sv_setuv(ret, do_vecget(src, offset, size)); + if (offset < 0 || UNLIKELY(offset > (IV)SSize_t_MAX)) + sv_setuv(ret, 0); + else + sv_setuv(ret, do_vecget(src, offset, size)); if (!lvalue) SvSETMAGIC(ret); PUSHs(ret); diff --git a/t/op/vec.t b/t/op/vec.t index 55a8706df6..a63bad62e7 100644 --- a/t/op/vec.t +++ b/t/op/vec.t @@ -8,7 +8,7 @@ BEGIN { use Config; -plan( tests => 40 ); +plan( tests => 42 ); is(vec($foo,0,1), 0); @@ -159,3 +159,22 @@ like($@, qr/^Modification of a read-only value attempted at /, like $err, qr/^Offset too large for vec in lvalue context/, 'no integer overflow in Perl_do_vecset' } + +{ + my $x = "\0\0\0\1"; + + # 0xffff_ffff or 0xffff_ffff_ffff_ffff + my $uv_max = hex( 'ff' x $Config{ivsize} ); + is vec($x, $uv_max, 8), 0, 'ignore overlarge vec offset'; + + # 0x7fff_0001 or 0x7fff_ffff_0000_0001; on a system with 64-bit IV and + # 32-bit SSize_t, make sure this doesn't truncate to 1 + my $large = do { + my $hi = 'ff' x ($Config{ivsize} / 2); + my $lo = '00' x ($Config{ivsize} / 2); + substr $hi, 0, 1, '7'; + substr $lo, -1, 1, '1'; + hex "$hi$lo"; + }; + is vec($x, $large, 8), 0, 'no truncation in pp_vec'; +} -- 2.11.0 ```

[p5pRT]

From @arc

0004-Throw-on-out-of-bounds-lvalue-vec-when-IV-wider-than.patch

```diff From f01af7a97800a9d8feb53a12f7d10ec1dbec9871 Mon Sep 17 00:00:00 2001 From: Aaron Crane Date: Sun, 5 Mar 2017 13:24:26 +0000 Subject: [PATCH 4/6] Throw on out-of-bounds lvalue vec() when IV wider than ssize_t --- pp.c | 5 +++++ t/op/vec.t | 14 +++++++++++++- 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/pp.c b/pp.c index 81ab717067..6b678e95b8 100644 --- a/pp.c +++ b/pp.c @@ -3479,6 +3479,11 @@ PP(pp_vec) SV * ret; if (lvalue) { /* it's an lvalue! */ + if (UNLIKELY(offset > (IV)SSize_t_MAX)) { + /* Have to throw here rather than in do_vecset(), because + * LvTARGOFF() is ssize_t, and therefore narrower than IV */ + Perl_croak_nocontext("Offset too large for vec in lvalue context"); + } ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */ sv_magic(ret, NULL, PERL_MAGIC_vec, NULL, 0); LvTYPE(ret) = 'v'; diff --git a/t/op/vec.t b/t/op/vec.t index a63bad62e7..3d6ae5821d 100644 --- a/t/op/vec.t +++ b/t/op/vec.t @@ -8,7 +8,7 @@ BEGIN { use Config; -plan( tests => 42 ); +plan( tests => 44 ); is(vec($foo,0,1), 0); @@ -177,4 +177,16 @@ like($@, qr/^Modification of a read-only value attempted at /, hex "$hi$lo"; }; is vec($x, $large, 8), 0, 'no truncation in pp_vec'; + + SKIP: { + skip 'IV is no longer than ssize_t', 2 + if $Config{ivsize} <= $Config{sizesize}; + + local $@; + my $result = eval { \vec($x, $large, 8) }; + my $err = $@; + is $result, undef; + like $err, qr/^Offset too large for vec in lvalue context/, + "exception on lvalue vec with offset beyond ssize_t range"; + } } -- 2.11.0 ```

[p5pRT]

From @arc

0005-Remove-spurious-levels-of-nesting-in-do_vecget-do_ve.patch

```diff From 816f1223d5bc7efc3f856e481f74f22a507ac315 Mon Sep 17 00:00:00 2001 From: Aaron Crane Date: Sun, 5 Mar 2017 12:02:25 +0000 Subject: [PATCH 5/6] Remove spurious levels of nesting in do_vecget, do_vecset --- doop.c | 50 ++++++++++++++++++++++---------------------------- 1 file changed, 22 insertions(+), 28 deletions(-) diff --git a/doop.c b/doop.c index 8e459738d4..41ed90cac7 100644 --- a/doop.c +++ b/doop.c @@ -786,11 +786,10 @@ Perl_do_vecget(pTHX_ SV *sv, SSize_t offset, int size) if (len > srclen) { if (size <= 8) retnum = 0; - else { - if (size == 16) { - retnum = (UV) s[uoffset] << 8; - } - else if (size == 32) { + else if (size == 16) { + retnum = (UV) s[uoffset] << 8; + } + else if (size == 32) { if (uoffset + 1 >= srclen) retnum = ((UV) s[uoffset ] << 24); @@ -803,9 +802,9 @@ Perl_do_vecget(pTHX_ SV *sv, SSize_t offset, int size) ((UV) s[uoffset ] << 24) + ((UV) s[uoffset + 1] << 16) + ( s[uoffset + 2] << 8); - } + } #ifdef UV_IS_QUAD - else if (size == 64) { + else if (size == 64) { Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), "Bit vector size > 32 non-portable"); if (uoffset + 1 >= srclen) @@ -850,27 +849,25 @@ Perl_do_vecget(pTHX_ SV *sv, SSize_t offset, int size) ((UV) s[uoffset + 4] << 24) + ((UV) s[uoffset + 5] << 16) + ((UV) s[uoffset + 6] << 8); - } + } #endif - } } else if (size < 8) retnum = (s[uoffset] >> bitoffs) & ((1 << size) - 1); - else { - if (size == 8) - retnum = s[uoffset]; - else if (size == 16) - retnum = + else if (size == 8) + retnum = s[uoffset]; + else if (size == 16) + retnum = ((UV) s[uoffset] << 8) + s[uoffset + 1]; - else if (size == 32) - retnum = + else if (size == 32) + retnum = ((UV) s[uoffset ] << 24) + ((UV) s[uoffset + 1] << 16) + ( s[uoffset + 2] << 8) + s[uoffset + 3]; #ifdef UV_IS_QUAD - else if (size == 64) { + else if (size == 64) { Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), "Bit vector size > 32 non-portable"); retnum = @@ -882,9 +879,8 @@ Perl_do_vecget(pTHX_ SV *sv, SSize_t offset, int size) ((UV) s[uoffset + 5] << 16) + ( s[uoffset + 6] << 8) + s[uoffset + 7]; - } -#endif } +#endif return retnum; } @@ -952,21 +948,20 @@ Perl_do_vecset(pTHX_ SV *sv) s[offset] &= ~(mask << bitoffs); s[offset] |= lval << bitoffs; } - else { - if (size == 8) + else if (size == 8) s[offset ] = (U8)( lval & 0xff); - else if (size == 16) { + else if (size == 16) { s[offset ] = (U8)((lval >> 8) & 0xff); s[offset+1] = (U8)( lval & 0xff); - } - else if (size == 32) { + } + else if (size == 32) { s[offset ] = (U8)((lval >> 24) & 0xff); s[offset+1] = (U8)((lval >> 16) & 0xff); s[offset+2] = (U8)((lval >> 8) & 0xff); s[offset+3] = (U8)( lval & 0xff); - } + } #ifdef UV_IS_QUAD - else if (size == 64) { + else if (size == 64) { Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), "Bit vector size > 32 non-portable"); s[offset ] = (U8)((lval >> 56) & 0xff); @@ -977,9 +972,8 @@ Perl_do_vecset(pTHX_ SV *sv) s[offset+5] = (U8)((lval >> 16) & 0xff); s[offset+6] = (U8)((lval >> 8) & 0xff); s[offset+7] = (U8)( lval & 0xff); - } -#endif } +#endif SvSETMAGIC(targ); } -- 2.11.0 ```

[p5pRT]

From @arc

0006-Adjust-do_vecget-do_vecset-indentation-after-previou.patch

```diff From 4810547796c0a032139881f3b33fb671ed0cdef0 Mon Sep 17 00:00:00 2001 From: Aaron Crane Date: Sun, 5 Mar 2017 12:04:11 +0000 Subject: [PATCH 6/6] Adjust do_vecget/do_vecset indentation after previous change This change is whitespace-only. --- doop.c | 180 ++++++++++++++++++++++++++++++++--------------------------------- 1 file changed, 90 insertions(+), 90 deletions(-) diff --git a/doop.c b/doop.c index 41ed90cac7..9bdd1d8708 100644 --- a/doop.c +++ b/doop.c @@ -790,65 +790,65 @@ Perl_do_vecget(pTHX_ SV *sv, SSize_t offset, int size) retnum = (UV) s[uoffset] << 8; } else if (size == 32) { - if (uoffset + 1 >= srclen) - retnum = - ((UV) s[uoffset ] << 24); - else if (uoffset + 2 >= srclen) - retnum = - ((UV) s[uoffset ] << 24) + - ((UV) s[uoffset + 1] << 16); - else - retnum = - ((UV) s[uoffset ] << 24) + - ((UV) s[uoffset + 1] << 16) + - ( s[uoffset + 2] << 8); + if (uoffset + 1 >= srclen) + retnum = + ((UV) s[uoffset ] << 24); + else if (uoffset + 2 >= srclen) + retnum = + ((UV) s[uoffset ] << 24) + + ((UV) s[uoffset + 1] << 16); + else + retnum = + ((UV) s[uoffset ] << 24) + + ((UV) s[uoffset + 1] << 16) + + ( s[uoffset + 2] << 8); } #ifdef UV_IS_QUAD else if (size == 64) { - Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), - "Bit vector size > 32 non-portable"); - if (uoffset + 1 >= srclen) - retnum = - (UV) s[uoffset ] << 56; - else if (uoffset + 2 >= srclen) - retnum = - ((UV) s[uoffset ] << 56) + - ((UV) s[uoffset + 1] << 48); - else if (uoffset + 3 >= srclen) - retnum = - ((UV) s[uoffset ] << 56) + - ((UV) s[uoffset + 1] << 48) + - ((UV) s[uoffset + 2] << 40); - else if (uoffset + 4 >= srclen) - 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) - 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) - 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) + - ((UV) s[uoffset + 5] << 16); - else - 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) + - ((UV) s[uoffset + 5] << 16) + - ((UV) s[uoffset + 6] << 8); + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "Bit vector size > 32 non-portable"); + if (uoffset + 1 >= srclen) + retnum = + (UV) s[uoffset ] << 56; + else if (uoffset + 2 >= srclen) + retnum = + ((UV) s[uoffset ] << 56) + + ((UV) s[uoffset + 1] << 48); + else if (uoffset + 3 >= srclen) + retnum = + ((UV) s[uoffset ] << 56) + + ((UV) s[uoffset + 1] << 48) + + ((UV) s[uoffset + 2] << 40); + else if (uoffset + 4 >= srclen) + 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) + 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) + 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) + + ((UV) s[uoffset + 5] << 16); + else + 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) + + ((UV) s[uoffset + 5] << 16) + + ((UV) s[uoffset + 6] << 8); } #endif } @@ -858,27 +858,27 @@ Perl_do_vecget(pTHX_ SV *sv, SSize_t offset, int size) retnum = s[uoffset]; else if (size == 16) retnum = - ((UV) s[uoffset] << 8) + - s[uoffset + 1]; + ((UV) s[uoffset] << 8) + + s[uoffset + 1]; else if (size == 32) retnum = - ((UV) s[uoffset ] << 24) + - ((UV) s[uoffset + 1] << 16) + - ( s[uoffset + 2] << 8) + - s[uoffset + 3]; + ((UV) s[uoffset ] << 24) + + ((UV) s[uoffset + 1] << 16) + + ( s[uoffset + 2] << 8) + + s[uoffset + 3]; #ifdef UV_IS_QUAD else if (size == 64) { - Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), - "Bit vector size > 32 non-portable"); - 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) + - ((UV) s[uoffset + 5] << 16) + - ( s[uoffset + 6] << 8) + - s[uoffset + 7]; + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "Bit vector size > 32 non-portable"); + 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) + + ((UV) s[uoffset + 5] << 16) + + ( s[uoffset + 6] << 8) + + s[uoffset + 7]; } #endif @@ -949,29 +949,29 @@ Perl_do_vecset(pTHX_ SV *sv) s[offset] |= lval << bitoffs; } else if (size == 8) - s[offset ] = (U8)( lval & 0xff); + s[offset ] = (U8)( lval & 0xff); else if (size == 16) { - s[offset ] = (U8)((lval >> 8) & 0xff); - s[offset+1] = (U8)( lval & 0xff); + s[offset ] = (U8)((lval >> 8) & 0xff); + s[offset+1] = (U8)( lval & 0xff); } else if (size == 32) { - s[offset ] = (U8)((lval >> 24) & 0xff); - s[offset+1] = (U8)((lval >> 16) & 0xff); - s[offset+2] = (U8)((lval >> 8) & 0xff); - s[offset+3] = (U8)( lval & 0xff); + s[offset ] = (U8)((lval >> 24) & 0xff); + s[offset+1] = (U8)((lval >> 16) & 0xff); + s[offset+2] = (U8)((lval >> 8) & 0xff); + s[offset+3] = (U8)( lval & 0xff); } #ifdef UV_IS_QUAD else if (size == 64) { - Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), - "Bit vector size > 32 non-portable"); - s[offset ] = (U8)((lval >> 56) & 0xff); - s[offset+1] = (U8)((lval >> 48) & 0xff); - s[offset+2] = (U8)((lval >> 40) & 0xff); - s[offset+3] = (U8)((lval >> 32) & 0xff); - s[offset+4] = (U8)((lval >> 24) & 0xff); - s[offset+5] = (U8)((lval >> 16) & 0xff); - s[offset+6] = (U8)((lval >> 8) & 0xff); - s[offset+7] = (U8)( lval & 0xff); + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "Bit vector size > 32 non-portable"); + s[offset ] = (U8)((lval >> 56) & 0xff); + s[offset+1] = (U8)((lval >> 48) & 0xff); + s[offset+2] = (U8)((lval >> 40) & 0xff); + s[offset+3] = (U8)((lval >> 32) & 0xff); + s[offset+4] = (U8)((lval >> 24) & 0xff); + s[offset+5] = (U8)((lval >> 16) & 0xff); + s[offset+6] = (U8)((lval >> 8) & 0xff); + s[offset+7] = (U8)( lval & 0xff); } #endif SvSETMAGIC(targ); -- 2.11.0 ```

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @iabyn

On Sun\, Mar 05\, 2017 at 03​:04​:06PM +0000\, Aaron Crane wrote​:

via RT \perl5\-security\-report@&#8203;perl\.org wrote​:

I've attached the poc and the asan log.

This reduces to​:

vec($x = ""\, 9223372036854775807\, 16)

(where the large constant is 2**63 - 1) and is caused by an integer overflow in Perl_do_vecget.

For this to be a security vulnerability\, the attacker must be able to control the offset of a vec() call with size > 8. (Or to control both offset and size\, but since the size is constrained to positive powers of two no greater than the number of bits in an IV\, that's less of an issue.) The consequence is an arbitrary memory read\, afaict.

However\, there's also a related bug in Perl_do_vecset; this further requires the vec() to be in lvalue context\, but I think it allows writing to arbitrary attacker-controlled memory locations. This seems like a greater hazard; does it need a CVE?

From my own inspection of the existing code and your patches​:

There are fundamentally two classes of bug here.

First are ones related to type mismatches such as signed \<=> unsigned\, Size_t vs SSize_t vs IV\, plus arithmetic overflow and wraparound. These can cause the wrong element to be fetched or written to (but never outside the string). For example (and this bug is still present after your patches)\, this​:

  my $s = "abcdefghijklmnopqrstuvwxyz";   my $n1 = vec $s\,0x0000000000000000 \, 64;   my $n2 = vec $s\,0x4000000000000000 \, 64;   printf "n1=0x%x n2=0x%x\n"\, $n1\, $n2;

prints

  n1=0x6162636465666768 n2=0x6162636465666768

whereas n2 should be 0.

The second class of bug\, and the one reported in this ticket\, is where the calculation of len wraps in​:

  len = uoffset + (bitoffs + size + 7)/8;

here uoffset is the start byte within the string\, and len is supposed to be that plus the number of bytes needing to be read (2 in the case of bitsize 16). Thus for a value of uoffset very close to Size_t_MAX this calculation can wrap\, leaving len as a very small positive integer (e.g. 0 or 1 for bitsize 16\, 0..7 for bitsize 64). This defeats this guard​:

  if (len > srclen) ...  
and causes the code to take the 'all the bytes are within the string' branch which directly accesses the string using indexes like s[uoffset] and s[uoffset + 1]\, without any further guards.

The net effect of all this is that\, AFAICT\, the wild read can only be of the word directly preceding the start of the string\, not of any arbitrary attacker-controlled location.

Similarly in Perl_do_vecset()\, the code only fails to attempt to grow the buffer to the size of offset if the len calculation wrapped; so again the code can only write to the word directly before the string buffer rather than to any location in memory. Not ideal\, but given this can only occur when the attacker can cause the code to call vec() with a specified very large offset and a bit size >= 8\, I think we can skip the CVE.

I'd be happier if someone checked my logic above though.

I'm not entirely happy with your patchset\, chiefly in that I don't think it goes far enough. Some issues I see​:

* In pp_vec()​:

  const IV offset = POPi;

If the offset happens to be a large-valued UV\, then offset will be set to a negative value. This is safe\, but will give a misleading error in lval context​:

  $ perl -e'vec($x=""\, ~0\, 8) = 1'   Negative offset to vec in lvalue context at -e line 1.

(there is no negative value).

* I think the signature of Perl_do_vecget() should change​: offset should change from SSize_t to STRLEN (aka Size_t). This is because both string lengths and LvTARGOFF() are STRLEN and we're doing a bunch of undefined (but in practice safe) behaviour by storing a signed value as unsigned then retrieving it and treating it signed again. Changing this reduces the cognitive load. pp_vec()'s job then becomes to take an arbitrarily-valued SV and convert it into a STRLEN value ready to pass to do_vecget() (or via LvTARGOFF to do_vecget or do_vecset). Your patches already mostly do this\, but I would prefer to see it more explicit - i.e. a block of code which starts with an SV and ands with a STRLEN-valued variable ready to be used by the rest of the function (or which dies/returns 0 trying).

Perl_do_vecget() is 'p' in embed.fnc\, so shouldn't be used outside the core; in fact on win32 it *cannot* be used outside the core because it isn't exported. Also\, grep.cpan.me shows no use of it.

* In do_vecget and do_vecset\, the calculations where we do things like

  uoffset = 2*offset;   len = uoffset + 2;

both risk overflowing. I think it is more defensive to check for sane values before the calculations rather than check for insane values after; e.g.

  if (offset > SSize_t_MAX / 2)   croak(...);   uoffset = 2*offset;

Do you want to rework your patches\, or would you like me to have a go? (I don't mind - I am available to work on it immediately).

I still think this should be fixed for 5.25.11.

However\, patches 2 and 4 are slightly tricky from the point of view of the freeze\, in that they add a new exception. An alternative approach would be to silently do nothing in such situations\, but I don't think that's actually helpful for users.

We already have some generic out-of-memory error messages that although are less specific\, can suffice without needing a new diag. For example already​:

  $ perl -e'my $s=""; vec($s\,1\<\<40\,8) = 1'   Out of memory!

We don't necessarily need the special error of

  Offset too large for vec in lvalue context

just because we're running on a 32-bit system with -Duse64bitint and provided an offset > 2^31. I think 'Out of memory!' works just as well there too.

I also think that 5 and 6 should go in too​: the risk they present is negligible\, and they make it easier to see what the code is doing. But I accept that they aren't technically necessary during the freeze\, so I'm OK with holding them over to 5.27.

I'm happy for something similar to go in.

-- I before E. Except when it isn't.

[p5pRT]

From @iabyn

On Tue\, Mar 14\, 2017 at 05​:44​:38PM +0000\, Aaron Crane wrote​:

Thank you for the offer\, and please go ahead — I moved house yesterday\, so it's going to be a little while before I've got enough time to think carefully about things like this.

Ok here are two commits that I will merge into blead tomorrow unless I hear anything to the contrary. I decided not to remove the redundant sets of braces in the big if/else tree for now.

I've tested them on a 64-bit system and a 32-bit system with -Duse64bitint\, and am currently testing with a pure 32-bit build.

-- Music lesson​: a symbiotic relationship whereby a pupil's embellishments concerning the amount of practice performed since the last lesson are rewarded with embellishments from the teacher concerning the pupil's progress over the corresponding period.

[p5pRT]

From @iabyn

0001-Perl_do_vecget-change-offset-arg-to-STRLEN-type.patch

```diff From 3379bb7049bcc8d0777f220995e1ad91ad556fb0 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Wed, 15 Mar 2017 14:35:59 +0000 Subject: [PATCH 1/2] Perl_do_vecget(): change offset arg to STRLEN type ... 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. --- doop.c | 6 +----- embed.fnc | 2 +- pp.c | 40 ++++++++++++++++++++++++++++++++++++++-- proto.h | 2 +- t/op/vec.t | 54 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 5 files changed, 94 insertions(+), 10 deletions(-) diff --git a/doop.c b/doop.c index b5c1003..87e854a 100644 --- a/doop.c +++ b/doop.c @@ -744,7 +744,7 @@ Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg) /* 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) @@ -759,8 +759,6 @@ Perl_do_vecget(pTHX_ SV *sv, SSize_t offset, int size) 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"); @@ -926,8 +924,6 @@ Perl_do_vecset(pTHX_ SV *sv) (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"); diff --git a/embed.fnc b/embed.fnc index 3a68a35..654dad9 100644 --- a/embed.fnc +++ b/embed.fnc @@ -491,7 +491,7 @@ pR |Off_t |do_tell |NN GV* gv : 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 diff --git a/pp.c b/pp.c index a640995..a6b3041 100644 --- a/pp.c +++ b/pp.c @@ -3473,10 +3473,45 @@ PP(pp_vec) { 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 */ @@ -3492,7 +3527,8 @@ PP(pp_vec) ret = TARG; } - sv_setuv(ret, do_vecget(src, offset, size)); + + sv_setuv(ret, retuv); if (!lvalue) SvSETMAGIC(ret); PUSHs(ret); diff --git a/proto.h b/proto.h index 3e55e21..f1d6181 100644 --- a/proto.h +++ b/proto.h @@ -806,7 +806,7 @@ PERL_CALLCONV Off_t Perl_do_tell(pTHX_ GV* gv) 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); diff --git a/t/op/vec.t b/t/op/vec.t index ea63317..9bea548 100644 --- a/t/op/vec.t +++ b/t/op/vec.t @@ -6,7 +6,9 @@ BEGIN { set_up_inc('../lib'); } -plan( tests => 37 ); +use Config; + +plan( tests => 43 ); is(vec($foo,0,1), 0); @@ -135,3 +137,53 @@ like($@, qr/^Modification of a read-only value attempted at /, 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"); + } +} -- 2.4.11 ```

[p5pRT]

From @iabyn

0002-fix-integer-overflows-in-Perl_do_vecget-set.patch

```diff From 119002837548ba1351e3d2fb82b3c03f1c0a4498 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Thu, 16 Mar 2017 12:29:03 +0000 Subject: [PATCH 2/2] 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. --- doop.c | 74 +++++++++++++++++++++++++++++++++++++------------------------- t/op/vec.t | 38 +++++++++++++++++++++++++++++++- 2 files changed, 81 insertions(+), 31 deletions(-) diff --git a/doop.c b/doop.c index 87e854a..7674af5 100644 --- 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 --- 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"); + } + } } -- 2.4.11 ```

[p5pRT]

From @iabyn

On Thu\, Mar 16\, 2017 at 03​:15​:42PM +0000\, Dave Mitchell wrote​:

On Tue\, Mar 14\, 2017 at 05​:44​:38PM +0000\, Aaron Crane wrote​:

Thank you for the offer\, and please go ahead — I moved house yesterday\, so it's going to be a little while before I've got enough time to think carefully about things like this.

Ok here are two commits that I will merge into blead tomorrow unless I hear anything to the contrary. I decided not to remove the redundant sets of braces in the big if/else tree for now.

I've tested them on a 64-bit system and a 32-bit system with -Duse64bitint\, and am currently testing with a pure 32-bit build.

Now pushed\, as

  commit 281fe5e7055b0d2374f99ba00af0e45f22386854   Merge​: 7e337d2 67dd6f3   Author​: David Mitchell \davem@&#8203;iabyn\.com   AuthorDate​: Fri Mar 17 14​:13​:57 2017 +0000   Commit​: David Mitchell \davem@&#8203;iabyn\.com   CommitDate​: Fri Mar 17 14​:13​:57 2017 +0000

  [MERGE] fix vec() offset overflow issues

unless anyone objects\, I'll move this ticket to the public queue and close it.

-- Wesley Crusher gets beaten up by his classmates for being a smarmy git\, and consequently has a go at making some friends of his own age for a change.   -- Things That Never Happen in "Star Trek" #18

[p5pRT]

@iabyn - Status changed from 'open' to 'pending release'

[p5pRT]

From @khwilliamson

Thank you for filing this report. You have helped make Perl better.

With the release today of Perl 5.26.0\, this and 210 other issues have been resolved.

Perl 5.26.0 may be downloaded via​: https://metacpan.org/release/XSAWYERX/perl-5.26.0

If you find that the problem persists\, feel free to reopen this ticket.

[p5pRT]

@khwilliamson - Status changed from 'pending release' to 'resolved'