sslh/t
Josh Soref b1bfd5aee3 spelling: nonexistent
Signed-off-by: Josh Soref <2119212+jsoref@users.noreply.github.com>
2023-07-30 01:43:12 -04:00

476 lines
18 KiB
Perl
Executable File

#! /usr/bin/perl -w
# Test script for sslh
# Uses Conf::Libconfig to read sslh config file: install
# with:
# cpan Conf::Libconfig
use strict;
use IO::Socket::INET6;
use Test::More qw/no_plan/;
use Conf::Libconfig;
my $conf = new Conf::Libconfig;
$conf->read_file("test.cfg");
my $no_listen = 8083; # Port on which no-one listens
my $pidfile = $conf->lookup_value("pidfile");
my $sslh_port = $conf->fetch_array("listen")->[0]->{port};
my $user = (getpwuid $<)[0]; # Run under current username
# Which tests do we run
my $SSH_SHY_CNX = 0;
my $PROBES_NOFRAG = 1;
my $PROBES_AGAIN = 1;
my $SSL_MIX_SSH = 1;
my $SSH_MIX_SSL = 1;
my $DROP_CNX = 1;
# Robustness tests. These are mostly to achieve full test
# coverage, but do not necessarily result in an actual test
# (e.g. some tests need to be run with valgrind to check all
# memory management code).
my $RB_CNX_NOSERVER = 0;
my $RB_PARAM_NOHOST = 0;
my $RB_WRONG_USERNAME = 0;
my $RB_OPEN_PID_FILE = 0;
my $RB_RESOLVE_ADDRESS = 0;
my $RB_CL_PARAMS = 0;
`lcov --directory . --zerocounters`;
sub verbose_exec
{
my ($cmd) = @_;
warn "$cmd\n";
if (!fork) {
exec $cmd;
}
}
# We want to keep track of tests to print a report at the
# end, so we centralise all calls to Test::More::is here
my $cnt = 1; # test counter
my @results;
sub my_is {
my ($a, $b, $desc) = @_;
my $res = is($a, $b, $desc);
push @results, [$cnt++, $desc, $res];
}
# For SNI/ALPN, build a protocol name as such:
# tls:sni1,sni2,...;alpn1,alpn2,...
# input: a protocol entry from Libconfig
sub make_sni_alpn_name {
my ($prot) = @_;
return "tls:" . (join ",", @{$prot->{sni_hostnames} // []})
. ";" . (join ",", @{$prot->{alpn_protocols} // [] });
}
# Tests one probe: given input data, connect, verify we get
# the expected server, verify shoveling works
# Named options:
# data: what to write
# expected: expected protocol prefix
# no_frag: don't print byte-per-byte
sub test_probe {
my (%opts) = @_;
my $cnx = new IO::Socket::INET(PeerHost => "localhost:$sslh_port");
warn "$!\n" unless $cnx;
return unless $cnx;
my $pattern = $opts{data};
if ($opts{no_frag}) {
syswrite $cnx, $pattern;
} else {
while (length $pattern) {
syswrite $cnx, (substr $pattern, 0, 1, '');
select undef, undef, undef, .01;
}
}
my $data;
my $n = sysread $cnx, $data, 1024;
$data =~ /^(.*?): /;
my $prefix = $1;
$data =~ s/$prefix: //g;
print "Received $n bytes: protocol $prefix data [$data]\n";
close $cnx;
$opts{expected} =~ s/^ssl/tls/; # to remove in 1.21
my_is($prefix, $opts{expected}, "$opts{binary}:$opts{expected}: probe connected correctly");
my_is($data, $opts{data}, "$opts{binary}:$opts{expected}: data shoveled correctly");
}
# Test all probes, with or without fragmentation
# options:
# no_frag: write test patterns all at once (also
# available per-protocol as some probes don't support
# fragmentation)
sub test_probes {
my (%in_opts) = @_;
my @probes = @{$conf->fetch_array("protocols")};
foreach my $p (@probes) {
my %protocols = (
'ssh' => { data => "SSH-2.0 tester" },
'socks5' => { data => "\x05\x04\x01\x02\x03\x04" },
'http' => {
data => "GET index.html HTTP/1.1",
no_frag => 1 },
'tls' => {
# Packet with SNI and ALPN (`openssl s_client -connect localhost:443 -alpn alpn1 -servername sni1`)
data_sni_alpn => "\x16\x03\x01\x00\xc4\x01\x00\x00\xc0\x03\x03\x03\x19\x01\x00\x40\x14\x13\xcc\x1b\x94\xad\x20\x5d\x13\x1a\x8d\xd2\x65\x23\x70\xde\xd1\x3c\x5d\x05\x19\xcb\x27\x0d\x7c\x2c\x89\x00\x00\x38\xc0\x2c\xc0\x30\x00\x9f\xcc\xa9\xcc\xa8\xcc\xaa\xc0\x2b\xc0\x2f\x00\x9e\xc0\x24\xc0\x28\x00\x6b\xc0\x23\xc0\x27\x00\x67\xc0\x0a\xc0\x14\x00\x39\xc0\x09\xc0\x13\x00\x33\x00\x9d\x00\x9c\x00\x3d\x00\x3c\x00\x35\x00\x2f\x00\xff\x01\x00\x00\x5f\x00\x00\x00\x09\x00\x07\x00\x00\x04\$sni\x00\x0b\x00\x04\x03\x00\x01\x02\x00\x0a\x00\x0a\x00\x08\x00\x1d\x00\x17\x00\x19\x00\x18\x00\x23\x00\x00\x00\x0d\x00\x20\x00\x1e\x06\x01\x06\x02\x06\x03\x05\x01\x05\x02\x05\x03\x04\x01\x04\x02\x04\x03\x03\x01\x03\x02\x03\x03\x02\x01\x02\x02\x02\x03\x00\x10\x00\x08\x00\x06\x05\$alpn\x00\x16\x00\x00\x00\x17\x00\x00hello sni/alpn",
# Packet with SNI alone
data_sni => "\x16\x03\x01\x00\xb8\x01\x00\x00\xb4\x03\x03\x97\xe4\xe9\xad\x86\xe1\x21\xfd\xc4\x5b\x27\x0e\xad\x4b\x55\xc2\x50\xe4\x1c\x86\x2f\x37\x25\xde\xe8\x9c\x59\xfc\x1b\xa9\x37\x32\x00\x00\x38\xc0\x2c\xc0\x30\x00\x9f\xcc\xa9\xcc\xa8\xcc\xaa\xc0\x2b\xc0\x2f\x00\x9e\xc0\x24\xc0\x28\x00\x6b\xc0\x23\xc0\x27\x00\x67\xc0\x0a\xc0\x14\x00\x39\xc0\x09\xc0\x13\x00\x33\x00\x9d\x00\x9c\x00\x3d\x00\x3c\x00\x35\x00\x2f\x00\xff\x01\x00\x00\x53\x00\x00\x00\x09\x00\x07\x00\x00\x04\$sni\x00\x0b\x00\x04\x03\x00\x01\x02\x00\x0a\x00\x0a\x00\x08\x00\x1d\x00\x17\x00\x19\x00\x18\x00\x23\x00\x00\x00\x0d\x00\x20\x00\x1e\x06\x01\x06\x02\x06\x03\x05\x01\x05\x02\x05\x03\x04\x01\x04\x02\x04\x03\x03\x01\x03\x02\x03\x03\x02\x01\x02\x02\x02\x03\x00\x16\x00\x00\x00\x17\x00\x00hello sni",
# packet with ALPN alone
data_alpn => "\x16\x03\x01\x00\xb7\x01\x00\x00\xb3\x03\x03\xe2\x90\xa2\x29\x03\x31\xad\x98\x44\x51\x54\x90\x5b\xd9\x51\x0e\x66\xb5\x3f\xe8\x8b\x09\xc9\xe4\x2b\x97\x24\xef\xad\x56\x06\xc9\x00\x00\x38\xc0\x2c\xc0\x30\x00\x9f\xcc\xa9\xcc\xa8\xcc\xaa\xc0\x2b\xc0\x2f\x00\x9e\xc0\x24\xc0\x28\x00\x6b\xc0\x23\xc0\x27\x00\x67\xc0\x0a\xc0\x14\x00\x39\xc0\x09\xc0\x13\x00\x33\x00\x9d\x00\x9c\x00\x3d\x00\x3c\x00\x35\x00\x2f\x00\xff\x01\x00\x00\x52\x00\x0b\x00\x04\x03\x00\x01\x02\x00\x0a\x00\x0a\x00\x08\x00\x1d\x00\x17\x00\x19\x00\x18\x00\x23\x00\x00\x00\x0d\x00\x20\x00\x1e\x06\x01\x06\x02\x06\x03\x05\x01\x05\x02\x05\x03\x04\x01\x04\x02\x04\x03\x03\x01\x03\x02\x03\x03\x02\x01\x02\x02\x02\x03\x00\x10\x00\x08\x00\x06\x05\$alpn\x00\x16\x00\x00\x00\x17\x00\x00hello alpn",
# packet with no SNI, no ALPN
data => "\x16\x03\x01\x00\xab\x01\x00\x00\xa7\x03\x03\x89\x22\x33\x95\x43\x7a\xc3\x89\x45\x51\x12\x3c\x28\x24\x1b\x6a\x78\xbf\xbe\x95\xd8\x90\x58\xd7\x65\xf7\xbb\x2d\xb2\x8d\xa0\x75\x00\x00\x38\xc0\x2c\xc0\x30\x00\x9f\xcc\xa9\xcc\xa8\xcc\xaa\xc0\x2b\xc0\x2f\x00\x9e\xc0\x24\xc0\x28\x00\x6b\xc0\x23\xc0\x27\x00\x67\xc0\x0a\xc0\x14\x00\x39\xc0\x09\xc0\x13\x00\x33\x00\x9d\x00\x9c\x00\x3d\x00\x3c\x00\x35\x00\x2f\x00\xff\x01\x00\x00\x46\x00\x0b\x00\x04\x03\x00\x01\x02\x00\x0a\x00\x0a\x00\x08\x00\x1d\x00\x17\x00\x19\x00\x18\x00\x23\x00\x00\x00\x0d\x00\x20\x00\x1e\x06\x01\x06\x02\x06\x03\x05\x01\x05\x02\x05\x03\x04\x01\x04\x02\x04\x03\x03\x01\x03\x02\x03\x03\x02\x01\x02\x02\x02\x03\x00\x16\x00\x00\x00\x17\x00\x00hello tls alone"
},
'openvpn' => { data => "\x00\x00" },
'syslog' => { data => "<42> My syslog message" },
'tinc' => { data => "0 hello" },
'xmpp' => {data => "I should get a real jabber connection initialisation here" },
'adb' => { data => "CNXN....................host:..." },
'anyprot' => {data => "hello anyprot this needs to be longer than xmpp and adb which expect about 50 characters, which I all have to write before the timeout!" },
);
my $pattern = $protocols{$p->{name}}->{data};
my %opts = %in_opts;
$opts{no_frag} = 1 if $protocols{$p->{name}}->{no_frag};
if ($p->{sni_hostnames} or $p->{alpn_protocols}) {
my $pname = make_sni_alpn_name($p);
my @sni = @{$p->{sni_hostnames} // [""] };
my @alpn = @{$p->{alpn_protocols} // [""] };
foreach my $sni ( @sni ) {
foreach my $alpn ( @alpn ) {
print "sni: $sni\nalpn: $alpn\n";
$pattern = $protocols{tls}->{
"data". ($sni ? "_sni" : "") .
($alpn ? "_alpn": "")
};
$pattern =~ s/(\$\w+)/$1/eeg;
test_probe(
data => $pattern,
expected => $pname,
%opts
);
}
}
} elsif ($p->{name} eq 'regex') {
foreach my $test (@{$p->{test_patterns}}) {
test_probe(
data => $test->{pattern},
expected => $test->{result},
%opts
);
}
} else {
test_probe(
data => $pattern,
expected => $p->{name},
%opts
);
}
}
}
# Start an echoserver for each service
foreach my $s (@{$conf->fetch_array("protocols")}) {
my $prefix = $s->{name};
$prefix =~ s/^ssl/tls/; # To remove in 1.21
if ($s->{sni_hostnames} or $s->{alpn_protocols}) {
$prefix = make_sni_alpn_name($s);
}
verbose_exec "./echosrv --listen $s->{host}:$s->{port} --prefix '$prefix: '";
}
#my @binaries = ('sslh-select', 'sslh-fork');
my @binaries = ('sslh-select');
for my $binary (@binaries) {
warn "Testing $binary\n";
# Start sslh with the right plumbing
my ($sslh_pid, $valgrind);
if (!($sslh_pid = fork)) {
my $user = (getpwuid $<)[0]; # Run under current username
my $cmd = "./$binary -v 4 -f -u $user -F test.cfg";
#$valgrind = 1;
#$cmd = "valgrind --leak-check=full $cmd";
verbose_exec $cmd;
exit 0;
}
warn "spawned $sslh_pid\n";
sleep 1; # Give everyone some time to start
sleep 5 if $valgrind; # valgrind can be heavy -- wait 5 seconds
my $test_data = "hello world\n";
my $ssl_test_data = "\x16\x03\x01\x00\xab\x01\x00\x00\xa7\x03\x03\x89\x22\x33\x95\x43\x7a\xc3\x89\x45\x51\x12\x3c\x28\x24\x1b\x6a\x78\xbf\xbe\x95\xd8\x90\x58\xd7\x65\xf7\xbb\x2d\xb2\x8d\xa0\x75\x00\x00\x38\xc0\x2c\xc0\x30\x00\x9f\xcc\xa9\xcc\xa8\xcc\xaa\xc0\x2b\xc0\x2f\x00\x9e\xc0\x24\xc0\x28\x00\x6b\xc0\x23\xc0\x27\x00\x67\xc0\x0a\xc0\x14\x00\x39\xc0\x09\xc0\x13\x00\x33\x00\x9d\x00\x9c\x00\x3d\x00\x3c\x00\x35\x00\x2f\x00\xff\x01\x00\x00\x46\x00\x0b\x00\x04\x03\x00\x01\x02\x00\x0a\x00\x0a\x00\x08\x00\x1d\x00\x17\x00\x19\x00\x18\x00\x23\x00\x00\x00\x0d\x00\x20\x00\x1e\x06\x01\x06\x02\x06\x03\x05\x01\x05\x02\x05\x03\x04\x01\x04\x02\x04\x03\x03\x01\x03\x02\x03\x03\x02\x01\x02\x02\x02\x03\x00\x16\x00\x00\x00\x17\x00\x00hello tls alone";
# Test: Shy SSH connection
if ($SSH_SHY_CNX) {
print "***Test: Shy SSH connection\n";
my $cnx_h = new IO::Socket::INET(PeerHost => "localhost:$sslh_port");
warn "$!\n" unless $cnx_h;
if (defined $cnx_h) {
sleep 13;
print $cnx_h $test_data;
my $data = <$cnx_h>;
my_is($data, "ssh: $test_data", "$binary: Shy SSH connection");
}
}
# Test: One SSL half-started then one SSH
if ($SSL_MIX_SSH) {
print "***Test: One SSL half-started then one SSH\n";
my $cnx_l = new IO::Socket::INET(PeerHost => "localhost:$sslh_port");
warn "$!\n" unless $cnx_l;
if (defined $cnx_l) {
print $cnx_l $ssl_test_data;
my $cnx_h= new IO::Socket::INET(PeerHost => "localhost:$sslh_port");
warn "$!\n" unless $cnx_h;
if (defined $cnx_h) {
sleep 3;
print $cnx_h $test_data;
my $data_h = <$cnx_h>;
my_is($data_h, "ssh: $test_data", "$binary: SSH during SSL being established");
}
my $data;
my $n = sysread $cnx_l, $data, 1024;
my_is($data, "tls: $ssl_test_data", "$binary: SSL connection interrupted by SSH");
}
}
# Test: One SSH half-started then one SSL
if ($SSH_MIX_SSL) {
print "***Test: One SSH half-started then one SSL\n";
my $cnx_h = new IO::Socket::INET(PeerHost => "localhost:$sslh_port");
warn "$!\n" unless $cnx_h;
if (defined $cnx_h) {
sleep 3;
my $cnx_l = new IO::Socket::INET(PeerHost => "localhost:$sslh_port");
warn "$!\n" unless $cnx_l;
if (defined $cnx_l) {
print $cnx_l $ssl_test_data;
my $data;
my $n = sysread $cnx_l, $data, 1024;
my_is($data, "tls: $ssl_test_data", "$binary: SSL during SSH being established");
}
print $cnx_h $test_data;
my $data = <$cnx_h>;
my_is($data, "ssh: $test_data", "$binary: SSH connection interrupted by SSL");
}
}
# Test: Drop connection without writing anything
if ($DROP_CNX) {
print "***Test: Connect but don't write anything\n";
my $cnx_h = new IO::Socket::INET(PeerHost => "localhost:$sslh_port");
warn "$!\n" unless $cnx_h;
if ($cnx_h) {
close $cnx_h;
my_is(1, "$binary: Connect and write nothing");
# The goal of the test is to check sslh doesn't
# crash
}
}
if ($PROBES_NOFRAG) {
test_probes(no_frag => 1, binary => $binary);
}
if ($PROBES_AGAIN) {
test_probes(binary => $binary);
}
my $pid = `cat $pidfile`;
warn "killing $pid\n";
kill TERM => $pid or warn "kill process: $!\n";
sleep 1;
}
# Robustness: Connecting to non-existant server
if ($RB_CNX_NOSERVER) {
print "***Test: Connecting to non-existant server\n";
my $sslh_pid;
if (!($sslh_pid = fork)) {
exec "./sslh-select -v 3 -f -u $user --listen localhost:$sslh_port --ssh localhost:$no_listen --tls localhost:$no_listen -P $pidfile";
}
warn "spawned $sslh_pid\n";
sleep 1;
my $cnx_h = new IO::Socket::INET(PeerHost => "localhost:$sslh_port");
warn "$!\n" unless $cnx_h;
if (defined $cnx_h) {
sleep 1;
my $test_data = "hello";
print $cnx_h $test_data;
}
# Ideally we should check a log is emitted.
kill TERM => `cat $pidfile` or warn "kill: $!\n";
sleep 1;
}
my $ssh_conf = (grep { $_->{name} eq "ssh" } @{$conf->fetch_array("protocols")})[0];
my $ssh_address = $ssh_conf->{host} . ":" . $ssh_conf->{port};
# Use the last TLS echoserv (no SNI/ALPN)
my $ssl_conf = (grep { $_->{name} eq "tls" } @{$conf->fetch_array("protocols")})[-1];
my $ssl_address = $ssl_conf->{host} . ":" . $ssl_conf->{port};
# Robustness: No hostname in address
if ($RB_PARAM_NOHOST) {
print "***Test: No hostname in address\n";
my $sslh_pid;
if (!($sslh_pid = fork)) {
exec "./sslh-select -v 3 -f -u $user --listen $sslh_port --ssh $ssh_address --tls $ssl_address -P $pidfile";
}
warn "spawned $sslh_pid\n";
waitpid $sslh_pid, 0;
my $code = $? >> 8;
warn "exited with $code\n";
my_is($code, 6, "Exit status on illegal option");
}
# Robustness: User does not exist
if ($RB_WRONG_USERNAME) {
print "***Test: Changing to non-existant username\n";
my $sslh_pid;
if (!($sslh_pid = fork)) {
exec "./sslh-select -v 3 -f -u ${user}_doesnt_exist --listen localhost:$no_listen --ssh $ssh_address --tls $ssl_address -P $pidfile";
}
warn "spawned $sslh_pid\n";
waitpid $sslh_pid, 0;
my $code = $? >> 8;
warn "exited with $code\n";
my_is($code, 2, "Exit status on non-existant username");
}
# Robustness: Can't open PID file
if ($RB_OPEN_PID_FILE) {
print "***Test: Can't open PID file\n";
my $sslh_pid;
if (!($sslh_pid = fork)) {
exec "./sslh-select -v 3 -f -u $user --listen localhost:$no_listen --ssh $ssh_address --tls $ssl_address -P /dont_exist/$pidfile";
# You don't have a /dont_exist/ directory, do you?!
}
warn "spawned $sslh_pid\n";
waitpid $sslh_pid, 0;
my $code = $? >> 8;
warn "exited with $code\n";
my_is($code, 3, "Exit status if can't open PID file");
}
# Robustness: Can't resolve address
if ($RB_RESOLVE_ADDRESS) {
print "***Test: Can't resolve address\n";
my $sslh_pid;
if (!($sslh_pid = fork)) {
my $user = (getpwuid $<)[0]; # Run under current username
exec "./sslh-select -v 3 -f -u $user --listen blahblah.nonexistent:9000 --ssh $ssh_address --tls $ssl_address -P $pidfile";
}
warn "spawned $sslh_pid\n";
waitpid $sslh_pid, 0;
my $code = $? >> 8;
warn "exited with $code\n";
my_is($code, 4, "Exit status if can't resolve address");
}
# Robustness: verify all command line options work
if ($RB_CL_PARAMS) {
print "***Test: Command line parameters\n";
my $sslh_pid;
if (!($sslh_pid = fork)) {
my $user = (getpwuid $<)[0]; # Run under current username
# This doesn't test --inetd
exec "./sslh-select -v 3 -f -u $user -P $pidfile".
" -n --transparent --timeout 10 -C /tmp".
" --syslog-facility auth --on-timeout ssh".
" --listen localhost:$no_listen --ssh $ssh_address --tls $ssl_address".
" --openvpn localhost:$no_listen".
" --tinc localhost:$no_listen".
" --xmpp localhost:$no_listen".
" --http localhost:$no_listen".
" --adb localhost:$no_listen".
" --socks5 localhost:$no_listen".
" --anyprot localhost:$no_listen";
exit 0;
}
warn "spawned $sslh_pid\n";
# It will die soon because $user cannot chroot (you
# don't test as root, do you?)
waitpid $sslh_pid, 0;
my $code = $? >> 8;
warn "exited with $code\n";
my_is($code, 1, "Command line arguments");
print "***Test: Bad command line parameters\n";
my $sslh_pid;
if (!($sslh_pid = fork)) {
my $user = (getpwuid $<)[0]; # Run under current username
# This doesn't test --inetd
exec "./sslh-select -v 3 -f -u $user -P $pidfile".
" -n --transparent --timeout 10 -C /tmp".
" --fakeoption".
" --anyprot localhost:$no_listen";
exit 0;
}
warn "spawned $sslh_pid\n";
waitpid $sslh_pid, 0;
my $code = $? >> 8;
warn "exited with $code\n";
my_is($code, 6, "Bad command line parameters");
}
`lcov --directory . --capture --output-file sslh_cov.info`;
`genhtml sslh_cov.info`;
`killall echosrv`;
format test_results_top =
ID | Description | Status
----+-------------------------------------------------------------------+-------
.
format test_results =
@>> | @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @>>
$_->[0], $_->[1], $_->[2] ? "OK" : "NOK"
.
format_name STDOUT "test_results";
format_top_name STDOUT "test_results_top";
map { write; } @results;