From cb6afcd6ee0c0d66fae62e13fe5966171992f81c Mon Sep 17 00:00:00 2001 From: Richard Levitte Date: Tue, 1 Aug 2017 22:10:39 +0200 Subject: Consolidate the locations where we have our internal perl modules Instead of having perl modules under test/testlib, util and util/perl, consolidate them all to be inside util/perl. Reviewed-by: Andy Polyakov (Merged from https://github.com/openssl/openssl/pull/4069) --- util/TLSProxy/Certificate.pm | 219 ------ util/TLSProxy/CertificateVerify.pm | 96 --- util/TLSProxy/ClientHello.pm | 261 ------- util/TLSProxy/EncryptedExtensions.pm | 115 --- util/TLSProxy/HelloRetryRequest.pm | 150 ---- util/TLSProxy/Message.pm | 570 -------------- util/TLSProxy/NewSessionTicket.pm | 81 -- util/TLSProxy/Proxy.pm | 603 --------------- util/TLSProxy/Record.pm | 398 ---------- util/TLSProxy/ServerHello.pm | 234 ------ util/TLSProxy/ServerKeyExchange.pm | 157 ---- util/dofile.pl | 8 +- util/perl/OpenSSL/Test.pm | 1168 +++++++++++++++++++++++++++++ util/perl/OpenSSL/Test/Simple.pm | 91 +++ util/perl/OpenSSL/Test/Utils.pm | 239 ++++++ util/perl/TLSProxy/Certificate.pm | 219 ++++++ util/perl/TLSProxy/CertificateVerify.pm | 96 +++ util/perl/TLSProxy/ClientHello.pm | 261 +++++++ util/perl/TLSProxy/EncryptedExtensions.pm | 115 +++ util/perl/TLSProxy/HelloRetryRequest.pm | 150 ++++ util/perl/TLSProxy/Message.pm | 570 ++++++++++++++ util/perl/TLSProxy/NewSessionTicket.pm | 81 ++ util/perl/TLSProxy/Proxy.pm | 603 +++++++++++++++ util/perl/TLSProxy/Record.pm | 398 ++++++++++ util/perl/TLSProxy/ServerHello.pm | 234 ++++++ util/perl/TLSProxy/ServerKeyExchange.pm | 157 ++++ util/perl/checkhandshake.pm | 181 +++++ util/perl/with_fallback.pm | 25 + util/with_fallback.pm | 24 - 29 files changed, 4594 insertions(+), 2910 deletions(-) delete mode 100644 util/TLSProxy/Certificate.pm delete mode 100644 util/TLSProxy/CertificateVerify.pm delete mode 100644 util/TLSProxy/ClientHello.pm delete mode 100644 util/TLSProxy/EncryptedExtensions.pm delete mode 100644 util/TLSProxy/HelloRetryRequest.pm delete mode 100644 util/TLSProxy/Message.pm delete mode 100644 util/TLSProxy/NewSessionTicket.pm delete mode 100644 util/TLSProxy/Proxy.pm delete mode 100644 util/TLSProxy/Record.pm delete mode 100644 util/TLSProxy/ServerHello.pm delete mode 100644 util/TLSProxy/ServerKeyExchange.pm create mode 100644 util/perl/OpenSSL/Test.pm create mode 100644 util/perl/OpenSSL/Test/Simple.pm create mode 100644 util/perl/OpenSSL/Test/Utils.pm create mode 100644 util/perl/TLSProxy/Certificate.pm create mode 100644 util/perl/TLSProxy/CertificateVerify.pm create mode 100644 util/perl/TLSProxy/ClientHello.pm create mode 100644 util/perl/TLSProxy/EncryptedExtensions.pm create mode 100644 util/perl/TLSProxy/HelloRetryRequest.pm create mode 100644 util/perl/TLSProxy/Message.pm create mode 100644 util/perl/TLSProxy/NewSessionTicket.pm create mode 100644 util/perl/TLSProxy/Proxy.pm create mode 100644 util/perl/TLSProxy/Record.pm create mode 100644 util/perl/TLSProxy/ServerHello.pm create mode 100644 util/perl/TLSProxy/ServerKeyExchange.pm create mode 100644 util/perl/checkhandshake.pm create mode 100644 util/perl/with_fallback.pm delete mode 100644 util/with_fallback.pm (limited to 'util') diff --git a/util/TLSProxy/Certificate.pm b/util/TLSProxy/Certificate.pm deleted file mode 100644 index d3bf7f2180..0000000000 --- a/util/TLSProxy/Certificate.pm +++ /dev/null @@ -1,219 +0,0 @@ -# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. -# -# Licensed under the OpenSSL license (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::Certificate; - -use vars '@ISA'; -push @ISA, 'TLSProxy::Message'; - -sub new -{ - my $class = shift; - my ($server, - $data, - $records, - $startoffset, - $message_frag_lens) = @_; - - my $self = $class->SUPER::new( - $server, - TLSProxy::Message::MT_CERTIFICATE, - $data, - $records, - $startoffset, - $message_frag_lens); - - $self->{first_certificate} = ""; - $self->{extension_data} = ""; - $self->{remaining_certdata} = ""; - - return $self; -} - -sub parse -{ - my $self = shift; - - if (TLSProxy::Proxy->is_tls13()) { - my $context_len = unpack('C', $self->data); - my $context = substr($self->data, 1, $context_len); - - my $remdata = substr($self->data, 1 + $context_len); - - my ($hicertlistlen, $certlistlen) = unpack('Cn', $remdata); - $certlistlen += ($hicertlistlen << 16); - - $remdata = substr($remdata, 3); - - die "Invalid Certificate List length" - if length($remdata) != $certlistlen; - - my ($hicertlen, $certlen) = unpack('Cn', $remdata); - $certlen += ($hicertlen << 16); - - die "Certificate too long" if ($certlen + 3) > $certlistlen; - - $remdata = substr($remdata, 3); - - my $certdata = substr($remdata, 0, $certlen); - - $remdata = substr($remdata, $certlen); - - my $extensions_len = unpack('n', $remdata); - $remdata = substr($remdata, 2); - - die "Extensions too long" - if ($certlen + 3 + $extensions_len + 2) > $certlistlen; - - my $extension_data = ""; - if ($extensions_len != 0) { - $extension_data = substr($remdata, 0, $extensions_len); - - 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; - } - $remdata = substr($remdata, $extensions_len); - - $self->context($context); - $self->first_certificate($certdata); - $self->extension_data(\%extensions); - $self->remaining_certdata($remdata); - - print " Context:".$context."\n"; - print " Certificate List Len:".$certlistlen."\n"; - print " Certificate Len:".$certlen."\n"; - print " Extensions Len:".$extensions_len."\n"; - } else { - my ($hicertlistlen, $certlistlen) = unpack('Cn', $self->data); - $certlistlen += ($hicertlistlen << 16); - - my $remdata = substr($self->data, 3); - - die "Invalid Certificate List length" - if length($remdata) != $certlistlen; - - my ($hicertlen, $certlen) = unpack('Cn', $remdata); - $certlen += ($hicertlen << 16); - - die "Certificate too long" if ($certlen + 3) > $certlistlen; - - $remdata = substr($remdata, 3); - - my $certdata = substr($remdata, 0, $certlen); - - $remdata = substr($remdata, $certlen); - - $self->first_certificate($certdata); - $self->remaining_certdata($remdata); - - print " Certificate List Len:".$certlistlen."\n"; - print " Certificate Len:".$certlen."\n"; - } -} - -#Reconstruct the on-the-wire message data following changes -sub set_message_contents -{ - my $self = shift; - my $data; - my $extensions = ""; - - if (TLSProxy::Proxy->is_tls13()) { - foreach my $key (keys %{$self->extension_data}) { - my $extdata = ${$self->extension_data}{$key}; - $extensions .= pack("n", $key); - $extensions .= pack("n", length($extdata)); - $extensions .= $extdata; - if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) { - $extensions .= pack("n", $key); - $extensions .= pack("n", length($extdata)); - $extensions .= $extdata; - } - } - $data = pack('C', length($self->context())); - $data .= $self->context; - my $certlen = length($self->first_certificate); - my $certlistlen = $certlen + length($extensions) - + length($self->remaining_certdata); - my $hi = $certlistlen >> 16; - $certlistlen = $certlistlen & 0xffff; - $data .= pack('Cn', $hi, $certlistlen); - $hi = $certlen >> 16; - $certlen = $certlen & 0xffff; - $data .= pack('Cn', $hi, $certlen); - $data .= pack('n', length($extensions)); - $data .= $extensions; - $data .= $self->remaining_certdata(); - $self->data($data); - } else { - my $certlen = length($self->first_certificate); - my $certlistlen = $certlen + length($self->remaining_certdata); - my $hi = $certlistlen >> 16; - $certlistlen = $certlistlen & 0xffff; - $data .= pack('Cn', $hi, $certlistlen); - $hi = $certlen >> 16; - $certlen = $certlen & 0xffff; - $data .= pack('Cn', $hi, $certlen); - $data .= $self->remaining_certdata(); - $self->data($data); - } -} - -#Read/write accessors -sub context -{ - my $self = shift; - if (@_) { - $self->{context} = shift; - } - return $self->{context}; -} -sub first_certificate -{ - my $self = shift; - if (@_) { - $self->{first_certificate} = shift; - } - return $self->{first_certificate}; -} -sub remaining_certdata -{ - my $self = shift; - if (@_) { - $self->{remaining_certdata} = shift; - } - return $self->{remaining_certdata}; -} -sub extension_data -{ - my $self = shift; - if (@_) { - $self->{extension_data} = shift; - } - return $self->{extension_data}; -} -sub set_extension -{ - my ($self, $ext_type, $ext_data) = @_; - $self->{extension_data}{$ext_type} = $ext_data; -} -sub delete_extension -{ - my ($self, $ext_type) = @_; - delete $self->{extension_data}{$ext_type}; -} -1; diff --git a/util/TLSProxy/CertificateVerify.pm b/util/TLSProxy/CertificateVerify.pm deleted file mode 100644 index 8bf969fba1..0000000000 --- a/util/TLSProxy/CertificateVerify.pm +++ /dev/null @@ -1,96 +0,0 @@ -# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. -# -# Licensed under the OpenSSL license (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::CertificateVerify; - -use vars '@ISA'; -push @ISA, 'TLSProxy::Message'; - -sub new -{ - my $class = shift; - my ($server, - $data, - $records, - $startoffset, - $message_frag_lens) = @_; - - my $self = $class->SUPER::new( - $server, - TLSProxy::Message::MT_CERTIFICATE_VERIFY, - $data, - $records, - $startoffset, - $message_frag_lens); - - $self->{sigalg} = -1; - $self->{signature} = ""; - - return $self; -} - -sub parse -{ - my $self = shift; - - my $sigalg = -1; - my $remdata = $self->data; - my $record = ${$self->records}[0]; - - if (TLSProxy::Proxy->is_tls13() - || $record->version() == TLSProxy::Record::VERS_TLS_1_2) { - $sigalg = unpack('n', $remdata); - $remdata = substr($remdata, 2); - } - - my $siglen = unpack('n', substr($remdata, 0, 2)); - my $sig = substr($remdata, 2); - - die "Invalid CertificateVerify signature length" if length($sig) != $siglen; - - print " SigAlg:".$sigalg."\n"; - print " Signature Len:".$siglen."\n"; - - $self->sigalg($sigalg); - $self->signature($sig); -} - -#Reconstruct the on-the-wire message data following changes -sub set_message_contents -{ - my $self = shift; - my $data = ""; - my $sig = $self->signature(); - my $olddata = $self->data(); - - $data .= pack("n", $self->sigalg()) if ($self->sigalg() != -1); - $data .= pack("n", length($sig)); - $data .= $sig; - - $self->data($data); -} - -#Read/write accessors -sub sigalg -{ - my $self = shift; - if (@_) { - $self->{sigalg} = shift; - } - return $self->{sigalg}; -} -sub signature -{ - my $self = shift; - if (@_) { - $self->{signature} = shift; - } - return $self->{signature}; -} -1; diff --git a/util/TLSProxy/ClientHello.pm b/util/TLSProxy/ClientHello.pm deleted file mode 100644 index 2ae9d6f55d..0000000000 --- a/util/TLSProxy/ClientHello.pm +++ /dev/null @@ -1,261 +0,0 @@ -# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. -# -# Licensed under the OpenSSL license (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::ClientHello; - -use vars '@ISA'; -push @ISA, 'TLSProxy::Message'; - -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->{extension_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{TLSProxy::Message::EXT_ENCRYPT_THEN_MAC}) { - TLSProxy::Record->etm(1); - } -} - -sub extension_contents -{ - my $self = shift; - my $key = shift; - my $extension = ""; - - my $extdata = ${$self->extension_data}{$key}; - $extension .= pack("n", $key); - $extension .= pack("n", length($extdata)); - $extension .= $extdata; - if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) { - $extension .= pack("n", $key); - $extension .= pack("n", length($extdata)); - $extension .= $extdata; - } - return $extension; -} - -#Reconstruct the on-the-wire message data following changes -sub set_message_contents -{ - my $self = shift; - my $data; - my $extensions = ""; - - $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}); - - foreach my $key (keys %{$self->extension_data}) { - next if ($key == TLSProxy::Message::EXT_PSK); - $extensions .= $self->extension_contents($key); - } - #PSK extension always goes last... - if (defined ${$self->extension_data}{TLSProxy::Message::EXT_PSK}) { - $extensions .= $self->extension_contents(TLSProxy::Message::EXT_PSK); - } - #unless we have EXT_FORCE_LAST - if (defined ${$self->extension_data}{TLSProxy::Message::EXT_FORCE_LAST}) { - $extensions .= $self->extension_contents(TLSProxy::Message::EXT_FORCE_LAST); - } - - $data .= pack('n', length($extensions)); - $data .= $extensions; - - $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}; -} -sub set_extension -{ - my ($self, $ext_type, $ext_data) = @_; - $self->{extension_data}{$ext_type} = $ext_data; -} -sub delete_extension -{ - my ($self, $ext_type) = @_; - delete $self->{extension_data}{$ext_type}; -} -1; diff --git a/util/TLSProxy/EncryptedExtensions.pm b/util/TLSProxy/EncryptedExtensions.pm deleted file mode 100644 index 81242e29ff..0000000000 --- a/util/TLSProxy/EncryptedExtensions.pm +++ /dev/null @@ -1,115 +0,0 @@ -# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. -# -# Licensed under the OpenSSL license (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::EncryptedExtensions; - -use vars '@ISA'; -push @ISA, 'TLSProxy::Message'; - -sub new -{ - my $class = shift; - my ($server, - $data, - $records, - $startoffset, - $message_frag_lens) = @_; - - my $self = $class->SUPER::new( - $server, - TLSProxy::Message::MT_ENCRYPTED_EXTENSIONS, - $data, - $records, - $startoffset, - $message_frag_lens); - - $self->{extension_data} = ""; - - return $self; -} - -sub parse -{ - my $self = shift; - - my $extensions_len = unpack('n', $self->data); - if (!defined $extensions_len) { - $extensions_len = 0; - } - - my $extension_data; - if ($extensions_len != 0) { - $extension_data = substr($self->data, 2); - - if (length($extension_data) != $extensions_len) { - die "Invalid extension length\n"; - } - } else { - if (length($self->data) != 2) { - die "Invalid extension length\n"; - } - $extension_data = ""; - } - 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->extension_data(\%extensions); - - print " Extensions Len:".$extensions_len."\n"; -} - -#Reconstruct the on-the-wire message data following changes -sub set_message_contents -{ - my $self = shift; - my $data; - my $extensions = ""; - - foreach my $key (keys %{$self->extension_data}) { - my $extdata = ${$self->extension_data}{$key}; - $extensions .= pack("n", $key); - $extensions .= pack("n", length($extdata)); - $extensions .= $extdata; - if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) { - $extensions .= pack("n", $key); - $extensions .= pack("n", length($extdata)); - $extensions .= $extdata; - } - } - - $data = pack('n', length($extensions)); - $data .= $extensions; - $self->data($data); -} - -#Read/write accessors -sub extension_data -{ - my $self = shift; - if (@_) { - $self->{extension_data} = shift; - } - return $self->{extension_data}; -} -sub set_extension -{ - my ($self, $ext_type, $ext_data) = @_; - $self->{extension_data}{$ext_type} = $ext_data; -} -sub delete_extension -{ - my ($self, $ext_type) = @_; - delete $self->{extension_data}{$ext_type}; -} -1; diff --git a/util/TLSProxy/HelloRetryRequest.pm b/util/TLSProxy/HelloRetryRequest.pm deleted file mode 100644 index c4125b7a16..0000000000 --- a/util/TLSProxy/HelloRetryRequest.pm +++ /dev/null @@ -1,150 +0,0 @@ -# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. -# -# Licensed under the OpenSSL license (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::HelloRetryRequest; - -use vars '@ISA'; -push @ISA, 'TLSProxy::Message'; - -sub new -{ - my $class = shift; - my ($server, - $data, - $records, - $startoffset, - $message_frag_lens) = @_; - - my $self = $class->SUPER::new( - $server, - TLSProxy::Message::MT_HELLO_RETRY_REQUEST, - $data, - $records, - $startoffset, - $message_frag_lens); - - $self->{extension_data} = ""; - - return $self; -} - -sub parse -{ - my $self = shift; - my $ptr = 2; - - TLSProxy::Proxy->is_tls13(1); - - my ($server_version) = unpack('n', $self->data); - # TODO(TLS1.3): Replace this reference to draft version before release - if ($server_version == TLSProxy::Record::VERS_TLS_1_3_DRAFT) { - $server_version = TLSProxy::Record::VERS_TLS_1_3; - } - - my $ciphersuite = unpack('n', substr($self->data, $ptr)); - $ptr += 2; - - my $extensions_len = unpack('n', substr($self->data, $ptr)); - if (!defined $extensions_len) { - $extensions_len = 0; - } - - $ptr += 2; - my $extension_data; - if ($extensions_len != 0) { - $extension_data = substr($self->data, $ptr); - - if (length($extension_data) != $extensions_len) { - die "Invalid extension length\n"; - } - } else { - if (length($self->data) != 2) { - die "Invalid extension length\n"; - } - $extension_data = ""; - } - 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->server_version($server_version); - $self->ciphersuite($ciphersuite); - $self->extension_data(\%extensions); - - print " Server Version:".$server_version."\n"; - print " Ciphersuite:".$ciphersuite."\n"; - print " Extensions Len:".$extensions_len."\n"; -} - -#Reconstruct the on-the-wire message data following changes -sub set_message_contents -{ - my $self = shift; - my $data; - my $extensions = ""; - - foreach my $key (keys %{$self->extension_data}) { - my $extdata = ${$self->extension_data}{$key}; - $extensions .= pack("n", $key); - $extensions .= pack("n", length($extdata)); - $extensions .= $extdata; - if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) { - $extensions .= pack("n", $key); - $extensions .= pack("n", length($extdata)); - $extensions .= $extdata; - } - } - - $data = pack('n', $self->server_version); - $data .= pack('n', $self->ciphersuite); - $data .= pack('n', length($extensions)); - $data .= $extensions; - $self->data($data); -} - -#Read/write accessors -sub server_version -{ - my $self = shift; - if (@_) { - $self->{server_version} = shift; - } - return $self->{server_version}; -} -sub ciphersuite -{ - my $self = shift; - if (@_) { - $self->{ciphersuite} = shift; - } - return $self->{ciphersuite}; -} -sub extension_data -{ - my $self = shift; - if (@_) { - $self->{extension_data} = shift; - } - return $self->{extension_data}; -} -sub set_extension -{ - my ($self, $ext_type, $ext_data) = @_; - $self->{extension_data}{$ext_type} = $ext_data; -} -sub delete_extension -{ - my ($self, $ext_type) = @_; - delete $self->{extension_data}{$ext_type}; -} -1; diff --git a/util/TLSProxy/Message.pm b/util/TLSProxy/Message.pm deleted file mode 100644 index a9002ec654..0000000000 --- a/util/TLSProxy/Message.pm +++ /dev/null @@ -1,570 +0,0 @@ -# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. -# -# Licensed under the OpenSSL license (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::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_HELLO_RETRY_REQUEST => 6, - MT_ENCRYPTED_EXTENSIONS => 8, - 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 -}; - -#Alert levels -use constant { - AL_LEVEL_WARN => 1, - AL_LEVEL_FATAL => 2 -}; - -#Alert descriptions -use constant { - AL_DESC_CLOSE_NOTIFY => 0, - AL_DESC_UNEXPECTED_MESSAGE => 10, - AL_DESC_NO_RENEGOTIATION => 100 -}; - -my %message_type = ( - MT_HELLO_REQUEST, "HelloRequest", - MT_CLIENT_HELLO, "ClientHello", - MT_SERVER_HELLO, "ServerHello", - MT_NEW_SESSION_TICKET, "NewSessionTicket", - MT_HELLO_RETRY_REQUEST, "HelloRetryRequest", - MT_ENCRYPTED_EXTENSIONS, "EncryptedExtensions", - 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" -); - -use constant { - EXT_SERVER_NAME => 0, - EXT_STATUS_REQUEST => 5, - EXT_SUPPORTED_GROUPS => 10, - EXT_EC_POINT_FORMATS => 11, - EXT_SRP => 12, - EXT_SIG_ALGS => 13, - EXT_USE_SRTP => 14, - EXT_ALPN => 16, - EXT_SCT => 18, - EXT_PADDING => 21, - EXT_ENCRYPT_THEN_MAC => 22, - EXT_EXTENDED_MASTER_SECRET => 23, - EXT_SESSION_TICKET => 35, - EXT_KEY_SHARE => 40, - EXT_PSK => 41, - EXT_SUPPORTED_VERSIONS => 43, - EXT_COOKIE => 44, - EXT_PSK_KEX_MODES => 45, - EXT_RENEGOTIATE => 65281, - EXT_NPN => 13172, - # This extension is an unofficial extension only ever written by OpenSSL - # (i.e. not read), and even then only when enabled. We use it to test - # handling of duplicate extensions. - EXT_DUPLICATE_EXTENSION => 0xfde8, - EXT_UNKNOWN => 0xfffe, - #Unknown extension that should appear last - EXT_FORCE_LAST => 0xffff -}; - -# SignatureScheme of TLS 1.3, from -# https://tools.ietf.org/html/draft-ietf-tls-tls13-20#appendix-B.3.1.3 -# TODO(TLS1.3) update link to IANA registry after publication -# We have to manually grab the SHA224 equivalents from the old registry -use constant { - SIG_ALG_RSA_PKCS1_SHA256 => 0x0401, - SIG_ALG_RSA_PKCS1_SHA384 => 0x0501, - SIG_ALG_RSA_PKCS1_SHA512 => 0x0601, - SIG_ALG_ECDSA_SECP256R1_SHA256 => 0x0403, - SIG_ALG_ECDSA_SECP384R1_SHA384 => 0x0503, - SIG_ALG_ECDSA_SECP521R1_SHA512 => 0x0603, - SIG_ALG_RSA_PSS_SHA256 => 0x0804, - SIG_ALG_RSA_PSS_SHA384 => 0x0805, - SIG_ALG_RSA_PSS_SHA512 => 0x0806, - SIG_ALG_ED25519 => 0x0807, - SIG_ALG_ED448 => 0x0808, - SIG_ALG_RSA_PKCS1_SHA1 => 0x0201, - SIG_ALG_ECDSA_SHA1 => 0x0203, - SIG_ALG_DSA_SHA1 => 0x0202, - SIG_ALG_DSA_SHA256 => 0x0402, - SIG_ALG_DSA_SHA384 => 0x0502, - SIG_ALG_DSA_SHA512 => 0x0602, - OSSL_SIG_ALG_RSA_PKCS1_SHA224 => 0x0301, - OSSL_SIG_ALG_DSA_SHA224 => 0x0302, - OSSL_SIG_ALG_ECDSA_SHA224 => 0x0303 -}; - -use constant { - CIPHER_DHE_RSA_AES_128_SHA => 0x0033, - CIPHER_ADH_AES_128_SHA => 0x0034, - CIPHER_TLS13_AES_128_GCM_SHA256 => 0x1301, - CIPHER_TLS13_AES_256_GCM_SHA384 => 0x1302 -}; - -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 = (); -my $ciphersuite = 0; -my $successondata = 0; - -sub clear -{ - $payload = ""; - $messlen = -1; - $startoffset = -1; - $server = 0; - $success = 0; - $end = 0; - $successondata = 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; - - @message_frag_lens = (); - - 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_encrypting(1); - } else { - TLSProxy::Record->client_encrypting(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; - - $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; - - $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"; - - if ($successondata) { - $success = 1; - $end = 1; - } - } elsif ($record->content_type == TLSProxy::Record::RT_ALERT) { - my ($alertlev, $alertdesc) = unpack('CC', $record->decrypt_data); - #A CloseNotify from the client indicates we have finished successfully - #(we assume) - if (!$end && !$server && $alertlev == AL_LEVEL_WARN - && $alertdesc == AL_DESC_CLOSE_NOTIFY) { - $success = 1; - } - #All alerts end the test - $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(); - } elsif ($mt == MT_HELLO_RETRY_REQUEST) { - $message = TLSProxy::HelloRetryRequest->new( - $server, - $data, - [@message_rec_list], - $startoffset, - [@message_frag_lens] - ); - $message->parse(); - } elsif ($mt == MT_SERVER_HELLO) { - $message = TLSProxy::ServerHello->new( - $server, - $data, - [@message_rec_list], - $startoffset, - [@message_frag_lens] - ); - $message->parse(); - } elsif ($mt == MT_ENCRYPTED_EXTENSIONS) { - $message = TLSProxy::EncryptedExtensions->new( - $server, - $data, - [@message_rec_list], - $startoffset, - [@message_frag_lens] - ); - $message->parse(); - } elsif ($mt == MT_CERTIFICATE) { - $message = TLSProxy::Certificate->new( - $server, - $data, - [@message_rec_list], - $startoffset, - [@message_frag_lens] - ); - $message->parse(); - } elsif ($mt == MT_CERTIFICATE_VERIFY) { - $message = TLSProxy::CertificateVerify->new( - $server, - $data, - [@message_rec_list], - $startoffset, - [@message_frag_lens] - ); - $message->parse(); - } elsif ($mt == MT_SERVER_KEY_EXCHANGE) { - $message = TLSProxy::ServerKeyExchange->new( - $server, - $data, - [@message_rec_list], - $startoffset, - [@message_frag_lens] - ); - $message->parse(); - } elsif ($mt == MT_NEW_SESSION_TICKET) { - $message = TLSProxy::NewSessionTicket->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 fail -{ - my $class = shift; - return !$success && $end; -} -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; -} - -sub ciphersuite -{ - my $class = shift; - if (@_) { - $ciphersuite = shift; - } - return $ciphersuite; -} - -#Update all the underlying records with the modified data from this message -#Note: Only supports re-encrypting for TLSv1.3 -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; - $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; - - my $old_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; - } else { - $old_length = 0; - } - - my $prefix = substr($recdata, 0, $self->startoffset); - my $suffix = substr($recdata, $self->startoffset + $old_length); - - $rec->decrypt_data($prefix.($msgdata).($suffix)); - # TODO(openssl-team): don't keep explicit lengths. - # (If a length override is ever needed to construct invalid packets, - # use an explicit override field instead.) - $rec->decrypt_len(length($rec->decrypt_data)); - $rec->len($rec->len + length($msgdata) - $old_length); - # Only support re-encryption for TLSv1.3. - if (TLSProxy::Proxy->is_tls13() && $rec->encrypted()) { - #Add content type (1 byte) and 16 tag bytes - $rec->data($rec->decrypt_data - .pack("C", TLSProxy::Record::RT_HANDSHAKE).("\0"x16)); - } else { - $rec->data($rec->decrypt_data); - } - - #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}; -} -sub encoded_length -{ - my $self = shift; - return TLS_MESSAGE_HEADER_LENGTH + length($self->data); -} -sub successondata -{ - my $class = shift; - if (@_) { - $successondata = shift; - } - return $successondata; -} -1; diff --git a/util/TLSProxy/NewSessionTicket.pm b/util/TLSProxy/NewSessionTicket.pm deleted file mode 100644 index e5099851d5..0000000000 --- a/util/TLSProxy/NewSessionTicket.pm +++ /dev/null @@ -1,81 +0,0 @@ -# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. -# -# Licensed under the OpenSSL license (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::NewSessionTicket; - -use vars '@ISA'; -push @ISA, 'TLSProxy::Message'; - -sub new -{ - my $class = shift; - my ($server, - $data, - $records, - $startoffset, - $message_frag_lens) = @_; - - my $self = $class->SUPER::new( - $server, - TLSProxy::Message::MT_NEW_SESSION_TICKET, - $data, - $records, - $startoffset, - $message_frag_lens); - - $self->{ticket_lifetime_hint} = 0; - $self->{ticket} = ""; - - return $self; -} - -sub parse -{ - my $self = shift; - - my $ticket_lifetime_hint = unpack('N', $self->data); - my $ticket_len = unpack('n', $self->data); - my $ticket = substr($self->data, 6, $ticket_len); - - $self->ticket_lifetime_hint($ticket_lifetime_hint); - $self->ticket($ticket); -} - - -#Reconstruct the on-the-wire message data following changes -sub set_message_contents -{ - my $self = shift; - my $data; - - $data = pack('N', $self->ticket_lifetime_hint); - $data .= pack('n', length($self->ticket)); - $data .= $self->ticket; - - $self->data($data); -} - -#Read/write accessors -sub ticket_lifetime_hint -{ - my $self = shift; - if (@_) { - $self->{ticket_lifetime_hint} = shift; - } - return $self->{ticket_lifetime_hint}; -} -sub ticket -{ - my $self = shift; - if (@_) { - $self->{ticket} = shift; - } - return $self->{ticket}; -} -1; diff --git a/util/TLSProxy/Proxy.pm b/util/TLSProxy/Proxy.pm deleted file mode 100644 index c92652e78f..0000000000 --- a/util/TLSProxy/Proxy.pm +++ /dev/null @@ -1,603 +0,0 @@ -# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. -# -# Licensed under the OpenSSL license (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 POSIX ":sys_wait_h"; - -package TLSProxy::Proxy; - -use File::Spec; -use IO::Socket; -use IO::Select; -use TLSProxy::Record; -use TLSProxy::Message; -use TLSProxy::ClientHello; -use TLSProxy::HelloRetryRequest; -use TLSProxy::ServerHello; -use TLSProxy::EncryptedExtensions; -use TLSProxy::Certificate; -use TLSProxy::CertificateVerify; -use TLSProxy::ServerKeyExchange; -use TLSProxy::NewSessionTicket; - -my $have_IPv6 = 0; -my $IP_factory; - -my $is_tls13 = 0; -my $ciphersuite = undef; - -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, - serverflags => "", - clientflags => "", - serverconnects => 1, - serverpid => 0, - clientpid => 0, - reneg => 0, - sessionfile => undef, - - #Public read - execute => $execute, - cert => $cert, - debug => $debug, - cipherc => "", - ciphers => "AES128-SHA:TLS13-AES-128-GCM-SHA256", - flight => 0, - record_list => [], - message_list => [], - }; - - # IO::Socket::IP is on the core module list, IO::Socket::INET6 isn't. - # However, IO::Socket::INET6 is older and is said to be more widely - # deployed for the moment, and may have less bugs, so we try the latter - # first, then fall back on the code modules. Worst case scenario, we - # fall back to IO::Socket::INET, only supports IPv4. - eval { - require IO::Socket::INET6; - my $s = IO::Socket::INET6->new( - LocalAddr => "::1", - LocalPort => 0, - Listen=>1, - ); - $s or die "\n"; - $s->close(); - }; - if ($@ eq "") { - $IP_factory = sub { IO::Socket::INET6->new(@_); }; - $have_IPv6 = 1; - } else { - eval { - require IO::Socket::IP; - my $s = IO::Socket::IP->new( - LocalAddr => "::1", - LocalPort => 0, - Listen=>1, - ); - $s or die "\n"; - $s->close(); - }; - if ($@ eq "") { - $IP_factory = sub { IO::Socket::IP->new(@_); }; - $have_IPv6 = 1; - } else { - $IP_factory = sub { IO::Socket::INET->new(@_); }; - } - } - - return bless $self, $class; -} - -sub clearClient -{ - my $self = shift; - - $self->{cipherc} = ""; - $self->{flight} = 0; - $self->{record_list} = []; - $self->{message_list} = []; - $self->{clientflags} = ""; - $self->{sessionfile} = undef; - $self->{clientpid} = 0; - $is_tls13 = 0; - $ciphersuite = undef; - - TLSProxy::Message->clear(); - TLSProxy::Record->clear(); -} - -sub clear -{ - my $self = shift; - - $self->clearClient; - $self->{ciphers} = "AES128-SHA:TLS13-AES-128-GCM-SHA256"; - $self->{serverflags} = ""; - $self->{serverconnects} = 1; - $self->{serverpid} = 0; - $self->{reneg} = 0; -} - -sub restart -{ - my $self = shift; - - $self->clear; - $self->start; -} - -sub clientrestart -{ - my $self = shift; - - $self->clear; - $self->clientstart; -} - -sub start -{ - my ($self) = shift; - my $pid; - - $pid = fork(); - if ($pid == 0) { - if (!$self->debug) { - open(STDOUT, ">", File::Spec->devnull()) - or die "Failed to redirect stdout: $!"; - open(STDERR, ">&STDOUT"); - } - my $execcmd = $self->execute - ." s_server -no_comp -rev -engine ossltest -accept " - .($self->server_port) - ." -cert ".$self->cert." -cert2 ".$self->cert - ." -naccept ".$self->serverconnects; - if ($self->ciphers ne "") { - $execcmd .= " -cipher ".$self->ciphers; - } - if ($self->serverflags ne "") { - $execcmd .= " ".$self->serverflags; - } - if ($self->debug) { - print STDERR "Server command: $execcmd\n"; - } - exec($execcmd); - } - $self->serverpid($pid); - - return $self->clientstart; -} - -sub clientstart -{ - my ($self) = shift; - my $oldstdout; - - if(!$self->debug) { - open DEVNULL, ">", File::Spec->devnull(); - $oldstdout = select(DEVNULL); - } - - # Create the Proxy socket - my $proxaddr = $self->proxy_addr; - $proxaddr =~ s/[\[\]]//g; # Remove [ and ] - my $proxy_sock = $IP_factory->( - LocalHost => $proxaddr, - LocalPort => $self->proxy_port, - Proto => "tcp", - Listen => SOMAXCONN, - ReuseAddr => 1 - ); - - if ($proxy_sock) { - print "Proxy started on port ".$self->proxy_port."\n"; - } else { - warn "Failed creating proxy socket (".$proxaddr.",".$self->proxy_port."): $!\n"; - return 0; - } - - if ($self->execute) { - my $pid = fork(); - if ($pid == 0) { - if (!$self->debug) { - open(STDOUT, ">", File::Spec->devnull()) - or die "Failed to redirect stdout: $!"; - open(STDERR, ">&STDOUT"); - } - my $echostr; - if ($self->reneg()) { - $echostr = "R"; - } else { - $echostr = "test"; - } - my $execcmd = "echo ".$echostr." | ".$self->execute - ." s_client -engine ossltest -connect " - .($self->proxy_addr).":".($self->proxy_port); - if ($self->cipherc ne "") { - $execcmd .= " -cipher ".$self->cipherc; - } - if ($self->clientflags ne "") { - $execcmd .= " ".$self->clientflags; - } - if (defined $self->sessionfile) { - $execcmd .= " -ign_eof"; - } - if ($self->debug) { - print STDERR "Client command: $execcmd\n"; - } - exec($execcmd); - } - $self->clientpid($pid); - } - - # Wait for incoming connection from client - my $client_sock; - if(!($client_sock = $proxy_sock->accept())) { - warn "Failed accepting incoming connection: $!\n"; - return 0; - } - - print "Connection opened\n"; - - # Now connect to the server - my $retry = 10; - my $server_sock; - #We loop over this a few times because sometimes s_server can take a while - #to start up - do { - my $servaddr = $self->server_addr; - $servaddr =~ s/[\[\]]//g; # Remove [ and ] - eval { - $server_sock = $IP_factory->( - PeerAddr => $servaddr, - PeerPort => $self->server_port, - MultiHomed => 1, - Proto => 'tcp' - ); - }; - - $retry--; - #Some buggy IP factories can return a defined server_sock that hasn't - #actually connected, so we check peerport too - if ($@ || !defined($server_sock) || !defined($server_sock->peerport)) { - $server_sock->close() if defined($server_sock); - undef $server_sock; - if ($retry) { - #Sleep for a short while - select(undef, undef, undef, 0.1); - } else { - warn "Failed to start up server (".$servaddr.",".$self->server_port."): $!\n"; - return 0; - } - } - } 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; - my $ctr = 0; - while( (!(TLSProxy::Message->end) - || (defined $self->sessionfile() - && (-s $self->sessionfile()) == 0)) - && $ctr < 10 - && (@ready = $sel->can_read(1))) { - 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); - $ctr = 0; - } elsif ($hand == $client_sock) { - $client_sock->sysread($indata, 16384) or goto END; - $indata = $self->process_packet(0, $indata); - $server_sock->syswrite($indata); - $ctr = 0; - } else { - $ctr++ - } - } - } - - die "No progress made" if $ctr >= 10; - - 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); - } - $self->serverconnects($self->serverconnects - 1); - if ($self->serverconnects == 0) { - die "serverpid is zero\n" if $self->serverpid == 0; - print "Waiting for server process to close: " - .$self->serverpid."\n"; - waitpid( $self->serverpid, 0); - die "exit code $? from server process\n" if $? != 0; - } - die "clientpid is zero\n" if $self->clientpid == 0; - print "Waiting for client process to close: ".$self->clientpid."\n"; - waitpid($self->clientpid, 0); - - return 1; -} - -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]}; - push @{$self->{message_list}}, @{$ret[1]}; - - print "\n"; - - #Finished parsing. Call user provided filter here - if(defined $self->filter) { - $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($server); - } - - $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 success -{ - my $self = shift; - return $self->{success}; -} -sub end -{ - my $self = shift; - return $self->{end}; -} -sub supports_IPv6 -{ - my $self = shift; - return $have_IPv6; -} - -#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}; -} -sub cipherc -{ - my $self = shift; - if (@_) { - $self->{cipherc} = shift; - } - return $self->{cipherc}; -} -sub ciphers -{ - my $self = shift; - if (@_) { - $self->{ciphers} = shift; - } - return $self->{ciphers}; -} -sub serverflags -{ - my $self = shift; - if (@_) { - $self->{serverflags} = shift; - } - return $self->{serverflags}; -} -sub clientflags -{ - my $self = shift; - if (@_) { - $self->{clientflags} = shift; - } - return $self->{clientflags}; -} -sub serverconnects -{ - my $self = shift; - if (@_) { - $self->{serverconnects} = shift; - } - return $self->{serverconnects}; -} -# This is a bit ugly because the caller is responsible for keeping the records -# in sync with the updated message list; simply updating the message list isn't -# sufficient to get the proxy to forward the new message. -# But it does the trick for the one test (test_sslsessiontick) that needs it. -sub message_list -{ - my $self = shift; - if (@_) { - $self->{message_list} = shift; - } - return $self->{message_list}; -} -sub serverpid -{ - my $self = shift; - if (@_) { - $self->{serverpid} = shift; - } - return $self->{serverpid}; -} -sub clientpid -{ - my $self = shift; - if (@_) { - $self->{clientpid} = shift; - } - return $self->{clientpid}; -} - -sub fill_known_data -{ - my $length = shift; - my $ret = ""; - for (my $i = 0; $i < $length; $i++) { - $ret .= chr($i); - } - return $ret; -} - -sub is_tls13 -{ - my $class = shift; - if (@_) { - $is_tls13 = shift; - } - return $is_tls13; -} - -sub reneg -{ - my $self = shift; - if (@_) { - $self->{reneg} = shift; - } - return $self->{reneg}; -} - -#Setting a sessionfile means that the client will not close until the given -#file exists. This is useful in TLSv1.3 where otherwise s_client will close -#immediately at the end of the handshake, but before the session has been -#received from the server. A side effect of this is that s_client never sends -#a close_notify, so instead we consider success to be when it sends application -#data over the connection. -sub sessionfile -{ - my $self = shift; - if (@_) { - $self->{sessionfile} = shift; - TLSProxy::Message->successondata(1); - } - return $self->{sessionfile}; -} - -sub ciphersuite -{ - my $class = shift; - if (@_) { - $ciphersuite = shift; - } - return $ciphersuite; -} - -1; diff --git a/util/TLSProxy/Record.pm b/util/TLSProxy/Record.pm deleted file mode 100644 index 5017c9094c..0000000000 --- a/util/TLSProxy/Record.pm +++ /dev/null @@ -1,398 +0,0 @@ -# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. -# -# Licensed under the OpenSSL license (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 TLSProxy::Proxy; - -package TLSProxy::Record; - -my $server_encrypting = 0; -my $client_encrypting = 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, - RT_UNKNOWN => 100 -}; - -my %record_type = ( - RT_APPLICATION_DATA, "APPLICATION DATA", - RT_HANDSHAKE, "HANDSHAKE", - RT_ALERT, "ALERT", - RT_CCS, "CCS", - RT_UNKNOWN, "UNKNOWN" -); - -use constant { - VERS_TLS_1_4 => 0x0305, - VERS_TLS_1_3_DRAFT => 0x7f15, - VERS_TLS_1_3 => 0x0304, - VERS_TLS_1_2 => 0x0303, - VERS_TLS_1_1 => 0x0302, - VERS_TLS_1_0 => 0x0301, - VERS_SSL_3_0 => 0x0300, - VERS_SSL_LT_3_0 => 0x02ff -}; - -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", - VERS_SSL_LT_3_0, "SSL<3" -); - -#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, - 0, - $len_real, - $decrypt_len, - substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real), - substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real) - ); - - if (($server && $server_encrypting) - || (!$server && $client_encrypting)) { - if (!TLSProxy::Proxy->is_tls13() && $etm) { - $record->decryptETM(); - } else { - $record->decrypt(); - } - $record->encrypted(1); - } - - if (TLSProxy::Proxy->is_tls13()) { - print " Inner content type: " - .$record_type{$record->content_type()}."\n"; - } - - 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_encrypting = 0; - $client_encrypting = 0; -} - -#Class level accessors -sub server_encrypting -{ - my $class = shift; - if (@_) { - $server_encrypting = shift; - } - return $server_encrypting; -} -sub client_encrypting -{ - my $class = shift; - if (@_) { - $client_encrypting= shift; - } - return $client_encrypting; -} -#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, - $sslv2, - $len_real, - $decrypt_len, - $data, - $decrypt_data) = @_; - - my $self = { - flight => $flight, - content_type => $content_type, - version => $version, - len => $len, - sslv2 => $sslv2, - len_real => $len_real, - decrypt_len => $decrypt_len, - data => $data, - decrypt_data => $decrypt_data, - orig_decrypt_data => $decrypt_data, - encrypted => 0, - outer_content_type => RT_APPLICATION_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 $mactaglen = 20; - my $data = $self->data; - - #Throw away any IVs - if (TLSProxy::Proxy->is_tls13()) { - #A TLS1.3 client, when processing the server's initial flight, could - #respond with either an encrypted or an unencrypted alert. - if ($self->content_type() == RT_ALERT) { - #TODO(TLS1.3): Eventually it is sufficient just to check the record - #content type. If an alert is encrypted it will have a record - #content type of application data. However we haven't done the - #record layer changes yet, so it's a bit more complicated. For now - #we will additionally check if the data length is 2 (1 byte for - #alert level, 1 byte for alert description). If it is, then this is - #an unencrypted alert, so don't try to decrypt - return $data if (length($data) == 2); - } - $mactaglen = 16; - } elsif ($self->version >= VERS_TLS_1_1()) { - #16 bytes for a standard IV - $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 or TAG - $data = substr($data, 0, length($data) - $mactaglen); - - if (TLSProxy::Proxy->is_tls13()) { - #Get the content type - my $content_type = unpack("C", substr($data, length($data) - 1)); - $self->content_type($content_type); - $data = substr($data, 0, length($data) - 1); - } - - $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 $server = shift; - my $data; - my $tls13_enc = 0; - - 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 + 1); - $tls13_enc = 1; - } else { - $data = pack('Cnn', $self->content_type, $self->version, - $self->len); - } - - } - $data .= $self->data; - - if ($tls13_enc) { - $data .= pack('C', $self->content_type); - } - - return $data; -} - -#Read only accessors -sub flight -{ - my $self = shift; - return $self->{flight}; -} -sub sslv2 -{ - my $self = shift; - return $self->{sslv2}; -} -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}; -} -sub version -{ - my $self = shift; - if (@_) { - $self->{version} = shift; - } - return $self->{version}; -} -sub content_type -{ - my $self = shift; - if (@_) { - $self->{content_type} = shift; - } - return $self->{content_type}; -} -sub encrypted -{ - my $self = shift; - if (@_) { - $self->{encrypted} = shift; - } - return $self->{encrypted}; -} -sub outer_content_type -{ - my $self = shift; - if (@_) { - $self->{outer_content_type} = shift; - } - return $self->{outer_content_type}; -} -1; diff --git a/util/TLSProxy/ServerHello.pm b/util/TLSProxy/ServerHello.pm deleted file mode 100644 index 1abdd053e1..0000000000 --- a/util/TLSProxy/ServerHello.pm +++ /dev/null @@ -1,234 +0,0 @@ -# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. -# -# Licensed under the OpenSSL license (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::ServerHello; - -use vars '@ISA'; -push @ISA, 'TLSProxy::Message'; - -sub new -{ - my $class = shift; - my ($server, - $data, - $records, - $startoffset, - $message_frag_lens) = @_; - - my $self = $class->SUPER::new( - $server, - TLSProxy::Message::MT_SERVER_HELLO, - $data, - $records, - $startoffset, - $message_frag_lens); - - $self->{server_version} = 0; - $self->{random} = []; - $self->{session_id_len} = 0; - $self->{session} = ""; - $self->{ciphersuite} = 0; - $self->{comp_meth} = 0; - $self->{extension_data} = ""; - - return $self; -} - -sub parse -{ - my $self = shift; - my $ptr = 2; - my ($server_version) = unpack('n', $self->data); - - # TODO(TLS1.3): Replace this reference to draft version before release - if ($server_version == TLSProxy::Record::VERS_TLS_1_3_DRAFT) { - $server_version = TLSProxy::Record::VERS_TLS_1_3; - TLSProxy::Proxy->is_tls13(1); - } - - my $random = substr($self->data, $ptr, 32); - $ptr += 32; - my $session_id_len = 0; - my $session = ""; - if (!TLSProxy::Proxy->is_tls13()) { - $session_id_len = unpack('C', substr($self->data, $ptr)); - $ptr++; - $session = substr($self->data, $ptr, $session_id_len); - $ptr += $session_id_len; - } - my $ciphersuite = unpack('n', substr($self->data, $ptr)); - $ptr += 2; - my $comp_meth = 0; - if (!TLSProxy::Proxy->is_tls13()) { - $comp_meth = unpack('C', substr($self->data, $ptr)); - $ptr++; - } - my $extensions_len = unpack('n', substr($self->data, $ptr)); - if (!defined $extensions_len) { - $extensions_len = 0; - } else { - $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; - if ($extensions_len != 0) { - $extension_data = substr($self->data, $ptr); - - if (length($extension_data) != $extensions_len) { - die "Invalid extension length\n"; - } - } else { - if (length($self->data) != $ptr) { - die "Invalid extension length\n"; - } - $extension_data = ""; - } - 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->server_version($server_version); - $self->random($random); - $self->session_id_len($session_id_len); - $self->session($session); - $self->ciphersuite($ciphersuite); - TLSProxy::Proxy->ciphersuite($ciphersuite); - $self->comp_meth($comp_meth); - $self->extension_data(\%extensions); - - $self->process_data(); - - if (TLSProxy::Proxy->is_tls13()) { - TLSProxy::Record->server_encrypting(1); - TLSProxy::Record->client_encrypting(1); - } - - print " Server Version:".$server_version."\n"; - print " Session ID Len:".$session_id_len."\n"; - print " Ciphersuite:".$ciphersuite."\n"; - print " Compression Method:".$comp_meth."\n"; - print " Extensions Len:".$extensions_len."\n"; -} - -#Perform any actions necessary based on the data we've seen -sub process_data -{ - my $self = shift; - - TLSProxy::Message->ciphersuite($self->ciphersuite); -} - -#Reconstruct the on-the-wire message data following changes -sub set_message_contents -{ - my $self = shift; - my $data; - my $extensions = ""; - - $data = pack('n', $self->server_version); - $data .= $self->random; - if (!TLSProxy::Proxy->is_tls13()) { - $data .= pack('C', $self->session_id_len); - $data .= $self->session; - } - $data .= pack('n', $self->ciphersuite); - if (!TLSProxy::Proxy->is_tls13()) { - $data .= pack('C', $self->comp_meth); - } - - foreach my $key (keys %{$self->extension_data}) { - my $extdata = ${$self->extension_data}{$key}; - $extensions .= pack("n", $key); - $extensions .= pack("n", length($extdata)); - $extensions .= $extdata; - if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) { - $extensions .= pack("n", $key); - $extensions .= pack("n", length($extdata)); - $extensions .= $extdata; - } - } - - $data .= pack('n', length($extensions)); - $data .= $extensions; - $self->data($data); -} - -#Read/write accessors -sub server_version -{ - my $self = shift; - if (@_) { - $self->{server_version} = shift; - } - return $self->{server_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 -{ - my $self = shift; - if (@_) { - $self->{ciphersuite} = shift; - } - return $self->{ciphersuite}; -} -sub comp_meth -{ - my $self = shift; - if (@_) { - $self->{comp_meth} = shift; - } - return $self->{comp_meth}; -} -sub extension_data -{ - my $self = shift; - if (@_) { - $self->{extension_data} = shift; - } - return $self->{extension_data}; -} -sub set_extension -{ - my ($self, $ext_type, $ext_data) = @_; - $self->{extension_data}{$ext_type} = $ext_data; -} -sub delete_extension -{ - my ($self, $ext_type) = @_; - delete $self->{extension_data}{$ext_type}; -} -1; diff --git a/util/TLSProxy/ServerKeyExchange.pm b/util/TLSProxy/ServerKeyExchange.pm deleted file mode 100644 index cb4cc7c762..0000000000 --- a/util/TLSProxy/ServerKeyExchange.pm +++ /dev/null @@ -1,157 +0,0 @@ -# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. -# -# Licensed under the OpenSSL license (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::ServerKeyExchange; - -use vars '@ISA'; -push @ISA, 'TLSProxy::Message'; - -sub new -{ - my $class = shift; - my ($server, - $data, - $records, - $startoffset, - $message_frag_lens) = @_; - - my $self = $class->SUPER::new( - $server, - TLSProxy::Message::MT_SERVER_KEY_EXCHANGE, - $data, - $records, - $startoffset, - $message_frag_lens); - - #DHE - $self->{p} = ""; - $self->{g} = ""; - $self->{pub_key} = ""; - $self->{sigalg} = -1; - $self->{sig} = ""; - - return $self; -} - -sub parse -{ - my $self = shift; - my $sigalg = -1; - - #Minimal SKE parsing. Only supports one known DHE ciphersuite at the moment - return if TLSProxy::Proxy->ciphersuite() - != TLSProxy::Message::CIPHER_ADH_AES_128_SHA - && TLSProxy::Proxy->ciphersuite() - != TLSProxy::Message::CIPHER_DHE_RSA_AES_128_SHA; - - my $p_len = unpack('n', $self->data); - my $ptr = 2; - my $p = substr($self->data, $ptr, $p_len); - $ptr += $p_len; - - my $g_len = unpack('n', substr($self->data, $ptr)); - $ptr += 2; - my $g = substr($self->data, $ptr, $g_len); - $ptr += $g_len; - - my $pub_key_len = unpack('n', substr($self->data, $ptr)); - $ptr += 2; - my $pub_key = substr($self->data, $ptr, $pub_key_len); - $ptr += $pub_key_len; - - #We assume its signed - my $record = ${$self->records}[0]; - - if (TLSProxy::Proxy->is_tls13() - || $record->version() == TLSProxy::Record::VERS_TLS_1_2) { - $sigalg = unpack('n', substr($self->data, $ptr)); - $ptr += 2; - } - my $sig = ""; - if (defined $sigalg) { - my $sig_len = unpack('n', substr($self->data, $ptr)); - if (defined $sig_len) { - $ptr += 2; - $sig = substr($self->data, $ptr, $sig_len); - $ptr += $sig_len; - } - } - - $self->p($p); - $self->g($g); - $self->pub_key($pub_key); - $self->sigalg($sigalg) if defined $sigalg; - $self->signature($sig); -} - - -#Reconstruct the on-the-wire message data following changes -sub set_message_contents -{ - my $self = shift; - my $data; - - $data = pack('n', length($self->p)); - $data .= $self->p; - $data .= pack('n', length($self->g)); - $data .= $self->g; - $data .= pack('n', length($self->pub_key)); - $data .= $self->pub_key; - $data .= pack('n', $self->sigalg) if ($self->sigalg != -1); - if (length($self->signature) > 0) { - $data .= pack('n', length($self->signature)); - $data .= $self->signature; - } - - $self->data($data); -} - -#Read/write accessors -#DHE -sub p -{ - my $self = shift; - if (@_) { - $self->{p} = shift; - } - return $self->{p}; -} -sub g -{ - my $self = shift; - if (@_) { - $self->{g} = shift; - } - return $self->{g}; -} -sub pub_key -{ - my $self = shift; - if (@_) { - $self->{pub_key} = shift; - } - return $self->{pub_key}; -} -sub sigalg -{ - my $self = shift; - if (@_) { - $self->{sigalg} = shift; - } - return $self->{sigalg}; -} -sub signature -{ - my $self = shift; - if (@_) { - $self->{sig} = shift; - } - return $self->{sig}; -} -1; diff --git a/util/dofile.pl b/util/dofile.pl index 0d05574667..36827e350a 100644 --- a/util/dofile.pl +++ b/util/dofile.pl @@ -14,6 +14,7 @@ use strict; use warnings; +use FindBin; use Getopt::Std; # We actually expect to get the following hash tables from configdata: @@ -38,7 +39,7 @@ package OpenSSL::Template; # a fallback in case it's not installed on the system use File::Basename; use File::Spec::Functions; -use lib catdir(dirname(__FILE__)); +use lib "$FindBin::Bin/perl"; use with_fallback qw(Text::Template); #use parent qw/Text::Template/; @@ -175,7 +176,10 @@ my $text = # Load the full template (combination of files) into Text::Template # and fill it up with our data. Output goes directly to STDOUT -my $template = OpenSSL::Template->new(TYPE => 'STRING', SOURCE => $text ); +my $template = + OpenSSL::Template->new(TYPE => 'STRING', + SOURCE => $text, + PREPEND => qq{use lib "$FindBin::Bin/perl";}); sub output_reset_on { $template->output_reset_on(); diff --git a/util/perl/OpenSSL/Test.pm b/util/perl/OpenSSL/Test.pm new file mode 100644 index 0000000000..f8fcbe906d --- /dev/null +++ b/util/perl/OpenSSL/Test.pm @@ -0,0 +1,1168 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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 + +package OpenSSL::Test; + +use strict; +use warnings; + +use Test::More 0.96; + +use Exporter; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +$VERSION = "0.8"; +@ISA = qw(Exporter); +@EXPORT = (@Test::More::EXPORT, qw(setup run indir cmd app fuzz test + perlapp perltest subtest)); +@EXPORT_OK = (@Test::More::EXPORT_OK, qw(bldtop_dir bldtop_file + srctop_dir srctop_file + data_file + pipe with cmdstr quotify)); + +=head1 NAME + +OpenSSL::Test - a private extension of Test::More + +=head1 SYNOPSIS + + use OpenSSL::Test; + + setup("my_test_name"); + + ok(run(app(["openssl", "version"])), "check for openssl presence"); + + indir "subdir" => sub { + ok(run(test(["sometest", "arg1"], stdout => "foo.txt")), + "run sometest with output to foo.txt"); + }; + +=head1 DESCRIPTION + +This module is a private extension of L for testing OpenSSL. +In addition to the Test::More functions, it also provides functions that +easily find the diverse programs within a OpenSSL build tree, as well as +some other useful functions. + +This module I on the environment variables C<$TOP> or C<$SRCTOP> +and C<$BLDTOP>. Without one of the combinations it refuses to work. +See L below. + +With each test recipe, a parallel data directory with (almost) the same name +as the recipe is possible in the source directory tree. For example, for a +recipe C<$SRCTOP/test/recipes/99-foo.t>, there could be a directory +C<$SRCTOP/test/recipes/99-foo_data/>. + +=cut + +use File::Copy; +use File::Spec::Functions qw/file_name_is_absolute curdir canonpath splitdir + catdir catfile splitpath catpath devnull abs2rel + rel2abs/; +use File::Path 2.00 qw/rmtree mkpath/; +use File::Basename; + +my $level = 0; + +# The name of the test. This is set by setup() and is used in the other +# functions to verify that setup() has been used. +my $test_name = undef; + +# Directories we want to keep track of TOP, APPS, TEST and RESULTS are the +# ones we're interested in, corresponding to the environment variables TOP +# (mandatory), BIN_D, TEST_D, UTIL_D and RESULT_D. +my %directories = (); + +# The environment variables that gave us the contents in %directories. These +# get modified whenever we change directories, so that subprocesses can use +# the values of those environment variables as well +my @direnv = (); + +# A bool saying if we shall stop all testing if the current recipe has failing +# tests or not. This is set by setup() if the environment variable STOPTEST +# is defined with a non-empty value. +my $end_with_bailout = 0; + +# A set of hooks that is affected by with() and may be used in diverse places. +# All hooks are expected to be CODE references. +my %hooks = ( + + # exit_checker is used by run() directly after completion of a command. + # it receives the exit code from that command and is expected to return + # 1 (for success) or 0 (for failure). This is the status value that run() + # will give back (through the |statusvar| referens and as returned value + # when capture => 1 doesn't apply). + exit_checker => sub { return shift == 0 ? 1 : 0 }, + + ); + +# Debug flag, to be set manually when needed +my $debug = 0; + +=head2 Main functions + +The following functions are exported by default when using C. + +=cut + +=over 4 + +=item B + +C is used for initial setup, and it is mandatory that it's used. +If it's not used in a OpenSSL test recipe, the rest of the recipe will +most likely refuse to run. + +C checks for environment variables (see L below), +checks that C<$TOP/Configure> or C<$SRCTOP/Configure> exists, C +into the results directory (defined by the C<$RESULT_D> environment +variable if defined, otherwise C<$BLDTOP/test> or C<$TOP/test>, whichever +is defined). + +=back + +=cut + +sub setup { + my $old_test_name = $test_name; + $test_name = shift; + + BAIL_OUT("setup() must receive a name") unless $test_name; + warn "setup() detected test name change. Innocuous, so we continue...\n" + if $old_test_name && $old_test_name ne $test_name; + + return if $old_test_name; + + BAIL_OUT("setup() needs \$TOP or \$SRCTOP and \$BLDTOP to be defined") + unless $ENV{TOP} || ($ENV{SRCTOP} && $ENV{BLDTOP}); + BAIL_OUT("setup() found both \$TOP and \$SRCTOP or \$BLDTOP...") + if $ENV{TOP} && ($ENV{SRCTOP} || $ENV{BLDTOP}); + + __env(); + + BAIL_OUT("setup() expects the file Configure in the source top directory") + unless -f srctop_file("Configure"); + + __cwd($directories{RESULTS}); +} + +=over 4 + +=item B sub BLOCK, OPTS> + +C is used to run a part of the recipe in a different directory than +the one C moved into, usually a subdirectory, given by SUBDIR. +The part of the recipe that's run there is given by the codeblock BLOCK. + +C takes some additional options OPTS that affect the subdirectory: + +=over 4 + +=item B 0|1> + +When set to 1 (or any value that perl preceives as true), the subdirectory +will be created if it doesn't already exist. This happens before BLOCK +is executed. + +=item B 0|1> + +When set to 1 (or any value that perl preceives as true), the subdirectory +will be cleaned out and removed. This happens both before and after BLOCK +is executed. + +=back + +An example: + + indir "foo" => sub { + ok(run(app(["openssl", "version"]), stdout => "foo.txt")); + if (ok(open(RESULT, "foo.txt"), "reading foo.txt")) { + my $line = ; + close RESULT; + is($line, qr/^OpenSSL 1\./, + "check that we're using OpenSSL 1.x.x"); + } + }, create => 1, cleanup => 1; + +=back + +=cut + +sub indir { + my $subdir = shift; + my $codeblock = shift; + my %opts = @_; + + my $reverse = __cwd($subdir,%opts); + BAIL_OUT("FAILURE: indir, \"$subdir\" wasn't possible to move into") + unless $reverse; + + $codeblock->(); + + __cwd($reverse); + + if ($opts{cleanup}) { + rmtree($subdir, { safe => 0 }); + } +} + +=over 4 + +=item B + +This functions build up a platform dependent command based on the +input. It takes a reference to a list that is the executable or +script and its arguments, and some additional options (described +further on). Where necessary, the command will be wrapped in a +suitable environment to make sure the correct shared libraries are +used (currently only on Unix). + +It returns a CODEREF to be used by C, C or C. + +The options that C can take are in the form of hash values: + +=over 4 + +=item B PATH> + +=item B PATH> + +=item B PATH> + +In all three cases, the corresponding standard input, output or error is +redirected from (for stdin) or to (for the others) a file given by the +string PATH, I, if the value is C, C or similar. + +=back + +=item B + +=item B + +Both of these are specific applications of C, with just a couple +of small difference: + +C expects to find the given command (the first item in the given list +reference) as an executable in C<$BIN_D> (if defined, otherwise C<$TOP/apps> +or C<$BLDTOP/apps>). + +C expects to find the given command (the first item in the given list +reference) as an executable in C<$TEST_D> (if defined, otherwise C<$TOP/test> +or C<$BLDTOP/test>). + +Also, for both C and C, the command may be prefixed with +the content of the environment variable C<$EXE_SHELL>, which is useful +in case OpenSSL has been cross compiled. + +=item B + +=item B + +These are also specific applications of C, where the interpreter +is predefined to be C, and they expect the script to be +interpreted to reside in the same location as C and C. + +C and C will also take the following option: + +=over 4 + +=item B ARRAYref> + +The array reference is a set of arguments for the interpreter rather +than the script. Take care so that none of them can be seen as a +script! Flags and their eventual arguments only! + +=back + +An example: + + ok(run(perlapp(["foo.pl", "arg1"], + interpreter_args => [ "-I", srctop_dir("test") ]))); + +=back + +=begin comment + +One might wonder over the complexity of C, C, C, ... +with all the lazy evaluations and all that. The reason for this is that +we want to make sure the directory in which those programs are found are +correct at the time these commands are used. Consider the following code +snippet: + + my $cmd = app(["openssl", ...]); + + indir "foo", sub { + ok(run($cmd), "Testing foo") + }; + +If there wasn't this lazy evaluation, the directory where C is +found would be incorrect at the time C is called, because it was +calculated before we moved into the directory "foo". + +=end comment + +=cut + +sub cmd { + my $cmd = shift; + my %opts = @_; + return sub { + my $num = shift; + # Make a copy to not destroy the caller's array + my @cmdargs = ( @$cmd ); + my @prog = __wrap_cmd(shift @cmdargs, $opts{exe_shell} // ()); + + return __decorate_cmd($num, [ @prog, quotify(@cmdargs) ], + %opts); + } +} + +sub app { + my $cmd = shift; + my %opts = @_; + return sub { + my @cmdargs = ( @{$cmd} ); + my @prog = __fixup_prg(__apps_file(shift @cmdargs, __exeext())); + return cmd([ @prog, @cmdargs ], + exe_shell => $ENV{EXE_SHELL}, %opts) -> (shift); + } +} + +sub fuzz { + my $cmd = shift; + my %opts = @_; + return sub { + my @cmdargs = ( @{$cmd} ); + my @prog = __fixup_prg(__fuzz_file(shift @cmdargs, __exeext())); + return cmd([ @prog, @cmdargs ], + exe_shell => $ENV{EXE_SHELL}, %opts) -> (shift); + } +} + +sub test { + my $cmd = shift; + my %opts = @_; + return sub { + my @cmdargs = ( @{$cmd} ); + my @prog = __fixup_prg(__test_file(shift @cmdargs, __exeext())); + return cmd([ @prog, @cmdargs ], + exe_shell => $ENV{EXE_SHELL}, %opts) -> (shift); + } +} + +sub perlapp { + my $cmd = shift; + my %opts = @_; + return sub { + my @interpreter_args = defined $opts{interpreter_args} ? + @{$opts{interpreter_args}} : (); + my @interpreter = __fixup_prg($^X); + my @cmdargs = ( @{$cmd} ); + my @prog = __apps_file(shift @cmdargs, undef); + return cmd([ @interpreter, @interpreter_args, + @prog, @cmdargs ], %opts) -> (shift); + } +} + +sub perltest { + my $cmd = shift; + my %opts = @_; + return sub { + my @interpreter_args = defined $opts{interpreter_args} ? + @{$opts{interpreter_args}} : (); + my @interpreter = __fixup_prg($^X); + my @cmdargs = ( @{$cmd} ); + my @prog = __test_file(shift @cmdargs, undef); + return cmd([ @interpreter, @interpreter_args, + @prog, @cmdargs ], %opts) -> (shift); + } +} + +=over 4 + +=item B + +CODEREF is expected to be the value return by C or any of its +derivatives, anything else will most likely cause an error unless you +know what you're doing. + +C executes the command returned by CODEREF and return either the +resulting output (if the option C is set true) or a boolean +indicating if the command succeeded or not. + +The options that C can take are in the form of hash values: + +=over 4 + +=item B 0|1> + +If true, the command will be executed with a perl backtick, and C will +return the resulting output as an array of lines. If false or not given, +the command will be executed with C, and C will return 1 if +the command was successful or 0 if it wasn't. + +=item B EXPR> + +If specified, EXPR will be used as a string to prefix the output from the +command. This is useful if the output contains lines starting with C +or C that can disturb Test::Harness. + +=item B VARREF> + +If used, B must be a reference to a scalar variable. It will be +assigned a boolean indicating if the command succeeded or not. This is +particularly useful together with B. + +=back + +For further discussion on what is considered a successful command or not, see +the function C further down. + +=back + +=cut + +sub run { + my ($cmd, $display_cmd) = shift->(0); + my %opts = @_; + + return () if !$cmd; + + my $prefix = ""; + if ( $^O eq "VMS" ) { # VMS + $prefix = "pipe "; + } + + my @r = (); + my $r = 0; + my $e = 0; + + die "OpenSSL::Test::run(): statusvar value not a scalar reference" + if $opts{statusvar} && ref($opts{statusvar}) ne "SCALAR"; + + # In non-verbose, we want to shut up the command interpreter, in case + # it has something to complain about. On VMS, it might complain both + # on stdout and stderr + my $save_STDOUT; + my $save_STDERR; + if ($ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_VERBOSE}) { + open $save_STDOUT, '>&', \*STDOUT or die "Can't dup STDOUT: $!"; + open $save_STDERR, '>&', \*STDERR or die "Can't dup STDERR: $!"; + open STDOUT, ">", devnull(); + open STDERR, ">", devnull(); + } + + $ENV{HARNESS_OSSL_LEVEL} = $level + 1; + + # The dance we do with $? is the same dance the Unix shells appear to + # do. For example, a program that gets aborted (and therefore signals + # SIGABRT = 6) will appear to exit with the code 134. We mimic this + # to make it easier to compare with a manual run of the command. + if ($opts{capture} || defined($opts{prefix})) { + my $pipe; + local $_; + + open($pipe, '-|', "$prefix$cmd") or die "Can't start command: $!"; + while(<$pipe>) { + my $l = ($opts{prefix} // "") . $_; + if ($opts{capture}) { + push @r, $l; + } else { + print STDOUT $l; + } + } + close $pipe; + } else { + system("$prefix$cmd"); + } + $e = ($? & 0x7f) ? ($? & 0x7f)|0x80 : ($? >> 8); + $r = $hooks{exit_checker}->($e); + if ($opts{statusvar}) { + ${$opts{statusvar}} = $r; + } + + if ($ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_VERBOSE}) { + close STDOUT; + close STDERR; + open STDOUT, '>&', $save_STDOUT or die "Can't restore STDOUT: $!"; + open STDERR, '>&', $save_STDERR or die "Can't restore STDERR: $!"; + } + + print STDERR "$prefix$display_cmd => $e\n" + if !$ENV{HARNESS_ACTIVE} || $ENV{HARNESS_VERBOSE}; + + # At this point, $? stops being interesting, and unfortunately, + # there are Test::More versions that get picky if we leave it + # non-zero. + $? = 0; + + if ($opts{capture}) { + return @r; + } else { + return $r; + } +} + +END { + my $tb = Test::More->builder; + my $failure = scalar(grep { $_ == 0; } $tb->summary); + if ($failure && $end_with_bailout) { + BAIL_OUT("Stoptest!"); + } +} + +=head2 Utility functions + +The following functions are exported on request when using C. + + # To only get the bldtop_file and srctop_file functions. + use OpenSSL::Test qw/bldtop_file srctop_file/; + + # To only get the bldtop_file function in addition to the default ones. + use OpenSSL::Test qw/:DEFAULT bldtop_file/; + +=cut + +# Utility functions, exported on request + +=over 4 + +=item B + +LIST is a list of directories that make up a path from the top of the OpenSSL +build directory (as indicated by the environment variable C<$TOP> or +C<$BLDTOP>). +C returns the resulting directory as a string, adapted to the local +operating system. + +=back + +=cut + +sub bldtop_dir { + return __bldtop_dir(@_); # This caters for operating systems that have + # a very distinct syntax for directories. +} + +=over 4 + +=item B + +LIST is a list of directories that make up a path from the top of the OpenSSL +build directory (as indicated by the environment variable C<$TOP> or +C<$BLDTOP>) and FILENAME is the name of a file located in that directory path. +C returns the resulting file path as a string, adapted to the local +operating system. + +=back + +=cut + +sub bldtop_file { + return __bldtop_file(@_); +} + +=over 4 + +=item B + +LIST is a list of directories that make up a path from the top of the OpenSSL +source directory (as indicated by the environment variable C<$TOP> or +C<$SRCTOP>). +C returns the resulting directory as a string, adapted to the local +operating system. + +=back + +=cut + +sub srctop_dir { + return __srctop_dir(@_); # This caters for operating systems that have + # a very distinct syntax for directories. +} + +=over 4 + +=item B + +LIST is a list of directories that make up a path from the top of the OpenSSL +source directory (as indicated by the environment variable C<$TOP> or +C<$SRCTOP>) and FILENAME is the name of a file located in that directory path. +C returns the resulting file path as a string, adapted to the local +operating system. + +=back + +=cut + +sub srctop_file { + return __srctop_file(@_); +} + +=over 4 + +=item B + +LIST is a list of directories that make up a path from the data directory +associated with the test (see L above) and FILENAME is the name +of a file located in that directory path. C returns the resulting +file path as a string, adapted to the local operating system. + +=back + +=cut + +sub data_file { + return __data_file(@_); +} + +=over 4 + +=item B + +LIST is a list of CODEREFs returned by C or C, from which C +creates a new command composed of all the given commands put together in a +pipe. C returns a new CODEREF in the same manner as C or C, +to be passed to C for execution. + +=back + +=cut + +sub pipe { + my @cmds = @_; + return + sub { + my @cs = (); + my @dcs = (); + my @els = (); + my $counter = 0; + foreach (@cmds) { + my ($c, $dc, @el) = $_->(++$counter); + + return () if !$c; + + push @cs, $c; + push @dcs, $dc; + push @els, @el; + } + return ( + join(" | ", @cs), + join(" | ", @dcs), + @els + ); + }; +} + +=over 4 + +=item B + +C will temporarly install hooks given by the HASHREF and then execute +the given CODEREF. Hooks are usually expected to have a coderef as value. + +The currently available hoosk are: + +=over 4 + +=item B CODEREF> + +This hook is executed after C has performed its given command. The +CODEREF receives the exit code as only argument and is expected to return +1 (if the exit code indicated success) or 0 (if the exit code indicated +failure). + +=back + +=back + +=cut + +sub with { + my $opts = shift; + my %opts = %{$opts}; + my $codeblock = shift; + + my %saved_hooks = (); + + foreach (keys %opts) { + $saved_hooks{$_} = $hooks{$_} if exists($hooks{$_}); + $hooks{$_} = $opts{$_}; + } + + $codeblock->(); + + foreach (keys %saved_hooks) { + $hooks{$_} = $saved_hooks{$_}; + } +} + +=over 4 + +=item B + +C takes a CODEREF from C or C and simply returns the +command as a string. + +C takes some additiona options OPTS that affect the string returned: + +=over 4 + +=item B 0|1> + +When set to 0, the returned string will be with all decorations, such as a +possible redirect of stderr to the null device. This is suitable if the +string is to be used directly in a recipe. + +When set to 1, the returned string will be without extra decorations. This +is suitable for display if that is desired (doesn't confuse people with all +internal stuff), or if it's used to pass a command down to a subprocess. + +Default: 0 + +=back + +=back + +=cut + +sub cmdstr { + my ($cmd, $display_cmd) = shift->(0); + my %opts = @_; + + if ($opts{display}) { + return $display_cmd; + } else { + return $cmd; + } +} + +=over 4 + +=item B + +LIST is a list of strings that are going to be used as arguments for a +command, and makes sure to inject quotes and escapes as necessary depending +on the content of each string. + +This can also be used to put quotes around the executable of a command. +I + +=back + +=cut + +sub quotify { + # Unix setup (default if nothing else is mentioned) + my $arg_formatter = + sub { $_ = shift; /\s|[\{\}\\\$\[\]\*\?\|\&:;<>]/ ? "'$_'" : $_ }; + + if ( $^O eq "VMS") { # VMS setup + $arg_formatter = sub { + $_ = shift; + if (/\s|["[:upper:]]/) { + s/"/""/g; + '"'.$_.'"'; + } else { + $_; + } + }; + } elsif ( $^O eq "MSWin32") { # MSWin setup + $arg_formatter = sub { + $_ = shift; + if (/\s|["\|\&\*\;<>]/) { + s/(["\\])/\\$1/g; + '"'.$_.'"'; + } else { + $_; + } + }; + } + + return map { $arg_formatter->($_) } @_; +} + +###################################################################### +# private functions. These are never exported. + +=head1 ENVIRONMENT + +OpenSSL::Test depends on some environment variables. + +=over 4 + +=item B + +This environment variable is mandatory. C will check that it's +defined and that it's a directory that contains the file C. +If this isn't so, C will C. + +=item B + +If defined, its value should be the directory where the openssl application +is located. Defaults to C<$TOP/apps> (adapted to the operating system). + +=item B + +If defined, its value should be the directory where the test applications +are located. Defaults to C<$TOP/test> (adapted to the operating system). + +=item B + +If defined, it puts testing in a different mode, where a recipe with +failures will result in a C at the end of its run. + +=back + +=cut + +sub __env { + (my $recipe_datadir = basename($0)) =~ s/\.t$/_data/i; + + $directories{SRCTOP} = $ENV{SRCTOP} || $ENV{TOP}; + $directories{BLDTOP} = $ENV{BLDTOP} || $ENV{TOP}; + $directories{BLDAPPS} = $ENV{BIN_D} || __bldtop_dir("apps"); + $directories{SRCAPPS} = __srctop_dir("apps"); + $directories{BLDFUZZ} = __bldtop_dir("fuzz"); + $directories{SRCFUZZ} = __srctop_dir("fuzz"); + $directories{BLDTEST} = $ENV{TEST_D} || __bldtop_dir("test"); + $directories{SRCTEST} = __srctop_dir("test"); + $directories{SRCDATA} = __srctop_dir("test", "recipes", + $recipe_datadir); + $directories{RESULTS} = $ENV{RESULT_D} || $directories{BLDTEST}; + + push @direnv, "TOP" if $ENV{TOP}; + push @direnv, "SRCTOP" if $ENV{SRCTOP}; + push @direnv, "BLDTOP" if $ENV{BLDTOP}; + push @direnv, "BIN_D" if $ENV{BIN_D}; + push @direnv, "TEST_D" if $ENV{TEST_D}; + push @direnv, "RESULT_D" if $ENV{RESULT_D}; + + $end_with_bailout = $ENV{STOPTEST} ? 1 : 0; +}; + +# __srctop_file and __srctop_dir are helpers to build file and directory +# names on top of the source directory. They depend on $SRCTOP, and +# therefore on the proper use of setup() and when needed, indir(). +# __bldtop_file and __bldtop_dir do the same thing but relative to $BLDTOP. +# __srctop_file and __bldtop_file take the same kind of argument as +# File::Spec::Functions::catfile. +# Similarly, __srctop_dir and __bldtop_dir take the same kind of argument +# as File::Spec::Functions::catdir +sub __srctop_file { + BAIL_OUT("Must run setup() first") if (! $test_name); + + my $f = pop; + return catfile($directories{SRCTOP},@_,$f); +} + +sub __srctop_dir { + BAIL_OUT("Must run setup() first") if (! $test_name); + + return catdir($directories{SRCTOP},@_); +} + +sub __bldtop_file { + BAIL_OUT("Must run setup() first") if (! $test_name); + + my $f = pop; + return catfile($directories{BLDTOP},@_,$f); +} + +sub __bldtop_dir { + BAIL_OUT("Must run setup() first") if (! $test_name); + + return catdir($directories{BLDTOP},@_); +} + +# __exeext is a function that returns the platform dependent file extension +# for executable binaries, or the value of the environment variable $EXE_EXT +# if that one is defined. +sub __exeext { + my $ext = ""; + if ($^O eq "VMS" ) { # VMS + $ext = ".exe"; + } elsif ($^O eq "MSWin32") { # Windows + $ext = ".exe"; + } + return $ENV{"EXE_EXT"} || $ext; +} + +# __test_file, __apps_file and __fuzz_file return the full path to a file +# relative to the test/, apps/ or fuzz/ directory in the build tree or the +# source tree, depending on where the file is found. Note that when looking +# in the build tree, the file name with an added extension is looked for, if +# an extension is given. The intent is to look for executable binaries (in +# the build tree) or possibly scripts (in the source tree). +# These functions all take the same arguments as File::Spec::Functions::catfile, +# *plus* a mandatory extension argument. This extension argument can be undef, +# and is ignored in such a case. +sub __test_file { + BAIL_OUT("Must run setup() first") if (! $test_name); + + my $e = pop || ""; + my $f = pop; + $f = catfile($directories{BLDTEST},@_,$f . $e); + $f = catfile($directories{SRCTEST},@_,$f) unless -f $f; + return $f; +} + +sub __apps_file { + BAIL_OUT("Must run setup() first") if (! $test_name); + + my $e = pop || ""; + my $f = pop; + $f = catfile($directories{BLDAPPS},@_,$f . $e); + $f = catfile($directories{SRCAPPS},@_,$f) unless -f $f; + return $f; +} + +sub __fuzz_file { + BAIL_OUT("Must run setup() first") if (! $test_name); + + my $e = pop || ""; + my $f = pop; + $f = catfile($directories{BLDFUZZ},@_,$f . $e); + $f = catfile($directories{SRCFUZZ},@_,$f) unless -f $f; + return $f; +} + +sub __data_file { + BAIL_OUT("Must run setup() first") if (! $test_name); + + my $f = pop; + return catfile($directories{SRCDATA},@_,$f); +} + +sub __results_file { + BAIL_OUT("Must run setup() first") if (! $test_name); + + my $f = pop; + return catfile($directories{RESULTS},@_,$f); +} + +# __cwd DIR +# __cwd DIR, OPTS +# +# __cwd changes directory to DIR (string) and changes all the relative +# entries in %directories accordingly. OPTS is an optional series of +# hash style arguments to alter __cwd's behavior: +# +# create = 0|1 The directory we move to is created if 1, not if 0. +# cleanup = 0|1 The directory we move from is removed if 1, not if 0. + +sub __cwd { + my $dir = catdir(shift); + my %opts = @_; + my $abscurdir = rel2abs(curdir()); + my $absdir = rel2abs($dir); + my $reverse = abs2rel($abscurdir, $absdir); + + # PARANOIA: if we're not moving anywhere, we do nothing more + if ($abscurdir eq $absdir) { + return $reverse; + } + + # Do not support a move to a different volume for now. Maybe later. + BAIL_OUT("FAILURE: \"$dir\" moves to a different volume, not supported") + if $reverse eq $abscurdir; + + # If someone happened to give a directory that leads back to the current, + # it's extremely silly to do anything more, so just simulate that we did + # move. + # In this case, we won't even clean it out, for safety's sake. + return "." if $reverse eq ""; + + $dir = canonpath($dir); + if ($opts{create}) { + mkpath($dir); + } + + # We are recalculating the directories we keep track of, but need to save + # away the result for after having moved into the new directory. + my %tmp_directories = (); + my %tmp_ENV = (); + + # For each of these directory variables, figure out where they are relative + # to the directory we want to move to if they aren't absolute (if they are, + # they don't change!) + my @dirtags = sort keys %directories; + foreach (@dirtags) { + if (!file_name_is_absolute($directories{$_})) { + my $newpath = abs2rel(rel2abs($directories{$_}), rel2abs($dir)); + $tmp_directories{$_} = $newpath; + } + } + + # Treat each environment variable that was used to get us the values in + # %directories the same was as the paths in %directories, so any sub + # process can use their values properly as well + foreach (@direnv) { + if (!file_name_is_absolute($ENV{$_})) { + my $newpath = abs2rel(rel2abs($ENV{$_}), rel2abs($dir)); + $tmp_ENV{$_} = $newpath; + } + } + + # Should we just bail out here as well? I'm unsure. + return undef unless chdir($dir); + + if ($opts{cleanup}) { + rmtree(".", { safe => 0, keep_root => 1 }); + } + + # We put back new values carefully. Doing the obvious + # %directories = ( %tmp_irectories ) + # will clear out any value that happens to be an absolute path + foreach (keys %tmp_directories) { + $directories{$_} = $tmp_directories{$_}; + } + foreach (keys %tmp_ENV) { + $ENV{$_} = $tmp_ENV{$_}; + } + + if ($debug) { + print STDERR "DEBUG: __cwd(), directories and files:\n"; + print STDERR " \$directories{BLDTEST} = \"$directories{BLDTEST}\"\n"; + print STDERR " \$directories{SRCTEST} = \"$directories{SRCTEST}\"\n"; + print STDERR " \$directories{SRCDATA} = \"$directories{SRCDATA}\"\n"; + print STDERR " \$directories{RESULTS} = \"$directories{RESULTS}\"\n"; + print STDERR " \$directories{BLDAPPS} = \"$directories{BLDAPPS}\"\n"; + print STDERR " \$directories{SRCAPPS} = \"$directories{SRCAPPS}\"\n"; + print STDERR " \$directories{SRCTOP} = \"$directories{SRCTOP}\"\n"; + print STDERR " \$directories{BLDTOP} = \"$directories{BLDTOP}\"\n"; + print STDERR "\n"; + print STDERR " current directory is \"",curdir(),"\"\n"; + print STDERR " the way back is \"$reverse\"\n"; + } + + return $reverse; +} + +# __wrap_cmd CMD +# __wrap_cmd CMD, EXE_SHELL +# +# __wrap_cmd "wraps" CMD (string) with a beginning command that makes sure +# the command gets executed with an appropriate environment. If EXE_SHELL +# is given, it is used as the beginning command. +# +# __wrap_cmd returns a list that should be used to build up a larger list +# of command tokens, or be joined together like this: +# +# join(" ", __wrap_cmd($cmd)) +sub __wrap_cmd { + my $cmd = shift; + my $exe_shell = shift; + + my @prefix = ( __bldtop_file("util", "shlib_wrap.sh") ); + + if(defined($exe_shell)) { + @prefix = ( $exe_shell ); + } elsif ($^O eq "VMS" || $^O eq "MSWin32") { + # VMS and Windows don't use any wrapper script for the moment + @prefix = (); + } + + return (@prefix, $cmd); +} + +# __fixup_prg PROG +# +# __fixup_prg does whatever fixup is needed to execute an executable binary +# given by PROG (string). +# +# __fixup_prg returns a string with the possibly prefixed program path spec. +sub __fixup_prg { + my $prog = shift; + + my $prefix = ""; + + if ($^O eq "VMS" ) { + $prefix = ($prog =~ /^(?:[\$a-z0-9_]+:)?[<\[]/i ? "mcr " : "mcr []"); + } + + # We test if the program to use exists. + if ( ! -x $prog ) { + $prog = undef; + } + + if (defined($prog)) { + # Make sure to quotify the program file on platforms that may + # have spaces or similar in their path name. + # To our knowledge, VMS is the exception where quotifying should + # never happen. + ($prog) = quotify($prog) unless $^O eq "VMS"; + return $prefix.$prog; + } + + print STDERR "$prog not found\n"; + return undef; +} + +# __decorate_cmd NUM, CMDARRAYREF +# +# __decorate_cmd takes a command number NUM and a command token array +# CMDARRAYREF, builds up a command string from them and decorates it +# with necessary redirections. +# __decorate_cmd returns a list of two strings, one with the command +# string to actually be used, the other to be displayed for the user. +# The reason these strings might differ is that we redirect stderr to +# the null device unless we're verbose and unless the user has +# explicitly specified a stderr redirection. +sub __decorate_cmd { + BAIL_OUT("Must run setup() first") if (! $test_name); + + my $num = shift; + my $cmd = shift; + my %opts = @_; + + my $cmdstr = join(" ", @$cmd); + my $null = devnull(); + my $fileornull = sub { $_[0] ? $_[0] : $null; }; + my $stdin = ""; + my $stdout = ""; + my $stderr = ""; + my $saved_stderr = undef; + $stdin = " < ".$fileornull->($opts{stdin}) if exists($opts{stdin}); + $stdout= " > ".$fileornull->($opts{stdout}) if exists($opts{stdout}); + $stderr=" 2> ".$fileornull->($opts{stderr}) if exists($opts{stderr}); + + my $display_cmd = "$cmdstr$stdin$stdout$stderr"; + + $stderr=" 2> ".$null + unless $stderr || !$ENV{HARNESS_ACTIVE} || $ENV{HARNESS_VERBOSE}; + + $cmdstr .= "$stdin$stdout$stderr"; + + if ($debug) { + print STDERR "DEBUG[__decorate_cmd]: \$cmdstr = \"$cmdstr\"\n"; + print STDERR "DEBUG[__decorate_cmd]: \$display_cmd = \"$display_cmd\"\n"; + } + + return ($cmdstr, $display_cmd); +} + +=head1 SEE ALSO + +L, L + +=head1 AUTHORS + +Richard Levitte Elevitte@openssl.orgE with assitance and +inspiration from Andy Polyakov Eappro@openssl.org. + +=cut + +no warnings 'redefine'; +sub subtest { + $level++; + + Test::More::subtest @_; + + $level--; +}; + +1; diff --git a/util/perl/OpenSSL/Test/Simple.pm b/util/perl/OpenSSL/Test/Simple.pm new file mode 100644 index 0000000000..c5a84d5ca3 --- /dev/null +++ b/util/perl/OpenSSL/Test/Simple.pm @@ -0,0 +1,91 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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 + +package OpenSSL::Test::Simple; + +use strict; +use warnings; + +use Exporter; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +$VERSION = "0.2"; +@ISA = qw(Exporter); +@EXPORT = qw(simple_test); + +=head1 NAME + +OpenSSL::Test::Simple - a few very simple test functions + +=head1 SYNOPSIS + + use OpenSSL::Test::Simple; + + simple_test("my_test_name", "destest", "des"); + +=head1 DESCRIPTION + +Sometimes, the functions in L are quite tedious for some +repetitive tasks. This module provides functions to make life easier. +You could call them hacks if you wish. + +=cut + +use OpenSSL::Test; +use OpenSSL::Test::Utils; + +=over 4 + +=item B + +Runs a test named NAME, running the program PROGRAM with no arguments, +to test the algorithm ALGORITHM. + +A complete recipe looks like this: + + use OpenSSL::Test::Simple; + + simple_test("test_bf", "bftest", "bf"); + +=back + +=cut + +# args: +# name (used with setup()) +# algorithm (used to check if it's at all supported) +# name of binary (the program that does the actual test) +sub simple_test { + my ($name, $prgr, @algos) = @_; + + setup($name); + + if (scalar(disabled(@algos))) { + if (scalar(@algos) == 1) { + plan skip_all => $algos[0]." is not supported by this OpenSSL build"; + } else { + my $last = pop @algos; + plan skip_all => join(", ", @algos)." and $last are not supported by this OpenSSL build"; + } + } + + plan tests => 1; + + ok(run(test([$prgr])), "running $prgr"); +} + +=head1 SEE ALSO + +L + +=head1 AUTHORS + +Richard Levitte Elevitte@openssl.orgE with inspiration +from Rich Salz Ersalz@openssl.orgE. + +=cut + +1; diff --git a/util/perl/OpenSSL/Test/Utils.pm b/util/perl/OpenSSL/Test/Utils.pm new file mode 100644 index 0000000000..665bfc6310 --- /dev/null +++ b/util/perl/OpenSSL/Test/Utils.pm @@ -0,0 +1,239 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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 + +package OpenSSL::Test::Utils; + +use strict; +use warnings; + +use Exporter; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); +$VERSION = "0.1"; +@ISA = qw(Exporter); +@EXPORT = qw(alldisabled anydisabled disabled config available_protocols + have_IPv4 have_IPv6); + +=head1 NAME + +OpenSSL::Test::Utils - test utility functions + +=head1 SYNOPSIS + + use OpenSSL::Test::Utils; + + my @tls = available_protocols("tls"); + my @dtls = available_protocols("dtls"); + alldisabled("dh", "dsa"); + anydisabled("dh", "dsa"); + + config("fips"); + + have_IPv4(); + have_IPv6(); + +=head1 DESCRIPTION + +This module provides utility functions for the testing framework. + +=cut + +use OpenSSL::Test qw/:DEFAULT bldtop_file/; + +=over 4 + +=item B + +Returns a list of strings for all the available SSL/TLS versions if +STRING is "tls", or for all the available DTLS versions if STRING is +"dtls". Otherwise, it returns the empty list. The strings in the +returned list can be used with B and B. + +=item B +=item B + +In an array context returns an array with each element set to 1 if the +corresponding feature is disabled and 0 otherwise. + +In a scalar context, alldisabled returns 1 if all of the features in +ARRAY are disabled, while anydisabled returns 1 if any of them are +disabled. + +=item B + +Returns an item from the %config hash in \$TOP/configdata.pm. + +=item B +=item B + +Return true if IPv4 / IPv6 is possible to use on the current system. + +=back + +=cut + +our %available_protocols; +our %disabled; +our %config; +my $configdata_loaded = 0; + +sub load_configdata { + # We eval it so it doesn't run at compile time of this file. + # The latter would have bldtop_file() complain that setup() hasn't + # been run yet. + my $configdata = bldtop_file("configdata.pm"); + eval { require $configdata; + %available_protocols = %configdata::available_protocols; + %disabled = %configdata::disabled; + %config = %configdata::config; + }; + $configdata_loaded = 1; +} + +# args +# list of 1s and 0s, coming from check_disabled() +sub anyof { + my $x = 0; + foreach (@_) { $x += $_ } + return $x > 0; +} + +# args +# list of 1s and 0s, coming from check_disabled() +sub allof { + my $x = 1; + foreach (@_) { $x *= $_ } + return $x > 0; +} + +# args +# list of strings, all of them should be names of features +# that can be disabled. +# returns a list of 1s (if the corresponding feature is disabled) +# and 0s (if it isn't) +sub check_disabled { + return map { exists $disabled{lc $_} ? 1 : 0 } @_; +} + +# Exported functions ################################################# + +# args: +# list of features to check +sub anydisabled { + load_configdata() unless $configdata_loaded; + my @ret = check_disabled(@_); + return @ret if wantarray; + return anyof(@ret); +} + +# args: +# list of features to check +sub alldisabled { + load_configdata() unless $configdata_loaded; + my @ret = check_disabled(@_); + return @ret if wantarray; + return allof(@ret); +} + +# !!! Kept for backward compatibility +# args: +# single string +sub disabled { + anydisabled(@_); +} + +sub available_protocols { + load_configdata() unless $configdata_loaded; + my $protocol_class = shift; + if (exists $available_protocols{lc $protocol_class}) { + return @{$available_protocols{lc $protocol_class}} + } + return (); +} + +sub config { + return $config{$_[0]}; +} + +# IPv4 / IPv6 checker +my $have_IPv4 = -1; +my $have_IPv6 = -1; +my $IP_factory; +sub check_IP { + my $listenaddress = shift; + + eval { + require IO::Socket::IP; + my $s = IO::Socket::IP->new( + LocalAddr => $listenaddress, + LocalPort => 0, + Listen=>1, + ); + $s or die "\n"; + $s->close(); + }; + if ($@ eq "") { + return 1; + } + + eval { + require IO::Socket::INET6; + my $s = IO::Socket::INET6->new( + LocalAddr => $listenaddress, + LocalPort => 0, + Listen=>1, + ); + $s or die "\n"; + $s->close(); + }; + if ($@ eq "") { + return 1; + } + + eval { + require IO::Socket::INET; + my $s = IO::Socket::INET->new( + LocalAddr => $listenaddress, + LocalPort => 0, + Listen=>1, + ); + $s or die "\n"; + $s->close(); + }; + if ($@ eq "") { + return 1; + } + + return 0; +} + +sub have_IPv4 { + if ($have_IPv4 < 0) { + $have_IPv4 = check_IP("127.0.0.1"); + } + return $have_IPv4; +} + +sub have_IPv6 { + if ($have_IPv6 < 0) { + $have_IPv6 = check_IP("::1"); + } + return $have_IPv6; +} + + +=head1 SEE ALSO + +L + +=head1 AUTHORS + +Stephen Henson Esteve@openssl.orgE and +Richard Levitte Elevitte@openssl.orgE + +=cut + +1; diff --git a/util/perl/TLSProxy/Certificate.pm b/util/perl/TLSProxy/Certificate.pm new file mode 100644 index 0000000000..d3bf7f2180 --- /dev/null +++ b/util/perl/TLSProxy/Certificate.pm @@ -0,0 +1,219 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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::Certificate; + +use vars '@ISA'; +push @ISA, 'TLSProxy::Message'; + +sub new +{ + my $class = shift; + my ($server, + $data, + $records, + $startoffset, + $message_frag_lens) = @_; + + my $self = $class->SUPER::new( + $server, + TLSProxy::Message::MT_CERTIFICATE, + $data, + $records, + $startoffset, + $message_frag_lens); + + $self->{first_certificate} = ""; + $self->{extension_data} = ""; + $self->{remaining_certdata} = ""; + + return $self; +} + +sub parse +{ + my $self = shift; + + if (TLSProxy::Proxy->is_tls13()) { + my $context_len = unpack('C', $self->data); + my $context = substr($self->data, 1, $context_len); + + my $remdata = substr($self->data, 1 + $context_len); + + my ($hicertlistlen, $certlistlen) = unpack('Cn', $remdata); + $certlistlen += ($hicertlistlen << 16); + + $remdata = substr($remdata, 3); + + die "Invalid Certificate List length" + if length($remdata) != $certlistlen; + + my ($hicertlen, $certlen) = unpack('Cn', $remdata); + $certlen += ($hicertlen << 16); + + die "Certificate too long" if ($certlen + 3) > $certlistlen; + + $remdata = substr($remdata, 3); + + my $certdata = substr($remdata, 0, $certlen); + + $remdata = substr($remdata, $certlen); + + my $extensions_len = unpack('n', $remdata); + $remdata = substr($remdata, 2); + + die "Extensions too long" + if ($certlen + 3 + $extensions_len + 2) > $certlistlen; + + my $extension_data = ""; + if ($extensions_len != 0) { + $extension_data = substr($remdata, 0, $extensions_len); + + 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; + } + $remdata = substr($remdata, $extensions_len); + + $self->context($context); + $self->first_certificate($certdata); + $self->extension_data(\%extensions); + $self->remaining_certdata($remdata); + + print " Context:".$context."\n"; + print " Certificate List Len:".$certlistlen."\n"; + print " Certificate Len:".$certlen."\n"; + print " Extensions Len:".$extensions_len."\n"; + } else { + my ($hicertlistlen, $certlistlen) = unpack('Cn', $self->data); + $certlistlen += ($hicertlistlen << 16); + + my $remdata = substr($self->data, 3); + + die "Invalid Certificate List length" + if length($remdata) != $certlistlen; + + my ($hicertlen, $certlen) = unpack('Cn', $remdata); + $certlen += ($hicertlen << 16); + + die "Certificate too long" if ($certlen + 3) > $certlistlen; + + $remdata = substr($remdata, 3); + + my $certdata = substr($remdata, 0, $certlen); + + $remdata = substr($remdata, $certlen); + + $self->first_certificate($certdata); + $self->remaining_certdata($remdata); + + print " Certificate List Len:".$certlistlen."\n"; + print " Certificate Len:".$certlen."\n"; + } +} + +#Reconstruct the on-the-wire message data following changes +sub set_message_contents +{ + my $self = shift; + my $data; + my $extensions = ""; + + if (TLSProxy::Proxy->is_tls13()) { + foreach my $key (keys %{$self->extension_data}) { + my $extdata = ${$self->extension_data}{$key}; + $extensions .= pack("n", $key); + $extensions .= pack("n", length($extdata)); + $extensions .= $extdata; + if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) { + $extensions .= pack("n", $key); + $extensions .= pack("n", length($extdata)); + $extensions .= $extdata; + } + } + $data = pack('C', length($self->context())); + $data .= $self->context; + my $certlen = length($self->first_certificate); + my $certlistlen = $certlen + length($extensions) + + length($self->remaining_certdata); + my $hi = $certlistlen >> 16; + $certlistlen = $certlistlen & 0xffff; + $data .= pack('Cn', $hi, $certlistlen); + $hi = $certlen >> 16; + $certlen = $certlen & 0xffff; + $data .= pack('Cn', $hi, $certlen); + $data .= pack('n', length($extensions)); + $data .= $extensions; + $data .= $self->remaining_certdata(); + $self->data($data); + } else { + my $certlen = length($self->first_certificate); + my $certlistlen = $certlen + length($self->remaining_certdata); + my $hi = $certlistlen >> 16; + $certlistlen = $certlistlen & 0xffff; + $data .= pack('Cn', $hi, $certlistlen); + $hi = $certlen >> 16; + $certlen = $certlen & 0xffff; + $data .= pack('Cn', $hi, $certlen); + $data .= $self->remaining_certdata(); + $self->data($data); + } +} + +#Read/write accessors +sub context +{ + my $self = shift; + if (@_) { + $self->{context} = shift; + } + return $self->{context}; +} +sub first_certificate +{ + my $self = shift; + if (@_) { + $self->{first_certificate} = shift; + } + return $self->{first_certificate}; +} +sub remaining_certdata +{ + my $self = shift; + if (@_) { + $self->{remaining_certdata} = shift; + } + return $self->{remaining_certdata}; +} +sub extension_data +{ + my $self = shift; + if (@_) { + $self->{extension_data} = shift; + } + return $self->{extension_data}; +} +sub set_extension +{ + my ($self, $ext_type, $ext_data) = @_; + $self->{extension_data}{$ext_type} = $ext_data; +} +sub delete_extension +{ + my ($self, $ext_type) = @_; + delete $self->{extension_data}{$ext_type}; +} +1; diff --git a/util/perl/TLSProxy/CertificateVerify.pm b/util/perl/TLSProxy/CertificateVerify.pm new file mode 100644 index 0000000000..8bf969fba1 --- /dev/null +++ b/util/perl/TLSProxy/CertificateVerify.pm @@ -0,0 +1,96 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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::CertificateVerify; + +use vars '@ISA'; +push @ISA, 'TLSProxy::Message'; + +sub new +{ + my $class = shift; + my ($server, + $data, + $records, + $startoffset, + $message_frag_lens) = @_; + + my $self = $class->SUPER::new( + $server, + TLSProxy::Message::MT_CERTIFICATE_VERIFY, + $data, + $records, + $startoffset, + $message_frag_lens); + + $self->{sigalg} = -1; + $self->{signature} = ""; + + return $self; +} + +sub parse +{ + my $self = shift; + + my $sigalg = -1; + my $remdata = $self->data; + my $record = ${$self->records}[0]; + + if (TLSProxy::Proxy->is_tls13() + || $record->version() == TLSProxy::Record::VERS_TLS_1_2) { + $sigalg = unpack('n', $remdata); + $remdata = substr($remdata, 2); + } + + my $siglen = unpack('n', substr($remdata, 0, 2)); + my $sig = substr($remdata, 2); + + die "Invalid CertificateVerify signature length" if length($sig) != $siglen; + + print " SigAlg:".$sigalg."\n"; + print " Signature Len:".$siglen."\n"; + + $self->sigalg($sigalg); + $self->signature($sig); +} + +#Reconstruct the on-the-wire message data following changes +sub set_message_contents +{ + my $self = shift; + my $data = ""; + my $sig = $self->signature(); + my $olddata = $self->data(); + + $data .= pack("n", $self->sigalg()) if ($self->sigalg() != -1); + $data .= pack("n", length($sig)); + $data .= $sig; + + $self->data($data); +} + +#Read/write accessors +sub sigalg +{ + my $self = shift; + if (@_) { + $self->{sigalg} = shift; + } + return $self->{sigalg}; +} +sub signature +{ + my $self = shift; + if (@_) { + $self->{signature} = shift; + } + return $self->{signature}; +} +1; diff --git a/util/perl/TLSProxy/ClientHello.pm b/util/perl/TLSProxy/ClientHello.pm new file mode 100644 index 0000000000..2ae9d6f55d --- /dev/null +++ b/util/perl/TLSProxy/ClientHello.pm @@ -0,0 +1,261 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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::ClientHello; + +use vars '@ISA'; +push @ISA, 'TLSProxy::Message'; + +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->{extension_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{TLSProxy::Message::EXT_ENCRYPT_THEN_MAC}) { + TLSProxy::Record->etm(1); + } +} + +sub extension_contents +{ + my $self = shift; + my $key = shift; + my $extension = ""; + + my $extdata = ${$self->extension_data}{$key}; + $extension .= pack("n", $key); + $extension .= pack("n", length($extdata)); + $extension .= $extdata; + if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) { + $extension .= pack("n", $key); + $extension .= pack("n", length($extdata)); + $extension .= $extdata; + } + return $extension; +} + +#Reconstruct the on-the-wire message data following changes +sub set_message_contents +{ + my $self = shift; + my $data; + my $extensions = ""; + + $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}); + + foreach my $key (keys %{$self->extension_data}) { + next if ($key == TLSProxy::Message::EXT_PSK); + $extensions .= $self->extension_contents($key); + } + #PSK extension always goes last... + if (defined ${$self->extension_data}{TLSProxy::Message::EXT_PSK}) { + $extensions .= $self->extension_contents(TLSProxy::Message::EXT_PSK); + } + #unless we have EXT_FORCE_LAST + if (defined ${$self->extension_data}{TLSProxy::Message::EXT_FORCE_LAST}) { + $extensions .= $self->extension_contents(TLSProxy::Message::EXT_FORCE_LAST); + } + + $data .= pack('n', length($extensions)); + $data .= $extensions; + + $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}; +} +sub set_extension +{ + my ($self, $ext_type, $ext_data) = @_; + $self->{extension_data}{$ext_type} = $ext_data; +} +sub delete_extension +{ + my ($self, $ext_type) = @_; + delete $self->{extension_data}{$ext_type}; +} +1; diff --git a/util/perl/TLSProxy/EncryptedExtensions.pm b/util/perl/TLSProxy/EncryptedExtensions.pm new file mode 100644 index 0000000000..81242e29ff --- /dev/null +++ b/util/perl/TLSProxy/EncryptedExtensions.pm @@ -0,0 +1,115 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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::EncryptedExtensions; + +use vars '@ISA'; +push @ISA, 'TLSProxy::Message'; + +sub new +{ + my $class = shift; + my ($server, + $data, + $records, + $startoffset, + $message_frag_lens) = @_; + + my $self = $class->SUPER::new( + $server, + TLSProxy::Message::MT_ENCRYPTED_EXTENSIONS, + $data, + $records, + $startoffset, + $message_frag_lens); + + $self->{extension_data} = ""; + + return $self; +} + +sub parse +{ + my $self = shift; + + my $extensions_len = unpack('n', $self->data); + if (!defined $extensions_len) { + $extensions_len = 0; + } + + my $extension_data; + if ($extensions_len != 0) { + $extension_data = substr($self->data, 2); + + if (length($extension_data) != $extensions_len) { + die "Invalid extension length\n"; + } + } else { + if (length($self->data) != 2) { + die "Invalid extension length\n"; + } + $extension_data = ""; + } + 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->extension_data(\%extensions); + + print " Extensions Len:".$extensions_len."\n"; +} + +#Reconstruct the on-the-wire message data following changes +sub set_message_contents +{ + my $self = shift; + my $data; + my $extensions = ""; + + foreach my $key (keys %{$self->extension_data}) { + my $extdata = ${$self->extension_data}{$key}; + $extensions .= pack("n", $key); + $extensions .= pack("n", length($extdata)); + $extensions .= $extdata; + if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) { + $extensions .= pack("n", $key); + $extensions .= pack("n", length($extdata)); + $extensions .= $extdata; + } + } + + $data = pack('n', length($extensions)); + $data .= $extensions; + $self->data($data); +} + +#Read/write accessors +sub extension_data +{ + my $self = shift; + if (@_) { + $self->{extension_data} = shift; + } + return $self->{extension_data}; +} +sub set_extension +{ + my ($self, $ext_type, $ext_data) = @_; + $self->{extension_data}{$ext_type} = $ext_data; +} +sub delete_extension +{ + my ($self, $ext_type) = @_; + delete $self->{extension_data}{$ext_type}; +} +1; diff --git a/util/perl/TLSProxy/HelloRetryRequest.pm b/util/perl/TLSProxy/HelloRetryRequest.pm new file mode 100644 index 0000000000..c4125b7a16 --- /dev/null +++ b/util/perl/TLSProxy/HelloRetryRequest.pm @@ -0,0 +1,150 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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::HelloRetryRequest; + +use vars '@ISA'; +push @ISA, 'TLSProxy::Message'; + +sub new +{ + my $class = shift; + my ($server, + $data, + $records, + $startoffset, + $message_frag_lens) = @_; + + my $self = $class->SUPER::new( + $server, + TLSProxy::Message::MT_HELLO_RETRY_REQUEST, + $data, + $records, + $startoffset, + $message_frag_lens); + + $self->{extension_data} = ""; + + return $self; +} + +sub parse +{ + my $self = shift; + my $ptr = 2; + + TLSProxy::Proxy->is_tls13(1); + + my ($server_version) = unpack('n', $self->data); + # TODO(TLS1.3): Replace this reference to draft version before release + if ($server_version == TLSProxy::Record::VERS_TLS_1_3_DRAFT) { + $server_version = TLSProxy::Record::VERS_TLS_1_3; + } + + my $ciphersuite = unpack('n', substr($self->data, $ptr)); + $ptr += 2; + + my $extensions_len = unpack('n', substr($self->data, $ptr)); + if (!defined $extensions_len) { + $extensions_len = 0; + } + + $ptr += 2; + my $extension_data; + if ($extensions_len != 0) { + $extension_data = substr($self->data, $ptr); + + if (length($extension_data) != $extensions_len) { + die "Invalid extension length\n"; + } + } else { + if (length($self->data) != 2) { + die "Invalid extension length\n"; + } + $extension_data = ""; + } + 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->server_version($server_version); + $self->ciphersuite($ciphersuite); + $self->extension_data(\%extensions); + + print " Server Version:".$server_version."\n"; + print " Ciphersuite:".$ciphersuite."\n"; + print " Extensions Len:".$extensions_len."\n"; +} + +#Reconstruct the on-the-wire message data following changes +sub set_message_contents +{ + my $self = shift; + my $data; + my $extensions = ""; + + foreach my $key (keys %{$self->extension_data}) { + my $extdata = ${$self->extension_data}{$key}; + $extensions .= pack("n", $key); + $extensions .= pack("n", length($extdata)); + $extensions .= $extdata; + if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) { + $extensions .= pack("n", $key); + $extensions .= pack("n", length($extdata)); + $extensions .= $extdata; + } + } + + $data = pack('n', $self->server_version); + $data .= pack('n', $self->ciphersuite); + $data .= pack('n', length($extensions)); + $data .= $extensions; + $self->data($data); +} + +#Read/write accessors +sub server_version +{ + my $self = shift; + if (@_) { + $self->{server_version} = shift; + } + return $self->{server_version}; +} +sub ciphersuite +{ + my $self = shift; + if (@_) { + $self->{ciphersuite} = shift; + } + return $self->{ciphersuite}; +} +sub extension_data +{ + my $self = shift; + if (@_) { + $self->{extension_data} = shift; + } + return $self->{extension_data}; +} +sub set_extension +{ + my ($self, $ext_type, $ext_data) = @_; + $self->{extension_data}{$ext_type} = $ext_data; +} +sub delete_extension +{ + my ($self, $ext_type) = @_; + delete $self->{extension_data}{$ext_type}; +} +1; diff --git a/util/perl/TLSProxy/Message.pm b/util/perl/TLSProxy/Message.pm new file mode 100644 index 0000000000..a9002ec654 --- /dev/null +++ b/util/perl/TLSProxy/Message.pm @@ -0,0 +1,570 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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::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_HELLO_RETRY_REQUEST => 6, + MT_ENCRYPTED_EXTENSIONS => 8, + 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 +}; + +#Alert levels +use constant { + AL_LEVEL_WARN => 1, + AL_LEVEL_FATAL => 2 +}; + +#Alert descriptions +use constant { + AL_DESC_CLOSE_NOTIFY => 0, + AL_DESC_UNEXPECTED_MESSAGE => 10, + AL_DESC_NO_RENEGOTIATION => 100 +}; + +my %message_type = ( + MT_HELLO_REQUEST, "HelloRequest", + MT_CLIENT_HELLO, "ClientHello", + MT_SERVER_HELLO, "ServerHello", + MT_NEW_SESSION_TICKET, "NewSessionTicket", + MT_HELLO_RETRY_REQUEST, "HelloRetryRequest", + MT_ENCRYPTED_EXTENSIONS, "EncryptedExtensions", + 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" +); + +use constant { + EXT_SERVER_NAME => 0, + EXT_STATUS_REQUEST => 5, + EXT_SUPPORTED_GROUPS => 10, + EXT_EC_POINT_FORMATS => 11, + EXT_SRP => 12, + EXT_SIG_ALGS => 13, + EXT_USE_SRTP => 14, + EXT_ALPN => 16, + EXT_SCT => 18, + EXT_PADDING => 21, + EXT_ENCRYPT_THEN_MAC => 22, + EXT_EXTENDED_MASTER_SECRET => 23, + EXT_SESSION_TICKET => 35, + EXT_KEY_SHARE => 40, + EXT_PSK => 41, + EXT_SUPPORTED_VERSIONS => 43, + EXT_COOKIE => 44, + EXT_PSK_KEX_MODES => 45, + EXT_RENEGOTIATE => 65281, + EXT_NPN => 13172, + # This extension is an unofficial extension only ever written by OpenSSL + # (i.e. not read), and even then only when enabled. We use it to test + # handling of duplicate extensions. + EXT_DUPLICATE_EXTENSION => 0xfde8, + EXT_UNKNOWN => 0xfffe, + #Unknown extension that should appear last + EXT_FORCE_LAST => 0xffff +}; + +# SignatureScheme of TLS 1.3, from +# https://tools.ietf.org/html/draft-ietf-tls-tls13-20#appendix-B.3.1.3 +# TODO(TLS1.3) update link to IANA registry after publication +# We have to manually grab the SHA224 equivalents from the old registry +use constant { + SIG_ALG_RSA_PKCS1_SHA256 => 0x0401, + SIG_ALG_RSA_PKCS1_SHA384 => 0x0501, + SIG_ALG_RSA_PKCS1_SHA512 => 0x0601, + SIG_ALG_ECDSA_SECP256R1_SHA256 => 0x0403, + SIG_ALG_ECDSA_SECP384R1_SHA384 => 0x0503, + SIG_ALG_ECDSA_SECP521R1_SHA512 => 0x0603, + SIG_ALG_RSA_PSS_SHA256 => 0x0804, + SIG_ALG_RSA_PSS_SHA384 => 0x0805, + SIG_ALG_RSA_PSS_SHA512 => 0x0806, + SIG_ALG_ED25519 => 0x0807, + SIG_ALG_ED448 => 0x0808, + SIG_ALG_RSA_PKCS1_SHA1 => 0x0201, + SIG_ALG_ECDSA_SHA1 => 0x0203, + SIG_ALG_DSA_SHA1 => 0x0202, + SIG_ALG_DSA_SHA256 => 0x0402, + SIG_ALG_DSA_SHA384 => 0x0502, + SIG_ALG_DSA_SHA512 => 0x0602, + OSSL_SIG_ALG_RSA_PKCS1_SHA224 => 0x0301, + OSSL_SIG_ALG_DSA_SHA224 => 0x0302, + OSSL_SIG_ALG_ECDSA_SHA224 => 0x0303 +}; + +use constant { + CIPHER_DHE_RSA_AES_128_SHA => 0x0033, + CIPHER_ADH_AES_128_SHA => 0x0034, + CIPHER_TLS13_AES_128_GCM_SHA256 => 0x1301, + CIPHER_TLS13_AES_256_GCM_SHA384 => 0x1302 +}; + +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 = (); +my $ciphersuite = 0; +my $successondata = 0; + +sub clear +{ + $payload = ""; + $messlen = -1; + $startoffset = -1; + $server = 0; + $success = 0; + $end = 0; + $successondata = 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; + + @message_frag_lens = (); + + 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_encrypting(1); + } else { + TLSProxy::Record->client_encrypting(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; + + $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; + + $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"; + + if ($successondata) { + $success = 1; + $end = 1; + } + } elsif ($record->content_type == TLSProxy::Record::RT_ALERT) { + my ($alertlev, $alertdesc) = unpack('CC', $record->decrypt_data); + #A CloseNotify from the client indicates we have finished successfully + #(we assume) + if (!$end && !$server && $alertlev == AL_LEVEL_WARN + && $alertdesc == AL_DESC_CLOSE_NOTIFY) { + $success = 1; + } + #All alerts end the test + $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(); + } elsif ($mt == MT_HELLO_RETRY_REQUEST) { + $message = TLSProxy::HelloRetryRequest->new( + $server, + $data, + [@message_rec_list], + $startoffset, + [@message_frag_lens] + ); + $message->parse(); + } elsif ($mt == MT_SERVER_HELLO) { + $message = TLSProxy::ServerHello->new( + $server, + $data, + [@message_rec_list], + $startoffset, + [@message_frag_lens] + ); + $message->parse(); + } elsif ($mt == MT_ENCRYPTED_EXTENSIONS) { + $message = TLSProxy::EncryptedExtensions->new( + $server, + $data, + [@message_rec_list], + $startoffset, + [@message_frag_lens] + ); + $message->parse(); + } elsif ($mt == MT_CERTIFICATE) { + $message = TLSProxy::Certificate->new( + $server, + $data, + [@message_rec_list], + $startoffset, + [@message_frag_lens] + ); + $message->parse(); + } elsif ($mt == MT_CERTIFICATE_VERIFY) { + $message = TLSProxy::CertificateVerify->new( + $server, + $data, + [@message_rec_list], + $startoffset, + [@message_frag_lens] + ); + $message->parse(); + } elsif ($mt == MT_SERVER_KEY_EXCHANGE) { + $message = TLSProxy::ServerKeyExchange->new( + $server, + $data, + [@message_rec_list], + $startoffset, + [@message_frag_lens] + ); + $message->parse(); + } elsif ($mt == MT_NEW_SESSION_TICKET) { + $message = TLSProxy::NewSessionTicket->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 fail +{ + my $class = shift; + return !$success && $end; +} +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; +} + +sub ciphersuite +{ + my $class = shift; + if (@_) { + $ciphersuite = shift; + } + return $ciphersuite; +} + +#Update all the underlying records with the modified data from this message +#Note: Only supports re-encrypting for TLSv1.3 +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; + $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; + + my $old_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; + } else { + $old_length = 0; + } + + my $prefix = substr($recdata, 0, $self->startoffset); + my $suffix = substr($recdata, $self->startoffset + $old_length); + + $rec->decrypt_data($prefix.($msgdata).($suffix)); + # TODO(openssl-team): don't keep explicit lengths. + # (If a length override is ever needed to construct invalid packets, + # use an explicit override field instead.) + $rec->decrypt_len(length($rec->decrypt_data)); + $rec->len($rec->len + length($msgdata) - $old_length); + # Only support re-encryption for TLSv1.3. + if (TLSProxy::Proxy->is_tls13() && $rec->encrypted()) { + #Add content type (1 byte) and 16 tag bytes + $rec->data($rec->decrypt_data + .pack("C", TLSProxy::Record::RT_HANDSHAKE).("\0"x16)); + } else { + $rec->data($rec->decrypt_data); + } + + #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}; +} +sub encoded_length +{ + my $self = shift; + return TLS_MESSAGE_HEADER_LENGTH + length($self->data); +} +sub successondata +{ + my $class = shift; + if (@_) { + $successondata = shift; + } + return $successondata; +} +1; diff --git a/util/perl/TLSProxy/NewSessionTicket.pm b/util/perl/TLSProxy/NewSessionTicket.pm new file mode 100644 index 0000000000..e5099851d5 --- /dev/null +++ b/util/perl/TLSProxy/NewSessionTicket.pm @@ -0,0 +1,81 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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::NewSessionTicket; + +use vars '@ISA'; +push @ISA, 'TLSProxy::Message'; + +sub new +{ + my $class = shift; + my ($server, + $data, + $records, + $startoffset, + $message_frag_lens) = @_; + + my $self = $class->SUPER::new( + $server, + TLSProxy::Message::MT_NEW_SESSION_TICKET, + $data, + $records, + $startoffset, + $message_frag_lens); + + $self->{ticket_lifetime_hint} = 0; + $self->{ticket} = ""; + + return $self; +} + +sub parse +{ + my $self = shift; + + my $ticket_lifetime_hint = unpack('N', $self->data); + my $ticket_len = unpack('n', $self->data); + my $ticket = substr($self->data, 6, $ticket_len); + + $self->ticket_lifetime_hint($ticket_lifetime_hint); + $self->ticket($ticket); +} + + +#Reconstruct the on-the-wire message data following changes +sub set_message_contents +{ + my $self = shift; + my $data; + + $data = pack('N', $self->ticket_lifetime_hint); + $data .= pack('n', length($self->ticket)); + $data .= $self->ticket; + + $self->data($data); +} + +#Read/write accessors +sub ticket_lifetime_hint +{ + my $self = shift; + if (@_) { + $self->{ticket_lifetime_hint} = shift; + } + return $self->{ticket_lifetime_hint}; +} +sub ticket +{ + my $self = shift; + if (@_) { + $self->{ticket} = shift; + } + return $self->{ticket}; +} +1; diff --git a/util/perl/TLSProxy/Proxy.pm b/util/perl/TLSProxy/Proxy.pm new file mode 100644 index 0000000000..c92652e78f --- /dev/null +++ b/util/perl/TLSProxy/Proxy.pm @@ -0,0 +1,603 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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 POSIX ":sys_wait_h"; + +package TLSProxy::Proxy; + +use File::Spec; +use IO::Socket; +use IO::Select; +use TLSProxy::Record; +use TLSProxy::Message; +use TLSProxy::ClientHello; +use TLSProxy::HelloRetryRequest; +use TLSProxy::ServerHello; +use TLSProxy::EncryptedExtensions; +use TLSProxy::Certificate; +use TLSProxy::CertificateVerify; +use TLSProxy::ServerKeyExchange; +use TLSProxy::NewSessionTicket; + +my $have_IPv6 = 0; +my $IP_factory; + +my $is_tls13 = 0; +my $ciphersuite = undef; + +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, + serverflags => "", + clientflags => "", + serverconnects => 1, + serverpid => 0, + clientpid => 0, + reneg => 0, + sessionfile => undef, + + #Public read + execute => $execute, + cert => $cert, + debug => $debug, + cipherc => "", + ciphers => "AES128-SHA:TLS13-AES-128-GCM-SHA256", + flight => 0, + record_list => [], + message_list => [], + }; + + # IO::Socket::IP is on the core module list, IO::Socket::INET6 isn't. + # However, IO::Socket::INET6 is older and is said to be more widely + # deployed for the moment, and may have less bugs, so we try the latter + # first, then fall back on the code modules. Worst case scenario, we + # fall back to IO::Socket::INET, only supports IPv4. + eval { + require IO::Socket::INET6; + my $s = IO::Socket::INET6->new( + LocalAddr => "::1", + LocalPort => 0, + Listen=>1, + ); + $s or die "\n"; + $s->close(); + }; + if ($@ eq "") { + $IP_factory = sub { IO::Socket::INET6->new(@_); }; + $have_IPv6 = 1; + } else { + eval { + require IO::Socket::IP; + my $s = IO::Socket::IP->new( + LocalAddr => "::1", + LocalPort => 0, + Listen=>1, + ); + $s or die "\n"; + $s->close(); + }; + if ($@ eq "") { + $IP_factory = sub { IO::Socket::IP->new(@_); }; + $have_IPv6 = 1; + } else { + $IP_factory = sub { IO::Socket::INET->new(@_); }; + } + } + + return bless $self, $class; +} + +sub clearClient +{ + my $self = shift; + + $self->{cipherc} = ""; + $self->{flight} = 0; + $self->{record_list} = []; + $self->{message_list} = []; + $self->{clientflags} = ""; + $self->{sessionfile} = undef; + $self->{clientpid} = 0; + $is_tls13 = 0; + $ciphersuite = undef; + + TLSProxy::Message->clear(); + TLSProxy::Record->clear(); +} + +sub clear +{ + my $self = shift; + + $self->clearClient; + $self->{ciphers} = "AES128-SHA:TLS13-AES-128-GCM-SHA256"; + $self->{serverflags} = ""; + $self->{serverconnects} = 1; + $self->{serverpid} = 0; + $self->{reneg} = 0; +} + +sub restart +{ + my $self = shift; + + $self->clear; + $self->start; +} + +sub clientrestart +{ + my $self = shift; + + $self->clear; + $self->clientstart; +} + +sub start +{ + my ($self) = shift; + my $pid; + + $pid = fork(); + if ($pid == 0) { + if (!$self->debug) { + open(STDOUT, ">", File::Spec->devnull()) + or die "Failed to redirect stdout: $!"; + open(STDERR, ">&STDOUT"); + } + my $execcmd = $self->execute + ." s_server -no_comp -rev -engine ossltest -accept " + .($self->server_port) + ." -cert ".$self->cert." -cert2 ".$self->cert + ." -naccept ".$self->serverconnects; + if ($self->ciphers ne "") { + $execcmd .= " -cipher ".$self->ciphers; + } + if ($self->serverflags ne "") { + $execcmd .= " ".$self->serverflags; + } + if ($self->debug) { + print STDERR "Server command: $execcmd\n"; + } + exec($execcmd); + } + $self->serverpid($pid); + + return $self->clientstart; +} + +sub clientstart +{ + my ($self) = shift; + my $oldstdout; + + if(!$self->debug) { + open DEVNULL, ">", File::Spec->devnull(); + $oldstdout = select(DEVNULL); + } + + # Create the Proxy socket + my $proxaddr = $self->proxy_addr; + $proxaddr =~ s/[\[\]]//g; # Remove [ and ] + my $proxy_sock = $IP_factory->( + LocalHost => $proxaddr, + LocalPort => $self->proxy_port, + Proto => "tcp", + Listen => SOMAXCONN, + ReuseAddr => 1 + ); + + if ($proxy_sock) { + print "Proxy started on port ".$self->proxy_port."\n"; + } else { + warn "Failed creating proxy socket (".$proxaddr.",".$self->proxy_port."): $!\n"; + return 0; + } + + if ($self->execute) { + my $pid = fork(); + if ($pid == 0) { + if (!$self->debug) { + open(STDOUT, ">", File::Spec->devnull()) + or die "Failed to redirect stdout: $!"; + open(STDERR, ">&STDOUT"); + } + my $echostr; + if ($self->reneg()) { + $echostr = "R"; + } else { + $echostr = "test"; + } + my $execcmd = "echo ".$echostr." | ".$self->execute + ." s_client -engine ossltest -connect " + .($self->proxy_addr).":".($self->proxy_port); + if ($self->cipherc ne "") { + $execcmd .= " -cipher ".$self->cipherc; + } + if ($self->clientflags ne "") { + $execcmd .= " ".$self->clientflags; + } + if (defined $self->sessionfile) { + $execcmd .= " -ign_eof"; + } + if ($self->debug) { + print STDERR "Client command: $execcmd\n"; + } + exec($execcmd); + } + $self->clientpid($pid); + } + + # Wait for incoming connection from client + my $client_sock; + if(!($client_sock = $proxy_sock->accept())) { + warn "Failed accepting incoming connection: $!\n"; + return 0; + } + + print "Connection opened\n"; + + # Now connect to the server + my $retry = 10; + my $server_sock; + #We loop over this a few times because sometimes s_server can take a while + #to start up + do { + my $servaddr = $self->server_addr; + $servaddr =~ s/[\[\]]//g; # Remove [ and ] + eval { + $server_sock = $IP_factory->( + PeerAddr => $servaddr, + PeerPort => $self->server_port, + MultiHomed => 1, + Proto => 'tcp' + ); + }; + + $retry--; + #Some buggy IP factories can return a defined server_sock that hasn't + #actually connected, so we check peerport too + if ($@ || !defined($server_sock) || !defined($server_sock->peerport)) { + $server_sock->close() if defined($server_sock); + undef $server_sock; + if ($retry) { + #Sleep for a short while + select(undef, undef, undef, 0.1); + } else { + warn "Failed to start up server (".$servaddr.",".$self->server_port."): $!\n"; + return 0; + } + } + } 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; + my $ctr = 0; + while( (!(TLSProxy::Message->end) + || (defined $self->sessionfile() + && (-s $self->sessionfile()) == 0)) + && $ctr < 10 + && (@ready = $sel->can_read(1))) { + 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); + $ctr = 0; + } elsif ($hand == $client_sock) { + $client_sock->sysread($indata, 16384) or goto END; + $indata = $self->process_packet(0, $indata); + $server_sock->syswrite($indata); + $ctr = 0; + } else { + $ctr++ + } + } + } + + die "No progress made" if $ctr >= 10; + + 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); + } + $self->serverconnects($self->serverconnects - 1); + if ($self->serverconnects == 0) { + die "serverpid is zero\n" if $self->serverpid == 0; + print "Waiting for server process to close: " + .$self->serverpid."\n"; + waitpid( $self->serverpid, 0); + die "exit code $? from server process\n" if $? != 0; + } + die "clientpid is zero\n" if $self->clientpid == 0; + print "Waiting for client process to close: ".$self->clientpid."\n"; + waitpid($self->clientpid, 0); + + return 1; +} + +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]}; + push @{$self->{message_list}}, @{$ret[1]}; + + print "\n"; + + #Finished parsing. Call user provided filter here + if(defined $self->filter) { + $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($server); + } + + $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 success +{ + my $self = shift; + return $self->{success}; +} +sub end +{ + my $self = shift; + return $self->{end}; +} +sub supports_IPv6 +{ + my $self = shift; + return $have_IPv6; +} + +#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}; +} +sub cipherc +{ + my $self = shift; + if (@_) { + $self->{cipherc} = shift; + } + return $self->{cipherc}; +} +sub ciphers +{ + my $self = shift; + if (@_) { + $self->{ciphers} = shift; + } + return $self->{ciphers}; +} +sub serverflags +{ + my $self = shift; + if (@_) { + $self->{serverflags} = shift; + } + return $self->{serverflags}; +} +sub clientflags +{ + my $self = shift; + if (@_) { + $self->{clientflags} = shift; + } + return $self->{clientflags}; +} +sub serverconnects +{ + my $self = shift; + if (@_) { + $self->{serverconnects} = shift; + } + return $self->{serverconnects}; +} +# This is a bit ugly because the caller is responsible for keeping the records +# in sync with the updated message list; simply updating the message list isn't +# sufficient to get the proxy to forward the new message. +# But it does the trick for the one test (test_sslsessiontick) that needs it. +sub message_list +{ + my $self = shift; + if (@_) { + $self->{message_list} = shift; + } + return $self->{message_list}; +} +sub serverpid +{ + my $self = shift; + if (@_) { + $self->{serverpid} = shift; + } + return $self->{serverpid}; +} +sub clientpid +{ + my $self = shift; + if (@_) { + $self->{clientpid} = shift; + } + return $self->{clientpid}; +} + +sub fill_known_data +{ + my $length = shift; + my $ret = ""; + for (my $i = 0; $i < $length; $i++) { + $ret .= chr($i); + } + return $ret; +} + +sub is_tls13 +{ + my $class = shift; + if (@_) { + $is_tls13 = shift; + } + return $is_tls13; +} + +sub reneg +{ + my $self = shift; + if (@_) { + $self->{reneg} = shift; + } + return $self->{reneg}; +} + +#Setting a sessionfile means that the client will not close until the given +#file exists. This is useful in TLSv1.3 where otherwise s_client will close +#immediately at the end of the handshake, but before the session has been +#received from the server. A side effect of this is that s_client never sends +#a close_notify, so instead we consider success to be when it sends application +#data over the connection. +sub sessionfile +{ + my $self = shift; + if (@_) { + $self->{sessionfile} = shift; + TLSProxy::Message->successondata(1); + } + return $self->{sessionfile}; +} + +sub ciphersuite +{ + my $class = shift; + if (@_) { + $ciphersuite = shift; + } + return $ciphersuite; +} + +1; diff --git a/util/perl/TLSProxy/Record.pm b/util/perl/TLSProxy/Record.pm new file mode 100644 index 0000000000..5017c9094c --- /dev/null +++ b/util/perl/TLSProxy/Record.pm @@ -0,0 +1,398 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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 TLSProxy::Proxy; + +package TLSProxy::Record; + +my $server_encrypting = 0; +my $client_encrypting = 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, + RT_UNKNOWN => 100 +}; + +my %record_type = ( + RT_APPLICATION_DATA, "APPLICATION DATA", + RT_HANDSHAKE, "HANDSHAKE", + RT_ALERT, "ALERT", + RT_CCS, "CCS", + RT_UNKNOWN, "UNKNOWN" +); + +use constant { + VERS_TLS_1_4 => 0x0305, + VERS_TLS_1_3_DRAFT => 0x7f15, + VERS_TLS_1_3 => 0x0304, + VERS_TLS_1_2 => 0x0303, + VERS_TLS_1_1 => 0x0302, + VERS_TLS_1_0 => 0x0301, + VERS_SSL_3_0 => 0x0300, + VERS_SSL_LT_3_0 => 0x02ff +}; + +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", + VERS_SSL_LT_3_0, "SSL<3" +); + +#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, + 0, + $len_real, + $decrypt_len, + substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real), + substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real) + ); + + if (($server && $server_encrypting) + || (!$server && $client_encrypting)) { + if (!TLSProxy::Proxy->is_tls13() && $etm) { + $record->decryptETM(); + } else { + $record->decrypt(); + } + $record->encrypted(1); + } + + if (TLSProxy::Proxy->is_tls13()) { + print " Inner content type: " + .$record_type{$record->content_type()}."\n"; + } + + 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_encrypting = 0; + $client_encrypting = 0; +} + +#Class level accessors +sub server_encrypting +{ + my $class = shift; + if (@_) { + $server_encrypting = shift; + } + return $server_encrypting; +} +sub client_encrypting +{ + my $class = shift; + if (@_) { + $client_encrypting= shift; + } + return $client_encrypting; +} +#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, + $sslv2, + $len_real, + $decrypt_len, + $data, + $decrypt_data) = @_; + + my $self = { + flight => $flight, + content_type => $content_type, + version => $version, + len => $len, + sslv2 => $sslv2, + len_real => $len_real, + decrypt_len => $decrypt_len, + data => $data, + decrypt_data => $decrypt_data, + orig_decrypt_data => $decrypt_data, + encrypted => 0, + outer_content_type => RT_APPLICATION_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 $mactaglen = 20; + my $data = $self->data; + + #Throw away any IVs + if (TLSProxy::Proxy->is_tls13()) { + #A TLS1.3 client, when processing the server's initial flight, could + #respond with either an encrypted or an unencrypted alert. + if ($self->content_type() == RT_ALERT) { + #TODO(TLS1.3): Eventually it is sufficient just to check the record + #content type. If an alert is encrypted it will have a record + #content type of application data. However we haven't done the + #record layer changes yet, so it's a bit more complicated. For now + #we will additionally check if the data length is 2 (1 byte for + #alert level, 1 byte for alert description). If it is, then this is + #an unencrypted alert, so don't try to decrypt + return $data if (length($data) == 2); + } + $mactaglen = 16; + } elsif ($self->version >= VERS_TLS_1_1()) { + #16 bytes for a standard IV + $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 or TAG + $data = substr($data, 0, length($data) - $mactaglen); + + if (TLSProxy::Proxy->is_tls13()) { + #Get the content type + my $content_type = unpack("C", substr($data, length($data) - 1)); + $self->content_type($content_type); + $data = substr($data, 0, length($data) - 1); + } + + $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 $server = shift; + my $data; + my $tls13_enc = 0; + + 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 + 1); + $tls13_enc = 1; + } else { + $data = pack('Cnn', $self->content_type, $self->version, + $self->len); + } + + } + $data .= $self->data; + + if ($tls13_enc) { + $data .= pack('C', $self->content_type); + } + + return $data; +} + +#Read only accessors +sub flight +{ + my $self = shift; + return $self->{flight}; +} +sub sslv2 +{ + my $self = shift; + return $self->{sslv2}; +} +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}; +} +sub version +{ + my $self = shift; + if (@_) { + $self->{version} = shift; + } + return $self->{version}; +} +sub content_type +{ + my $self = shift; + if (@_) { + $self->{content_type} = shift; + } + return $self->{content_type}; +} +sub encrypted +{ + my $self = shift; + if (@_) { + $self->{encrypted} = shift; + } + return $self->{encrypted}; +} +sub outer_content_type +{ + my $self = shift; + if (@_) { + $self->{outer_content_type} = shift; + } + return $self->{outer_content_type}; +} +1; diff --git a/util/perl/TLSProxy/ServerHello.pm b/util/perl/TLSProxy/ServerHello.pm new file mode 100644 index 0000000000..1abdd053e1 --- /dev/null +++ b/util/perl/TLSProxy/ServerHello.pm @@ -0,0 +1,234 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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::ServerHello; + +use vars '@ISA'; +push @ISA, 'TLSProxy::Message'; + +sub new +{ + my $class = shift; + my ($server, + $data, + $records, + $startoffset, + $message_frag_lens) = @_; + + my $self = $class->SUPER::new( + $server, + TLSProxy::Message::MT_SERVER_HELLO, + $data, + $records, + $startoffset, + $message_frag_lens); + + $self->{server_version} = 0; + $self->{random} = []; + $self->{session_id_len} = 0; + $self->{session} = ""; + $self->{ciphersuite} = 0; + $self->{comp_meth} = 0; + $self->{extension_data} = ""; + + return $self; +} + +sub parse +{ + my $self = shift; + my $ptr = 2; + my ($server_version) = unpack('n', $self->data); + + # TODO(TLS1.3): Replace this reference to draft version before release + if ($server_version == TLSProxy::Record::VERS_TLS_1_3_DRAFT) { + $server_version = TLSProxy::Record::VERS_TLS_1_3; + TLSProxy::Proxy->is_tls13(1); + } + + my $random = substr($self->data, $ptr, 32); + $ptr += 32; + my $session_id_len = 0; + my $session = ""; + if (!TLSProxy::Proxy->is_tls13()) { + $session_id_len = unpack('C', substr($self->data, $ptr)); + $ptr++; + $session = substr($self->data, $ptr, $session_id_len); + $ptr += $session_id_len; + } + my $ciphersuite = unpack('n', substr($self->data, $ptr)); + $ptr += 2; + my $comp_meth = 0; + if (!TLSProxy::Proxy->is_tls13()) { + $comp_meth = unpack('C', substr($self->data, $ptr)); + $ptr++; + } + my $extensions_len = unpack('n', substr($self->data, $ptr)); + if (!defined $extensions_len) { + $extensions_len = 0; + } else { + $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; + if ($extensions_len != 0) { + $extension_data = substr($self->data, $ptr); + + if (length($extension_data) != $extensions_len) { + die "Invalid extension length\n"; + } + } else { + if (length($self->data) != $ptr) { + die "Invalid extension length\n"; + } + $extension_data = ""; + } + 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->server_version($server_version); + $self->random($random); + $self->session_id_len($session_id_len); + $self->session($session); + $self->ciphersuite($ciphersuite); + TLSProxy::Proxy->ciphersuite($ciphersuite); + $self->comp_meth($comp_meth); + $self->extension_data(\%extensions); + + $self->process_data(); + + if (TLSProxy::Proxy->is_tls13()) { + TLSProxy::Record->server_encrypting(1); + TLSProxy::Record->client_encrypting(1); + } + + print " Server Version:".$server_version."\n"; + print " Session ID Len:".$session_id_len."\n"; + print " Ciphersuite:".$ciphersuite."\n"; + print " Compression Method:".$comp_meth."\n"; + print " Extensions Len:".$extensions_len."\n"; +} + +#Perform any actions necessary based on the data we've seen +sub process_data +{ + my $self = shift; + + TLSProxy::Message->ciphersuite($self->ciphersuite); +} + +#Reconstruct the on-the-wire message data following changes +sub set_message_contents +{ + my $self = shift; + my $data; + my $extensions = ""; + + $data = pack('n', $self->server_version); + $data .= $self->random; + if (!TLSProxy::Proxy->is_tls13()) { + $data .= pack('C', $self->session_id_len); + $data .= $self->session; + } + $data .= pack('n', $self->ciphersuite); + if (!TLSProxy::Proxy->is_tls13()) { + $data .= pack('C', $self->comp_meth); + } + + foreach my $key (keys %{$self->extension_data}) { + my $extdata = ${$self->extension_data}{$key}; + $extensions .= pack("n", $key); + $extensions .= pack("n", length($extdata)); + $extensions .= $extdata; + if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) { + $extensions .= pack("n", $key); + $extensions .= pack("n", length($extdata)); + $extensions .= $extdata; + } + } + + $data .= pack('n', length($extensions)); + $data .= $extensions; + $self->data($data); +} + +#Read/write accessors +sub server_version +{ + my $self = shift; + if (@_) { + $self->{server_version} = shift; + } + return $self->{server_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 +{ + my $self = shift; + if (@_) { + $self->{ciphersuite} = shift; + } + return $self->{ciphersuite}; +} +sub comp_meth +{ + my $self = shift; + if (@_) { + $self->{comp_meth} = shift; + } + return $self->{comp_meth}; +} +sub extension_data +{ + my $self = shift; + if (@_) { + $self->{extension_data} = shift; + } + return $self->{extension_data}; +} +sub set_extension +{ + my ($self, $ext_type, $ext_data) = @_; + $self->{extension_data}{$ext_type} = $ext_data; +} +sub delete_extension +{ + my ($self, $ext_type) = @_; + delete $self->{extension_data}{$ext_type}; +} +1; diff --git a/util/perl/TLSProxy/ServerKeyExchange.pm b/util/perl/TLSProxy/ServerKeyExchange.pm new file mode 100644 index 0000000000..cb4cc7c762 --- /dev/null +++ b/util/perl/TLSProxy/ServerKeyExchange.pm @@ -0,0 +1,157 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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::ServerKeyExchange; + +use vars '@ISA'; +push @ISA, 'TLSProxy::Message'; + +sub new +{ + my $class = shift; + my ($server, + $data, + $records, + $startoffset, + $message_frag_lens) = @_; + + my $self = $class->SUPER::new( + $server, + TLSProxy::Message::MT_SERVER_KEY_EXCHANGE, + $data, + $records, + $startoffset, + $message_frag_lens); + + #DHE + $self->{p} = ""; + $self->{g} = ""; + $self->{pub_key} = ""; + $self->{sigalg} = -1; + $self->{sig} = ""; + + return $self; +} + +sub parse +{ + my $self = shift; + my $sigalg = -1; + + #Minimal SKE parsing. Only supports one known DHE ciphersuite at the moment + return if TLSProxy::Proxy->ciphersuite() + != TLSProxy::Message::CIPHER_ADH_AES_128_SHA + && TLSProxy::Proxy->ciphersuite() + != TLSProxy::Message::CIPHER_DHE_RSA_AES_128_SHA; + + my $p_len = unpack('n', $self->data); + my $ptr = 2; + my $p = substr($self->data, $ptr, $p_len); + $ptr += $p_len; + + my $g_len = unpack('n', substr($self->data, $ptr)); + $ptr += 2; + my $g = substr($self->data, $ptr, $g_len); + $ptr += $g_len; + + my $pub_key_len = unpack('n', substr($self->data, $ptr)); + $ptr += 2; + my $pub_key = substr($self->data, $ptr, $pub_key_len); + $ptr += $pub_key_len; + + #We assume its signed + my $record = ${$self->records}[0]; + + if (TLSProxy::Proxy->is_tls13() + || $record->version() == TLSProxy::Record::VERS_TLS_1_2) { + $sigalg = unpack('n', substr($self->data, $ptr)); + $ptr += 2; + } + my $sig = ""; + if (defined $sigalg) { + my $sig_len = unpack('n', substr($self->data, $ptr)); + if (defined $sig_len) { + $ptr += 2; + $sig = substr($self->data, $ptr, $sig_len); + $ptr += $sig_len; + } + } + + $self->p($p); + $self->g($g); + $self->pub_key($pub_key); + $self->sigalg($sigalg) if defined $sigalg; + $self->signature($sig); +} + + +#Reconstruct the on-the-wire message data following changes +sub set_message_contents +{ + my $self = shift; + my $data; + + $data = pack('n', length($self->p)); + $data .= $self->p; + $data .= pack('n', length($self->g)); + $data .= $self->g; + $data .= pack('n', length($self->pub_key)); + $data .= $self->pub_key; + $data .= pack('n', $self->sigalg) if ($self->sigalg != -1); + if (length($self->signature) > 0) { + $data .= pack('n', length($self->signature)); + $data .= $self->signature; + } + + $self->data($data); +} + +#Read/write accessors +#DHE +sub p +{ + my $self = shift; + if (@_) { + $self->{p} = shift; + } + return $self->{p}; +} +sub g +{ + my $self = shift; + if (@_) { + $self->{g} = shift; + } + return $self->{g}; +} +sub pub_key +{ + my $self = shift; + if (@_) { + $self->{pub_key} = shift; + } + return $self->{pub_key}; +} +sub sigalg +{ + my $self = shift; + if (@_) { + $self->{sigalg} = shift; + } + return $self->{sigalg}; +} +sub signature +{ + my $self = shift; + if (@_) { + $self->{sig} = shift; + } + return $self->{sig}; +} +1; diff --git a/util/perl/checkhandshake.pm b/util/perl/checkhandshake.pm new file mode 100644 index 0000000000..65c5135a1e --- /dev/null +++ b/util/perl/checkhandshake.pm @@ -0,0 +1,181 @@ +#! /usr/bin/env perl +# Copyright 2015-2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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 + +package checkhandshake; + +use OpenSSL::Test qw/:DEFAULT cmdstr srctop_file srctop_dir bldtop_dir/; +use OpenSSL::Test::Utils; +use TLSProxy::Proxy; + +use Exporter; +our @ISA = 'Exporter'; +our @EXPORT = qw(@handmessages @extensions checkhandshake); + +use constant { + DEFAULT_HANDSHAKE => 1, + OCSP_HANDSHAKE => 2, + RESUME_HANDSHAKE => 4, + CLIENT_AUTH_HANDSHAKE => 8, + RENEG_HANDSHAKE => 16, + NPN_HANDSHAKE => 32, + EC_HANDSHAKE => 64, + HRR_HANDSHAKE => 128, + HRR_RESUME_HANDSHAKE => 256, + + ALL_HANDSHAKES => 511 +}; + +use constant { + #DEFAULT also includes SESSION_TICKET_SRV_EXTENSION and SERVER_NAME_CLI + DEFAULT_EXTENSIONS => 0x00000007, + SESSION_TICKET_SRV_EXTENSION => 0x00000002, + SERVER_NAME_CLI_EXTENSION => 0x00000004, + SERVER_NAME_SRV_EXTENSION => 0x00000008, + STATUS_REQUEST_CLI_EXTENSION => 0x00000010, + STATUS_REQUEST_SRV_EXTENSION => 0x00000020, + ALPN_CLI_EXTENSION => 0x00000040, + ALPN_SRV_EXTENSION => 0x00000080, + SCT_CLI_EXTENSION => 0x00000100, + SCT_SRV_EXTENSION => 0x00000200, + RENEGOTIATE_CLI_EXTENSION => 0x00000400, + NPN_CLI_EXTENSION => 0x00000800, + NPN_SRV_EXTENSION => 0x00001000, + SRP_CLI_EXTENSION => 0x00002000, + #Client side for ec point formats is a default extension + EC_POINT_FORMAT_SRV_EXTENSION => 0x00004000, + PSK_CLI_EXTENSION => 0x00008000, + PSK_SRV_EXTENSION => 0x00010000, + KEY_SHARE_SRV_EXTENSION => 0x00020000, + PSK_KEX_MODES_EXTENSION => 0x00040000, + KEY_SHARE_HRR_EXTENSION => 0x00080000, + SUPPORTED_GROUPS_SRV_EXTENSION => 0x00100000 +}; + +our @handmessages = (); +our @extensions = (); + +sub checkhandshake($$$$) +{ + my ($proxy, $handtype, $exttype, $testname) = @_; + + subtest $testname => sub { + my $loop = 0; + my $numtests; + my $extcount; + my $clienthelloseen = 0; + + #First count the number of tests + my $nextmess = 0; + my $message = undef; + my $chnum = 0; + for ($numtests = 0; $handmessages[$loop][1] != 0; $loop++) { + next if (($handmessages[$loop][1] & $handtype) == 0); + if (scalar @{$proxy->message_list} > $nextmess) { + $message = ${$proxy->message_list}[$nextmess]; + $nextmess++; + } else { + $message = undef; + } + $numtests++; + + next if (!defined $message); + $chnum = 1 if $message->mt() != TLSProxy::Message::MT_CLIENT_HELLO + && TLSProxy::Proxy::is_tls13(); + next if ($message->mt() != TLSProxy::Message::MT_CLIENT_HELLO + && $message->mt() != TLSProxy::Message::MT_HELLO_RETRY_REQUEST + && $message->mt() != TLSProxy::Message::MT_SERVER_HELLO + && $message->mt() != + TLSProxy::Message::MT_ENCRYPTED_EXTENSIONS + && $message->mt() != TLSProxy::Message::MT_CERTIFICATE); + + next if $message->mt() == TLSProxy::Message::MT_CERTIFICATE + && !TLSProxy::Proxy::is_tls13(); + + my $extchnum = 0; + for (my $extloop = 0; + $extensions[$extloop][2] != 0; + $extloop++) { + $extchnum = 1 if $extensions[$extloop][0] != TLSProxy::Message::MT_CLIENT_HELLO + && TLSProxy::Proxy::is_tls13(); + next if $extensions[$extloop][0] == TLSProxy::Message::MT_CLIENT_HELLO + && $extchnum != $chnum; + next if ($message->mt() != $extensions[$extloop][0]); + $numtests++; + } + $numtests++; + } + + plan tests => $numtests; + + $nextmess = 0; + $message = undef; + $chnum = 0; + for ($loop = 0; $handmessages[$loop][1] != 0; $loop++) { + next if (($handmessages[$loop][1] & $handtype) == 0); + if (scalar @{$proxy->message_list} > $nextmess) { + $message = ${$proxy->message_list}[$nextmess]; + $nextmess++; + } else { + $message = undef; + } + if (!defined $message) { + fail("Message type check. Got nothing, expected " + .$handmessages[$loop][0]); + next; + } else { + ok($message->mt == $handmessages[$loop][0], + "Message type check. Got ".$message->mt + .", expected ".$handmessages[$loop][0]); + } + $chnum = 1 if $message->mt() != TLSProxy::Message::MT_CLIENT_HELLO + && TLSProxy::Proxy::is_tls13(); + + next if ($message->mt() != TLSProxy::Message::MT_CLIENT_HELLO + && $message->mt() != TLSProxy::Message::MT_HELLO_RETRY_REQUEST + && $message->mt() != TLSProxy::Message::MT_SERVER_HELLO + && $message->mt() != + TLSProxy::Message::MT_ENCRYPTED_EXTENSIONS + && $message->mt() != TLSProxy::Message::MT_CERTIFICATE); + + next if $message->mt() == TLSProxy::Message::MT_CERTIFICATE + && !TLSProxy::Proxy::is_tls13(); + + if ($message->mt() == TLSProxy::Message::MT_CLIENT_HELLO) { + #Add renegotiate extension we will expect if renegotiating + $exttype |= RENEGOTIATE_CLI_EXTENSION + if ($clienthelloseen && !TLSProxy::Proxy::is_tls13()); + $clienthelloseen = 1; + } + #Now check that we saw the extensions we expected + my $msgexts = $message->extension_data(); + my $extchnum = 0; + for (my $extloop = 0, $extcount = 0; $extensions[$extloop][2] != 0; + $extloop++) { + #In TLSv1.3 we can have two ClientHellos if there has been a + #HelloRetryRequest, and they may have different extensions. Skip + #if these are extensions for a different ClientHello + $extchnum = 1 if $extensions[$extloop][0] != TLSProxy::Message::MT_CLIENT_HELLO + && TLSProxy::Proxy::is_tls13(); + next if $extensions[$extloop][0] == TLSProxy::Message::MT_CLIENT_HELLO + && $extchnum != $chnum; + next if ($message->mt() != $extensions[$extloop][0]); + ok (($extensions[$extloop][2] & $exttype) == 0 + || defined ($msgexts->{$extensions[$extloop][1]}), + "Extension presence check (Message: ".$message->mt() + ." Extension: ".($extensions[$extloop][2] & $exttype).", " + .$extloop.")"); + $extcount++ if (($extensions[$extloop][2] & $exttype) != 0); + } + ok($extcount == keys %$msgexts, "Extensions count mismatch (" + .$extcount.", ".(keys %$msgexts) + .")"); + } + } +} + +1; diff --git a/util/perl/with_fallback.pm b/util/perl/with_fallback.pm new file mode 100644 index 0000000000..2af1d5fbd5 --- /dev/null +++ b/util/perl/with_fallback.pm @@ -0,0 +1,25 @@ +# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. +# +# Licensed under the OpenSSL license (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 + +package with_fallback; + +sub import { + use File::Basename; + use File::Spec::Functions; + foreach (@_) { + eval "require $_"; + if ($@) { + unshift @INC, catdir(dirname(__FILE__), + "..", "..", "external", "perl"); + my $transfer = "transfer::$_"; + eval "require $transfer"; + shift @INC; + warn $@ if $@; + } + } +} +1; diff --git a/util/with_fallback.pm b/util/with_fallback.pm deleted file mode 100644 index b6deb2092e..0000000000 --- a/util/with_fallback.pm +++ /dev/null @@ -1,24 +0,0 @@ -# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved. -# -# Licensed under the OpenSSL license (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 - -package with_fallback; - -sub import { - use File::Basename; - use File::Spec::Functions; - foreach (@_) { - eval "require $_"; - if ($@) { - unshift @INC, catdir(dirname(__FILE__), "..", "external", "perl"); - my $transfer = "transfer::$_"; - eval "require $transfer"; - shift @INC; - warn $@ if $@; - } - } -} -1; -- cgit v1.2.3