This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix a null pointer dereference segfault in Storable.
authorJohn Lightsey <lightsey@debian.org>
Sun, 25 Dec 2016 02:41:40 +0000 (21:41 -0500)
committerJames E Keenan <jkeenan@cpan.org>
Sun, 1 Jan 2017 15:11:18 +0000 (10:11 -0500)
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

dist/Storable/Storable.pm
dist/Storable/Storable.xs
dist/Storable/t/store.t

index 246957f..397d584 100644 (file)
@@ -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 {
index 3788f57..a72d84c 100644 (file)
@@ -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)
index be43299..3a4b9dc 100644 (file)
@@ -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' }