rpms
/
perl-Storable
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

3.25 bump

This commit is contained in:
Jitka Plesnikova 2021-08-30 14:19:32 +02:00
parent b93ba647e6
commit 398811b883
8 changed files with 9 additions and 1126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -6,3 +6,4 @@
/Storable-3.11.tar.gz
/Storable-3.11_repackaged.tar.gz
/Storable-3.15.tar.gz
/Storable-3.25.tar.gz

476
Storable-3.15-Upgrade-to-3.21.patch
View File

@ -1,476 +0,0 @@
From 0452589669aed9ad06940de7c1620b340608868a Mon Sep 17 00:00:00 2001
From: Jitka Plesnikova <jplesnik@redhat.com>
Date: Mon, 1 Jun 2020 12:58:11 +0200
Subject: [PATCH] Upgrade to 3.21
---
ChangeLog | 33 ++++++++++++++++++-
MANIFEST | 3 +-
Makefile.PL | 59 +++++++++++++---------------------
__Storable__.pm => Storable.pm | 23 +++++++------
Storable.pm.PL | 35 --------------------
Storable.xs | 20 ++++++++----
stacksize | 2 +-
t/attach_errors.t | 2 +-
t/huge.t | 4 +--
t/recurse.t | 4 +--
t/regexp.t | 8 ++---
11 files changed, 93 insertions(+), 100 deletions(-)
rename __Storable__.pm => Storable.pm (99%)
delete mode 100644 Storable.pm.PL
diff --git a/ChangeLog b/ChangeLog
index 0488199..bf35381 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,34 @@
+2010-01-27 10:27:00 TonyC
+ version 3.20
+ * fix a format string and arguments for some debugging text
+ * linkify references to alternatives to Storable
+
+2020-01-27 11:01:00 TonyC
+ version 3.19
+ * add casts to match some I32 parameters to "%d" formats (#17339)
+ * fix dependencies in Makefile.PL -> META (#17422)
+ * make use of note() optional, this requires a newer version of
+ Test::More and there's a circular dependency between later
+ versions of Test::More and Storable (#17422)
+
+2019-11-19 07:59:39 TonyC
+ version 3.18
+ * update bug tracker to point at github (#17298)
+ * disallow vstring magic strings over 2GB-1 (#17306)
+ * mark some ASCII dependent tests as ASCII platform only
+
+2019-08-08 11:48:00 TonyC
+ version 3.17
+ * correct a data type to ensure the check for too large results from
+ STORABLE_freeze() are detected correctly (detected by Coverity)
+ * removed remains of stack size detection from the build process.
+ * moved CAN_FLOCK detection into XS to simplify the build process.
+
+2019-06-11 10:43:00 TonyC
+ version 3.16
+ * (perl #134179) fix self-referencing structures that include regexps
+ * bless regexps to preserve bless qr//, "Foo"
+
2019-04-23 16:00:00 xsawyerx
version 3.15
* Fix leaking.
@@ -341,7 +372,7 @@ Sat Mar 13 20:11:03 GMT 2004 Nicholas Clark <nick@ccl4.org>
Version 2.11
1. Storing restricted hashes in canonical order would SEGV. Fixed.
- 2. It was impossible to retrieve references to PL_sv_no and and
+ 2. It was impossible to retrieve references to PL_sv_no and
PL_sv_undef from STORABLE_thaw hooks.
3. restrict.t was failing on 5.8.0, due to 5.8.0's unique
implementation of restricted hashes using PL_sv_undef
diff --git a/MANIFEST b/MANIFEST
index d30b94e..5e382d9 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,4 +1,3 @@
-__Storable__.pm
ChangeLog
hints/gnukfreebsd.pl
hints/gnuknetbsd.pl
@@ -11,7 +10,7 @@ META.yml Module meta-data (added by MakeMaker)
ppport.h
README
stacksize
-Storable.pm.PL
+Storable.pm
Storable.xs
t/attach.t
t/attach_errors.t
diff --git a/Makefile.PL b/Makefile.PL
index 4a39125..e03e141 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -10,43 +10,48 @@ use strict;
use warnings;
use ExtUtils::MakeMaker 6.31;
use Config;
-use File::Copy qw(move copy);
-use File::Spec;
-
-my $pm = { 'Storable.pm' => '$(INST_ARCHLIB)/Storable.pm' };
WriteMakefile(
NAME => 'Storable',
AUTHOR => 'Perl 5 Porters',
LICENSE => 'perl',
DISTNAME => "Storable",
-# We now ship this in t/
-# PREREQ_PM => { 'Test::More' => '0.41' },
- PL_FILES => { }, # prevent default behaviour
- PM => $pm,
- PREREQ_PM => { XSLoader => 0 },
+ PREREQ_PM =>
+ {
+ XSLoader => 0,
+ },
+ ( $ExtUtils::MakeMaker::VERSION >= 6.64 ?
+ (
+ CONFIGURE_REQUIRES => {
+ 'ExtUtils::MakeMaker' => '6.31',
+ },
+ BUILD_REQUIRES => {
+ 'ExtUtils::MakeMaker' => '6.31',
+ },
+ TEST_REQUIRES => {
+ 'Test::More' => '0.41',
+ },
+ )
+ : () ),
INSTALLDIRS => ($] >= 5.007 && $] < 5.012) ? 'perl' : 'site',
- VERSION_FROM => '__Storable__.pm',
- ABSTRACT_FROM => '__Storable__.pm',
+ VERSION_FROM => 'Storable.pm',
+ ABSTRACT_FROM => 'Storable.pm',
($ExtUtils::MakeMaker::VERSION > 6.45 ?
(META_MERGE => { resources =>
- { bugtracker => 'http://rt.perl.org/perlbug/' },
+ { bugtracker => 'https://github.com/Perl/perl5/issues' },
provides => {
'Storable' => {
- file => '__Storable__.pm',
- version => MM->parse_version('__Storable__.pm'),
+ file => 'Storable.pm',
+ version => MM->parse_version('Storable.pm'),
},
},
},
) : ()),
dist => { SUFFIX => 'gz', COMPRESS => 'gzip -f' },
- clean => { FILES => 'Storable-* Storable.pm lib' },
+ clean => { FILES => 'Storable-*' },
);
-# Unlink the .pm file included with the distribution
-1 while unlink "Storable.pm";
-
my $ivtype = $Config{ivtype};
# I don't know if the VMS folks ever supported long long on 5.6.x
@@ -67,16 +72,8 @@ in the Storable documentation for instructions on how to read your data.
EOM
}
-# compute the maximum stacksize, before and after linking
package MY;
-# FORCE finish of INST_DYNAMIC, avoid loading the old Storable (failed XS_VERSION check)
-sub xlinkext {
- my $s = shift->SUPER::linkext(@_);
- $s =~ s|( :: .*)| $1 FORCE stacksize|;
- $s
-}
-
sub depend {
"
@@ -87,13 +84,3 @@ release : dist
git push --tags
"
}
-
-sub postamble {
-'
-all :: Storable.pm
- $(NOECHO) $(NOOP)
-
-Storable.pm :: Storable.pm.PL __Storable__.pm
- $(PERLRUN) Storable.pm.PL
-'
-}
diff --git a/__Storable__.pm b/Storable.pm
similarity index 99%
rename from __Storable__.pm
rename to Storable.pm
index 9237371..1a750f1 100644
--- a/__Storable__.pm
+++ b/Storable.pm
@@ -8,7 +8,7 @@
# in the README file that comes with the distribution.
#
-require XSLoader;
+BEGIN { require XSLoader }
require Exporter;
package Storable;
@@ -27,7 +27,9 @@ our @EXPORT_OK = qw(
our ($canonical, $forgive_me);
-our $VERSION = '3.15';
+BEGIN {
+ our $VERSION = '3.21';
+}
our $recursion_limit;
our $recursion_limit_hash;
@@ -104,14 +106,12 @@ $Storable::flags = FLAGS_COMPAT;
$Storable::downgrade_restricted = 1;
$Storable::accept_future_minor = 1;
-XSLoader::load('Storable');
+BEGIN { XSLoader::load('Storable') };
#
# Determine whether locking is possible, but only when needed.
#
-sub CAN_FLOCK; # TEMPLATE - replaced by Storable.pm.PL
-
sub show_file_magic {
print <<EOM;
#
@@ -266,7 +266,7 @@ sub _store {
local *FILE;
if ($use_locking) {
open(FILE, ">>", $file) || logcroak "can't write into $file: $!";
- unless (&CAN_FLOCK) {
+ unless (CAN_FLOCK) {
logcarp
"Storable::lock_store: fcntl/flock emulation broken on $^O";
return undef;
@@ -410,7 +410,7 @@ sub _retrieve {
my $self;
my $da = $@; # Could be from exception handler
if ($use_locking) {
- unless (&CAN_FLOCK) {
+ unless (CAN_FLOCK) {
logcarp
"Storable::lock_store: fcntl/flock emulation broken on $^O";
return undef;
@@ -986,6 +986,9 @@ modifying C<$Storable::recursion_limit> and
C<$Storable::recursion_limit_hash> respectively. Either can be set to
C<-1> to prevent any depth checks, though this isn't recommended.
+If you want to test what the limits are, the F<stacksize> tool is
+included in the C<Storable> distribution.
+
=item *
You can create endless loops if the things you serialize via freeze()
@@ -1224,9 +1227,9 @@ 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, Cpanel::JSON::XS, Data::MessagePack or Serial are the best
-choices and offers maximum interoperability, but note that Serial is
-unsafe by default.
+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>.
=head1 WARNING
diff --git a/Storable.pm.PL b/Storable.pm.PL
deleted file mode 100644
index df979c0..0000000
--- a/Storable.pm.PL
+++ /dev/null
@@ -1,35 +0,0 @@
-use strict;
-use warnings;
-
-use Config;
-
-my $template;
-{ # keep all the code in an external template to keep it easy to update
- local $/;
- open my $FROM, '<', '__Storable__.pm' or die $!;
- $template = <$FROM>;
- close $FROM or die $!;
-}
-
-sub CAN_FLOCK {
- return
- $Config{'d_flock'} ||
- $Config{'d_fcntl_can_lock'} ||
- $Config{'d_lockf'}
- ? 1 : 0;
-}
-
-my $CAN_FLOCK = CAN_FLOCK();
-
-# populate the sub and preserve it if used outside
-$template =~ s{^sub CAN_FLOCK;.*$}{sub CAN_FLOCK { ${CAN_FLOCK} } # computed by Storable.pm.PL}m;
-# alternatively we could remove the sub
-#$template =~ s{^sub CAN_FLOCK;.*$}{}m;
-# replace local function calls to hardcoded value
-$template =~ s{&CAN_FLOCK}{${CAN_FLOCK}}g;
-
-{
- open my $OUT, '>', 'Storable.pm' or die $!;
- print {$OUT} $template or die $!;
- close $OUT or die $!;
-}
diff --git a/Storable.xs b/Storable.xs
index e1f0b88..4c4c268 100644
--- a/Storable.xs
+++ b/Storable.xs
@@ -104,6 +104,12 @@
# define strEQc(s,c) memEQ(s, ("" c ""), sizeof(c))
#endif
+#if defined(HAS_FLOCK) || defined(FCNTL_CAN_LOCK) && defined(HAS_LOCKF)
+#define CAN_FLOCK &PL_sv_yes
+#else
+#define CAN_FLOCK &PL_sv_no
+#endif
+
#ifdef DEBUGME
#ifndef DASSERT
@@ -726,8 +732,8 @@ static stcxt_t *Context_ptr = NULL;
STRLEN nsz = (STRLEN) round_mgrow((x)+msiz); \
STRLEN offset = mptr - mbase; \
ASSERT(!cxt->membuf_ro, ("mbase is not read-only")); \
- TRACEME(("** extending mbase from %ld to %ld bytes (wants %ld new)", \
- (long)msiz, nsz, (long)(x))); \
+ TRACEME(("** extending mbase from %lu to %lu bytes (wants %lu new)", \
+ (unsigned long)msiz, (unsigned long)nsz, (unsigned long)(x))); \
Renew(mbase, nsz, char); \
msiz = nsz; \
mptr = mbase + offset; \
@@ -3085,7 +3091,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
len = HEK_LEN(hek);
if (len == HEf_SVKEY) {
/* This is somewhat sick, but the internal APIs are
- * such that XS code could put one of these in in
+ * such that XS code could put one of these in
* a regular hash.
* Maybe we should be capable of storing one if
* found.
@@ -3437,7 +3443,7 @@ static int get_regexp(pTHX_ stcxt_t *cxt, SV* sv, SV **re, SV **flags) {
count = call_sv((SV*)cv, G_ARRAY);
SPAGAIN;
if (count < 2)
- CROAK(("re::regexp_pattern returned only %d results", count));
+ CROAK(("re::regexp_pattern returned only %d results", (int)count));
*flags = POPs;
SvREFCNT_inc(*flags);
*re = POPs;
@@ -5952,7 +5958,7 @@ static SV *retrieve_lvstring(pTHX_ stcxt_t *cxt, const char *cname)
}
New(10003, s, len+1, char);
- SAFEPVREAD(s, len, s);
+ SAFEPVREAD(s, (I32)len, s);
sv = retrieve(aTHX_ cxt, cname);
if (!sv) {
@@ -6858,7 +6864,7 @@ static SV *retrieve_regexp(pTHX_ stcxt_t *cxt, const char *cname) {
SPAGAIN;
if (count != 1)
- CROAK(("Bad count %d calling _make_re", count));
+ CROAK(("Bad count %d calling _make_re", (int)count));
re_ref = POPs;
@@ -7807,6 +7813,8 @@ BOOT:
newCONSTSUB(stash, "BIN_MINOR", newSViv(STORABLE_BIN_MINOR));
newCONSTSUB(stash, "BIN_WRITE_MINOR", newSViv(STORABLE_BIN_WRITE_MINOR));
+ newCONSTSUB(stash, "CAN_FLOCK", CAN_FLOCK);
+
init_perinterp(aTHX);
gv_fetchpv("Storable::drop_utf8", GV_ADDMULTI, SVt_PV);
#ifdef DEBUGME
diff --git a/stacksize b/stacksize
index f93eccc..2896684 100644
--- a/stacksize
+++ b/stacksize
@@ -161,7 +161,7 @@ my $max_depth_hash = $n;
# instead so a user setting of either variable more closely matches
# the limits the use sees.
-# be fairly aggressive in trimming this, smoke testing showed several
+# be fairly aggressive in trimming this, smoke testing showed
# several apparently random failures here, eg. working in one
# configuration, but not in a very similar configuration.
$max_depth = int(0.6 * $max_depth);
diff --git a/t/attach_errors.t b/t/attach_errors.t
index 0ed7c8d..e2be39d 100644
--- a/t/attach_errors.t
+++ b/t/attach_errors.t
@@ -94,7 +94,7 @@ use Storable ();
# Error 2
#
# If, for some reason, a STORABLE_attach object is accidentally stored
-# with references, this should be checked and and error should be throw.
+# with references, this should be checked and an error should be thrown.
diff --git a/t/huge.t b/t/huge.t
index d28e238..09b173e 100644
--- a/t/huge.t
+++ b/t/huge.t
@@ -63,7 +63,7 @@ if ($Config{ptrsize} > 4 and !$has_too_many) {
[ 'huge array',
sub { my @x; $x[$huge] = undef; \@x } ];
} else {
- diag "skip huge array, need PERL_TEST_MEMORY >= 8";
+ diag "skip huge array, need PERL_TEST_MEMORY >= 55";
}
}
@@ -78,7 +78,7 @@ if (!$has_too_many) {
['huge hash',
sub { my %x = (0 .. $huge); \%x } ];
} else {
- diag "skip huge hash, need PERL_TEST_MEMORY >= 16";
+ diag "skip huge hash, need PERL_TEST_MEMORY >= 96";
}
}
diff --git a/t/recurse.t b/t/recurse.t
index b5967a0..6f82169 100644
--- a/t/recurse.t
+++ b/t/recurse.t
@@ -347,7 +347,7 @@ sub MAX_DEPTH_HASH () { Storable::stack_depth_hash() }
eval {
my $t;
$t = [$t] for 1 .. MAX_DEPTH*2;
- note 'trying catching recursive aref stack overflow';
+ eval { note('trying catching recursive aref stack overflow') };
dclone $t;
};
like $@, qr/Max\. recursion depth with nested structures exceeded/,
@@ -362,7 +362,7 @@ else {
my $t;
# 35.000 will cause appveyor 64bit windows to fail earlier
$t = {1=>$t} for 1 .. MAX_DEPTH * 2;
- note 'trying catching recursive href stack overflow';
+ eval { note('trying catching recursive href stack overflow') };
dclone $t;
};
like $@, qr/Max\. recursion depth with nested structures exceeded/,
diff --git a/t/regexp.t b/t/regexp.t
index e7c6c7e..6c6b1d5 100644
--- a/t/regexp.t
+++ b/t/regexp.t
@@ -123,7 +123,7 @@ __DATA__
A-; qr(\x2E) ; ".", !"a" ; \x2E - hex meta
-; qr/\./ ; "." , !"a" ; \. - backslash meta
8- ; qr/\x{100}/ ; "\x{100}" ; simple unicode
-12- ; qr/fss/i ; "f\xDF\x{101}" ; case insensive unicode promoted
-22-; qr/fss/ui ; "f\xDF" ; case insensitive unicode SS /iu
-22-; qr/fss/aai ; !"f\xDF" ; case insensitive unicode SS /iaa
-22-; qr/f\w/a ; "fo", !"f\xff" ; simple /a flag
+A12- ; qr/fss/i ; "f\xDF\x{101}" ; case insensive unicode promoted
+A22-; qr/fss/ui ; "f\xDF" ; case insensitive unicode SS /iu
+A22-; qr/fss/aai ; !"f\xDF" ; case insensitive unicode SS /iaa
+A22-; qr/f\w/a ; "fo", !"f\xff" ; simple /a flag
--
2.25.4

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

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

53
Storable-3.16-Storable-make-count-large-enough.patch
View File

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

416
Storable-3.21-Upgrade-to-3.23.patch
View File

@ -1,416 +0,0 @@
From 90102878a84e4b4a2180a83ccaaef3a3c00bbc8a Mon Sep 17 00:00:00 2001
From: Jitka Plesnikova <jplesnik@redhat.com>
Date: Thu, 6 May 2021 09:15:58 +0200
Subject: [PATCH] Upgrade to 3.23
---
Storable.pm | 4 +--
Storable.xs | 94 +++++++++++++++++++++++++--------------------------
t/canonical.t | 2 +-
t/malice.t | 6 ++--
4 files changed, 52 insertions(+), 54 deletions(-)
diff --git a/Storable.pm b/Storable.pm
index 1a750f1..27c9cf5 100644
--- a/Storable.pm
+++ b/Storable.pm
@@ -28,7 +28,7 @@ our @EXPORT_OK = qw(
our ($canonical, $forgive_me);
BEGIN {
- our $VERSION = '3.21';
+ our $VERSION = '3.23';
}
our $recursion_limit;
@@ -1423,7 +1423,7 @@ Murray Nesbitt made Storable thread-safe. Marc Lehmann added overloading
and references to tied items support. Benjamin Holzman added a performance
improvement for overloaded classes; thanks to Grant Street Group for footing
the bill.
-Reini Urban took over maintainance from p5p, and added security fixes
+Reini Urban took over maintenance from p5p, and added security fixes
and huge object support.
=head1 AUTHOR
diff --git a/Storable.xs b/Storable.xs
index 4c4c268..70dddf3 100644
--- a/Storable.xs
+++ b/Storable.xs
@@ -16,18 +16,16 @@
#include <perl.h>
#include <XSUB.h>
-#ifndef PATCHLEVEL
-#include <patchlevel.h> /* Perl's one, needed since 5.6 */
-#endif
-
-#if !defined(PERL_VERSION) || 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
+#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
#include "ppport.h" /* handle old perls */
#endif
@@ -521,7 +519,7 @@ static MAGIC *THX_sv_magicext(pTHX_
#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI)
-#if (PATCHLEVEL <= 4) && (SUBVERSION < 68)
+#if PERL_VERSION_LT(5,4,68)
#define dSTCXT_SV \
SV *perinterp_sv = get_sv(MY_VERSION, 0)
#else /* >= perl5.004_68 */
@@ -1012,22 +1010,22 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
#define STORABLE_BIN_MAJOR 2 /* Binary major "version" */
#define STORABLE_BIN_MINOR 11 /* Binary minor "version" */
-#if (PATCHLEVEL <= 5)
+#if PERL_VERSION_LT(5,6,0)
#define STORABLE_BIN_WRITE_MINOR 4
#elif !defined (SvVOK)
/*
* Perl 5.6.0-5.8.0 can do weak references, but not vstring magic.
*/
#define STORABLE_BIN_WRITE_MINOR 8
-#elif PATCHLEVEL >= 19
+#elif PERL_VERSION_GE(5,19,0)
/* Perl 5.19 takes away the special meaning of PL_sv_undef in arrays. */
/* With 3.x we added LOBJECT */
#define STORABLE_BIN_WRITE_MINOR 11
#else
#define STORABLE_BIN_WRITE_MINOR 9
-#endif /* (PATCHLEVEL <= 5) */
+#endif /* PERL_VERSION_LT(5,6,0) */
-#if (PATCHLEVEL < 8 || (PATCHLEVEL == 8 && SUBVERSION < 1))
+#if PERL_VERSION_LT(5,8,1)
#define PL_sv_placeholder PL_sv_undef
#endif
@@ -1354,7 +1352,7 @@ static U32 Sntohl(U32 x) {
* sortsv is not available ( <= 5.6.1 ).
*/
-#if (PATCHLEVEL <= 6)
+#if PERL_VERSION_LT(5,7,0)
#if defined(USE_ITHREADS)
@@ -1373,12 +1371,12 @@ static U32 Sntohl(U32 x) {
#endif /* USE_ITHREADS */
-#else /* PATCHLEVEL > 6 */
+#else /* PERL >= 5.7.0 */
#define STORE_HASH_SORT \
sortsv(AvARRAY(av), len, Perl_sv_cmp);
-#endif /* PATCHLEVEL <= 6 */
+#endif /* PERL_VERSION_LT(5,7,0) */
static int store(pTHX_ stcxt_t *cxt, SV *sv);
static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname);
@@ -1650,7 +1648,7 @@ static void init_store_context(pTHX_
*
* It is reported fixed in 5.005, hence the #if.
*/
-#if PERL_VERSION >= 5
+#if PERL_VERSION_GE(5,5,0)
#define HBUCKETS 4096 /* Buckets for %hseen */
#ifndef USE_PTR_TABLE
HvMAX(cxt->hseen) = HBUCKETS - 1; /* keys %hseen = $HBUCKETS; */
@@ -1667,7 +1665,7 @@ static void init_store_context(pTHX_
cxt->hclass = newHV(); /* Where seen classnames are stored */
-#if PERL_VERSION >= 5
+#if PERL_VERSION_GE(5,5,0)
HvMAX(cxt->hclass) = HBUCKETS - 1; /* keys %hclass = $HBUCKETS; */
#endif
@@ -2244,7 +2242,7 @@ static AV *array_call(pTHX_
return av;
}
-#if PERL_VERSION < 15
+#if PERL_VERSION_LT(5,15,0)
static void
cleanup_recursive_av(pTHX_ AV* av) {
SSize_t i = AvFILLp(av);
@@ -2252,7 +2250,7 @@ cleanup_recursive_av(pTHX_ AV* av) {
if (SvMAGICAL(av)) return;
while (i >= 0) {
if (arr[i]) {
-#if PERL_VERSION < 14
+#if PERL_VERSION_LT(5,14,0)
arr[i] = NULL;
#else
SvREFCNT_dec(arr[i]);
@@ -2283,7 +2281,7 @@ cleanup_recursive_hv(pTHX_ HV* hv) {
}
i--;
}
-#if PERL_VERSION < 8
+#if PERL_VERSION_LT(5,8,0)
((XPVHV*)SvANY(hv))->xhv_array = NULL;
#else
HvARRAY(hv) = NULL;
@@ -2394,7 +2392,7 @@ static int store_ref(pTHX_ stcxt_t *cxt, 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
+#if PERL_VERSION_LT(5,15,0)
cleanup_recursive_data(aTHX_ (SV*)sv);
#endif
CROAK((MAX_DEPTH_ERROR));
@@ -2498,7 +2496,7 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
/* public string - go direct to string read. */
goto string_readlen;
} else if (
-#if (PATCHLEVEL <= 6)
+#if PERL_VERSION_LT(5,7,0)
/* For 5.6 and earlier NV flag trumps IV flag, so only use integer
direct if NV flag is off. */
(flags & (SVf_NOK | SVf_IOK)) == SVf_IOK
@@ -2576,7 +2574,7 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
*/
Zero(&nv, 1, NV_bytes);
#endif
-#if (PATCHLEVEL <= 6)
+#if PERL_VERSION_LT(5,7,0)
nv.nv = SvNV(sv);
/*
* Watch for number being an integer in disguise.
@@ -2699,7 +2697,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
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
+#if PERL_VERSION_LT(5,15,0)
cleanup_recursive_data(aTHX_ (SV*)av);
#endif
CROAK((MAX_DEPTH_ERROR));
@@ -2717,7 +2715,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
STORE_SV_UNDEF();
continue;
}
-#if PATCHLEVEL >= 19
+#if PERL_VERSION_GE(5,19,0)
/* In 5.19.3 and up, &PL_sv_undef can actually be stored in
* an array; it no longer represents nonexistent elements.
* Historically, we have used SX_SV_UNDEF in arrays for
@@ -2748,7 +2746,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
}
-#if (PATCHLEVEL <= 6)
+#if PERL_VERSION_LT(5,7,0)
/*
* sortcmp
@@ -2765,7 +2763,7 @@ sortcmp(const void *a, const void *b)
return sv_cmp(*(SV * const *) a, *(SV * const *) b);
}
-#endif /* PATCHLEVEL <= 6 */
+#endif /* PERL_VERSION_LT(5,7,0) */
/*
* store_hash
@@ -2861,7 +2859,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
++cxt->recur_depth;
}
if (RECURSION_TOO_DEEP_HASH()) {
-#if PERL_VERSION < 15
+#if PERL_VERSION_LT(5,15,0)
cleanup_recursive_data(aTHX_ (SV*)hv);
#endif
CROAK((MAX_DEPTH_ERROR));
@@ -3275,7 +3273,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
++cxt->recur_depth;
}
if (RECURSION_TOO_DEEP_HASH()) {
-#if PERL_VERSION < 15
+#if PERL_VERSION_LT(5,15,0)
cleanup_recursive_data(aTHX_ (SV*)hv);
#endif
CROAK((MAX_DEPTH_ERROR));
@@ -3311,7 +3309,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
*/
static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
{
-#if PERL_VERSION < 6
+#if PERL_VERSION_LT(5,6,0)
/*
* retrieve_code does not work with perl 5.005 or less
*/
@@ -3410,10 +3408,10 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
#endif
}
-#if PERL_VERSION < 8
+#if PERL_VERSION_LT(5,8,0)
# define PERL_MAGIC_qr 'r' /* precompiled qr// regex */
# define BFD_Svs_SMG_OR_RMG SVs_RMG
-#elif ((PERL_VERSION==8) && (PERL_SUBVERSION >= 1) || (PERL_VERSION>8))
+#elif PERL_VERSION_GE(5,8,1)
# define BFD_Svs_SMG_OR_RMG SVs_SMG
# define MY_PLACEHOLDER PL_sv_placeholder
#else
@@ -3424,7 +3422,7 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
static int get_regexp(pTHX_ stcxt_t *cxt, SV* sv, SV **re, SV **flags) {
dSP;
SV* rv;
-#if PERL_VERSION >= 12
+#if PERL_VERSION_GE(5,12,0)
CV *cv = get_cv("re::regexp_pattern", 0);
#else
CV *cv = get_cv("Storable::_regexp_pattern", 0);
@@ -4286,7 +4284,7 @@ static int sv_type(pTHX_ SV *sv)
{
switch (SvTYPE(sv)) {
case SVt_NULL:
-#if PERL_VERSION <= 10
+#if PERL_VERSION_LT(5,11,0)
case SVt_IV:
#endif
case SVt_NV:
@@ -4296,7 +4294,7 @@ static int sv_type(pTHX_ SV *sv)
*/
return svis_SCALAR;
case SVt_PV:
-#if PERL_VERSION <= 10
+#if PERL_VERSION_LT(5,11,0)
case SVt_RV:
#else
case SVt_IV:
@@ -4314,7 +4312,7 @@ static int sv_type(pTHX_ SV *sv)
*/
return SvROK(sv) ? svis_REF : svis_SCALAR;
case SVt_PVMG:
-#if PERL_VERSION <= 10
+#if PERL_VERSION_LT(5,11,0)
if ((SvFLAGS(sv) & (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
== (SVs_OBJECT|BFD_Svs_SMG_OR_RMG)
&& mg_find(sv, PERL_MAGIC_qr)) {
@@ -4327,7 +4325,7 @@ static int sv_type(pTHX_ SV *sv)
(mg_find(sv, 'p')))
return svis_TIED_ITEM;
/* FALL THROUGH */
-#if PERL_VERSION < 9
+#if PERL_VERSION_LT(5,9,0)
case SVt_PVBM:
#endif
if ((SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) ==
@@ -4345,10 +4343,10 @@ static int sv_type(pTHX_ SV *sv)
return svis_HASH;
case SVt_PVCV:
return svis_CODE;
-#if PERL_VERSION > 8
+#if PERL_VERSION_GE(5,9,0)
/* case SVt_INVLIST: */
#endif
-#if PERL_VERSION > 10
+#if PERL_VERSION_GE(5,11,0)
case SVt_REGEXP:
return svis_REGEXP;
#endif
@@ -6689,7 +6687,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname)
*/
static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
{
-#if PERL_VERSION < 6
+#if PERL_VERSION_LT(5,6,0)
CROAK(("retrieve_code does not work with perl 5.005 or less\n"));
#else
dSP;
@@ -6817,7 +6815,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
}
static SV *retrieve_regexp(pTHX_ stcxt_t *cxt, const char *cname) {
-#if PERL_VERSION >= 8
+#if PERL_VERSION_GE(5,8,0)
int op_flags;
U32 re_len;
STRLEN flags_len;
@@ -7582,7 +7580,7 @@ static SV *do_retrieve(
if (!sv) {
TRACEMED(("retrieve ERROR"));
-#if (PATCHLEVEL <= 4)
+#if PERL_VERSION_LT(5,5,0)
/* perl 5.00405 seems to screw up at this point with an
'attempt to modify a read only value' error reported in the
eval { $self = pretrieve(*FILE) } in _retrieve.
@@ -7712,7 +7710,7 @@ static SV *dclone(pTHX_ SV *sv)
*/
if ((SvTYPE(sv) == SVt_PVLV
-#if PERL_VERSION < 8
+#if PERL_VERSION_LT(5,8,0)
|| SvTYPE(sv) == SVt_PVMG
#endif
) && (SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) ==
diff --git a/t/canonical.t b/t/canonical.t
index f7791ce..3b930aa 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/malice.t b/t/malice.t
index 5888863..8adae95 100644
--- a/t/malice.t
+++ b/t/malice.t
@@ -63,7 +63,7 @@ sub test_hash {
is (ref $clone, "HASH", "Get hash back");
is (scalar keys %$clone, 1, "with 1 key");
is ((keys %$clone)[0], "perl", "which is correct");
- is ($clone->{perl}, "rules");
+ is ($clone->{perl}, "rules", "Got expected value when looking up key in clone");
}
sub test_header {
@@ -238,7 +238,7 @@ sub test_things {
}
}
-ok (defined store(\%hash, $file));
+ok (defined store(\%hash, $file), "store() returned defined value");
my $expected = 20 + length ($file_magic_str) + $other_magic + $fancy;
my $length = -s $file;
@@ -266,7 +266,7 @@ test_things($stored, \&freeze_and_thaw, 'string');
# Network order.
unlink $file or die "Can't unlink '$file': $!";
-ok (defined nstore(\%hash, $file));
+ok (defined nstore(\%hash, $file), "nstore() returned defined value");
$expected = 20 + length ($file_magic_str) + $network_magic + $fancy;
$length = -s $file;
--
2.30.2

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

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

28
perl-Storable.spec
View File

@ -1,25 +1,13 @@
%global base_version 3.15
%global base_version 3.25
Name: perl-Storable
Epoch: 1
Version: 3.23
Release: 478%{?dist}
Version: %{base_version}
Release: 1%{?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-%{base_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
# Unbundled from perl 5.32.0
Patch3: Storable-3.15-Upgrade-to-3.21.patch
# Unbundled from perl 5.34.0
Patch4: Storable-3.21-Upgrade-to-3.23.patch
Source0: https://cpan.metacpan.org/authors/id/N/NW/NWCLARK/Storable-%{base_version}.tar.gz
BuildRequires: coreutils
BuildRequires: gcc
BuildRequires: make
@ -80,11 +68,6 @@ can be conveniently stored to disk and retrieved at a later time.
%prep
%setup -q -n Storable-%{base_version}
%patch0 -p3
%patch1 -p3
%patch2 -p3
%patch3 -p1
%patch4 -p1
%build
perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 NO_PERLLOCAL=1 OPTIMIZE="$RPM_OPT_FLAGS"
@ -107,6 +90,9 @@ make test
%{_mandir}/man3/*
%changelog
* Mon Aug 30 2021 Jitka Plesnikova <jplesnik@redhat.com> - 1:3.25-1
- 3.25 bump
* Thu Jul 22 2021 Fedora Release Engineering <releng@fedoraproject.org> - 1:3.23-478
- Rebuilt for https://fedoraproject.org/wiki/Fedora_35_Mass_Rebuild

2
sources
View File

@ -1 +1 @@
SHA512 (Storable-3.15.tar.gz) = cd84d50a75b2d639b3075a671615ca1e879fe7b3322bf987843b5c08a8644807b58a671bee340f9694645d789b5a0f7ae93176cb06c94d795fe629697ca077ba
SHA512 (Storable-3.25.tar.gz) = a1e0342061bc3fbe04e1041c94004c6dc2fbee10ab49939fe93fa84696829aa32896e6af234a33743c6ecd9e5b0c2e2c623428207e0f04dc01b31caa87f8d73c