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