Fix a memory leak of a class name from retrieve_hook() on an exception

.fmf/version

@@ -1 +0,0 @@
-1

.gitignore

@@ -1,9 +1,3 @@
 /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-3.11_repackaged.tar.gz
-/Storable-3.15.tar.gz
-/Storable-3.25.tar.gz

Storable-2.51-Upgrade-to-2.53.patch

@@ -0,0 +1,307 @@
+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

@@ -0,0 +1,99 @@
+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.56-CVE-2016-1238-avoid-loading-optional-modules-from.patch

@@ -0,0 +1,18 @@
+diff -up Storable/Storable.pm.cve Storable/Storable.pm
+--- Storable/Storable.pm.cve	2016-03-19 19:50:47.000000000 +0100
++++ Storable/Storable.pm	2016-08-03 12:48:36.415082280 +0200
+@@ -25,7 +25,13 @@ use vars qw($canonical $forgive_me $VERS
+ $VERSION = '2.56';
+ 
+ BEGIN {
+-    if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) {
++    if (eval {
++        local $SIG{__DIE__};
++        local @INC = @INC;
++        pop @INC if $INC[-1] eq '.';
++        require Log::Agent;
++        1;
++    }) {
+         Log::Agent->import;
+     }
+     #

Storable-2.56-Fix-stack-buffer-overflow-in-deserialization-of-hook.patch

@@ -0,0 +1,103 @@
+From c34e1dd29983e5d36d367462b9b4b4b8fcd5a0f8 Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
+Date: Mon, 6 Feb 2017 15:13:41 +0100
+Subject: [PATCH] Fix stack buffer overflow in deserialization of hooks.
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Ported from perl:
+
+commit 3e998ddfb597cfae7bdb460b22e6c50440b1de92
+Author: John Lightsey <jd@cpanel.net>
+Date:   Tue Jan 24 10:30:18 2017 -0600
+
+    Fix stack buffer overflow in deserialization of hooks.
+
+    The use of signed lengths resulted in a stack overflow in retrieve_hook()
+    when a negative length was provided in the storable data.
+
+    The retrieve_blessed() codepath had a similar problem with the placement
+    of the trailing null byte when negative lengths were provided.
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ Storable.xs | 11 +++++++++--
+ t/store.t   | 12 +++++++++++-
+ 2 files changed, 20 insertions(+), 3 deletions(-)
+
+diff --git a/Storable.xs b/Storable.xs
+index bc15d1d..3cce3ed 100644
+--- a/Storable.xs
++++ b/Storable.xs
+@@ -4016,7 +4016,7 @@ static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, const char *cname)
+  */
+ static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, const char *cname)
+ {
+-	I32 len;
++	U32 len;
+ 	SV *sv;
+ 	char buf[LG_BLESS + 1];		/* Avoid malloc() if possible */
+ 	char *classname = buf;
+@@ -4037,6 +4037,9 @@ static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, const char *cname)
+ 	if (len & 0x80) {
+ 		RLEN(len);
+ 		TRACEME(("** allocating %d bytes for class name", len+1));
++		if (len > I32_MAX) {
++			CROAK(("Corrupted classname length"));
++		}
+ 		New(10003, classname, len+1, char);
+ 		malloced_classname = classname;
+ 	}
+@@ -4087,7 +4090,7 @@ static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, const char *cname)
+  */
+ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
+ {
+-	I32 len;
++	U32 len;
+ 	char buf[LG_BLESS + 1];		/* Avoid malloc() if possible */
+ 	char *classname = buf;
+ 	unsigned int flags;
+@@ -4221,6 +4224,10 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
+ 		else
+ 			GETMARK(len);
+ 
++		if (len > I32_MAX) {
++			CROAK(("Corrupted classname length"));
++		}
++
+ 		if (len > LG_BLESS) {
+ 			TRACEME(("** allocating %d bytes for class name", len+1));
+ 			New(10003, classname, len+1, char);
+diff --git a/t/store.t b/t/store.t
+index be43299..1cbf021 100644
+--- a/t/store.t
++++ b/t/store.t
+@@ -19,7 +19,7 @@ sub BEGIN {
+ 
+ use Storable qw(store retrieve store_fd nstore_fd fd_retrieve);
+ 
+-use Test::More tests => 21;
++use Test::More tests => 22;
+ 
+ $a = 'toto';
+ $b = \$a;
+@@ -87,5 +87,15 @@ is(&dump($r), &dump(\%a));
+ eval { $r = fd_retrieve(::OUT); };
+ isnt($@, '');
+ 
++{
++
++    my $frozen =
++      "\x70\x73\x74\x30\x04\x0a\x08\x31\x32\x33\x34\x35\x36\x37\x38\x04\x08\x08\x08\x03\xff\x00\x00\x00\x19\x08\xff\x00\x00\x00\x08\x08\xf9\x16\x16\x13\x16\x10\x10\x10\xff\x15\x16\x16\x16\x1e\x16\x16\x16\x16\x16\x16\x16\x16\x16\x16\x13\xf0\x16\x16\x16\xfe\x16\x41\x41\x41\x41\xe8\x03\x41\x41\x41\x41\x41\x41\x41\x41\x51\x41\xa9\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xb8\xac\xac\xac\xac\xac\xac\xac\xac\x9a\xac\xac\xac\xac\xac\xac\xac\xac\xac\x93\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\x00\x64\xac\xa8\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\x2c\xac\x41\x41\x41\x41\x41\x41\x41\x41\x41\x00\x80\x41\x80\x41\x41\x41\x41\x41\x41\x51\x41\xac\xac\xac";
++    open my $fh, '<', \$frozen;
++    eval { Storable::fd_retrieve($fh); };
++    pass('RT 130635:  no stack smashing error when retrieving hook');
++
++}
++
+ close OUT or die "Could not close: $!";
+ END { 1 while unlink 'store' }
+-- 
+2.7.4
+

Storable-2.56-prevent-leak-of-class-name-from-retrieve_hook-on-an-.patch

@@ -0,0 +1,81 @@
+From 979ae704ddc9e6f19d8dbf7a83bea155065ef3cc Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
+Date: Mon, 6 Feb 2017 15:26:09 +0100
+Subject: [PATCH] prevent leak of class name from retrieve_hook() on an
+ exception
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Ported from perl:
+
+commit da1ec2b1b9abdfd956d9c539abf39d908d046304
+Author: Tony Cook <tony@develop-help.com>
+Date:   Mon Feb 6 11:38:10 2017 +1100
+
+    prevent leak of class name from retrieve_hook() on an exception
+
+    If supplied with a large class name, retrieve_hook() allocates
+    buffer for the class name and Safefree()s it on exit path.
+
+    Unfortunately this memory leaks if load_module() (or a couple of other
+    code paths) throw an exception.
+
+    So use SAVEFREEPV() to release the memory instead.
+
+    ==20183== 193 bytes in 1 blocks are definitely lost in loss record 4 of 6
+    ==20183==    at 0x4C28C20: malloc (in /usr/lib/valgrind/vgpreload_memcheck-amd64-linux.so)
+    ==20183==    by 0x55F85D: Perl_safesysmalloc (util.c:153)
+    ==20183==    by 0x6ACA046: retrieve_hook (Storable.xs:4265)
+    ==20183==    by 0x6AD6D19: retrieve (Storable.xs:6217)
+    ==20183==    by 0x6AD8144: do_retrieve (Storable.xs:6401)
+    ==20183==    by 0x6AD85B7: pretrieve (Storable.xs:6506)
+    ==20183==    by 0x6AD8E14: XS_Storable_pretrieve (Storable.xs:6718)
+    ==20183==    by 0x5C176D: Perl_pp_entersub (pp_hot.c:4227)
+    ==20183==    by 0x55E1C6: Perl_runops_debug (dump.c:2450)
+    ==20183==    by 0x461B79: S_run_body (perl.c:2528)
+    ==20183==    by 0x46115C: perl_run (perl.c:2451)
+    ==20183==    by 0x41F1CD: main (perlmain.c:123)
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ Storable.xs | 9 +++++----
+ 1 file changed, 5 insertions(+), 4 deletions(-)
+
+diff --git a/Storable.xs b/Storable.xs
+index 3cce3ed..75ce3df 100644
+--- a/Storable.xs
++++ b/Storable.xs
+@@ -4249,6 +4249,11 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
+ 
+ 	TRACEME(("class name: %s", classname));
+ 
++	if (!(flags & SHF_IDX_CLASSNAME) && classname != buf) {
++                /* some execution paths can throw an exception */
++		SAVEFREEPV(classname);
++        }
++
+ 	/*
+ 	 * Decode user-frozen string length and read it in an SV.
+ 	 *
+@@ -4367,8 +4372,6 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
+ 		SEEN0(sv, 0);
+ 		SvRV_set(attached, NULL);
+ 		SvREFCNT_dec(attached);
+-		if (!(flags & SHF_IDX_CLASSNAME) && classname != buf)
+-		    Safefree(classname);
+ 		return sv;
+ 	    }
+ 	    CROAK(("STORABLE_attach did not return a %s object", classname));
+@@ -4449,8 +4452,6 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
+ 	SvREFCNT_dec(frozen);
+ 	av_undef(av);
+ 	sv_free((SV *) av);
+-	if (!(flags & SHF_IDX_CLASSNAME) && classname != buf)
+-		Safefree(classname);
+ 
+ 	/*
+ 	 * If we had an <extra> type, then the object was not as simple, and
+-- 
+2.7.4
+

Storable-3.25-Upgrade-to-3.32.patch

@@ -1,538 +0,0 @@
-From 93b4cf22054a0e3f9f5d4ae8eaec85e8ca28944c Mon Sep 17 00:00:00 2001
-From: Jitka Plesnikova <jplesnik@redhat.com>
-Date: Mon, 12 Jun 2023 16:00:23 +0200
-Subject: [PATCH] Upgrade to 3.32
-
----
- ChangeLog   |  29 ++++++++++++++
- Makefile.PL |   2 +-
- Storable.pm |  30 ++++++++------
- Storable.xs | 111 ++++++++++++++++++++++++++++++++++++++++++----------
- t/blessed.t |  53 ++++++++++++++++++++++++-
- t/boolean.t |  84 +++++++++++++++++++++++++++++++++++++++
- t/malice.t  |   6 +--
- 7 files changed, 278 insertions(+), 37 deletions(-)
- create mode 100644 t/boolean.t
-
-diff --git a/ChangeLog b/ChangeLog
-index b1f4790..6619543 100644
---- a/ChangeLog
-+++ b/ChangeLog
-@@ -1,3 +1,32 @@
-+2023-05-26 21:36:00 demerphq
-+    version 3.32
-+        * Update security advisory to be more clear
-+
-+2023-02-26 00:31:32 demerphq
-+    version 3.31
-+        * Fixup for ppport fix in 3.30
-+
-+2023-02-22 09:56:27 leont
-+    version 3.30
-+        * Use ppport for all modules in dist.
-+
-+2023-01-04 17:33:24 iabyn
-+    version 3.29
-+        * Store code fixes identified from refcounted stack patch
-+
-+2022-11-08 10:12:46 tony
-+    version 3.28
-+        * Store hook error reporting improvements
-+	* Store hook handles regex objects properly.
-+
-+2022-06-20 20:32:29 toddr
-+    version 3.27
-+        * Use cBOOL instead of !! in xs code
-+
-+2022-04-18 17:36:00 toddr
-+    version 3.26
-+        * Conform to ppport.h 3.68 recommendations
-+
- 2021-08-30 07:46:52 nwclark
-     version 3.25
-         * No changes from previous version
-diff --git a/Makefile.PL b/Makefile.PL
-index e03e141..b705654 100644
---- a/Makefile.PL
-+++ b/Makefile.PL
-@@ -29,7 +29,7 @@ WriteMakefile(
-                 'ExtUtils::MakeMaker' => '6.31',
-             },
-             TEST_REQUIRES => {
--                'Test::More' => '0.41',
-+                'Test::More' => '0.82',
-             },
-            )
-         : () ),
-diff --git a/Storable.pm b/Storable.pm
-index 8e6ab25..d531f2b 100644
---- a/Storable.pm
-+++ b/Storable.pm
-@@ -28,7 +28,7 @@ our @EXPORT_OK = qw(
- our ($canonical, $forgive_me);
- 
- BEGIN {
--  our $VERSION = '3.25';
-+  our $VERSION = '3.32';
- }
- 
- our $recursion_limit;
-@@ -1197,11 +1197,16 @@ compartment:
- 
- =head1 SECURITY WARNING
- 
--B<Do not accept Storable documents from untrusted sources!>
-+B<Do not accept Storable documents from untrusted sources!> There is
-+B<no> way to configure Storable so that it can be used safely to process
-+untrusted data.  While there I<are> various options that can be used to
-+mitigate specific security issues these options do I<not> comprise a
-+complete safety net for the user, and processing untrusted data may
-+result in segmentation faults, remote code execution, or privilege
-+escalation.  The following lists some known features which represent
-+security issues that should be considered by users of this module.
- 
--Some features of Storable can lead to security vulnerabilities if you
--accept Storable documents from untrusted sources with the default
--flags. Most obviously, the optional (off by default) CODE reference
-+Most obviously, the optional (off by default) CODE reference
- serialization feature allows transfer of code to the deserializing
- process. Furthermore, any serialized object will cause Storable to
- helpfully load the module corresponding to the class of the object in
-@@ -1224,12 +1229,15 @@ With the default setting of C<$Storable::flags> = 6, creating or destroying
- random objects, even renamed objects can be controlled by an attacker.
- See CVE-2015-1592 and its metasploit module.
- 
--If your application requires accepting data from untrusted sources,
--you are best off with a less powerful and more-likely safe
--serialization format and implementation. If your data is sufficiently
--simple, L<Cpanel::JSON::XS>, L<Data::MessagePack> or L<Sereal> are the best
--choices and offer maximum interoperability, but note that Sereal is
--L<unsafe by default|Sereal::Decoder/ROBUSTNESS>.
-+If your application requires accepting data from untrusted sources, you
-+are best off with a less powerful and more-likely safe serialization
-+format and implementation.  If your data is sufficiently simple,
-+L<Cpanel::JSON::XS> or L<Data::MessagePack> are fine alternatives.  For
-+more complex data structures containing various Perl specific data types
-+like regular expressions or aliased data L<Sereal> is the best
-+alternative and offers maximum interoperability.  Note that Sereal is
-+L<unsafe by default|Sereal::Decoder/ROBUSTNESS>, but you can configure
-+the encoder and decoder to mitigate any security issues.
- 
- =head1 WARNING
- 
-diff --git a/Storable.xs b/Storable.xs
-index 6944b76..a558dd7 100644
---- a/Storable.xs
-+++ b/Storable.xs
-@@ -16,18 +16,13 @@
- #include <perl.h>
- #include <XSUB.h>
- 
--#ifndef PERL_VERSION_LT
--# if !defined(PERL_VERSION) || !defined(PERL_REVISION) || ( PERL_REVISION == 5 && ( PERL_VERSION < 10 || (PERL_VERSION == 10 && PERL_SUBVERSION < 1) ) )
--#   define NEED_PL_parser
--#   define NEED_sv_2pv_flags
--#   define NEED_load_module
--#   define NEED_vload_module
--#   define NEED_newCONSTSUB
--#   define NEED_newSVpvn_flags
--#   define NEED_newRV_noinc
--# endif
-+#define NEED_sv_2pv_flags
-+#define NEED_load_module
-+#define NEED_vload_module
-+#define NEED_newCONSTSUB
-+#define NEED_newSVpvn_flags
-+#define NEED_newRV_noinc
- #include "ppport.h"             /* handle old perls */
--#endif
- 
- #ifdef DEBUGGING
- #define DEBUGME /* Debug mode, turns assertions on as well */
-@@ -176,7 +171,9 @@
- #define SX_SVUNDEF_ELEM	C(31)	/* array element set to &PL_sv_undef */
- #define SX_REGEXP	C(32)	/* Regexp */
- #define SX_LOBJECT	C(33)	/* Large object: string, array or hash (size >2G) */
--#define SX_LAST		C(34)	/* invalid. marker only */
-+#define SX_BOOLEAN_TRUE	C(34)	/* Boolean true */
-+#define SX_BOOLEAN_FALSE	C(35)	/* Boolean false */
-+#define SX_LAST		C(36)	/* invalid. marker only */
- 
- /*
-  * Those are only used to retrieve "old" pre-0.6 binary images.
-@@ -975,7 +972,7 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
- #endif
- 
- #define STORABLE_BIN_MAJOR	2		/* Binary major "version" */
--#define STORABLE_BIN_MINOR	11		/* Binary minor "version" */
-+#define STORABLE_BIN_MINOR	12		/* Binary minor "version" */
- 
- #if !defined (SvVOK)
- /*
-@@ -1454,6 +1451,8 @@ static const sv_retrieve_t sv_old_retrieve[] = {
-     (sv_retrieve_t)retrieve_other,	/* SX_SVUNDEF_ELEM not supported */
-     (sv_retrieve_t)retrieve_other,	/* SX_REGEXP */
-     (sv_retrieve_t)retrieve_other,  	/* SX_LOBJECT not supported */
-+    (sv_retrieve_t)retrieve_other,	/* SX_BOOLEAN_TRUE not supported */
-+    (sv_retrieve_t)retrieve_other,	/* SX_BOOLEAN_FALSE not supported */
-     (sv_retrieve_t)retrieve_other,  	/* SX_LAST */
- };
- 
-@@ -1477,6 +1476,8 @@ static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, const char *cname);
- static SV *retrieve_vstring(pTHX_ stcxt_t *cxt, const char *cname);
- static SV *retrieve_lvstring(pTHX_ stcxt_t *cxt, const char *cname);
- static SV *retrieve_svundef_elem(pTHX_ stcxt_t *cxt, const char *cname);
-+static SV *retrieve_boolean_true(pTHX_ stcxt_t *cxt, const char *cname);
-+static SV *retrieve_boolean_false(pTHX_ stcxt_t *cxt, const char *cname);
- 
- static const sv_retrieve_t sv_retrieve[] = {
-     0,					/* SX_OBJECT -- entry unused dynamically */
-@@ -1513,6 +1514,8 @@ static const sv_retrieve_t sv_retrieve[] = {
-     (sv_retrieve_t)retrieve_svundef_elem,/* SX_SVUNDEF_ELEM */
-     (sv_retrieve_t)retrieve_regexp,	/* SX_REGEXP */
-     (sv_retrieve_t)retrieve_lobject,	/* SX_LOBJECT */
-+    (sv_retrieve_t)retrieve_boolean_true,	/* SX_BOOLEAN_TRUE */
-+    (sv_retrieve_t)retrieve_boolean_false,	/* SX_BOOLEAN_FALSE */
-     (sv_retrieve_t)retrieve_other,  	/* SX_LAST */
- };
- 
-@@ -2187,7 +2190,7 @@ static AV *array_call(pTHX_
-     XPUSHs(sv_2mortal(newSViv(cloning)));	/* Cloning flag */
-     PUTBACK;
- 
--    count = call_sv(hook, G_ARRAY);	/* Go back to Perl code */
-+    count = call_sv(hook, G_LIST);	/* Go back to Perl code */
- 
-     SPAGAIN;
- 
-@@ -2454,6 +2457,16 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
-             pv = SvPV(sv, len);		/* We know it's SvPOK */
-             goto string;			/* Share code below */
-         }
-+#ifdef SvIsBOOL
-+    } else if (SvIsBOOL(sv)) {
-+        TRACEME(("mortal boolean"));
-+        if (SvTRUE_nomg_NN(sv)) {
-+            PUTMARK(SX_BOOLEAN_TRUE);
-+        }
-+        else {
-+            PUTMARK(SX_BOOLEAN_FALSE);
-+        }
-+#endif
-     } else if (flags & SVf_POK) {
-         /* public string - go direct to string read.  */
-         goto string_readlen;
-@@ -3250,6 +3263,7 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
-         CROAK(("Unexpected return value from B::Deparse::coderef2text\n"));
- 
-     text = POPs;
-+    PUTBACK;
-     len = SvCUR(text);
-     reallen = strlen(SvPV_nolen(text));
- 
-@@ -3318,7 +3332,7 @@ static int get_regexp(pTHX_ stcxt_t *cxt, SV* sv, SV **re, SV **flags) {
-     XPUSHs(rv);
-     PUTBACK;
-     /* optimize to call the XS directly later */
--    count = call_sv((SV*)cv, G_ARRAY);
-+    count = call_sv((SV*)cv, G_LIST);
-     SPAGAIN;
-     if (count < 2)
-       CROAK(("re::regexp_pattern returned only %d results", (int)count));
-@@ -3567,7 +3581,10 @@ static int store_hook(
-     int need_large_oids = 0;
- #endif
- 
--    TRACEME(("store_hook, classname \"%s\", tagged #%d", HvNAME_get(pkg), (int)cxt->tagnum));
-+    classname = HvNAME_get(pkg);
-+    len = strlen(classname);
-+
-+    TRACEME(("store_hook, classname \"%s\", tagged #%d", classname, (int)cxt->tagnum));
- 
-     /*
-      * Determine object type on 2 bits.
-@@ -3576,6 +3593,7 @@ static int store_hook(
-     switch (type) {
-     case svis_REF:
-     case svis_SCALAR:
-+    case svis_REGEXP:
-         obj_type = SHT_SCALAR;
-         break;
-     case svis_ARRAY:
-@@ -3615,13 +3633,20 @@ static int store_hook(
-         }
-         break;
-     default:
--        CROAK(("Unexpected object type (%d) in store_hook()", type));
-+        {
-+            /* pkg_can() always returns a ref to a CV on success */
-+            CV *cv = (CV*)SvRV(hook);
-+            const GV * const gv = CvGV(cv);
-+            const char *gvname = GvNAME(gv);
-+            const HV * const stash = GvSTASH(gv);
-+            const char *hvname = stash ? HvNAME(stash) : NULL;
-+
-+            CROAK(("Unexpected object type (%s) of class '%s' in store_hook() calling %s::%s",
-+                   sv_reftype(sv, FALSE), classname, hvname, gvname));
-+        }
-     }
-     flags = SHF_NEED_RECURSE | obj_type;
- 
--    classname = HvNAME_get(pkg);
--    len = strlen(classname);
--
-     /*
-      * To call the hook, we need to fake a call like:
-      *
-@@ -5882,6 +5907,50 @@ static SV *retrieve_integer(pTHX_ stcxt_t *cxt, const char *cname)
-     return sv;
- }
- 
-+/*
-+ * retrieve_boolean_true
-+ *
-+ * Retrieve boolean true copy.
-+ */
-+static SV *retrieve_boolean_true(pTHX_ stcxt_t *cxt, const char *cname)
-+{
-+    SV *sv;
-+    HV *stash;
-+
-+    TRACEME(("retrieve_boolean_true (#%d)", (int)cxt->tagnum));
-+
-+    sv = newSVsv(&PL_sv_yes);
-+    stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
-+    SEEN_NN(sv, stash, 0);  /* Associate this new scalar with tag "tagnum" */
-+
-+    TRACEME(("boolean true"));
-+    TRACEME(("ok (retrieve_boolean_true at 0x%" UVxf ")", PTR2UV(sv)));
-+
-+    return sv;
-+}
-+
-+/*
-+ * retrieve_boolean_false
-+ *
-+ * Retrieve boolean false copy.
-+ */
-+static SV *retrieve_boolean_false(pTHX_ stcxt_t *cxt, const char *cname)
-+{
-+    SV *sv;
-+    HV *stash;
-+
-+    TRACEME(("retrieve_boolean_false (#%d)", (int)cxt->tagnum));
-+
-+    sv = newSVsv(&PL_sv_no);
-+    stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
-+    SEEN_NN(sv, stash, 0);  /* Associate this new scalar with tag "tagnum" */
-+
-+    TRACEME(("boolean false"));
-+    TRACEME(("ok (retrieve_boolean_false at 0x%" UVxf ")", PTR2UV(sv)));
-+
-+    return sv;
-+}
-+
- /*
-  * retrieve_lobject
-  *
-@@ -7774,7 +7843,7 @@ CODE:
-         assert(cxt);
-         result = cxt->entry && (cxt->optype & ix) ? TRUE : FALSE;
-     } else {
--        result = !!last_op_in_netorder(aTHX);
-+        result = cBOOL(last_op_in_netorder(aTHX));
-     }
-     ST(0) = boolSV(result);
- 
-diff --git a/t/blessed.t b/t/blessed.t
-index d9a77b3..dea569b 100644
---- a/t/blessed.t
-+++ b/t/blessed.t
-@@ -44,7 +44,7 @@ use Storable qw(freeze thaw store retrieve fd_retrieve);
-    'long VSTRING' => \(my $lvstring = eval "v" . 0 x 300),
-    LVALUE         => \(my $substr  = substr((my $str = "foo"), 0, 3)));
- 
--my $test = 13;
-+my $test = 18;
- my $tests = $test + 41 + (2 * 6 * keys %::immortals) + (3 * keys %::weird_refs);
- plan(tests => $tests);
- 
-@@ -414,3 +414,54 @@ is(ref $t, 'STRESS_THE_STACK');
- 
-     unlink("store$$");
- }
-+
-+{
-+    # trying to freeze a glob via STORABLE_freeze
-+    {
-+        package GlobHookedBase;
-+
-+        sub STORABLE_freeze {
-+            return \1;
-+        }
-+
-+        package GlobHooked;
-+        our @ISA = "GlobHookedBase";
-+    }
-+    use Symbol ();
-+    my $glob = bless Symbol::gensym(), "GlobHooked";
-+    eval {
-+        my $data = freeze($glob);
-+    };
-+    my $msg = $@;
-+    like($msg, qr/Unexpected object type \(GLOB\) of class 'GlobHooked' in store_hook\(\) calling GlobHookedBase::STORABLE_freeze/,
-+         "check we get the verbose message");
-+}
-+
-+SKIP:
-+{
-+    $] < 5.012
-+      and skip "Can't assign regexps directly before 5.12", 4;
-+    my $hook_called;
-+    # store regexp via hook
-+    {
-+        package RegexpHooked;
-+        sub STORABLE_freeze {
-+            ++$hook_called;
-+            "$_[0]";
-+        }
-+        sub STORABLE_thaw {
-+            my ($obj, $cloning, $serialized) = @_;
-+            ++$hook_called;
-+            $$obj = ${ qr/$serialized/ };
-+        }
-+    }
-+
-+    my $obj = bless qr/abc/, "RegexpHooked";
-+    my $data = freeze($obj);
-+    ok($data, "froze regexp blessed into hooked class");
-+    ok($hook_called, "and the hook was actually called");
-+    $hook_called = 0;
-+    my $obj_thawed = thaw($data);
-+    ok($hook_called, "hook called for thaw");
-+    like("abc", $obj_thawed, "check the regexp");
-+}
-diff --git a/t/boolean.t b/t/boolean.t
-new file mode 100644
-index 0000000..9ba19c0
---- /dev/null
-+++ b/t/boolean.t
-@@ -0,0 +1,84 @@
-+use strict;
-+use warnings;
-+
-+my $true_ref;
-+my $false_ref;
-+BEGIN {
-+    $true_ref = \!!1;
-+    $false_ref = \!!0;
-+}
-+
-+BEGIN {
-+    unshift @INC, 't';
-+    unshift @INC, 't/compat' if $] < 5.006002;
-+    require Config;
-+    if ($ENV{PERL_CORE} and $Config::Config{'extensions'} !~ /\bStorable\b/) {
-+        print "1..0 # Skip: Storable was not built\n";
-+        exit 0;
-+    }
-+}
-+
-+use Test::More tests => 12;
-+use Storable qw(thaw freeze);
-+
-+use constant CORE_BOOLS => defined &builtin::is_bool;
-+
-+{
-+  my $x = $true_ref;
-+  my $y = ${thaw freeze \$x};
-+  is($y, $x);
-+  eval {
-+    $$y = 2;
-+  };
-+  isnt $@, '',
-+    'immortal true maintained as immortal';
-+}
-+
-+{
-+  my $x = $false_ref;
-+  my $y = ${thaw freeze \$x};
-+  is($y, $x);
-+  eval {
-+    $$y = 2;
-+  };
-+  isnt $@, '',
-+    'immortal false maintained as immortal';
-+}
-+
-+{
-+  my $true = $$true_ref;
-+  my $x = \$true;
-+  my $y = ${thaw freeze \$x};
-+  is($$y, $$x);
-+  is($$y, '1');
-+  SKIP: {
-+    skip "perl $] does not support tracking boolean values", 1
-+      unless CORE_BOOLS;
-+    BEGIN { CORE_BOOLS and warnings->unimport('experimental::builtin') }
-+    ok builtin::is_bool($$y);
-+  }
-+  eval {
-+    $$y = 2;
-+  };
-+  is $@, '',
-+    'mortal true maintained as mortal';
-+}
-+
-+{
-+  my $false = $$false_ref;
-+  my $x = \$false;
-+  my $y = ${thaw freeze \$x};
-+  is($$y, $$x);
-+  is($$y, '');
-+  SKIP: {
-+    skip "perl $] does not support tracking boolean values", 1
-+      unless CORE_BOOLS;
-+    BEGIN { CORE_BOOLS and warnings->unimport('experimental::builtin') }
-+    ok builtin::is_bool($$y);
-+  }
-+  eval {
-+    $$y = 2;
-+  };
-+  is $@, '',
-+    'mortal true maintained as mortal';
-+}
-diff --git a/t/malice.t b/t/malice.t
-index 8adae95..7b92d3d 100644
---- a/t/malice.t
-+++ b/t/malice.t
-@@ -32,7 +32,7 @@ our $file_magic_str = 'pst0';
- our $other_magic = 7 + length $byteorder;
- our $network_magic = 2;
- our $major = 2;
--our $minor = 11;
-+our $minor = 12;
- our $minor_write = $] >= 5.019 ? 11 : $] > 5.008 ? 9 : $] > 5.005_50 ? 8 : 4;
- 
- use Test::More;
-@@ -206,7 +206,7 @@ sub test_things {
-     $where = $file_magic + $network_magic;
-   }
- 
--  # Just the header and a tag 255. As 33 is currently the highest tag, this
-+  # Just the header and a tag 255. As 34 is currently the highest tag, this
-   # is "unexpected"
-   $copy = substr ($contents, 0, $where) . chr 255;
- 
-@@ -226,7 +226,7 @@ sub test_things {
-   # local $Storable::DEBUGME = 1;
-   # This is the delayed croak
-   test_corrupt ($copy, $sub,
--                "/^Storable binary image v$header->{major}.$minor6 contains data of type 255. This Storable is v$header->{major}.$minor and can only handle data types up to 33/",
-+                "/^Storable binary image v$header->{major}.$minor6 contains data of type 255. This Storable is v$header->{major}.$minor and can only handle data types up to 35/",
-                 "bogus tag, minor plus 4");
-   # And check again that this croak is not delayed:
-   {
--- 
-2.40.1
-

gating.yaml

@@ -1,7 +0,0 @@
---- !Policy
-product_versions:
-  - fedora-*
-decision_context: bodhi_update_push_stable
-subject_type: koji_build
-rules:
-  - !PassingTestCaseRule {test_case_name: fedora-ci.koji-build.tier0.functional}

perl-5.25.7-Fix-Storable-segfaults.patch

@@ -0,0 +1,61 @@
+From fecd3be8dbdb747b9cbf4cbb9299ce40faabc8e6 Mon Sep 17 00:00:00 2001
+From: John Lightsey <lightsey@debian.org>
+Date: Mon, 14 Nov 2016 11:56:15 +0100
+Subject: [PATCH] Fix Storable segfaults.
+
+Fix a null pointed dereference segfault in storable when the
+retrieve_code logic was unable to read the string that contained
+the code.
+
+Also fix several locations where retrieve_other was called with a
+null context pointer. This also resulted in a null pointer
+dereference.
+---
+ dist/Storable/Storable.xs | 10 +++++++---
+ 1 file changed, 7 insertions(+), 3 deletions(-)
+
+diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
+index 053951c..caa489c 100644
+--- a/dist/Storable/Storable.xs
++++ b/dist/Storable/Storable.xs
+@@ -5647,6 +5647,10 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
+ 		CROAK(("Unexpected type %d in retrieve_code\n", type));
+ 	}
+ 
++	if (!text) {
++		CROAK(("Unable to retrieve code\n"));
++	}
++
+ 	/*
+ 	 * prepend "sub " to the source
+ 	 */
+@@ -5767,7 +5771,7 @@ static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, const char *cname)
+ 			continue;			/* av_extend() already filled us with undef */
+ 		}
+ 		if (c != SX_ITEM)
+-			(void) retrieve_other(aTHX_ (stcxt_t *) 0, 0);	/* Will croak out */
++			(void) retrieve_other(aTHX_ cxt, 0);	/* Will croak out */
+ 		TRACEME(("(#%d) item", i));
+ 		sv = retrieve(aTHX_ cxt, 0);						/* Retrieve item */
+ 		if (!sv)
+@@ -5844,7 +5848,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname)
+ 			if (!sv)
+ 				return (SV *) 0;
+ 		} else
+-			(void) retrieve_other(aTHX_ (stcxt_t *) 0, 0);	/* Will croak out */
++			(void) retrieve_other(aTHX_ cxt, 0);	/* Will croak out */
+ 
+ 		/*
+ 		 * Get key.
+@@ -5855,7 +5859,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname)
+ 
+ 		GETMARK(c);
+ 		if (c != SX_KEY)
+-			(void) retrieve_other(aTHX_ (stcxt_t *) 0, 0);	/* Will croak out */
++			(void) retrieve_other(aTHX_ cxt, 0);	/* Will croak out */
+ 		RLEN(size);						/* Get key size */
+ 		KBUFCHK((STRLEN)size);					/* Grow hash key read pool if needed */
+ 		if (size)
+-- 
+2.10.2
+

