Home | History | Annotate | Line # | Download | only in recipes
      1 #! /usr/bin/env perl
      2 # Copyright 2016-2025 The OpenSSL Project Authors. All Rights Reserved.
      3 #
      4 # Licensed under the Apache License 2.0 (the "License").  You may not use
      5 # this file except in compliance with the License.  You can obtain a copy
      6 # in the file LICENSE in the source distribution or at
      7 # https://www.openssl.org/source/license.html
      8 
      9 use strict;
     10 use feature 'state';
     11 
     12 use OpenSSL::Test qw/:DEFAULT cmdstr srctop_file bldtop_dir/;
     13 use OpenSSL::Test::Utils;
     14 use TLSProxy::Proxy;
     15 use TLSProxy::Message;
     16 
     17 my $test_name = "test_sslrecords";
     18 setup($test_name);
     19 
     20 plan skip_all => "TLSProxy isn't usable on $^O"
     21     if $^O =~ /^(VMS)$/;
     22 
     23 plan skip_all => "$test_name needs the dynamic engine feature enabled"
     24     if disabled("engine") || disabled("dynamic-engine");
     25 
     26 plan skip_all => "$test_name needs the sock feature enabled"
     27     if disabled("sock");
     28 
     29 my $inject_recs_num = undef;
     30 my $content_type = undef;
     31 my $boundary_test_type = undef;
     32 my $fatal_alert = undef; # set by filters at expected fatal alerts
     33 my $sslv2testtype = undef;
     34 my $proxy_start_success = 0;
     35 
     36 plan tests => 44;
     37 
     38 SKIP: {
     39     skip "TLS 1.2 is disabled", 22 if disabled("tls1_2");
     40     # Run tests with TLS
     41     run_tests(0);
     42 }
     43 
     44 SKIP: {
     45     skip "DTLS 1.2 is disabled", 22 if disabled("dtls1_2");
     46     skip "DTLSProxy does not work on Windows", 22 if $^O =~ /^(MSWin32)$/;
     47     run_tests(1);
     48 }
     49 
     50 sub run_tests
     51 {
     52     my $run_test_as_dtls = shift;
     53 
     54     my $proxy;
     55     if ($run_test_as_dtls == 1) {
     56         $proxy = TLSProxy::Proxy->new_dtls(
     57             \&add_empty_recs_filter,
     58             cmdstr(app([ "openssl" ]), display => 1),
     59             srctop_file("apps", "server.pem"),
     60             (!$ENV{HARNESS_ACTIVE} || $ENV{HARNESS_VERBOSE})
     61         );
     62     } else {
     63         $proxy = TLSProxy::Proxy->new(
     64             \&add_empty_recs_filter,
     65             cmdstr(app([ "openssl" ]), display => 1),
     66             srctop_file("apps", "server.pem"),
     67             (!$ENV{HARNESS_ACTIVE} || $ENV{HARNESS_VERBOSE})
     68         );
     69     }
     70 
     71     $fatal_alert = 0; # set by filters at expected fatal alerts
     72     SKIP: {
     73         skip "Record tests not intended for dtls", 1 if $run_test_as_dtls == 1;
     74         #Test 1: Injecting out of context empty records should fail
     75         $proxy->clear();
     76         $content_type = TLSProxy::Record::RT_APPLICATION_DATA;
     77         $inject_recs_num = 1;
     78         $fatal_alert = 0;
     79         $proxy->serverflags("-tls1_2");
     80         $proxy->clientflags("-no_tls1_3");
     81         $proxy_start_success = $proxy->start();
     82         ok($fatal_alert, "Out of context empty records test");
     83     }
     84 
     85     skip "TLSProxy did not start correctly", 21 if $proxy_start_success == 0
     86                                                    && $run_test_as_dtls == 0;
     87 
     88     #Test 2: Injecting in context empty records should succeed
     89     $proxy->clear();
     90     $content_type = TLSProxy::Record::RT_HANDSHAKE;
     91     if ($run_test_as_dtls == 1) {
     92         $proxy->serverflags("-min_protocol DTLSv1.2 -max_protocol DTLSv1.2");
     93         $proxy->clientflags("-max_protocol DTLSv1.2");
     94     } else {
     95         $proxy->serverflags("-tls1_2");
     96         $proxy->clientflags("-no_tls1_3");
     97     }
     98     $proxy_start_success = $proxy->start();
     99 
    100     skip "TLSProxy did not start correctly", 20 if $proxy_start_success == 0
    101                                                    && $run_test_as_dtls == 1;
    102 
    103     ok($proxy_start_success && TLSProxy::Message->success(),
    104        "In context empty records test".($run_test_as_dtls == 1) ? " for DTLS" : " for TLS");
    105 
    106     SKIP: {
    107         skip "Record tests not intended for dtls", 7 if $run_test_as_dtls == 1;
    108         #Test 3: Injecting too many in context empty records should fail
    109         $fatal_alert = 0;
    110         $proxy->clear();
    111         #We allow 32 consecutive in context empty records
    112         $inject_recs_num = 33;
    113         $proxy->serverflags("-tls1_2");
    114         $proxy->clientflags("-no_tls1_3");
    115         $proxy->start();
    116         ok($fatal_alert, "Too many in context empty records test");
    117 
    118         #Test 4: Injecting a fragmented fatal alert should fail. We expect the server to
    119         #        send back an alert of its own because it cannot handle fragmented
    120         #        alerts
    121         $fatal_alert = 0;
    122         $proxy->clear();
    123         $proxy->filter(\&add_frag_alert_filter);
    124         $proxy->serverflags("-tls1_2");
    125         $proxy->clientflags("-no_tls1_3");
    126         $proxy->start();
    127         ok($fatal_alert, "Fragmented alert records test");
    128 
    129         #Run some SSLv2 ClientHello tests
    130 
    131         use constant {
    132             TLSV1_2_IN_SSLV2      => 0,
    133             SSLV2_IN_SSLV2        => 1,
    134             FRAGMENTED_IN_TLSV1_2 => 2,
    135             FRAGMENTED_IN_SSLV2   => 3,
    136             ALERT_BEFORE_SSLV2    => 4
    137         };
    138 
    139         # The TLSv1.2 in SSLv2 ClientHello need to run at security level 0
    140         # because in a SSLv2 ClientHello we can't send extensions to indicate
    141         # which signature algorithm we want to use, and the default is SHA1.
    142 
    143         #Test 5: Inject an SSLv2 style record format for a TLSv1.2 ClientHello
    144         $sslv2testtype = TLSV1_2_IN_SSLV2;
    145         $proxy->clear();
    146         $proxy->filter(\&add_sslv2_filter);
    147         $proxy->serverflags("-tls1_2");
    148         $proxy->clientflags("-no_tls1_3 -legacy_renegotiation");
    149         $proxy->ciphers("AES128-SHA:\@SECLEVEL=0");
    150         $proxy->start();
    151         ok(TLSProxy::Message->success(), "TLSv1.2 in SSLv2 ClientHello test");
    152 
    153         #Test 6: Inject an SSLv2 style record format for an SSLv2 ClientHello. We don't
    154         #        support this so it should fail. We actually treat it as an unknown
    155         #        protocol so we don't even send an alert in this case.
    156         $sslv2testtype = SSLV2_IN_SSLV2;
    157         $proxy->clear();
    158         $proxy->serverflags("-tls1_2");
    159         $proxy->clientflags("-no_tls1_3");
    160         $proxy->ciphers("AES128-SHA:\@SECLEVEL=0");
    161         $proxy->start();
    162         ok(TLSProxy::Message->fail(), "SSLv2 in SSLv2 ClientHello test");
    163 
    164         #Test 7: Sanity check ClientHello fragmentation. This isn't really an SSLv2 test
    165         #        at all, but it gives us confidence that Test 8 fails for the right
    166         #        reasons
    167         $sslv2testtype = FRAGMENTED_IN_TLSV1_2;
    168         $proxy->clear();
    169         $proxy->serverflags("-tls1_2");
    170         $proxy->clientflags("-no_tls1_3");
    171         $proxy->ciphers("AES128-SHA:\@SECLEVEL=0");
    172         $proxy->start();
    173         ok(TLSProxy::Message->success(), "Fragmented ClientHello in TLSv1.2 test");
    174 
    175         #Test 8: Fragment a TLSv1.2 ClientHello across a TLS1.2 record; an SSLv2
    176         #        record; and another TLS1.2 record. This isn't allowed so should fail
    177         $sslv2testtype = FRAGMENTED_IN_SSLV2;
    178         $proxy->clear();
    179         $proxy->serverflags("-tls1_2");
    180         $proxy->clientflags("-no_tls1_3");
    181         $proxy->ciphers("AES128-SHA:\@SECLEVEL=0");
    182         $proxy->start();
    183         ok(TLSProxy::Message->fail(), "Fragmented ClientHello in TLSv1.2/SSLv2 test");
    184 
    185         #Test 9: Send a TLS warning alert before an SSLv2 ClientHello. This should
    186         #        fail because an SSLv2 ClientHello must be the first record.
    187         $sslv2testtype = ALERT_BEFORE_SSLV2;
    188         $proxy->clear();
    189         $proxy->serverflags("-tls1_2");
    190         $proxy->clientflags("-no_tls1_3");
    191         $proxy->ciphers("AES128-SHA:\@SECLEVEL=0");
    192         $proxy->start();
    193         ok(TLSProxy::Message->fail(), "Alert before SSLv2 ClientHello test");
    194    }
    195     #Unrecognised record type tests
    196 
    197     #Test 10: Sending an unrecognised record type in TLS1.2 should fail
    198     $fatal_alert = 0;
    199     $proxy->clear();
    200     if ($run_test_as_dtls == 1) {
    201         $proxy->serverflags("-min_protocol DTLSv1.2 -max_protocol DTLSv1.2");
    202         $proxy->clientflags("-max_protocol DTLSv1.2");
    203     } else {
    204         $proxy->serverflags("-tls1_2");
    205         $proxy->clientflags("-no_tls1_3");
    206     }
    207     $proxy->filter(\&add_unknown_record_type);
    208     $proxy_start_success = $proxy->start();
    209 
    210     if ($run_test_as_dtls == 1) {
    211         ok($proxy_start_success == 0, "Unrecognised record type in DTLS1.2");
    212     } else {
    213         ok($fatal_alert, "Unrecognised record type in TLS1.2");
    214     }
    215 
    216     SKIP: {
    217         skip "TLSv1.1 or DTLSv1 disabled", 1 if ($run_test_as_dtls == 0 && disabled("tls1_1"))
    218                                                  || ($run_test_as_dtls == 1 && disabled("dtls1"));
    219 
    220         #Test 11: Sending an unrecognised record type in TLS1.1 should fail
    221         $fatal_alert = 0;
    222         $proxy->clear();
    223         if ($run_test_as_dtls == 1) {
    224             $proxy->clientflags("-min_protocol DTLSv1 -max_protocol DTLSv1 -cipher DEFAULT:\@SECLEVEL=0");
    225         } else {
    226             $proxy->clientflags("-tls1_1 -cipher DEFAULT:\@SECLEVEL=0");
    227         }
    228         $proxy->ciphers("AES128-SHA:\@SECLEVEL=0");
    229         $proxy_start_success = $proxy->start();
    230         if ($run_test_as_dtls == 1) {
    231             ok($proxy_start_success == 0, "Unrecognised record type in DTLSv1");
    232         } else {
    233             ok($fatal_alert, "Unrecognised record type in TLSv1.1");
    234         }
    235     }
    236 
    237     SKIP: {
    238         skip "Record tests not intended for dtls", 10 if $run_test_as_dtls == 1;
    239         #Test 12: Sending a different record version in TLS1.2 should fail
    240         $fatal_alert = 0;
    241         $proxy->clear();
    242         $proxy->clientflags("-tls1_2");
    243         $proxy->filter(\&change_version);
    244         $proxy->start();
    245         ok($fatal_alert, "Changed record version in TLS1.2");
    246 
    247         #TLS1.3 specific tests
    248         SKIP: {
    249             skip "TLSv1.3 disabled", 9
    250                 if disabled("tls1_3") || (disabled("ec") && disabled("dh"));
    251 
    252             #Test 13: Sending a different record version in TLS1.3 should fail
    253             $proxy->clear();
    254             $proxy->filter(\&change_version);
    255             $proxy->start();
    256             ok(TLSProxy::Message->fail(), "Changed record version in TLS1.3");
    257 
    258             #Test 14: Sending an unrecognised record type in TLS1.3 should fail
    259             $fatal_alert = 0;
    260             $proxy->clear();
    261             $proxy->filter(\&add_unknown_record_type);
    262             $proxy->start();
    263             ok($fatal_alert, "Unrecognised record type in TLS1.3");
    264 
    265             #Test 15: Sending an outer record type other than app data once encrypted
    266             #should fail
    267             $fatal_alert = 0;
    268             $proxy->clear();
    269             $proxy->filter(\&change_outer_record_type);
    270             $proxy->start();
    271             ok($fatal_alert, "Wrong outer record type in TLS1.3");
    272 
    273             use constant {
    274                 DATA_AFTER_SERVER_HELLO    => 0,
    275                 DATA_AFTER_FINISHED        => 1,
    276                 DATA_AFTER_KEY_UPDATE      => 2,
    277                 DATA_BETWEEN_KEY_UPDATE    => 3,
    278                 NO_DATA_BETWEEN_KEY_UPDATE => 4,
    279             };
    280 
    281             #Test 16: Sending a ServerHello which doesn't end on a record boundary
    282             #         should fail
    283             $fatal_alert = 0;
    284             $proxy->clear();
    285             $boundary_test_type = DATA_AFTER_SERVER_HELLO;
    286             $proxy->filter(\&not_on_record_boundary);
    287             $proxy->start();
    288             ok($fatal_alert, "Record not on boundary in TLS1.3 (ServerHello)");
    289 
    290             #Test 17: Sending a Finished which doesn't end on a record boundary
    291             #         should fail
    292             $fatal_alert = 0;
    293             $proxy->clear();
    294             $boundary_test_type = DATA_AFTER_FINISHED;
    295             $proxy->start();
    296             ok($fatal_alert, "Record not on boundary in TLS1.3 (Finished)");
    297 
    298             #Test 18: Sending a KeyUpdate which doesn't end on a record boundary
    299             #         should fail
    300             $fatal_alert = 0;
    301             $proxy->clear();
    302             $boundary_test_type = DATA_AFTER_KEY_UPDATE;
    303             $proxy->start();
    304             ok($fatal_alert, "Record not on boundary in TLS1.3 (KeyUpdate)");
    305 
    306             #Test 19: Sending application data in the middle of a fragmented KeyUpdate
    307             #         should fail. Strictly speaking this is not a record boundary test
    308             #         but we use the same filter.
    309             $fatal_alert = 0;
    310             $proxy->clear();
    311             $boundary_test_type = DATA_BETWEEN_KEY_UPDATE;
    312             $proxy->start();
    313             ok($fatal_alert, "Data between KeyUpdate");
    314 
    315             #Test 20: Fragmented KeyUpdate. This should succeed. Strictly speaking this
    316             #         is not a record boundary test but we use the same filter.
    317             $proxy->clear();
    318             $boundary_test_type = NO_DATA_BETWEEN_KEY_UPDATE;
    319             $proxy->start();
    320             ok(TLSProxy::Message->success(), "No data between KeyUpdate");
    321 
    322             SKIP: {
    323                 skip "EC disabled", 1 if disabled("ec");
    324 
    325                 #Test 21: Force an HRR and change the "real" ServerHello to have a protocol
    326                 #         record version of 0x0301 (TLSv1.0). At this point we have already
    327                 #         decided that we are doing TLSv1.3 but are still using plaintext
    328                 #         records. The server should be sending a record version of 0x303
    329                 #         (TLSv1.2), but the RFC requires us to ignore this field so we
    330                 #         should tolerate the incorrect version.
    331                 $proxy->clear();
    332                 $proxy->filter(\&change_server_hello_version);
    333                 $proxy->serverflags("-groups P-256"); # Force an HRR
    334                 $proxy->start();
    335                 ok(TLSProxy::Message->success(), "Bad ServerHello record version after HRR");
    336             }
    337         }
    338     }
    339 
    340     SKIP: {
    341         skip "DTLS only record tests", 1 if $run_test_as_dtls != 1;
    342         #Test 22: We should ignore empty app data records
    343         $proxy->clear();
    344         $proxy->filter(\&empty_app_data);
    345         $proxy->start();
    346         ok(TLSProxy::Message->success(), "Empty app data in DTLS");
    347 
    348     }
    349 }
    350 
    351 sub add_empty_recs_filter
    352 {
    353     my $proxy = shift;
    354     my $records = $proxy->record_list;
    355     my $isdtls = $proxy->isdtls();
    356 
    357     # We're only interested in the initial ClientHello
    358     if ($proxy->flight != 0) {
    359         $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(1) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
    360         return;
    361     }
    362 
    363     for (my $i = 0; $i < $inject_recs_num; $i++) {
    364         my $record;
    365         if ($isdtls == 1) {
    366             $record = TLSProxy::Record->new_dtls(
    367                 0,
    368                 $content_type,
    369                 TLSProxy::Record::VERS_DTLS_1_2,
    370                 0,
    371                 0,
    372                 0,
    373                 0,
    374                 0,
    375                 0,
    376                 "",
    377                 ""
    378             );
    379         } else {
    380             $record = TLSProxy::Record->new(
    381                 0,
    382                 $content_type,
    383                 TLSProxy::Record::VERS_TLS_1_2,
    384                 0,
    385                 0,
    386                 0,
    387                 0,
    388                 "",
    389                 ""
    390             );
    391         }
    392         push @{$records}, $record;
    393     }
    394 }
    395 
    396 sub add_frag_alert_filter
    397 {
    398     my $proxy = shift;
    399     my $records = $proxy->record_list;
    400     my $byte;
    401 
    402     # We're only interested in the initial ClientHello
    403     if ($proxy->flight != 0) {
    404         $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(1) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
    405         return;
    406     }
    407 
    408     # Add a zero length fragment first
    409     #my $record = TLSProxy::Record->new(
    410     #    0,
    411     #    TLSProxy::Record::RT_ALERT,
    412     #    TLSProxy::Record::VERS_TLS_1_2,
    413     #    0,
    414     #    0,
    415     #    0,
    416     #    "",
    417     #    ""
    418     #);
    419     #push @{$proxy->record_list}, $record;
    420 
    421     # Now add the alert level (Fatal) as a separate record
    422     $byte = pack('C', TLSProxy::Message::AL_LEVEL_FATAL);
    423     my $record = TLSProxy::Record->new(
    424         0,
    425         TLSProxy::Record::RT_ALERT,
    426         TLSProxy::Record::VERS_TLS_1_2,
    427         1,
    428         0,
    429         1,
    430         1,
    431         $byte,
    432         $byte
    433     );
    434     push @{$records}, $record;
    435 
    436     # And finally the description (Unexpected message) in a third record
    437     $byte = pack('C', TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE);
    438     $record = TLSProxy::Record->new(
    439         0,
    440         TLSProxy::Record::RT_ALERT,
    441         TLSProxy::Record::VERS_TLS_1_2,
    442         1,
    443         0,
    444         1,
    445         1,
    446         $byte,
    447         $byte
    448     );
    449     push @{$records}, $record;
    450 }
    451 
    452 sub add_sslv2_filter
    453 {
    454     my $proxy = shift;
    455     my $clienthello;
    456     my $record;
    457 
    458     # We're only interested in the initial ClientHello
    459     if ($proxy->flight != 0) {
    460         return;
    461     }
    462 
    463     # Ditch the real ClientHello - we're going to replace it with our own
    464     shift @{$proxy->record_list};
    465 
    466     if ($sslv2testtype == ALERT_BEFORE_SSLV2) {
    467         my $alert = pack('CC', TLSProxy::Message::AL_LEVEL_FATAL,
    468                                TLSProxy::Message::AL_DESC_NO_RENEGOTIATION);
    469         my $alertlen = length $alert;
    470         $record = TLSProxy::Record->new(
    471             0,
    472             TLSProxy::Record::RT_ALERT,
    473             TLSProxy::Record::VERS_TLS_1_2,
    474             $alertlen,
    475             0,
    476             $alertlen,
    477             $alertlen,
    478             $alert,
    479             $alert
    480         );
    481 
    482         push @{$proxy->record_list}, $record;
    483     }
    484 
    485     if ($sslv2testtype == ALERT_BEFORE_SSLV2
    486             || $sslv2testtype == TLSV1_2_IN_SSLV2
    487             || $sslv2testtype == SSLV2_IN_SSLV2) {
    488         # This is an SSLv2 format ClientHello
    489         $clienthello =
    490             pack "C44",
    491             0x01, # ClientHello
    492             0x03, 0x03, #TLSv1.2
    493             0x00, 0x03, # Ciphersuites len
    494             0x00, 0x00, # Session id len
    495             0x00, 0x20, # Challenge len
    496             0x00, 0x00, 0x2f, #AES128-SHA
    497             0x01, 0x18, 0x9F, 0x76, 0xEC, 0x57, 0xCE, 0xE5, 0xB3, 0xAB, 0x79, 0x90,
    498             0xAD, 0xAC, 0x6E, 0xD1, 0x58, 0x35, 0x03, 0x97, 0x16, 0x10, 0x82, 0x56,
    499             0xD8, 0x55, 0xFF, 0xE1, 0x8A, 0xA3, 0x2E, 0xF6; # Challenge
    500 
    501         if ($sslv2testtype == SSLV2_IN_SSLV2) {
    502             # Set the version to "real" SSLv2
    503             vec($clienthello, 1, 8) = 0x00;
    504             vec($clienthello, 2, 8) = 0x02;
    505         }
    506 
    507         my $chlen = length $clienthello;
    508 
    509         $record = TLSProxy::Record->new(
    510             0,
    511             TLSProxy::Record::RT_HANDSHAKE,
    512             TLSProxy::Record::VERS_TLS_1_2,
    513             $chlen,
    514             1, #SSLv2
    515             $chlen,
    516             $chlen,
    517             $clienthello,
    518             $clienthello
    519         );
    520 
    521         push @{$proxy->record_list}, $record;
    522     } else {
    523         # For this test we're using a real TLS ClientHello
    524         $clienthello =
    525             pack "C49",
    526             0x01, # ClientHello
    527             0x00, 0x00, 0x2D, # Message length
    528             0x03, 0x03, # TLSv1.2
    529             0x01, 0x18, 0x9F, 0x76, 0xEC, 0x57, 0xCE, 0xE5, 0xB3, 0xAB, 0x79, 0x90,
    530             0xAD, 0xAC, 0x6E, 0xD1, 0x58, 0x35, 0x03, 0x97, 0x16, 0x10, 0x82, 0x56,
    531             0xD8, 0x55, 0xFF, 0xE1, 0x8A, 0xA3, 0x2E, 0xF6, # Random
    532             0x00, # Session id len
    533             0x00, 0x04, # Ciphersuites len
    534             0x00, 0x2f, # AES128-SHA
    535             0x00, 0xff, # Empty reneg info SCSV
    536             0x01, # Compression methods len
    537             0x00, # Null compression
    538             0x00, 0x00; # Extensions len
    539 
    540         # Split this into 3: A TLS record; a SSLv2 record and a TLS record.
    541         # We deliberately split the second record prior to the Challenge/Random
    542         # and set the first byte of the random to 1. This makes the second SSLv2
    543         # record look like an SSLv2 ClientHello
    544         my $frag1 = substr $clienthello, 0, 6;
    545         my $frag2 = substr $clienthello, 6, 32;
    546         my $frag3 = substr $clienthello, 38;
    547 
    548         my $fraglen = length $frag1;
    549         $record = TLSProxy::Record->new(
    550             0,
    551             TLSProxy::Record::RT_HANDSHAKE,
    552             TLSProxy::Record::VERS_TLS_1_2,
    553             $fraglen,
    554             0,
    555             $fraglen,
    556             $fraglen,
    557             $frag1,
    558             $frag1
    559         );
    560         push @{$proxy->record_list}, $record;
    561 
    562         $fraglen = length $frag2;
    563         my $recvers;
    564         if ($sslv2testtype == FRAGMENTED_IN_SSLV2) {
    565             $recvers = 1;
    566         } else {
    567             $recvers = 0;
    568         }
    569         $record = TLSProxy::Record->new(
    570             0,
    571             TLSProxy::Record::RT_HANDSHAKE,
    572             TLSProxy::Record::VERS_TLS_1_2,
    573             $fraglen,
    574             $recvers,
    575             $fraglen,
    576             $fraglen,
    577             $frag2,
    578             $frag2
    579         );
    580         push @{$proxy->record_list}, $record;
    581 
    582         $fraglen = length $frag3;
    583         $record = TLSProxy::Record->new(
    584             0,
    585             TLSProxy::Record::RT_HANDSHAKE,
    586             TLSProxy::Record::VERS_TLS_1_2,
    587             $fraglen,
    588             0,
    589             $fraglen,
    590             $fraglen,
    591             $frag3,
    592             $frag3
    593         );
    594         push @{$proxy->record_list}, $record;
    595     }
    596 
    597 }
    598 
    599 sub add_unknown_record_type
    600 {
    601     my $proxy = shift;
    602     my $records = $proxy->record_list;
    603     my $isdtls = $proxy->isdtls;
    604     state $added_record;
    605 
    606     # We'll change a record after the initial version neg has taken place
    607     if ($proxy->flight == 0) {
    608         $added_record = 0;
    609         return;
    610     } elsif ($proxy->flight != 1 || $added_record) {
    611         $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
    612         return;
    613     }
    614 
    615     my $record;
    616 
    617     if ($isdtls) {
    618         $record = TLSProxy::Record->new_dtls(
    619             1,
    620             TLSProxy::Record::RT_UNKNOWN,
    621             @{$records}[-1]->version(),
    622             @{$records}[-1]->epoch(),
    623             @{$records}[-1]->seq() +1,
    624             1,
    625             0,
    626             1,
    627             1,
    628             "X",
    629             "X"
    630         );
    631     } else {
    632         $record = TLSProxy::Record->new(
    633             1,
    634             TLSProxy::Record::RT_UNKNOWN,
    635             @{$records}[-1]->version(),
    636             1,
    637             0,
    638             1,
    639             1,
    640             "X",
    641             "X"
    642         );
    643     }
    644 
    645     #Find ServerHello record and insert after that
    646     my $i;
    647     for ($i = 0; ${$proxy->record_list}[$i]->flight() < 1; $i++) {
    648         next;
    649     }
    650     $i++;
    651 
    652     splice @{$proxy->record_list}, $i, 0, $record;
    653     $added_record = 1;
    654 }
    655 
    656 sub change_version
    657 {
    658     my $proxy = shift;
    659     my $records = $proxy->record_list;
    660 
    661     # We'll change a version after the initial version neg has taken place
    662     if ($proxy->flight != 1) {
    663         $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_PROTOCOL_VERSION;
    664         return;
    665     }
    666 
    667     if ($#{$records} > 1) {
    668         # ... typically in ServerHelloDone
    669         @{$records}[-1]->version(TLSProxy::Record::VERS_TLS_1_1);
    670     }
    671 }
    672 
    673 sub change_server_hello_version
    674 {
    675     my $proxy = shift;
    676     my $records = $proxy->record_list;
    677 
    678     # We're only interested in changing the ServerHello after an HRR
    679     if ($proxy->flight != 3) {
    680         return;
    681     }
    682 
    683     # The ServerHello has index 5
    684     # 0 - ClientHello
    685     # 1 - HRR
    686     # 2 - CCS
    687     # 3 - ClientHello(2)
    688     # 4 - CCS
    689     # 5 - ServerHello
    690     @{$records}[5]->version(TLSProxy::Record::VERS_TLS_1_0);
    691 }
    692 
    693 sub change_outer_record_type
    694 {
    695     my $proxy = shift;
    696     my $records = $proxy->record_list;
    697 
    698     # We'll change a record after the initial version neg has taken place
    699     if ($proxy->flight != 1) {
    700         $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
    701         return;
    702     }
    703 
    704     # Find CCS record and change record after that
    705     my $i = 0;
    706     foreach my $record (@{$records}) {
    707         last if $record->content_type == TLSProxy::Record::RT_CCS;
    708         $i++;
    709     }
    710     if (defined(${$records}[++$i])) {
    711         ${$records}[$i]->outer_content_type(TLSProxy::Record::RT_HANDSHAKE);
    712     }
    713 }
    714 
    715 sub not_on_record_boundary
    716 {
    717     my $proxy = shift;
    718     my $records = $proxy->record_list;
    719     my $data;
    720 
    721     #Find server's first flight
    722     if ($proxy->flight != 1) {
    723         $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
    724         return;
    725     }
    726 
    727     if ($boundary_test_type == DATA_AFTER_SERVER_HELLO) {
    728         #Merge the ServerHello and EncryptedExtensions records into one
    729         my $i = 0;
    730         foreach my $record (@{$records}) {
    731             if ($record->content_type == TLSProxy::Record::RT_HANDSHAKE) {
    732                 $record->{sent} = 1;    # pretend it's sent already
    733                 last;
    734             }
    735             $i++;
    736         }
    737 
    738         if (defined(${$records}[$i+1])) {
    739             $data = ${$records}[$i]->data();
    740             $data .= ${$records}[$i+1]->decrypt_data();
    741             ${$records}[$i+1]->data($data);
    742             ${$records}[$i+1]->len(length $data);
    743 
    744             #Delete the old ServerHello record
    745             splice @{$records}, $i, 1;
    746         }
    747     } elsif ($boundary_test_type == DATA_AFTER_FINISHED) {
    748         return if @{$proxy->{message_list}}[-1]->{mt}
    749                   != TLSProxy::Message::MT_FINISHED;
    750 
    751         my $last_record = @{$records}[-1];
    752         $data = $last_record->decrypt_data;
    753 
    754         #Add a KeyUpdate message onto the end of the Finished record
    755         my $keyupdate = pack "C5",
    756             0x18, # KeyUpdate
    757             0x00, 0x00, 0x01, # Message length
    758             0x00; # Update not requested
    759 
    760         $data .= $keyupdate;
    761 
    762         #Add content type and tag
    763         $data .= pack("C", TLSProxy::Record::RT_HANDSHAKE).("\0"x16);
    764 
    765         #Update the record
    766         $last_record->data($data);
    767         $last_record->len(length $data);
    768     } elsif ($boundary_test_type == DATA_AFTER_KEY_UPDATE) {
    769         return if @{$proxy->{message_list}}[-1]->{mt}
    770                   != TLSProxy::Message::MT_FINISHED;
    771 
    772         #KeyUpdates must end on a record boundary
    773 
    774         my $record = TLSProxy::Record->new(
    775             1,
    776             TLSProxy::Record::RT_APPLICATION_DATA,
    777             TLSProxy::Record::VERS_TLS_1_2,
    778             0,
    779             0,
    780             0,
    781             0,
    782             "",
    783             ""
    784         );
    785 
    786         #Add two KeyUpdate messages into a single record
    787         my $keyupdate = pack "C5",
    788             0x18, # KeyUpdate
    789             0x00, 0x00, 0x01, # Message length
    790             0x00; # Update not requested
    791 
    792         $data = $keyupdate.$keyupdate;
    793 
    794         #Add content type and tag
    795         $data .= pack("C", TLSProxy::Record::RT_HANDSHAKE).("\0"x16);
    796 
    797         $record->data($data);
    798         $record->len(length $data);
    799         push @{$records}, $record;
    800     } else {
    801         return if @{$proxy->{message_list}}[-1]->{mt}
    802                   != TLSProxy::Message::MT_FINISHED;
    803 
    804         my $record = TLSProxy::Record->new(
    805             1,
    806             TLSProxy::Record::RT_APPLICATION_DATA,
    807             TLSProxy::Record::VERS_TLS_1_2,
    808             0,
    809             0,
    810             0,
    811             0,
    812             "",
    813             ""
    814         );
    815 
    816         #Add a partial KeyUpdate message into the record
    817         $data = pack "C1",
    818             0x18; # KeyUpdate message type. Omit the rest of the message header
    819 
    820         #Add content type and tag
    821         $data .= pack("C", TLSProxy::Record::RT_HANDSHAKE).("\0"x16);
    822 
    823         $record->data($data);
    824         $record->len(length $data);
    825         push @{$records}, $record;
    826 
    827         if ($boundary_test_type == DATA_BETWEEN_KEY_UPDATE) {
    828             #Now add an app data record
    829             $record = TLSProxy::Record->new(
    830                 1,
    831                 TLSProxy::Record::RT_APPLICATION_DATA,
    832                 TLSProxy::Record::VERS_TLS_1_2,
    833                 0,
    834                 0,
    835                 0,
    836                 0,
    837                 "",
    838                 ""
    839             );
    840 
    841             #Add an empty app data record (just content type and tag)
    842             $data = pack("C", TLSProxy::Record::RT_APPLICATION_DATA).("\0"x16);
    843 
    844             $record->data($data);
    845             $record->len(length $data);
    846             push @{$records}, $record;
    847         }
    848 
    849         #Now add the rest of the KeyUpdate message
    850         $record = TLSProxy::Record->new(
    851             1,
    852             TLSProxy::Record::RT_APPLICATION_DATA,
    853             TLSProxy::Record::VERS_TLS_1_2,
    854             0,
    855             0,
    856             0,
    857             0,
    858             "",
    859             ""
    860         );
    861 
    862         #Add the last 4 bytes of the KeyUpdate record
    863         $data = pack "C4",
    864             0x00, 0x00, 0x01, # Message length
    865             0x00; # Update not requested
    866 
    867         #Add content type and tag
    868         $data .= pack("C", TLSProxy::Record::RT_HANDSHAKE).("\0"x16);
    869 
    870         $record->data($data);
    871         $record->len(length $data);
    872         push @{$records}, $record;
    873 
    874     }
    875 }
    876 
    877 sub empty_app_data
    878 {
    879     my $proxy = shift;
    880 
    881     # We're only interested in the client's Certificate..Finished flight
    882     if ($proxy->flight != 4) {
    883         return;
    884     }
    885 
    886     my $data = pack "C52",
    887         0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
    888         0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, #IV
    889         0x0f, 0x0f, 0x0f, 0x0f, 0x0f, 0x0f, 0x0f, 0x0f,
    890         0x0f, 0x0f, 0x0f, 0x0f, 0x0f, 0x0f, 0x0f, 0x0f, #One block of empty padded data
    891         0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,
    892         0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f,
    893         0x10, 0x11, 0x12, 0x13; #MAC, assume to be 20 bytes
    894 
    895     # Add a zero length app data record at the end
    896     # This will have the same sequence number as the subsequent app data record
    897     # that s_client will send - which will cause that second record to be
    898     # dropped. But that isn't important for this test.
    899     my $record = TLSProxy::Record->new_dtls(
    900         4,
    901         TLSProxy::Record::RT_APPLICATION_DATA,
    902         TLSProxy::Record::VERS_DTLS_1_2,
    903         1,
    904         1,
    905         length($data),
    906         0,
    907         length($data),
    908         0,
    909         $data,
    910         ""
    911     );
    912     push @{$proxy->record_list}, $record;
    913 }
    914