This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
don't recurse infinitely in Data::Dumper
authorTony Cook <tony@develop-help.com>
Mon, 30 Jun 2014 02:16:03 +0000 (12:16 +1000)
committerRicardo Signes <rjbs@cpan.org>
Thu, 18 Sep 2014 13:06:21 +0000 (09:06 -0400)
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.

MANIFEST
dist/Data-Dumper/Dumper.pm
dist/Data-Dumper/Dumper.xs
dist/Data-Dumper/t/recurse.t [new file with mode: 0644]

index 26e80b4..f5b5464 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2873,6 +2873,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
index 9afeac7..4557060 100644 (file)
@@ -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
index 6356501..2ffa867 100644 (file)
@@ -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 (file)
index 0000000..275a89d
--- /dev/null
@@ -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");
+}