root
/
openssl
mirror of https://github.com/openssl/openssl.git
1
0
Fork 0
Code Issues Actions 7 Packages Projects Releases Wiki Activity

Support DTLS in TLS::Proxy. 

Fixes #23199

Reviewed-by: Tomas Mraz <tomas@openssl.org>
Reviewed-by: Matt Caswell <matt@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/23319)
This commit is contained in:
Frederik Wedel-Heinen 2024-01-11 14:18:07 +01:00 committed by Matt Caswell
parent 01690a7ff3
commit a1c72cc20d
16 changed files with 857 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

153
test/recipes/70-test_dtlsrecords.t Normal file
View File

@ -0,0 +1,153 @@
#! /usr/bin/env perl
# Copyright 2024 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the Apache License 2.0 (the "License"). You may not use
# this file except in compliance with the License. You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html
use strict;
use feature 'state';
use OpenSSL::Test qw/:DEFAULT cmdstr srctop_file bldtop_dir/;
use OpenSSL::Test::Utils;
use TLSProxy::Proxy;
use TLSProxy::Message;
my $test_name = "test_dtlsrecords";
setup($test_name);
plan skip_all => "TLSProxy isn't usable on $^O"
if $^O =~ /^(VMS)$/;
plan skip_all => "$test_name needs the dynamic engine feature enabled"
if disabled("engine") || disabled("dynamic-engine");
plan skip_all => "$test_name needs the sock feature enabled"
if disabled("sock");
plan skip_all => "$test_name needs DTLSv1.2 enabled"
if disabled("dtls1_2");
my $proxy = TLSProxy::Proxy->new_dtls(
undef,
cmdstr(app(["openssl"]), display => 1),
srctop_file("apps", "server.pem"),
(!$ENV{HARNESS_ACTIVE} || $ENV{HARNESS_VERBOSE})
);
plan tests => 4;
my $fatal_alert = 0; # set by filters at expected fatal alerts
my $inject_recs_num = 0; # used by add_empty_recs_filter
my $proxy_start_success = 0;
#Test 1: Injecting out of context empty records should succeed
my $content_type = TLSProxy::Record::RT_APPLICATION_DATA;
$inject_recs_num = 1;
$proxy->serverflags("-min_protocol DTLSv1.2 -max_protocol DTLSv1.2");
$proxy->clientflags("-max_protocol DTLSv1.2");
$proxy->filter(\&add_empty_recs_filter);
$proxy_start_success = $proxy->start();
ok($proxy_start_success && TLSProxy::Message->success(), "Out of context empty records test");
#Test 2: Injecting in context empty records should succeed
$proxy->clear();
$content_type = TLSProxy::Record::RT_HANDSHAKE;
$inject_recs_num = 1;
$proxy->serverflags("-min_protocol DTLSv1.2 -max_protocol DTLSv1.2");
$proxy->clientflags("-max_protocol DTLSv1.2");
$proxy->filter(\&add_empty_recs_filter);
$proxy_start_success = $proxy->start();
ok($proxy_start_success && TLSProxy::Message->success(), "In context empty records test");
#Unrecognised record type tests
#Test 3: Sending an unrecognised record type in DTLSv1.2 should fail
$fatal_alert = 0;
$proxy->clear();
$proxy->serverflags("-min_protocol DTLSv1.2 -max_protocol DTLSv1.2");
$proxy->clientflags("-max_protocol DTLSv1.2");
$proxy->filter(\&add_unknown_record_type);
ok($proxy->start() == 0, "Unrecognised record type in DTLS1.2");
SKIP: {
skip "DTLSv1 disabled", 1 if disabled("dtls1");
#Test 4: Sending an unrecognised record type in DTLSv1 should fail
$fatal_alert = 0;
$proxy->clear();
$proxy->clientflags("-min_protocol DTLSv1 -max_protocol DTLSv1 -cipher DEFAULT:\@SECLEVEL=0");
$proxy->ciphers("AES128-SHA:\@SECLEVEL=0");
$proxy->filter(\&add_unknown_record_type);
ok($proxy->start() == 0, "Unrecognised record type in DTLSv1");
}
sub add_empty_recs_filter
{
my $proxy = shift;
my $records = $proxy->record_list;
# We're only interested in the initial ClientHello
if ($proxy->flight != 0) {
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(1) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
return;
}
for (my $i = 0; $i < $inject_recs_num; $i++) {
my $record = TLSProxy::Record->new_dtls(
0,
$content_type,
TLSProxy::Record::VERS_TLS_1_2,
0,
0,
0,
0,
0,
0,
"",
""
);
push @{$records}, $record;
}
}
sub add_unknown_record_type
{
my $proxy = shift;
my $records = $proxy->record_list;
state $added_record;
# We'll change a record after the initial version neg has taken place
if ($proxy->flight == 0) {
$added_record = 0;
return;
} elsif ($proxy->flight != 1 || $added_record) {
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
return;
}
my $record = TLSProxy::Record->new_dtls(
1,
TLSProxy::Record::RT_UNKNOWN,
@{$records}[-1]->version(),
@{$records}[-1]->epoch(),
@{$records}[-1]->seq() +1,
1,
0,
1,
1,
"X",
"X"
);
#Find ServerHello record and insert after that
my $i;
for ($i = 0; ${$proxy->record_list}[$i]->flight() < 1; $i++) {
next;
}
$i++;
splice @{$proxy->record_list}, $i, 0, $record;
$added_record = 1;
}

