moved UDP support from sslh-fork to sslh-select

This commit is contained in:
yrutschle committed 2021-07-01 22:44:35 +02:00
1 parent 24e7f46a43
commit 862e33cfec
10 files changed
+245 -125

No files matched your search

+78 -32
View File
@@ -18,12 +18,9 @@ use Conf::Libconfig;
## BEGIN TEST CONFIG
# Do we test sslh-select or sslh-fork?
my $sslh_binary = "./sslh-select";
# How many total clients to we start? Each client will pick
# a new protocol among what's in test.cfg.
my $NUM_CNX = 20;
my $NUM_CNX = 50;
# Delay between starting new processes when starting up. If
# you start 200 processes in under a second, things go wrong
@@ -33,7 +30,7 @@ my $start_time_delay = .5;
# Max times we repeat the test string: allows to test for
# large messages.
my $block_rpt = 4096;
my $block_rpt = 5;
# Probability to stop a client after a message (e.g. with
# .01 a client will send an average of 100 messages before
@@ -53,28 +50,33 @@ my ($sslh_tcp_address, $sslh_udp_address);
foreach my $l (@listen) {
if ($l->{is_udp}) {
$sslh_udp_address //= "$l->{host}:$l->{port}";
last if defined $sslh_tcp_address;
} else {
$sslh_tcp_address //= "$l->{host}:$l->{port}";
last if defined $sslh_udp_address;
}
last if defined $sslh_tcp_address and defined $sslh_udp_address;
}
# code snippets to connect to each protocol
my %connect_params = (
ssh => {
regex => {
is_udp => 1,
sleep => 0,
test_data => "foo bar",
resp_len => 12,
},
ssh => {
sleep => 20, # So it times out 50% of connections
test_data => "SSH-2.0 hello",
resp_len => 18, # length "ssh: SSH-2.0 hello" => 18
},
tinc => {
sleep => 10,
sleep => 0,
test_data => "0 ",
resp_len => 8, # length "tinc: 0 " => 10
},
openvpn => {
sleep => 10,
sleep => 0,
test_data => "\x00\x00",
resp_len => 11, # length "openvpn: \x0\x0" => 11
},
@@ -103,13 +105,13 @@ sub client {
while (1) {
my $r;
warn "$client_id: connect $sslh_tcp_address\n";
#warn "$client_id: connect $sslh_tcp_address\n";
my $cnx = new IO::Socket::INET(PeerHost => $sslh_tcp_address);
die "$@\n" if (!$cnx);
my $cnt = 0;
warn "$client_id: connecting $service\n";
#warn "$client_id: connecting $service\n";
if (not connect_service($cnx, $service)) {
print $fd_out "$client_id\t0\tC\n";
@@ -117,7 +119,7 @@ sub client {
exit;
}
warn "$client_id: shoveling $service\n";
#warn "$client_id: shoveling $service\n";
while (1) {
my $test_data = "$service $cnt" x int(rand($block_rpt)+1) . "\n";
@@ -141,26 +143,60 @@ sub client {
exit 0;
}
# For now, a simple regex client
sub udp_client {
my ($protocol, $client_id, $fd_out) = @_;
warn "UDP client starts\n";
while (1) {
my $cnx = new IO::Socket::INET(Proto => 'udp', PeerHost => $sslh_udp_address);
# my $cnx; socket $cnx, PF_INET, SOCK_DGRAM, 0 or die "socket: $!\n";
die "$@\n" if (!$cnx);
my $cnt = 0;
while (1) {
my $test_data = "foo udp $cnt"x int(rand($block_rpt)+1). "\n";
my $ipaddr = inet_aton("localhost");
my $portaddr = sockaddr_in(8086, $ipaddr);
my $res = send($cnx, $test_data, 0, $portaddr);
if ($res != length($test_data)) {
die "cannot sendto: $!";
}
my $expected= "$protocol->{name}: $test_data";
my $r;
defined(recv($cnx, $r, length $expected, 0)) or die "recv: $!\n";
my $r_l = length $r;
my $e_l = length $expected;
$fd_out->autoflush;
my $error = "";
$error = "M" if $r ne $expected;
print $fd_out ("$client_id\t$r_l\t$error\n");
($? = 1, die "udp got [$r] expected [$expected]\n") if ($r ne $expected);
if (rand(1) < $stop_client_probability) {
print $fd_out ("$client_id\t$r_l\tD\n");
last;
}
$cnt++;
}
}
}
foreach my $p (@{$conf->fetch_array("protocols")}) {
if (!fork) {
my $udp = $p->{is_udp} ? "--udp" : "";
my $cmd = "./echosrv $udp -p $p->{host}:$p->{port} --prefix '$p->{name}: '";
my $cmd = "./echosrv $udp -p $p->{host}:$p->{port} --prefix '$p->{name}: ' 2> /dev/null";
warn "$cmd\n";
exec $cmd;
exit;
}
}
# Start sslh with the right plumbing
my $sslh_pid;
if (0) {
if (!($sslh_pid = fork)) {
my $cmd = "$sslh_binary -F test.cfg";
warn "$cmd\n";
exec $cmd;
}
warn "spawned $sslh_pid\n";
}
warn "Don't forget to run sslh -F test.cfg!\n";
sleep 2; # Let echosrv's and sslh start
@@ -178,6 +214,7 @@ if (!fork) {
my @p = grep { $_->{name} eq $p_name } @protocols;
my $p = shift @p;
if ($p->{is_udp}) {
udp_client($p, "$p->{name}$client_num", $c_out);
} else {
client($p, "$p->{name}$client_num", $c_out);
}
@@ -194,22 +231,31 @@ if (!fork) {
# The condition here selects between pretty output or
# raw output
if (1) {
my $CLEAR_LINE = "\033[2K";
my $CURSOR_HOME = "\033[1;1H";
my $CLEAR_SCREEN = "\033[2J";
# Process that retrieves client output to pretty print
print "\033[2J";
print $CLEAR_SCREEN; # Clear screen
while (<$c_in>) {
chop;
my ($client_id, $r_l, $error, @rest) = split /\t/, $_;
my ($curr_rcv) = ${$data{$client_id}}[0];
my ($curr_error) = ${$data{$client_id}}[1] // "";
$data{$client_id} = [ 0, ""] if not exists $data{$client_id};
my ($curr_rcv) = ${$data{$client_id}}[0] + $r_l;;
$error //= "";
my ($curr_error) = "${$data{$client_id}}[1]$error";
$data{$client_id} = [ $r_l + $curr_rcv, "$curr_error$error" ];
print "\033[0;0H";
foreach my $i (sort keys %data) {
($r_l, $error) = @{$data{$i}};
print "\033[2K$i\t$r_l\t$error\n";
}
$client_id =~ /(\d+)/;
my $i = $1;
# print $CURSOR_HOME;
print "\033[$i;1H$CLEAR_LINE$client_id\t$curr_rcv\t$curr_error\n";
#foreach my $i (sort keys %data) {
# ($r_l, $error) = @{$data{$i}};
# print "$CLEAR_LINE$i\t$r_l\t$error\n";
}
} else {
# Just print the client outputs