Compare commits

..

4 Commits
rawhide ... f29

Author SHA1 Message Date
Petr Písař 539842d610 Fix a buffer overflow when processing a vstring longer than 2^31-1 2019-11-25 16:11:40 +01:00
Petr Písař c1517c8a01 Fix array length check in a store hook 2019-08-08 12:27:55 +02:00
Petr Písař 74534d920a Fix deep cloning regular expression objects 2019-06-11 17:32:20 +02:00
Petr Písař ce32964da6 3.15 bump 2019-04-24 10:33:47 +02:00
11 changed files with 239 additions and 681 deletions

View File

@ -1 +0,0 @@
1

1
.gitignore vendored
View File

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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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}

View File

@ -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

View File

@ -1,16 +1,20 @@
%global base_version 3.25
Name: perl-Storable
Epoch: 1
Version: 3.32
Release: 502%{?dist}
Version: 3.15
Release: 4%{?dist}
Summary: Persistence for Perl data structures
# Storable.pm: GPL+ or Artistic
License: GPL-1.0-or-later OR Artistic-1.0-Perl
# __Storable__.pm: GPL+ or Artistic
License: GPL+ or Artistic
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
BuildRequires: coreutils
Source0: https://cpan.metacpan.org/authors/id/X/XS/XSAWYERX/Storable-%{version}.tar.gz
# Fix deep cloning regular expression objects, RT#134179,
# in Perl upstream after 5.31.0
Patch0: Storable-3.15-perl-134179-include-regexps-in-the-seen-objects-tabl.patch
# Fix array length check in a store hook, in Perl upstream after 5.31.2
Patch1: Storable-3.16-Storable-make-count-large-enough.patch
# Fix a buffer overflow when processing a vstring longer than 2^31-1,
# Perl GH#17306, in perl upstream after 5.31.6
Patch2: perl-5.31.6-disallow-vstring-magic-strings-over-2GB-1.patch
BuildRequires: gcc
BuildRequires: make
BuildRequires: perl-devel
@ -36,7 +40,6 @@ BuildRequires: perl(XSLoader)
# Tests:
BuildRequires: perl(base)
BuildRequires: perl(bytes)
BuildRequires: perl(constant)
BuildRequires: perl(File::Temp)
BuildRequires: perl(integer)
BuildRequires: perl(overload)
@ -45,7 +48,6 @@ BuildRequires: perl(Test::More)
BuildRequires: perl(threads)
BuildRequires: perl(Safe)
BuildRequires: perl(Scalar::Util)
BuildRequires: perl(Symbol)
BuildRequires: perl(Tie::Array)
# Optional tests:
# gzip not used
@ -57,6 +59,7 @@ 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))
Requires: perl(Config)
# Fcntl is optional, but locking is good
Requires: perl(Fcntl)
@ -64,65 +67,28 @@ 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-%{version}
%patch0 -p3
%patch1 -p3
%patch2 -p3
%build
perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 NO_PERLLOCAL=1 OPTIMIZE="%{optflags}"
perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 NO_PERLLOCAL=1 OPTIMIZE="$RPM_OPT_FLAGS"
%{make_build}
%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
find $RPM_BUILD_ROOT -type f -name '*.bs' -size 0 -delete
find $RPM_BUILD_ROOT -type f -name '*.3pm' -size 0 -delete
%{_fixperms} $RPM_BUILD_ROOT/*
%check
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
@ -130,86 +96,22 @@ make test
%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
* Mon Nov 25 2019 Petr Pisar <ppisar@redhat.com> - 1:3.15-4
- Fix a buffer overflow when processing a vstring longer than 2^31-1
(Perl GH#17306)
* Thu Aug 08 2019 Petr Pisar <ppisar@redhat.com> - 1:3.15-441
* Thu Aug 08 2019 Petr Pisar <ppisar@redhat.com> - 1:3.15-3
- 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
* Tue Jun 11 2019 Petr Pisar <ppisar@redhat.com> - 1:3.15-2
- 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)

View File

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

View File

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

View File

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