THRIFT-6048: Limit struct read/write recursion depth in Perl library

compiler/cpp/src/thrift/generate/t_perl_generator.cc

@@ -545,6 +545,9 @@ void t_perl_generator::generate_perl_struct_reader(ostream& out, t_struct* tstru
       << indent() << "my $fname;" << '\n' << indent() << "my $ftype = 0;" << '\n' << indent()
       << "my $fid   = 0;" << '\n';
 
+  indent(out) << "$input->incrementRecursionDepth();" << '\n';
+  indent(out) << "eval {" << '\n';
+  indent_up();
   indent(out) << "$xfer += $input->readStructBegin(\\$fname);" << '\n';
 
   // Loop over reading in fields
@@ -594,6 +597,12 @@ void t_perl_generator::generate_perl_struct_reader(ostream& out, t_struct* tstru
 
   indent(out) << "$xfer += $input->readStructEnd();" << '\n';
 
+  indent_down();
+  indent(out) << "};" << '\n';
+  indent(out) << "my $err = $@;" << '\n';
+  indent(out) << "$input->decrementRecursionDepth();" << '\n';
+  indent(out) << "die $err if $err;" << '\n';
+
   indent(out) << "return $xfer;" << '\n';
 
   indent_down();
@@ -614,6 +623,9 @@ void t_perl_generator::generate_perl_struct_writer(ostream& out, t_struct* tstru
   indent(out) << "my ($self, $output) = @_;" << '\n';
   indent(out) << "my $xfer   = 0;" << '\n';
 
+  indent(out) << "$output->incrementRecursionDepth();" << '\n';
+  indent(out) << "eval {" << '\n';
+  indent_up();
   indent(out) << "$xfer += $output->writeStructBegin('" << name << "');" << '\n';
 
   for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
@@ -636,6 +648,12 @@ void t_perl_generator::generate_perl_struct_writer(ostream& out, t_struct* tstru
   out << indent() << "$xfer += $output->writeFieldStop();" << '\n' << indent()
       << "$xfer += $output->writeStructEnd();" << '\n';
 
+  indent_down();
+  out << indent() << "};" << '\n';
+  out << indent() << "my $err = $@;" << '\n';
+  out << indent() << "$output->decrementRecursionDepth();" << '\n';
+  out << indent() << "die $err if $err;" << '\n';
+
   out << indent() << "return $xfer;" << '\n';
 
   indent_down();

lib/perl/Makefile.am

@@ -74,6 +74,7 @@ THRIFT = @top_builddir@/compiler/cpp/thrift
 THRIFT_IF = @top_srcdir@/test/v0.16/ThriftTest.thrift
 NAME_BENCHMARKSERVICE =  @top_srcdir@/lib/rb/benchmark/Benchmark.thrift
 NAME_AGGR = @top_srcdir@/contrib/async-test/aggr.thrift
+NAME_RECURSION = @top_srcdir@/lib/perl/t/RecursionDepth.thrift
 
 THRIFTTEST_GEN = \
 	gen-perl/ThriftTest/Constants.pm \
@@ -91,10 +92,15 @@ AGGR_GEN = \
 	gen-perl2/Constants.pm \
 	gen-perl2/Types.pm
 
+RECURSION_GEN = \
+	gen-perl/RecursionDepth/Constants.pm \
+	gen-perl/RecursionDepth/Types.pm
+
 PERL_GEN = \
 	$(THRIFTTEST_GEN) \
 	$(BENCHMARK_GEN) \
-	$(AGGR_GEN)
+	$(AGGR_GEN) \
+	$(RECURSION_GEN)
 
 PERL_PRECROSS_GEN = \
 	gen-perl/ThriftTest/Constants.pm \
@@ -118,3 +124,6 @@ $(BENCHMARK_GEN): $(NAME_BENCHMARKSERVICE) $(THRIFT)
 $(AGGR_GEN): $(NAME_AGGR) $(THRIFT)
 	$(MKDIR_P) gen-perl2
 	$(THRIFT) -out gen-perl2 --gen perl $<
+
+$(RECURSION_GEN): $(NAME_RECURSION) $(THRIFT)
+	$(THRIFT) --gen perl $<

lib/perl/lib/Thrift/Protocol.pm

@@ -54,16 +54,36 @@ sub new {
 package Thrift::Protocol;
 use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
 
+use constant DEFAULT_RECURSION_DEPTH => 64;
+
 sub new {
     my $classname = shift;
     my $self      = {};
 
     my $trans     = shift;
-    $self->{trans}= $trans;
+    $self->{trans}        = $trans;
+    $self->{recursionDepth} = 0;
 
     return bless($self,$classname);
 }
 
+sub incrementRecursionDepth {
+    my $self = shift;
+    $self->{recursionDepth}++;
+    if ($self->{recursionDepth} > DEFAULT_RECURSION_DEPTH) {
+        $self->{recursionDepth}--;
+        die Thrift::TProtocolException->new(
+            'Maximum recursion depth exceeded',
+            Thrift::TProtocolException::DEPTH_LIMIT
+        );
+    }
+}
+
+sub decrementRecursionDepth {
+    my $self = shift;
+    $self->{recursionDepth}--;
+}
+
 sub getTransport
 {
     my $self = shift;

lib/perl/t/Makefile.am

@@ -20,4 +20,5 @@
 distdir:
 	$(MAKE) $(AM_MAKEFLAGS) distdir-am
 
-EXTRA_DIST = binary_protocol_negative_size.t memory_buffer.t processor.t multiplex.t
+EXTRA_DIST = binary_protocol_negative_size.t memory_buffer.t processor.t multiplex.t \
+	recursion_depth.t RecursionDepth.thrift

lib/perl/t/RecursionDepth.thrift

@@ -0,0 +1,39 @@
+/*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ *   http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ */
+
+namespace perl RecursionDepth
+
+// A self-referential struct, union and exception used to exercise the
+// recursion-depth guard in the generated read()/write() code.  Recursion runs
+// through a list<self> so the types are expressible (no by-value cycle).
+
+struct RecTree {
+  1: list<RecTree> children
+  2: i16 item
+}
+
+union RecUnion {
+  1: list<RecUnion> children
+  2: i32 leaf
+}
+
+exception RecError {
+  1: list<RecError> children
+  2: i32 leaf
+}

lib/perl/t/recursion_depth.t

@@ -0,0 +1,143 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+#   http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+# Drives the recursion-depth guard through the *generated* read()/write()
+# code over a recursive struct (RecTree), union (RecUnion) and exception
+# (RecError). This exercises the real serialization path, not the protocol
+# counter in isolation.
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use Thrift;
+use Thrift::BinaryProtocol;
+use Thrift::MemoryBuffer;
+
+use RecursionDepth::Types;
+
+use constant LIMIT => Thrift::Protocol::DEFAULT_RECURSION_DEPTH;
+
+# Build a chain of $depth nested nodes. Every node sets exactly one field:
+# the inner nodes carry a single child, the deepest node carries the leaf
+# scalar -- a valid shape for both the struct and the union.
+sub make_chain {
+    my ($class, $leaf_field, $depth) = @_;
+    my $node = $class->new();
+    if ($depth > 1) {
+        $node->{children} = [make_chain($class, $leaf_field, $depth - 1)];
+    }
+    else {
+        $node->{$leaf_field} = 1;
+    }
+    return $node;
+}
+
+sub chain_depth {
+    my ($node) = @_;
+    my $depth = 1;
+    if (defined $node->{children} && scalar @{$node->{children}}) {
+        $depth += chain_depth($node->{children}->[0]);
+    }
+    return $depth;
+}
+
+# Serialize an over-limit payload using raw protocol primitives so that the
+# reader recurses through the guarded struct path (field id 1 = list<self>),
+# rather than through the separate (unbounded) skip() path.
+sub write_deep {
+    my ($proto, $struct_name, $depth) = @_;
+    $proto->writeStructBegin($struct_name);
+    if ($depth > 1) {
+        $proto->writeFieldBegin('children', Thrift::TType::LIST, 1);
+        $proto->writeListBegin(Thrift::TType::STRUCT, 1);
+        write_deep($proto, $struct_name, $depth - 1);
+        $proto->writeListEnd();
+        $proto->writeFieldEnd();
+    }
+    $proto->writeFieldStop();
+    $proto->writeStructEnd();
+}
+
+# Run $code and return the exception it threw (or undef).
+sub caught {
+    my ($code) = @_;
+    my $err;
+    eval { $code->(); 1 } or $err = $@;
+    return $err;
+}
+
+my @cases = (
+    {kind => 'struct',    class => 'RecursionDepth::RecTree',  name => 'RecTree',  leaf => 'item'},
+    {kind => 'union',     class => 'RecursionDepth::RecUnion', name => 'RecUnion', leaf => 'leaf'},
+    {kind => 'exception', class => 'RecursionDepth::RecError', name => 'RecError', leaf => 'leaf'},
+);
+
+for my $case (@cases) {
+    my ($kind, $class, $name, $leaf) = @{$case}{qw(kind class name leaf)};
+
+    # 1. A chain exactly at the limit round-trips. This also proves the
+    #    generator and protocol guards do not double-count (a chain of 64
+    #    would be rejected at 32 if they did).
+    {
+        my $buffer = Thrift::MemoryBuffer->new();
+        my $proto  = Thrift::BinaryProtocol->new($buffer);
+        my $chain  = make_chain($class, $leaf, LIMIT);
+
+        lives_ok { $chain->write($proto) }
+            "$kind: writing a chain at the depth limit succeeds";
+
+        my $decoded = $class->new();
+        lives_ok { $decoded->read($proto) }
+            "$kind: reading a chain at the depth limit succeeds";
+        is(chain_depth($decoded), LIMIT,
+            "$kind: round-trips to the original depth (${name})");
+    }
+
+    # 2. Writing past the limit is rejected with DEPTH_LIMIT.
+    {
+        my $buffer = Thrift::MemoryBuffer->new();
+        my $proto  = Thrift::BinaryProtocol->new($buffer);
+        my $chain  = make_chain($class, $leaf, LIMIT + 5);
+
+        my $err = caught(sub { $chain->write($proto) });
+        ok(ref($err) && $err->isa('Thrift::TProtocolException'),
+            "$kind: writing past the limit throws TProtocolException");
+        is(ref($err) ? $err->{code} : undef, Thrift::TProtocolException::DEPTH_LIMIT,
+            "$kind: ... with the DEPTH_LIMIT code");
+    }
+
+    # 3. Reading an over-limit payload is rejected with DEPTH_LIMIT.
+    {
+        my $buffer = Thrift::MemoryBuffer->new();
+        my $proto  = Thrift::BinaryProtocol->new($buffer);
+        write_deep($proto, $name, LIMIT + 5);
+
+        my $decoded = $class->new();
+        my $err = caught(sub { $decoded->read($proto) });
+        ok(ref($err) && $err->isa('Thrift::TProtocolException'),
+            "$kind: reading past the limit throws TProtocolException");
+        is(ref($err) ? $err->{code} : undef, Thrift::TProtocolException::DEPTH_LIMIT,
+            "$kind: ... with the DEPTH_LIMIT code");
+    }
+}
+
+done_testing();