In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/76b97db53754383a11c0e30949c54e45282d3317?hp=1927e203ff157957a4c28ff5a935927a92e8b48d>
- Log ----------------------------------------------------------------- commit 76b97db53754383a11c0e30949c54e45282d3317 Author: Abhijit Menon-Sen <[email protected]> Date: Sat Jul 13 21:29:49 2013 +0530 Edit ChangeLog, Bump VERSION before rebase/release M dist/Storable/ChangeLog M dist/Storable/Storable.pm commit 3c1b273b7ca4f7e3e20e9dba260670dfb71a4425 Author: Nicholas Clark <[email protected]> Date: Tue May 28 23:10:30 2013 +0200 Tweak the new Storable destroy test, and the ChangeLog Use Test::More instead of Test, as all the other tests now use Test::More. Use 2-argument open to be compatible with 5.005. (Where it passes) Close the test file before unlinking it. Check the error returns of open and close. Update the comment now that we have a better understanding of the bug's cause. As the previous commit as applied had no 5.6 compatibility changes, remove that note from the ChangeLog. M dist/Storable/ChangeLog M dist/Storable/t/destroy.t commit f17010dab44137f3fb45ce35aa343cad9fc8fe0b Author: Reini Urban <[email protected]> Date: Tue May 28 22:46:12 2013 +0200 [perl #118139] Storable 2.42 - die in global destruction Protect against SEGV during global destruction, e.g. when used in DESTROY blocks. [Part of a patch submitted by Reini. MANIFEST change added by the committer] M MANIFEST M dist/Storable/ChangeLog M dist/Storable/Storable.pm A dist/Storable/t/destroy.t commit 9f49f5e94687bc5f687292b495ab34349ed4d65a Author: Nicholas Clark <[email protected]> Date: Tue May 28 22:36:48 2013 +0200 Use magic rather than DESTROY to free memory in Storable's context. Suggested by Leon Timmermans. M dist/Storable/Storable.xs commit 81447963ebe01605860f66fb468a6cf646e913b0 Author: Nicholas Clark <[email protected]> Date: Tue May 28 21:37:06 2013 +0200 Restore Storable support for 5.005 and (astoundingly) 5.004 It even passes all tests on 5.004. M dist/Storable/Storable.pm ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + dist/Storable/ChangeLog | 14 +++++++---- dist/Storable/Storable.pm | 12 ++++++---- dist/Storable/Storable.xs | 60 +++++++++++++++++++++++++++++++++++++++-------- dist/Storable/t/destroy.t | 20 ++++++++++++++++ 5 files changed, 88 insertions(+), 19 deletions(-) create mode 100644 dist/Storable/t/destroy.t diff --git a/MANIFEST b/MANIFEST index bb086c8..a676881 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3322,6 +3322,7 @@ dist/Storable/t/compat01.t See if Storable works dist/Storable/t/compat06.t See if Storable works dist/Storable/t/croak.t See if Storable works dist/Storable/t/dclone.t See if Storable works +dist/Storable/t/destroy.t Test Storable in global destructon dist/Storable/t/downgrade.t See if Storable works dist/Storable/t/file_magic.t See if file_magic function works dist/Storable/t/forgive.t See if Storable works diff --git a/dist/Storable/ChangeLog b/dist/Storable/ChangeLog index 31e1b0c..33b3931 100644 --- a/dist/Storable/ChangeLog +++ b/dist/Storable/ChangeLog @@ -1,7 +1,13 @@ -? - Version 2.40 - - Security warnings section added +Sat Jul 13 18:34:27 IST 2013 Abhijit Menon-Sen <[email protected]> + Version 2.45 + + * [perl #118829] Memory leaks in STORABLE_attach + (Vladimir Timofeev) + * [perl #118139] Don't SEGV during global destruction + (Nicholas Clark, report/test from Reini Urban) + * Added security warnings section (Steffen Mueller) + * Update INSTALLDIRS to favour installation in 'site' + (James E Keenan) Tue 11 Sep 06:51:11 IST 2012 Abhijit Menon-Sen <[email protected]> Version 2.39 diff --git a/dist/Storable/Storable.pm b/dist/Storable/Storable.pm index 5f63871..00cc2e7 100644 --- a/dist/Storable/Storable.pm +++ b/dist/Storable/Storable.pm @@ -1,5 +1,6 @@ # -# Copyright (c) 1995-2000, Raphael Manfredi +# Copyright (c) 1995-2001, Raphael Manfredi +# Copyright (c) 2002-2013 by the Perl 5 Porters # # You may redistribute only under the same terms as Perl 5, as specified # in the README file that comes with the distribution. @@ -21,7 +22,7 @@ package Storable; @ISA = qw(Exporter); use vars qw($canonical $forgive_me $VERSION); -$VERSION = '2.44'; +$VERSION = '2.45'; BEGIN { if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) { @@ -31,13 +32,13 @@ BEGIN { # Use of Log::Agent is optional. If it hasn't imported these subs then # provide a fallback implementation. # - if (!exists &logcroak) { + unless ($Storable::{logcroak} && *{$Storable::{logcroak}}{CODE}) { require Carp; *logcroak = sub { Carp::croak(@_); }; } - if (!exists &logcarp) { + unless ($Storable::{logcarp} && *{$Storable::{logcarp}}{CODE}) { require Carp; *logcarp = sub { Carp::carp(@_); @@ -1192,7 +1193,8 @@ Thank you to (in chronological order): Salvador Ortiz Garcia <[email protected]> Dominic Dunlop <[email protected]> Erik Haugan <[email protected]> - Benjamin A. Holzman <[email protected]> + Benjamin A. Holzman <[email protected]> + Reini Urban <[email protected]> for their bug reports, suggestions and contributions. diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs index 81c8576..9cba279 100644 --- a/dist/Storable/Storable.xs +++ b/dist/Storable/Storable.xs @@ -335,11 +335,55 @@ typedef struct stcxt { int in_retrieve_overloaded; /* performance hack for retrieving overloaded objects */ } stcxt_t; +static int storable_free(pTHX_ SV *sv, MAGIC* mg); + +static MGVTBL vtbl_storable = { + NULL, /* get */ + NULL, /* set */ + NULL, /* len */ + NULL, /* clear */ + storable_free, +#ifdef MGf_COPY + NULL, /* copy */ +#endif +#ifdef MGf_DUP + NULL, /* dup */ +#endif +#ifdef MGf_LOCAL + NULL /* local */ +#endif +}; + +/* From Digest::MD5. */ +#ifndef sv_magicext +# define sv_magicext(sv, obj, type, vtbl, name, namlen) \ + THX_sv_magicext(aTHX_ sv, obj, type, vtbl, name, namlen) +static MAGIC *THX_sv_magicext(pTHX_ SV *sv, SV *obj, int type, + MGVTBL const *vtbl, char const *name, I32 namlen) +{ + MAGIC *mg; + if (obj || namlen) + /* exceeded intended usage of this reserve implementation */ + return NULL; + Newxz(mg, 1, MAGIC); + mg->mg_virtual = (MGVTBL*)vtbl; + mg->mg_type = type; + mg->mg_ptr = (char *)name; + mg->mg_len = -1; + (void) SvUPGRADE(sv, SVt_PVMG); + mg->mg_moremagic = SvMAGIC(sv); + SvMAGIC_set(sv, mg); + SvMAGICAL_off(sv); + mg_magical(sv); + return mg; +} +#endif + #define NEW_STORABLE_CXT_OBJ(cxt) \ STMT_START { \ SV *self = newSV(sizeof(stcxt_t) - 1); \ SV *my_sv = newRV_noinc(self); \ - sv_bless(my_sv, gv_stashpv("Storable::Cxt", GV_ADD)); \ + sv_magicext(self, NULL, PERL_MAGIC_ext, &vtbl_storable, NULL, 0); \ cxt = (stcxt_t *)SvPVX(self); \ Zero(cxt, 1, stcxt_t); \ cxt->my_sv = my_sv; \ @@ -6403,21 +6447,17 @@ static SV *dclone(pTHX_ SV *sv) #define InputStream PerlIO * #endif /* !OutputStream */ -MODULE = Storable PACKAGE = Storable::Cxt - -void -DESTROY(self) - SV *self -PREINIT: - stcxt_t *cxt = (stcxt_t *)SvPVX(SvRV(self)); -PPCODE: +static int +storable_free(pTHX_ SV *sv, MAGIC* mg) { + stcxt_t *cxt = (stcxt_t *)SvPVX(sv); if (kbuf) Safefree(kbuf); if (!cxt->membuf_ro && mbase) Safefree(mbase); if (cxt->membuf_ro && (cxt->msaved).arena) Safefree((cxt->msaved).arena); - + return 0; +} MODULE = Storable PACKAGE = Storable diff --git a/dist/Storable/t/destroy.t b/dist/Storable/t/destroy.t new file mode 100644 index 0000000..e9464fb --- /dev/null +++ b/dist/Storable/t/destroy.t @@ -0,0 +1,20 @@ +# [perl #118139] crash in global destruction when accessing the freed cxt. +use Test::More tests => 1; +use Storable; +BEGIN { + store {}, "foo"; +} +package foo; +sub new { return bless {} } +DESTROY { + open FH, "<foo" or die $!; + eval { Storable::pretrieve(*FH); }; + close FH or die $!; + unlink "foo"; +} + +package main; +# print "# $^X\n"; +$x = foo->new(); + +ok(1); -- Perl5 Master Repository
