In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/74ef8fd9adb71db3b12bc660c5718b47d53fa056?hp=f566343249618427131b73615909df934030adc1>
- Log ----------------------------------------------------------------- commit 74ef8fd9adb71db3b12bc660c5718b47d53fa056 Author: James E Keenan <[email protected]> Date: Sun Jan 1 10:12:56 2017 -0500 perldelta for adf9095d629bebb27169b0f3b03f75ee974da100 M pod/perldelta.pod commit adf9095d629bebb27169b0f3b03f75ee974da100 Author: John Lightsey <[email protected]> Date: Sat Dec 24 21:41:40 2016 -0500 Fix a null pointer dereference segfault in Storable. At point where the retrieve_code logic was unable to read the string that contained the code. Also fix several locations where retrieve_other was called with a null context pointer. This also resulted in a null pointer dereference. Committer: Add tests adapted from submitter's test program. For: RT #130098 M dist/Storable/Storable.pm M dist/Storable/Storable.xs M dist/Storable/t/store.t ----------------------------------------------------------------------- Summary of changes: dist/Storable/Storable.pm | 2 +- dist/Storable/Storable.xs | 10 +++++++--- dist/Storable/t/store.t | 18 ++++++++++++++++-- pod/perldelta.pod | 2 +- 4 files changed, 25 insertions(+), 7 deletions(-) diff --git a/dist/Storable/Storable.pm b/dist/Storable/Storable.pm index 246957f490..397d584763 100644 --- a/dist/Storable/Storable.pm +++ b/dist/Storable/Storable.pm @@ -22,7 +22,7 @@ package Storable; @ISA = qw(Exporter); use vars qw($canonical $forgive_me $VERSION); -$VERSION = '2.60'; +$VERSION = '2.61'; BEGIN { if (eval { diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs index 3788f57f5d..a72d84cbf5 100644 --- a/dist/Storable/Storable.xs +++ b/dist/Storable/Storable.xs @@ -5660,6 +5660,10 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname) CROAK(("Unexpected type %d in retrieve_code\n", type)); } + if (!text) { + CROAK(("Unable to retrieve code\n")); + } + /* * prepend "sub " to the source */ @@ -5780,7 +5784,7 @@ static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, const char *cname) continue; /* av_extend() already filled us with undef */ } if (c != SX_ITEM) - (void) retrieve_other(aTHX_ (stcxt_t *) 0, 0); /* Will croak out */ + (void) retrieve_other(aTHX_ cxt, 0); /* Will croak out */ TRACEME(("(#%d) item", i)); sv = retrieve(aTHX_ cxt, 0); /* Retrieve item */ if (!sv) @@ -5857,7 +5861,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname) if (!sv) return (SV *) 0; } else - (void) retrieve_other(aTHX_ (stcxt_t *) 0, 0); /* Will croak out */ + (void) retrieve_other(aTHX_ cxt, 0); /* Will croak out */ /* * Get key. @@ -5868,7 +5872,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname) GETMARK(c); if (c != SX_KEY) - (void) retrieve_other(aTHX_ (stcxt_t *) 0, 0); /* Will croak out */ + (void) retrieve_other(aTHX_ cxt, 0); /* Will croak out */ RLEN(size); /* Get key size */ KBUFCHK((STRLEN)size); /* Grow hash key read pool if needed */ if (size) diff --git a/dist/Storable/t/store.t b/dist/Storable/t/store.t index be43299521..3a4b9dca8a 100644 --- a/dist/Storable/t/store.t +++ b/dist/Storable/t/store.t @@ -1,7 +1,7 @@ #!./perl # # Copyright (c) 1995-2000, Raphael Manfredi -# +# # You may redistribute only under the same terms as Perl 5, as specified # in the README file that comes with the distribution. # @@ -19,7 +19,7 @@ sub BEGIN { use Storable qw(store retrieve store_fd nstore_fd fd_retrieve); -use Test::More tests => 21; +use Test::More tests => 24; $a = 'toto'; $b = \$a; @@ -87,5 +87,19 @@ is(&dump($r), &dump(\%a)); eval { $r = fd_retrieve(::OUT); }; isnt($@, ''); +{ + my %test = ( + old_retrieve_array => "\x70\x73\x74\x30\x01\x0a\x02\x02\x02\x02\x00\x3d\x08\x84\x08\x85\x08\x06\x04\x00\x00\x01\x1b", + old_retrieve_hash => "\x70\x73\x74\x30\x01\x0a\x03\x00\xe8\x03\x00\x00\x81\x00\x00\x00\x01\x61", + retrieve_code => "\x70\x73\x74\x30\x05\x0a\x19\xf0\x00\xff\xe8\x03\x1a\x0a\x0e\x01", + ); + + for my $k (sort keys %test) { + open my $fh, '<', \$test{$k}; + eval { Storable::fd_retrieve($fh); }; + is($?, 0, 'RT 130098: no segfault in Storable::fd_retrieve()'); + } +} + close OUT or die "Could not close: $!"; END { 1 while unlink 'store' } diff --git a/pod/perldelta.pod b/pod/perldelta.pod index b94df2ec69..22c7d135e4 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -187,7 +187,7 @@ L<perl5db.pl> has been upgraded from version 1.50 to 1.51. =item * -L<Storable> has been upgraded from version 2.59 to 2.60. +L<Storable> has been upgraded from version 2.59 to 2.61. =item * -- Perl5 Master Repository