perl-Storable.spec

@@ -1,43 +1,50 @@
-%global base_version 3.25
+%global base_version 2.51
+
 Name:           perl-Storable
 Epoch:          1
-Version:        3.32
-Release:        502%{?dist}
+Version:        2.56
+Release:        368%{?dist}
 Summary:        Persistence for Perl data structures
-# Storable.pm:  GPL+ or Artistic
-License:        GPL-1.0-or-later OR Artistic-1.0-Perl
-URL:            https://metacpan.org/release/Storable
-Source0:        https://cpan.metacpan.org/authors/id/N/NW/NWCLARK/Storable-%{base_version}.tar.gz
-# Unbundled from perl 5.37.12
-Patch0:         Storable-3.25-Upgrade-to-3.32.patch
+License:        GPL+ or Artistic
+Group:          Development/Libraries
+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
+# Avoid loading optional modules from default . (CVE-2016-1238)
+Patch2:         Storable-2.56-CVE-2016-1238-avoid-loading-optional-modules-from.patch
+# Fix crash in Storable when deserializing malformed code reference, RT#68348,
+# RT130098
+Patch3:         perl-5.25.7-Fix-Storable-segfaults.patch
+# Fix a stack buffer overflow in deserialization of hooks, RT#130635,
+# fixed in perl after 5.25.9
+Patch4:         Storable-2.56-Fix-stack-buffer-overflow-in-deserialization-of-hook.patch
+# Fix a memory leak of a class name from retrieve_hook() on an exception,
+# RT#130635, fixed in perl after 5.25.9
+Patch5:         Storable-2.56-prevent-leak-of-class-name-from-retrieve_hook-on-an-.patch
 BuildRequires:  coreutils
 BuildRequires:  gcc
 BuildRequires:  make
