also test probes when no fragmentation occurs

This commit is contained in:
Yves Rutschle 2018-08-12 21:45:42 +02:00
parent 3a17bd6832
commit b6db83a701

103
t
View File

@ -22,8 +22,8 @@ my $user = (getpwuid $<)[0]; # Run under current username
# Which tests do we run
my $SSH_SHY_CNX = 1;
my $SSH_PROBE_AGAIN = 1;
my $PROBES = 1;
my $PROBES_NOFRAG = 1;
my $PROBES_AGAIN = 1;
my $SSL_MIX_SSH = 1;
my $SSH_MIX_SSL = 1;
@ -49,6 +49,57 @@ sub verbose_exec
}
}
# Test all probes, with or without fragmentation
# options:
# no_frag: write test patterns all at once (also
# available per-protocol as some probes don't support
# fragmentation)
sub test_probes {
my (%opts) = @_;
my @probes = @{$conf->fetch_array("protocols")};
foreach my $p (@probes) {
my %protocols = (
'ssh' => { data => "SSH-2.0 tester" },
'socks5' => { data => "\x05\x04\x01\x02\x03\x04" },
'http' => {
data => "GET index.html HTTP/1.1",
no_frag => 1 },
'ssl' => { data => "\x16\x03\x031234" },
'openvpn' => { data => "\x00\x00" },
'tinc' => { data => "0 hello" },
'xmpp' => {data => "I should get a real jabber connection initialisation here" },
'adb' => { data => "CNXN....................host:..." },
'anyprot' => {data => "hello, this needs to be longer than the longest probe that returns PROBE_AGAIN" },
);
my $cnx = new IO::Socket::INET(PeerHost => "localhost:$sslh_port");
warn "$!\n" unless $cnx;
if (defined $cnx) {
my $pattern = $protocols{$p->{name}}->{data};
if ($opts{no_frag} or $protocols{$p->{name}}->{no_frag}) {
syswrite $cnx, $pattern;
} else {
while (length $pattern) {
syswrite $cnx, (substr $pattern, 0, 1, '');
select undef, undef, undef, .1;
}
}
my $data;
my $n = sysread $cnx, $data, 1024;
$data =~ /^(.*?): /;
my $prefix = $1;
$data =~ s/$prefix: //g;
print "Received: protocol $prefix data [$data]\n";
close $cnx;
is($prefix, $p->{name});
is($data, $protocols{$p->{name}}->{data});
}
}
}
# Start an echoserver for each service
foreach my $s (@{$conf->fetch_array("protocols")}) {
verbose_exec "./echosrv --listen $s->{host}:$s->{port} --prefix '$s->{name}: '";
@ -133,50 +184,12 @@ for my $binary (@binaries) {
}
# Test: probes. For each probe, write one byte at a time
# and check we get connected to the right server.
if ($PROBES) {
my @probes = @{$conf->fetch_array("protocols")};
foreach my $p (@probes) {
my %protocols = (
'ssh' => { data => "SSH-2.0 tester" },
'socks5' => { data => "\x05\x04\x01\x02\x03\x04" },
'http' => {
data => "GET index.html HTTP/1.1",
no_fragment => 1 },
'ssl' => { data => "\x16\x03\x031234" },
'openvpn' => { data => "\x00\x00" },
'tinc' => { data => "0 hello" },
'xmpp' => {data => "I should get a real jabber connection initialisation here" },
'adb' => { data => "CNXN....................host:..." },
'anyprot' => {data => "hello, this needs to be longer than the longest probe that returns PROBE_AGAIN" },
);
if ($PROBES_NOFRAG) {
test_probes(no_frag => 1);
}
my $cnx = new IO::Socket::INET(PeerHost => "localhost:$sslh_port");
warn "$!\n" unless $cnx;
if (defined $cnx) {
my $pattern = $protocols{$p->{name}}->{data};
if ($protocols{$p->{name}}->{no_fragment}) {
syswrite $cnx, $pattern;
} else {
while (length $pattern) {
syswrite $cnx, (substr $pattern, 0, 1, '');
select undef, undef, undef, .1;
}
}
my $data;
my $n = sysread $cnx, $data, 1024;
$data =~ /^(.*?): /;
my $prefix = $1;
$data =~ s/$prefix: //g;
print "Received: protocol $prefix data [$data]\n";
close $cnx;
is($prefix, $p->{name});
is($data, $protocols{$p->{name}}->{data});
}
}
if ($PROBES_AGAIN) {
test_probes;
}
my $pid = `cat $pidfile`;