From 1bfb7860cb81cf6431308c244a4967e41806a919 Mon Sep 17 00:00:00 2001
From: Bernd Edlinger <bernd.edlinger@hotmail.de>
Date: Thu, 22 Mar 2018 17:28:39 +0100
Subject: [PATCH] Handle partial messages in TLSProxy

Reviewed-by: Matt Caswell <matt@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/5726)
---
 util/perl/TLSProxy/Proxy.pm  | 30 +++++++++++++++++++-----------
 util/perl/TLSProxy/Record.pm | 15 ++++++++++++---
 2 files changed, 31 insertions(+), 14 deletions(-)

diff --git a/util/perl/TLSProxy/Proxy.pm b/util/perl/TLSProxy/Proxy.pm
index 7d9cb37f77..4ca0a7d40a 100644
--- a/util/perl/TLSProxy/Proxy.pm
+++ b/util/perl/TLSProxy/Proxy.pm
@@ -52,7 +52,9 @@ sub new
         debug => $debug,
         cipherc => "",
         ciphers => "AES128-SHA",
-        flight => 0,
+        flight => -1,
+        direction => -1,
+        partial => ["", ""],
         record_list => [],
         message_list => [],
     };
@@ -128,7 +130,9 @@ sub clearClient
     my $self = shift;
 
     $self->{cipherc} = "";
-    $self->{flight} = 0;
+    $self->{flight} = -1;
+    $self->{direction} = -1;
+    $self->{partial} = ["", ""];
     $self->{record_list} = [];
     $self->{message_list} = [];
     $self->{clientflags} = "";
@@ -344,34 +348,38 @@ sub process_packet
         print "Received client packet\n";
     }
 
+    if ($self->{direction} != $server) {
+        $self->{flight} = $self->{flight} + 1;
+        $self->{direction} = $server;
+    }
+
     print "Packet length = ".length($packet)."\n";
     print "Processing flight ".$self->flight."\n";
 
     #Return contains the list of record found in the packet followed by the
-    #list of messages in those records
-    my @ret = TLSProxy::Record->get_records($server, $self->flight, $packet);
+    #list of messages in those records and any partial message
+    my @ret = TLSProxy::Record->get_records($server, $self->flight, $self->{partial}[$server].$packet);
+    $self->{partial}[$server] = $ret[2];
     push @{$self->record_list}, @{$ret[0]};
     push @{$self->{message_list}}, @{$ret[1]};
 
     print "\n";
 
+    if (scalar(@{$ret[0]}) == 0 or length($ret[2]) != 0) {
+        return "";
+    }
+
     #Finished parsing. Call user provided filter here
-    if(defined $self->filter) {
+    if (defined $self->filter) {
         $self->filter->($self);
     }
 
     #Reconstruct the packet
     $packet = "";
     foreach my $record (@{$self->record_list}) {
-        #We only replay the records for the current flight
-        if ($record->flight != $self->flight) {
-            next;
-        }
         $packet .= $record->reconstruct_record();
     }
 
-    $self->{flight} = $self->{flight} + 1;
-
     print "Forwarded packet length = ".length($packet)."\n\n";
 
     return $packet;
diff --git a/util/perl/TLSProxy/Record.pm b/util/perl/TLSProxy/Record.pm
index a75d8cdfbd..13d804f42a 100644
--- a/util/perl/TLSProxy/Record.pm
+++ b/util/perl/TLSProxy/Record.pm
@@ -59,6 +59,7 @@ sub get_records
     my $server = shift;
     my $flight = shift;
     my $packet = shift;
+    my $partial = "";
     my @record_list = ();
     my @message_list = ();
     my $data;
@@ -77,8 +78,10 @@ sub get_records
             print " (client -> server)\n";
         }
         #Get the record header
-        if (length($packet) < TLS_RECORD_HEADER_LENGTH) {
+        if (length($packet) < TLS_RECORD_HEADER_LENGTH
+                || length($packet) < 5 + unpack("n", substr($packet, 3, 2))) {
             print "Partial data : ".length($packet)." bytes\n";
+            $partial = $packet;
             $packet = "";
         } else {
             ($content_type, $version, $len) = unpack('CnnC*', $packet);
@@ -127,7 +130,7 @@ sub get_records
         }
     }
 
-    return (\@record_list, \@message_list);
+    return (\@record_list, \@message_list, $partial);
 }
 
 sub clear
@@ -186,7 +189,8 @@ sub new
         decrypt_len => $decrypt_len,
         data => $data,
         decrypt_data => $decrypt_data,
-        orig_decrypt_data => $decrypt_data
+        orig_decrypt_data => $decrypt_data,
+        sent => 0
     };
 
     return bless $self, $class;
@@ -252,6 +256,11 @@ sub reconstruct_record
     my $self = shift;
     my $data;
 
+    if ($self->{sent}) {
+        return "";
+    }
+    $self->{sent} = 1;
+
     if ($self->sslv2) {
         $data = pack('n', $self->len | 0x8000);
     } else {
-- 
2.25.1