File DataDumper-no-infinite-recursion.diff of Package perl.6851
--- ./MANIFEST.orig 2014-01-06 22:46:42.000000000 +0000
+++ ./MANIFEST 2014-09-23 11:30:46.892942675 +0000
@@ -3150,6 +3150,7 @@ dist/Data-Dumper/t/perl-74170.t Regressi
dist/Data-Dumper/t/purity_deepcopy_maxdepth.t See if three Data::Dumper functions work
dist/Data-Dumper/t/qr.t See if Data::Dumper works with qr|/|
dist/Data-Dumper/t/quotekeys.t See if Data::Dumper::Quotekeys works
+dist/Data-Dumper/t/recurse.t See if Data::Dumper::Maxrecurse works
dist/Data-Dumper/t/seen.t See if Data::Dumper::Seen works
dist/Data-Dumper/t/sortkeys.t See if Data::Dumper::Sortkeys works
dist/Data-Dumper/t/sparseseen.t See if Data::Dumper::Sparseseen works
--- ./dist/Data-Dumper/Dumper.pm.orig 2014-01-06 22:46:44.000000000 +0000
+++ ./dist/Data-Dumper/Dumper.pm 2014-09-23 11:30:46.894942668 +0000
@@ -56,6 +56,7 @@ $Useperl = 0 unless defined $
$Sortkeys = 0 unless defined $Sortkeys;
$Deparse = 0 unless defined $Deparse;
$Sparseseen = 0 unless defined $Sparseseen;
+$Maxrecurse = 1000 unless defined $Maxrecurse;
#
# expects an arrayref of values to be dumped.
@@ -92,6 +93,7 @@ sub new {
'bless' => $Bless, # keyword to use for "bless"
# expdepth => $Expdepth, # cutoff depth for explicit dumping
maxdepth => $Maxdepth, # depth beyond which we give up
+ maxrecurse => $Maxrecurse, # depth beyond which we abort
useperl => $Useperl, # use the pure Perl implementation
sortkeys => $Sortkeys, # flag or filter for sorting hash keys
deparse => $Deparse, # use B::Deparse for coderefs
@@ -351,6 +353,12 @@ sub _dump {
return qq['$val'];
}
+ # avoid recursing infinitely [perl #122111]
+ if ($s->{maxrecurse} > 0
+ and $s->{level} >= $s->{maxrecurse}) {
+ die "Recursion limit of $s->{maxrecurse} exceeded";
+ }
+
# we have a blessed ref
my ($blesspad);
if ($realpack and !$no_bless) {
@@ -683,6 +691,11 @@ sub Maxdepth {
defined($v) ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'};
}
+sub Maxrecurse {
+ my($s, $v) = @_;
+ defined($v) ? (($s->{'maxrecurse'} = $v), return $s) : $s->{'maxrecurse'};
+}
+
sub Useperl {
my($s, $v) = @_;
defined($v) ? (($s->{'useperl'} = $v), return $s) : $s->{'useperl'};
@@ -1108,6 +1121,16 @@ no maximum depth.
=item *
+$Data::Dumper::Maxrecurse I<or> $I<OBJ>->Maxrecurse(I<[NEWVAL]>)
+
+Can be set to a positive integer that specifies the depth beyond which
+recursion into a structure will throw an exception. This is intended
+as a security measure to prevent perl running out of stack space when
+dumping an excessively deep structure. Can be set to 0 to remove the
+limit. Default is 1000.
+
+=item *
+
$Data::Dumper::Useperl I<or> $I<OBJ>->Useperl(I<[NEWVAL]>)
Can be set to a boolean value which controls whether the pure Perl
--- ./dist/Data-Dumper/Dumper.xs.orig 2014-01-06 22:46:44.000000000 +0000
+++ ./dist/Data-Dumper/Dumper.xs 2014-09-23 11:33:34.937179756 +0000
@@ -26,7 +26,7 @@ static I32 DD_dump (pTHX_ SV *val, const
SV *pad, SV *xpad, SV *apad, SV *sep, SV *pair,
SV *freezer, SV *toaster,
I32 purity, I32 deepcopy, I32 quotekeys, SV *bless,
- I32 maxdepth, SV *sortkeys, int use_sparse_seen_hash);
+ I32 maxdepth, SV *sortkeys, int use_sparse_seen_hash, IV maxrecurse);
#ifndef HvNAME_get
#define HvNAME_get HvNAME
@@ -298,7 +298,7 @@ DD_dump(pTHX_ SV *val, const char *name,
AV *postav, I32 *levelp, I32 indent, SV *pad, SV *xpad,
SV *apad, SV *sep, SV *pair, SV *freezer, SV *toaster, I32 purity,
I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth, SV *sortkeys,
- int use_sparse_seen_hash)
+ int use_sparse_seen_hash, IV maxrecurse)
{
char tmpbuf[128];
U32 i;
@@ -475,6 +475,10 @@ DD_dump(pTHX_ SV *val, const char *name,
return 1;
}
+ if (maxrecurse > 0 && *levelp >= maxrecurse) {
+ croak("Recursion limit of %" IVdf " exceeded", maxrecurse);
+ }
+
if (realpack && !no_bless) { /* we have a blessed ref */
STRLEN blesslen;
const char * const blessstr = SvPV(bless, blesslen);
@@ -524,7 +528,7 @@ DD_dump(pTHX_ SV *val, const char *name,
DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
postav, levelp, indent, pad, xpad, apad, sep, pair,
freezer, toaster, purity, deepcopy, quotekeys, bless,
- maxdepth, sortkeys, use_sparse_seen_hash);
+ maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse);
sv_catpvn(retval, ")}", 2);
} /* plain */
else {
@@ -532,7 +536,7 @@ DD_dump(pTHX_ SV *val, const char *name,
DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
postav, levelp, indent, pad, xpad, apad, sep, pair,
freezer, toaster, purity, deepcopy, quotekeys, bless,
- maxdepth, sortkeys, use_sparse_seen_hash);
+ maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse);
}
SvREFCNT_dec(namesv);
}
@@ -544,7 +548,7 @@ DD_dump(pTHX_ SV *val, const char *name,
DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
postav, levelp, indent, pad, xpad, apad, sep, pair,
freezer, toaster, purity, deepcopy, quotekeys, bless,
- maxdepth, sortkeys, use_sparse_seen_hash);
+ maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse);
SvREFCNT_dec(namesv);
}
else if (realtype == SVt_PVAV) {
@@ -617,7 +621,7 @@ DD_dump(pTHX_ SV *val, const char *name,
DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
levelp, indent, pad, xpad, apad, sep, pair,
freezer, toaster, purity, deepcopy, quotekeys, bless,
- maxdepth, sortkeys, use_sparse_seen_hash);
+ maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse);
if (ix < ixmax)
sv_catpvn(retval, ",", 1);
}
@@ -824,7 +828,7 @@ DD_dump(pTHX_ SV *val, const char *name,
DD_dump(aTHX_ hval, SvPVX_const(sname), SvCUR(sname), retval, seenhv,
postav, levelp, indent, pad, xpad, newapad, sep, pair,
freezer, toaster, purity, deepcopy, quotekeys, bless,
- maxdepth, sortkeys, use_sparse_seen_hash);
+ maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse);
SvREFCNT_dec(sname);
Safefree(nkey_buffer);
if (indent >= 2)
@@ -1033,7 +1037,7 @@ DD_dump(pTHX_ SV *val, const char *name,
seenhv, postav, &nlevel, indent, pad, xpad,
newapad, sep, pair, freezer, toaster, purity,
deepcopy, quotekeys, bless, maxdepth,
- sortkeys, use_sparse_seen_hash);
+ sortkeys, use_sparse_seen_hash, maxrecurse);
SvREFCNT_dec(e);
}
}
@@ -1113,6 +1117,7 @@ Data_Dumper_Dumpxs(href, ...)
SV *val, *name, *pad, *xpad, *apad, *sep, *pair, *varname;
SV *freezer, *toaster, *bless, *sortkeys;
I32 purity, deepcopy, quotekeys, maxdepth = 0;
+ IV maxrecurse = 1000;
char tmpbuf[1024];
I32 gimme = GIMME;
int use_sparse_seen_hash = 0;
@@ -1201,6 +1206,8 @@ Data_Dumper_Dumpxs(href, ...)
bless = *svp;
if ((svp = hv_fetch(hv, "maxdepth", 8, FALSE)))
maxdepth = SvIV(*svp);
+ if ((svp = hv_fetch(hv, "maxrecurse", 10, FALSE)))
+ maxrecurse = SvIV(*svp);
if ((svp = hv_fetch(hv, "sortkeys", 8, FALSE))) {
sortkeys = *svp;
if (! SvTRUE(sortkeys))
@@ -1280,7 +1287,7 @@ Data_Dumper_Dumpxs(href, ...)
DD_dump(aTHX_ val, SvPVX_const(name), SvCUR(name), valstr, seenhv,
postav, &level, indent, pad, xpad, newapad, sep, pair,
freezer, toaster, purity, deepcopy, quotekeys,
- bless, maxdepth, sortkeys, use_sparse_seen_hash);
+ bless, maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse);
SPAGAIN;
if (indent >= 2 && !terse)
--- ./dist/Data-Dumper/t/recurse.t.orig 2014-09-23 11:30:46.896942659 +0000
+++ ./dist/Data-Dumper/t/recurse.t 2014-09-23 11:30:46.896942659 +0000
@@ -0,0 +1,45 @@
+#!perl
+
+# Test the Maxrecurse option
+
+use strict;
+use Test::More tests => 32;
+use Data::Dumper;
+
+SKIP: {
+ skip "no XS available", 16
+ if $Data::Dumper::Useperl;
+ local $Data::Dumper::Useperl = 1;
+ test_recursion();
+}
+
+test_recursion();
+
+sub test_recursion {
+ my $pp = $Data::Dumper::Useperl ? "pure perl" : "XS";
+ $Data::Dumper::Purity = 1; # make sure this has no effect
+ $Data::Dumper::Indent = 0;
+ $Data::Dumper::Maxrecurse = 1;
+ is(eval { Dumper([]) }, '$VAR1 = [];', "$pp: maxrecurse 1, []");
+ is(eval { Dumper([[]]) }, undef, "$pp: maxrecurse 1, [[]]");
+ ok($@, "exception thrown");
+ is(eval { Dumper({}) }, '$VAR1 = {};', "$pp: maxrecurse 1, {}");
+ is(eval { Dumper({ a => 1 }) }, q($VAR1 = {'a' => 1};),
+ "$pp: maxrecurse 1, { a => 1 }");
+ is(eval { Dumper({ a => {} }) }, undef, "$pp: maxrecurse 1, { a => {} }");
+ ok($@, "exception thrown");
+ is(eval { Dumper(\1) }, "\$VAR1 = \\1;", "$pp: maxrecurse 1, \\1");
+ is(eval { Dumper(\\1) }, undef, "$pp: maxrecurse 1, \\1");
+ ok($@, "exception thrown");
+ $Data::Dumper::Maxrecurse = 3;
+ is(eval { Dumper(\1) }, "\$VAR1 = \\1;", "$pp: maxrecurse 3, \\1");
+ is(eval { Dumper(\(my $s = {})) }, "\$VAR1 = \\{};", "$pp: maxrecurse 3, \\{}");
+ is(eval { Dumper(\(my $s = { a => [] })) }, "\$VAR1 = \\{'a' => []};",
+ "$pp: maxrecurse 3, \\{ a => [] }");
+ is(eval { Dumper(\(my $s = { a => [{}] })) }, undef,
+ "$pp: maxrecurse 3, \\{ a => [{}] }");
+ ok($@, "exception thrown");
+ $Data::Dumper::Maxrecurse = 0;
+ is(eval { Dumper([[[[[]]]]]) }, q($VAR1 = [[[[[]]]]];),
+ "$pp: check Maxrecurse doesn't set limit to 0 recursion");
+}
