Limit allowed maximum nesting level

Loading deeply nested, but still small YAML documents, like

    [[[[[[[[[[...]]]]]]]]]]

can be significantly slower than a "normal" document with the same size.
By default the depth is limited to 512, which should be more than enough
for 99% of the use cases.

You can set the allowed depth with `max_depth`.

Author: perlpunk

lib/YAML/PP.pm

@@ -32,6 +32,7 @@ sub new {
     my $footer = delete $args{footer};
     my $require_footer = delete $args{require_footer};
     my $duplicate_keys = delete $args{duplicate_keys};
+    my $max_depth = delete $args{max_depth};
     my $yaml_version = $class->_arg_yaml_version(delete $args{yaml_version});
     my $default_yaml_version = $yaml_version->[0];
     my $version_directive = delete $args{version_directive};
@@ -71,6 +72,7 @@ sub new {
         preserve => $preserve,
         duplicate_keys => $duplicate_keys,
         require_footer => $require_footer,
+        max_depth => $max_depth,
     );
     my $dumper = YAML::PP::Dumper->new(
         schema => $default_schema,
@@ -523,6 +525,8 @@ L<https://perlpunk.github.io/YAML-PP-p5/test-suite.html>
         header => 1,
         footer => 0,
         version_directive => 0,
+        require_footer => 0,
+        max_depth => 512,
     );
 
 Options:
@@ -665,6 +669,8 @@ Print document header C<--->
 
 Default: 0
 
+Since version v0.39
+
 This option is for dumping.
 
 Print document footer C<...>
@@ -691,6 +697,19 @@ the complete content, for example over network.
     ---
     a: 2
 
+=item max_depth
+
+Since version v0.40
+
+default: 512
+
+Loading deeply nested, but still small YAML documents, like
+
+    [[[[[[[[[[...]]]]]]]]]]
+
+can be significantly slower than a "normal" document with the same size.
+By default the depth is limited to 512, which should be more than enough
+for 99% of the use cases.
 
 =item yaml_version
 

lib/YAML/PP/Constructor.pm

@@ -15,6 +15,8 @@ use Carp qw/ croak /;
 use constant DEBUG => ($ENV{YAML_PP_LOAD_DEBUG} or $ENV{YAML_PP_LOAD_TRACE}) ? 1 : 0;
 use constant TRACE => $ENV{YAML_PP_LOAD_TRACE} ? 1 : 0;
 
+use constant MAX_DEPTH => 2 ** 9;
+
 my %cyclic_refs = qw/ allow 1 ignore 1 warn 1 fatal 1 /;
 
 sub new {
@@ -26,6 +28,7 @@ sub new {
         $duplicate_keys = 0;
     }
     my $require_footer = delete $args{require_footer};
+    my $max_depth = delete $args{max_depth} || MAX_DEPTH;
     my $preserve = delete $args{preserve} || 0;
     if ($preserve == 1) {
         $preserve = PRESERVE_ORDER | PRESERVE_SCALAR_STYLE | PRESERVE_FLOW_STYLE | PRESERVE_ALIAS;
@@ -46,6 +49,7 @@ sub new {
         preserve => $preserve,
         duplicate_keys => $duplicate_keys,
         require_footer => $require_footer,
+        max_depth => $max_depth,
     }, $class;
     $self->init;
     return $self;
@@ -59,6 +63,7 @@ sub clone {
         default_yaml_version => $self->{default_yaml_version},
         cyclic_refs => $self->cyclic_refs,
         preserve => $self->{preserve},
+        max_depth => $self->{max_depth},
     };
     return bless $clone, ref $self;
 }
@@ -92,6 +97,7 @@ sub preserve_flow_style { return $_[0]->{preserve} & PRESERVE_FLOW_STYLE }
 sub preserve_alias { return $_[0]->{preserve} & PRESERVE_ALIAS }
 sub duplicate_keys { return $_[0]->{duplicate_keys} }
 sub require_footer { return $_[0]->{require_footer} }
+sub max_depth { return $_[0]->{max_depth} }
 
 sub document_start_event {
     my ($self, $event) = @_;
@@ -129,6 +135,15 @@ sub document_end_event {
     $self->set_stack([]);
 }
 
+sub _check_depth {
+    my ($self) = @_;
+    my $stack = $self->stack;
+    my $c = @$stack;
+    if ($c > ($self->max_depth || MAX_DEPTH)){
+        croak sprintf 'Depth of nesting exceeds maximum %s', $self->max_depth;
+    }
+}
+
 sub mapping_start_event {
     my ($self, $event) = @_;
     my ($data, $on_data) = $self->schema->create_mapping($self, $event);
@@ -139,6 +154,7 @@ sub mapping_start_event {
         event => $event,
         on_data => $on_data,
     };
+    $self->_check_depth;
     my $stack = $self->stack;
 
     my $preserve_order = $self->preserve_order;
@@ -241,6 +257,7 @@ sub sequence_start_event {
         on_data => $on_data,
     };
     my $stack = $self->stack;
+    $self->_check_depth;
 
     my $preserve_style = $self->preserve_flow_style;
     my $preserve_alias = $self->preserve_alias;

lib/YAML/PP/Loader.pm

@@ -17,6 +17,7 @@ sub new {
     my $preserve = delete $args{preserve};
     my $duplicate_keys = delete $args{duplicate_keys};
     my $require_footer = delete $args{require_footer};
+    my $max_depth = delete $args{max_depth};
     my $schemas = delete $args{schemas};
     $schemas ||= {
         '1.2' => YAML::PP->default_schema(
@@ -31,6 +32,7 @@ sub new {
         preserve => $preserve,
         duplicate_keys => $duplicate_keys,
         require_footer => $require_footer,
+        max_depth => $max_depth,
     );
     my $parser = delete $args{parser};
     unless ($parser) {

t/58.max-depth.t

@@ -0,0 +1,30 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use YAML::PP;
+
+my $yp = YAML::PP->new(
+    max_depth => 5,
+);
+
+my @errors = (
+    '[[[[[[]]]]]]',
+    '[{[{[{}]}]}]',
+    '{{{{{{}}}}}}',
+    '{[{[{[]}]}]}',
+);
+for my $yaml (@errors) {
+    eval {
+        $yp->load_string($yaml);
+    };
+    like $@, qr{Depth of nesting exceeds maximum 5}, "'$yaml' expected error message";
+}
+
+my $yaml = '[[[[[]]]]]';
+eval {
+    $yp->load_string($yaml);
+};
+is $@, '', 'no error message';
+
+done_testing;