don't recurse infinitely in Data::Dumper

Add a configuration variable/option to limit recursion when dumping
deep data structures.

Defaults the limit to 1000, which can be reduced or increase, or
eliminated by setting it to 0.

This patch addresses CVE-2014-4330.  This bug was found and
reported by: LSE Leading Security Experts GmbH employee Markus
Vervier.

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");
+}