Fix a buffer overflow when processing a vstring longer than 2^31-1

Storable-3.15-perl-134179-include-regexps-in-the-seen-objects-tabl.patch

@@ -0,0 +1,92 @@
+From 16f2ddb794883529d5a3ad8326974a07aae7e567 Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Mon, 10 Jun 2019 10:17:20 +1000
+Subject: [PATCH] (perl #134179) include regexps in the seen objects table on
+ retrieve
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Also, bless the regexp object, so freezing/thawing bless qr//, "Foo"
+returns a "Foo" blesses regexp.
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ dist/Storable/Storable.xs |  5 +++--
+ dist/Storable/t/regexp.t  |  4 +++-
+ dist/Storable/t/weak.t    | 10 +++++++++-
+ 3 files changed, 15 insertions(+), 4 deletions(-)
+
+diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
+index ed729c94a6..6a45d8adf2 100644
+--- a/dist/Storable/Storable.xs
++++ b/dist/Storable/Storable.xs
+@@ -6808,8 +6808,7 @@ static SV *retrieve_regexp(pTHX_ stcxt_t *cxt, const char *cname) {
+     SV *sv;
+     dSP;
+     I32 count;
+-
+-    PERL_UNUSED_ARG(cname);
++    HV *stash;
+ 
+     ENTER;
+     SAVETMPS;
+@@ -6857,6 +6856,8 @@ static SV *retrieve_regexp(pTHX_ stcxt_t *cxt, const char *cname) {
+ 
+     sv = SvRV(re_ref);
+     SvREFCNT_inc(sv);
++    stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
++    SEEN_NN(sv, stash, 0);
+     
+     FREETMPS;
+     LEAVE;
+diff --git a/dist/Storable/t/regexp.t b/dist/Storable/t/regexp.t
+index acf28cfec6..e7c6c7e94a 100644
+--- a/dist/Storable/t/regexp.t
++++ b/dist/Storable/t/regexp.t
+@@ -37,7 +37,7 @@ while (<DATA>) {
+     }
+ }
+ 
+-plan tests => 9 + 3*scalar(@tests);
++plan tests => 10 + 3*scalar(@tests);
+ 
+ SKIP:
+ {
+@@ -75,6 +75,8 @@ SKIP:
+     ok(!eval { dclone($re) }, "should fail to clone, even with use re 'eval'");
+ }
+ 
++is(ref(dclone(bless qr//, "Foo")), "Foo", "check reblessed regexps");
++
+ for my $test (@tests) {
+     my ($code, $not, $match, $matchc, $name) = @$test;
+     my $qr = eval $code;
+diff --git a/dist/Storable/t/weak.t b/dist/Storable/t/weak.t
+index 220c70160f..48752fbec4 100644
+--- a/dist/Storable/t/weak.t
++++ b/dist/Storable/t/weak.t
+@@ -29,7 +29,7 @@ sub BEGIN {
+ }
+ 
+ use Test::More 'no_plan';
+-use Storable qw (store retrieve freeze thaw nstore nfreeze);
++use Storable qw (store retrieve freeze thaw nstore nfreeze dclone);
+ require 'testlib.pl';
+ our $file;
+ use strict;
+@@ -143,3 +143,11 @@ foreach (@tests) {
+   $stored = nfreeze $input;
+   tester($stored, \&freeze_and_thaw, $testsub, 'network string');
+ }
++
++{
++    # [perl #134179] sv_upgrade from type 7 down to type 1
++    my $foo = [qr//,[]];
++    weaken($foo->[1][0][0] = $foo->[1]);
++    my $out = dclone($foo); # croaked here
++    is_deeply($out, $foo, "check they match");
++}
+-- 
+2.20.1
+

Storable-3.16-Storable-make-count-large-enough.patch

@@ -0,0 +1,53 @@
+From f7724052d1b8b75339f5ec2cc3d5b35ca5d130b5 Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Wed, 7 Aug 2019 11:13:53 +1000
+Subject: [PATCH] Storable: make count large enough
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+AvARRAY() could be very large, and we check for that at line 3807,
+but int was (potentially) too small to make that comparison
+meaningful.
+
+CID 174681.
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ dist/Storable/Storable.xs | 6 +++---
+ 1 file changed, 3 insertions(+), 3 deletions(-)
+
+diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
+index 6a45d8adf2..d75125b839 100644
+--- a/dist/Storable/Storable.xs
++++ b/dist/Storable/Storable.xs
+@@ -3662,7 +3662,7 @@ static int store_hook(
+     SV *ref;
+     AV *av;
+     SV **ary;
+-    int count;			/* really len3 + 1 */
++    IV count;			/* really len3 + 1 */
+     unsigned char flags;
+     char *pv;
+     int i;
+@@ -3752,7 +3752,7 @@ static int store_hook(
+     SvREFCNT_dec(ref);			/* Reclaim temporary reference */
+ 
+     count = AvFILLp(av) + 1;
+-    TRACEME(("store_hook, array holds %d items", count));
++    TRACEME(("store_hook, array holds %" IVdf " items", count));
+ 
+     /*
+      * If they return an empty list, it means they wish to ignore the
+@@ -3986,7 +3986,7 @@ static int store_hook(
+      */
+ 
+     TRACEME(("SX_HOOK (recursed=%d) flags=0x%x "
+-             "class=%" IVdf " len=%" IVdf " len2=%" IVdf " len3=%d",
++             "class=%" IVdf " len=%" IVdf " len2=%" IVdf " len3=%" IVdf,
+              recursed, flags, (IV)classnum, (IV)len, (IV)len2, count-1));
+ 
+     /* SX_HOOK <flags> [<extra>] */
+-- 
+2.20.1
+

perl-5.31.6-disallow-vstring-magic-strings-over-2GB-1.patch

@@ -0,0 +1,67 @@
+From ea1e86cfdf26a330e58ea377a80273de7110011b Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Wed, 21 Aug 2019 11:37:58 +1000
+Subject: [PATCH] disallow vstring magic strings over 2GB-1
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+On reads this could result in buffer overflows, so avoid writing
+such large vstrings to avoid causing problems for older Storable.
+
+Since we no longer write such large vstrings, we don't want to accept
+them.
+
+I doubt that restricting versions strings to under 2GB-1 will have
+a practical effect on downstream users.
+
+fixes #17306
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ dist/Storable/Storable.xs | 19 ++++++++++++++++---
+ 1 file changed, 16 insertions(+), 3 deletions(-)
+
+diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
+index c2335680ab..d27ac58012 100644
+--- a/dist/Storable/Storable.xs
++++ b/dist/Storable/Storable.xs
+@@ -2628,6 +2628,12 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
+             /* The macro passes this by address, not value, and a lot of
+                called code assumes that it's 32 bits without checking.  */
+             const SSize_t len = mg->mg_len;
++            /* we no longer accept vstrings over I32_SIZE-1, so don't emit
++               them, also, older Storables handle them badly.
++            */
++            if (len >= I32_MAX) {
++                CROAK(("vstring too large to freeze"));
++            }
+             STORE_PV_LEN((const char *)mg->mg_ptr,
+                          len, SX_VSTRING, SX_LVSTRING);
+         }
+@@ -5937,12 +5943,19 @@ static SV *retrieve_lvstring(pTHX_ stcxt_t *cxt, const char *cname)
+ {
+ #ifdef SvVOK
+     char *s;
+-    I32 len;
++    U32 len;
+     SV *sv;
+ 
+     RLEN(len);
+-    TRACEME(("retrieve_lvstring (#%d), len = %" IVdf,
+-             (int)cxt->tagnum, (IV)len));
++    TRACEME(("retrieve_lvstring (#%d), len = %" UVuf,
++             (int)cxt->tagnum, (UV)len));
++
++    /* Since we'll no longer produce such large vstrings, reject them
++       here too.
++    */
++    if (len >= I32_MAX) {
++        CROAK(("vstring too large to fetch"));
++    }
+ 
+     New(10003, s, len+1, char);
+     SAFEPVREAD(s, len, s);
+-- 
+2.21.0
+

perl-Storable.spec

@@ -1,12 +1,20 @@
 Name:           perl-Storable
 Epoch:          1
 Version:        3.15
-Release:        1%{?dist}
+Release:        4%{?dist}
 Summary:        Persistence for Perl data structures
 # __Storable__.pm:  GPL+ or Artistic
 License:        GPL+ or Artistic
 URL:            https://metacpan.org/release/Storable
 Source0:        https://cpan.metacpan.org/authors/id/X/XS/XSAWYERX/Storable-%{version}.tar.gz
+# Fix deep cloning regular expression objects, RT#134179,
+# in Perl upstream after 5.31.0
+Patch0:         Storable-3.15-perl-134179-include-regexps-in-the-seen-objects-tabl.patch
+# Fix array length check in a store hook, in Perl upstream after 5.31.2
+Patch1:         Storable-3.16-Storable-make-count-large-enough.patch
+# Fix a buffer overflow when processing a vstring longer than 2^31-1,
+# Perl GH#17306, in perl upstream after 5.31.6
+Patch2:         perl-5.31.6-disallow-vstring-magic-strings-over-2GB-1.patch
 BuildRequires:  gcc
 BuildRequires:  make
 BuildRequires:  perl-devel
@@ -66,6 +74,9 @@ can be conveniently stored to disk and retrieved at a later time.
 
 %prep
 %setup -q -n Storable-%{version}
+%patch0 -p3
+%patch1 -p3
+%patch2 -p3
 
 %build
 perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 NO_PERLLOCAL=1 OPTIMIZE="$RPM_OPT_FLAGS"
@@ -88,6 +99,16 @@ make test
 %{_mandir}/man3/*
 
 %changelog
+* Mon Nov 25 2019 Petr Pisar <ppisar@redhat.com> - 1:3.15-4
+- Fix a buffer overflow when processing a vstring longer than 2^31-1
+  (Perl GH#17306)
+
+* Thu Aug 08 2019 Petr Pisar <ppisar@redhat.com> - 1:3.15-3
+- Fix array length check in a store hook
+
+* Tue Jun 11 2019 Petr Pisar <ppisar@redhat.com> - 1:3.15-2
+- Fix deep cloning regular expression objects (RT#134179)
+
 * Wed Apr 24 2019 Petr Pisar <ppisar@redhat.com> - 1:3.15-1
 - 3.15 bump