2
test/recipes/70-test_sslcbcpadding.t
View File

@ -127,6 +127,6 @@ sub add_maximal_padding_filter
} elsif ($sent_corrupted_payload) {
# Check for bad_record_mac from client
my $last_record = @{$proxy->record_list}[-1];
$fatal_alert = 1 if $last_record->is_fatal_alert(0) == 20;
$fatal_alert = 1 if $last_record->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_BAD_RECORD_MAC;
}
}

13
test/recipes/70-test_sslrecords.t
View File

@ -12,6 +12,7 @@ use feature 'state';
use OpenSSL::Test qw/:DEFAULT cmdstr srctop_file bldtop_dir/;
use OpenSSL::Test::Utils;
use TLSProxy::Proxy;
use TLSProxy::Message;
my $test_name = "test_sslrecords";
setup($test_name);
@ -273,7 +274,7 @@ sub add_empty_recs_filter
# We're only interested in the initial ClientHello
if ($proxy->flight != 0) {
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(1) == 10;
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(1) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
return;
}
@ -301,7 +302,7 @@ sub add_frag_alert_filter
# We're only interested in the initial ClientHello
if ($proxy->flight != 0) {
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(1) == 10;
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(1) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
return;
}
@ -507,7 +508,7 @@ sub add_unknown_record_type
$added_record = 0;
return;
} elsif ($proxy->flight != 1 || $added_record) {
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == 10;
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
return;
}
@ -541,7 +542,7 @@ sub change_version
# We'll change a version after the initial version neg has taken place
if ($proxy->flight != 1) {
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == 70;
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_PROTOCOL_VERSION;
return;
}
@ -578,7 +579,7 @@ sub change_outer_record_type
# We'll change a record after the initial version neg has taken place
if ($proxy->flight != 1) {
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == 10;
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
return;
}
@ -601,7 +602,7 @@ sub not_on_record_boundary
#Find server's first flight
if ($proxy->flight != 1) {
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == 10;
$fatal_alert = 1 if @{$records}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
return;
}

3
test/recipes/70-test_tls13hrr.t
View File

