Fix recursion check

.gitignore

@@ -1,3 +1,6 @@
 /Storable-2.39.tar.gz
 /Storable-2.45.tar.gz
 /Storable-2.51.tar.gz
+/Storable-3.06.tar.gz
+/Storable-3.09.tar.gz
+/Storable-3.11.tar.gz

Storable-2.51-Upgrade-to-2.53.patch

@@ -1,307 +0,0 @@
-From fd2e79041c553c1220c6eca796293873246c5682 Mon Sep 17 00:00:00 2001
-From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
-Date: Wed, 6 May 2015 09:39:53 +0200
-Subject: [PATCH] Upgrade to 2.53
-MIME-Version: 1.0
-Content-Type: text/plain; charset=UTF-8
-Content-Transfer-Encoding: 8bit
-
-Signed-off-by: Petr Písař <ppisar@redhat.com>
----
- ChangeLog         |  2 +-
- MANIFEST          |  3 +++
- Storable.pm       |  6 +++---
- t/attach.t        | 42 ++++++++++++++++++++++++++++++++++++
- t/attach_errors.t |  2 +-
- t/canonical.t     |  2 +-
- t/code.t          |  2 +-
- t/leaks.t         | 34 +++++++++++++++++++++++++++++
- t/tied_store.t    | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
- t/utf8.t          |  6 ++++--
- 10 files changed, 154 insertions(+), 9 deletions(-)
- create mode 100644 t/attach.t
- create mode 100644 t/leaks.t
- create mode 100644 t/tied_store.t
-
-diff --git a/ChangeLog b/ChangeLog
-index 4df921e..cbfdbab 100644
---- a/ChangeLog
-+++ b/ChangeLog
-@@ -209,7 +209,7 @@ Fri Jun  7 23:55:41 BST 2002   Nicholas Clark
- 	The bug was introduced as development perl change 16442 (on
- 	2002/05/07), so has been present since 2.00.
- 	Patches to introduce more regression tests to reduce the chance of
--	a reoccurence of this sort of goof are always welcome.
-+	a reoccurrence of this sort of goof are always welcome.
- 	
- Thu May 30 20:31:08 BST 2002   Nicholas Clark <nick@ccl4.org>
- 
-diff --git a/MANIFEST b/MANIFEST
-index 84b72f1..2f5b725 100644
---- a/MANIFEST
-+++ b/MANIFEST
-@@ -9,6 +9,7 @@ ppport.h
- README
- Storable.pm
- Storable.xs
-+t/attach.t
- t/attach_errors.t
- t/attach_singleton.t
- t/blessed.t
-@@ -33,6 +34,7 @@ t/HAS_OVERLOAD.pm
- t/integer.t
- t/interwork56.t
- t/just_plain_nasty.t
-+t/leaks.t
- t/lock.t
- t/make_56_interwork.pl
- t/make_downgrade.pl
-@@ -51,6 +53,7 @@ t/threads.t
- t/tied.t
- t/tied_hook.t
- t/tied_items.t
-+t/tied_store.t
- t/utf8.t
- t/utf8hash.t
- t/weak.t
-diff --git a/Storable.pm b/Storable.pm
-index 839c1d1..9d8b621 100644
---- a/Storable.pm
-+++ b/Storable.pm
-@@ -22,7 +22,7 @@ package Storable; @ISA = qw(Exporter);
- 
- use vars qw($canonical $forgive_me $VERSION);
- 
--$VERSION = '2.51';
-+$VERSION = '2.53';
- 
- BEGIN {
-     if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) {
-@@ -1088,8 +1088,8 @@ deal with them.
- 
- The store functions will C<croak> if they run into such references
- unless you set C<$Storable::forgive_me> to some C<TRUE> value. In that
--case, the fatal message is turned in a warning and some
--meaningless string is stored instead.
-+case, the fatal message is converted to a warning and some meaningless
-+string is stored instead.
- 
- Setting C<$Storable::canonical> may not yield frozen strings that
- compare equal due to possible stringification of numbers. When the
-diff --git a/t/attach.t b/t/attach.t
-new file mode 100644
-index 0000000..5ffdae5
---- /dev/null
-+++ b/t/attach.t
-@@ -0,0 +1,42 @@
-+#!./perl -w
-+#
-+# This file tests that Storable correctly uses STORABLE_attach hooks
-+
-+sub BEGIN {
-+	unshift @INC, 't';
-+	unshift @INC, 't/compat' if $] < 5.006002;
-+	require Config; import Config;
-+	if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
-+		print "1..0 # Skip: Storable was not built\n";
-+		exit 0;
-+	}
-+}
-+
-+use Test::More tests => 3;
-+use Storable ();
-+
-+{
-+	my $destruct_cnt = 0;
-+	my $obj = bless {data => 'ok'}, 'My::WithDestructor';
-+	my $target = Storable::thaw( Storable::freeze( $obj ) );
-+	is( $target->{data}, 'ok', 'We got correct object after freeze/thaw' );
-+	is( $destruct_cnt, 0, 'No tmp objects created by Storable' );
-+	undef $obj;
-+	undef $target;
-+	is( $destruct_cnt, 2, 'Only right objects destroyed at the end' );
-+
-+	package My::WithDestructor;
-+
-+	sub STORABLE_freeze {
-+		my ($self, $clone) = @_;
-+		return $self->{data};
-+	}
-+
-+	sub STORABLE_attach {
-+		my ($class, $clone, $string) = @_;
-+		return bless {data => $string}, 'My::WithDestructor';
-+	}
-+
-+	sub DESTROY { $destruct_cnt++; }
-+}
-+
-diff --git a/t/attach_errors.t b/t/attach_errors.t
-index c163ca0..6cebd97 100644
---- a/t/attach_errors.t
-+++ b/t/attach_errors.t
-@@ -234,7 +234,7 @@ use Storable ();
- 	isa_ok( $thawed->[1], 'My::GoodAttach::MultipleReferences' );
- 
- 	is($thawed->[0], $thawed->[1], 'References to the same object are attached properly');
--	is($thawed->[1]{id}, $obj->{id}, 'Object with multiple references attchached properly');
-+	is($thawed->[1]{id}, $obj->{id}, 'Object with multiple references attached properly');
- 
-     package My::GoodAttach::MultipleReferences;
- 
-diff --git a/t/canonical.t b/t/canonical.t
-index 23e012f..35046de 100644
---- a/t/canonical.t
-+++ b/t/canonical.t
-@@ -34,7 +34,7 @@ $maxarraysize = 100;
- 
- eval { require Digest::MD5; };
- $gotmd5 = !$@;
--diag "Will use Digest::MD5" if $gotmd5;
-+note "Will use Digest::MD5" if $gotmd5;
- 
- # Use Data::Dumper if debugging and it is available to create an ASCII dump
- 
-diff --git a/t/code.t b/t/code.t
-index c383142..7fc40ba 100644
---- a/t/code.t
-+++ b/t/code.t
-@@ -102,7 +102,7 @@ is($thawed->{"b"}->(), "JAPH");
- $freezed = freeze $obj[2];
- $thawed  = thaw $freezed;
- 
--is($thawed->(), 42);
-+is($thawed->(), (ord "A") == 193 ? -118 : 42);
- 
- ######################################################################
- 
-diff --git a/t/leaks.t b/t/leaks.t
-new file mode 100644
-index 0000000..06360d6
---- /dev/null
-+++ b/t/leaks.t
-@@ -0,0 +1,34 @@
-+#!./perl
-+
-+use Test::More;
-+use Storable ();
-+BEGIN {
-+eval "use Test::LeakTrace";
-+plan 'skip_all' => 'Test::LeakTrace required for this tests' if $@;
-+}
-+plan 'tests' => 1;
-+
-+{
-+    my $c = My::Simple->new;
-+    my $d;
-+    my $freezed = Storable::freeze($c);
-+    no_leaks_ok
-+    {
-+        $d = Storable::thaw($freezed);
-+        undef $d;
-+    };
-+
-+    package My::Simple;
-+    sub new {
-+        my ($class, $arg) = @_;
-+        bless {t=>$arg}, $class;
-+    }
-+    sub STORABLE_freeze {
-+        return "abcderfgh";
-+    }
-+    sub STORABLE_attach {
-+        my ($class, $c, $serialized) = @_;
-+        return $class->new($serialized);
-+    }
-+}
-+
-diff --git a/t/tied_store.t b/t/tied_store.t
-new file mode 100644
-index 0000000..c657f95
---- /dev/null
-+++ b/t/tied_store.t
-@@ -0,0 +1,64 @@
-+#!./perl
-+
-+sub BEGIN {
-+    unshift @INC, 't';
-+    unshift @INC, 't/compat' if $] < 5.006002;
-+    require Config; import Config;
-+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
-+        print "1..0 # Skip: Storable was not built\n";
-+        exit 0;
-+    }
-+}
-+
-+use Storable ();
-+use Test::More tests => 3;
-+
-+our $f;
-+
-+package TIED_HASH;
-+
-+sub TIEHASH { bless({}, $_[0]) }
-+
-+sub STORE {
-+	$f = Storable::freeze(\$_[2]);
-+	1;
-+}
-+
-+package TIED_ARRAY;
-+
-+sub TIEARRAY { bless({}, $_[0]) }
-+
-+sub STORE {
-+	$f = Storable::freeze(\$_[2]);
-+	1;
-+}
-+
-+package TIED_SCALAR;
-+
-+sub TIESCALAR { bless({}, $_[0]) }
-+
-+sub STORE {
-+	$f = Storable::freeze(\$_[1]);
-+	1;
-+}
-+
-+package main;
-+
-+my($s, @a, %h);
-+tie $s, "TIED_SCALAR";
-+tie @a, "TIED_ARRAY";
-+tie %h, "TIED_HASH";
-+
-+$f = undef;
-+$s = 111;
-+is $f, Storable::freeze(\111);
-+
-+$f = undef;
-+$a[3] = 222;
-+is $f, Storable::freeze(\222);
-+
-+$f = undef;
-+$h{foo} = 333;
-+is $f, Storable::freeze(\333);
-+
-+1;
-diff --git a/t/utf8.t b/t/utf8.t
-index fd20ef6..a8dd6cd 100644
---- a/t/utf8.t
-+++ b/t/utf8.t
-@@ -32,8 +32,10 @@ is($x, ${thaw freeze \$x});
- $x = join '', map {chr $_} (0..1023);
- is($x, ${thaw freeze \$x});
- 
--# Char in the range 127-255 (probably) in utf8
--$x = chr (175) . chr (256);
-+# Char in the range 127-255 (probably) in utf8.  This just won't work for
-+# EBCDIC for early Perls.
-+$x = ($] lt 5.007_003) ? chr(175) : chr(utf8::unicode_to_native(175))
-+   . chr (256);
- chop $x;
- is($x, ${thaw freeze \$x});
- 
--- 
-2.1.0
-

