[CVE-2018-6913] heap-buffer-overflow in S_pack_rec

[p5pRT]

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

Searchable as RT131844$

[p5pRT]

From gy741.kim@gmail.com

Hi.

I found a heap-buffer-overflow bug in perl.

Please confirm.

Thanks.

Version​: This is perl 5, version 27, subversion 2 (v5.27.2) built for
i686-linux
OS​: Ubuntu 16.04.2 32bit
Steps to reproduce​:
1.Download the PoC files.
2.Compile the source code with ASan.
3.Execute the following command
  : ./perl $PoC

```

==2895==ERROR​: AddressSanitizer​: heap-buffer-overflow on address 0xb610081c
at pc 0x08a72387 bp 0xbfea6038 sp 0xbfea602c
WRITE of size 4 at 0xb610081c thread T0
  #0 0x8a72386 in S_pack_rec /root/karas/perl5-blead/pp_pack.c​:2703​:17
  #1 0x8a42706 in Perl_packlist /root/karas/perl5-blead/pp_pack.c​:1980​:11
  #2 0x8a73626 in Perl_pp_pack /root/karas/perl5-blead/pp_pack.c​:3135​:5
  #3 0x84dc7ac in Perl_runops_debug /root/karas/perl5-blead/dump.c​:2465​:23
  #4 0x818858a in S_fold_constants /root/karas/perl5-blead/op.c​:4557​:2
  #5 0x8186c5a in Perl_op_convert_list
/root/karas/perl5-blead/op.c​:4896​:12
  #6 0x8363e7e in Perl_yyparse /root/karas/perl5-blead/perly.y​:889​:23
  #7 0x8232350 in S_parse_body /root/karas/perl5-blead/perl.c​:2401​:9
  #8 0x82285e3 in perl_parse /root/karas/perl5-blead/perl.c​:1719​:2
  #9 0x81494a6 in main /root/karas/perl5-blead/perlmain.c​:121​:18
  #10 0xb74d5636 in __libc_start_main
/build/glibc-KM3i_a/glibc-2.23/csu/../csu/libc-start.c​:291
  #11 0x8075847 in _start (/root/karas/perl5-blead/perl+0x8075847)

0xb610081c is located 2 bytes to the right of 10-byte region
[0xb6100810,0xb610081a)
allocated by thread T0 here​:
  #0 0x8119b84 in malloc (/root/karas/perl5-blead/perl+0x8119b84)
  #1 0x84e2987 in Perl_safesysmalloc /root/karas/perl5-blead/util.c​:153​:21

SUMMARY​: AddressSanitizer​: heap-buffer-overflow
/root/karas/perl5-blead/pp_pack.c​:2703​:17 in S_pack_rec
Shadow bytes around the buggy address​:
  0x36c200b0​: fa fa fd fd fa fa fd fd fa fa fd fd fa fa 00 04
  0x36c200c0​: fa fa fd fd fa fa 00 04 fa fa 00 04 fa fa 00 04
  0x36c200d0​: fa fa 00 04 fa fa 00 04 fa fa 00 04 fa fa 00 04
  0x36c200e0​: fa fa 00 04 fa fa 00 04 fa fa 00 04 fa fa 00 04
  0x36c200f0​: fa fa fd fa fa fa fd fd fa fa 00 02 fa fa 01 fa
=>0x36c20100​: fa fa 00[02]fa fa 00 02 fa fa fd fd fa fa 00 04
  0x36c20110​: fa fa 02 fa fa fa 00 02 fa fa 07 fa fa fa 00 02
  0x36c20120​: fa fa 00 02 fa fa 00 00 fa fa 00 05 fa fa 00 01
  0x36c20130​: fa fa 00 07 fa fa 00 fa fa fa 00 02 fa fa 05 fa
  0x36c20140​: fa fa 00 02 fa fa 06 fa fa fa 00 02 fa fa 05 fa
  0x36c20150​: fa fa 00 05 fa fa 04 fa fa fa 05 fa fa fa 05 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
  Heap right redzone​: fb
  Freed heap region​: fd
  Stack left redzone​: f1
  Stack mid redzone​: f2
  Stack right redzone​: f3
  Stack partial redzone​: f4
  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
==2895==ABORTING
```

[p5pRT]

From gy741.kim@gmail.com

S_pack_rec_heap_PoC

[p5pRT]

From @tonycoz

