Handle partial messages in TLSProxy

Reviewed-by: Matt Caswell <matt@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/5412)

diff --git a/util/perl/TLSProxy/Proxy.pm b/util/perl/TLSProxy/Proxy.pm
index 7b4ad052de273ea3fd703a5f2b4b0c8da0aefdc2..0b90159811cec14620b0fed7179a9b33a3091097 100644 (file)
--- a/util/perl/TLSProxy/Proxy.pm
+++ b/util/perl/TLSProxy/Proxy.pm
@@ -61,7 +61,9 @@ sub new
         ciphersuitesc => "",
         ciphers => "AES128-SHA",
         ciphersuitess => "TLS_AES_128_GCM_SHA256",
-        flight => 0,
+        flight => -1,
+        direction => -1,
+        partial => ["", ""],
         record_list => [],
         message_list => [],
     };
@@ -138,7 +140,9 @@ sub clearClient
 
     $self->{cipherc} = "";
     $self->{ciphersuitec} = "";
-    $self->{flight} = 0;
+    $self->{flight} = -1;
+    $self->{direction} = -1;
+    $self->{partial} = ["", ""];
     $self->{record_list} = [];
     $self->{message_list} = [];
     $self->{clientflags} = "";
@@ -379,34 +383,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($server);
     }
 
-    $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 b52e344419a6b8f9973afa19e469f144935427ac..624d31c2d286c67e0d89d0e377443b3695b6abef 100644 (file)
--- a/util/perl/TLSProxy/Record.pm
+++ b/util/perl/TLSProxy/Record.pm
@@ -61,6 +61,7 @@ sub get_records
     my $server = shift;
     my $flight = shift;
     my $packet = shift;
+    my $partial = "";
     my @record_list = ();
     my @message_list = ();
     my $data;
@@ -79,8 +80,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);
@@ -137,7 +140,7 @@ sub get_records
         }
     }
 
-    return (\@record_list, \@message_list);
+    return (\@record_list, \@message_list, $partial);
 }
 
 sub clear
@@ -197,6 +200,7 @@ sub new
         data => $data,
         decrypt_data => $decrypt_data,
         orig_decrypt_data => $decrypt_data,
+        sent => 0,
         encrypted => 0,
         outer_content_type => RT_APPLICATION_DATA
     };
@@ -287,6 +291,11 @@ sub reconstruct_record
     my $server = shift;
     my $data;
 
+    if ($self->{sent}) {
+        return "";
+    }
+    $self->{sent} = 1;
+
     if ($self->sslv2) {
         $data = pack('n', $self->len | 0x8000);
     } else {