#! /usr/bin/perl -w # Test script for sslh # The principle is to create two listening sockets which # will act as the ssh and ssl servers, and then perform a # number of connections in various combinations to check # that the server behaves properly. use strict; use IO::Socket::INET; use Test::More qw/no_plan/; # We use ports 9000, 9001 and 9002 -- hope that won't clash # with anything... my $ssh_port = 9000; my $ssl_port = 9001; my $sslh_port = 9002; my $pidfile = "/tmp/sslh.pid"; # How many connections will be created during the last test my $NUM_SSL_CNX = 20; my $NUM_SSH_CNX = 20; # Which tests do we run my $SSL_CNX = 1; my $SSH_SHY_CNX = 1; my $SSH_BOLD_CNX = 1; my $SSL_MIX_SSH = 1; my $SSH_MIX_SSL = 1; my $BIG_MSG = 1; my $MANY_CNX = 1; # the Listen parameter needs to be bigger than the max number of connexions # we'll make during the last test (we open a bunch of SSH connexions, and # accept them all at once afterwards) my $ssh_listen = new IO::Socket::INET(LocalHost=> "localhost:$ssh_port", Blocking => 1, Reuse => 1, Listen => $NUM_SSH_CNX + 1); die "error1: $!\n" unless $ssh_listen; my $ssl_listen = new IO::Socket::INET(LocalHost=> "localhost:$ssl_port", Blocking => 1, Reuse => 1, Listen => $NUM_SSL_CNX + 1); die "error2: $!\n" unless $ssl_listen; # Start sslh with the right plumbing my $sslh_pid; if (!($sslh_pid = fork)) { my $user = (getpwuid $<)[0]; # Run under current username exec "./sslh-fork -v -u $user -p localhost:$sslh_port -s localhost:$ssh_port -l localhost:$ssl_port -P $pidfile"; #exec "./sslh-select -v -f -u $user -p localhost:$sslh_port -s localhost:$ssh_port -l localhost:$ssl_port -P $pidfile"; #exec "valgrind --leak-check=full ./sslh-select -v -f -u $user -p localhost:$sslh_port -s localhost:$ssh_port -l localhost:$ssl_port -P $pidfile"; exit 0; } warn "spawned $sslh_pid\n"; sleep 1; my $test_data = "hello world\n"; # Test: SSL connection if ($SSL_CNX) { print "***Test: SSL connection\n"; my $cnx_l = new IO::Socket::INET(PeerHost => "localhost:$sslh_port"); warn "$!\n" unless $cnx_l; if (defined $cnx_l) { print $cnx_l $test_data; my $ssl_data = $ssl_listen->accept; my $data = <$ssl_data>; is($data, $test_data, "SSL connection"); } } # 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 3; my $ssh_data = $ssh_listen->accept; print $cnx_h $test_data; my $data = <$ssh_data>; is($data, $test_data, "Shy SSH connection"); } } # Test: Bold SSH connection if ($SSH_BOLD_CNX) { print "***Test: Bold SSH connection\n"; my $cnx_h = new IO::Socket::INET(PeerHost => "localhost:$sslh_port"); warn "$!\n" unless $cnx_h; if (defined $cnx_h) { my $td = "SSH-2.0 testsuite\n$test_data"; print $cnx_h $td; my $ssh_data = $ssh_listen->accept; my $data = <$ssh_data>; $data .= <$ssh_data>; is($data, $td, "Bold 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 $test_data; my $cnx_h= new IO::Socket::INET(PeerHost => "localhost:$sslh_port"); warn "$!\n" unless $cnx_h; if (defined $cnx_h) { sleep 3; my $ssh_data = $ssh_listen->accept; print $cnx_h $test_data; my $data_h = <$ssh_data>; is($data_h, $test_data, "SSH during SSL being established"); } my $ssl_data = $ssl_listen->accept; my $data = <$ssl_data>; is($data, $test_data, "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 $test_data; my $ssl_data = $ssl_listen->accept; my $data = <$ssl_data>; is($data, $test_data, "SSL during SSH being established"); } my $ssh_data = $ssh_listen->accept; print $cnx_h $test_data; my $data = <$ssh_data>; is($data, $test_data, "SSH connection interrupted by SSL"); } } # Test: Big messages if ($BIG_MSG) { print "***Test: big message\n"; my $cnx_l = new IO::Socket::INET(PeerHost => "localhost:$sslh_port"); warn "$!\n" unless $cnx_l; my $test_data2 = "helloworld"; my $rept = 10000; if (defined $cnx_l) { print $cnx_l ($test_data2 x $rept); print $cnx_l "\n"; my $ssl_data = $ssl_listen->accept; my $data = <$ssl_data>; is($data, $test_data2 x $rept . "\n", "Big message"); } } # Test: several connections active at once # We start 50 SSH connexions, then open 50 SSL connexion, then accept the 50 # SSH connexions, then we randomize the order of connexions and write 1000 # messages on each connexion and check we get it on the other end. if ($MANY_CNX) { print "***Test: several connexions active at once\n"; my (@cnx_h, @ssh_data); for (1..$NUM_SSH_CNX) { my $cnx_h = new IO::Socket::INET(PeerHost => "localhost:$sslh_port"); warn "----> $!\n" unless defined $cnx_h; if (defined $cnx_h) { push @cnx_h, $cnx_h; } } my (@cnx_l, @ssl_data); for (1..$NUM_SSL_CNX) { my $cnx_l = new IO::Socket::INET(PeerHost => "localhost:$sslh_port"); warn "----> $!\n" unless defined $cnx_l; if (defined $cnx_l) { push @cnx_l, $cnx_l; print $cnx_l " "; push @ssl_data, ($ssl_listen->accept)[0]; } } # give time to the connections to turn to SSH sleep 4; # and accept all SSH connections... for (1..$NUM_SSH_CNX) { push @ssh_data, $ssh_listen->accept; } # Make up a random order so we don't always hit the # connexions in the same order # fisher_yates_shuffle( \@array ) : generate a random permutation # of @array in place (from # http://docstore.mik.ua/orelly/perl/cookbook/ch04_18.htm, # modified to shuffle two arrays in the same way) sub fisher_yates_shuffle { my ($array1, $array2) = @_; my $i; for ($i = @$array1; --$i; ) { my $j = int rand ($i+1); next if $i == $j; @$array1[$i,$j] = @$array1[$j,$i]; @$array2[$i,$j] = @$array2[$j,$i]; } } my @cnx = (@cnx_l, @cnx_l); my @rcv = (@ssl_data, @ssl_data); fisher_yates_shuffle(\@rcv, \@cnx); # Send a bunch of messages for my $cnt (1..1000) { foreach (@cnx) { print $_ "$cnt$test_data"; } foreach (@rcv) { my $data = <$_>; like($data, qr/ ?$cnt$test_data/, "Multiple messages [$cnt]"); } } } kill 15, `cat $pidfile` or warn "kill: $!\n";