On Sat, Sep 27, 2014 at 07:57:39PM +0100, Adam D. Barratt wrote: > On Thu, 2014-09-18 at 23:00 +0100, Dominic Hargreaves wrote: > > As announced in > > <http://www.nntp.perl.org/group/perl.perl5.porters/2014/09/msg220118.html> > > there is a probably-hard-to-exploit bug in the Data::Dumper module in > > perl. Updates are being prepared at > > > > <https://anonscm.debian.org/cgit/perl/perl.git/log/?h=wheezy-data-dumper-fix> > > > > The security team have called this one a no-dsa issue. Please let us know > > if it's okay to upload the fix to stable. > > From the current state of the above, it looks like it should be fine. > Please could we have a debdiff of the proposed upload attached to this > bug for a final confirmation? (For one thing it keeps the bug > self-contained; there's also no guarantee that the branch will still > exist in its current state for anyone looking in the future.)
Sure, here goes. Dominic.
diff -Nru perl-5.14.2/debian/changelog perl-5.14.2/debian/changelog --- perl-5.14.2/debian/changelog 2013-09-29 14:22:11.000000000 +0100 +++ perl-5.14.2/debian/changelog 2014-09-27 23:48:39.000000000 +0100 @@ -1,3 +1,10 @@ +perl (5.14.2-21+deb7u2) stable; urgency=low + + * [SECURITY] CVE-2014-4330: don't recurse infinitely in Data::Dumper + (Closes: #762256) + + -- Dominic Hargreaves <d...@earth.li> Sat, 27 Sep 2014 23:48:33 +0100 + perl (5.14.2-21+deb7u1) stable; urgency=low * Fix issue with shared references disappearing on sub return diff -Nru perl-5.14.2/debian/patches/fixes/data_dump_infinite_recurse.diff perl-5.14.2/debian/patches/fixes/data_dump_infinite_recurse.diff --- perl-5.14.2/debian/patches/fixes/data_dump_infinite_recurse.diff 1970-01-01 01:00:00.000000000 +0100 +++ perl-5.14.2/debian/patches/fixes/data_dump_infinite_recurse.diff 2014-09-27 23:47:48.000000000 +0100 @@ -0,0 +1,266 @@ +From ffa029bec251a964ed86c0b5fef689d2fa03811b Mon Sep 17 00:00:00 2001 +From: Tony Cook <t...@develop-help.com> +Date: Mon, 30 Jun 2014 12:16:03 +1000 +Subject: 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. + +This patch addresses CVE-2014-4330. This bug was found and +reported by: LSE Leading Security Experts GmbH employee Markus +Vervier. + +[Patch backported to 5.14 by Dominic Hargreaves for Debian.] + +Origin: http://perl5.git.perl.org/perl.git/commit/19be3be6968e2337bcdfe480693fff795ecd1304 +Patch-Name: fixes/data_dump_infinite_recurse.diff +--- + MANIFEST | 1 + + dist/Data-Dumper/Dumper.pm | 23 +++++++++++++++++++++ + dist/Data-Dumper/Dumper.xs | 26 +++++++++++++++--------- + dist/Data-Dumper/t/recurse.t | 45 ++++++++++++++++++++++++++++++++++++++++++ + 4 files changed, 86 insertions(+), 9 deletions(-) + create mode 100644 dist/Data-Dumper/t/recurse.t + +diff --git a/MANIFEST b/MANIFEST +index c426b9e..727c603 100644 +--- a/MANIFEST ++++ b/MANIFEST +@@ -2900,6 +2900,7 @@ dist/Data-Dumper/Todo Data pretty printer, futures + dist/Data-Dumper/t/overload.t See if Data::Dumper works for overloaded data + dist/Data-Dumper/t/pair.t See if Data::Dumper pair separator works + dist/Data-Dumper/t/perl-74170.t Regression test for stack reallocation ++dist/Data-Dumper/t/recurse.t See if Data::Dumper::Maxrecurse works + dist/Data-Dumper/t/terse.t See if Data::Dumper terse option works + dist/Devel-SelfStubber/lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm + dist/Devel-SelfStubber/t/Devel-SelfStubber.t See if Devel::SelfStubber works +diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm +index 1c68c98..32e4771 100644 +--- a/dist/Data-Dumper/Dumper.pm ++++ b/dist/Data-Dumper/Dumper.pm +@@ -53,6 +53,7 @@ $Pair = ' => ' unless defined $Pair; + $Useperl = 0 unless defined $Useperl; + $Sortkeys = 0 unless defined $Sortkeys; + $Deparse = 0 unless defined $Deparse; ++$Maxrecurse = 1000 unless defined $Maxrecurse; + + # + # expects an arrayref of values to be dumped. +@@ -89,6 +90,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 +@@ -339,6 +341,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 + if ($realpack and !$no_bless) { + $out = $s->{'bless'} . '( '; +@@ -650,6 +658,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'}; +@@ -1024,6 +1037,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 2c249db..b2f061a 100644 +--- a/dist/Data-Dumper/Dumper.xs ++++ b/dist/Data-Dumper/Dumper.xs +@@ -22,7 +22,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); ++ I32 maxdepth, SV *sortkeys, IV maxrecurse); + + #ifndef HvNAME_get + #define HvNAME_get HvNAME +@@ -266,7 +266,8 @@ static I32 + 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) ++ I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth, SV *sortkeys, ++ IV maxrecurse) + { + char tmpbuf[128]; + U32 i; +@@ -443,6 +444,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); +@@ -489,7 +494,7 @@ 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); ++ maxdepth, sortkeys, maxrecurse); + sv_catpvn(retval, ")}", 2); + } /* plain */ + else { +@@ -497,7 +502,7 @@ 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); ++ maxdepth, sortkeys, maxrecurse); + } + SvREFCNT_dec(namesv); + } +@@ -509,7 +514,7 @@ 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); ++ maxdepth, sortkeys, maxrecurse); + SvREFCNT_dec(namesv); + } + else if (realtype == SVt_PVAV) { +@@ -582,7 +587,7 @@ 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); ++ maxdepth, sortkeys, maxrecurse); + if (ix < ixmax) + sv_catpvn(retval, ",", 1); + } +@@ -789,7 +794,7 @@ 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); ++ maxdepth, sortkeys, maxrecurse); + SvREFCNT_dec(sname); + Safefree(nkey_buffer); + if (indent >= 2) +@@ -969,7 +974,7 @@ 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); ++ sortkeys, maxrecurse); + SvREFCNT_dec(e); + } + } +@@ -1035,6 +1040,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; + +@@ -1117,6 +1123,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)) +@@ -1196,7 +1204,7 @@ 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); ++ bless, maxdepth, sortkeys, 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"); ++} diff -Nru perl-5.14.2/debian/patches/series perl-5.14.2/debian/patches/series --- perl-5.14.2/debian/patches/series 2013-09-29 14:22:11.000000000 +0100 +++ perl-5.14.2/debian/patches/series 2014-09-27 23:47:48.000000000 +0100 @@ -86,3 +86,4 @@ fixes/list_util_off_by_two.diff fixes/sdbm_off_by_one.diff fixes/socket_unpack_sockaddr_un_heap_buffer_overflow.diff +fixes/data_dump_infinite_recurse.diff
