--- /dev/null
+#! /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;
+}
} 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;
}
}
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);
# 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;
}
# 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;
}
$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;
}
# 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;
}
# 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;
}
#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;
}
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);
# 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) {
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,
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,
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,
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;
$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,
$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);
$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";
$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);
}
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;
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,
--- /dev/null
+# 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;
use TLSProxy::Alert;
+use constant DTLS_MESSAGE_HEADER_LENGTH => 12;
use constant TLS_MESSAGE_HEADER_LENGTH => 4;
#Message types
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,
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
};
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",
my $class = shift;
my $serverin = shift;
my $record = shift;
+ my $isdtls = shift;
my @messages = ();
my $message;
$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 = "";
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) {
$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 = "";
#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,
$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,
$message->parse();
} elsif ($mt == MT_ENCRYPTED_EXTENSIONS) {
$message = TLSProxy::EncryptedExtensions->new(
+ $isdtls,
$server,
+ $msgseq,
+ $msgfrag,
+ $msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
$message->parse();
} elsif ($mt == MT_CERTIFICATE) {
$message = TLSProxy::Certificate->new(
+ $isdtls,
$server,
+ $msgseq,
+ $msgfrag,
+ $msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
$message->parse();
} elsif ($mt == MT_CERTIFICATE_REQUEST) {
$message = TLSProxy::CertificateRequest->new(
+ $isdtls,
$server,
+ $msgseq,
+ $msgfrag,
+ $msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
$message->parse();
} elsif ($mt == MT_CERTIFICATE_VERIFY) {
$message = TLSProxy::CertificateVerify->new(
+ $isdtls,
$server,
+ $msgseq,
+ $msgfrag,
+ $msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
$message->parse();
} elsif ($mt == MT_SERVER_KEY_EXCHANGE) {
$message = TLSProxy::ServerKeyExchange->new(
+ $isdtls,
$server,
+ $msgseq,
+ $msgfrag,
+ $msgfragoffs,
$data,
[@message_rec_list],
$startoffset,
);
$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,
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
$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
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;
}
$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;
}
}
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;
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
{
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,
use TLSProxy::Message;
use TLSProxy::ClientHello;
use TLSProxy::ServerHello;
+use TLSProxy::HelloVerifyRequest;
use TLSProxy::EncryptedExtensions;
use TLSProxy::Certificate;
use TLSProxy::CertificateRequest;
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 => "",
sessionfile => undef,
#Public read
+ isdtls => $isdtls,
proxy_port => 0,
+ client_port => 49152 + int(rand(65535 - 49152)),
server_port => 0,
serverpid => 0,
clientpid => 0,
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;
}
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});
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
." -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;
}
{
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;
}
}
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;
}
&& $self->{saw_session_ticket};
}
if (!(@ready = $fdset->can_read(1))) {
+ last if TLSProxy::Message->success()
+ && $self->{saw_session_ticket};
+
$ctr++;
next;
}
if ($ctr >= 10) {
kill(3, $self->{real_serverpid});
- die "No progress made";
+ print "No progress made\n";
+ $succes = 0;
}
END:
print "Waiting for s_client process to close: $pid...\n";
waitpid($pid, 0);
- return 1;
+ return $succes;
}
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]};
my $client_encrypting = 0;
my $etm = 0;
+use constant DTLS_RECORD_HEADER_LENGTH => 13;
use constant TLS_RECORD_HEADER_LENGTH => 5;
#Record types
);
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,
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",
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 ($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) < TLS_RECORD_HEADER_LENGTH + ($len // 0)) {
+ 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()
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++;
}
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;
$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,
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);
+ }
}
}
}
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;
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;
}
package TLSProxy::ServerHello;
+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,
TLSProxy::Message::MT_SERVER_HELLO,
+ $msgseq,
+ $msgfrag,
+ $msgfragoffs,
$data,
$records,
$startoffset,
$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";
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,
projects / openssl.git / commitdiff