This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Storable: throw exception on huge values
authorAaron Crane <arc@cpan.org>
Fri, 18 Mar 2016 15:22:12 +0000 (15:22 +0000)
committerTony Cook <tony@develop-help.com>
Thu, 8 Feb 2018 02:34:10 +0000 (13:34 +1100)
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 <rurban@cpanel.net>
Conflicts:
dist/Storable/Storable.pm
dist/Storable/Storable.xs

MANIFEST
dist/Storable/Storable.xs
dist/Storable/__Storable__.pm
dist/Storable/t/huge.t [new file with mode: 0644]

index 7ad0841..85afbd8 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3699,6 +3699,7 @@ dist/Storable/t/freeze.t          See if Storable works
 dist/Storable/t/HAS_ATTACH.pm          For auto-requiring of modules for STORABLE_attach
 dist/Storable/t/HAS_HOOK.pm            For auto-requiring of modules for STORABLE_thaw
 dist/Storable/t/HAS_OVERLOAD.pm                For auto-requiring of mdoules for overload
+dist/Storable/t/huge.t                 See how Storable handles huge data
 dist/Storable/t/integer.t              See if Storable works
 dist/Storable/t/interwork56.t          Test compatibility kludge for 64bit data under 5.6.x
 dist/Storable/t/just_plain_nasty.t     See if Storable works
index 269af24..e124d32 100644 (file)
@@ -879,6 +879,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...
  */
@@ -945,6 +952,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);                                             \
@@ -2269,6 +2277,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);
@@ -2298,6 +2307,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)));
 
        /* 
@@ -2399,6 +2410,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),
index fff20f1..d1122b6 100644 (file)
@@ -1177,7 +1177,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.
 
diff --git a/dist/Storable/t/huge.t b/dist/Storable/t/huge.t
new file mode 100644 (file)
index 0000000..f578333
--- /dev/null
@@ -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;
+}