File DataDumper-no-infinite-recursion.diff of Package perl

Overview Repositories Revisions Requests Users Attributes Meta

File DataDumper-no-infinite-recursion.diff of Package perl (Revision 3e3b2a7819d27294abc2ed93aa206221)

Currently displaying revision 3e3b2a7819d27294abc2ed93aa206221 , Show latest

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

Places

File DataDumper-no-infinite-recursion.diff of Package perl (Revision 3e3b2a7819d27294abc2ed93aa206221)

Places