CVE-2018-6913.diff   [plain text]


diff --git a/perl.h b/perl.h
index 89f4c98..8b0add6 100644
--- a/perl.h
+++ b/perl.h
@@ -1796,6 +1796,8 @@ typedef UVTYPE UV;
 # undef PERL_NEED_MY_BETOH64
 #endif
 
+#define SSize_t_MAX (SSize_t)(~(Size_t)0 >> 1)
+
 #define IV_DIG (BIT_DIGITS(IVSIZE * 8))
 #define UV_DIG (BIT_DIGITS(UVSIZE * 8))
 
diff --git a/pp_pack.c b/pp_pack.c
index 6c3dc5f..06a0423 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -755,11 +755,28 @@ STMT_START {							\
     }								\
 } STMT_END
 
+#define SAFE_UTF8_EXPAND(var)	\
+STMT_START {				\
+    if ((var) > SSize_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 (SSize_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 (SSize_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);		\
     }						\
@@ -769,7 +786,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));	\
@@ -2556,7 +2573,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 99cb533..90ba9ad 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 => 14704;
+plan tests => 14708;
 
 use strict;
 use warnings qw(FATAL all);
@@ -2003,3 +2003,25 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
 #90160
 is(eval { () = unpack "C0 U*", ""; "ok" }, "ok",
   'medial U* on empty string');
+
+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 during pack/, { 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.8.4 (Apple Git-73)