1 files changed, 148 insertions, 0 deletions

diff --git a/recipes-devtools/perl/perl/CVE-2018-6913-perl-131844-fix-various-space-calculation-issues-in-.patch b/recipes-devtools/perl/perl/CVE-2018-6913-perl-131844-fix-various-space-calculation-issues-in-.patch
new file mode 100644
index 0000000..cb73e21
--- /dev/null
+++ b/recipes-devtools/perl/perl/CVE-2018-6913-perl-131844-fix-various-space-calculation-issues-in-.patch
@@ -0,0 +1,148 @@
+From a9d5c6e11891b48be06d4e06eeed18642bc98527 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.
+
+Originally this used Size_t_MAX as the maximum size of a memory
+allocation, but for -DDEBUGGING builds realloc() throws a panic for
+allocations over half the address space in size, changing the error
+reported for the allocation.
+
+For non-DEBUGGING builds the Size_t_MAX limit has the small chance
+of finding a system that has 3GB of contiguous space available, and
+allocating that space, which could be a denial of servce in some cases.
+
+Unfortunately changing the limit to half the address space means that
+the exact case with the original issue can no longer occur, so the
+test is no longer testing against the address + length issue that
+caused the original problem, since the allocation is failing earlier.
+
+One option would be to change the test so the size request by pack is
+just under 2GB, but this has a higher (but still low) probability that
+the system has the address space available, and will actually try to
+allocate the memory, so let's not do that.
+
+(cherry picked from commit f5506feddde8546eabb69d71569d856c7e9c615b)
+
+CVE: CVE-2018-131844
+Upstream-Status: Backport [https://rt.perl.org/Public/Ticket/Attachment/1480002/799836/0001-perl-131844-fix-various-space-calculation-issues-in-.patch]
+
+Signed-off-by: Andreas Wellving <andreas.wellving@enea.com>
+---
+ 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 f6964c3..c0de5ab 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) > 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);           \
+     }                                          \
+@@ -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 a2da636..a480c3a 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 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.7.4
+