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");
++}
--
http://lists.linuxfromscratch.org/listinfo/patches
FAQ: http://www.linuxfromscratch.org/blfs/faq.html
Unsubscribe: See the above information page