Storable-2.53-Upgrade-to-2.56.patch

@@ -1,99 +0,0 @@
-diff --git a/Storable.pm b/Storable.pm
-index 9d8b621..c8f6db1 100644
---- a/Storable.pm
-+++ b/Storable.pm
-@@ -22,7 +22,7 @@ package Storable; @ISA = qw(Exporter);
- 
- use vars qw($canonical $forgive_me $VERSION);
- 
--$VERSION = '2.53';
-+$VERSION = '2.56';
- 
- BEGIN {
-     if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) {
-@@ -979,43 +979,43 @@ such.
- 
- Here are some code samples showing a possible usage of Storable:
- 
--	use Storable qw(store retrieve freeze thaw dclone);
-+ use Storable qw(store retrieve freeze thaw dclone);
- 
--	%color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1);
-+ %color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1);
- 
--	store(\%color, 'mycolors') or die "Can't store %a in mycolors!\n";
-+ store(\%color, 'mycolors') or die "Can't store %a in mycolors!\n";
- 
--	$colref = retrieve('mycolors');
--	die "Unable to retrieve from mycolors!\n" unless defined $colref;
--	printf "Blue is still %lf\n", $colref->{'Blue'};
-+ $colref = retrieve('mycolors');
-+ die "Unable to retrieve from mycolors!\n" unless defined $colref;
-+ printf "Blue is still %lf\n", $colref->{'Blue'};
- 
--	$colref2 = dclone(\%color);
-+ $colref2 = dclone(\%color);
- 
--	$str = freeze(\%color);
--	printf "Serialization of %%color is %d bytes long.\n", length($str);
--	$colref3 = thaw($str);
-+ $str = freeze(\%color);
-+ printf "Serialization of %%color is %d bytes long.\n", length($str);
-+ $colref3 = thaw($str);
- 
- which prints (on my machine):
- 
--	Blue is still 0.100000
--	Serialization of %color is 102 bytes long.
-+ Blue is still 0.100000
-+ Serialization of %color is 102 bytes long.
- 
- Serialization of CODE references and deserialization in a safe
- compartment:
- 
- =for example begin
- 
--	use Storable qw(freeze thaw);
--	use Safe;
--	use strict;
--	my $safe = new Safe;
-+ use Storable qw(freeze thaw);
-+ use Safe;
-+ use strict;
-+ my $safe = new Safe;
-         # because of opcodes used in "use strict":
--	$safe->permit(qw(:default require));
--	local $Storable::Deparse = 1;
--	local $Storable::Eval = sub { $safe->reval($_[0]) };
--	my $serialized = freeze(sub { 42 });
--	my $code = thaw($serialized);
--	$code->() == 42;
-+ $safe->permit(qw(:default require));
-+ local $Storable::Deparse = 1;
-+ local $Storable::Eval = sub { $safe->reval($_[0]) };
-+ my $serialized = freeze(sub { 42 });
-+ my $code = thaw($serialized);
-+ $code->() == 42;
- 
- =for example end
- 
-diff --git a/Storable.xs b/Storable.xs
-index e7d0329..83cd001 100644
---- a/Storable.xs
-+++ b/Storable.xs
-@@ -1667,6 +1667,7 @@ static void free_context(pTHX_ stcxt_t *cxt)
- 
- 	ASSERT(!cxt->s_dirty, ("clean context"));
- 	ASSERT(prev, ("not freeing root context"));
-+	assert(prev);
- 
- 	SvREFCNT_dec(cxt->my_sv);
- 	SET_STCXT(prev);
-@@ -6677,6 +6678,7 @@ SV *	obj
-  ALIAS:
-   net_mstore = 1
-  CODE:
-+  RETVAL = &PL_sv_undef;
-   if (!do_store(aTHX_ (PerlIO*) 0, obj, 0, ix, &RETVAL))
-     RETVAL = &PL_sv_undef;
-  OUTPUT:

