Hi, I created a patch for CVE-2014-4330 in Data::Dumper, Version 2.145. Derived from http://perl5.git.perl.org/perl.git/commitdiff/19be3be6968e2337bcdfe480693fff795ecd1304 See below.
Regards, Max Pascher --- gnu/usr.bin/perl/MANIFEST.orig Tue Sep 30 08:51:52 2014 +++ gnu/usr.bin/perl/MANIFEST Tue Sep 30 08:52:35 2014 @@ -3155,6 +3155,7 @@ dist/Data-Dumper/t/perl-74170.t Regression test for st 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 --- gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm.orig Tue Sep 30 08:52:51 2014 +++ gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm Tue Sep 30 08:55:32 2014 @@ -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 @@ -351,6 +353,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) { @@ -683,6 +691,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 @@ we don't venture into a structure. Has no effect when C<Data::Dumper::Purity> is set. (Useful in debugger when we often don't want to see more than enough). Default is 0, which means there is 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 * --- gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs.orig Tue Sep 30 08:55:39 2014 +++ gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs Tue Sep 30 08:59:08 2014 @@ -26,7 +26,8 @@ static I32 DD_dump (pTHX_ SV *val, const char *name, S 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 maxdepth, SV *sortkeys, int use_sparse_seen_hash, + IV maxrecurse); #ifndef HvNAME_get #define HvNAME_get HvNAME @@ -298,7 +299,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namele 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) + int use_sparse_seen_hash, IV maxrecurse) { char tmpbuf[128]; U32 i; @@ -475,6 +476,10 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namele 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); @@ -524,7 +529,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namele 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); + maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse); sv_catpvn(retval, ")}", 2); } /* plain */ else { @@ -532,7 +537,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namele 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); + maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse); } SvREFCNT_dec(namesv); } @@ -544,7 +549,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namele 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); + maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse); SvREFCNT_dec(namesv); } else if (realtype == SVt_PVAV) { @@ -617,7 +622,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namele 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); + maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse); if (ix < ixmax) sv_catpvn(retval, ",", 1); } @@ -824,7 +829,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namele 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); + maxdepth, sortkeys, use_sparse_seen_hash, maxrecurse); SvREFCNT_dec(sname); Safefree(nkey_buffer); if (indent >= 2) @@ -1033,7 +1038,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namele seenhv, postav, &nlevel, indent, pad, xpad, newapad, sep, pair, freezer, toaster, purity, deepcopy, quotekeys, bless, maxdepth, - sortkeys, use_sparse_seen_hash); + sortkeys, use_sparse_seen_hash, maxrecurse); SvREFCNT_dec(e); } } @@ -1113,6 +1118,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; @@ -1201,6 +1207,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)) @@ -1280,7 +1288,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); + bless, maxdepth, sortkeys, use_sparse_seen_hash, + maxrecurse); SPAGAIN; if (indent >= 2 && !terse) --- /dev/null Tue Sep 30 09:02:47 2014 +++ gnu/usr.bin/perl/dist/Data-Dumper/t/recurse.t Tue Sep 30 09:00:04 2014 @@ -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"); +} --- gnu/usr.bin/perl/patchlevel.h.orig Thu Oct 9 12:31:31 2014 +++ gnu/usr.bin/perl/patchlevel.h Thu Oct 9 12:31:10 2014 @@ -133,6 +133,7 @@ hunk. # endif static const char * const local_patches[] = { NULL + ,"CVE-2014-4330" #ifdef PERL_GIT_UNCOMMITTED_CHANGES ,"uncommitted-changes" #endif -- genua Gesellschaft für Netzwerk - und Unix-Administration mbH Domagkstr. 7, D-85551 Kirchheim. http://www.genua.de Tel: (089) 99 19 50-0, Fax: (089) 99 10 50 - 999 Geschäftsführer: Dr. Magnus Harlander, Dr. Michaela Harlander, Bernhard Schneck. Amtsgericht München HRB 98238
signature.asc
Description: This is a digitally signed message part.