Storable's recursion check fires even in unproblematic cases #16606
Comments
From @eserteThis is a bug report for perl from slaven@rezic.de, The recursion check introduced in Storable 3.x croaks in cases $ perl5.28.0 -E 'use Storable qw(dclone); say "version=",$Storable::VERSION; say "limit=",$Storable::recursion_limit; my @tt; for (1..16000) { my $t = [[[]]]; push @tt, $t } dclone \@tt' (Depending on the calculated recursion_limit the number of iterations This is not a problem with earlier Storable versions, even with much more $ perl5.26.2 -E 'use Storable qw(dclone); say "version=",$Storable::VERSION; say "limit=",$Storable::recursion_limit; my @tt; for (1..1_000_000) { my $t = [[[]]]; push @tt, $t } dclone \@tt' If $Storable::DEBUGME is set (and a debugging perl is available), BTW: Storable's bug queue currently points to rt.perl.org. But Flags: Site configuration information for perl 5.28.0: Configured by eserte at Sat Jun 23 08:28:02 CEST 2018. Summary of my perl5 (revision 5 version 28 subversion 0) configuration: @INC for perl 5.28.0: Environment for perl 5.28.0: |
From @eserteDana Tue, 03 Jul 2018 01:40:45 -0700, slaven@rezic.de reče:
Same problem also with the latest Storable, 3.11.
|
From @eserteDana Tue, 03 Jul 2018 02:03:42 -0700, slaven@rezic.de reče:
On the other hand, it's still possible to bypass the recursion check, e.g. with the following oneliner: $ perl5.28.0 -E 'use Storable qw(dclone); say "version=", $Storable::VERSION; $t = [{1,2},$t] for 1..30000; dclone $t' Looking at Storable.xs I don't understand how cxt->recur_sv is supposed to work. Wouldn't it be more correct (and the code much simpler) if the depth variable is incremented on _every_ internal function call and decremented on every exit? |
From @eserteDana Tue, 03 Jul 2018 01:40:45 -0700, slaven@rezic.de reče:
Ping. |
From @tonycozOn Fri, 03 Aug 2018 08:06:35 -0700, slaven@rezic.de wrote:
I'll take a look at this. Tony |
|
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Fri, 03 Aug 2018 08:06:35 -0700, slaven@rezic.de wrote:
Please try the attached. Tony |
From @tonycoz0001-perl-133326-fix-and-clarify-handling-of-recurs_sv.patchFrom eb7c3f5f968a14ca81758bfc49d795469834f013 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 7 Aug 2018 15:34:06 +1000
Subject: (perl #133326) fix and clarify handling of recurs_sv.
There were a few problems:
- the purpose of recur_sv wasn't clear, I believe I understand it
now from looking at where recur_sv was actually being used.
Frankly the logic of the code itself was hard to follow, apparently
only counting a level if the recur_sv was equal to the current
SV.
Fixed by adding some documentation to recur_sv in the context
structure. The logic has been re-worked (see below) to hopefully
make it more understandable.
- the conditional checks for inc/decrementing recur_depth didn't
match between the beginnings and ends of the store_array() and
store_hash() handlers didn't match, since recur_sv was both
explicitly modified by those functions and implicitly modified
in their recursive calls to process elements.
Fixing by storing the starting value of cxt->recur_sv locally
testing against that instead of against the value that might be
modified recursively.
- the checks in store_ref(), store_array(), store_l?hash() were
over complex, obscuring their purpose.
Fixed by:
- always count a recursion level in store_ref() and store the
RV in recur_sv
- only count a recursion level in the array/hash handlers if
the SV didn't match.
- skip the check against cxt->entry, if we're in this code
we could be recursing, so we want to detect it.
- (after the other changes) the recursion checks in store_hash()/
store_lhash() only checked the limit if the SV didn't match the
recur_sv, which horribly broke things.
Fixed by:
- Now only make the depth increment conditional, and always
check against the limit if one is set.
---
dist/Storable/Storable.xs | 98 ++++++++++++++++++++++++++++++-----------------
dist/Storable/t/recurse.t | 16 +++++++-
2 files changed, 77 insertions(+), 37 deletions(-)
diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
index 6a90e24814..f6df32b121 100644
--- a/dist/Storable/Storable.xs
+++ b/dist/Storable/Storable.xs
@@ -418,6 +418,24 @@ typedef struct stcxt {
SV *(**retrieve_vtbl)(pTHX_ struct stcxt *, const char *); /* retrieve dispatch table */
SV *prev; /* contexts chained backwards in real recursion */
SV *my_sv; /* the blessed scalar who's SvPVX() I am */
+
+ /* recur_sv:
+
+ A hashref of hashrefs or arrayref of arrayrefs is actually a
+ chain of four SVs, eg for an array ref containing an array ref:
+
+ RV -> AV (element) -> RV -> AV
+
+ To make this depth appear natural from a perl level we only
+ want to count this as two levels, so store_ref() stores it's RV
+ into recur_sv and store_array()/store_hash() will only count
+ that level if the AV/HV *isn't* recur_sv.
+
+ We can't just have store_hash()/store_array() not count that
+ level, since it's possible for XS code to store an AV or HV
+ directly as an element (though perl code trying to access such
+ an object will generally croak.)
+ */
SV *recur_sv; /* check only one recursive SV */
int in_retrieve_overloaded; /* performance hack for retrieving overloaded objects */
int flags; /* controls whether to bless or tie objects */
@@ -431,8 +449,13 @@ typedef struct stcxt {
#define RECURSION_TOO_DEEP() \
(cxt->max_recur_depth != -1 && ++cxt->recur_depth > cxt->max_recur_depth)
+
+/* There's cases where we need to check whether the hash recursion
+ limit has been reached without bumping the recursion levels, so the
+ hash check doesn't bump the depth.
+*/
#define RECURSION_TOO_DEEP_HASH() \
- (cxt->max_recur_depth_hash != -1 && ++cxt->recur_depth > cxt->max_recur_depth_hash)
+ (cxt->max_recur_depth_hash != -1 && cxt->recur_depth > cxt->max_recur_depth_hash)
#define MAX_DEPTH_ERROR "Max. recursion depth with nested structures exceeded"
static int storable_free(pTHX_ SV *sv, MAGIC* mg);
@@ -2360,21 +2383,20 @@ static int store_ref(pTHX_ stcxt_t *cxt, SV *sv)
} else
PUTMARK(is_weak ? SX_WEAKREF : SX_REF);
- TRACEME(("recur_depth %" IVdf ", recur_sv (0x%" UVxf ")", cxt->recur_depth,
- PTR2UV(cxt->recur_sv)));
- if (cxt->entry && cxt->recur_sv == sv) {
- if (RECURSION_TOO_DEEP()) {
+ cxt->recur_sv = sv;
+
+ TRACEME((">ref recur_depth %" IVdf ", recur_sv (0x%" UVxf ") max %" IVdf, cxt->recur_depth,
+ PTR2UV(cxt->recur_sv), cxt->max_recur_depth));
+ if (RECURSION_TOO_DEEP()) {
#if PERL_VERSION < 15
- cleanup_recursive_data(aTHX_ (SV*)sv);
+ cleanup_recursive_data(aTHX_ (SV*)sv);
#endif
- CROAK((MAX_DEPTH_ERROR));
- }
+ CROAK((MAX_DEPTH_ERROR));
}
- cxt->recur_sv = sv;
retval = store(aTHX_ cxt, sv);
- if (cxt->entry && cxt->recur_sv == sv && cxt->recur_depth > 0) {
- TRACEME(("recur_depth --%" IVdf, cxt->recur_depth));
+ if (cxt->max_recur_depth != -1 && cxt->recur_depth > 0) {
+ TRACEME(("<ref recur_depth --%" IVdf, cxt->recur_depth));
--cxt->recur_depth;
}
return retval;
@@ -2635,6 +2657,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
UV len = av_len(av) + 1;
UV i;
int ret;
+ SV *const recur_sv = cxt->recur_sv;
TRACEME(("store_array (0x%" UVxf ")", PTR2UV(av)));
@@ -2659,9 +2682,9 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
TRACEME(("size = %d", (int)l));
}
- TRACEME(("recur_depth %" IVdf ", recur_sv (0x%" UVxf ")", cxt->recur_depth,
- PTR2UV(cxt->recur_sv)));
- if (cxt->entry && cxt->recur_sv == (SV*)av) {
+ TRACEME((">array recur_depth %" IVdf ", recur_sv (0x%" UVxf ") max %" IVdf, cxt->recur_depth,
+ PTR2UV(cxt->recur_sv), cxt->max_recur_depth));
+ if (recur_sv != (SV*)av) {
if (RECURSION_TOO_DEEP()) {
/* with <= 5.14 it recurses in the cleanup also, needing 2x stack size */
#if PERL_VERSION < 15
@@ -2670,7 +2693,6 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
CROAK((MAX_DEPTH_ERROR));
}
}
- cxt->recur_sv = (SV*)av;
/*
* Now store each item recursively.
@@ -2701,9 +2723,12 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
return ret;
}
- if (cxt->entry && cxt->recur_sv == (SV*)av && cxt->recur_depth > 0) {
- TRACEME(("recur_depth --%" IVdf, cxt->recur_depth));
- --cxt->recur_depth;
+ if (recur_sv != (SV*)av) {
+ assert(cxt->max_recur_depth == -1 || cxt->recur_depth > 0);
+ if (cxt->max_recur_depth != -1 && cxt->recur_depth > 0) {
+ TRACEME(("<array recur_depth --%" IVdf, cxt->recur_depth));
+ --cxt->recur_depth;
+ }
}
TRACEME(("ok (array)"));
@@ -2766,6 +2791,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
#endif
) ? 1 : 0);
unsigned char hash_flags = (SvREADONLY(hv) ? SHV_RESTRICTED : 0);
+ SV * const recur_sv = cxt->recur_sv;
/*
* Signal hash by emitting SX_HASH, followed by the table length.
@@ -2817,17 +2843,17 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
TRACEME(("size = %d, used = %d", (int)l, (int)HvUSEDKEYS(hv)));
}
- TRACEME(("recur_depth %" IVdf ", recur_sv (0x%" UVxf ")", cxt->recur_depth,
- PTR2UV(cxt->recur_sv)));
- if (cxt->entry && cxt->recur_sv == (SV*)hv) {
- if (RECURSION_TOO_DEEP_HASH()) {
+ TRACEME((">hash recur_depth %" IVdf ", recur_sv (0x%" UVxf ") max %" IVdf, cxt->recur_depth,
+ PTR2UV(cxt->recur_sv), cxt->max_recur_depth_hash));
+ if (recur_sv != (SV*)hv && cxt->max_recur_depth_hash != -1) {
+ ++cxt->recur_depth;
+ }
+ if (RECURSION_TOO_DEEP_HASH()) {
#if PERL_VERSION < 15
- cleanup_recursive_data(aTHX_ (SV*)hv);
+ cleanup_recursive_data(aTHX_ (SV*)hv);
#endif
- CROAK((MAX_DEPTH_ERROR));
- }
+ CROAK((MAX_DEPTH_ERROR));
}
- cxt->recur_sv = (SV*)hv;
/*
* Save possible iteration state via each() on that table.
@@ -3107,8 +3133,9 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
TRACEME(("ok (hash 0x%" UVxf ")", PTR2UV(hv)));
out:
- if (cxt->entry && cxt->recur_sv == (SV*)hv && cxt->recur_depth > 0) {
- TRACEME(("recur_depth --%" IVdf , cxt->recur_depth));
+ assert(cxt->max_recur_depth_hash != -1 && cxt->recur_depth > 0);
+ TRACEME(("<hash recur_depth --%" IVdf , cxt->recur_depth));
+ if (cxt->max_recur_depth_hash != -1 && recur_sv != (SV*)hv && cxt->recur_depth > 0) {
--cxt->recur_depth;
}
HvRITER_set(hv, riter); /* Restore hash iterator state */
@@ -3221,6 +3248,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
#ifdef DEBUGME
UV len = (UV)HvTOTALKEYS(hv);
#endif
+ SV * const recur_sv = cxt->recur_sv;
if (hash_flags) {
TRACEME(("store_lhash (0x%" UVxf ") (flags %x)", PTR2UV(hv),
(int) hash_flags));
@@ -3231,15 +3259,15 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
TRACEME(("recur_depth %" IVdf ", recur_sv (0x%" UVxf ")", cxt->recur_depth,
PTR2UV(cxt->recur_sv)));
- if (cxt->entry && cxt->recur_sv == (SV*)hv) {
- if (RECURSION_TOO_DEEP_HASH()) {
+ if (recur_sv != (SV*)hv && cxt->max_recur_depth_hash != -1) {
+ ++cxt->recur_depth;
+ }
+ if (RECURSION_TOO_DEEP_HASH()) {
#if PERL_VERSION < 15
- cleanup_recursive_data(aTHX_ (SV*)hv);
+ cleanup_recursive_data(aTHX_ (SV*)hv);
#endif
- CROAK((MAX_DEPTH_ERROR));
- }
+ CROAK((MAX_DEPTH_ERROR));
}
- cxt->recur_sv = (SV*)hv;
array = HvARRAY(hv);
for (i = 0; i <= (Size_t)HvMAX(hv); i++) {
@@ -3252,7 +3280,7 @@ static int store_lhash(pTHX_ stcxt_t *cxt, HV *hv, unsigned char hash_flags)
return ret;
}
}
- if (cxt->entry && cxt->recur_sv == (SV*)hv && cxt->recur_depth > 0) {
+ if (recur_sv == (SV*)hv && cxt->max_recur_depth_hash != -1 && cxt->recur_depth > 0) {
TRACEME(("recur_depth --%" IVdf, cxt->recur_depth));
--cxt->recur_depth;
}
diff --git a/dist/Storable/t/recurse.t b/dist/Storable/t/recurse.t
index fa8be0b374..63fde90fdf 100644
--- a/dist/Storable/t/recurse.t
+++ b/dist/Storable/t/recurse.t
@@ -20,7 +20,7 @@ use Storable qw(freeze thaw dclone);
$Storable::flags = Storable::FLAGS_COMPAT;
-use Test::More tests => 38;
+use Test::More tests => 39;
package OBJ_REAL;
@@ -364,5 +364,17 @@ else {
dclone $t;
};
like $@, qr/Max\. recursion depth with nested structures exceeded/,
- 'Caught href stack overflow '.MAX_DEPTH*2;
+ 'Caught href stack overflow '.MAX_DEPTH_HASH*2;
+}
+
+{
+ # perl #133326
+ my @tt;
+ #$Storable::DEBUGME=1;
+ for (1..16000) {
+ my $t = [[[]]];
+ push @tt, $t;
+ }
+ ok(eval { dclone \@tt; 1 },
+ "low depth structure shouldn't be treated as nested");
}
--
2.11.0
|
|
@tonycoz - Status changed from 'open' to 'pending release' |
From @khwilliamsonThank you for filing this report. You have helped make Perl better. With the release today of Perl 5.30.0, this and 160 other issues have been Perl 5.30.0 may be downloaded via: If you find that the problem persists, feel free to reopen this ticket. |
|
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#133326 (status was 'resolved')
Searchable as RT133326$
The text was updated successfully, but these errors were encountered: