Compare commits
No commits in common. 'cs10' and 'c9' have entirely different histories.
@ -1 +1 @@
|
|||||||
SOURCES/Storable-3.25.tar.gz
|
SOURCES/Storable-3.15.tar.gz
|
||||||
|
|||||||
@ -1 +1 @@
|
|||||||
bf9a9fce480251283d1fb5a49c342e4a2e78662f SOURCES/Storable-3.25.tar.gz
|
dfd5ef17f9cdca7c246a90cbde7948e4c0168670 SOURCES/Storable-3.15.tar.gz
|
||||||
|
|||||||
@ -0,0 +1,476 @@
|
|||||||
|
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
|
||||||
|
|
||||||
@ -0,0 +1,92 @@
|
|||||||
|
From 16f2ddb794883529d5a3ad8326974a07aae7e567 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Tony Cook <tony@develop-help.com>
|
||||||
|
Date: Mon, 10 Jun 2019 10:17:20 +1000
|
||||||
|
Subject: [PATCH] (perl #134179) include regexps in the seen objects table on
|
||||||
|
retrieve
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
Also, bless the regexp object, so freezing/thawing bless qr//, "Foo"
|
||||||
|
returns a "Foo" blesses regexp.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
dist/Storable/Storable.xs | 5 +++--
|
||||||
|
dist/Storable/t/regexp.t | 4 +++-
|
||||||
|
dist/Storable/t/weak.t | 10 +++++++++-
|
||||||
|
3 files changed, 15 insertions(+), 4 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
|
||||||
|
index ed729c94a6..6a45d8adf2 100644
|
||||||
|
--- a/dist/Storable/Storable.xs
|
||||||
|
+++ b/dist/Storable/Storable.xs
|
||||||
|
@@ -6808,8 +6808,7 @@ static SV *retrieve_regexp(pTHX_ stcxt_t *cxt, const char *cname) {
|
||||||
|
SV *sv;
|
||||||
|
dSP;
|
||||||
|
I32 count;
|
||||||
|
-
|
||||||
|
- PERL_UNUSED_ARG(cname);
|
||||||
|
+ HV *stash;
|
||||||
|
|
||||||
|
ENTER;
|
||||||
|
SAVETMPS;
|
||||||
|
@@ -6857,6 +6856,8 @@ static SV *retrieve_regexp(pTHX_ stcxt_t *cxt, const char *cname) {
|
||||||
|
|
||||||
|
sv = SvRV(re_ref);
|
||||||
|
SvREFCNT_inc(sv);
|
||||||
|
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
|
||||||
|
+ SEEN_NN(sv, stash, 0);
|
||||||
|
|
||||||
|
FREETMPS;
|
||||||
|
LEAVE;
|
||||||
|
diff --git a/dist/Storable/t/regexp.t b/dist/Storable/t/regexp.t
|
||||||
|
index acf28cfec6..e7c6c7e94a 100644
|
||||||
|
--- a/dist/Storable/t/regexp.t
|
||||||
|
+++ b/dist/Storable/t/regexp.t
|
||||||
|
@@ -37,7 +37,7 @@ while (<DATA>) {
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
-plan tests => 9 + 3*scalar(@tests);
|
||||||
|
+plan tests => 10 + 3*scalar(@tests);
|
||||||
|
|
||||||
|
SKIP:
|
||||||
|
{
|
||||||
|
@@ -75,6 +75,8 @@ SKIP:
|
||||||
|
ok(!eval { dclone($re) }, "should fail to clone, even with use re 'eval'");
|
||||||
|
}
|
||||||
|
|
||||||
|
+is(ref(dclone(bless qr//, "Foo")), "Foo", "check reblessed regexps");
|
||||||
|
+
|
||||||
|
for my $test (@tests) {
|
||||||
|
my ($code, $not, $match, $matchc, $name) = @$test;
|
||||||
|
my $qr = eval $code;
|
||||||
|
diff --git a/dist/Storable/t/weak.t b/dist/Storable/t/weak.t
|
||||||
|
index 220c70160f..48752fbec4 100644
|
||||||
|
--- a/dist/Storable/t/weak.t
|
||||||
|
+++ b/dist/Storable/t/weak.t
|
||||||
|
@@ -29,7 +29,7 @@ sub BEGIN {
|
||||||
|
}
|
||||||
|
|
||||||
|
use Test::More 'no_plan';
|
||||||
|
-use Storable qw (store retrieve freeze thaw nstore nfreeze);
|
||||||
|
+use Storable qw (store retrieve freeze thaw nstore nfreeze dclone);
|
||||||
|
require 'testlib.pl';
|
||||||
|
our $file;
|
||||||
|
use strict;
|
||||||
|
@@ -143,3 +143,11 @@ foreach (@tests) {
|
||||||
|
$stored = nfreeze $input;
|
||||||
|
tester($stored, \&freeze_and_thaw, $testsub, 'network string');
|
||||||
|
}
|
||||||
|
+
|
||||||
|
+{
|
||||||
|
+ # [perl #134179] sv_upgrade from type 7 down to type 1
|
||||||
|
+ my $foo = [qr//,[]];
|
||||||
|
+ weaken($foo->[1][0][0] = $foo->[1]);
|
||||||
|
+ my $out = dclone($foo); # croaked here
|
||||||
|
+ is_deeply($out, $foo, "check they match");
|
||||||
|
+}
|
||||||
|
--
|
||||||
|
2.20.1
|
||||||
|
|
||||||
@ -0,0 +1,53 @@
|
|||||||
|
From f7724052d1b8b75339f5ec2cc3d5b35ca5d130b5 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Tony Cook <tony@develop-help.com>
|
||||||
|
Date: Wed, 7 Aug 2019 11:13:53 +1000
|
||||||
|
Subject: [PATCH] Storable: make count large enough
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
AvARRAY() could be very large, and we check for that at line 3807,
|
||||||
|
but int was (potentially) too small to make that comparison
|
||||||
|
meaningful.
|
||||||
|
|
||||||
|
CID 174681.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
dist/Storable/Storable.xs | 6 +++---
|
||||||
|
1 file changed, 3 insertions(+), 3 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
|
||||||
|
index 6a45d8adf2..d75125b839 100644
|
||||||
|
--- a/dist/Storable/Storable.xs
|
||||||
|
+++ b/dist/Storable/Storable.xs
|
||||||
|
@@ -3662,7 +3662,7 @@ static int store_hook(
|
||||||
|
SV *ref;
|
||||||
|
AV *av;
|
||||||
|
SV **ary;
|
||||||
|
- int count; /* really len3 + 1 */
|
||||||
|
+ IV count; /* really len3 + 1 */
|
||||||
|
unsigned char flags;
|
||||||
|
char *pv;
|
||||||
|
int i;
|
||||||
|
@@ -3752,7 +3752,7 @@ static int store_hook(
|
||||||
|
SvREFCNT_dec(ref); /* Reclaim temporary reference */
|
||||||
|
|
||||||
|
count = AvFILLp(av) + 1;
|
||||||
|
- TRACEME(("store_hook, array holds %d items", count));
|
||||||
|
+ TRACEME(("store_hook, array holds %" IVdf " items", count));
|
||||||
|
|
||||||
|
/*
|
||||||
|
* If they return an empty list, it means they wish to ignore the
|
||||||
|
@@ -3986,7 +3986,7 @@ static int store_hook(
|
||||||
|
*/
|
||||||
|
|
||||||
|
TRACEME(("SX_HOOK (recursed=%d) flags=0x%x "
|
||||||
|
- "class=%" IVdf " len=%" IVdf " len2=%" IVdf " len3=%d",
|
||||||
|
+ "class=%" IVdf " len=%" IVdf " len2=%" IVdf " len3=%" IVdf,
|
||||||
|
recursed, flags, (IV)classnum, (IV)len, (IV)len2, count-1));
|
||||||
|
|
||||||
|
/* SX_HOOK <flags> [<extra>] */
|
||||||
|
--
|
||||||
|
2.20.1
|
||||||
|
|
||||||
@ -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
|
|
||||||
|
|
||||||
@ -0,0 +1,67 @@
|
|||||||
|
From ea1e86cfdf26a330e58ea377a80273de7110011b Mon Sep 17 00:00:00 2001
|
||||||
|
From: Tony Cook <tony@develop-help.com>
|
||||||
|
Date: Wed, 21 Aug 2019 11:37:58 +1000
|
||||||
|
Subject: [PATCH] disallow vstring magic strings over 2GB-1
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
On reads this could result in buffer overflows, so avoid writing
|
||||||
|
such large vstrings to avoid causing problems for older Storable.
|
||||||
|
|
||||||
|
Since we no longer write such large vstrings, we don't want to accept
|
||||||
|
them.
|
||||||
|
|
||||||
|
I doubt that restricting versions strings to under 2GB-1 will have
|
||||||
|
a practical effect on downstream users.
|
||||||
|
|
||||||
|
fixes #17306
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
dist/Storable/Storable.xs | 19 ++++++++++++++++---
|
||||||
|
1 file changed, 16 insertions(+), 3 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
|
||||||
|
index c2335680ab..d27ac58012 100644
|
||||||
|
--- a/dist/Storable/Storable.xs
|
||||||
|
+++ b/dist/Storable/Storable.xs
|
||||||
|
@@ -2628,6 +2628,12 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
|
||||||
|
/* The macro passes this by address, not value, and a lot of
|
||||||
|
called code assumes that it's 32 bits without checking. */
|
||||||
|
const SSize_t len = mg->mg_len;
|
||||||
|
+ /* we no longer accept vstrings over I32_SIZE-1, so don't emit
|
||||||
|
+ them, also, older Storables handle them badly.
|
||||||
|
+ */
|
||||||
|
+ if (len >= I32_MAX) {
|
||||||
|
+ CROAK(("vstring too large to freeze"));
|
||||||
|
+ }
|
||||||
|
STORE_PV_LEN((const char *)mg->mg_ptr,
|
||||||
|
len, SX_VSTRING, SX_LVSTRING);
|
||||||
|
}
|
||||||
|
@@ -5937,12 +5943,19 @@ static SV *retrieve_lvstring(pTHX_ stcxt_t *cxt, const char *cname)
|
||||||
|
{
|
||||||
|
#ifdef SvVOK
|
||||||
|
char *s;
|
||||||
|
- I32 len;
|
||||||
|
+ U32 len;
|
||||||
|
SV *sv;
|
||||||
|
|
||||||
|
RLEN(len);
|
||||||
|
- TRACEME(("retrieve_lvstring (#%d), len = %" IVdf,
|
||||||
|
- (int)cxt->tagnum, (IV)len));
|
||||||
|
+ TRACEME(("retrieve_lvstring (#%d), len = %" UVuf,
|
||||||
|
+ (int)cxt->tagnum, (UV)len));
|
||||||
|
+
|
||||||
|
+ /* Since we'll no longer produce such large vstrings, reject them
|
||||||
|
+ here too.
|
||||||
|
+ */
|
||||||
|
+ if (len >= I32_MAX) {
|
||||||
|
+ CROAK(("vstring too large to fetch"));
|
||||||
|
+ }
|
||||||
|
|
||||||
|
New(10003, s, len+1, char);
|
||||||
|
SAFEPVREAD(s, len, s);
|
||||||
|
--
|
||||||
|
2.21.0
|
||||||
|
|
||||||
Loading…
Reference in new issue