diff --git a/.gitignore b/.gitignore index 96a1a5d..7044d60 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1 @@ -SOURCES/Storable-3.15.tar.gz +Storable-3.25.tar.gz diff --git a/.perl-Storable.metadata b/.perl-Storable.metadata deleted file mode 100644 index db4c03c..0000000 --- a/.perl-Storable.metadata +++ /dev/null @@ -1 +0,0 @@ -dfd5ef17f9cdca7c246a90cbde7948e4c0168670 SOURCES/Storable-3.15.tar.gz diff --git a/SOURCES/Storable-3.15-perl-134179-include-regexps-in-the-seen-objects-tabl.patch b/SOURCES/Storable-3.15-perl-134179-include-regexps-in-the-seen-objects-tabl.patch deleted file mode 100644 index a4660d8..0000000 --- a/SOURCES/Storable-3.15-perl-134179-include-regexps-in-the-seen-objects-tabl.patch +++ /dev/null @@ -1,92 +0,0 @@ -From 16f2ddb794883529d5a3ad8326974a07aae7e567 Mon Sep 17 00:00:00 2001 -From: Tony Cook -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ř ---- - 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 () { - } - } - --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 - diff --git a/SOURCES/Storable-3.16-Storable-make-count-large-enough.patch b/SOURCES/Storable-3.16-Storable-make-count-large-enough.patch deleted file mode 100644 index b2b5b40..0000000 --- a/SOURCES/Storable-3.16-Storable-make-count-large-enough.patch +++ /dev/null @@ -1,53 +0,0 @@ -From f7724052d1b8b75339f5ec2cc3d5b35ca5d130b5 Mon Sep 17 00:00:00 2001 -From: Tony Cook -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ř ---- - 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 [] */ --- -2.20.1 - diff --git a/SOURCES/perl-5.31.6-disallow-vstring-magic-strings-over-2GB-1.patch b/SOURCES/perl-5.31.6-disallow-vstring-magic-strings-over-2GB-1.patch deleted file mode 100644 index e3e9819..0000000 --- a/SOURCES/perl-5.31.6-disallow-vstring-magic-strings-over-2GB-1.patch +++ /dev/null @@ -1,67 +0,0 @@ -From ea1e86cfdf26a330e58ea377a80273de7110011b Mon Sep 17 00:00:00 2001 -From: Tony Cook -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ř ---- - 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 - diff --git a/Storable-3.25-Upgrade-to-3.32.patch b/Storable-3.25-Upgrade-to-3.32.patch new file mode 100644 index 0000000..e67bc46 --- /dev/null +++ b/Storable-3.25-Upgrade-to-3.32.patch @@ -0,0 +1,538 @@ +From 93b4cf22054a0e3f9f5d4ae8eaec85e8ca28944c Mon Sep 17 00:00:00 2001 +From: Jitka Plesnikova +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 ++B There is ++B way to configure Storable so that it can be used safely to process ++untrusted data. While there I various options that can be used to ++mitigate specific security issues these options do I 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, L or L are the best +-choices and offer maximum interoperability, but note that Sereal is +-L. ++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 or L are fine alternatives. For ++more complex data structures containing various Perl specific data types ++like regular expressions or aliased data L is the best ++alternative and offers maximum interoperability. Note that Sereal is ++L, 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 + #include + +-#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 + diff --git a/SPECS/perl-Storable.spec b/perl-Storable.spec similarity index 59% rename from SPECS/perl-Storable.spec rename to perl-Storable.spec index e0aaa8f..9b73d29 100644 --- a/SPECS/perl-Storable.spec +++ b/perl-Storable.spec @@ -1,20 +1,16 @@ +%global base_version 3.25 Name: perl-Storable Epoch: 1 -Version: 3.15 -Release: 442%{?dist} +Version: 3.32 +Release: 511%{?dist} Summary: Persistence for Perl data structures -# __Storable__.pm: GPL+ or Artistic -License: GPL+ or Artistic +# Storable.pm: GPL+ or Artistic +License: GPL-1.0-or-later OR Artistic-1.0-Perl URL: https://metacpan.org/release/Storable -Source0: https://cpan.metacpan.org/authors/id/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 +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 BuildRequires: gcc BuildRequires: make BuildRequires: perl-devel @@ -40,6 +36,7 @@ BuildRequires: perl(XSLoader) # Tests: BuildRequires: perl(base) BuildRequires: perl(bytes) +BuildRequires: perl(constant) BuildRequires: perl(File::Temp) BuildRequires: perl(integer) BuildRequires: perl(overload) @@ -48,6 +45,7 @@ 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 @@ -59,7 +57,6 @@ 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) @@ -67,28 +64,65 @@ 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 -%setup -q -n Storable-%{version} -%patch0 -p3 -%patch1 -p3 -%patch2 -p3 +%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 %build -perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 NO_PERLLOCAL=1 OPTIMIZE="$RPM_OPT_FLAGS" +perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 NO_PERLLOCAL=1 OPTIMIZE="%{optflags}" %{make_build} %install %{make_install} -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/* +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 %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 @@ -96,9 +130,74 @@ make test %doc ChangeLog README %{perl_vendorarch}/auto/* %{perl_vendorarch}/Storable* -%{_mandir}/man3/* +%{_mandir}/man3/Storable* + +%files tests +%{_libexecdir}/%{name} %changelog +* Tue Oct 29 2024 Troy Dawson - 1:3.32-511 +- Bump release for October 2024 mass rebuild: + Resolves: RHEL-64018 + +* Thu Jul 18 2024 Jitka Plesnikova - 1:3.32-510 +- Increase release to favour standalone package + +* Mon Jun 24 2024 Troy Dawson - 1:3.32-503 +- Bump release for June 2024 mass rebuild + +* Thu Jan 25 2024 Fedora Release Engineering - 1:3.32-502 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_40_Mass_Rebuild + +* Sun Jan 21 2024 Fedora Release Engineering - 1:3.32-501 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_40_Mass_Rebuild + +* Fri Jul 21 2023 Fedora Release Engineering - 1:3.32-500 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_39_Mass_Rebuild + +* Tue Jul 11 2023 Jitka Plesnikova - 1:3.32-499 +- Increase release to favour standalone package + +* Mon Jun 12 2023 Jitka Plesnikova - 1:3.32-1 +- Upgrade to 3.32 as provided in perl-5.37.12 + +* Thu May 18 2023 Jitka Plesnikova - 1:3.31-1 +- Upgrade to 3.31 as provided in perl-5.37.11 + +* Fri Jan 20 2023 Fedora Release Engineering - 1:3.26-490 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_38_Mass_Rebuild + +* Fri Jul 22 2022 Fedora Release Engineering - 1:3.26-489 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_37_Mass_Rebuild + +* Mon May 30 2022 Jitka Plesnikova - 1:3.26-488 +- Upgrade to 3.26 as provided in perl-5.35.11 + +* Fri Jan 21 2022 Fedora Release Engineering - 1:3.25-2 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_36_Mass_Rebuild + +* Mon Aug 30 2021 Jitka Plesnikova - 1:3.25-1 +- 3.25 bump +- Package tests + +* Thu Jul 22 2021 Fedora Release Engineering - 1:3.23-478 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_35_Mass_Rebuild + +* Fri May 21 2021 Jitka Plesnikova - 1:3.23-477 +- Upgrade to 3.23 as provided in perl-5.34.0 + +* Wed Jan 27 2021 Fedora Release Engineering - 1:3.21-458 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_34_Mass_Rebuild + +* Tue Jul 28 2020 Fedora Release Engineering - 1:3.21-457 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_33_Mass_Rebuild + +* Mon Jun 22 2020 Jitka Plesnikova - 1:3.21-456 +- Upgrade to 3.21 as provided in perl-5.32.0 + +* Thu Jan 30 2020 Fedora Release Engineering - 1:3.15-443 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_32_Mass_Rebuild + * Mon Nov 25 2019 Petr Pisar - 1:3.15-442 - Fix a buffer overflow when processing a vstring longer than 2^31-1 (Perl GH#17306) diff --git a/sources b/sources new file mode 100644 index 0000000..c1fe2cb --- /dev/null +++ b/sources @@ -0,0 +1 @@ +SHA512 (Storable-3.25.tar.gz) = a1e0342061bc3fbe04e1041c94004c6dc2fbee10ab49939fe93fa84696829aa32896e6af234a33743c6ecd9e5b0c2e2c623428207e0f04dc01b31caa87f8d73c