+BuildRequires:  perl
 BuildRequires:  perl-devel
 BuildRequires:  perl-generators
-BuildRequires:  perl-interpreter
 BuildRequires:  perl(Config)
-BuildRequires:  perl(Cwd)
-BuildRequires:  perl(ExtUtils::MakeMaker) >= 6.76
-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
+BuildRequires:  perl(ExtUtils::MakeMaker)
+BuildRequires:  sed
 # Run-time:
+# Carp substitutes missing Log::Agent
 BuildRequires:  perl(Carp)
 BuildRequires:  perl(Exporter)
 # Fcntl is optional, but locking is good
 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(constant)
-BuildRequires:  perl(File::Temp)
 BuildRequires:  perl(integer)
 BuildRequires:  perl(overload)
 BuildRequires:  perl(utf8)
@@ -45,18 +52,19 @@ BuildRequires:  perl(Test::More)
 BuildRequires:  perl(threads)
 BuildRequires:  perl(Safe)
 BuildRequires:  perl(Scalar::Util)
-BuildRequires:  perl(Symbol)
-BuildRequires:  perl(Tie::Array)
+BuildRequires:  perl(strict)
+BuildRequires:  perl(warnings)
 # 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
+Requires:       perl(Carp)
 Requires:       perl(Config)
 # Fcntl is optional, but locking is good
 Requires:       perl(Fcntl)