On Sat, 05 Aug 2017 05​:55​:33 -0700, gy741.kim@​gmail.com wrote​:

Hi.

I found a heap-buffer-overflow bug in perl.

Please confirm.

Thanks.

Version​: This is perl 5, version 27, subversion 2 (v5.27.2) built for
i686-linux
OS​: Ubuntu 16.04.2 32bit
Steps to reproduce​:
1.Download the PoC files.
2.Compile the source code with ASan.
3.Execute the following command
: ./perl $PoC

```

==2895==ERROR​: AddressSanitizer​: heap-buffer-overflow on address 0xb610081c
at pc 0x08a72387 bp 0xbfea6038 sp 0xbfea602c
WRITE of size 4 at 0xb610081c thread T0
#0 0x8a72386 in S_pack_rec /root/karas/perl5-blead/pp_pack.c​:2703​:17
#1 0x8a42706 in Perl_packlist /root/karas/perl5-blead/pp_pack.c​:1980​:11

As written this only reproduces on 32-bit systems.

This is caused by a pointer wrap when calculating (cur)+glen in​:

  if ((cur) + glen >= (start) + SvLEN(cat)) {

since in this case glen is ~3GB, and the new pointer ends up less than (start), let alone (start)+SvLEN(cat).

Going through the code I found three other issues, and added tests and
fixes for those too, per the attached patch.

Note that the first case results in a panic with the fix - since the test case attempts to allocate a large amount of memory, which fails, resulting in a call to croak_no_mem(), which triggers a my_exit(), which the constant folding code doesn't know how to handle.

The issues here could result in an exploit in code that accepts either large blocks of data from untrusted sources and/or duplicates such blocks.

The supplied case is a compile-time failure while constant folding, but the same issue could be triggered during runtime with attacker supplied data.

Such code is already subject to denial-of-service attacks (the code can be made to allocate large amounts of memory, as it does on 64-bit systems), but this expands such an attack to a malloced buffer overflow, which is
more serious.

Tony

[p5pRT]

From @tonycoz

0001-perl-131844-fix-various-space-calculation-issues-in-.patch

From 5a66253379c8be70130f8d4e5961e8d26c3a9efc Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@debian9-x32.tony.develop-help.com>
Date: Tue, 8 Aug 2017 09:32:58 +1000
Subject: (perl #131844) fix various space calculation issues in pp_pack.c

- for the originally reported case, if the start/cur pointer is in the
  top 75% of the address space the add (cur) + glen addition would
  overflow, resulting in the condition failing incorrectly.

- the addition of the existing space used to the space needed could
  overflow, resulting in too small an allocation and a buffer overflow.

- the scaling for UTF8 could overflow.

- the multiply to calculate the space needed for many items could
  overflow.

For the first case, do a space calculation without making new pointers.

For the other cases, detect the overflow and croak if there's an
overflow.
---
 pp_pack.c   | 25 +++++++++++++++++++++----
 t/op/pack.t | 24 +++++++++++++++++++++++-
 2 files changed, 44 insertions(+), 5 deletions(-)

diff --git a/pp_pack.c b/pp_pack.c
index 86d138bb05..53f74c82f5 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -361,11 +361,28 @@ STMT_START {							\
     }								\
 } STMT_END
 
+#define SAFE_UTF8_EXPAND(var)	\
+STMT_START {				\
+    if ((var) > Size_t_MAX / UTF8_EXPAND) \
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+    (var) = (var) * UTF8_EXPAND; \
+} STMT_END
+
+#define GROWING2(utf8, cat, start, cur, item_size, item_count)	\
+STMT_START {							\
+    if (Size_t_MAX / (item_size) < (item_count))		\
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()");	\
+    GROWING((utf8), (cat), (start), (cur), (item_size) * (item_count)); \
+} STMT_END
+
 #define GROWING(utf8, cat, start, cur, in_len)	\
 STMT_START {					\
     STRLEN glen = (in_len);			\
-    if (utf8) glen *= UTF8_EXPAND;		\
-    if ((cur) + glen >= (start) + SvLEN(cat)) {	\
+    STRLEN catcur = (STRLEN)((cur) - (start));	\
+    if (utf8) SAFE_UTF8_EXPAND(glen);		\
+    if (Size_t_MAX - glen < catcur)		\
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+    if (catcur + glen >= SvLEN(cat)) {	\
 	(start) = sv_exp_grow(cat, glen);	\
 	(cur) = (start) + SvCUR(cat);		\
     }						\
@@ -375,7 +392,7 @@ STMT_START {					\
 STMT_START {					\
     const STRLEN glen = (in_len);		\
     STRLEN gl = glen;				\
-    if (utf8) gl *= UTF8_EXPAND;		\
+    if (utf8) SAFE_UTF8_EXPAND(gl);		\
     if ((cur) + gl >= (start) + SvLEN(cat)) {	\
         *cur = '\0';				\
         SvCUR_set((cat), (cur) - (start));	\
@@ -2135,7 +2152,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    if (props && !(props & PACK_SIZE_UNPREDICTABLE)) {
 		/* We can process this letter. */
 		STRLEN size = props & PACK_SIZE_MASK;
-		GROWING(utf8, cat, start, cur, (STRLEN) len * size);
+		GROWING2(utf8, cat, start, cur, size, (STRLEN)len);
 	    }
         }
 
diff --git a/t/op/pack.t b/t/op/pack.t
index 919e4c55c6..6e025b4741 100644
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' :
 my $no_signedness = $] > 5.009 ? '' :
   "Signed/unsigned pack modifiers not available on this perl";
 
-plan tests => 14713;
+plan tests => 14717;
 
 use strict;
 use warnings qw(FATAL all);
@@ -2059,3 +2059,25 @@ print pack("ucW", "0000", 0, 140737488355327) eq "\$,#`P,```\n\0\x{7fffffffffff}
  ? "ok\n" : "not ok\n";
 EOS
 }
+
+SKIP:
+{
+  # [perl #131844] pointer addition overflow
+    $Config{ptrsize} == 4
+      or skip "[perl $131844] need 32-bit build for this test", 1;
+    # prevent ASAN just crashing on the allocation failure
+    local $ENV{ASAN_OPTIONS} = $ENV{ASAN_OPTIONS};
+    $ENV{ASAN_OPTIONS} .= ",allocator_may_return_null=1";
+    fresh_perl_like('pack "f999999999"', qr/Out of memory!/, { stderr => 1 },
+		    "pointer addition overflow");
+
+    # integer (STRLEN) overflow from addition of glen to current length
+    fresh_perl_like('pack "c10f1073741823"', qr/Out of memory during pack/, { stderr => 1 },
+		    "integer overflow calculating allocation (addition)");
+
+    fresh_perl_like('pack "W10f536870913", 256', qr/Out of memory during pack/, { stderr => 1 },
+		    "integer overflow calculating allocation (utf8)");
+
+    fresh_perl_like('pack "c10f1073741824"', qr/Out of memory during pack/, { stderr => 1 },
+		    "integer overflow calculating allocation (multiply)");
+}
-- 
2.11.0

[p5pRT]

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

[p5pRT]

From @iabyn

On Sat, Aug 05, 2017 at 05​:55​:33AM -0700, GwanYeong Kim wrote​:

I found a heap-buffer-overflow bug in perl.

Tony, any reason you haven't applied your proposed pp_pack.c fix from back
in August?

--
Art is anything that has a label (especially if the label is "untitled 1")

[p5pRT]

From @tonycoz

On Wed, 29 Nov 2017 01​:08​:14 -0800, davem wrote​:

On Sat, Aug 05, 2017 at 05​:55​:33AM -0700, GwanYeong Kim wrote​:

I found a heap-buffer-overflow bug in perl.

Tony, any reason you haven't applied your proposed pp_pack.c fix from back
in August?

Do we treat it as a security issue?

Tony

[p5pRT]

From @tonycoz

On Wed, 24 Jan 2018 20​:49​:53 -0800, tonyc wrote​:

On Wed, 29 Nov 2017 01​:08​:14 -0800, davem wrote​:

On Sat, Aug 05, 2017 at 05​:55​:33AM -0700, GwanYeong Kim wrote​:

I found a heap-buffer-overflow bug in perl.

Tony, any reason you haven't applied your proposed pp_pack.c fix from back
in August?

Do we treat it as a security issue?

After reviewing it, I think this is a security issue.

Tony

[p5pRT]

From @tonycoz

On Tue, 30 Jan 2018 16​:28​:44 -0800, tonyc wrote​:

On Wed, 24 Jan 2018 20​:49​:53 -0800, tonyc wrote​:

On Wed, 29 Nov 2017 01​:08​:14 -0800, davem wrote​:

On Sat, Aug 05, 2017 at 05​:55​:33AM -0700, GwanYeong Kim wrote​:

I found a heap-buffer-overflow bug in perl.

Tony, any reason you haven't applied your proposed pp_pack.c fix
from back
in August?

Do we treat it as a security issue?

After reviewing it, I think this is a security issue.

I plan to request a CVE ID for this one too, since it's a buffer overflow and an attacker may have control over the data written.

Vulnerability type​:
  Buffer Overflow

Vendor of the product​:
  Perl5 Porters

Product​:
  perl

Version​:
  5.8 through 5.26

Has vendor confirmed or acknowledged the vulnerability?
  Yes

Attack vector​:
  Context dependent

Impact​:
  Denial of service (it can crash perl)

- the other choices for Impact are​:
  Code Execution - this may be possible, but we don't have a confirmed exploit
  Information Disclosure - no direct disclosure
  Escalation of Privilege - nope
  Other - not that I can think of

Affected Components​:
  pp_pack.c, S_pack_rec()

Attack vector
 
A program that accepts a large pack count may misallocate a buffer due to an integer overflow. If an attacker can also supply pack data this may result in a heap buffer write overflow with data controlled by the attacker.

Suggested description of the vulnerability for use in the CVE

  pack() may cause a heap buffer write overflow with a large item count

Discoverer(s)/Credits

  GwanYeong Kim <gy741.kim@​gmail.com>

Reference(s)

  https://rt.perl.org/Public/Bug/Display.html?id=131844

Additional Information

(blank)

I don't plan to supply the suggested description until issue is public.

Tony

[p5pRT]

From @tonycoz

On Wed, 07 Feb 2018 18​:15​:16 -0800, tonyc wrote​:

I plan to request a CVE ID for this one too, since it's a buffer
overflow and an attacker may have control over the data written.

I've requested a CVE id for this issue.

Tony

[p5pRT]

From @tonycoz

On Sun, 11 Feb 2018 19​:31​:18 -0800, tonyc wrote​:

On Wed, 07 Feb 2018 18​:15​:16 -0800, tonyc wrote​:

I plan to request a CVE ID for this one too, since it's a buffer
overflow and an attacker may have control over the data written.

I've requested a CVE id for this issue.

This is CVE-2018-6913.

There are no other tickets I'm planning on requesting a CVE id for, if you think any need one please speak up.

Tony

[p5pRT]

From @tonycoz

On Mon, 07 Aug 2017 18​:34​:44 -0700, tonyc wrote​:

Going through the code I found three other issues, and added tests and
fixes for those too, per the attached patch.

There were two problems (the email address and the skip count), fixed in the attached.

The non-5.24 patch applies to both blead and maint-5.26, the other to 5.24.

Tony

[p5pRT]

From @tonycoz

0001-perl-131844-5.24-fix-various-space-calculation-issue.patch

From 8a34d2c1718e7cd9ca9d88b71d5932b4e931276d Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 8 Aug 2017 09:32:58 +1000
Subject: (perl #131844) 5.24: fix various space calculation issues in
 pp_pack.c

- for the originally reported case, if the start/cur pointer is in the
  top 75% of the address space the add (cur) + glen addition would
  overflow, resulting in the condition failing incorrectly.

- the addition of the existing space used to the space needed could
  overflow, resulting in too small an allocation and a buffer overflow.

- the scaling for UTF8 could overflow.

- the multiply to calculate the space needed for many items could
  overflow.

For the first case, do a space calculation without making new pointers.

For the other cases, detect the overflow and croak if there's an
overflow.
---
 pp_pack.c   | 25 +++++++++++++++++++++----
 t/op/pack.t | 24 +++++++++++++++++++++++-
 2 files changed, 44 insertions(+), 5 deletions(-)

diff --git a/pp_pack.c b/pp_pack.c
index f6964c3f30..c35525aae9 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -358,11 +358,28 @@ STMT_START {							\
     }								\
 } STMT_END
 
+#define SAFE_UTF8_EXPAND(var)	\
+STMT_START {				\
+    if ((var) > Size_t_MAX / UTF8_EXPAND) \
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+    (var) = (var) * UTF8_EXPAND; \
+} STMT_END
+
+#define GROWING2(utf8, cat, start, cur, item_size, item_count)	\
+STMT_START {							\
+    if (Size_t_MAX / (item_size) < (item_count))		\
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()");	\
+    GROWING((utf8), (cat), (start), (cur), (item_size) * (item_count)); \
+} STMT_END
+
 #define GROWING(utf8, cat, start, cur, in_len)	\
 STMT_START {					\
     STRLEN glen = (in_len);			\
-    if (utf8) glen *= UTF8_EXPAND;		\
-    if ((cur) + glen >= (start) + SvLEN(cat)) {	\
+    STRLEN catcur = (STRLEN)((cur) - (start));	\
+    if (utf8) SAFE_UTF8_EXPAND(glen);		\
+    if (Size_t_MAX - glen < catcur)		\
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+    if (catcur + glen >= SvLEN(cat)) {	\
 	(start) = sv_exp_grow(cat, glen);	\
 	(cur) = (start) + SvCUR(cat);		\
     }						\
@@ -372,7 +389,7 @@ STMT_START {					\
 STMT_START {					\
     const STRLEN glen = (in_len);		\
     STRLEN gl = glen;				\
-    if (utf8) gl *= UTF8_EXPAND;		\
+    if (utf8) SAFE_UTF8_EXPAND(gl);		\
     if ((cur) + gl >= (start) + SvLEN(cat)) {	\
         *cur = '\0';				\
         SvCUR_set((cat), (cur) - (start));	\
@@ -2126,7 +2143,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    if (props && !(props & PACK_SIZE_UNPREDICTABLE)) {
 		/* We can process this letter. */
 		STRLEN size = props & PACK_SIZE_MASK;
-		GROWING(utf8, cat, start, cur, (STRLEN) len * size);
+		GROWING2(utf8, cat, start, cur, size, (STRLEN)len);
 	    }
         }
 
diff --git a/t/op/pack.t b/t/op/pack.t
index a2da63689b..0b640fb6eb 100644
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' :
 my $no_signedness = $] > 5.009 ? '' :
   "Signed/unsigned pack modifiers not available on this perl";
 
-plan tests => 14712;
+plan tests => 14716;
 
 use strict;
 use warnings qw(FATAL all);
@@ -2044,3 +2044,25 @@ ok(1, "argument underflow did not crash");
     is(pack("H40", $up_nul), $twenty_nuls,
        "check pack H zero fills (utf8 source)");
 }
+
+SKIP:
+{
+  # [perl #131844] pointer addition overflow
+    $Config{ptrsize} == 4
+      or skip "[perl #131844] need 32-bit build for this test", 4;
+    # prevent ASAN just crashing on the allocation failure
+    local $ENV{ASAN_OPTIONS} = $ENV{ASAN_OPTIONS};
+    $ENV{ASAN_OPTIONS} .= ",allocator_may_return_null=1";
+    fresh_perl_like('pack "f999999999"', qr/Out of memory!/, { stderr => 1 },
+		    "pointer addition overflow");
+
+    # integer (STRLEN) overflow from addition of glen to current length
+    fresh_perl_like('pack "c10f1073741823"', qr/Out of memory during pack/, { stderr => 1 },
+		    "integer overflow calculating allocation (addition)");
+
+    fresh_perl_like('pack "W10f536870913", 256', qr/Out of memory during pack/, { stderr => 1 },
+		    "integer overflow calculating allocation (utf8)");
+
+    fresh_perl_like('pack "c10f1073741824"', qr/Out of memory during pack/, { stderr => 1 },
+		    "integer overflow calculating allocation (multiply)");
+}
-- 
2.11.0

[p5pRT]

From @tonycoz

0001-perl-131844-fix-various-space-calculation-issues-in-.patch

From 14451983c134d2390238d8e77b15e90873c5b596 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 8 Aug 2017 09:32:58 +1000
Subject: [PATCH] (perl #131844) fix various space calculation issues in
 pp_pack.c

- for the originally reported case, if the start/cur pointer is in the
  top 75% of the address space the add (cur) + glen addition would
  overflow, resulting in the condition failing incorrectly.

- the addition of the existing space used to the space needed could
  overflow, resulting in too small an allocation and a buffer overflow.

- the scaling for UTF8 could overflow.

- the multiply to calculate the space needed for many items could
  overflow.

For the first case, do a space calculation without making new pointers.

For the other cases, detect the overflow and croak if there's an
overflow.
---
 pp_pack.c   | 25 +++++++++++++++++++++----
 t/op/pack.t | 24 +++++++++++++++++++++++-
 2 files changed, 44 insertions(+), 5 deletions(-)

diff --git a/pp_pack.c b/pp_pack.c
index 8937d6d715..12a850284d 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -357,11 +357,28 @@ STMT_START {							\
     }								\
 } STMT_END
 
+#define SAFE_UTF8_EXPAND(var)	\
+STMT_START {				\
+    if ((var) > Size_t_MAX / UTF8_EXPAND) \
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+    (var) = (var) * UTF8_EXPAND; \
+} STMT_END
+
+#define GROWING2(utf8, cat, start, cur, item_size, item_count)	\
+STMT_START {							\
+    if (Size_t_MAX / (item_size) < (item_count))		\
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()");	\
+    GROWING((utf8), (cat), (start), (cur), (item_size) * (item_count)); \
+} STMT_END
+
 #define GROWING(utf8, cat, start, cur, in_len)	\
 STMT_START {					\
     STRLEN glen = (in_len);			\
-    if (utf8) glen *= UTF8_EXPAND;		\
-    if ((cur) + glen >= (start) + SvLEN(cat)) {	\
+    STRLEN catcur = (STRLEN)((cur) - (start));	\
+    if (utf8) SAFE_UTF8_EXPAND(glen);		\
+    if (Size_t_MAX - glen < catcur)		\
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+    if (catcur + glen >= SvLEN(cat)) {	\
 	(start) = sv_exp_grow(cat, glen);	\
 	(cur) = (start) + SvCUR(cat);		\
     }						\
@@ -371,7 +388,7 @@ STMT_START {					\
 STMT_START {					\
     const STRLEN glen = (in_len);		\
     STRLEN gl = glen;				\
-    if (utf8) gl *= UTF8_EXPAND;		\
+    if (utf8) SAFE_UTF8_EXPAND(gl);		\
     if ((cur) + gl >= (start) + SvLEN(cat)) {	\
         *cur = '\0';				\
         SvCUR_set((cat), (cur) - (start));	\
@@ -2131,7 +2148,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 	    if (props && !(props & PACK_SIZE_UNPREDICTABLE)) {
 		/* We can process this letter. */
 		STRLEN size = props & PACK_SIZE_MASK;
-		GROWING(utf8, cat, start, cur, (STRLEN) len * size);
+		GROWING2(utf8, cat, start, cur, size, (STRLEN)len);
 	    }
         }
 
diff --git a/t/op/pack.t b/t/op/pack.t
index 664aaaf1b0..439e74ee17 100644
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' :
 my $no_signedness = $] > 5.009 ? '' :
   "Signed/unsigned pack modifiers not available on this perl";
 
-plan tests => 14713;
+plan tests => 14717;
 
 use strict;
 use warnings qw(FATAL all);
@@ -2059,3 +2059,25 @@ print pack("ucW", "0000", 0, 140737488355327) eq "\$,#`P,```\n\0\x{7fffffffffff}
  ? "ok\n" : "not ok\n";
 EOS
 }
+
+SKIP:
+{
+  # [perl #131844] pointer addition overflow
+    $Config{ptrsize} == 4
+      or skip "[perl #131844] need 32-bit build for this test", 4;
+    # prevent ASAN just crashing on the allocation failure
+    local $ENV{ASAN_OPTIONS} = $ENV{ASAN_OPTIONS};
+    $ENV{ASAN_OPTIONS} .= ",allocator_may_return_null=1";
+    fresh_perl_like('pack "f999999999"', qr/Out of memory!/, { stderr => 1 },
+		    "pointer addition overflow");
+
+    # integer (STRLEN) overflow from addition of glen to current length
+    fresh_perl_like('pack "c10f1073741823"', qr/Out of memory during pack/, { stderr => 1 },
+		    "integer overflow calculating allocation (addition)");
+
+    fresh_perl_like('pack "W10f536870913", 256', qr/Out of memory during pack/, { stderr => 1 },
+		    "integer overflow calculating allocation (utf8)");
+
+    fresh_perl_like('pack "c10f1073741824"', qr/Out of memory during pack/, { stderr => 1 },
+		    "integer overflow calculating allocation (multiply)");
+}
-- 
2.11.0

[p5pRT]

From @xsawyerx

The public disclosure date is set for March 15th.