mirror of
https://github.com/yrutschle/sslh.git
synced 2025-07-14 07:31:03 +03:00
336 lines
8.4 KiB
Perl
Executable File
336 lines
8.4 KiB
Perl
Executable File
#! /usr/bin/perl -w
|
|
|
|
# Test suite for sslh
|
|
|
|
# Uses Conf::Libconfig to read sslh config file: install
|
|
# with:
|
|
# cpan Conf::Libconfig
|
|
|
|
# Usage:
|
|
# ./run # run all tests
|
|
# ./run -l # list all tests
|
|
# ./run 1 3 5 # run specified tests
|
|
|
|
use strict;
|
|
use IO::Socket::INET6;
|
|
use Test::More qw/no_plan/;
|
|
use Conf::Libconfig 1.0.3;
|
|
use Getopt::Long;
|
|
|
|
my ($coverage, $list_tests);
|
|
GetOptions(
|
|
'cover' => \$coverage,
|
|
'list' => \$list_tests,
|
|
);
|
|
|
|
|
|
use Data::Dumper;
|
|
|
|
################################################################################
|
|
# Global setup
|
|
################################################################################
|
|
my $no_listen = 8083; # Port on which no-one listens
|
|
my $user = (getpwuid $<)[0]; # Run under current username
|
|
|
|
################################################################################
|
|
# Helper functions
|
|
################################################################################
|
|
sub get_conf {
|
|
my ($filename) = @_;
|
|
my $conf = new Conf::Libconfig;
|
|
$conf->read_file($filename) or die "$filename: $!";
|
|
return $conf;
|
|
}
|
|
|
|
# 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];
|
|
}
|
|
|
|
#my $pidfile = $conf->lookup_value("pidfile");
|
|
|
|
sub verbose_exec
|
|
{
|
|
my ($cmd) = @_;
|
|
|
|
warn "$cmd\n";
|
|
if (!fork) {
|
|
exec $cmd;
|
|
}
|
|
}
|
|
|
|
# Returns a 'host:port' address targetting ssh from the configuration file
|
|
sub ssh_address {
|
|
my ($conf) = @_;
|
|
my $ssh_conf = (grep { $_->{name} eq "ssh" } @{$conf->value("protocols")})[0];
|
|
return $ssh_conf->{host} . ":" . $ssh_conf->{port};
|
|
}
|
|
|
|
|
|
# Returns the last TLS target from the configuration file
|
|
sub ssl_address {
|
|
my ($conf) = @_;
|
|
my $ssl_conf = (grep { $_->{name} eq "tls" } @{$conf->value ("protocols")})[-1];
|
|
return $ssl_conf->{host} . ":" . $ssl_conf->{port};
|
|
}
|
|
|
|
# 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} // [] });
|
|
}
|
|
|
|
# Start an echoserver for each service
|
|
my ($started_echosrvs);
|
|
sub start_echosrv
|
|
{
|
|
my ($conf) = @_;
|
|
|
|
return if defined $started_echosrvs;
|
|
|
|
foreach my $s (@{$conf->value("protocols")}) {
|
|
my $prefix = $s->{name};
|
|
|
|
$prefix =~ s/^ssl/tls/;
|
|
|
|
if ($s->{sni_hostnames} or $s->{alpn_protocols}) {
|
|
$prefix = make_sni_alpn_name($s);
|
|
}
|
|
|
|
verbose_exec "../echosrv --listen $s->{host}:$s->{port} --prefix '$prefix: '";
|
|
}
|
|
$started_echosrvs = 1;
|
|
}
|
|
|
|
sub stop_echosrv
|
|
{
|
|
`killall echosrv` if $started_echosrvs;
|
|
undef $started_echosrvs;
|
|
}
|
|
|
|
|
|
# Runs sslh
|
|
my ($sslh_pid);
|
|
sub start_sslh
|
|
{
|
|
my ($exe, $conf) = @_;
|
|
return if defined $sslh_pid;
|
|
my ($valgrind);
|
|
if (!($sslh_pid = fork)) {
|
|
my $user = (getpwuid $<)[0]; # Run under current username
|
|
my $cmd = "../$exe -u $user -F $conf";
|
|
print "****CMDLINE [$cmd]\n";
|
|
#$valgrind = 1;
|
|
#$cmd = "valgrind --leak-check=full $cmd";
|
|
verbose_exec $cmd;
|
|
exit 0;
|
|
}
|
|
sleep 1;
|
|
warn "spawned $sslh_pid\n";
|
|
sleep 5 if $valgrind; # valgrind can be heavy -- wait 5 seconds
|
|
}
|
|
|
|
#stop sslh
|
|
sub stop_sslh
|
|
{
|
|
if (defined $sslh_pid) {
|
|
kill TERM => $sslh_pid or warn "kill process: $!\n";
|
|
undef $sslh_pid;
|
|
}
|
|
}
|
|
|
|
################################################################################
|
|
# Test methods
|
|
################################################################################
|
|
|
|
# runs a test that ends in sslh exiting early
|
|
# $cmdline: which command line to run
|
|
# $test: test object
|
|
# Returns: sslh exit code
|
|
sub run_ending_test
|
|
{
|
|
my ($exe, $params, $test) = @_;
|
|
my $conf = get_conf($test->{cfg});
|
|
my $ssh_address = ssh_address($conf);
|
|
my $ssl_address = ssl_address($conf);
|
|
my $pidfile = $conf->lookup_value("pidfile");
|
|
my $sslh_pid;
|
|
if (!($sslh_pid = fork)) {
|
|
my $cmdline = "../$exe $params";
|
|
warn "eval `$cmdline`\n";
|
|
$cmdline = eval "\"$cmdline\"";
|
|
warn "running `$cmdline`\n";
|
|
exec "$cmdline";
|
|
}
|
|
warn "spawned $sslh_pid\n";
|
|
waitpid $sslh_pid, 0;
|
|
my $code = $? >> 8;
|
|
warn "exited with $code\n";
|
|
my_is($code, $test->{exit}, "$exe: $test->{desc}");
|
|
return $code;
|
|
}
|
|
|
|
|
|
|
|
# Runs one test for one probe. Start echosrv's if required.
|
|
# Extract sslh's listening port from the config file, run
|
|
# sslh, connect, write the test pattern, read the result,
|
|
# check it connected to the right echosrv, check the data
|
|
# was transfered ok.
|
|
sub run_test_probe
|
|
{
|
|
my ($exe, $test) = @_;
|
|
|
|
my $conf = get_conf($test->{cfg});
|
|
start_echosrv($conf);
|
|
start_sslh($exe, $test->{cfg});
|
|
|
|
my $expected = $test->{expected};
|
|
|
|
my $sslh_port = $conf->value("listen")->[0]->{port};
|
|
print "test_probe [$expected] $sslh_port\n";
|
|
my $cnx = new IO::Socket::INET(PeerHost => "localhost:$sslh_port");
|
|
warn "t: $!\n" unless $cnx;
|
|
return unless $cnx;
|
|
|
|
syswrite $cnx, $test->{data};
|
|
|
|
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;
|
|
|
|
my_is($prefix, $expected, "$exe:$expected: probe");
|
|
my_is($data, $test->{data}, "$exe:$expected: shoveled");
|
|
}
|
|
|
|
|
|
################################################################################
|
|
# Test bodies
|
|
# Functions here each perform one test, and will be called with:
|
|
# - exe: path the executable to test
|
|
# - test: test object
|
|
################################################################################
|
|
|
|
sub test_no_host
|
|
{
|
|
my ($exe, $test) = @_;
|
|
run_ending_test(
|
|
$exe,
|
|
"-v 3 -f -u $user --listen $no_listen --ssh \$ssh_address --tls \$ssl_address -P \$pidfile",
|
|
$test,
|
|
);
|
|
}
|
|
|
|
sub test_wrong_user
|
|
{
|
|
my ($exe, $test) = @_;
|
|
run_ending_test(
|
|
$exe,
|
|
"-F $test->{cfg} -u ${user}_doesnt_exist --listen localhost:$no_listen --ssh \$ssh_address --tls \$ssl_address -P \$pidfile",
|
|
$test,
|
|
);
|
|
}
|
|
|
|
|
|
################################################################################
|
|
|
|
my @tests = (
|
|
{
|
|
desc => "No hostname in address",
|
|
run => \&test_no_host,
|
|
cfg => "test1.cfg",
|
|
exit => 6,
|
|
},
|
|
{
|
|
desc => "Changing to non-existant username",
|
|
run => \&test_wrong_user,
|
|
cfg => "test1.cfg",
|
|
exit => 2,
|
|
},
|
|
|
|
{
|
|
desc => "ssh probe",
|
|
run => \&run_test_probe,
|
|
cfg => "test1.cfg",
|
|
data => "SSH-2.0 Tester banner\n", # Sent to echosrv
|
|
expected => "ssh", # prefix expected from echosrv
|
|
},
|
|
|
|
{
|
|
desc => "socks5 probe",
|
|
run => \&run_test_probe,
|
|
cfg => "test1.cfg",
|
|
data => "\x05\x04\x01\x02\x03\x04",
|
|
expected => "socks5", # prefix expected from echosrv
|
|
},
|
|
|
|
);
|
|
|
|
|
|
# Number tests
|
|
my $i = 1;
|
|
map { $_->{'index'} = $i++ } @tests;
|
|
|
|
# Only keep selected tests
|
|
@tests = @tests[ map { $_ - 1 } @ARGV ] if @ARGV;
|
|
|
|
################################################################################
|
|
#####List all tests
|
|
format test_list_top =
|
|
ID | Description
|
|
----+-------------------------------------------------------------------------
|
|
.
|
|
format test_list =
|
|
@>> | @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
|
|
$_->{'index'}, $_->{'desc'};
|
|
.
|
|
if ($list_tests) {
|
|
format_name STDOUT "test_list";
|
|
format_top_name STDOUT "test_list_top";
|
|
map { write; } @tests;
|
|
exit 0;
|
|
}
|
|
#####/list
|
|
|
|
################################################################################
|
|
# Run selected tests
|
|
foreach my $test (@tests) {
|
|
warn "Running test: $test->{desc}\n";
|
|
my $binary = 'sslh-ev';
|
|
my $code = ($test->{run})->($binary, $test);
|
|
}
|
|
|
|
stop_echosrv();
|
|
stop_sslh();
|
|
|
|
done_testing();
|
|
|
|
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;
|
|
|