@@ -64,192 +72,45 @@ Requires:       perl(IO::File)
 
 %{?perl_default_filter}
 
-# Filter modules bundled for tests
-%global __provides_exclude_from %{?__provides_exclude_from:%__provides_exclude_from|}^%{_libexecdir}
-%global __requires_exclude %{?__requires_exclude:%__requires_exclude|}^perl\\(HAS_OVERLOAD\\)
-%global __requires_exclude %{__requires_exclude}|^perl\\(testlib.pl\\)
-
 %description
 The Storable package brings persistence to your Perl data structures
 containing scalar, array, hash or reference objects, i.e. anything that
 can be conveniently stored to disk and retrieved at a later time.
 
-%package tests
-Summary:        Tests for %{name}
-Requires:       %{name} = %{?epoch:%{epoch}:}%{version}-%{release}
-Requires:       perl-Test-Harness
-Requires:       perl(B::Deparse) >= 0.61
-Requires:       perl(Digest::MD5)
-
-%description tests
-Tests from %{name}. Execute them
-with "%{_libexecdir}/%{name}/test".
-
 %prep
-%autosetup -p1 -n Storable-%{base_version}
-
-# Help generators to recognize Perl scripts
-for F in t/*.t t/*.pl; do
-    perl -i -MConfig -ple 'print $Config{startperl} if $. == 1 && !s{\A#!.*perl\b}{$Config{startperl}}' "$F"
-    chmod +x "$F"
-done
+%setup -q -n Storable-%{base_version}
+%patch0 -p1
+%patch1 -p1
+%patch2 -p1
+%patch3 -p3
+%patch4 -p1
+%patch5 -p1
+# Remove bundled modules
+rm -rf t/compat
+sed -i -e '/^t\/compat\//d' MANIFEST
 
 %build
-perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 NO_PERLLOCAL=1 OPTIMIZE="%{optflags}"
-%{make_build}
+# Be ware hints/linux.pl removes "-ON" from CFLAGS if N > 2 because it can
+# break the code.
+perl Makefile.PL INSTALLDIRS=vendor OPTIMIZE="$RPM_OPT_FLAGS"
+make %{?_smp_mflags}
 
 %install
-%{make_install}
-find %{buildroot} -type f -name '*.bs' -size 0 -delete
-find %{buildroot} -type f -name '*.3pm' -size 0 -delete
-%{_fixperms} %{buildroot}/*
-
-# Install tests
-mkdir -p %{buildroot}/%{_libexecdir}/%{name}
-cp -a t %{buildroot}/%{_libexecdir}/%{name}
-cat > %{buildroot}/%{_libexecdir}/%{name}/test << 'EOF'
-#!/bin/bash
-set -e
-# Some tests write into temporary files/directories. The easiest solution
-# is to copy the tests into a writable directory and execute them from there.
-DIR=$(mktemp -d)
-pushd "$DIR"
-cp -a %{_libexecdir}/%{name}/* ./
-prove -I . -j "$(getconf _NPROCESSORS_ONLN)"
-popd
-rm -rf "$DIR"
-EOF
-chmod +x %{buildroot}/%{_libexecdir}/%{name}/test
+make pure_install DESTDIR=$RPM_BUILD_ROOT
+find $RPM_BUILD_ROOT -type f -name .packlist -delete
+find $RPM_BUILD_ROOT -type f -name '*.bs' -size 0 -delete
+%{_fixperms} $RPM_BUILD_ROOT/*
 
 %check
-export HARNESS_OPTIONS=j$(perl -e 'if ($ARGV[0] =~ /.*-j([0-9][0-9]*).*/) {print $1} else {print 1}' -- '%{?_smp_mflags}')
-unset PERL_CORE PERL_TEST_MEMORY PERL_RUN_SLOW_TESTS
 make test
 
 %files
 %doc ChangeLog README
 %{perl_vendorarch}/auto/*
 %{perl_vendorarch}/Storable*
-%{_mandir}/man3/Storable*
-
-%files tests
-%{_libexecdir}/%{name}
+%{_mandir}/man3/*
 
 %changelog
-* Thu Jan 25 2024 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.32-502
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_40_Mass_Rebuild
-
-* Sun Jan 21 2024 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.32-501
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_40_Mass_Rebuild
-
-* Fri Jul 21 2023 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.32-500
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_39_Mass_Rebuild
-
-* Tue Jul 11 2023 Jitka Plesnikova <jplesnik@redhat.com> - 1:3.32-499
-- Increase release to favour standalone package
-
-* Mon Jun 12 2023 Jitka Plesnikova <jplesnik@redhat.com> - 1:3.32-1
-- Upgrade to 3.32 as provided in perl-5.37.12
-
-* Thu May 18 2023 Jitka Plesnikova <jplesnik@redhat.com> - 1:3.31-1
-- Upgrade to 3.31 as provided in perl-5.37.11
-
-* Fri Jan 20 2023 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.26-490
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_38_Mass_Rebuild
-
-* Fri Jul 22 2022 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.26-489
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_37_Mass_Rebuild
-
-* Mon May 30 2022 Jitka Plesnikova <jplesnik@redhat.com> - 1:3.26-488
-- Upgrade to 3.26 as provided in perl-5.35.11
-
-* Fri Jan 21 2022 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.25-2
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_36_Mass_Rebuild
-
-* Mon Aug 30 2021 Jitka Plesnikova <jplesnik@redhat.com> - 1:3.25-1
-- 3.25 bump
-- Package tests
-
-* Thu Jul 22 2021 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.23-478
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_35_Mass_Rebuild
-
-* Fri May 21 2021 Jitka Plesnikova <jplesnik@redhat.com> - 1:3.23-477
-- Upgrade to 3.23 as provided in perl-5.34.0
-
-* Wed Jan 27 2021 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.21-458
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_34_Mass_Rebuild
-
-* Tue Jul 28 2020 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.21-457
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_33_Mass_Rebuild
-
-* Mon Jun 22 2020 Jitka Plesnikova <jplesnik@redhat.com> - 1:3.21-456
-- Upgrade to 3.21 as provided in perl-5.32.0
-
-* Thu Jan 30 2020 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.15-443
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_32_Mass_Rebuild
-
-* Mon Nov 25 2019 Petr Pisar <ppisar@redhat.com> - 1:3.15-442
-- 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-441
-- Fix array length check in a store hook
-
-* Fri Jul 26 2019 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.15-440
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_31_Mass_Rebuild
-
-* Tue Jun 11 2019 Petr Pisar <ppisar@redhat.com> - 1:3.15-439
-- Fix deep cloning regular expression objects (RT#134179)
-
-* Thu May 30 2019 Jitka Plesnikova <jplesnik@redhat.com> - 1:3.15-438
-- Increase release to favour standalone package
-
-* Wed Apr 24 2019 Petr Pisar <ppisar@redhat.com> - 1:3.15-1
-- 3.15 bump
-
-* Sat Feb 02 2019 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.11-7
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_30_Mass_Rebuild
-
-* Mon Jan 07 2019 Petr Pisar <ppisar@redhat.com> - 1:3.11-6
-- Storable-3.11 source archive repackaged without a t/CVE-2015-1592.inc file
-  (RT#133706)
-
-* Mon Aug 27 2018 Petr Pisar <ppisar@redhat.com> - 1:3.11-5
-- Fix recursion check (RT#133326)
-
-* Fri Jul 13 2018 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.11-4
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_29_Mass_Rebuild
-
-* Tue Jun 26 2018 Jitka Plesnikova <jplesnik@redhat.com> - 1:3.11-3
-- Perl 5.28 rebuild
-
-* 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
-
-* Fri Feb 09 2018 Fedora Release Engineering <releng@fedoraproject.org> - 1:2.62-396
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_28_Mass_Rebuild
-
-* 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
-
-* Thu Jul 27 2017 Fedora Release Engineering <releng@fedoraproject.org> - 1:2.62-394
-- Rebuilt for https://fedoraproject.org/wiki/Fedora_27_Mass_Rebuild
-
-* Sat Jun 03 2017 Jitka Plesnikova <jplesnik@redhat.com> - 1:2.62-393
-- Perl 5.26 rebuild
-
-* Thu May 11 2017 Petr Pisar <ppisar@redhat.com> - 1:2.62-1
-- Upgrade to 2.62 as provided in perl-5.25.12
-
 * Mon Feb 06 2017 Petr Pisar <ppisar@redhat.com> - 1:2.56-368
 - Fix a stack buffer overflow in deserialization of hooks (RT#130635)
 - Fix a memory leak of a class name from retrieve_hook() on an exception

plans/sanity.fmf

@@ -1,5 +0,0 @@
-summary: Sanity tests
-discover:
-    how: fmf
-execute:
-    how: tmt

sources

@@ -1 +1 @@
-SHA512 (Storable-3.25.tar.gz) = a1e0342061bc3fbe04e1041c94004c6dc2fbee10ab49939fe93fa84696829aa32896e6af234a33743c6ecd9e5b0c2e2c623428207e0f04dc01b31caa87f8d73c
+48082965a6403a8c5adcd42aeb0c58e5  Storable-2.51.tar.gz

tests/upstream-tests.fmf

@@ -1,4 +0,0 @@
-summary: Upstream tests
-component: perl-Storable
-require: perl-Storable-tests
-test: /usr/libexec/perl-Storable/test