--- ./MANIFEST.orig 2014-09-14 11:30:59.000000000 +0000 +++ ./MANIFEST 2014-09-17 12:33:11.840499982 +0000 @@ -2994,6 +2994,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-09-14 11:31:01.000000000 +0000 +++ ./dist/Data-Dumper/Dumper.pm 2014-09-17 12:33:11.840499982 +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 @@ -350,6 +352,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) { @@ -680,6 +688,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'}; @@ -1105,6 +1118,16 @@ no maximum depth. =item * +$Data::Dumper::Maxrecurse I $I->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 $I->Useperl(I<[NEWVAL]>) Can be set to a boolean value which controls whether the pure Perl --- ./dist/Data-Dumper/Dumper.xs.orig 2014-09-14 11:31:01.000000000 +0000 +++ ./dist/Data-Dumper/Dumper.xs 2014-09-17 12:34:36.236138989 +0000 @@ -28,7 +28,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 useqq); + I32 maxdepth, SV *sortkeys, int use_sparse_seen_hash, I32 useqq, IV maxrecurse); #ifndef HvNAME_get #define HvNAME_get HvNAME @@ -412,7 +412,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, I32 useqq) + int use_sparse_seen_hash, I32 useqq, IV maxrecurse) { char tmpbuf[128]; Size_t i; @@ -589,6 +589,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); @@ -674,7 +678,8 @@ 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, useqq); + maxdepth, sortkeys, use_sparse_seen_hash, useqq, + maxrecurse); sv_catpvn(retval, ")}", 2); } /* plain */ else { @@ -682,7 +687,8 @@ 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, useqq); + maxdepth, sortkeys, use_sparse_seen_hash, useqq, + maxrecurse); } SvREFCNT_dec(namesv); } @@ -694,7 +700,8 @@ 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, useqq); + maxdepth, sortkeys, use_sparse_seen_hash, useqq, + maxrecurse); SvREFCNT_dec(namesv); } else if (realtype == SVt_PVAV) { @@ -767,7 +774,8 @@ 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, useqq); + maxdepth, sortkeys, use_sparse_seen_hash, + useqq, maxrecurse); if (ix < ixmax) sv_catpvn(retval, ",", 1); } @@ -970,7 +978,8 @@ 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, useqq); + maxdepth, sortkeys, use_sparse_seen_hash, useqq, + maxrecurse); SvREFCNT_dec(sname); Safefree(nkey_buffer); if (indent >= 2) @@ -1179,7 +1188,8 @@ 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, useqq); + sortkeys, use_sparse_seen_hash, useqq, + maxrecurse); SvREFCNT_dec(e); } } @@ -1269,6 +1279,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; @@ -1355,6 +1366,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)) @@ -1434,7 +1447,8 @@ 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, useqq); + bless, maxdepth, sortkeys, use_sparse_seen_hash, + useqq, maxrecurse); SPAGAIN; if (indent >= 2 && !terse) --- ./dist/Data-Dumper/t/recurse.t.orig 2014-09-17 12:33:11.841499978 +0000 +++ ./dist/Data-Dumper/t/recurse.t 2014-09-17 12:33:11.841499978 +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"); +}