Storable-2.62-Provide-SvPVCLEAR-macro.patch

@@ -1,34 +0,0 @@
-From ccf6bcc1ea08403f9081ce608009322e1b5091f6 Mon Sep 17 00:00:00 2001
-From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
-Date: Thu, 11 May 2017 13:29:57 +0200
-Subject: [PATCH] Provide SvPVCLEAR() macro
-MIME-Version: 1.0
-Content-Type: text/plain; charset=UTF-8
-Content-Transfer-Encoding: 8bit
-
-To build with perl <= 5.25.5.
-
-Signed-off-by: Petr Písař <ppisar@redhat.com>
----
- Storable.xs | 5 +++++
- 1 file changed, 5 insertions(+)
-
-diff --git a/Storable.xs b/Storable.xs
-index 9ba48be..f7d253c 100644
---- a/Storable.xs
-+++ b/Storable.xs
-@@ -26,6 +26,11 @@
- #include "ppport.h"             /* handle old perls */
- #endif
- 
-+/* SvPVCLEAR was added after 5.25.5 and ppport.h does not provide it */
-+#if !defined SvPVCLEAR
-+#define SvPVCLEAR(x) sv_setpvs((x), "")
-+#endif
-+
- #if 0
- #define DEBUGME /* Debug mode, turns assertions on as well */
- #define DASSERT /* Assertion mode */
--- 
-2.9.3
-

