Hi Alexander,
Alexander Bluhm wrote on Fri, Oct 24, 2014 at 10:55:07PM +0200:
> On Fri, Oct 24, 2014 at 10:40:55PM +0200, Alexander Bluhm wrote:
>> Here is the diff that applies to -current. I have compared it with
>> the perl git and with Data::Dumper on CPAN. It looks correct.
Confirmed.
> I have forgotten to cvs add dist/Data-Dumper/t/recurse.t
> so here is the diff with the new test.
>
> ok?
Reads good. Also checked that the test suite succeeds
and that mitigation is effective (on i386).
So *if* we decide to patch it, ok schwarze@ for this version of the patch.
It physically and logically conflicts with future Perl updates,
though (changes to the same lines; changing the parameter lists
of the same functions in different ways). I think it would be
nice to hear how Andrew thinks such issues should be addressed
to minimize the pain during future Perl updates.
>> Alternatively we could update Data::Dumper to 2.154.
I'd say answering that question is at least in part Andrew's call.
I'm not sure whether that makes the upcoming 1.20 update easier
or harder.
Yours,
Ingo
> Index: gnu/usr.bin/perl/MANIFEST
> ===================================================================
> RCS file: /data/mirror/openbsd/cvs/src/gnu/usr.bin/perl/MANIFEST,v
> retrieving revision 1.29
> diff -u -p -u -p -r1.29 MANIFEST
> --- gnu/usr.bin/perl/MANIFEST 24 Mar 2014 15:05:12 -0000 1.29
> +++ gnu/usr.bin/perl/MANIFEST 24 Oct 2014 20:19:35 -0000
> @@ -3155,6 +3155,7 @@ dist/Data-Dumper/t/perl-74170.t Regressi
> 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
> Index: gnu/usr.bin/perl/patchlevel.h
> ===================================================================
> RCS file: /data/mirror/openbsd/cvs/src/gnu/usr.bin/perl/patchlevel.h,v
> retrieving revision 1.34
> diff -u -p -u -p -r1.34 patchlevel.h
> --- gnu/usr.bin/perl/patchlevel.h 5 Sep 2014 06:53:07 -0000 1.34
> +++ gnu/usr.bin/perl/patchlevel.h 24 Oct 2014 20:25:05 -0000
> @@ -134,6 +134,7 @@ hunk.
> static const char * const local_patches[] = {
> NULL
> ,"Update libnet to 1.27"
> + ,"CVE-2014-4330"
> #ifdef PERL_GIT_UNCOMMITTED_CHANGES
> ,"uncommitted-changes"
> #endif
> Index: gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm
> ===================================================================
> RCS file:
> /data/mirror/openbsd/cvs/src/gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm,v
> retrieving revision 1.1.1.3
> diff -u -p -u -p -r1.1.1.3 Dumper.pm
> --- gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm 24 Mar 2014 14:58:59
> -0000 1.1.1.3
> +++ gnu/usr.bin/perl/dist/Data-Dumper/Dumper.pm 24 Oct 2014 20:19:35
> -0000
> @@ -56,6 +56,7 @@ $Useperl = 0 unless defined $
> $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
> 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 *
>
> Index: gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs
> ===================================================================
> RCS file:
> /data/mirror/openbsd/cvs/src/gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs,v
> retrieving revision 1.1.1.3
> diff -u -p -u -p -r1.1.1.3 Dumper.xs
> --- gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs 24 Mar 2014 14:58:59
> -0000 1.1.1.3
> +++ gnu/usr.bin/perl/dist/Data-Dumper/Dumper.xs 24 Oct 2014 20:22:57
> -0000
> @@ -26,7 +26,8 @@ static I32 DD_dump (pTHX_ SV *val, const
> 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,
> 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,
> 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,
> 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,
> 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,
> 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,
> 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,
> 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,
> 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)
> Index: gnu/usr.bin/perl/dist/Data-Dumper/t/recurse.t
> ===================================================================
> RCS file: gnu/usr.bin/perl/dist/Data-Dumper/t/recurse.t
> diff -N gnu/usr.bin/perl/dist/Data-Dumper/t/recurse.t
> --- /dev/null 1 Jan 1970 00:00:00 -0000
> +++ gnu/usr.bin/perl/dist/Data-Dumper/t/recurse.t 24 Oct 2014 20:21:37
> -0000
> @@ -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");
> +}
