]> git.ipfire.org Git - thirdparty/openssl.git/blame - test/recipes/70-test_sslrecords.t
Raise an error on syscall failure in tls_retry_write_records
[thirdparty/openssl.git] / test / recipes / 70-test_sslrecords.t
CommitLineData
4f0c4757 1#! /usr/bin/env perl
b6461792 2# Copyright 2016-2024 The OpenSSL Project Authors. All Rights Reserved.
4f0c4757 3#
909f1a2e 4# Licensed under the Apache License 2.0 (the "License"). You may not use
4f0c4757
MC
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;
c4220c0f
AP
10use feature 'state';
11
4f0c4757
MC
12use OpenSSL::Test qw/:DEFAULT cmdstr srctop_file bldtop_dir/;
13use OpenSSL::Test::Utils;
14use TLSProxy::Proxy;
a1c72cc2 15use TLSProxy::Message;
4f0c4757
MC
16
17my $test_name = "test_sslrecords";
18setup($test_name);
19
20plan skip_all => "TLSProxy isn't usable on $^O"
c5856878 21 if $^O =~ /^(VMS)$/;
4f0c4757
MC
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
4d7f5b82
FWH
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;
fa9e6f17 35
5f7694c8
FWH
36plan tests => 42;
37
38SKIP: {
39 skip "TLS 1.2 is disabled", 21 if disabled("tls1_2");
40 # Run tests with TLS
41 run_tests(0);
42}
43
44SKIP: {
45 skip "DTLS 1.2 is disabled", 21 if disabled("dtls1_2");
fe3029a1 46 skip "DTLSProxy does not work on Windows", 21 if $^O =~ /^(MSWin32)$/;
5f7694c8
FWH
47 run_tests(1);
48}
4d7f5b82
FWH
49
50sub run_tests
51{
52 my $run_test_as_dtls = shift;
635b5629
FWH
53
54 my $proxy;
4d7f5b82 55 if ($run_test_as_dtls == 1) {
fa9e6f17
FWH
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 );
4d7f5b82 62 } else {
fa9e6f17
FWH
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 );
4d7f5b82
FWH
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
a909113e 75 $proxy->clear();
4d7f5b82
FWH
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");
fa9e6f17 81 $proxy_start_success = $proxy->start();
4d7f5b82
FWH
82 ok($fatal_alert, "Out of context empty records test");
83 }
84
fa9e6f17
FWH
85 skip "TLSProxy did not start correctly", 21 if $proxy_start_success == 0
86 && $run_test_as_dtls == 0;
87
4d7f5b82 88 #Test 2: Injecting in context empty records should succeed
1f3e70a4 89 $proxy->clear();
4d7f5b82
FWH
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();
fa9e6f17
FWH
99
100 skip "TLSProxy did not start correctly", 20 if $proxy_start_success == 0
101 && $run_test_as_dtls == 1;
102
4d7f5b82
FWH
103 ok($proxy_start_success && TLSProxy::Message->success(),
104 "In context empty records test".($run_test_as_dtls == 1) ? " for DTLS" : " for TLS");
1f3e70a4 105
4d7f5b82
FWH
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");
8e47ee18 117
4d7f5b82
FWH
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");
774c909b 128
4d7f5b82 129 #Run some SSLv2 ClientHello tests
b4c6e37e 130
4d7f5b82
FWH
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 };
b4c6e37e 138
4d7f5b82
FWH
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.
774c909b 142
4d7f5b82
FWH
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");
774c909b 152
4d7f5b82
FWH
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
73e62d40 196
4d7f5b82 197 #Test 10: Sending an unrecognised record type in TLS1.2 should fail
73e62d40
MC
198 $fatal_alert = 0;
199 $proxy->clear();
4d7f5b82
FWH
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();
73e62d40 209
4d7f5b82
FWH
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 }
723844d3
MC
236
237 SKIP: {
4d7f5b82
FWH
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;
723844d3 241 $proxy->clear();
4d7f5b82
FWH
242 $proxy->clientflags("-tls1_2");
243 $proxy->filter(\&change_version);
723844d3 244 $proxy->start();
4d7f5b82
FWH
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 }
723844d3 338 }
4d7f5b82 339}
b4c6e37e 340
8e47ee18 341
4f0c4757
MC
342sub add_empty_recs_filter
343{
344 my $proxy = shift;
c4220c0f 345 my $records = $proxy->record_list;
4d7f5b82 346 my $isdtls = $proxy->isdtls();
4f0c4757
MC
347
348 # We're only interested in the initial ClientHello
349 if ($proxy->flight != 0) {
a1c72cc2 350 $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(1) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
4f0c4757
MC
351 return;
352 }
353
354 for (my $i = 0; $i < $inject_recs_num; $i++) {
4d7f5b82
FWH
355 my $record;
356 if ($isdtls == 1) {
357 $record = TLSProxy::Record->new_dtls(
358 0,
359 $content_type,
360 TLSProxy::Record::VERS_DTLS_1_2,
361 0,
362 0,
363 0,
364 0,
365 0,
366 0,
367 "",
368 ""
369 );
370 } else {
371 $record = TLSProxy::Record->new(
372 0,
373 $content_type,
374 TLSProxy::Record::VERS_TLS_1_2,
375 0,
376 0,
377 0,
378 0,
379 "",
380 ""
381 );
382 }
c4220c0f 383 push @{$records}, $record;
4f0c4757
MC
384 }
385}
c3fd55d4
MC
386
387sub add_frag_alert_filter
388{
389 my $proxy = shift;
c4220c0f 390 my $records = $proxy->record_list;
c3fd55d4
MC
391 my $byte;
392
393 # We're only interested in the initial ClientHello
394 if ($proxy->flight != 0) {
a1c72cc2 395 $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(1) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
c3fd55d4
MC
396 return;
397 }
398
399 # Add a zero length fragment first
400 #my $record = TLSProxy::Record->new(
401 # 0,
402 # TLSProxy::Record::RT_ALERT,
403 # TLSProxy::Record::VERS_TLS_1_2,
404 # 0,
405 # 0,
406 # 0,
407 # "",
408 # ""
409 #);
410 #push @{$proxy->record_list}, $record;
411
60250017 412 # Now add the alert level (Fatal) as a separate record
c3fd55d4
MC
413 $byte = pack('C', TLSProxy::Message::AL_LEVEL_FATAL);
414 my $record = TLSProxy::Record->new(
415 0,
416 TLSProxy::Record::RT_ALERT,
417 TLSProxy::Record::VERS_TLS_1_2,
418 1,
a2a0c86b 419 0,
c3fd55d4
MC
420 1,
421 1,
422 $byte,
423 $byte
424 );
c4220c0f 425 push @{$records}, $record;
c3fd55d4
MC
426
427 # And finally the description (Unexpected message) in a third record
428 $byte = pack('C', TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE);
429 $record = TLSProxy::Record->new(
430 0,
431 TLSProxy::Record::RT_ALERT,
432 TLSProxy::Record::VERS_TLS_1_2,
433 1,
a2a0c86b 434 0,
c3fd55d4
MC
435 1,
436 1,
437 $byte,
438 $byte
439 );
c4220c0f 440 push @{$records}, $record;
c3fd55d4 441}
a2a0c86b
MC
442
443sub add_sslv2_filter
444{
445 my $proxy = shift;
446 my $clienthello;
447 my $record;
448
449 # We're only interested in the initial ClientHello
450 if ($proxy->flight != 0) {
451 return;
452 }
453
454 # Ditch the real ClientHello - we're going to replace it with our own
455 shift @{$proxy->record_list};
456
457 if ($sslv2testtype == ALERT_BEFORE_SSLV2) {
458 my $alert = pack('CC', TLSProxy::Message::AL_LEVEL_FATAL,
459 TLSProxy::Message::AL_DESC_NO_RENEGOTIATION);
460 my $alertlen = length $alert;
461 $record = TLSProxy::Record->new(
462 0,
463 TLSProxy::Record::RT_ALERT,
464 TLSProxy::Record::VERS_TLS_1_2,
465 $alertlen,
466 0,
467 $alertlen,
468 $alertlen,
469 $alert,
470 $alert
471 );
472
473 push @{$proxy->record_list}, $record;
474 }
475
476 if ($sslv2testtype == ALERT_BEFORE_SSLV2
477 || $sslv2testtype == TLSV1_2_IN_SSLV2
478 || $sslv2testtype == SSLV2_IN_SSLV2) {
479 # This is an SSLv2 format ClientHello
480 $clienthello =
481 pack "C44",
482 0x01, # ClientHello
483 0x03, 0x03, #TLSv1.2
484 0x00, 0x03, # Ciphersuites len
485 0x00, 0x00, # Session id len
486 0x00, 0x20, # Challenge len
487 0x00, 0x00, 0x2f, #AES128-SHA
488 0x01, 0x18, 0x9F, 0x76, 0xEC, 0x57, 0xCE, 0xE5, 0xB3, 0xAB, 0x79, 0x90,
489 0xAD, 0xAC, 0x6E, 0xD1, 0x58, 0x35, 0x03, 0x97, 0x16, 0x10, 0x82, 0x56,
490 0xD8, 0x55, 0xFF, 0xE1, 0x8A, 0xA3, 0x2E, 0xF6; # Challenge
491
492 if ($sslv2testtype == SSLV2_IN_SSLV2) {
493 # Set the version to "real" SSLv2
494 vec($clienthello, 1, 8) = 0x00;
495 vec($clienthello, 2, 8) = 0x02;
496 }
497
498 my $chlen = length $clienthello;
499
500 $record = TLSProxy::Record->new(
501 0,
502 TLSProxy::Record::RT_HANDSHAKE,
503 TLSProxy::Record::VERS_TLS_1_2,
504 $chlen,
505 1, #SSLv2
506 $chlen,
507 $chlen,
508 $clienthello,
509 $clienthello
510 );
511
512 push @{$proxy->record_list}, $record;
513 } else {
514 # For this test we're using a real TLS ClientHello
515 $clienthello =
516 pack "C49",
517 0x01, # ClientHello
518 0x00, 0x00, 0x2D, # Message length
519 0x03, 0x03, # TLSv1.2
520 0x01, 0x18, 0x9F, 0x76, 0xEC, 0x57, 0xCE, 0xE5, 0xB3, 0xAB, 0x79, 0x90,
521 0xAD, 0xAC, 0x6E, 0xD1, 0x58, 0x35, 0x03, 0x97, 0x16, 0x10, 0x82, 0x56,
522 0xD8, 0x55, 0xFF, 0xE1, 0x8A, 0xA3, 0x2E, 0xF6, # Random
523 0x00, # Session id len
524 0x00, 0x04, # Ciphersuites len
525 0x00, 0x2f, # AES128-SHA
526 0x00, 0xff, # Empty reneg info SCSV
527 0x01, # Compression methods len
528 0x00, # Null compression
529 0x00, 0x00; # Extensions len
530
531 # Split this into 3: A TLS record; a SSLv2 record and a TLS record.
532 # We deliberately split the second record prior to the Challenge/Random
533 # and set the first byte of the random to 1. This makes the second SSLv2
534 # record look like an SSLv2 ClientHello
535 my $frag1 = substr $clienthello, 0, 6;
536 my $frag2 = substr $clienthello, 6, 32;
537 my $frag3 = substr $clienthello, 38;
538
539 my $fraglen = length $frag1;
540 $record = TLSProxy::Record->new(
541 0,
542 TLSProxy::Record::RT_HANDSHAKE,
543 TLSProxy::Record::VERS_TLS_1_2,
544 $fraglen,
545 0,
546 $fraglen,
547 $fraglen,
548 $frag1,
549 $frag1
550 );
551 push @{$proxy->record_list}, $record;
552
553 $fraglen = length $frag2;
554 my $recvers;
555 if ($sslv2testtype == FRAGMENTED_IN_SSLV2) {
556 $recvers = 1;
557 } else {
558 $recvers = 0;
559 }
560 $record = TLSProxy::Record->new(
561 0,
562 TLSProxy::Record::RT_HANDSHAKE,
563 TLSProxy::Record::VERS_TLS_1_2,
564 $fraglen,
565 $recvers,
566 $fraglen,
567 $fraglen,
568 $frag2,
569 $frag2
570 );
571 push @{$proxy->record_list}, $record;
572
573 $fraglen = length $frag3;
574 $record = TLSProxy::Record->new(
575 0,
576 TLSProxy::Record::RT_HANDSHAKE,
577 TLSProxy::Record::VERS_TLS_1_2,
578 $fraglen,
579 0,
580 $fraglen,
581 $fraglen,
582 $frag3,
583 $frag3
584 );
585 push @{$proxy->record_list}, $record;
586 }
587
588}
1f3e70a4
MC
589
590sub add_unknown_record_type
591{
592 my $proxy = shift;
c4220c0f 593 my $records = $proxy->record_list;
4d7f5b82 594 my $isdtls = $proxy->isdtls;
c4220c0f 595 state $added_record;
1f3e70a4
MC
596
597 # We'll change a record after the initial version neg has taken place
c4220c0f
AP
598 if ($proxy->flight == 0) {
599 $added_record = 0;
600 return;
601 } elsif ($proxy->flight != 1 || $added_record) {
a1c72cc2 602 $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
1f3e70a4
MC
603 return;
604 }
605
4d7f5b82
FWH
606 my $record;
607
608 if ($isdtls) {
609 $record = TLSProxy::Record->new_dtls(
610 1,
611 TLSProxy::Record::RT_UNKNOWN,
612 @{$records}[-1]->version(),
613 @{$records}[-1]->epoch(),
614 @{$records}[-1]->seq() +1,
615 1,
616 0,
617 1,
618 1,
619 "X",
620 "X"
621 );
622 } else {
623 $record = TLSProxy::Record->new(
624 1,
625 TLSProxy::Record::RT_UNKNOWN,
626 @{$records}[-1]->version(),
627 1,
628 0,
629 1,
630 1,
631 "X",
632 "X"
633 );
634 }
1f3e70a4 635
b4c6e37e
MC
636 #Find ServerHello record and insert after that
637 my $i;
638 for ($i = 0; ${$proxy->record_list}[$i]->flight() < 1; $i++) {
639 next;
640 }
641 $i++;
642
643 splice @{$proxy->record_list}, $i, 0, $record;
c4220c0f 644 $added_record = 1;
1f3e70a4 645}
8e47ee18
MC
646
647sub change_version
648{
649 my $proxy = shift;
c4220c0f 650 my $records = $proxy->record_list;
8e47ee18
MC
651
652 # We'll change a version after the initial version neg has taken place
3295d242 653 if ($proxy->flight != 1) {
a1c72cc2 654 $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_PROTOCOL_VERSION;
8e47ee18
MC
655 return;
656 }
657
c4220c0f
AP
658 if ($#{$records} > 1) {
659 # ... typically in ServerHelloDone
660 @{$records}[-1]->version(TLSProxy::Record::VERS_TLS_1_1);
661 }
8e47ee18 662}
b4c6e37e 663
723844d3
MC
664sub change_server_hello_version
665{
666 my $proxy = shift;
667 my $records = $proxy->record_list;
668
669 # We're only interested in changing the ServerHello after an HRR
670 if ($proxy->flight != 3) {
671 return;
672 }
673
674 # The ServerHello has index 5
675 # 0 - ClientHello
676 # 1 - HRR
677 # 2 - CCS
678 # 3 - ClientHello(2)
679 # 4 - CCS
680 # 5 - ServerHello
681 @{$records}[5]->version(TLSProxy::Record::VERS_TLS_1_0);
682}
683
b4c6e37e
MC
684sub change_outer_record_type
685{
686 my $proxy = shift;
c4220c0f 687 my $records = $proxy->record_list;
b4c6e37e
MC
688
689 # We'll change a record after the initial version neg has taken place
690 if ($proxy->flight != 1) {
a1c72cc2 691 $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
b4c6e37e
MC
692 return;
693 }
694
c4220c0f
AP
695 # Find CCS record and change record after that
696 my $i = 0;
697 foreach my $record (@{$records}) {
698 last if $record->content_type == TLSProxy::Record::RT_CCS;
699 $i++;
700 }
701 if (defined(${$records}[++$i])) {
702 ${$records}[$i]->outer_content_type(TLSProxy::Record::RT_HANDSHAKE);
b4c6e37e 703 }
b4c6e37e 704}
774c909b
MC
705
706sub not_on_record_boundary
707{
708 my $proxy = shift;
c4220c0f 709 my $records = $proxy->record_list;
774c909b
MC
710 my $data;
711
712 #Find server's first flight
713 if ($proxy->flight != 1) {
a1c72cc2 714 $fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
774c909b
MC
715 return;
716 }
717
718 if ($boundary_test_type == DATA_AFTER_SERVER_HELLO) {
719 #Merge the ServerHello and EncryptedExtensions records into one
c4220c0f
AP
720 my $i = 0;
721 foreach my $record (@{$records}) {
722 if ($record->content_type == TLSProxy::Record::RT_HANDSHAKE) {
723 $record->{sent} = 1; # pretend it's sent already
724 last;
725 }
726 $i++;
774c909b 727 }
774c909b 728
c4220c0f
AP
729 if (defined(${$records}[$i+1])) {
730 $data = ${$records}[$i]->data();
731 $data .= ${$records}[$i+1]->decrypt_data();
732 ${$records}[$i+1]->data($data);
733 ${$records}[$i+1]->len(length $data);
734
735 #Delete the old ServerHello record
736 splice @{$records}, $i, 1;
737 }
774c909b 738 } elsif ($boundary_test_type == DATA_AFTER_FINISHED) {
c4220c0f
AP
739 return if @{$proxy->{message_list}}[-1]->{mt}
740 != TLSProxy::Message::MT_FINISHED;
741
742 my $last_record = @{$records}[-1];
743 $data = $last_record->decrypt_data;
774c909b
MC
744
745 #Add a KeyUpdate message onto the end of the Finished record
746 my $keyupdate = pack "C5",
747 0x18, # KeyUpdate
748 0x00, 0x00, 0x01, # Message length
749 0x00; # Update not requested
750
751 $data .= $keyupdate;
752
753 #Add content type and tag
754 $data .= pack("C", TLSProxy::Record::RT_HANDSHAKE).("\0"x16);
755
756 #Update the record
c4220c0f
AP
757 $last_record->data($data);
758 $last_record->len(length $data);
73e62d40 759 } elsif ($boundary_test_type == DATA_AFTER_KEY_UPDATE) {
c4220c0f
AP
760 return if @{$proxy->{message_list}}[-1]->{mt}
761 != TLSProxy::Message::MT_FINISHED;
762
774c909b
MC
763 #KeyUpdates must end on a record boundary
764
765 my $record = TLSProxy::Record->new(
766 1,
767 TLSProxy::Record::RT_APPLICATION_DATA,
c4220c0f 768 TLSProxy::Record::VERS_TLS_1_2,
774c909b
MC
769 0,
770 0,
771 0,
772 0,
773 "",
774 ""
775 );
776
777 #Add two KeyUpdate messages into a single record
778 my $keyupdate = pack "C5",
779 0x18, # KeyUpdate
780 0x00, 0x00, 0x01, # Message length
781 0x00; # Update not requested
782
783 $data = $keyupdate.$keyupdate;
784
785 #Add content type and tag
786 $data .= pack("C", TLSProxy::Record::RT_HANDSHAKE).("\0"x16);
787
788 $record->data($data);
789 $record->len(length $data);
c4220c0f 790 push @{$records}, $record;
73e62d40
MC
791 } else {
792 return if @{$proxy->{message_list}}[-1]->{mt}
793 != TLSProxy::Message::MT_FINISHED;
794
795 my $record = TLSProxy::Record->new(
796 1,
797 TLSProxy::Record::RT_APPLICATION_DATA,
798 TLSProxy::Record::VERS_TLS_1_2,
799 0,
800 0,
801 0,
802 0,
803 "",
804 ""
805 );
806
807 #Add a partial KeyUpdate message into the record
808 $data = pack "C1",
809 0x18; # KeyUpdate message type. Omit the rest of the message header
810
811 #Add content type and tag
812 $data .= pack("C", TLSProxy::Record::RT_HANDSHAKE).("\0"x16);
813
814 $record->data($data);
815 $record->len(length $data);
816 push @{$records}, $record;
817
818 if ($boundary_test_type == DATA_BETWEEN_KEY_UPDATE) {
819 #Now add an app data record
820 $record = TLSProxy::Record->new(
821 1,
822 TLSProxy::Record::RT_APPLICATION_DATA,
823 TLSProxy::Record::VERS_TLS_1_2,
824 0,
825 0,
826 0,
827 0,
828 "",
829 ""
830 );
831
832 #Add an empty app data record (just content type and tag)
833 $data = pack("C", TLSProxy::Record::RT_APPLICATION_DATA).("\0"x16);
834
835 $record->data($data);
836 $record->len(length $data);
837 push @{$records}, $record;
838 }
839
840 #Now add the rest of the KeyUpdate message
841 $record = TLSProxy::Record->new(
842 1,
843 TLSProxy::Record::RT_APPLICATION_DATA,
844 TLSProxy::Record::VERS_TLS_1_2,
845 0,
846 0,
847 0,
848 0,
849 "",
850 ""
851 );
852
853 #Add the last 4 bytes of the KeyUpdate record
854 $data = pack "C4",
855 0x00, 0x00, 0x01, # Message length
856 0x00; # Update not requested
857
858 #Add content type and tag
859 $data .= pack("C", TLSProxy::Record::RT_HANDSHAKE).("\0"x16);
860
861 $record->data($data);
862 $record->len(length $data);
863 push @{$records}, $record;
864
774c909b
MC
865 }
866}