[openssl-commits] [openssl] master update

Andy Polyakov appro at openssl.org
Wed Apr 18 18:03:23 UTC 2018


The branch master has been updated
       via  f3d3b362553d95047d93608edd15d20aa6e6e0fd (commit)
       via  c4220c0f9a8c944c31450b0cd6e01014687f28db (commit)
       via  3f1f62b97b795d973d40c32735eedee70140731c (commit)
       via  17cde9c2e404a0ada05601fb726dbaed6c532112 (commit)
       via  3f473b936a292262a020353e99f896cabfedc947 (commit)
      from  5bb1cd2292b388263a0cc05392bb99141212aa53 (commit)


- Log -----------------------------------------------------------------
commit f3d3b362553d95047d93608edd15d20aa6e6e0fd
Author: Andy Polyakov <appro at openssl.org>
Date:   Wed Apr 18 10:42:23 2018 +0200

    TLSProxy/Proxy.pm: preclude output intermix.
    
    s_server -rev emits info output on stderr, i.e. unbufferred, which
    risks intermixing with output from TLSProxy itself on non-line
    boundaries, which in turn is confusing to TAP parser.
    
    Reviewed-by: Richard Levitte <levitte at openssl.org>
    (Merged from https://github.com/openssl/openssl/pull/5975)

commit c4220c0f9a8c944c31450b0cd6e01014687f28db
Author: Andy Polyakov <appro at openssl.org>
Date:   Mon Apr 16 22:32:10 2018 +0200

    recipes/70-test_ssl{cbcpadding,extension,records}: make it work w/fragmentation.
    
    This fixes only those tests that were failing when network data was
    fragmented. Remaining ones might succeed for "wrong reasons". Bunch
    of tests have to fail to be considered successful and when data is
    fragmented they might fail for reasons other than originally intended.
    
    Reviewed-by: Richard Levitte <levitte at openssl.org>
    (Merged from https://github.com/openssl/openssl/pull/5975)

commit 3f1f62b97b795d973d40c32735eedee70140731c
Author: Andy Polyakov <appro at openssl.org>
Date:   Mon Apr 16 14:08:35 2018 +0200

    TLSProxy/Record.pm: add is_fatal_alert method.
    
    (resolve uninitialized variable warning and harmonize output).
    
    Reviewed-by: Richard Levitte <levitte at openssl.org>
    (Merged from https://github.com/openssl/openssl/pull/5975)

commit 17cde9c2e404a0ada05601fb726dbaed6c532112
Author: Andy Polyakov <appro at openssl.org>
Date:   Mon Apr 16 14:13:07 2018 +0200

    TLSProxy/Proxy.pm: refine NewSessionTicket detection.
    
    Reviewed-by: Richard Levitte <levitte at openssl.org>
    (Merged from https://github.com/openssl/openssl/pull/5975)

commit 3f473b936a292262a020353e99f896cabfedc947
Author: Andy Polyakov <appro at openssl.org>
Date:   Mon Apr 16 14:10:39 2018 +0200

    TLSProxy/Message.pm: refine end-of-conversation detection logic.
    
    Reviewed-by: Richard Levitte <levitte at openssl.org>
    (Merged from https://github.com/openssl/openssl/pull/5975)

-----------------------------------------------------------------------

Summary of changes:
 test/recipes/70-test_sslcbcpadding.t |  31 +++++++--
 test/recipes/70-test_sslextension.t  |  49 +++++++++++---
 test/recipes/70-test_sslrecords.t    | 126 ++++++++++++++++++++++++-----------
 util/perl/TLSProxy/Message.pm        |   7 +-
 util/perl/TLSProxy/Proxy.pm          |  21 ++++--
 util/perl/TLSProxy/Record.pm         |  22 ++++--
 6 files changed, 184 insertions(+), 72 deletions(-)

diff --git a/test/recipes/70-test_sslcbcpadding.t b/test/recipes/70-test_sslcbcpadding.t
index 85b26b8..5594376 100644
--- a/test/recipes/70-test_sslcbcpadding.t
+++ b/test/recipes/70-test_sslcbcpadding.t
@@ -7,6 +7,8 @@
 # https://www.openssl.org/source/license.html
 
 use strict;
+use feature 'state';
+
 use OpenSSL::Test qw/:DEFAULT cmdstr srctop_file bldtop_dir/;
 use OpenSSL::Test::Utils;
 use TLSProxy::Proxy;
@@ -41,26 +43,31 @@ my @test_offsets = (0, 128, 254, 255);
 # Test that maximally-padded records are accepted.
 my $bad_padding_offset = -1;
 $proxy->serverflags("-tls1_2");
+$proxy->serverconnects(1 + scalar(@test_offsets));
 $proxy->start() or plan skip_all => "Unable to start up Proxy for tests";
 plan tests => 1 + scalar(@test_offsets);
 ok(TLSProxy::Message->success(), "Maximally-padded record test");
 
 # Test that invalid padding is rejected.
+my $fatal_alert;    # set by add_maximal_padding_filter on client's fatal alert
+
 foreach my $offset (@test_offsets) {
-    $proxy->clear();
-    $proxy->serverflags("-tls1_2");
     $bad_padding_offset = $offset;
-    $proxy->start();
-    ok(TLSProxy::Message->fail(), "Invalid padding byte $bad_padding_offset");
+    $fatal_alert = 0;
+    $proxy->clearClient();
+    $proxy->clientstart();
+    ok($fatal_alert, "Invalid padding byte $bad_padding_offset");
 }
 
 sub add_maximal_padding_filter
 {
     my $proxy = shift;
+    my $messages = $proxy->message_list;
+    state $sent_corrupted_payload;
 
     if ($proxy->flight == 0) {
         # Disable Encrypt-then-MAC.
-        foreach my $message (@{$proxy->message_list}) {
+        foreach my $message (@{$messages}) {
             if ($message->mt != TLSProxy::Message::MT_CLIENT_HELLO) {
                 next;
             }
@@ -69,9 +76,16 @@ sub add_maximal_padding_filter
             $message->process_extensions();
             $message->repack();
         }
+        $sent_corrupted_payload = 0;
+        return;
     }
 
-    if ($proxy->flight == 3) {
+    my $last_message = @{$messages}[-1];
+    if (defined($last_message)
+        && $last_message->server
+        && $last_message->mt == TLSProxy::Message::MT_FINISHED
+        && !@{$last_message->records}[0]->{sent}) {
+
         # Insert a maximally-padded record. Assume a block size of 16 (AES) and
         # a MAC length of 20 (SHA-1).
         my $block_size = 16;
@@ -88,6 +102,7 @@ sub add_maximal_padding_filter
         # Add padding.
         for (my $i = 0; $i < 256; $i++) {
             if ($i == $bad_padding_offset) {
+                $sent_corrupted_payload = 1;
                 $data .= "\xfe";
             } else {
                 $data .= "\xff";
@@ -108,5 +123,9 @@ sub add_maximal_padding_filter
 
         # Send the record immediately after the server Finished.
         push @{$proxy->record_list}, $record;
+    } elsif ($sent_corrupted_payload) {
+        # Check for bad_record_mac from client
+        my $last_record = @{$proxy->record_list}[-1];
+        $fatal_alert = 1 if $last_record->is_fatal_alert(0) == 20;
     }
 }
diff --git a/test/recipes/70-test_sslextension.t b/test/recipes/70-test_sslextension.t
index 142ce0e..20e1933 100644
--- a/test/recipes/70-test_sslextension.t
+++ b/test/recipes/70-test_sslextension.t
@@ -7,6 +7,8 @@
 # https://www.openssl.org/source/license.html
 
 use strict;
+use feature 'state';
+
 use OpenSSL::Test qw/:DEFAULT cmdstr srctop_file bldtop_dir/;
 use OpenSSL::Test::Utils;
 use TLSProxy::Proxy;
@@ -37,6 +39,7 @@ use constant {
 };
 
 my $testtype;
+my $fatal_alert = 0;    # set by filter on fatal alert
 
 $ENV{OPENSSL_ia32cap} = '~0x200000200000000';
 my $proxy = TLSProxy::Proxy->new(
@@ -98,11 +101,13 @@ sub inject_duplicate_extension_clienthello
     my $proxy = shift;
 
     # We're only interested in the initial ClientHello
-    if ($proxy->flight != 0) {
+    if ($proxy->flight == 0) {
+        inject_duplicate_extension($proxy, TLSProxy::Message::MT_CLIENT_HELLO);
         return;
     }
 
-    inject_duplicate_extension($proxy, TLSProxy::Message::MT_CLIENT_HELLO);
+    my $last_record = @{$proxy->{record_list}}[-1];
+    $fatal_alert = 1 if $last_record->is_fatal_alert(1);
 }
 
 sub inject_duplicate_extension_serverhello
@@ -110,26 +115,43 @@ sub inject_duplicate_extension_serverhello
     my $proxy = shift;
 
     # We're only interested in the initial ServerHello
-    if ($proxy->flight != 1) {
+    if ($proxy->flight == 0) {
+        return;
+    } elsif ($proxy->flight == 1) {
+        inject_duplicate_extension($proxy, TLSProxy::Message::MT_SERVER_HELLO);
         return;
     }
 
-    inject_duplicate_extension($proxy, TLSProxy::Message::MT_SERVER_HELLO);
+    my $last_record = @{$proxy->{record_list}}[-1];
+    $fatal_alert = 1 if $last_record->is_fatal_alert(0);
 }
 
 sub inject_unsolicited_extension
 {
     my $proxy = shift;
     my $message;
+    state $sent_unsolisited_extension;
+
+    if ($proxy->flight == 0) {
+        $sent_unsolisited_extension = 0;
+        return;
+    }
 
     # We're only interested in the initial ServerHello/EncryptedExtensions
     if ($proxy->flight != 1) {
+        if ($sent_unsolisited_extension) {
+            my $last_record = @{$proxy->record_list}[-1];
+            $fatal_alert = 1 if $last_record->is_fatal_alert(0);
+        }
         return;
     }
 
     if ($testtype == UNSOLICITED_SERVER_NAME_TLS13) {
-        $message = ${$proxy->message_list}[2];
-        die "Expecting EE message ".($message->mt).", ".${$proxy->message_list}[1]->mt.", ".${$proxy->message_list}[3]->mt if $message->mt != TLSProxy::Message::MT_ENCRYPTED_EXTENSIONS;
+        return if (!defined($message = ${$proxy->message_list}[2]));
+        die "Expecting EE message ".($message->mt).","
+                                   .${$proxy->message_list}[1]->mt.", "
+                                   .${$proxy->message_list}[3]->mt
+            if $message->mt != TLSProxy::Message::MT_ENCRYPTED_EXTENSIONS;
     } else {
         $message = ${$proxy->message_list}[1];
     }
@@ -148,17 +170,19 @@ sub inject_unsolicited_extension
     }
     $message->set_extension($type, $ext);
     $message->repack();
+    $sent_unsolisited_extension = 1;
 }
 
 # Test 1-2: Sending a duplicate extension should fail.
 $proxy->start() or plan skip_all => "Unable to start up Proxy for tests";
 plan tests => 7;
-ok(TLSProxy::Message->fail(), "Duplicate ClientHello extension");
+ok($fatal_alert, "Duplicate ClientHello extension");
 
+$fatal_alert = 0;
 $proxy->clear();
 $proxy->filter(\&inject_duplicate_extension_serverhello);
 $proxy->start();
-ok(TLSProxy::Message->fail(), "Duplicate ServerHello extension");
+ok($fatal_alert, "Duplicate ServerHello extension");
 
 SKIP: {
     skip "TLS <= 1.2 disabled", 3 if $no_below_tls13;
@@ -170,12 +194,13 @@ SKIP: {
     ok(TLSProxy::Message->success, "Zero extension length test");
 
     #Test 4: Inject an unsolicited extension (<= TLSv1.2)
+    $fatal_alert = 0;
     $proxy->clear();
     $proxy->filter(\&inject_unsolicited_extension);
     $testtype = UNSOLICITED_SERVER_NAME;
     $proxy->clientflags("-no_tls1_3 -noservername");
     $proxy->start();
-    ok(TLSProxy::Message->fail(), "Unsolicited server name extension");
+    ok($fatal_alert, "Unsolicited server name extension");
 
     #Test 5: Inject a noncompliant supported_groups extension (<= TLSv1.2)
     $proxy->clear();
@@ -190,20 +215,22 @@ SKIP: {
     skip "TLS <= 1.2 or CT disabled", 1
         if $no_below_tls13 || disabled("ct");
     #Test 6: Same as above for the SCT extension which has special handling
+    $fatal_alert = 0;
     $proxy->clear();
     $testtype = UNSOLICITED_SCT;
     $proxy->clientflags("-no_tls1_3");
     $proxy->start();
-    ok(TLSProxy::Message->fail(), "Unsolicited sct extension");
+    ok($fatal_alert, "Unsolicited sct extension");
 }
 
 SKIP: {
     skip "TLS 1.3 disabled", 1 if disabled("tls1_3");
     #Test 7: Inject an unsolicited extension (TLSv1.3)
+    $fatal_alert = 0;
     $proxy->clear();
     $proxy->filter(\&inject_unsolicited_extension);
     $testtype = UNSOLICITED_SERVER_NAME_TLS13;
     $proxy->clientflags("-noservername");
     $proxy->start();
-    ok(TLSProxy::Message->fail(), "Unsolicited server name extension (TLSv1.3)");
+    ok($fatal_alert, "Unsolicited server name extension (TLSv1.3)");
 }
diff --git a/test/recipes/70-test_sslrecords.t b/test/recipes/70-test_sslrecords.t
index 88cb022..1233028 100644
--- a/test/recipes/70-test_sslrecords.t
+++ b/test/recipes/70-test_sslrecords.t
@@ -7,6 +7,8 @@
 # https://www.openssl.org/source/license.html
 
 use strict;
+use feature 'state';
+
 use OpenSSL::Test qw/:DEFAULT cmdstr srctop_file bldtop_dir/;
 use OpenSSL::Test::Utils;
 use TLSProxy::Proxy;
@@ -35,6 +37,7 @@ my $proxy = TLSProxy::Proxy->new(
 );
 
 my $boundary_test_type;
+my $fatal_alert = 0;    # set by filters at expected fatal alerts
 
 #Test 1: Injecting out of context empty records should fail
 my $content_type = TLSProxy::Record::RT_APPLICATION_DATA;
@@ -42,7 +45,7 @@ my $inject_recs_num = 1;
 $proxy->serverflags("-tls1_2");
 $proxy->start() or plan skip_all => "Unable to start up Proxy for tests";
 plan tests => 18;
-ok(TLSProxy::Message->fail(), "Out of context empty records test");
+ok($fatal_alert, "Out of context empty records test");
 
 #Test 2: Injecting in context empty records should succeed
 $proxy->clear();
@@ -52,21 +55,23 @@ $proxy->start();
 ok(TLSProxy::Message->success(), "In context empty records test");
 
 #Test 3: Injecting too many in context empty records should fail
+$fatal_alert = 0;
 $proxy->clear();
 #We allow 32 consecutive in context empty records
 $inject_recs_num = 33;
 $proxy->serverflags("-tls1_2");
 $proxy->start();
-ok(TLSProxy::Message->fail(), "Too many in context empty records test");
+ok($fatal_alert, "Too many in context empty records test");
 
 #Test 4: Injecting a fragmented fatal alert should fail. We expect the server to
 #        send back an alert of its own because it cannot handle fragmented
 #        alerts
+$fatal_alert = 0;
 $proxy->clear();
 $proxy->filter(\&add_frag_alert_filter);
 $proxy->serverflags("-tls1_2");
 $proxy->start();
-ok(TLSProxy::Message->fail(), "Fragmented alert records test");
+ok($fatal_alert, "Fragmented alert records test");
 
 #Run some SSLv2 ClientHello tests
 
@@ -122,28 +127,31 @@ ok(TLSProxy::Message->fail(), "Alert before SSLv2 ClientHello test");
 #Unrecognised record type tests
 
 #Test 10: Sending an unrecognised record type in TLS1.2 should fail
+$fatal_alert = 0;
 $proxy->clear();
 $proxy->serverflags("-tls1_2");
 $proxy->filter(\&add_unknown_record_type);
 $proxy->start();
-ok(TLSProxy::Message->fail(), "Unrecognised record type in TLS1.2");
+ok($fatal_alert, "Unrecognised record type in TLS1.2");
 
 SKIP: {
     skip "TLSv1.1 disabled", 1 if disabled("tls1_1");
 
     #Test 11: Sending an unrecognised record type in TLS1.1 should fail
+    $fatal_alert = 0;
     $proxy->clear();
     $proxy->clientflags("-tls1_1");
     $proxy->start();
-    ok(TLSProxy::Message->fail(), "Unrecognised record type in TLS1.1");
+    ok($fatal_alert, "Unrecognised record type in TLS1.1");
 }
 
 #Test 12: Sending a different record version in TLS1.2 should fail
+$fatal_alert = 0;
 $proxy->clear();
 $proxy->clientflags("-tls1_2");
 $proxy->filter(\&change_version);
 $proxy->start();
-ok(TLSProxy::Message->fail(), "Changed record version in TLS1.2");
+ok($fatal_alert, "Changed record version in TLS1.2");
 
 #TLS1.3 specific tests
 SKIP: {
@@ -156,17 +164,19 @@ SKIP: {
     ok(TLSProxy::Message->fail(), "Changed record version in TLS1.3");
 
     #Test 14: Sending an unrecognised record type in TLS1.3 should fail
+    $fatal_alert = 0;
     $proxy->clear();
     $proxy->filter(\&add_unknown_record_type);
     $proxy->start();
-    ok(TLSProxy::Message->fail(), "Unrecognised record type in TLS1.3");
+    ok($fatal_alert, "Unrecognised record type in TLS1.3");
 
     #Test 15: Sending an outer record type other than app data once encrypted
     #should fail
+    $fatal_alert = 0;
     $proxy->clear();
     $proxy->filter(\&change_outer_record_type);
     $proxy->start();
-    ok(TLSProxy::Message->fail(), "Wrong outer record type in TLS1.3");
+    ok($fatal_alert, "Wrong outer record type in TLS1.3");
 
     use constant {
         DATA_AFTER_SERVER_HELLO => 0,
@@ -176,36 +186,41 @@ SKIP: {
 
     #Test 16: Sending a ServerHello which doesn't end on a record boundary
     #         should fail
+    $fatal_alert = 0;
     $proxy->clear();
     $boundary_test_type = DATA_AFTER_SERVER_HELLO;
     $proxy->filter(\&not_on_record_boundary);
     $proxy->start();
-    ok(TLSProxy::Message->fail(), "Record not on boundary in TLS1.3 (ServerHello)");
+    ok($fatal_alert, "Record not on boundary in TLS1.3 (ServerHello)");
 
     #Test 17: Sending a Finished which doesn't end on a record boundary
     #         should fail
+    $fatal_alert = 0;
     $proxy->clear();
     $boundary_test_type = DATA_AFTER_FINISHED;
     $proxy->filter(\&not_on_record_boundary);
     $proxy->start();
-    ok(TLSProxy::Message->fail(), "Record not on boundary in TLS1.3 (Finished)");
+    ok($fatal_alert, "Record not on boundary in TLS1.3 (Finished)");
 
     #Test 18: Sending a KeyUpdate which doesn't end on a record boundary
     #         should fail
+    $fatal_alert = 0;
     $proxy->clear();
     $boundary_test_type = DATA_AFTER_KEY_UPDATE;
     $proxy->filter(\&not_on_record_boundary);
     $proxy->start();
-    ok(TLSProxy::Message->fail(), "Record not on boundary in TLS1.3 (KeyUpdate)");
+    ok($fatal_alert, "Record not on boundary in TLS1.3 (KeyUpdate)");
  }
 
 
 sub add_empty_recs_filter
 {
     my $proxy = shift;
+    my $records = $proxy->record_list;
 
     # We're only interested in the initial ClientHello
     if ($proxy->flight != 0) {
+        $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(1) == 10;
         return;
     }
 
@@ -221,18 +236,19 @@ sub add_empty_recs_filter
             "",
             ""
         );
-
-        push @{$proxy->record_list}, $record;
+        push @{$records}, $record;
     }
 }
 
 sub add_frag_alert_filter
 {
     my $proxy = shift;
+    my $records = $proxy->record_list;
     my $byte;
 
     # We're only interested in the initial ClientHello
     if ($proxy->flight != 0) {
+        $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(1) == 10;
         return;
     }
 
@@ -262,7 +278,7 @@ sub add_frag_alert_filter
         $byte,
         $byte
     );
-    push @{$proxy->record_list}, $record;
+    push @{$records}, $record;
 
     # And finally the description (Unexpected message) in a third record
     $byte = pack('C', TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE);
@@ -277,7 +293,7 @@ sub add_frag_alert_filter
         $byte,
         $byte
     );
-    push @{$proxy->record_list}, $record;
+    push @{$records}, $record;
 }
 
 sub add_sslv2_filter
@@ -430,17 +446,22 @@ sub add_sslv2_filter
 sub add_unknown_record_type
 {
     my $proxy = shift;
+    my $records = $proxy->record_list;
+    state $added_record;
 
     # We'll change a record after the initial version neg has taken place
-    if ($proxy->flight != 1) {
+    if ($proxy->flight == 0) {
+        $added_record = 0;
+        return;
+    } elsif ($proxy->flight != 1 || $added_record) {
+        $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == 10;
         return;
     }
 
-    my $lastrec = ${$proxy->record_list}[-1];
     my $record = TLSProxy::Record->new(
         1,
         TLSProxy::Record::RT_UNKNOWN,
-        $lastrec->version(),
+        @{$records}[-1]->version(),
         1,
         0,
         1,
@@ -457,64 +478,86 @@ sub add_unknown_record_type
     $i++;
 
     splice @{$proxy->record_list}, $i, 0, $record;
+    $added_record = 1;
 }
 
 sub change_version
 {
     my $proxy = shift;
+    my $records = $proxy->record_list;
 
     # We'll change a version after the initial version neg has taken place
     if ($proxy->flight != 1) {
+        $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == 70;
         return;
     }
 
-    (${$proxy->record_list}[-1])->version(TLSProxy::Record::VERS_TLS_1_1);
+    if ($#{$records} > 1) {
+        # ... typically in ServerHelloDone
+        @{$records}[-1]->version(TLSProxy::Record::VERS_TLS_1_1);
+    }
 }
 
 sub change_outer_record_type
 {
     my $proxy = shift;
+    my $records = $proxy->record_list;
 
     # We'll change a record after the initial version neg has taken place
     if ($proxy->flight != 1) {
+        $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == 10;
         return;
     }
 
-    #Find ServerHello record and change record after that
-    my $i;
-    for ($i = 0; ${$proxy->record_list}[$i]->flight() < 1; $i++) {
-        next;
+    # Find CCS record and change record after that
+    my $i = 0;
+    foreach my $record (@{$records}) {
+        last if $record->content_type == TLSProxy::Record::RT_CCS;
+        $i++;
+    }
+    if (defined(${$records}[++$i])) {
+        ${$records}[$i]->outer_content_type(TLSProxy::Record::RT_HANDSHAKE);
     }
-    #Skip CCS and ServerHello
-    $i += 2;
-    ${$proxy->record_list}[$i]->outer_content_type(TLSProxy::Record::RT_HANDSHAKE);
 }
 
 sub not_on_record_boundary
 {
     my $proxy = shift;
+    my $records = $proxy->record_list;
     my $data;
 
     #Find server's first flight
     if ($proxy->flight != 1) {
+        $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == 10;
         return;
     }
 
     if ($boundary_test_type == DATA_AFTER_SERVER_HELLO) {
         #Merge the ServerHello and EncryptedExtensions records into one
-        my $i;
-        for ($i = 0; ${$proxy->record_list}[$i]->flight() < 1; $i++) {
-            next;
+        my $i = 0;
+        foreach my $record (@{$records}) {
+            if ($record->content_type == TLSProxy::Record::RT_HANDSHAKE) {
+                $record->{sent} = 1;    # pretend it's sent already
+                last;
+            }
+            $i++;
         }
-        $data = ${$proxy->record_list}[$i]->data();
-        $data .= ${$proxy->record_list}[$i + 1]->decrypt_data();
-        ${$proxy->record_list}[$i]->data($data);
-        ${$proxy->record_list}[$i]->len(length $data);
 
-        #Delete the old EncryptedExtensions record
-        splice @{$proxy->record_list}, $i + 1, 1;
+        if (defined(${$records}[$i+1])) {
+            $data = ${$records}[$i]->data();
+            $data .= ${$records}[$i+1]->decrypt_data();
+            ${$records}[$i+1]->data($data);
+            ${$records}[$i+1]->len(length $data);
+
+            #Delete the old ServerHello record
+            splice @{$records}, $i, 1;
+        }
     } elsif ($boundary_test_type == DATA_AFTER_FINISHED) {
-        $data = ${$proxy->record_list}[-1]->decrypt_data;
+        return if @{$proxy->{message_list}}[-1]->{mt}
+                  != TLSProxy::Message::MT_FINISHED;
+
+        my $last_record = @{$records}[-1];
+        $data = $last_record->decrypt_data;
 
         #Add a KeyUpdate message onto the end of the Finished record
         my $keyupdate = pack "C5",
@@ -528,15 +571,18 @@ sub not_on_record_boundary
         $data .= pack("C", TLSProxy::Record::RT_HANDSHAKE).("\0"x16);
 
         #Update the record
-        ${$proxy->record_list}[-1]->data($data);
-        ${$proxy->record_list}[-1]->len(length $data);
+        $last_record->data($data);
+        $last_record->len(length $data);
     } else {
+        return if @{$proxy->{message_list}}[-1]->{mt}
+                  != TLSProxy::Message::MT_FINISHED;
+
         #KeyUpdates must end on a record boundary
 
         my $record = TLSProxy::Record->new(
             1,
             TLSProxy::Record::RT_APPLICATION_DATA,
-            TLSProxy::Record::VERS_TLS_1_0,
+            TLSProxy::Record::VERS_TLS_1_2,
             0,
             0,
             0,
@@ -558,6 +604,6 @@ sub not_on_record_boundary
 
         $record->data($data);
         $record->len(length $data);
-        push @{$proxy->record_list}, $record;
+        push @{$records}, $record;
     }
 }
diff --git a/util/perl/TLSProxy/Message.pm b/util/perl/TLSProxy/Message.pm
index 68179d9..4a60ba0 100644
--- a/util/perl/TLSProxy/Message.pm
+++ b/util/perl/TLSProxy/Message.pm
@@ -267,14 +267,17 @@ sub get_messages
         }
     } elsif ($record->content_type == TLSProxy::Record::RT_ALERT) {
         my ($alertlev, $alertdesc) = unpack('CC', $record->decrypt_data);
+        print "  [$alertlev, $alertdesc]\n";
         #A CloseNotify from the client indicates we have finished successfully
         #(we assume)
         if (!$end && !$server && $alertlev == AL_LEVEL_WARN
             && $alertdesc == AL_DESC_CLOSE_NOTIFY) {
             $success = 1;
         }
-        #All alerts end the test
-        $end = 1;
+        #Fatal or close notify alerts end the test
+        if ($alertlev == AL_LEVEL_FATAL || $alertdesc == AL_DESC_CLOSE_NOTIFY) {
+            $end = 1;
+        }
     }
 
     return @messages;
diff --git a/util/perl/TLSProxy/Proxy.pm b/util/perl/TLSProxy/Proxy.pm
index 9e9764d..de6d2fd 100644
--- a/util/perl/TLSProxy/Proxy.pm
+++ b/util/perl/TLSProxy/Proxy.pm
@@ -239,7 +239,7 @@ sub start
     open(my $savedin, "<&STDIN");
 
     # Temporarily replace STDIN so that sink process can inherit it...
-    $pid = open(STDIN, "$execcmd |") or die "Failed to $execcmd: $!\n";
+    $pid = open(STDIN, "$execcmd 2>&1 |") or die "Failed to $execcmd: $!\n";
     $self->{real_serverpid} = $pid;
 
     # Process the output from s_server until we find the ACCEPT line, which
@@ -369,13 +369,14 @@ sub clientstart
     $fdset = IO::Select->new($server_sock, $client_sock);
     my @ready;
     my $ctr = 0;
-    my $sessionfile = $self->{sessionfile};
     local $SIG{PIPE} = "IGNORE";
+    $self->{saw_session_ticket} = undef;
     while($fdset->count && $ctr < 10) {
-        if (defined($sessionfile)) {
+        if (defined($self->{sessionfile})) {
             # s_client got -ign_eof and won't be exiting voluntarily, so we
-            # look for data *and* check on session file...
-            last if TLSProxy::Message->success() && -s $sessionfile;
+            # look for data *and* session ticket...
+            last if TLSProxy::Message->success()
+                    && $self->{saw_session_ticket};
         }
         if (!(@ready = $fdset->can_read(1))) {
             $ctr++;
@@ -449,7 +450,7 @@ sub clientstart
         $self->connect_to_server();
     }
     $pid = $self->{clientpid};
-    print "Waiting for client process to close: $pid...\n";
+    print "Waiting for s_client process to close: $pid...\n";
     waitpid($pid, 0);
 
     return 1;
@@ -496,6 +497,14 @@ sub process_packet
         $self->filter->($self);
     }
 
+    #Take a note on NewSessionTicket
+    foreach my $message (reverse @{$self->{message_list}}) {
+        if ($message->{mt} == TLSProxy::Message::MT_NEW_SESSION_TICKET) {
+            $self->{saw_session_ticket} = 1;
+            last;
+        }
+    }
+
     #Reconstruct the packet
     $packet = "";
     foreach my $record (@{$self->record_list}) {
diff --git a/util/perl/TLSProxy/Record.pm b/util/perl/TLSProxy/Record.pm
index 49a0084..8ff948b 100644
--- a/util/perl/TLSProxy/Record.pm
+++ b/util/perl/TLSProxy/Record.pm
@@ -67,17 +67,13 @@ sub get_records
 
     my $recnum = 1;
     while (length ($packet) > 0) {
-        print " Record $recnum";
-        if ($server) {
-            print " (server -> client)\n";
-        } else {
-            print " (client -> server)\n";
-        }
+        print " Record $recnum ", $server ? "(server -> client)\n"
+                                          : "(client -> server)\n";
 
         #Get the record header (unpack can't fail if $packet is too short)
         my ($content_type, $version, $len) = unpack('Cnn', $packet);
 
-        if (length($packet) < TLS_RECORD_HEADER_LENGTH + $len) {
+        if (length($packet) < TLS_RECORD_HEADER_LENGTH + ($len // 0)) {
             print "Partial data : ".length($packet)." bytes\n";
             $partial = $packet;
             last;
@@ -389,4 +385,16 @@ sub outer_content_type
     }
     return $self->{outer_content_type};
 }
+sub is_fatal_alert
+{
+    my $self = shift;
+    my $server = shift;
+
+    if (($self->{flight} & 1) == $server
+        && $self->{content_type} == TLSProxy::Record::RT_ALERT) {
+        my ($level, $alert) = unpack('CC', $self->decrypt_data);
+        return $alert if ($level == 2);
+    }
+    return 0;
+}
 1;


More information about the openssl-commits mailing list