Michael Schröder
65f6990c26
OBS-URL: https://build.opensuse.org/package/show/devel:languages:perl/perl?expand=0&rev=124
237 lines
9.5 KiB
Diff
237 lines
9.5 KiB
Diff
--- ./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<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-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");
|
|
+}
|