perl-5.29.2-perl-133326-fix-and-clarify-handling-of-recurs_sv.patch

@@ -0,0 +1,295 @@
+From 120060c86e233cb9f588314214137f3ed1b48e2a Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Tue, 7 Aug 2018 15:34:06 +1000
+Subject: [PATCH] (perl #133326) fix and clarify handling of recurs_sv.
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+There were a few problems:
+
+- the purpose of recur_sv wasn't clear, I believe I understand it
+  now from looking at where recur_sv was actually being used.
+  Frankly the logic of the code itself was hard to follow, apparently
+  only counting a level if the recur_sv was equal to the current
+  SV.
+
+  Fixed by adding some documentation to recur_sv in the context
+  structure.  The logic has been re-worked (see below) to hopefully
+  make it more understandable.
+
+- the conditional checks for inc/decrementing recur_depth didn't
+  match between the beginnings and ends of the store_array() and
+  store_hash() handlers didn't match, since recur_sv was both
+  explicitly modified by those functions and implicitly modified
+  in their recursive calls to process elements.
+
+  Fixing by storing the starting value of cxt->recur_sv locally
+  testing against that instead of against the value that might be
+  modified recursively.
+
+- the checks in store_ref(), store_array(), store_l?hash() were
+  over complex, obscuring their purpose.
+
+  Fixed by:
+   - always count a recursion level in store_ref() and store the
+     RV in recur_sv
+   - only count a recursion level in the array/hash handlers if
+     the SV didn't match.
+   - skip the check against cxt->entry, if we're in this code
+     we could be recursing, so we want to detect it.
+
+- (after the other changes) the recursion checks in store_hash()/
+  store_lhash() only checked the limit if the SV didn't match the
+  recur_sv, which horribly broke things.
+
+  Fixed by:
+   - Now only make the depth increment conditional, and always
+     check against the limit if one is set.
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ dist/Storable/Storable.xs | 98 ++++++++++++++++++++++++++++++-----------------
+ dist/Storable/t/recurse.t | 16 +++++++-
+ 2 files changed, 77 insertions(+), 37 deletions(-)
+
+diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
+index 6a90e24814..f6df32b121 100644
+--- a/dist/Storable/Storable.xs
++++ b/dist/Storable/Storable.xs
+@@ -418,6 +418,24 @@ typedef struct stcxt {
+     SV *(**retrieve_vtbl)(pTHX_ struct stcxt *, const char *);	/* retrieve dispatch table */
+     SV *prev;			/* contexts chained backwards in real recursion */
+     SV *my_sv;			/* the blessed scalar who's SvPVX() I am */
++
++    /* recur_sv:
++
++       A hashref of hashrefs or arrayref of arrayrefs is actually a
++       chain of four SVs, eg for an array ref containing an array ref:
++
++         RV -> AV (element) -> RV -> AV
++
++       To make this depth appear natural from a perl level we only
++       want to count this as two levels, so store_ref() stores it's RV
++       into recur_sv and store_array()/store_hash() will only count
++       that level if the AV/HV *isn't* recur_sv.
++
++       We can't just have store_hash()/store_array() not count that
++       level, since it's possible for XS code to store an AV or HV
++       directly as an element (though perl code trying to access such
++       an object will generally croak.)
++     */
+     SV *recur_sv;               /* check only one recursive SV */
+     int in_retrieve_overloaded; /* performance hack for retrieving overloaded objects */
+     int flags;			/* controls whether to bless or tie objects */
+@@ -431,8 +449,13 @@ typedef struct stcxt {
+ 
+ #define RECURSION_TOO_DEEP() \
+     (cxt->max_recur_depth != -1 && ++cxt->recur_depth > cxt->max_recur_depth)
++
++/* There's cases where we need to check whether the hash recursion
++   limit has been reached without bumping the recursion levels, so the
++   hash check doesn't bump the depth.
++*/
+ #define RECURSION_TOO_DEEP_HASH() \
+-    (cxt->max_recur_depth_hash != -1 && ++cxt->recur_depth > cxt->max_recur_depth_hash)
++    (cxt->max_recur_depth_hash != -1 && cxt->recur_depth > cxt->max_recur_depth_hash)
+ #define MAX_DEPTH_ERROR "Max. recursion depth with nested structures exceeded"
+ 
+ static int storable_free(pTHX_ SV *sv, MAGIC* mg);
+@@ -2360,21 +2383,20 @@ static int store_ref(pTHX_ stcxt_t *cxt, SV *sv)
+     } else
+         PUTMARK(is_weak ? SX_WEAKREF : SX_REF);
+ 
+-    TRACEME(("recur_depth %" IVdf ", recur_sv (0x%" UVxf ")", cxt->recur_depth,
+-             PTR2UV(cxt->recur_sv)));
+-    if (cxt->entry && cxt->recur_sv == sv) {
+-        if (RECURSION_TOO_DEEP()) {
++    cxt->recur_sv = sv;
++
++    TRACEME((">ref recur_depth %" IVdf ", recur_sv (0x%" UVxf ") max %" IVdf, cxt->recur_depth,
++             PTR2UV(cxt->recur_sv), cxt->max_recur_depth));
++    if (RECURSION_TOO_DEEP()) {
+ #if PERL_VERSION < 15
+-            cleanup_recursive_data(aTHX_ (SV*)sv);
++        cleanup_recursive_data(aTHX_ (SV*)sv);
+ #endif
+-            CROAK((MAX_DEPTH_ERROR));
+-        }
++        CROAK((MAX_DEPTH_ERROR));
+     }
+-    cxt->recur_sv = sv;
+ 
+     retval = store(aTHX_ cxt, sv);
+-    if (cxt->entry && cxt->recur_sv == sv && cxt->recur_depth > 0) {
+-        TRACEME(("recur_depth --%" IVdf, cxt->recur_depth));
++    if (cxt->max_recur_depth != -1 && cxt->recur_depth > 0) {
++        TRACEME(("<ref recur_depth --%" IVdf, cxt->recur_depth));
+         --cxt->recur_depth;
+     }
+     return retval;
+@@ -2635,6 +2657,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
+     UV len = av_len(av) + 1;
+     UV i;
+     int ret;
++    SV *const recur_sv = cxt->recur_sv;
+ 
+     TRACEME(("store_array (0x%" UVxf ")", PTR2UV(av)));
+ 
+@@ -2659,9 +2682,9 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
+         TRACEME(("size = %d", (int)l));
+     }
+ 
+-    TRACEME(("recur_depth %" IVdf ", recur_sv (0x%" UVxf ")", cxt->recur_depth,
+-             PTR2UV(cxt->recur_sv)));
+-    if (cxt->entry && cxt->recur_sv == (SV*)av) {
++    TRACEME((">array recur_depth %" IVdf ", recur_sv (0x%" UVxf ") max %" IVdf, cxt->recur_depth,
++             PTR2UV(cxt->recur_sv), cxt->max_recur_depth));
++    if (recur_sv != (SV*)av) {
+         if (RECURSION_TOO_DEEP()) {
+             /* with <= 5.14 it recurses in the cleanup also, needing 2x stack size */
+ #if PERL_VERSION < 15
+@@ -2670,7 +2693,6 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
+             CROAK((MAX_DEPTH_ERROR));
+         }
+     }
+-    cxt->recur_sv = (SV*)av;
+ 
+     /*
+      * Now store each item recursively.
+@@ -2701,9 +2723,12 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
+             return ret;
+     }
+ 
+-    if (cxt->entry && cxt->recur_sv == (SV*)av && cxt->recur_depth > 0) {
+-        TRACEME(("recur_depth --%" IVdf, cxt->recur_depth));
+-        --cxt->recur_depth;
++    if (recur_sv != (SV*)av) {
++        assert(cxt->max_recur_depth == -1 || cxt->recur_depth > 0);
++        if (cxt->max_recur_depth != -1 && cxt->recur_depth > 0) {
++            TRACEME(("<array recur_depth --%" IVdf, cxt->recur_depth));
++            --cxt->recur_depth;
++        }
+     }
+     TRACEME(("ok (array)"));
+ 
+@@ -2766,6 +2791,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
+ #endif
+                          ) ? 1 : 0);
+     unsigned char hash_flags = (SvREADONLY(hv) ? SHV_RESTRICTED : 0);
++    SV * const recur_sv = cxt->recur_sv;
+ 
+     /* 
+      * Signal hash by emitting SX_HASH, followed by the table length.
+@@ -2817,17 +2843,17 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
+         TRACEME(("size = %d, used = %d", (int)l, (int)HvUSEDKEYS(hv)));
+     }
+ 
+-    TRACEME(("recur_depth %" IVdf ", recur_sv (0x%" UVxf ")", cxt->recur_depth,
+-             PTR2UV(cxt->recur_sv)));
+-    if (cxt->entry && cxt->recur_sv == (SV*)hv) {
+-        if (RECURSION_TOO_DEEP_HASH()) {
++    TRACEME((">hash recur_depth %" IVdf ", recur_sv (0x%" UVxf ") max %" IVdf, cxt->recur_depth,
++             PTR2UV(cxt->recur_sv), cxt->max_recur_depth_hash));
++    if (recur_sv != (SV*)hv && cxt->max_recur_depth_hash != -1) {
++        ++cxt->recur_depth;
++    }
++    if (RECURSION_TOO_DEEP_HASH()) {
+ #if PERL_VERSION < 15
+-            cleanup_recursive_data(aTHX_ (SV*)hv);
++        cleanup_recursive_data(aTHX_ (SV*)hv);
+ #endif
+-            CROAK((MAX_DEPTH_ERROR));
+-        }
++        CROAK((MAX_DEPTH_ERROR));
+     }
+-    cxt->recur_sv = (SV*)hv;
+ 
+     /*
+      * Save possible iteration state via each() on that table.
+@@ -3107,8 +3133,9 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
+     TRACEME(("ok (hash 0x%" UVxf ")", PTR2UV(hv)));
+ 
+  out:
+-    if (cxt->entry && cxt->recur_sv == (SV*)hv && cxt->recur_depth > 0) {
+-        TRACEME(("recur_depth --%" IVdf , cxt->recur_depth));
++    assert(cxt->max_recur_depth_hash != -1 && cxt->recur_depth > 0);
++    TRACEME(("<hash recur_depth --%" IVdf , cxt->recur_depth));
++    if (cxt->max_recur_depth_hash != -1 && recur_sv != (SV*)hv && cxt->recur_depth > 0) {
+         --cxt->recur_depth;
+     }
+     HvRITER_set(hv, riter);		/* Restore hash iterator state */
+@@ -3221,6 +3248,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
+ #ifdef DEBUGME
+     UV len = (UV)HvTOTALKEYS(hv);
+ #endif
++    SV * const recur_sv = cxt->recur_sv;
+     if (hash_flags) {
+         TRACEME(("store_lhash (0x%" UVxf ") (flags %x)", PTR2UV(hv),
+                  (int) hash_flags));
+@@ -3231,15 +3259,15 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
+ 
+     TRACEME(("recur_depth %" IVdf ", recur_sv (0x%" UVxf ")", cxt->recur_depth,
+              PTR2UV(cxt->recur_sv)));
+-    if (cxt->entry && cxt->recur_sv == (SV*)hv) {
+-        if (RECURSION_TOO_DEEP_HASH()) {
++    if (recur_sv != (SV*)hv && cxt->max_recur_depth_hash != -1) {
++        ++cxt->recur_depth;
++    }
++    if (RECURSION_TOO_DEEP_HASH()) {
+ #if PERL_VERSION < 15
+-            cleanup_recursive_data(aTHX_ (SV*)hv);
++        cleanup_recursive_data(aTHX_ (SV*)hv);
+ #endif
+-            CROAK((MAX_DEPTH_ERROR));
+-        }
++        CROAK((MAX_DEPTH_ERROR));
+     }
+-    cxt->recur_sv = (SV*)hv;
+ 
+     array = HvARRAY(hv);
+     for (i = 0; i <= (Size_t)HvMAX(hv); i++) {
+@@ -3252,7 +3280,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
+                 return ret;
+         }
+     }
+-    if (cxt->entry && cxt->recur_sv == (SV*)hv && cxt->recur_depth > 0) {
++    if (recur_sv == (SV*)hv && cxt->max_recur_depth_hash != -1 && cxt->recur_depth > 0) {
+         TRACEME(("recur_depth --%" IVdf, cxt->recur_depth));
+         --cxt->recur_depth;
+     }
+diff --git a/dist/Storable/t/recurse.t b/dist/Storable/t/recurse.t
+index fa8be0b374..63fde90fdf 100644
+--- a/dist/Storable/t/recurse.t
++++ b/dist/Storable/t/recurse.t
+@@ -20,7 +20,7 @@ use Storable qw(freeze thaw dclone);
+ 
+ $Storable::flags = Storable::FLAGS_COMPAT;
+ 
+-use Test::More tests => 38;
++use Test::More tests => 39;
+ 
+ package OBJ_REAL;
+ 
+@@ -364,5 +364,17 @@ else {
+         dclone $t;
+     };
+     like $@, qr/Max\. recursion depth with nested structures exceeded/,
+-      'Caught href stack overflow '.MAX_DEPTH*2;
++      'Caught href stack overflow '.MAX_DEPTH_HASH*2;
++}
++
++{
++    # perl #133326
++    my @tt;
++    #$Storable::DEBUGME=1;
++    for (1..16000) {
++        my $t = [[[]]];
++        push @tt, $t;
++    }
++    ok(eval { dclone \@tt; 1 },
++       "low depth structure shouldn't be treated as nested");
+ }
+-- 
+2.14.4
+

perl-Storable.spec

@@ -1,31 +1,32 @@
-%global base_version 2.51
-
 Name:           perl-Storable
 Epoch:          1
-Version:        2.62
-Release:        395%{?dist}
+Version:        3.11
+Release:        3%{?dist}
 Summary:        Persistence for Perl data structures
+# __Storable__.pm:  GPL+ or Artistic
+## Not in the binary packages
+# t/CVE-2015-1592.inc:  BSD (same as Metasploit Framwork)
 License:        GPL+ or Artistic
-URL:            http://search.cpan.org/dist/Storable/
-Source0:        http://www.cpan.org/authors/id/A/AM/AMS/Storable-%{base_version}.tar.gz
-# Unbundled from perl 5.21.11
-Patch0:         Storable-2.51-Upgrade-to-2.53.patch
-# Unbundled from perl 5.24.0
-Patch1:         Storable-2.53-Upgrade-to-2.56.patch
-# Unbundled from perl 5.25.12, requires SvPVCLEAR() added into perl after 5.25.5
-Patch2:         Storable-2.56-Upgrade-to-2.62.patch
-# Allow building against perl <= 5.25.5,
-# required for Storable-2.56-Upgrade-to-2.62.patch
-Patch3:         Storable-2.62-Provide-SvPVCLEAR-macro.patch
-BuildRequires:  coreutils
+URL:            https://metacpan.org/release/Storable
+Source0:        https://cpan.metacpan.org/authors/id/X/XS/XSAWYERX/Storable-%{version}.tar.gz
+# Fix recursion check, RT#133326
+Patch0:         perl-5.29.2-perl-133326-fix-and-clarify-handling-of-recurs_sv.patch
+# bash for stacksize script (ulimit) that is executed at build time
+BuildRequires:  bash
 BuildRequires:  gcc
 BuildRequires:  make
-BuildRequires:  perl-interpreter
 BuildRequires:  perl-devel
 BuildRequires:  perl-generators
+BuildRequires:  perl-interpreter
 BuildRequires:  perl(Config)
+BuildRequires:  perl(Cwd)
 BuildRequires:  perl(ExtUtils::MakeMaker) >= 6.76
-BuildRequires:  sed
+BuildRequires:  perl(File::Copy)
+BuildRequires:  perl(File::Spec) >= 0.8
+BuildRequires:  perl(strict)
+BuildRequires:  perl(warnings)
+# Win32 not used on Linux
+# Win32API::File not used on Linux
 # Run-time:
 # Carp substitutes missing Log::Agent
 BuildRequires:  perl(Carp)
@@ -34,10 +35,11 @@ BuildRequires:  perl(Exporter)
 BuildRequires:  perl(Fcntl)
 BuildRequires:  perl(IO::File)
 # Log::Agent is optional
-BuildRequires:  perl(vars)
 BuildRequires:  perl(XSLoader)
 # Tests:
+BuildRequires:  perl(base)
 BuildRequires:  perl(bytes)
+BuildRequires:  perl(File::Temp)
 BuildRequires:  perl(integer)
 BuildRequires:  perl(overload)
 BuildRequires:  perl(utf8)
@@ -45,15 +47,16 @@ BuildRequires:  perl(Test::More)
 BuildRequires:  perl(threads)
 BuildRequires:  perl(Safe)
 BuildRequires:  perl(Scalar::Util)
-BuildRequires:  perl(strict)
-BuildRequires:  perl(warnings)
+BuildRequires:  perl(Tie::Array)
 # Optional tests:
+# gzip not used
 # Data::Dump not used
 # Data::Dumper not used
 BuildRequires:  perl(B::Deparse) >= 0.61
 BuildRequires:  perl(Digest::MD5)
-BuildRequires:  perl(File::Spec) >= 0.8
 BuildRequires:  perl(Hash::Util)
+# Test::LeakTrace omitted because it's not a core module requried for building
+# core Storable.
 BuildRequires:  perl(Tie::Hash)
 Requires:       perl(:MODULE_COMPAT_%(eval "`perl -V:version`"; echo $version))
 # Carp substitutes missing Log::Agent
@@ -71,27 +74,21 @@ containing scalar, array, hash or reference objects, i.e. anything that
 can be conveniently stored to disk and retrieved at a later time.
 
 %prep
-%setup -q -n Storable-%{base_version}
-%patch0 -p1
-%patch1 -p1
-%patch2 -p1
-%patch3 -p1
-# Remove bundled modules
-rm -rf t/compat
-sed -i -e '/^t\/compat\//d' MANIFEST
+%setup -q -n Storable-%{version}
+%patch0 -p3
 
 %build
-# Be ware hints/linux.pl removes "-ON" from CFLAGS if N > 2 because it can
-# break the code.
 perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 OPTIMIZE="$RPM_OPT_FLAGS"
 make %{?_smp_mflags}
 
 %install
 make pure_install DESTDIR=$RPM_BUILD_ROOT
 find $RPM_BUILD_ROOT -type f -name '*.bs' -size 0 -delete
+find $RPM_BUILD_ROOT -type f -name '*.3pm' -size 0 -delete
 %{_fixperms} $RPM_BUILD_ROOT/*
 
 %check
+unset PERL_TEST_MEMORY PERL_RUN_SLOW_TESTS
 make test
 
 %files
@@ -101,6 +98,21 @@ make test
 %{_mandir}/man3/*
 
 %changelog
+* Mon Aug 27 2018 Petr Pisar <ppisar@redhat.com> - 1:3.11-3
+- Fix recursion check (RT#133326)
+
+* Tue Jun 05 2018 Petr Pisar <ppisar@redhat.com> - 1:3.11-2
+- Do not package empty Storable::Limit(3pm) manual page
+
+* Mon Apr 30 2018 Petr Pisar <ppisar@redhat.com> - 1:3.11-1
+- 3.11 bump
+
+* Mon Apr 23 2018 Petr Pisar <ppisar@redhat.com> - 1:3.09-1
+- 3.09 bump
+
+* Thu Apr 19 2018 Petr Pisar <ppisar@redhat.com> - 1:3.06-1
+- 3.06 bump
+
 * Thu Aug 03 2017 Fedora Release Engineering <releng@fedoraproject.org> - 1:2.62-395
 - Rebuilt for https://fedoraproject.org/wiki/Fedora_27_Binutils_Mass_Rebuild
 

sources

@@ -1 +1 @@
-48082965a6403a8c5adcd42aeb0c58e5  Storable-2.51.tar.gz
+SHA512 (Storable-3.11.tar.gz) = da27b56dd422d4ae0bad225c0b0dcc91beff546d0cc537643da5530e8d50f421e88b960a2ac9f09867448e28a10743790d935aa0c1b6c8456d059430e1f7ffe9