Attachment 935700 Details for Bug 1139700 – Upstream provided patch

[patch] Upstream provided patch

0001-perl-122111-don-t-recurse-infinitely-in-Data-Dumper.patch (text/plain), 10.95 KB, created by Vasyl Kaigorodov on 2014-09-09 13:29:53 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Vasyl Kaigorodov

Created: 2014-09-09 13:29:53 UTC

Size: 10.95 KB

patch

obsolete

>From 0d873a8cd31b74556652ebe1235dc50d59d06b49 Mon Sep 17 00:00:00 2001
>From: Tony Cook <tony@develop-help.com>
>Date: Mon, 30 Jun 2014 12:16:03 +1000
>Subject: [PATCH] [perl #122111] 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.
>---
> MANIFEST                     |    1 +
> dist/Data-Dumper/Dumper.pm   |   25 ++++++++++++++++++++++-
> dist/Data-Dumper/Dumper.xs   |   32 +++++++++++++++++++++---------
> dist/Data-Dumper/t/recurse.t |   45 ++++++++++++++++++++++++++++++++++++++++++
> 4 files changed, 93 insertions(+), 10 deletions(-)
> create mode 100644 dist/Data-Dumper/t/recurse.t
>
>diff --git a/MANIFEST b/MANIFEST
>index 150cd5c..912433e 100644
>--- a/MANIFEST
>+++ b/MANIFEST
>@@ -2849,6 +2849,7 @@ dist/Data-Dumper/t/perl-74170.t	Regression test for stack reallocation
> 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
>diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm
>index 9afeac7..4557060 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 6356501..2ffa867 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 0000000..275a89d
>--- /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");
>+}
>-- 
>1.7.10.4
>

Actions: View | Diff

Attachments on bug 1139700: 935700