sslh/t_load

#! /usr/bin/perl -w

# Test script for sslh -- mass communication

# This creates many clients that perform concurrent
# connections, disconnect at any time, and try to generally
# behave as badly as possible.

# It can be used to test sslh behaves properly with many
# clients, however its main use is to get an idea of how
# much load it can take on your system before things start
# to go wrong.

use strict;
use IO::Socket::INET6;
use Data::Dumper;

## BEGIN TEST CONFIG

# Do we test sslh-select or sslh-fork?
my $sslh_binary = "./sslh-select";

# How many clients to we start for each protocol?
my $NUM_CNX = 30;

# Delay between starting new processes when starting up. If
# you start 200 processes in under a second, things go wrong
# and it's not sslh's fault (typically the echosrv won't be
# forking fast enough).
my $start_time_delay = 1;

# If you test 4 protocols, you'll start $NUM_CNX * 4 clients
# (e.g. 40), starting one every $start_time_delay seconds.

# Max times we repeat the test string: allows to test for
# large messages.
my $block_rpt = 4096;

# Probability to stop a client after a message (e.g. with
# .01 a client will send an average of 100 messages before
# disconnecting).
my $stop_client_probability = .001;

# What protocols we test, and on what ports
# Just comment out protocols you don't want to use.
my %protocols = (
    #"ssh" => { address => "localhost:9001", client => client("ssh") },
    #    "tls" => { address => "localhost:9002", client => client("tls") },
    "openvpn" => {address => "localhost:9004" },
    "tinc" => {address => "localhost:9003" },
);

##END CONFIG


my $sslh_address = "localhost:8080";
my $pidfile = "/tmp/sslh_test.pid";



sub connect_service {
    my ($cnx, $service) = @_;

    my ($test_data, $r);

    sleep 5 if $service eq "ssh";
    if ($service eq "openvpn") {
        $test_data = "\x00\x00";
        syswrite $cnx, $test_data;
        sleep 1;
        sysread $cnx, $r, 11; # length "openvpn: \x0\x0" => 11
    }
    if ($service eq "tinc") {
        $test_data = "0 ";
        syswrite $cnx, $test_data;
        sleep 1;
        sysread $cnx, $r, 8; # length "tinc: 0 " => 10 
    }
    my $expected = "$service: $test_data";
    return ($r eq $expected);
}


sub client {
    my ($service, $client_id, $fd_out) = @_;

    while (1) {
        my $r;
        my $cnx = new IO::Socket::INET(PeerHost => $sslh_address);
        die "$@\n" if (!$cnx);

        my $cnt = 0;

        warn "starting $service\n";

        if (not connect_service($cnx, $service)) {
            print $fd_out "$client_id\t0\tC\n";
            exit;
        }

        while (1) {
            my $test_data = "$service $cnt" x int(rand($block_rpt)+1) . "\n";
            print $cnx $test_data;
            $r = <$cnx>;
            my $expected= "$test_data";
            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 "$service got [$r] expected [$expected]\n") if ($r ne $expected);
            #last if rand(1) < $stop_client_probability;
            $cnt++;
        }
    }
    exit 0;
}

foreach my $p (keys %protocols) {
    if (!fork) {
        my $cmd = "./echosrv --listen $protocols{$p}->{address} --prefix '$p: '";
        print "$cmd\n";
        exec $cmd;
    }
}

# Start sslh with the right plumbing
my $sslh_pid;
if (0) {
if (!($sslh_pid = fork)) {
    my $user = (getpwuid $<)[0]; # Run under current username
    my $prots = join " ", map "--$_ $protocols{$_}->{address}", keys %protocols;
    my $cmd = "$sslh_binary -f -v3 -t 3 -u $user --listen $sslh_address $prots -P $pidfile";
    print "$cmd\n";
    exec $cmd;
    exit 0;
}
warn "spawned $sslh_pid\n";
sleep 2;  # valgrind can be heavy -- wait 5 seconds
}


my ($c_in, $c_out);
pipe $c_in, $c_out;

if (!fork) {
    # Process that starts all the clients
    for my $client_id (1 .. $NUM_CNX) {
        foreach my $p (keys %protocols) {
            if (!fork) {
                client($p, "$p$client_id", $c_out);
                exit;
            }
            # Give a little time so we don't overrun the
            # listen(2) backlog.
            select undef, undef, undef, $start_time_delay;
        }
    }
} else {
    my %data;

    # Process that retrieves client output to pretty print
    print "\033[2J";
    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} = [ $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";
        }
    }
}

wait;


`killall echosrv`;