Data::Dumper vul'n reported #13928
Comments
From @rjbsThis is the report I got via PGP message:
Here's the file: === LSE Leading Security Experts GmbH - Security Advisory LSE-2014-06-10 === Perl - Deep Recursion Stack Overflow Affected VersionsTested and affected: Perl v5.16.3 and v5.14.2 Issue OverviewTechnical Risk: high Issue DescriptionDuring internal development a stack overflow was discovered. The cause of the ImpactWhen the runtime stack grows over the maximal size, a guard page on most modern Temporary Workaround and FixApplications written in Perl should make sure that no unnecessary large Proof of Concept$ cat min.pl my $dumpme = []; $ gdb --args perl min.pl 20000 Program received signal SIGSEGV, Segmentation fault. History2014-06-10 Issue discovery during internal development -- |
From @nwc10On Mon, Jun 16, 2014 at 04:54:55AM -0700, Ricardo SIGNES wrote:
Bother. You can probably do something similar with Storable. And I'd failed to deal with the massive Storable refactoring patches because
That might be quite hard. Nicholas Clark |
|
The RT System itself - Status changed from 'new' to 'open' |
From @jhiOn Monday-201406-16, 8:03, Nicholas Clark wrote:
Another option is to keep track of which refs we have already gone through? |
From @demerphqOn 16 June 2014 14:03, Nicholas Clark <nick@ccl4.org> wrote:
Sereal has a compile time max C recursion depth of approximately 1000.
Yes. I agree. On the other hand a similar guard ala what Sereal does would Yves -- |
From @demerphqOn 16 June 2014 14:08, Jarkko Hietaniemi <jhi@iki.fi> wrote:
One need not keep track of every ref actually, although DD already does You only need to track items with a refcount>1. This is one of the tricks Sereal uses to be fast. If the refcount of the Yves -- |
From @rjbs* Ricardo SIGNES <perl5-security-report@perl.org> [2014-06-16T07:54:55]
Anybody care to take point on this and make an offer? :) The reporter provided a sploit, which I will provide once I get them -- |
From @demerphqWhat do you 'sploit? They actually were able to elevate perms? On 16 June 2014 18:17, Ricardo Signes <perl.security@rjbs.manxome.org>
-- |
From @rjbs* demerphq <demerphq@gmail.com> [2014-06-16T12:20:41]
Sorry, I had not decrypted their program before sending my previous message.
It just produces a crash. -- |
From @rjbs |
From @rjbs |
From @tonycozOn Mon Jun 16 09:18:24 2014, perl.security@rjbs.manxome.org wrote:
Data::Dumper already provides a depth limit in $Data::Dumper::Maxdepth, but this is ignored when Purity is true. I expect we need another configuration option, Maxrecurse that limits recursion, but instead of stringifying a reference, throws an exception. We'd throw an exception since the other option would be to provide output that doesn't eval to the input. Of course, some people will probably consider this an incompatible change. I've attached a candidate patch. Tony |
From @tonycoz0001-perl-122111-don-t-recurse-infinitely-in-Data-Dumper.patchFrom 0d873a8cd31b74556652ebe1235dc50d59d06b49 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 30 Jun 2014 12:16:03 +1000
Subject: [PATCH] [perl #122111] 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.
---
MANIFEST | 1 +
dist/Data-Dumper/Dumper.pm | 25 ++++++++++++++++++++++-
dist/Data-Dumper/Dumper.xs | 32 +++++++++++++++++++++---------
dist/Data-Dumper/t/recurse.t | 45 ++++++++++++++++++++++++++++++++++++++++++
4 files changed, 93 insertions(+), 10 deletions(-)
create mode 100644 dist/Data-Dumper/t/recurse.t
diff --git a/MANIFEST b/MANIFEST
index 150cd5c..912433e 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2849,6 +2849,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 9afeac7..4557060 100644
--- a/dist/Data-Dumper/Dumper.pm
+++ b/dist/Data-Dumper/Dumper.pm
@@ -10,7 +10,7 @@
package Data::Dumper;
BEGIN {
- $VERSION = '2.152'; # Don't forget to set version and release
+ $VERSION = '2.153'; # Don't forget to set version and release
} # date in POD below!
#$| = 1;
@@ -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 6356501..2ffa867 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
@@ -413,7 +413,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;
@@ -590,6 +590,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);
@@ -676,7 +680,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_catpvs(retval, ")}");
} /* plain */
else {
@@ -684,7 +689,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);
}
@@ -696,7 +702,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) {
@@ -769,7 +776,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_catpvs(retval, ",");
}
@@ -981,7 +989,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)
@@ -1190,7 +1199,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);
}
}
@@ -1280,6 +1290,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;
@@ -1366,6 +1377,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))
@@ -1445,7 +1458,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");
+}
--
1.7.10.4
|
From @rjbs* Tony Cook via RT <perl5-security-report@perl.org> [2014-06-29T22:16:53]
Review, anyone? -- |
From @iabynOn Sun, Jul 06, 2014 at 09:46:55PM -0400, Ricardo Signes wrote:
Well, I'm no Data::Dumper expert, but it looks good to me. -- |
From markus.vervier@lsexperts.de-----BEGIN PGP SIGNED MESSAGE----- Hi Ricardo, we are planning to release the public advisory on 2014-09-11 and would Kind regards Markus On 21.07.2014 17:49, Markus Vervier wrote:
- -- iQEcBAEBAgAGBQJT0nKzAAoJEK9u9A5+VXgeCNgIAI1B20cSP1kNhAuFFw1pluEO |
From @rjbs* Markus Vervier <markus.vervier@lsexperts.de> [2014-07-25T11:07:31]
This seems almost certain. I'm sorry for my late reply -- between OSCON and I have this issue on my short list of things to get pushed through (so I can -- |
From @tonycozHi, I've merged the two new tickets from Friday's exchange into the original ticket. If you keep "[perl #122111]" in the subject your responses will be filed with the original report and discussion (which Markus missed out on, since he wasn't previously listed as a requestor.) Tony |
From @rjbsTo amend into comment when applied to blead: report credit to LSE Leading Security Experts GmbH employee Markus Vervier embargoed until sep 18 -- |
1 similar comment
From @rjbsTo amend into comment when applied to blead: report credit to LSE Leading Security Experts GmbH employee Markus Vervier embargoed until sep 18 -- |
From @rjbs* Ricardo SIGNES <perl5-security-report@perl.org> [2014-06-16T07:54:55]
At first glance, this ticket looks okay to make public, now that the problem If there are no objections within a week, I will do this. -- |
From markus.vervier@lsexperts.de-----BEGIN PGP SIGNED MESSAGE----- Hi Ricardo, okay thanks for the fix / coordination. Now we had an unexpected Cheers Markus On 18.09.2014 20:37, Ricardo Signes via RT wrote:
- -- iQEcBAEBAgAGBQJUI80oAAoJEK9u9A5+VXgeJVMH/j7EyHyhEWGjNtZ/TMVHVXZt |
From @tonycozOn Thu Sep 18 11:37:45 2014, perl.security@rjbs.manxome.org wrote:
Done. Tony |
From @iabynThis ticket was moved to the public queue but not closed. I think that was just an oversight so am closing it now. |
|
@iabyn - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#122111 (status was 'resolved')
Searchable as RT122111$
The text was updated successfully, but these errors were encountered: