xref: /freebsd/crypto/openssl/test/recipes/70-test_sslrecords.t (revision 24e4dcf4ba5e9dedcf89efd358ea3e1fe5867020)
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
9use strict;
10use feature 'state';
11
12use OpenSSL::Test qw/:DEFAULT cmdstr srctop_file bldtop_dir/;
13use OpenSSL::Test::Utils;
14use TLSProxy::Proxy;
15use TLSProxy::Message;
16
17my $test_name = "test_sslrecords";
18setup($test_name);
19
20plan skip_all => "TLSProxy isn't usable on $^O"
21    if $^O =~ /^(VMS)$/;
22
23plan skip_all => "$test_name needs the dynamic engine feature enabled"
24    if disabled("engine") || disabled("dynamic-engine");
25
26plan skip_all => "$test_name needs the sock feature enabled"
27    if disabled("sock");
28
29my $inject_recs_num = undef;
30my $content_type = undef;
31my $boundary_test_type = undef;
32my $fatal_alert = undef; # set by filters at expected fatal alerts
33my $sslv2testtype = undef;
34my $proxy_start_success = 0;
35
36plan tests => 44;
37
38SKIP: {
39    skip "TLS 1.2 is disabled", 22 if disabled("tls1_2");
40    # Run tests with TLS
41    run_tests(0);
42}
43
44SKIP: {
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
50sub 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
351sub 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
396sub 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
452sub 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
599sub 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
656sub 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
673sub 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
693sub 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
715sub 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
877sub 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