test/recipes/70-test_sslrecords.t

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