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/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/recursion_depth.t

@@ -0,0 +1,70 @@
+#
+# 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.
+#
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+use Test::Exception;
+
+use Thrift;
+use Thrift::BinaryProtocol;
+use Thrift::MemoryBuffer;
+
+my $transport = Thrift::MemoryBuffer->new();
+my $protocol  = Thrift::BinaryProtocol->new($transport);
+
+# incrementRecursionDepth allows up to DEFAULT_RECURSION_DEPTH levels
+lives_ok {
+    for (1 .. Thrift::Protocol::DEFAULT_RECURSION_DEPTH) {
+        $protocol->incrementRecursionDepth();
+    }
+} 'incrementRecursionDepth allows up to limit';
+
+# one more should throw
+dies_ok { $protocol->incrementRecursionDepth() }
+    'incrementRecursionDepth throws at limit + 1';
+
+# decrementRecursionDepth restores capacity (first undo the extra that caused die)
+$protocol->decrementRecursionDepth()
+    for (1 .. Thrift::Protocol::DEFAULT_RECURSION_DEPTH);
+
+# now at depth 0; 64 increments should succeed
+lives_ok {
+    for (1 .. Thrift::Protocol::DEFAULT_RECURSION_DEPTH) {
+        $protocol->incrementRecursionDepth();
+    }
+} 'after full decrement, can go deep again';
+
+# decrement one and confirm one more fits
+$protocol->decrementRecursionDepth();
+lives_ok { $protocol->incrementRecursionDepth() }
+    'after one decrement, one more increment succeeds';
+
+# exception is a Thrift::TProtocolException
+my $transport2 = Thrift::MemoryBuffer->new();
+my $protocol2  = Thrift::BinaryProtocol->new($transport2);
+$protocol2->incrementRecursionDepth()
+    for (1 .. Thrift::Protocol::DEFAULT_RECURSION_DEPTH);
+
+my $caught;
+eval { $protocol2->incrementRecursionDepth() };
+$caught = $@;
+ok(ref($caught) && $caught->isa('Thrift::TProtocolException'),
+   'exception is a Thrift::TProtocolException');