[lfs-patches] r3024 - trunk/perl

bdubbs at higgs.linuxfromscratch.org bdubbs at higgs.linuxfromscratch.org
Wed Oct 1 23:46:29 PDT 2014


Author: bdubbs
Date: Wed Oct  1 23:46:29 2014
New Revision: 3024

Log:
Add perl Data::Dumper recursion patch

Added:
   trunk/perl/perl-5.20.1-infinite_recurse_fix-1.patch

Added: trunk/perl/perl-5.20.1-infinite_recurse_fix-1.patch
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/perl/perl-5.20.1-infinite_recurse_fix-1.patch	Wed Oct  1 23:46:29 2014	(r3024)
@@ -0,0 +1,253 @@
+Submitted By:            Bruce Dubbs <bdubbs_at_linuxfromscratch_dot_org>
+Date:                    2014-09-30
+Initial Package Version: 7.6
+Upstream Status:         Already in upstream patch repo
+Origin:                  Upstream
+Description:             This patch contains a fix for CVE-2014-4330. 
+                         Prevnet infinite recursion in Data::Dumper.
+
+diff --git a/MANIFEST b/MANIFEST
+index f4f7404..867ea7d 100644
+--- a/MANIFEST
++++ b/MANIFEST
+@@ -2994,6 +2994,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 7c8a72c..49121ce 100644
+--- a/dist/Data-Dumper/Dumper.pm
++++ b/dist/Data-Dumper/Dumper.pm
+@@ -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 12c4ebd..49937be 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
+@@ -412,7 +412,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;
+@@ -589,6 +589,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);
+@@ -674,7 +678,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_catpvn(retval, ")}", 2);
+ 	    }						     /* plain */
+ 	    else {
+@@ -682,7 +687,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);
+ 	}
+@@ -694,7 +700,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) {
+@@ -767,7 +774,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_catpvn(retval, ",", 1);
+ 	    }
+@@ -970,7 +978,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)
+@@ -1179,7 +1188,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);
+ 		    }
+ 		}
+@@ -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)
+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");
++}


More information about the patches mailing list