Bug#762144: pu: package perl/5.14.2-21+deb7u1
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 <dom@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 <tony@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
Reply to: