Storable: throw exception on huge values

The Storable data format is incapable of representing lengths of 2**31 or
greater; and if you try, you can get segfaults or corrupt data or other fun
and games.

Though it would be undeniably good to fix this properly, this is just a
simple starting point: the limitation is documented, and an exception is
thrown when such data is encountered.

Signed-off-by: Reini Urban <[email protected]>

Author: arc

Storable.pm

@@ -24,7 +24,7 @@ package Storable; @ISA = qw(Exporter);
 
 use vars qw($canonical $forgive_me $VERSION);
 
-$VERSION = '2.53_03';
+$VERSION = '2.57_01';
 
 BEGIN {
     if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) {
@@ -1178,7 +1178,7 @@ A hash with 2**31 or more keys
 
 =back
 
-Attempting to do so will result in unpredicatable overflow results.
+Attempting to do so will yield an exception.
 
 This may be fixed in the future.
 

Storable.xs

@@ -875,6 +875,13 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 #define PL_sv_placeholder PL_sv_undef
 #endif
 
+#define MUST_FIT_IN_I32(x)                                              \
+    STMT_START {                                                        \
+        if ((UV)(x) > (UV)0x7fffffffu) {                                \
+            CROAK(("Storable cannot yet handle data that needs a 64-bit machine")); \
+        }                                                               \
+    } STMT_END
+
 /*
  * Useful store shortcuts...
  */
@@ -941,6 +948,7 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
             if (len)                                                    \
                 WRITE(pv, len);                                         \
 	} else {							\
+            MUST_FIT_IN_I32(len);                                       \
             PUTMARK(large);                                             \
             WLEN(len);                                                  \
             WRITE(pv, len);                                             \
@@ -2259,6 +2267,7 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
             }
 #endif
 
+            MUST_FIT_IN_I32(len);
             wlen = (I32) len; /* WLEN via STORE_SCALAR expects I32 */
             if (SvUTF8 (sv))
                 STORE_UTF8STR(pv, wlen);
@@ -2288,6 +2297,8 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
 	I32 i;
 	int ret;
 
+        MUST_FIT_IN_I32(av_len(av) + 1);
+
 	TRACEME(("store_array (0x%"UVxf")", PTR2UV(av)));
 
 	/* 
@@ -2389,6 +2400,8 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
                             ) ? 1 : 0);
         unsigned char hash_flags = (SvREADONLY(hv) ? SHV_RESTRICTED : 0);
 
+        MUST_FIT_IN_I32(HvTOTALKEYS(hv));
+
         if (flagged_hash) {
             /* needs int cast for C++ compilers, doesn't it?  */
             TRACEME(("store_hash (0x%"UVxf") (flags %x)", PTR2UV(hv),

t/huge.t

@@ -0,0 +1,60 @@
+#!./perl
+
+use strict;
+use warnings;
+
+use Config;
+use Storable qw(dclone);
+use Test::More;
+
+BEGIN {
+    plan skip_all => 'Storable was not built'
+        if $ENV{PERL_CORE} && $Config{'extensions'} !~ /\b Storable \b/x;
+    plan skip_all => 'Need 64-bit pointers for this test'
+        if $Config{ptrsize} < 8;
+    plan skip_all => 'Need ~4 GiB of core for this test'
+        if !$ENV{PERL_TEST_MEMORY} || $ENV{PERL_TEST_MEMORY} < 4;
+}
+
+# Just too big to fit in an I32.
+my $huge = int(2 ** 31);
+
+# For now, all of these should throw an exception. Actually storing and
+# retrieving them would require changing the serialisation format, and
+# that's a larger task than I'm looking to undertake right now.
+my @cases = (
+    ['huge string',
+     sub { my $s = 'x' x $huge; \$s }],
+
+    ['huge array',
+     sub { my @x; $x[$huge] = undef; \@x }],
+
+    ['array with huge element',
+     sub { my $s = 'x' x $huge; [$s] }],
+
+    # A hash with a huge number of keys would require tens of gigabytes of
+    # memory, which doesn't seem like a good idea even for this test file.
+
+    ['hash with huge value',
+     sub { my $s = 'x' x $huge; +{ foo => $s } }],
+
+    # Can't test hash with a huge key, because Perl internals currently
+    # limit hash keys to <2**31 anyway
+);
+
+plan tests => scalar @cases;
+
+for (@cases) {
+    my ($desc, $build) = @$_;
+    note "building test input: $desc";
+    my $input = $build->();
+    note "running test: $desc";
+    my ($exn, $clone);
+    $exn = $@ if !eval { $clone = dclone($input); 1 };
+    like($exn, qr/^Storable cannot yet handle data that needs a 64-bit machine\b/,
+         "$desc: throw an exception, not a segfault or panic");
+
+    # Ensure the huge objects are freed right now:
+    undef $input;
+    undef $clone;
+}