git ssb

0+

cel / sslh



Tree: 63a83cf0416ab89720b15a4a649786812b630b79

Files: 63a83cf0416ab89720b15a4a649786812b630b79 / t_load

3713 bytesRaw
1#! /usr/bin/perl -w
2
3# Test script for sslh -- mass communication
4
5# This creates many clients that perform concurrent
6# connections, disconnect at any time, and try to generally
7# behave as badly as possible.
8
9# It can be used to test sslh behaves properly with many
10# clients, however its main use is to get an idea of how
11# much load it can take on your system before things start
12# to go wrong.
13
14use strict;
15use IO::Socket::INET6;
16use Data::Dumper;
17
18## BEGIN TEST CONFIG
19
20# Do we test sslh-select or sslh-fork?
21my $sslh_binary = "./sslh-select";
22
23# How many clients to we start for each protocol?
24my $NUM_CNX = 30;
25
26# Delay between starting new processes when starting up. If
27# you start 200 processes in under a second, things go wrong
28# and it's not sslh's fault (typically the echosrv won't be
29# forking fast enough).
30my $start_time_delay = 1;
31
32# If you test 4 protocols, you'll start $NUM_CNX * 4 clients
33# (e.g. 40), starting one every $start_time_delay seconds.
34
35# Max times we repeat the test string: allows to test for
36# large messages.
37my $block_rpt = 4096;
38
39# Probability to stop a client after a message (e.g. with
40# .01 a client will send an average of 100 messages before
41# disconnecting).
42my $stop_client_probability = .001;
43
44# What protocols we test, and on what ports
45# Just comment out protocols you don't want to use.
46my %protocols = (
47 "ssh" => { address => "localhost:9001", client => client("ssh") },
48 "ssl" => { address => "localhost:9002", client => client("ssl") },
49 "openvpn" => {address => "localhost:9003", client => client("openvpn") },
50 "tinc" => {address => "localhost:9004", client => client("tinc") },
51);
52
53##END CONFIG
54
55
56# We use ports 9000, 9001 and 9002 -- hope that won't clash
57# with anything...
58my $sslh_address = "localhost:9000";
59my $pidfile = "/tmp/sslh_test.pid";
60
61sub client {
62 my ($service) = @_;
63
64 return sub {
65 while (1) {
66 my $cnx = new IO::Socket::INET(PeerHost => $sslh_address);
67 my $test_data = "$service testing " x int(rand($block_rpt)+1) . "\n";
68
69 sleep 5 if $service eq "ssh";
70 if ($service eq "openvpn") {
71 syswrite $cnx, "\x00\x0F\x38\n";
72 my $msg;
73 sysread $cnx, $msg, 14; # length "openvpn: \x0\xF\x38\n" => 14
74 }
75 if ($service eq "tinc") {
76 syswrite $cnx, "0 \n";
77 my $msg;
78 sysread $cnx, $msg, 10; # length "tinc: 0 \n" => 10
79 }
80 while (1) {
81 print $cnx $test_data;
82 my $r = <$cnx>;
83 ($? = 1, die "$service got [$r]\n") if ($r ne "$service: $test_data");
84 last if rand(1) < $stop_client_probability;
85 }
86 }
87 exit 0;
88 }
89}
90
91foreach my $p (keys %protocols) {
92 if (!fork) {
93 exec "./echosrv --listen $protocols{$p}->{address} --prefix '$p: '";
94 }
95}
96
97# Start sslh with the right plumbing
98my $sslh_pid;
99if (!($sslh_pid = fork)) {
100 my $user = (getpwuid $<)[0]; # Run under current username
101 my $prots = join " ", map "--$_ $protocols{$_}->{address}", keys %protocols;
102 my $cmd = "$sslh_binary -f -t 3 -u $user --listen $sslh_address $prots -P $pidfile";
103 print "$cmd\n";
104 exec $cmd;
105 exit 0;
106}
107warn "spawned $sslh_pid\n";
108sleep 2; # valgrind can be heavy -- wait 5 seconds
109
110
111for (1 .. $NUM_CNX) {
112 foreach my $p (keys %protocols) {
113 if (!fork) {
114 warn "starting $p\n";
115 &{$protocols{$p}->{client}};
116 exit;
117 }
118 # Give a little time so we don't overrun the
119 # listen(2) backlog.
120 select undef, undef, undef, $start_time_delay;
121 }
122}
123
124wait;
125
126
127`killall echosrv`;
128
129

Built with git-ssb-web