On Fri, Oct 24, 2014 at 10:40:55PM +0200, Alexander Bluhm wrote:
> Here is the diff that applies to -current. I have compared it with
> the perl git and with Data::Dumper on CPAN. It looks correct.
I have forgotten to cvs add dist/Data-Dumper/t/recurse.t
so here is the diff with the new test.
ok?
bluhm
Index: gnu/usr.bin/perl/MANIFEST
===================================================================
RCS file: /data/mirror/openbsd/cvs/src/gnu/usr.bin/perl/MANIFEST,v
retrieving revision 1.29
diff -u -p -u -p -r1.29 MANIFEST
--- gnu/usr.bin/perl/MANIFEST 24 Mar 2014 15:05:12 -0000 1.29
+++ gnu/usr.bin/perl/MANIFEST 24 Oct 2014 20:19:35 -0000
@@ -3155,6 +3155,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
Index: gnu/usr.bin/perl/patchlevel.h
===================================================================
RCS file: /data/mirror/openbsd/cvs/src/gnu/usr.bin/perl/patchlevel.h,v
retrieving revision 1.34
diff -u -p -u -p -r1.34 patchlevel.h
--- gnu/usr.bin/perl/patchlevel.h 5 Sep 2014 06:53:07 -0000 1.34
+++ gnu/usr.bin/perl/patchlevel.h 24 Oct 2014 20:25:05 -0000
@@ -134,6 +134,7 @@ hunk.
static const char * const local_patches[] = {
NULL
,"Update libnet to 1.27"
+ ,"CVE-2014-4330"
#ifdef PERL_GIT_UNCOMMITTED_CHANGES
,"uncommitted-changes"
#endif
Index: gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm
===================================================================
RCS file:
/data/mirror/openbsd/cvs/src/gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm,v
retrieving revision 1.1.1.3
diff -u -p -u -p -r1.1.1.3 Dumper.pm
--- gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm 24 Mar 2014 14:58:59 -0000
1.1.1.3
+++ gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm 24 Oct 2014 20:19:35 -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'};
@@ -1105,6 +1118,16 @@ we don't venture into a structure. Has
C<Data::Dumper::Purity> is set. (Useful in debugger when we often don't
want to see more than enough). Default is 0, which means there is
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 *
Index: gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs
===================================================================
RCS file:
/data/mirror/openbsd/cvs/src/gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs,v
retrieving revision 1.1.1.3
diff -u -p -u -p -r1.1.1.3 Dumper.xs
--- gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs 24 Mar 2014 14:58:59 -0000
1.1.1.3
+++ gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs 24 Oct 2014 20:22:57 -0000
@@ -26,7 +26,8 @@ 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 +299,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 +476,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 +529,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 +537,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 +549,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 +622,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 +829,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 +1038,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 +1118,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 +1207,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 +1288,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);
+ bless, maxdepth, sortkeys, use_sparse_seen_hash,
+ maxrecurse);
SPAGAIN;
if (indent >= 2 && !terse)
Index: gnu/usr.bin/perl/dist/Data-Dumper/t/recurse.t
===================================================================
RCS file: gnu/usr.bin/perl/dist/Data-Dumper/t/recurse.t
diff -N gnu/usr.bin/perl/dist/Data-Dumper/t/recurse.t
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ gnu/usr.bin/perl/dist/Data-Dumper/t/recurse.t 24 Oct 2014 20:21:37
-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");
+}
