From a1cf6c8afb45daaf60936eb5c58301cae3884b5a Mon Sep 17 00:00:00 2001 From: Gilles Peskine Date: Wed, 17 May 2017 14:50:38 +0200 Subject: [PATCH] More tests of FALLBACK_SCSV This is a backport of a non-regression test for issue #810 which affected the current release of mbed TLS, but not the 1.3 branch. --- tests/scripts/tcp_client.pl | 86 +++++++++++++++++++++++++++++++++++++ tests/ssl-opt.sh | 33 ++++++++++++++ 2 files changed, 119 insertions(+) create mode 100755 tests/scripts/tcp_client.pl diff --git a/tests/scripts/tcp_client.pl b/tests/scripts/tcp_client.pl new file mode 100755 index 000000000..11cbf1b1b --- /dev/null +++ b/tests/scripts/tcp_client.pl @@ -0,0 +1,86 @@ +#!/usr/bin/env perl + +# A simple TCP client that sends some data and expects a response. +# Usage: tcp_client.pl HOSTNAME PORT DATA1 RESPONSE1 +# DATA: hex-encoded data to send to the server +# RESPONSE: regexp that must match the server's response + +use warnings; +use strict; +use IO::Socket::INET; + +# Pack hex digits into a binary string, ignoring whitespace. +sub parse_hex { + my ($hex) = @_; + $hex =~ s/\s+//g; + return pack('H*', $hex); +} + +## Open a TCP connection to the specified host and port. +sub open_connection { + my ($host, $port) = @_; + my $socket = IO::Socket::INET->new(PeerAddr => $host, + PeerPort => $port, + Proto => 'tcp', + Timeout => 1); + die "Cannot connect to $host:$port: $!" unless $socket; + return $socket; +} + +## Close the TCP connection. +sub close_connection { + my ($connection) = @_; + $connection->shutdown(2); + # Ignore shutdown failures (at least for now) + return 1; +} + +## Write the given data, expressed as hexadecimal +sub write_data { + my ($connection, $hexdata) = @_; + my $data = parse_hex($hexdata); + my $total_sent = 0; + while ($total_sent < length($data)) { + my $sent = $connection->send($data, 0); + if (!defined $sent) { + die "Unable to send data: $!"; + } + $total_sent += $sent; + } + return 1; +} + +## Read a response and check it against an expected prefix +sub read_response { + my ($connection, $expected_hex) = @_; + my $expected_data = parse_hex($expected_hex); + my $start_offset = 0; + while ($start_offset < length($expected_data)) { + my $actual_data; + my $ok = $connection->recv($actual_data, length($expected_data)); + if (!defined $ok) { + die "Unable to receive data: $!"; + } + if (($actual_data ^ substr($expected_data, $start_offset)) =~ /[^\000]/) { + printf STDERR ("Received \\x%02x instead of \\x%02x at offset %d\n", + ord(substr($actual_data, $-[0], 1)), + ord(substr($expected_data, $start_offset + $-[0], 1)), + $start_offset + $-[0]); + return 0; + } + $start_offset += length($actual_data); + } + return 1; +} + +if (@ARGV != 4) { + print STDERR "Usage: $0 HOSTNAME PORT DATA1 RESPONSE1\n"; + exit(3); +} +my ($host, $port, $data1, $response1) = @ARGV; +my $connection = open_connection($host, $port); +write_data($connection, $data1); +if (!read_response($connection, $response1)) { + exit(1); +} +close_connection($connection); diff --git a/tests/ssl-opt.sh b/tests/ssl-opt.sh index a018f64a2..7bcc41215 100755 --- a/tests/ssl-opt.sh +++ b/tests/ssl-opt.sh @@ -16,11 +16,13 @@ set -u : ${OPENSSL_CMD:=openssl} # OPENSSL would conflict with the build system : ${GNUTLS_CLI:=gnutls-cli} : ${GNUTLS_SERV:=gnutls-serv} +: ${PERL:=perl} O_SRV="$OPENSSL_CMD s_server -www -cert data_files/server5.crt -key data_files/server5.key -dhparam data_files/dhparams.pem" O_CLI="echo 'GET / HTTP/1.0' | $OPENSSL_CMD s_client" G_SRV="$GNUTLS_SERV --x509certfile data_files/server5.crt --x509keyfile data_files/server5.key" G_CLI="echo 'GET / HTTP/1.0' | $GNUTLS_CLI --x509cafile data_files/test-ca_cat12.crt" +TCP_CLIENT="$PERL scripts/tcp_client.pl" TESTS=0 FAILS=0 @@ -761,6 +763,37 @@ run_test "Fallback SCSV: enabled, max version, openssl client" \ -s "received FALLBACK_SCSV" \ -S "inapropriate fallback" +## ClientHello generated with +## "openssl s_client -CAfile tests/data_files/test-ca.crt -tls1_1 -connect localhost:4433 -cipher ..." +## then manually twiddling the ciphersuite list. +## The ClientHello content is spelled out below as a hex string as +## "prefix ciphersuite1 ciphersuite2 ciphersuite3 ciphersuite4 suffix". +## The expected response is an inappropriate_fallback alert. +requires_openssl_with_fallback_scsv +run_test "Fallback SCSV: beginning of list" \ + "$P_SRV debug_level=2" \ + "$TCP_CLIENT localhost $PORT '160301003e0100003a03022aafb94308dc22ca1086c65acc00e414384d76b61ecab37df1633b1ae1034dbe000008 5600 0031 0032 0033 0100000900230000000f000101' '15030200020256'" \ + 0 \ + -s "received FALLBACK_SCSV" \ + -s "inapropriate fallback" + +requires_openssl_with_fallback_scsv +run_test "Fallback SCSV: end of list" \ + "$P_SRV debug_level=2" \ + "$TCP_CLIENT localhost $PORT '160301003e0100003a03022aafb94308dc22ca1086c65acc00e414384d76b61ecab37df1633b1ae1034dbe000008 0031 0032 0033 5600 0100000900230000000f000101' '15030200020256'" \ + 0 \ + -s "received FALLBACK_SCSV" \ + -s "inapropriate fallback" + +## Here the expected response is a valid ServerHello prefix, up to the random. +requires_openssl_with_fallback_scsv +run_test "Fallback SCSV: not in list" \ + "$P_SRV debug_level=2" \ + "$TCP_CLIENT localhost $PORT '160301003e0100003a03022aafb94308dc22ca1086c65acc00e414384d76b61ecab37df1633b1ae1034dbe000008 0056 0031 0032 0033 0100000900230000000f000101' '16030200300200002c0302'" \ + 0 \ + -S "received FALLBACK_SCSV" \ + -S "inapropriate fallback" + # Tests for CBC 1/n-1 record splitting run_test "CBC Record splitting: TLS 1.2, no splitting" \