From: Nicholas Clark Date: Tue, 7 May 2002 00:21:46 +0000 (+0100) Subject: Re: perl@16433 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e8189732aa38feae107d2273cfd45716bf8360df;p=p5sagit%2Fp5-mst-13.2.git Re: perl@16433 Message-ID: <20020506232146.GF4698@Bagpuss.unfortu.net> p4raw-id: //depot/perl@16437 --- diff --git a/ext/Storable/Storable.pm b/ext/Storable/Storable.pm index ea6080b..e6d5269 100644 --- a/ext/Storable/Storable.pm +++ b/ext/Storable/Storable.pm @@ -102,6 +102,7 @@ sub retrieve_fd { &fd_retrieve } # Backward compatibility # By default restricted hashes are downgraded on earlier perls. $Storable::downgrade_restricted = 1; +$Storable::accept_future_minor = 1; bootstrap Storable; 1; __END__ @@ -590,6 +591,25 @@ placeholder keys and leaving the keys and all values unlocked. To make Storable C instead, set C<$Storable::downgrade_restricted> to a false value. To restore the default set it back to some C value. +=item files from future versions of Storable + +Earlier versions of Storable would immediately croak if they encountered +a file with a higher internal version number than the reading Storable +knew about. Internal version numbers are increased each time new data +types (such as restricted hashes) are added to the vocabulary of the file +format. This meant that a newer Storable module had no way of writing a +file readable by an older Storable, even if writer didn't store newer +data types. + +This version of Storable will defer croaking until it encounters a data +type in the file that it does not recognize. This means that it will +continue to read files generated by newer Storable modules which are careful +in what they write out, making it easier to upgrade Storable modules in a +mixed environment. + +The old behaviour of immediate croaking can be re-instated by setting +C<$Storable::accept_future_minor> to false. + =back Both these variables have no effect on a newer Perl which supports the diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs index 05705c0..332ed70 100644 --- a/ext/Storable/Storable.xs +++ b/ext/Storable/Storable.xs @@ -59,7 +59,7 @@ #include #ifndef NETWARE -#if 1 +#if 0 #define DEBUGME /* Debug mode, turns assertions on as well */ #define DASSERT /* Assertion mode */ #endif @@ -339,6 +339,7 @@ typedef struct stcxt { #ifndef HAS_UTF8_ALL int use_bytes; /* whether to bytes-ify utf8 */ #endif + int accept_future_minor; /* croak immediately on future minor versions? */ int s_dirty; /* context is dirty due to CROAK() -- can be cleaned */ int membuf_ro; /* true means membuf is read-only and msaved is rw */ struct extendable keybuf; /* for hash key retrieval */ @@ -1204,6 +1205,9 @@ static void clean_store_context(stcxt_t *cxt) sv_free((SV *) hook_seen); } + cxt->forgive_me = -1; /* Fetched from perl if needed */ + cxt->canonical = -1; /* Idem */ + reset_context(cxt); } @@ -1249,6 +1253,7 @@ static void init_retrieve_context(stcxt_t *cxt, int optype, int is_tainted) #ifndef HAS_UTF8_ALL cxt->use_bytes = -1; /* Fetched from perl if needed */ #endif + cxt->accept_future_minor = -1; /* Fetched from perl if needed */ } /* @@ -1290,6 +1295,14 @@ static void clean_retrieve_context(stcxt_t *cxt) sv_free((SV *) hseen); /* optional HV, for backward compat. */ } +#ifndef HAS_RESTRICTED_HASHES + cxt->derestrict = -1; /* Fetched from perl if needed */ +#endif +#ifndef HAS_UTF8_ALL + cxt->use_bytes = -1; /* Fetched from perl if needed */ +#endif + cxt->accept_future_minor = -1; /* Fetched from perl if needed */ + reset_context(cxt); } @@ -4891,12 +4904,26 @@ magic_ok: (version_major == STORABLE_BIN_MAJOR && version_minor > STORABLE_BIN_MINOR) ) { - TRACEME(("but I am version is %d.%d", STORABLE_BIN_MAJOR, - STORABLE_BIN_MINOR)); - + int croak_now = 1; + TRACEME(("but I am version is %d.%d", STORABLE_BIN_MAJOR, + STORABLE_BIN_MINOR)); + + if (version_major == STORABLE_BIN_MAJOR) { + TRACEME(("cxt->accept_future_minor is %d", + cxt->accept_future_minor)); + if (cxt->accept_future_minor < 0) + cxt->accept_future_minor + = (SvTRUE(perl_get_sv("Storable::accept_future_minor", + TRUE)) + ? 1 : 0); + if (cxt->accept_future_minor == 1) + croak_now = 0; /* Don't croak yet. */ + } + if (croak_now) { CROAK(("Storable binary image v%d.%d more recent than I am (v%d.%d)", - version_major, version_minor, - STORABLE_BIN_MAJOR, STORABLE_BIN_MINOR)); + version_major, version_minor, + STORABLE_BIN_MAJOR, STORABLE_BIN_MINOR)); + } } /* @@ -5034,7 +5061,19 @@ static SV *retrieve(stcxt_t *cxt, char *cname) TRACEME(("had retrieved #%d at 0x%"UVxf, tag, PTR2UV(sv))); SvREFCNT_inc(sv); /* One more reference to this same sv */ return sv; /* The SV pointer where object was retrieved */ - } + } else if (type >= SX_ERROR && cxt->ver_minor > STORABLE_BIN_MINOR) { + if (cxt->accept_future_minor < 0) + cxt->accept_future_minor + = (SvTRUE(perl_get_sv("Storable::accept_future_minor", + TRUE)) + ? 1 : 0); + if (cxt->accept_future_minor == 1) { + CROAK(("Storable binary image v%d.%d contains data of type %d. " + "This Storable is v%d.%d and can only handle data types up to %d", + cxt->ver_major, cxt->ver_minor, type, + STORABLE_BIN_MAJOR, STORABLE_BIN_MINOR, SX_ERROR - 1)); + } + } first_time: /* Will disappear when support for old format is dropped */ diff --git a/ext/Storable/t/malice.t b/ext/Storable/t/malice.t index be55970..c8edc45 100644 --- a/ext/Storable/t/malice.t +++ b/ext/Storable/t/malice.t @@ -48,7 +48,7 @@ BEGIN { # for network order, and 2 tests per byte on the 'pst0' "magic number" only # present in files, but not in things store()ed to memory $fancy = ($] > 5.007 ? 2 : 0); - plan tests => 334 + length($Config{byteorder}) * 4 + $fancy * 8; + plan tests => 378 + length($Config{byteorder}) * 4 + $fancy * 8; } use Storable qw (store retrieve freeze thaw nstore nfreeze); @@ -174,9 +174,17 @@ sub test_things { # ) my $minor4 = $header->{minor} + 4; substr ($copy, $file_magic + 1, 1) = chr $minor4; - test_corrupt ($copy, $sub, - "/^Storable binary image v$header->{major}\.$minor4 more recent than I am \\(v$header->{major}\.$minor\\)/", - "higher minor"); + { + # Now by default newer minor version numbers are not a pain. + $clone = &$sub($copy); + ok ($@, "", "by default no error on higher minor"); + test_hash ($clone); + + local $Storable::accept_future_minor = 0; + test_corrupt ($copy, $sub, + "/^Storable binary image v$header->{major}\.$minor4 more recent than I am \\(v$header->{major}\.$minor\\)/", + "higher minor"); + } $copy = $contents; my $major1 = $header->{major} + 1; @@ -224,6 +232,29 @@ sub test_things { test_corrupt ($copy, $sub, "/^Corrupted storable $what \\(binary v$header->{major}.$header->{minor}\\)/", "bogus tag"); + + # Now drop the minor version number + substr ($copy, $file_magic + 1, 1) = chr $minor1; + + test_corrupt ($copy, $sub, + "/^Corrupted storable $what \\(binary v$header->{major}.$minor1\\)/", + "bogus tag, minor less 1"); + # Now increase the minor version number + substr ($copy, $file_magic + 1, 1) = chr $minor4; + + # local $Storable::DEBUGME = 1; + # This is the delayed croak + test_corrupt ($copy, $sub, + "/^Storable binary image v$header->{major}.$minor4 contains data of type 255. This Storable is v$header->{major}.$header->{minor} and can only handle data types up to 25/", + "bogus tag, minor plus 4"); + # And check again that this croak is not delayed: + { + # local $Storable::DEBUGME = 1; + local $Storable::accept_future_minor = 0; + test_corrupt ($copy, $sub, + "/^Storable binary image v$header->{major}\.$minor4 more recent than I am \\(v$header->{major}\.$minor\\)/", + "higher minor"); + } } sub slurp {