wbrawner/openssl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add a libssl test harness

Browse source 
This commit provides a set of perl modules that support the testing of
libssl. The test harness operates as a man-in-the-middle proxy between
s_server and s_client. Both s_server and s_client must be started using the
"-testmode" option which loads the new OSSLTEST engine.

The test harness enables scripts to be written that can examine the packets
sent during a handshake, as well as (potentially) modifying them so that
otherwise illegal handshake messages can be sent.

Reviewed-by: Richard Levitte <levitte@openssl.org>
This commit is contained in:
Matt Caswell 2015-06-16 13:06:41 +01:00
parent 2d5d70b155
commit 631c120633
4 changed files with 1419 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

272
util/TLSProxy/ClientHello.pm Normal file
View file

@ -0,0 +1,272 @@
# Written by Matt Caswell for the OpenSSL project.
# ====================================================================
# Copyright (c) 1998-2015 The OpenSSL Project. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in
# the documentation and/or other materials provided with the
# distribution.
#
# 3. All advertising materials mentioning features or use of this
# software must display the following acknowledgment:
# "This product includes software developed by the OpenSSL Project
# for use in the OpenSSL Toolkit. (http://www.openssl.org/)"
#
# 4. The names "OpenSSL Toolkit" and "OpenSSL Project" must not be used to
# endorse or promote products derived from this software without
# prior written permission. For written permission, please contact
# openssl-core@openssl.org.
#
# 5. Products derived from this software may not be called "OpenSSL"
# nor may "OpenSSL" appear in their names without prior written
# permission of the OpenSSL Project.
#
# 6. Redistributions of any form whatsoever must retain the following
# acknowledgment:
# "This product includes software developed by the OpenSSL Project
# for use in the OpenSSL Toolkit (http://www.openssl.org/)"
#
# THIS SOFTWARE IS PROVIDED BY THE OpenSSL PROJECT ``AS IS'' AND ANY
# EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE OpenSSL PROJECT OR
# ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
# OF THE POSSIBILITY OF SUCH DAMAGE.
# ====================================================================
#
# This product includes cryptographic software written by Eric Young
# (eay@cryptsoft.com). This product includes software written by Tim
# Hudson (tjh@cryptsoft.com).
use strict;
package TLSProxy::ClientHello;
use parent 'TLSProxy::Message';
use constant {
EXT_ENCRYPT_THEN_MAC => 22
};
sub new
{
my $class = shift;
my ($server,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = $class->SUPER::new(
$server,
1,
$data,
$records,
$startoffset,
$message_frag_lens);
$self->{client_version} = 0;
$self->{random} = [];
$self->{session_id_len} = 0;
$self->{session} = "";
$self->{ciphersuite_len} = 0;
$self->{ciphersuites} = [];
$self->{comp_meth_len} = 0;
$self->{comp_meths} = [];
$self->{extensions_len} = 0;
$self->{extensions_data} = "";
return $self;
}
sub parse
{
my $self = shift;
my $ptr = 2;
my ($client_version) = unpack('n', $self->data);
my $random = substr($self->data, $ptr, 32);
$ptr += 32;
my $session_id_len = unpack('C', substr($self->data, $ptr));
$ptr++;
my $session = substr($self->data, $ptr, $session_id_len);
$ptr += $session_id_len;
my $ciphersuite_len = unpack('n', substr($self->data, $ptr));
$ptr += 2;
my @ciphersuites = unpack('n*', substr($self->data, $ptr,
$ciphersuite_len));
$ptr += $ciphersuite_len;
my $comp_meth_len = unpack('C', substr($self->data, $ptr));
$ptr++;
my @comp_meths = unpack('C*', substr($self->data, $ptr, $comp_meth_len));
$ptr += $comp_meth_len;
my $extensions_len = unpack('n', substr($self->data, $ptr));
$ptr += 2;
#For now we just deal with this as a block of data. In the future we will
#want to parse this
my $extension_data = substr($self->data, $ptr);
if (length($extension_data) != $extensions_len) {
die "Invalid extension length\n";
}
my %extensions = ();
while (length($extension_data) >= 4) {
my ($type, $size) = unpack("nn", $extension_data);
my $extdata = substr($extension_data, 4, $size);
$extension_data = substr($extension_data, 4 + $size);
$extensions{$type} = $extdata;
}
$self->client_version($client_version);
$self->random($random);
$self->session_id_len($session_id_len);
$self->session($session);
$self->ciphersuite_len($ciphersuite_len);
$self->ciphersuites(\@ciphersuites);
$self->comp_meth_len($comp_meth_len);
$self->comp_meths(\@comp_meths);
$self->extensions_len($extensions_len);
$self->extension_data(\%extensions);
$self->process_extensions();
print " Client Version:".$client_version."\n";
print " Session ID Len:".$session_id_len."\n";
print " Ciphersuite len:".$ciphersuite_len."\n";
print " Compression Method Len:".$comp_meth_len."\n";
print " Extensions Len:".$extensions_len."\n";
}
#Perform any actions necessary based on the extensions we've seen
sub process_extensions
{
my $self = shift;
my %extensions = %{$self->extension_data};
#Clear any state from a previous run
TLSProxy::Record->etm(0);
if (exists $extensions{&EXT_ENCRYPT_THEN_MAC}) {
TLSProxy::Record->etm(1);
}
}
#Reconstruct the on-the-wire message data following changes
sub set_message_contents
{
my $self = shift;
my $data;
$data = pack('n', $self->client_version);
$data .= $self->random;
$data .= pack('C', $self->session_id_len);
$data .= $self->session;
$data .= pack('n', $self->ciphersuite_len);
$data .= pack("n*", @{$self->ciphersuites});
$data .= pack('C', $self->comp_meth_len);
$data .= pack("C*", @{$self->comp_meths});
$data .= pack('n', $self->extensions_len);
foreach my $key (keys %{$self->extension_data}) {
my $extdata = ${$self->extension_data}{$key};
$data .= pack("n", $key);
$data .= pack("n", length($extdata));
$data .= $extdata;
}
$self->data($data);
}
#Read/write accessors
sub client_version
{
my $self = shift;
if (@_) {
$self->{client_version} = shift;
}
return $self->{client_version};
}
sub random
{
my $self = shift;
if (@_) {
$self->{random} = shift;
}
return $self->{random};
}
sub session_id_len
{
my $self = shift;
if (@_) {
$self->{session_id_len} = shift;
}
return $self->{session_id_len};
}
sub session
{
my $self = shift;
if (@_) {
$self->{session} = shift;
}
return $self->{session};
}
sub ciphersuite_len
{
my $self = shift;
if (@_) {
$self->{ciphersuite_len} = shift;
}
return $self->{ciphersuite_len};
}
sub ciphersuites
{
my $self = shift;
if (@_) {
$self->{ciphersuites} = shift;
}
return $self->{ciphersuites};
}
sub comp_meth_len
{
my $self = shift;
if (@_) {
$self->{comp_meth_len} = shift;
}
return $self->{comp_meth_len};
}
sub comp_meths
{
my $self = shift;
if (@_) {
$self->{comp_meths} = shift;
}
return $self->{comp_meths};
}
sub extensions_len
{
my $self = shift;
if (@_) {
$self->{extensions_len} = shift;
}
return $self->{extensions_len};
}
sub extension_data
{
my $self = shift;
if (@_) {
$self->{extension_data} = shift;
}
return $self->{extension_data};
}
1;

423
util/TLSProxy/Message.pm Normal file
View file

@ -0,0 +1,423 @@
# Written by Matt Caswell for the OpenSSL project.
# ====================================================================
# Copyright (c) 1998-2015 The OpenSSL Project. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in
# the documentation and/or other materials provided with the
# distribution.
#
# 3. All advertising materials mentioning features or use of this
# software must display the following acknowledgment:
# "This product includes software developed by the OpenSSL Project
# for use in the OpenSSL Toolkit. (http://www.openssl.org/)"
#
# 4. The names "OpenSSL Toolkit" and "OpenSSL Project" must not be used to
# endorse or promote products derived from this software without
# prior written permission. For written permission, please contact
# openssl-core@openssl.org.
#
# 5. Products derived from this software may not be called "OpenSSL"
# nor may "OpenSSL" appear in their names without prior written
# permission of the OpenSSL Project.
#
# 6. Redistributions of any form whatsoever must retain the following
# acknowledgment:
# "This product includes software developed by the OpenSSL Project
# for use in the OpenSSL Toolkit (http://www.openssl.org/)"
#
# THIS SOFTWARE IS PROVIDED BY THE OpenSSL PROJECT ``AS IS'' AND ANY
# EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE OpenSSL PROJECT OR
# ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
# OF THE POSSIBILITY OF SUCH DAMAGE.
# ====================================================================
#
# This product includes cryptographic software written by Eric Young
# (eay@cryptsoft.com). This product includes software written by Tim
# Hudson (tjh@cryptsoft.com).
use strict;
package TLSProxy::Message;
use constant TLS_MESSAGE_HEADER_LENGTH => 4;
#Message types
use constant {
MT_HELLO_REQUEST => 0,
MT_CLIENT_HELLO => 1,
MT_SERVER_HELLO => 2,
MT_NEW_SESSION_TICKET => 4,
MT_CERTIFICATE => 11,
MT_SERVER_KEY_EXCHANGE => 12,
MT_CERTIFICATE_REQUEST => 13,
MT_SERVER_HELLO_DONE => 14,
MT_CERTIFICATE_VERIFY => 15,
MT_CLIENT_KEY_EXCHANGE => 16,
MT_FINISHED => 20,
MT_CERTIFICATE_STATUS => 22,
MT_NEXT_PROTO => 67
};
my %message_type = (
MT_HELLO_REQUEST, "HelloRequest",
MT_CLIENT_HELLO, "ClientHello",
MT_SERVER_HELLO, "ServerHello",
MT_NEW_SESSION_TICKET, "NewSessionTicket",
MT_CERTIFICATE, "Certificate",
MT_SERVER_KEY_EXCHANGE, "ServerKeyExchange",
MT_CERTIFICATE_REQUEST, "CertificateRequest",
MT_SERVER_HELLO_DONE, "ServerHelloDone",
MT_CERTIFICATE_VERIFY, "CertificateVerify",
MT_CLIENT_KEY_EXCHANGE, "ClientKeyExchange",
MT_FINISHED, "Finished",
MT_CERTIFICATE_STATUS, "CertificateStatus",
MT_NEXT_PROTO, "NextProto"
);
my $payload = "";
my $messlen = -1;
my $mt;
my $startoffset = -1;
my $server = 0;
my $success = 0;
my $end = 0;
my @message_rec_list = ();
my @message_frag_lens = ();
sub clear
{
$payload = "";
$messlen = -1;
$startoffset = -1;
$server = 0;
$success = 0;
$end = 0;
@message_rec_list = ();
@message_frag_lens = ();
}
#Class method to extract messages from a record
sub get_messages
{
my $class = shift;
my $serverin = shift;
my $record = shift;
my @messages = ();
my $message;
if ($serverin != $server && length($payload) != 0) {
die "Changed peer, but we still have fragment data\n";
}
$server = $serverin;
if ($record->content_type == TLSProxy::Record::RT_CCS) {
if ($payload ne "") {
#We can't handle this yet
die "CCS received before message data complete\n";
}
if ($server) {
TLSProxy::Record->server_ccs_seen(1);
} else {
TLSProxy::Record->client_ccs_seen(1);
}
} elsif ($record->content_type == TLSProxy::Record::RT_HANDSHAKE) {
if ($record->len == 0 || $record->len_real == 0) {
print " Message truncated\n";
} else {
my $recoffset = 0;
if (length $payload > 0) {
#We are continuing processing a message started in a previous
#record. Add this record to the list associated with this
#message
push @message_rec_list, $record;
if ($messlen <= length($payload)) {
#Shouldn't happen
die "Internal error: invalid messlen: ".$messlen
." payload length:".length($payload)."\n";
}
if (length($payload) + $record->decrypt_len >= $messlen) {
#We can complete the message with this record
$recoffset = $messlen - length($payload);
$payload .= substr($record->decrypt_data, 0, $recoffset);
push @message_frag_lens, $recoffset;
$message = create_message($server, $mt, $payload,
$startoffset);
push @messages, $message;
#Check if we have finished the handshake
if ($mt == MT_FINISHED && $server) {
$success = 1;
$end = 1;
}
$payload = "";
} else {
#This is just part of the total message
$payload .= $record->decrypt_data;
$recoffset = $record->decrypt_len;
push @message_frag_lens, $record->decrypt_len;
}
print " Partial message data read: ".$recoffset." bytes\n";
}
while ($record->decrypt_len > $recoffset) {
#We are at the start of a new message
if ($record->decrypt_len - $recoffset < 4) {
#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));
$messlen = ($lenhi << 8) | $lenlo;
print " Message type: $message_type{$mt}\n";
print " Message Length: $messlen\n";
$startoffset = $recoffset;
$recoffset += 4;
$payload = "";
if ($recoffset < $record->decrypt_len) {
#Some payload data is present in this record
if ($record->decrypt_len - $recoffset >= $messlen) {
#We can complete the message with this record
$payload .= substr($record->decrypt_data, $recoffset,
$messlen);
$recoffset += $messlen;
push @message_frag_lens, $messlen;
$message = create_message($server, $mt, $payload,
$startoffset);
push @messages, $message;
#Check if we have finished the handshake
if ($mt == MT_FINISHED && $server) {
$success = 1;
$end = 1;
}
$payload = "";
} else {
#This is just part of the total message
$payload .= substr($record->decrypt_data, $recoffset,
$record->decrypt_len - $recoffset);
$recoffset = $record->decrypt_len;
push @message_frag_lens, $recoffset;
}
}
}
}
} elsif ($record->content_type == TLSProxy::Record::RT_APPLICATION_DATA) {
print " [ENCRYPTED APPLICATION DATA]\n";
print " [".$record->decrypt_data."]\n";
} elsif ($record->content_type == TLSProxy::Record::RT_ALERT) {
#For now assume all alerts are fatal
$end = 1;
}
return @messages;
}
#Function to work out which sub-class we need to create and then
#construct it
sub create_message
{
my ($server, $mt, $data, $startoffset) = @_;
my $message;
#We only support ClientHello in this version...needs to be extended for
#others
if ($mt == MT_CLIENT_HELLO) {
$message = TLSProxy::ClientHello->new(
$server,
$data,
[@message_rec_list],
$startoffset,
[@message_frag_lens]
);
$message->parse();
} else {
#Unknown message type
$message = TLSProxy::Message->new(
$server,
$mt,
$data,
[@message_rec_list],
$startoffset,
[@message_frag_lens]
);
}
return $message;
}
sub end
{
my $class = shift;
return $end;
}
sub success
{
my $class = shift;
return $success;
}
sub new
{
my $class = shift;
my ($server,
$mt,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = {
server => $server,
data => $data,
records => $records,
mt => $mt,
startoffset => $startoffset,
message_frag_lens => $message_frag_lens
};
return bless $self, $class;
}
#Update all the underlying records with the modified data from this message
#Note: Does not currently support re-encrypting
sub repack
{
my $self = shift;
my $msgdata;
my $numrecs = $#{$self->records};
$self->set_message_contents();
my $lenhi;
my $lenlo;
$lenlo = length($self->data) & 0xff;
$lenhi = length($self->data) >> 8;
my $msgdata = pack('CnC', $self->mt, $lenhi, $lenlo).$self->data;
if ($numrecs == 0) {
#The message is fully contained within one record
my ($rec) = @{$self->records};
my $recdata = $rec->decrypt_data;
if (length($msgdata) != ${$self->message_frag_lens}[0]
+ TLS_MESSAGE_HEADER_LENGTH) {
#Message length has changed! Better adjust the record length
my $diff = length($msgdata) - ${$self->message_frag_lens}[0]
- TLS_MESSAGE_HEADER_LENGTH;
$rec->len($rec->len + $diff);
}
$rec->data(substr($recdata, 0, $self->startoffset)
.($msgdata)
.substr($recdata, ${$self->message_frag_lens}[0]
+ TLS_MESSAGE_HEADER_LENGTH));
#Update the fragment len in case we changed it above
${$self->message_frag_lens}[0] = length($msgdata)
- TLS_MESSAGE_HEADER_LENGTH;
return;
}
#Note we don't currently support changing a fragmented message length
my $recctr = 0;
my $datadone = 0;
foreach my $rec (@{$self->records}) {
my $recdata = $rec->decrypt_data;
if ($recctr == 0) {
#This is the first record
my $remainlen = length($recdata) - $self->startoffset;
$rec->data(substr($recdata, 0, $self->startoffset)
.substr(($msgdata), 0, $remainlen));
$datadone += $remainlen;
} elsif ($recctr + 1 == $numrecs) {
#This is the last record
$rec->data(substr($msgdata, $datadone));
} else {
#This is a middle record
$rec->data(substr($msgdata, $datadone, length($rec->data)));
$datadone += length($rec->data);
}
$recctr++;
}
}
#To be overridden by sub-classes
sub set_message_contents
{
}
#Read only accessors
sub server
{
my $self = shift;
return $self->{server};
}
#Read/write accessors
sub mt
{
my $self = shift;
if (@_) {
$self->{mt} = shift;
}
return $self->{mt};
}
sub data
{
my $self = shift;
if (@_) {
$self->{data} = shift;
}
return $self->{data};
}
sub records
{
my $self = shift;
if (@_) {
$self->{records} = shift;
}
return $self->{records};
}
sub startoffset
{
my $self = shift;
if (@_) {
$self->{startoffset} = shift;
}
return $self->{startoffset};
}
sub message_frag_lens
{
my $self = shift;
if (@_) {
$self->{message_frag_lens} = shift;
}
return $self->{message_frag_lens};
}
1;

364
util/TLSProxy/Proxy.pm Normal file
View file

@ -0,0 +1,364 @@
# Written by Matt Caswell for the OpenSSL project.
# ====================================================================
# Copyright (c) 1998-2015 The OpenSSL Project. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in
# the documentation and/or other materials provided with the
# distribution.
#
# 3. All advertising materials mentioning features or use of this
# software must display the following acknowledgment:
# "This product includes software developed by the OpenSSL Project
# for use in the OpenSSL Toolkit. (http://www.openssl.org/)"
#
# 4. The names "OpenSSL Toolkit" and "OpenSSL Project" must not be used to
# endorse or promote products derived from this software without
# prior written permission. For written permission, please contact
# openssl-core@openssl.org.
#
# 5. Products derived from this software may not be called "OpenSSL"
# nor may "OpenSSL" appear in their names without prior written
# permission of the OpenSSL Project.
#
# 6. Redistributions of any form whatsoever must retain the following
# acknowledgment:
# "This product includes software developed by the OpenSSL Project
# for use in the OpenSSL Toolkit (http://www.openssl.org/)"
#
# THIS SOFTWARE IS PROVIDED BY THE OpenSSL PROJECT ``AS IS'' AND ANY
# EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE OpenSSL PROJECT OR
# ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
# OF THE POSSIBILITY OF SUCH DAMAGE.
# ====================================================================
#
# This product includes cryptographic software written by Eric Young
# (eay@cryptsoft.com). This product includes software written by Tim
# Hudson (tjh@cryptsoft.com).
use strict;
package TLSProxy::Proxy;
use File::Spec;
use IO::Socket;
use IO::Select;
use TLSProxy::Record;
use TLSProxy::Message;
use TLSProxy::ClientHello;
sub new
{
my $class = shift;
my ($filter,
$execute,
$cert,
$debug) = @_;
my $self = {
#Public read/write
proxy_addr => "localhost",
proxy_port => 4453,
server_addr => "localhost",
server_port => 4443,
filter => $filter,
#Public read
execute => $execute,
cert => $cert,
debug => $debug,
flight => 0,
record_list => [],
message_list => [],
#Private
message_rec_list => []
};
return bless $self, $class;
}
sub clear
{
my $self = shift;
$self->{flight} = 0;
$self->{record_list} = [];
$self->{message_list} = [];
$self->{message_rec_list} = [];
TLSProxy::Message->clear();
TLSProxy::Record->clear();
}
sub restart
{
my $self = shift;
$self->clear;
$self->start;
}
sub start
{
my ($self) = shift;
my $pid;
$pid = fork();
if ($pid == 0) {
open(STDOUT, ">", File::Spec->devnull())
or die "Failed to redirect stdout";
open(STDERR, ">&STDOUT");
exec($self->execute." s_server -testmode -accept ".($self->server_port)
." -cert ".$self->cert." -naccept 1");
}
my $oldstdout;
if(!$self->debug) {
$oldstdout = select(File::Spec->devnull());
}
# Create the Proxy socket
my $proxy_sock = new IO::Socket::INET(
LocalHost => $self->proxy_addr,
LocalPort => $self->proxy_port,
Proto => "tcp",
Listen => SOMAXCONN,
Reuse => 1
);
if ($proxy_sock) {
print "Proxy started on port ".$self->proxy_port."\n";
} else {
die "Failed creating proxy socket\n";
}
if ($self->execute) {
my $pid = fork();
if ($pid == 0) {
open(STDOUT, ">", File::Spec->devnull())
or die "Failed to redirect stdout";
open(STDERR, ">&STDOUT");
exec($self->execute
." s_client -cipher AES128-SHA -testmode -connect "
.($self->proxy_addr).":".($self->proxy_port));
}
}
# Wait for incoming connection from client
my $client_sock = $proxy_sock->accept()
or die "Failed accepting incoming connection\n";
print "Connection opened\n";
# Now connect to the server
my $retry = 3;
my $server_sock;
#We loop over this a few times because sometimes s_server can take a while
#to start up
do {
$server_sock = new IO::Socket::INET(
PeerAddr => $self->server_addr,
PeerPort => $self->server_port,
Proto => 'tcp'
);
$retry--;
if (!$server_sock) {
if ($retry) {
#Sleep for a short while
select(undef, undef, undef, 0.1);
} else {
die "Failed to start up server\n";
}
}
} while (!$server_sock);
my $sel = IO::Select->new($server_sock, $client_sock);
my $indata;
my @handles = ($server_sock, $client_sock);
#Wait for either the server socket or the client socket to become readable
my @ready;
while(!(TLSProxy::Message->end) && (@ready = $sel->can_read)) {
foreach my $hand (@ready) {
if ($hand == $server_sock) {
$server_sock->sysread($indata, 16384) or goto END;
$indata = $self->process_packet(1, $indata);
$client_sock->syswrite($indata);
} elsif ($hand == $client_sock) {
$client_sock->sysread($indata, 16384) or goto END;
$indata = $self->process_packet(0, $indata);
$server_sock->syswrite($indata);
} else {
print "Err\n";
goto END;
}
}
}
END:
print "Connection closed\n";
if($server_sock) {
$server_sock->close();
}
if($client_sock) {
#Closing this also kills the child process
$client_sock->close();
}
if($proxy_sock) {
$proxy_sock->close();
}
if(!$self->debug) {
select($oldstdout);
}
}
sub process_packet
{
my ($self, $server, $packet) = @_;
my $len_real;
my $decrypt_len;
my $data;
my $recnum;
if ($server) {
print "Received server packet\n";
} else {
print "Received client packet\n";
}
print "Packet length = ".length($packet)."\n";
print "Processing flight ".$self->flight."\n";
#Return contains the list of record found in the packet followed by the
#list of messages in those records
my @ret = TLSProxy::Record->get_records($server, $self->flight, $packet);
push @{$self->record_list}, @{$ret[0]};
$self->{message_rec_list} = $ret[0];
push @{$self->{message_list}}, @{$ret[1]};
print "\n";
#Finished parsing. Call user provided filter here
$self->filter->($self);
#Reconstruct the packet
$packet = "";
foreach my $record (@{$self->record_list}) {
#We only replay the records for the current flight
if ($record->flight != $self->flight) {
next;
}
$packet .= $record->reconstruct_record();
}
$self->{flight} = $self->{flight} + 1;
print "Forwarded packet length = ".length($packet)."\n\n";
return $packet;
}
#Read accessors
sub execute
{
my $self = shift;
return $self->{execute};
}
sub cert
{
my $self = shift;
return $self->{cert};
}
sub debug
{
my $self = shift;
return $self->{debug};
}
sub flight
{
my $self = shift;
return $self->{flight};
}
sub record_list
{
my $self = shift;
return $self->{record_list};
}
sub message_list
{
my $self = shift;
return $self->{message_list};
}
sub success
{
my $self = shift;
return $self->{success};
}
sub end
{
my $self = shift;
return $self->{end};
}
#Read/write accessors
sub proxy_addr
{
my $self = shift;
if (@_) {
$self->{proxy_addr} = shift;
}
return $self->{proxy_addr};
}
sub proxy_port
{
my $self = shift;
if (@_) {
$self->{proxy_port} = shift;
}
return $self->{proxy_port};
}
sub server_addr
{
my $self = shift;
if (@_) {
$self->{server_addr} = shift;
}
return $self->{server_addr};
}
sub server_port
{
my $self = shift;
if (@_) {
$self->{server_port} = shift;
}
return $self->{server_port};
}
sub filter
{
my $self = shift;
if (@_) {
$self->{filter} = shift;
}
return $self->{filter};
}
1;

360
util/TLSProxy/Record.pm Normal file
View file

@ -0,0 +1,360 @@
# Written by Matt Caswell for the OpenSSL project.
# ====================================================================
# Copyright (c) 1998-2015 The OpenSSL Project. All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in
# the documentation and/or other materials provided with the
# distribution.
#
# 3. All advertising materials mentioning features or use of this
# software must display the following acknowledgment:
# "This product includes software developed by the OpenSSL Project
# for use in the OpenSSL Toolkit. (http://www.openssl.org/)"
#
# 4. The names "OpenSSL Toolkit" and "OpenSSL Project" must not be used to
# endorse or promote products derived from this software without
# prior written permission. For written permission, please contact
# openssl-core@openssl.org.
#
# 5. Products derived from this software may not be called "OpenSSL"
# nor may "OpenSSL" appear in their names without prior written
# permission of the OpenSSL Project.
#
# 6. Redistributions of any form whatsoever must retain the following
# acknowledgment:
# "This product includes software developed by the OpenSSL Project
# for use in the OpenSSL Toolkit (http://www.openssl.org/)"
#
# THIS SOFTWARE IS PROVIDED BY THE OpenSSL PROJECT ``AS IS'' AND ANY
# EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE OpenSSL PROJECT OR
# ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
# OF THE POSSIBILITY OF SUCH DAMAGE.
# ====================================================================
#
# This product includes cryptographic software written by Eric Young
# (eay@cryptsoft.com). This product includes software written by Tim
# Hudson (tjh@cryptsoft.com).
use strict;
use TLSProxy::Proxy;
package TLSProxy::Record;
my $server_ccs_seen = 0;
my $client_ccs_seen = 0;
my $etm = 0;
use constant TLS_RECORD_HEADER_LENGTH => 5;
#Record types
use constant {
RT_APPLICATION_DATA => 23,
RT_HANDSHAKE => 22,
RT_ALERT => 21,
RT_CCS => 20
};
my %record_type = (
RT_APPLICATION_DATA, "APPLICATION DATA",
RT_HANDSHAKE, "HANDSHAKE",
RT_ALERT, "ALERT",
RT_CCS, "CCS"
);
use constant {
VERS_TLS_1_3 => 772,
VERS_TLS_1_2 => 771,
VERS_TLS_1_1 => 770,
VERS_TLS_1_0 => 769,
VERS_SSL_3_0 => 768
};
my %tls_version = (
VERS_TLS_1_3, "TLS1.3",
VERS_TLS_1_2, "TLS1.2",
VERS_TLS_1_1, "TLS1.1",
VERS_TLS_1_0, "TLS1.0",
VERS_SSL_3_0, "SSL3"
);
#Class method to extract records from a packet of data
sub get_records
{
my $class = shift;
my $server = shift;
my $flight = shift;
my $packet = shift;
my @record_list = ();
my @message_list = ();
my $data;
my $content_type;
my $version;
my $len;
my $len_real;
my $decrypt_len;
my $recnum = 1;
while (length ($packet) > 0) {
print " Record $recnum";
if ($server) {
print " (server -> client)\n";
} else {
print " (client -> server)\n";
}
#Get the record header
if (length($packet) < TLS_RECORD_HEADER_LENGTH) {
print "Partial data : ".length($packet)." bytes\n";
$packet = "";
} else {
($content_type, $version, $len) = unpack('CnnC*', $packet);
$data = substr($packet, 5, $len);
print " Content type: ".$record_type{$content_type}."\n";
print " Version: $tls_version{$version}\n";
print " Length: $len";
if ($len == length($data)) {
print "\n";
$decrypt_len = $len_real = $len;
} else {
print " (expected), ".length($data)." (actual)\n";
$decrypt_len = $len_real = length($data);
}
my $record = TLSProxy::Record->new(
$flight,
$content_type,
$version,
$len,
$len_real,
$decrypt_len,
substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real),
substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real)
);
if (($server && $server_ccs_seen)
|| (!$server && $client_ccs_seen)) {
if ($etm) {
$record->decryptETM();
} else {
$record->decrypt();
}
}
push @record_list, $record;
#Now figure out what messages are contained within this record
my @messages = TLSProxy::Message->get_messages($server, $record);
push @message_list, @messages;
$packet = substr($packet, TLS_RECORD_HEADER_LENGTH + $len_real);
$recnum++;
}
}
return (\@record_list, \@message_list);
}
sub clear
{
$server_ccs_seen = 0;
$client_ccs_seen = 0;
}
#Class level accessors
sub server_ccs_seen
{
my $class = shift;
if (@_) {
$server_ccs_seen = shift;
}
return $server_ccs_seen;
}
sub client_ccs_seen
{
my $class = shift;
if (@_) {
$client_ccs_seen = shift;
}
return $client_ccs_seen;
}
#Enable/Disable Encrypt-then-MAC
sub etm
{
my $class = shift;
if (@_) {
$etm = shift;
}
return $etm;
}
sub new
{
my $class = shift;
my ($flight,
$content_type,
$version,
$len,
$len_real,
$decrypt_len,
$data,
$decrypt_data) = @_;
my $self = {
flight => $flight,
content_type => $content_type,
version => $version,
len => $len,
len_real => $len_real,
decrypt_len => $decrypt_len,
data => $data,
decrypt_data => $decrypt_data,
orig_decrypt_data => $decrypt_data
};
return bless $self, $class;
}
#Decrypt using encrypt-then-MAC
sub decryptETM
{
my ($self) = shift;
my $data = $self->data;
if($self->version >= VERS_TLS_1_1()) {
#TLS1.1+ has an explicit IV. Throw it away
$data = substr($data, 16);
}
#Throw away the MAC (assumes MAC is 20 bytes for now. FIXME)
$data = substr($data, 0, length($data) - 20);
#Find out what the padding byte is
my $padval = unpack("C", substr($data, length($data) - 1));
#Throw away the padding
$data = substr($data, 0, length($data) - ($padval + 1));
$self->decrypt_data($data);
$self->decrypt_len(length($data));
return $data;
}
#Standard decrypt
sub decrypt()
{
my ($self) = shift;
my $data = $self->data;
if($self->version >= VERS_TLS_1_1()) {
#TLS1.1+ has an explicit IV. Throw it away
$data = substr($data, 16);
}
#Find out what the padding byte is
my $padval = unpack("C", substr($data, length($data) - 1));
#Throw away the padding
$data = substr($data, 0, length($data) - ($padval + 1));
#Throw away the MAC (assumes MAC is 20 bytes for now. FIXME)
$data = substr($data, 0, length($data) - 20);
$self->decrypt_data($data);
$self->decrypt_len(length($data));
return $data;
}
#Reconstruct the on-the-wire record representation
sub reconstruct_record
{
my $self = shift;
my $data;
$data = pack('Cnn', $self->content_type, $self->version, $self->len);
$data .= $self->data;
return $data;
}
#Read only accessors
sub flight
{
my $self = shift;
return $self->{flight};
}
sub content_type
{
my $self = shift;
return $self->{content_type};
}
sub version
{
my $self = shift;
return $self->{version};
}
sub len_real
{
my $self = shift;
return $self->{len_real};
}
sub orig_decrypt_data
{
my $self = shift;
return $self->{orig_decrypt_data};
}
#Read/write accessors
sub decrypt_len
{
my $self = shift;
if (@_) {
$self->{decrypt_len} = shift;
}
return $self->{decrypt_len};
}
sub data
{
my $self = shift;
if (@_) {
$self->{data} = shift;
}
return $self->{data};
}
sub decrypt_data
{
my $self = shift;
if (@_) {
$self->{decrypt_data} = shift;
}
return $self->{decrypt_data};
}
sub len
{
my $self = shift;
if (@_) {
$self->{len} = shift;
}
return $self->{len};
}
1;