@ -10,6 +10,7 @@ use strict;
use OpenSSL::Test qw/:DEFAULT cmdstr srctop_file bldtop_dir/;
use OpenSSL::Test::Utils;
use TLSProxy::Proxy;
use TLSProxy::Message;
my $test_name = "test_tls13hrr";
setup($test_name);
@ -122,7 +123,7 @@ sub hrr_filter
# and the unexpected_message alert from client
if ($proxy->flight == 4) {
$fatal_alert = 1
if @{$proxy->record_list}[-1]->is_fatal_alert(0) == 10;
if @{$proxy->record_list}[-1]->is_fatal_alert(0) == TLSProxy::Message::AL_DESC_UNEXPECTED_MESSAGE;
return;
}
if ($proxy->flight != 3) {

10
util/perl/TLSProxy/Certificate.pm
View File

@ -15,15 +15,23 @@ push @ISA, 'TLSProxy::Message';
sub new
{
my $class = shift;
my ($server,
my ($isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = $class->SUPER::new(
$isdtls,
$server,
TLSProxy::Message::MT_CERTIFICATE,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,

10
util/perl/TLSProxy/CertificateRequest.pm
View File

@ -15,15 +15,23 @@ push @ISA, 'TLSProxy::Message';
sub new
{
my $class = shift;
my ($server,
my ($isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = $class->SUPER::new(
$isdtls,
$server,
TLSProxy::Message::MT_CERTIFICATE_REQUEST,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,

10
util/perl/TLSProxy/CertificateVerify.pm
View File

@ -15,15 +15,23 @@ push @ISA, 'TLSProxy::Message';
sub new
{
my $class = shift;
my ($server,
my ($isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = $class->SUPER::new(
$isdtls,
$server,
TLSProxy::Message::MT_CERTIFICATE_VERIFY,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,

54
util/perl/TLSProxy/ClientHello.pm
View File

@ -9,30 +9,43 @@ use strict;
package TLSProxy::ClientHello;
use TLSProxy::Record;
use vars '@ISA';
push @ISA, 'TLSProxy::Message';
sub new
{
my $class = shift;
my ($server,
my ($isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = $class->SUPER::new(
$isdtls,
$server,
1,
TLSProxy::Message::MT_CLIENT_HELLO,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens);
$self->{isdtls} = $isdtls;
$self->{client_version} = 0;
$self->{random} = [];
$self->{session_id_len} = 0;
$self->{session} = "";
$self->{legacy_cookie_len} = 0; #DTLS only
$self->{legacy_cookie} = ""; #DTLS only
$self->{ciphersuite_len} = 0;
$self->{ciphersuites} = [];
$self->{comp_meth_len} = 0;
@ -54,6 +67,14 @@ sub parse
$ptr++;
my $session = substr($self->data, $ptr, $session_id_len);
$ptr += $session_id_len;
my $legacy_cookie_len = 0;
my $legacy_cookie = "";
if($self->{isdtls}) {
$legacy_cookie_len = unpack('C', substr($self->data, $ptr));
$ptr++;
$legacy_cookie = substr($self->data, $ptr, $legacy_cookie_len);
$ptr += $legacy_cookie_len;
}
my $ciphersuite_len = unpack('n', substr($self->data, $ptr));
$ptr += 2;
my @ciphersuites = unpack('n*', substr($self->data, $ptr,
@ -84,6 +105,8 @@ sub parse
$self->random($random);
$self->session_id_len($session_id_len);
$self->session($session);
$self->legacy_cookie_len($legacy_cookie_len);
$self->legacy_cookie($legacy_cookie);
$self->ciphersuite_len($ciphersuite_len);
$self->ciphersuites(\@ciphersuites);
$self->comp_meth_len($comp_meth_len);
@ -93,8 +116,11 @@ sub parse
$self->process_extensions();
print " Client Version:".$client_version."\n";
print " Client Version:".$TLSProxy::Record::tls_version{$client_version}."\n";
print " Session ID Len:".$session_id_len."\n";
if($self->{isdtls}) {
print " Legacy Cookie Len:".$legacy_cookie_len."\n";
}
print " Ciphersuite len:".$ciphersuite_len."\n";
print " Compression Method Len:".$comp_meth_len."\n";
print " Extensions Len:".$extensions_len."\n";
@ -138,6 +164,12 @@ sub set_message_contents
$data .= $self->random;
$data .= pack('C', $self->session_id_len);
$data .= $self->session;
if($self->{isdtls}){
$data .= pack('C', $self->legacy_cookie_len);
if($self->legacy_cookie_len > 0) {
$data .= $self->legacy_cookie;
}
}
$data .= pack('n', $self->ciphersuite_len);
$data .= pack("n*", @{$self->ciphersuites});
$data .= pack('C', $self->comp_meth_len);
@ -197,6 +229,22 @@ sub session
}
return $self->{session};
}
sub legacy_cookie_len
{
my $self = shift;
if (@_) {
$self->{legacy_cookie_len} = shift;
}
return $self->{legacy_cookie_len};
}
sub legacy_cookie
{
my $self = shift;
if (@_) {
$self->{legacy_cookie} = shift;
}
return $self->{legacy_cookie};
}
sub ciphersuite_len
{
my $self = shift;

10
util/perl/TLSProxy/EncryptedExtensions.pm
View File

@ -15,15 +15,23 @@ push @ISA, 'TLSProxy::Message';
sub new
{
my $class = shift;
my ($server,
my ($isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = $class->SUPER::new(
$isdtls,
$server,
TLSProxy::Message::MT_ENCRYPTED_EXTENSIONS,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,

115
util/perl/TLSProxy/HelloVerifyRequest.pm Normal file
View File

@ -0,0 +1,115 @@
# Copyright 2016-2018 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the Apache License 2.0 (the "License"). You may not use
# this file except in compliance with the License. You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html
use strict;
package TLSProxy::HelloVerifyRequest;
use TLSProxy::Record;
use vars '@ISA';
push @ISA, 'TLSProxy::Message';
sub new
{
my $class = shift;
my ($isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = $class->SUPER::new(
$isdtls,
$server,
TLSProxy::Message::MT_HELLO_VERIFY_REQUEST,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens);
$self->{server_version} = 0;
$self->{cookie_len} = 0;
$self->{cookie} = "";
return $self;
}
sub parse
{
my $self = shift;
my ($server_version) = unpack('n', $self->data);
my $ptr = 2;
my $cookie_len = unpack('C', substr($self->data, $ptr));
$ptr++;
my $cookie = substr($self->data, $ptr, $cookie_len);
$self->server_version($server_version);
$self->cookie_len($cookie_len);
$self->cookie($cookie);
$self->process_data();
print " Server Version:".$TLSProxy::Record::tls_version{$server_version}."\n";
print " Cookie Len:".$cookie_len."\n";
}
#Perform any actions necessary based on the data we've seen
sub process_data
{
my $self = shift;
#Intentional no-op
}
#Reconstruct the on-the-wire message data following changes
sub set_message_contents
{
my $self = shift;
my $data;
$data = pack('n', $self->server_version);
$data .= pack('C', $self->cookie_len);
$data .= $self->cookie;
$self->data($data);
}
#Read/write accessors
sub server_version
{
my $self = shift;
if (@_) {
$self->{server_version} = shift;
}
return $self->{server_version};
}
sub cookie_len
{
my $self = shift;
if (@_) {
$self->{cookie_len} = shift;
}
return $self->{cookie_len};
}
sub cookie
{
my $self = shift;
if (@_) {
$self->{cookie} = shift;
}
return $self->{cookie};
}
1;

187
util/perl/TLSProxy/Message.pm
View File

@ -11,6 +11,7 @@ package TLSProxy::Message;
use TLSProxy::Alert;
use constant DTLS_MESSAGE_HEADER_LENGTH => 12;
use constant TLS_MESSAGE_HEADER_LENGTH => 4;
#Message types
@ -18,6 +19,7 @@ use constant {
MT_HELLO_REQUEST => 0,
MT_CLIENT_HELLO => 1,
MT_SERVER_HELLO => 2,
MT_HELLO_VERIFY_REQUEST => 3,
MT_NEW_SESSION_TICKET => 4,
MT_ENCRYPTED_EXTENSIONS => 8,
MT_CERTIFICATE => 11,
@ -42,7 +44,9 @@ use constant {
use constant {
AL_DESC_CLOSE_NOTIFY => 0,
AL_DESC_UNEXPECTED_MESSAGE => 10,
AL_DESC_BAD_RECORD_MAC => 20,
AL_DESC_ILLEGAL_PARAMETER => 47,
AL_DESC_PROTOCOL_VERSION => 70,
AL_DESC_NO_RENEGOTIATION => 100
};
@ -50,6 +54,7 @@ my %message_type = (
MT_HELLO_REQUEST, "HelloRequest",
MT_CLIENT_HELLO, "ClientHello",
MT_SERVER_HELLO, "ServerHello",
MT_HELLO_VERIFY_REQUEST, "HelloVerifyRequest",
MT_NEW_SESSION_TICKET, "NewSessionTicket",
MT_ENCRYPTED_EXTENSIONS, "EncryptedExtensions",
MT_CERTIFICATE, "Certificate",
@ -172,6 +177,7 @@ sub get_messages
my $class = shift;
my $serverin = shift;
my $record = shift;
my $isdtls = shift;
my @messages = ();
my $message;
@ -216,8 +222,14 @@ sub get_messages
$recoffset = $messlen - length($payload);
$payload .= substr($record->decrypt_data, 0, $recoffset);
push @message_frag_lens, $recoffset;
$message = create_message($server, $mt, $payload,
$startoffset);
if ($isdtls) {
# We must set $msgseq, $msgfrag, $msgfragoffs
die "Internal error: cannot handle partial dtls messages\n"
}
$message = create_message($server, $mt,
#$msgseq, $msgfrag, $msgfragoffs,
0, 0, 0,
$payload, $startoffset, $isdtls);
push @messages, $message;
$payload = "";
@ -232,21 +244,36 @@ sub get_messages
while ($record->decrypt_len > $recoffset) {
#We are at the start of a new message
if ($record->decrypt_len - $recoffset < 4) {
my $msgheaderlen = $isdtls ? DTLS_MESSAGE_HEADER_LENGTH
: TLS_MESSAGE_HEADER_LENGTH;
if ($record->decrypt_len - $recoffset < $msgheaderlen) {
#Whilst technically probably valid we can't cope with this
die "End of record in the middle of a message header\n";
}
@message_rec_list = ($record);
my $lenhi;
my $lenlo;
($mt, $lenhi, $lenlo) = unpack('CnC',
substr($record->decrypt_data,
$recoffset));
my $msgseq;
my $msgfrag;
my $msgfragoffs;
if ($isdtls) {
my $msgfraghi;
my $msgfraglo;
my $msgfragoffshi;
my $msgfragoffslo;
($mt, $lenhi, $lenlo, $msgseq, $msgfraghi, $msgfraglo, $msgfragoffshi, $msgfragoffslo) =
unpack('CnCnnCnC', substr($record->decrypt_data, $recoffset));
$msgfrag = ($msgfraghi << 8) | $msgfraglo;
$msgfragoffs = ($msgfragoffshi << 8) | $msgfragoffslo;
} else {
($mt, $lenhi, $lenlo) =
unpack('CnC', substr($record->decrypt_data, $recoffset));
}
$messlen = ($lenhi << 8) | $lenlo;
print " Message type: $message_type{$mt}\n";
print " Message type: $message_type{$mt}($mt)\n";
print " Message Length: $messlen\n";
$startoffset = $recoffset;
$recoffset += 4;
$recoffset += $msgheaderlen;
$payload = "";
if ($recoffset <= $record->decrypt_len) {
@ -257,8 +284,9 @@ sub get_messages
$messlen);
$recoffset += $messlen;
push @message_frag_lens, $messlen;
$message = create_message($server, $mt, $payload,
$startoffset);
$message = create_message($server, $mt, $msgseq,
$msgfrag, $msgfragoffs,
$payload, $startoffset, $isdtls);
push @messages, $message;
$payload = "";
@ -307,14 +335,18 @@ sub get_messages
#construct it
sub create_message
{
my ($server, $mt, $data, $startoffset) = @_;
my ($server, $mt, $msgseq, $msgfrag, $msgfragoffs, $data, $startoffset, $isdtls) = @_;
my $message;
#We only support ClientHello in this version...needs to be extended for
#others
if ($mt == MT_CLIENT_HELLO) {
$message = TLSProxy::ClientHello->new(
$isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
@ -323,7 +355,24 @@ sub create_message
$message->parse();
} elsif ($mt == MT_SERVER_HELLO) {
$message = TLSProxy::ServerHello->new(
$isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
[@message_frag_lens]
);
$message->parse();
} elsif ($mt == MT_HELLO_VERIFY_REQUEST) {
$message = TLSProxy::HelloVerifyRequest->new(
$isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
@ -332,7 +381,11 @@ sub create_message
$message->parse();
} elsif ($mt == MT_ENCRYPTED_EXTENSIONS) {
$message = TLSProxy::EncryptedExtensions->new(
$isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
@ -341,7 +394,11 @@ sub create_message
$message->parse();
} elsif ($mt == MT_CERTIFICATE) {
$message = TLSProxy::Certificate->new(
$isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
@ -350,7 +407,11 @@ sub create_message
$message->parse();
} elsif ($mt == MT_CERTIFICATE_REQUEST) {
$message = TLSProxy::CertificateRequest->new(
$isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
@ -359,7 +420,11 @@ sub create_message
$message->parse();
} elsif ($mt == MT_CERTIFICATE_VERIFY) {
$message = TLSProxy::CertificateVerify->new(
$isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
@ -368,7 +433,11 @@ sub create_message
$message->parse();
} elsif ($mt == MT_SERVER_KEY_EXCHANGE) {
$message = TLSProxy::ServerKeyExchange->new(
$isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
@ -376,19 +445,36 @@ sub create_message
);
$message->parse();
} elsif ($mt == MT_NEW_SESSION_TICKET) {
$message = TLSProxy::NewSessionTicket->new(
$server,
$data,
[@message_rec_list],
$startoffset,
[@message_frag_lens]
);
if ($isdtls) {
$message = TLSProxy::NewSessionTicket->new_dtls(
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
[@message_frag_lens]
);
} else {
$message = TLSProxy::NewSessionTicket->new(
$server,
$data,
[@message_rec_list],
$startoffset,
[@message_frag_lens]
);
}
$message->parse();
} else {
#Unknown message type
$message = TLSProxy::Message->new(
$isdtls,
$server,
$mt,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
@ -423,18 +509,26 @@ sub alert
sub new
{
my $class = shift;
my ($server,
my ($isdtls,
$server,
$mt,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = {
isdtls => $isdtls,
server => $server,
data => $data,
records => $records,
mt => $mt,
msgseq => $msgseq,
msgfrag => $msgfrag,
msgfragoffs => $msgfragoffs,
startoffset => $startoffset,
message_frag_lens => $message_frag_lens,
dupext => -1
@ -463,12 +557,21 @@ sub repack
$self->set_message_contents();
my $lenhi;
my $lenlo;
my $lenlo = length($self->data) & 0xff;
my $lenhi = length($self->data) >> 8;
$lenlo = length($self->data) & 0xff;
$lenhi = length($self->data) >> 8;
$msgdata = pack('CnC', $self->mt, $lenhi, $lenlo).$self->data;
if ($self->{isdtls}) {
my $msgfraghi = $self->msgfrag >> 8;
my $msgfraglo = $self->msgfrag & 0xff;
my $msgfragoffshi = $self->msgfragoffs >> 8;
my $msgfragoffslo = $self->msgfragoffs & 0xff;
$msgdata = pack('CnCnnCnC', $self->mt, $lenhi, $lenlo, $self->msgseq,
$msgfraghi, $msgfraglo,
$msgfragoffshi, $msgfragoffslo).$self->data;
} else {
$msgdata = pack('CnC', $self->mt, $lenhi, $lenlo).$self->data;
}
if ($numrecs == 0) {
#The message is fully contained within one record
@ -476,13 +579,14 @@ sub repack
my $recdata = $rec->decrypt_data;
my $old_length;
my $msg_header_len = $self->{isdtls} ? DTLS_MESSAGE_HEADER_LENGTH
: TLS_MESSAGE_HEADER_LENGTH;
# We use empty message_frag_lens to indicates that pre-repacking,
# the message wasn't present. The first fragment length doesn't include
# the TLS header, so we need to check and compute the right length.
if (@{$self->message_frag_lens}) {
$old_length = ${$self->message_frag_lens}[0] +
TLS_MESSAGE_HEADER_LENGTH;
$old_length = ${$self->message_frag_lens}[0] + $msg_header_len;
} else {
$old_length = 0;
}
@ -529,8 +633,7 @@ sub repack
$rec->len(length($rec->data));
#Update the fragment len in case we changed it above
${$self->message_frag_lens}[0] = length($msgdata)
- TLS_MESSAGE_HEADER_LENGTH;
${$self->message_frag_lens}[0] = length($msgdata) - $msg_header_len;
return;
}
@ -578,6 +681,30 @@ sub mt
}
return $self->{mt};
}
sub msgseq
{
my $self = shift;
if (@_) {
$self->{msgseq} = shift;
}
return $self->{msgseq};
}
sub msgfrag
{
my $self = shift;
if (@_) {
$self->{msgfrag} = shift;
}
return $self->{msgfrag};
}
sub msgfragoffs
{
my $self = shift;
if (@_) {
$self->{msgfragoffs} = shift;
}
return $self->{msgfragoffs};
}
sub data
{
my $self = shift;
@ -613,7 +740,9 @@ sub message_frag_lens
sub encoded_length
{
my $self = shift;
return TLS_MESSAGE_HEADER_LENGTH + length($self->data);
my $msg_header_len = $self->{isdtls} ? DTLS_MESSAGE_HEADER_LENGTH
: TLS_MESSAGE_HEADER_LENGTH;
return $msg_header_len + length($self->data);
}
sub dupext
{

56
util/perl/TLSProxy/NewSessionTicket.pm
View File

@ -12,18 +12,74 @@ package TLSProxy::NewSessionTicket;
use vars '@ISA';
push @ISA, 'TLSProxy::Message';
sub new_dtls
{
my $class = shift;
my ($server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
return $class->init(
1,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens
)
}
sub new
{
my $class = shift;
my ($server,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
return $class->init(
0,
$server,
0, # msgseq
0, # msgfrag
0, # $msgfragoffs
$data,
$records,
$startoffset,
$message_frag_lens
)
}
sub init{
my $class = shift;
my ($isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = $class->SUPER::new(
$isdtls,
$server,
TLSProxy::Message::MT_NEW_SESSION_TICKET,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,

132
util/perl/TLSProxy/Proxy.pm
View File

@ -17,6 +17,7 @@ use TLSProxy::Record;
use TLSProxy::Message;
use TLSProxy::ClientHello;
use TLSProxy::ServerHello;
use TLSProxy::HelloVerifyRequest;
use TLSProxy::EncryptedExtensions;
use TLSProxy::Certificate;
use TLSProxy::CertificateRequest;
@ -71,17 +72,37 @@ BEGIN
my $is_tls13 = 0;
my $ciphersuite = undef;
sub new
{
sub new {
my $class = shift;
my ($filter,
$execute,
$cert,
$debug) = @_;
return init($class, $filter, $execute, $cert, $debug, 0);
}
sub new_dtls {
my $class = shift;
my ($filter,
$execute,
$cert,
$debug) = @_;
return init($class, $filter, $execute, $cert, $debug, 1);
}
sub init
{
my $class = shift;
my ($filter,
$execute,
$cert,
$debug,
$isdtls) = @_;
my $self = {
#Public read/write
proxy_addr => $have_IPv6 ? "[::1]" : "127.0.0.1",
client_addr => $have_IPv6 ? "[::1]" : "127.0.0.1",
filter => $filter,
serverflags => "",
clientflags => "",
@ -90,7 +111,9 @@ sub new
sessionfile => undef,
#Public read
isdtls => $isdtls,
proxy_port => 0,
client_port => 49152 + int(rand(65535 - 49152)),
server_port => 0,
serverpid => 0,
clientpid => 0,
@ -108,29 +131,6 @@ sub new
message_list => [],
};
# Create the Proxy socket
my $proxaddr = $self->{proxy_addr};
$proxaddr =~ s/[\[\]]//g; # Remove [ and ]
my @proxyargs = (
LocalHost => $proxaddr,
LocalPort => 0,
Proto => "tcp",
Listen => SOMAXCONN,
);
if (my $sock = $IP_factory->(@proxyargs)) {
$self->{proxy_sock} = $sock;
$self->{proxy_port} = $sock->sockport();
$self->{proxy_addr} = $sock->sockhost();
$self->{proxy_addr} =~ s/(.*:.*)/[$1]/;
print "Proxy started on port ",
"$self->{proxy_addr}:$self->{proxy_port}\n";
# use same address for s_server
$self->{server_addr} = $self->{proxy_addr};
} else {
warn "Failed creating proxy socket (".$proxaddr.",0): $!\n";
}
return bless $self, $class;
}
@ -200,7 +200,7 @@ sub connect_to_server
my $sock = $IP_factory->(PeerAddr => $servaddr,
PeerPort => $self->{server_port},
Proto => 'tcp');
Proto => $self->{isdtls} ? 'udp' : 'tcp');
if (!defined($sock)) {
my $err = $!;
kill(3, $self->{real_serverpid});
@ -215,12 +215,51 @@ sub start
my ($self) = shift;
my $pid;
# Create the Proxy socket
my $proxaddr = $self->{proxy_addr};
$proxaddr =~ s/[\[\]]//g; # Remove [ and ]
my $clientaddr = $self->{client_addr};
$clientaddr =~ s/[\[\]]//g; # Remove [ and ]
my @proxyargs;
if ($self->{isdtls}) {
@proxyargs = (
LocalHost => $proxaddr,
LocalPort => 0,
PeerHost => $clientaddr,
PeerPort => $self->{client_port},
Proto => "udp",
);
} else {
@proxyargs = (
LocalHost => $proxaddr,
LocalPort => 0,
Proto => "tcp",
Listen => SOMAXCONN,
);
}
if (my $sock = $IP_factory->(@proxyargs)) {
$self->{proxy_sock} = $sock;
$self->{proxy_port} = $sock->sockport();
$self->{proxy_addr} = $sock->sockhost();
$self->{proxy_addr} =~ s/(.*:.*)/[$1]/;
print "Proxy started on port ",
"$self->{proxy_addr}:$self->{proxy_port}\n";
# use same address for s_server
$self->{server_addr} = $self->{proxy_addr};
} else {
warn "Failed creating proxy socket (".$proxaddr.",0): $!\n";
}
if ($self->{proxy_sock} == 0) {
return 0;
}
my $execcmd = $self->execute
." s_server -max_protocol TLSv1.3 -no_comp -rev -engine ossltest"
." s_server -no_comp -engine ossltest -state"
#In TLSv1.3 we issue two session tickets. The default session id
#callback gets confused because the ossltest engine causes the same
#session id to be created twice due to the changed random number
@ -230,6 +269,14 @@ sub start
." -accept $self->{server_addr}:0"
." -cert ".$self->cert." -cert2 ".$self->cert
." -naccept ".$self->serverconnects;
if ($self->{isdtls}) {
$execcmd .= " -dtls -max_protocol DTLSv1.2"
# TLSProxy does not support message fragmentation. So
# set a high mtu and fingers crossed.
." -mtu 1500";
} else {
$execcmd .= " -rev -max_protocol TLSv1.3";
}
if ($self->ciphers ne "") {
$execcmd .= " -cipher ".$self->ciphers;
}
@ -311,11 +358,24 @@ sub clientstart
{
my ($self) = shift;
my $succes = 1;
if ($self->execute) {
my $pid;
my $execcmd = $self->execute
." s_client -max_protocol TLSv1.3 -engine ossltest"
." s_client -engine ossltest"
." -connect $self->{proxy_addr}:$self->{proxy_port}";
if ($self->{isdtls}) {
$execcmd .= " -dtls -max_protocol DTLSv1.2"
# TLSProxy does not support message fragmentation. So
# set a high mtu and fingers crossed.
." -mtu 1500"
# UDP has no "accept" for sockets which means we need to
# know were to send data back to.
." -bind $self->{client_addr}:$self->{client_port}";
} else {
$execcmd .= " -max_protocol TLSv1.3";
}
if ($self->cipherc ne "") {
$execcmd .= " -cipher ".$self->cipherc;
}
@ -362,7 +422,9 @@ sub clientstart
}
my $client_sock;
if(!($client_sock = $self->{proxy_sock}->accept())) {
if($self->{isdtls}) {
$client_sock = $self->{proxy_sock}
} elsif (!($client_sock = $self->{proxy_sock}->accept())) {
warn "Failed accepting incoming connection: $!\n";
return 0;
}
@ -386,6 +448,9 @@ sub clientstart
&& $self->{saw_session_ticket};
}
if (!(@ready = $fdset->can_read(1))) {
last if TLSProxy::Message->success()
&& $self->{saw_session_ticket};
$ctr++;
next;
}
@ -419,7 +484,8 @@ sub clientstart
if ($ctr >= 10) {
kill(3, $self->{real_serverpid});
die "No progress made";
print "No progress made\n";
$succes = 0;
}
END:
@ -460,7 +526,7 @@ sub clientstart
print "Waiting for s_client process to close: $pid...\n";
waitpid($pid, 0);
return 1;
return $succes;
}
sub process_packet
@ -488,7 +554,9 @@ sub process_packet
#Return contains the list of record found in the packet followed by the
#list of messages in those records and any partial message
my @ret = TLSProxy::Record->get_records($server, $self->flight,
$self->{partial}[$server].$packet);
$self->{partial}[$server].$packet,
$self->{isdtls});
$self->{partial}[$server] = $ret[2];
push @{$self->{record_list}}, @{$ret[0]};
push @{$self->{message_list}}, @{$ret[1]};

184
util/perl/TLSProxy/Record.pm
View File

@ -15,6 +15,7 @@ my $server_encrypting = 0;
my $client_encrypting = 0;
my $etm = 0;
use constant DTLS_RECORD_HEADER_LENGTH => 13;
use constant TLS_RECORD_HEADER_LENGTH => 5;
#Record types
@ -35,6 +36,8 @@ my %record_type = (
);
use constant {
VERS_DTLS_1_2 => 0xfefd,
VERS_DTLS_1 => 0xfeff,
VERS_TLS_1_4 => 0x0305,
VERS_TLS_1_3 => 0x0304,
VERS_TLS_1_2 => 0x0303,
@ -44,7 +47,9 @@ use constant {
VERS_SSL_LT_3_0 => 0x02ff
};
my %tls_version = (
our %tls_version = (
VERS_DTLS_1_2, "DTLS1.2",
VERS_DTLS_1, "DTLS1",
VERS_TLS_1_3, "TLS1.3",
VERS_TLS_1_2, "TLS1.2",
VERS_TLS_1_1, "TLS1.1",
@ -60,41 +65,81 @@ sub get_records
my $server = shift;
my $flight = shift;
my $packet = shift;
my $isdtls = shift;
my $partial = "";
my @record_list = ();
my @message_list = ();
my $record_hdr_len = $isdtls ? DTLS_RECORD_HEADER_LENGTH
: TLS_RECORD_HEADER_LENGTH;
my $recnum = 1;
while (length ($packet) > 0) {
print " Record $recnum ", $server ? "(server -> client)\n"
: "(client -> server)\n";
#Get the record header (unpack can't fail if $packet is too short)
my ($content_type, $version, $len) = unpack('Cnn', $packet);
my $content_type;
my $version;
my $len;
my $epoch;
my $seq;
if (length($packet) < TLS_RECORD_HEADER_LENGTH + ($len // 0)) {
if ($isdtls) {
my $seqhi;
my $seqmi;
my $seqlo;
#Get the record header (unpack can't fail if $packet is too short)
($content_type, $version, $epoch,
$seqhi, $seqmi, $seqlo, $len) = unpack('Cnnnnnn', $packet);
$seq = ($seqhi << 32) | ($seqmi << 16) | $seqlo
} else {
#Get the record header (unpack can't fail if $packet is too short)
($content_type, $version, $len) = unpack('Cnn', $packet);
}
if (length($packet) < $record_hdr_len + ($len // 0)) {
print "Partial data : ".length($packet)." bytes\n";
$partial = $packet;
last;
}
my $data = substr($packet, TLS_RECORD_HEADER_LENGTH, $len);
my $data = substr($packet, $record_hdr_len, $len);
print " Content type: ".$record_type{$content_type}."\n";
print " Version: $tls_version{$version}\n";
if($isdtls) {
print " Epoch: $epoch\n";
print " Sequence: $seq\n";
}
print " Length: $len\n";
my $record = TLSProxy::Record->new(
$flight,
$content_type,
$version,
$len,
0,
$len, # len_real
$len, # decrypt_len
$data, # data
$data # decrypt_data
);
my $record;
if ($isdtls) {
$record = TLSProxy::Record->new_dtls(
$flight,
$content_type,
$version,
$epoch,
$seq,
$len,
0,
$len, # len_real
$len, # decrypt_len
$data, # data
$data # decrypt_data
);
} else {
$record = TLSProxy::Record->new(
$flight,
$content_type,
$version,
$len,
0,
$len, # len_real
$len, # decrypt_len
$data, # data
$data # decrypt_data
);
}
if ($content_type != RT_CCS
&& (!TLSProxy::Proxy->is_tls13()
@ -118,10 +163,10 @@ sub get_records
push @record_list, $record;
#Now figure out what messages are contained within this record
my @messages = TLSProxy::Message->get_messages($server, $record);
my @messages = TLSProxy::Message->get_messages($server, $record, $isdtls);
push @message_list, @messages;
$packet = substr($packet, TLS_RECORD_HEADER_LENGTH + $len);
$packet = substr($packet, $record_hdr_len + $len);
$recnum++;
}
@ -161,6 +206,34 @@ sub etm
return $etm;
}
sub new_dtls
{
my $class = shift;
my ($flight,
$content_type,
$version,
$epoch,
$seq,
$len,
$sslv2,
$len_real,
$decrypt_len,
$data,
$decrypt_data) = @_;
return $class->init(1,
$flight,
$content_type,
$version,
$epoch,
$seq,
$len,
$sslv2,
$len_real,
$decrypt_len,
$data,
$decrypt_data);
}
sub new
{
my $class = shift;
@ -173,11 +246,44 @@ sub new
$decrypt_len,
$data,
$decrypt_data) = @_;
return $class->init(
0,
$flight,
$content_type,
$version,
0, #epoch
0, #seq
$len,
$sslv2,
$len_real,
$decrypt_len,
$data,
$decrypt_data);
}
sub init
{
my $class = shift;
my ($isdtls,
$flight,
$content_type,
$version,
$epoch,
$seq,
$len,
$sslv2,
$len_real,
$decrypt_len,
$data,
$decrypt_data) = @_;
my $self = {
isdtls => $isdtls,
flight => $flight,
content_type => $content_type,
version => $version,
epoch => $epoch,
seq => $seq,
len => $len,
sslv2 => $sslv2,
len_real => $len_real,
@ -285,12 +391,21 @@ sub reconstruct_record
if ($self->sslv2) {
$data = pack('n', $self->len | 0x8000);
} else {
if (TLSProxy::Proxy->is_tls13() && $self->encrypted) {
$data = pack('Cnn', $self->outer_content_type, $self->version,
$self->len);
if($self->{isdtls}) {
my $seqhi = ($self->seq >> 32) & 0xffff;
my $seqmi = ($self->seq >> 16) & 0xffff;
my $seqlo = ($self->seq >> 0) & 0xffff;
$data = pack('Cnnnnnn', $self->content_type, $self->version,
$self->epoch, $seqhi, $seqmi, $seqlo, $self->len);
} else {
$data = pack('Cnn', $self->content_type, $self->version,
$self->len);
if (TLSProxy::Proxy->is_tls13() && $self->encrypted) {
$data = pack('Cnn', $self->outer_content_type, $self->version,
$self->len);
}
else {
$data = pack('Cnn', $self->content_type, $self->version,
$self->len);
}
}
}
@ -370,6 +485,22 @@ sub content_type
}
return $self->{content_type};
}
sub epoch
{
my $self = shift;
if (@_) {
$self->{epoch} = shift;
}
return $self->{epoch};
}
sub seq
{
my $self = shift;
if (@_) {
$self->{seq} = shift;
}
return $self->{seq};
}
sub encrypted
{
my $self = shift;
@ -391,10 +522,9 @@ sub is_fatal_alert
my $self = shift;
my $server = shift;
if (($self->{flight} & 1) == $server
&& $self->{content_type} == TLSProxy::Record::RT_ALERT) {
my ($level, $alert) = unpack('CC', $self->decrypt_data);
return $alert if ($level == 2);
if (($self->{flight} & 1) == $server && $self->{content_type} == RT_ALERT) {
my ($level, $description) = unpack('CC', $self->decrypt_data);
return $description if ($level == 2);
}
return 0;
}

14
util/perl/TLSProxy/ServerHello.pm
View File

@ -9,6 +9,8 @@ use strict;
package TLSProxy::ServerHello;
use TLSProxy::Record;
use vars '@ISA';
push @ISA, 'TLSProxy::Message';
@ -20,15 +22,23 @@ my $hrrrandom = pack("C*", 0xCF, 0x21, 0xAD, 0x74, 0xE5, 0x9A, 0x61, 0x11, 0xBE,
sub new
{
my $class = shift;
my ($server,
my ($isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = $class->SUPER::new(
$isdtls,
$server,
TLSProxy::Message::MT_SERVER_HELLO,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
@ -120,7 +130,7 @@ sub parse
$self->process_data();
print " Server Version:".$server_version."\n";
print " Server Version:".$TLSProxy::Record::tls_version{$server_version}."\n";
print " Session ID Len:".$session_id_len."\n";
print " Ciphersuite:".$ciphersuite."\n";
print " Compression Method:".$comp_meth."\n";

10
util/perl/TLSProxy/ServerKeyExchange.pm
View File

@ -15,15 +15,23 @@ push @ISA, 'TLSProxy::Message';
sub new
{
my $class = shift;
my ($server,
my ($isdtls,
$server,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = $class->SUPER::new(
$isdtls,
$server,
TLSProxy::Message::MT_SERVER_KEY_EXCHANGE,
$msgseq,
$msgfrag,
$msgfragoffs,
$data,
$records,
$startoffset,