summaryrefslogtreecommitdiff
path: root/dist/Data-Dumper
diff options
context:
space:
mode:
Diffstat (limited to 'dist/Data-Dumper')
-rw-r--r--dist/Data-Dumper/Dumper.pm25
-rw-r--r--dist/Data-Dumper/Dumper.xs32
-rw-r--r--dist/Data-Dumper/t/recurse.t45
3 files changed, 92 insertions, 10 deletions
diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm
index 9afeac77b7..4557060b87 100644
--- a/dist/Data-Dumper/Dumper.pm
+++ b/dist/Data-Dumper/Dumper.pm
@@ -10,7 +10,7 @@
package Data::Dumper;
BEGIN {
- $VERSION = '2.152'; # Don't forget to set version and release
+ $VERSION = '2.153'; # Don't forget to set version and release
} # date in POD below!
#$| = 1;
@@ -56,6 +56,7 @@ $Useperl = 0 unless defined $Useperl;
$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<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
diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs
index 6356501d79..2ffa867b24 100644
--- a/dist/Data-Dumper/Dumper.xs
+++ b/dist/Data-Dumper/Dumper.xs
@@ -28,7 +28,7 @@ static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval,
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
@@ -413,7 +413,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
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;
@@ -590,6 +590,10 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
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);
@@ -676,7 +680,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
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_catpvs(retval, ")}");
} /* plain */
else {
@@ -684,7 +689,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
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);
}
@@ -696,7 +702,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
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) {
@@ -769,7 +776,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
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_catpvs(retval, ",");
}
@@ -981,7 +989,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
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)
@@ -1190,7 +1199,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
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);
}
}
@@ -1280,6 +1290,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;
@@ -1366,6 +1377,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))
@@ -1445,7 +1458,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)
diff --git a/dist/Data-Dumper/t/recurse.t b/dist/Data-Dumper/t/recurse.t
new file mode 100644
index 0000000000..275a89d236
--- /dev/null
+++ b/dist/Data-Dumper/t/recurse.t
@@ -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");
+}
View Lorry Controller Status