mirror of
https://github.com/nmap/nmap.git
synced 2026-02-07 05:56:34 +00:00
73d4b0f0a0
This patch adds tests for idle timeout in listen mode for all supported protocols. It also modifies existing test for idle time in connection mode to test the option for all supported protocols. Signed-off-by: Tomas Hozza <thozza@redhat.com>
2690 lines
83 KiB
Perl
Executable File
2690 lines
83 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
|
|
# This file contains tests of the external behavior of Ncat.
|
|
|
|
require HTTP::Response;
|
|
require HTTP::Request;
|
|
|
|
use MIME::Base64;
|
|
use File::Temp qw/ tempfile /;
|
|
use URI::Escape;
|
|
use Data::Dumper;
|
|
use Socket;
|
|
use Digest::MD5 qw/md5_hex/;
|
|
use POSIX ":sys_wait_h";
|
|
|
|
use IPC::Open3;
|
|
use strict;
|
|
|
|
my $NCAT = "../ncat";
|
|
my $HOST = "localhost";
|
|
my $IPV6_ADDR = "::1";
|
|
my $PORT = 40000;
|
|
my $PROXY_PORT = 40001;
|
|
my $UNIXSOCK = "ncat.unixsock";
|
|
my $UNIXSOCK_TMP = "ncat.unixsock_tmp";
|
|
|
|
my $BUFSIZ = 1024;
|
|
|
|
my $num_tests = 0;
|
|
my $num_failures = 0;
|
|
my $num_expected_failures = 0;
|
|
my $num_unexpected_passes = 0;
|
|
|
|
# If true during a test, failure is expected (XFAIL).
|
|
our $xfail = 0;
|
|
|
|
# Run $NCAT with the given arguments.
|
|
sub ncat {
|
|
my $pid;
|
|
local *IN;
|
|
local *OUT;
|
|
local *ERR;
|
|
# print join(" ", ($NCAT, @_)) . "\n";
|
|
$pid = open3(*IN, *OUT, *ERR, $NCAT, @_);
|
|
if (!defined $pid) {
|
|
die "open2 failed";
|
|
}
|
|
return ($pid, *OUT, *IN, *ERR);
|
|
}
|
|
|
|
sub ncat_server {
|
|
my @ret = ncat($HOST, $PORT, "-l", @_);
|
|
# Give it a moment to start up.
|
|
select(undef, undef, undef, 0.3);
|
|
return @ret;
|
|
}
|
|
|
|
sub ncat_client {
|
|
my @ret = ncat($HOST, $PORT, @_);
|
|
# Give it a moment to connect.
|
|
select(undef, undef, undef, 0.1);
|
|
return @ret;
|
|
}
|
|
|
|
# Kill all child processes.
|
|
sub kill_children {
|
|
local $SIG{TERM} = "IGNORE";
|
|
kill "TERM", -$$;
|
|
while (waitpid(-1, 0) > 0) {
|
|
}
|
|
}
|
|
|
|
# Read until a timeout occurs. Return undef on EOF or "" on timeout.
|
|
sub timeout_read {
|
|
my $fh = shift;
|
|
my $timeout = 0.50;
|
|
if (scalar(@_) > 0) {
|
|
$timeout = shift;
|
|
}
|
|
my $result = "";
|
|
my $rd = "";
|
|
my $frag;
|
|
vec($rd, fileno($fh), 1) = 1;
|
|
# Here we rely on $timeout being decremented after select returns,
|
|
# which may not be supported on all systems.
|
|
while (select($rd, undef, undef, $timeout) != 0) {
|
|
return ($result or undef) if sysread($fh, $frag, $BUFSIZ) == 0;
|
|
$result .= $frag;
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
$Data::Dumper::Terse = 1;
|
|
$Data::Dumper::Useqq = 1;
|
|
$Data::Dumper::Indent = 0;
|
|
sub d {
|
|
return Dumper(@_);
|
|
}
|
|
|
|
# Run the code reference received as an argument. Count it as a pass if the
|
|
# evaluation is successful, a failure otherwise.
|
|
sub test {
|
|
my $desc = shift;
|
|
my $code = shift;
|
|
$num_tests++;
|
|
if (eval { &$code() }) {
|
|
if ($xfail) {
|
|
print "UNEXPECTED PASS $desc\n";
|
|
$num_unexpected_passes++;
|
|
} else {
|
|
print "PASS $desc\n";
|
|
}
|
|
} else {
|
|
if ($xfail) {
|
|
$num_expected_failures++;
|
|
print "XFAIL $desc\n";
|
|
} else {
|
|
$num_failures++;
|
|
print "FAIL $desc\n";
|
|
print " $@";
|
|
}
|
|
}
|
|
}
|
|
|
|
my ($s_pid, $s_out, $s_in, $c_pid, $c_out, $c_in, $p_pid, $p_out, $p_in);
|
|
|
|
# Handle a common test situation. Start up a server and client with the given
|
|
# arguments and call test on a code block. Within the code block the server's
|
|
# PID, output filehandle, and input filehandle are accessible through
|
|
# $s_pid, $s_out, and $s_in
|
|
# and likewise for the client:
|
|
# $c_pid, $c_out, and $c_in.
|
|
sub server_client_test {
|
|
my $desc = shift;
|
|
my $server_args = shift;
|
|
my $client_args = shift;
|
|
my $code = shift;
|
|
($s_pid, $s_out, $s_in) = ncat_server(@$server_args);
|
|
($c_pid, $c_out, $c_in) = ncat_client(@$client_args);
|
|
test($desc, $code);
|
|
kill_children;
|
|
}
|
|
|
|
sub server_client_test_multi {
|
|
my $specs = shift;
|
|
my $desc = shift;
|
|
my $server_args_ref = shift;
|
|
my $client_args_ref = shift;
|
|
my $code = shift;
|
|
my $outer_xfail = $xfail;
|
|
local $xfail;
|
|
|
|
for my $spec (@$specs) {
|
|
my @server_args = @$server_args_ref;
|
|
my @client_args = @$client_args_ref;
|
|
|
|
$xfail = $outer_xfail;
|
|
for my $proto (split(/ /, $spec)) {
|
|
if ($proto eq "tcp") {
|
|
# Nothing needed.
|
|
} elsif ($proto eq "udp") {
|
|
push @server_args, ("--udp");
|
|
push @client_args, ("--udp");
|
|
} elsif ($proto eq "sctp") {
|
|
push @server_args, ("--sctp");
|
|
push @client_args, ("--sctp");
|
|
} elsif ($proto eq "ssl") {
|
|
push @server_args, ("--ssl", "--ssl-key", "test-cert.pem", "--ssl-cert", "test-cert.pem");
|
|
push @client_args, ("--ssl");
|
|
} elsif ($proto eq "xfail") {
|
|
$xfail = 1;
|
|
} else {
|
|
die "Unknown protocol $proto";
|
|
}
|
|
}
|
|
server_client_test("$desc ($spec)", [@server_args], [@client_args], $code);
|
|
}
|
|
}
|
|
|
|
# Like server_client_test, but run the test once each for each mix of TCP, UDP,
|
|
# SCTP, and SSL.
|
|
sub server_client_test_all {
|
|
server_client_test_multi(["tcp", "udp", "sctp", "tcp ssl", "sctp ssl"], @_);
|
|
}
|
|
|
|
sub server_client_test_tcp_sctp_ssl {
|
|
server_client_test_multi(["tcp", "sctp", "tcp ssl", "sctp ssl"], @_);
|
|
}
|
|
|
|
sub server_client_test_tcp_ssl {
|
|
server_client_test_multi(["tcp", "tcp ssl"], @_);
|
|
}
|
|
|
|
sub server_client_test_sctp_ssl {
|
|
server_client_test_multi(["sctp", "sctp ssl"], @_);
|
|
}
|
|
|
|
# Set up a proxy running on $PROXY_PORT. Start a server on $PORT and connect a
|
|
# client to the server through the proxy. The proxy is controlled through the
|
|
# variables
|
|
# $p_pid, $p_out, and $p_in.
|
|
sub proxy_test {
|
|
my $desc = shift;
|
|
my $proxy_args = shift;
|
|
my $server_args = shift;
|
|
my $client_args = shift;
|
|
my $code = shift;
|
|
($p_pid, $p_out, $p_in) = ncat(($HOST, $PROXY_PORT, "-l", "--proxy-type", "http"), @$proxy_args);
|
|
($s_pid, $s_out, $s_in) = ncat(($HOST, $PORT, "-l"), @$server_args);
|
|
($c_pid, $c_out, $c_in) = ncat(($HOST, $PORT, "--proxy", "$HOST:$PROXY_PORT"), @$client_args);
|
|
test($desc, $code);
|
|
kill_children;
|
|
}
|
|
|
|
# Like proxy_test, but connect the client directly to the proxy so you can
|
|
# control the proxy interaction.
|
|
sub proxy_test_raw {
|
|
my $desc = shift;
|
|
my $proxy_args = shift;
|
|
my $server_args = shift;
|
|
my $client_args = shift;
|
|
my $code = shift;
|
|
($p_pid, $p_out, $p_in) = ncat(($HOST, $PROXY_PORT, "-l", "--proxy-type", "http"), @$proxy_args);
|
|
($s_pid, $s_out, $s_in) = ncat(($HOST, $PORT, "-l"), @$server_args);
|
|
($c_pid, $c_out, $c_in) = ncat(($HOST, $PROXY_PORT), @$client_args);
|
|
test($desc, $code);
|
|
kill_children;
|
|
}
|
|
|
|
sub proxy_test_multi {
|
|
my $specs = shift;
|
|
my $desc = shift;
|
|
my $proxy_args_ref = shift;
|
|
my $server_args_ref = shift;
|
|
my $client_args_ref = shift;
|
|
my $code = shift;
|
|
my $outer_xfail = $xfail;
|
|
local $xfail;
|
|
|
|
for my $spec (@$specs) {
|
|
my @proxy_args = @$proxy_args_ref;
|
|
my @server_args = @$server_args_ref;
|
|
my @client_args = @$client_args_ref;
|
|
|
|
$xfail = $outer_xfail;
|
|
for my $proto (split(/ /, $spec)) {
|
|
if ($proto eq "tcp") {
|
|
# Nothing needed.
|
|
} elsif ($proto eq "udp") {
|
|
push @server_args, ("--udp");
|
|
push @client_args, ("--udp");
|
|
} elsif ($proto eq "sctp") {
|
|
push @server_args, ("--sctp");
|
|
push @client_args, ("--sctp");
|
|
} elsif ($proto eq "ssl") {
|
|
push @server_args, ("--ssl", "--ssl-key", "test-cert.pem", "--ssl-cert", "test-cert.pem");
|
|
push @client_args, ("--ssl");
|
|
} elsif ($proto eq "xfail") {
|
|
$xfail = 1;
|
|
} else {
|
|
die "Unknown protocol $proto";
|
|
}
|
|
}
|
|
proxy_test("$desc ($spec)", [@proxy_args], [@server_args], [@client_args], $code);
|
|
}
|
|
}
|
|
|
|
sub max_conns_test {
|
|
my $desc = shift;
|
|
my $server_args = shift;
|
|
my $client_args = shift;
|
|
my $count = shift;
|
|
my @client_pids;
|
|
my @client_outs;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server(@$server_args, ("--max-conns", $count));
|
|
test $desc, sub {
|
|
my ($i, $resp);
|
|
|
|
# Fill the connection limit exactly.
|
|
for ($i = 0; $i < $count; $i++) {
|
|
my @tmp;
|
|
($c_pid, $c_out, $c_in) = ncat_client(@$client_args);
|
|
push @client_pids, $c_pid;
|
|
push @client_outs, $c_out;
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out, 2.0);
|
|
if (!$resp) {
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out);
|
|
}
|
|
$resp = "" if not defined($resp);
|
|
$resp eq "abc\n" or die "--max-conns $count server did not accept client #" . ($i + 1);
|
|
}
|
|
# Try a few more times. Should be rejected.
|
|
for (; $i < $count + 2; $i++) {
|
|
($c_pid, $c_out, $c_in) = ncat_client(@$client_args);
|
|
push @client_pids, $c_pid;
|
|
push @client_outs, $c_out;
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out, 2.0);
|
|
if (!$resp) {
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out);
|
|
}
|
|
!$resp or die "--max-conns $count server accepted client #" . ($i + 1);
|
|
}
|
|
# Kill one of the connected clients, which should open up a
|
|
# space.
|
|
{
|
|
kill "TERM", $client_pids[0];
|
|
while (waitpid($client_pids[0], 0) > 0) {
|
|
}
|
|
shift @client_pids;
|
|
shift @client_outs;
|
|
sleep 2;
|
|
}
|
|
if ($count > 0) {
|
|
($c_pid, $c_out, $c_in) = ncat_client(@$client_args);
|
|
push @client_pids, $c_pid;
|
|
push @client_outs, $c_out;
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out, 2.0);
|
|
if (!$resp) {
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out);
|
|
}
|
|
$resp = "" if not defined($resp);
|
|
$resp eq "abc\n" or die "--max-conns $count server did not accept client #$count after freeing one space";
|
|
}
|
|
return 1;
|
|
};
|
|
kill_children;
|
|
}
|
|
|
|
sub max_conns_test_multi {
|
|
my $specs = shift;
|
|
my $desc = shift;
|
|
my $server_args_ref = shift;
|
|
my $client_args_ref = shift;
|
|
my $count = shift;
|
|
my $outer_xfail = $xfail;
|
|
local $xfail;
|
|
|
|
for my $spec (@$specs) {
|
|
my @server_args = @$server_args_ref;
|
|
my @client_args = @$client_args_ref;
|
|
|
|
$xfail = $outer_xfail;
|
|
for my $proto (split(/ /, $spec)) {
|
|
if ($proto eq "tcp") {
|
|
# Nothing needed.
|
|
} elsif ($proto eq "udp") {
|
|
push @server_args, ("--udp");
|
|
push @client_args, ("--udp");
|
|
} elsif ($proto eq "sctp") {
|
|
push @server_args, ("--sctp");
|
|
push @client_args, ("--sctp");
|
|
} elsif ($proto eq "ssl") {
|
|
push @server_args, ("--ssl", "--ssl-key", "test-cert.pem", "--ssl-cert", "test-cert.pem");
|
|
push @client_args, ("--ssl");
|
|
} elsif ($proto eq "xfail") {
|
|
$xfail = 1;
|
|
} else {
|
|
die "Unknown protocol $proto";
|
|
}
|
|
}
|
|
max_conns_test("$desc ($spec)", [@server_args], [@client_args], $count);
|
|
}
|
|
}
|
|
|
|
sub max_conns_test_all {
|
|
max_conns_test_multi(["tcp", "udp", "sctp", "tcp ssl", "sctp ssl"], @_);
|
|
}
|
|
|
|
sub max_conns_test_tcp_sctp_ssl {
|
|
max_conns_test_multi(["tcp", "sctp", "tcp ssl", "sctp ssl"], @_);
|
|
}
|
|
|
|
sub max_conns_test_tcp_ssl {
|
|
max_conns_test_multi(["tcp", "tcp ssl"], @_);
|
|
}
|
|
|
|
# Ignore broken pipe signals that result when trying to read from a terminated
|
|
# client.
|
|
$SIG{PIPE} = "IGNORE";
|
|
# Don't have to wait on children.
|
|
$SIG{CHLD} = "IGNORE";
|
|
|
|
# Individual tests begin here.
|
|
|
|
# Test server with no hostname or port.
|
|
($s_pid, $s_out, $s_in) = ncat("-lk");
|
|
test "Server default listen address and port",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat($HOST);
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
|
|
my ($c_pid2, $c_out2, $c_in2) = ncat("-6", $IPV6_ADDR);
|
|
syswrite($c_in2, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat("-4", "-lk");
|
|
test "Server -4 default listen address and port",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat($HOST);
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat("-6", "-lk");
|
|
test "Server -6 default listen address and port",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat("-6", $IPV6_ADDR);
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
# Test server with no hostname.
|
|
($s_pid, $s_out, $s_in) = ncat("-l", $HOST);
|
|
test "Server default port",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat($HOST);
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
# Test server with no port.
|
|
($s_pid, $s_out, $s_in) = ncat("-l", $PORT);
|
|
test "Server default listen address",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat($HOST, $PORT);
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
# Test server with UDP.
|
|
($s_pid, $s_out, $s_in) = ncat("-l", "--udp");
|
|
test "Server default listen address --udp IPV4",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat("localhost", "--udp");
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\" from localhost";
|
|
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat("-l", "--udp");
|
|
test "Server default listen address --udp IPV6",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c_pid1, $c_out1, $c_in1) = ncat("::1", "--udp");
|
|
syswrite($c_in1, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\" from ::1";
|
|
};
|
|
kill_children;
|
|
|
|
{
|
|
local $xfail = 1;
|
|
($s_pid, $s_out, $s_in) = ncat("-l", "--udp");
|
|
test "Server default listen address --udp IPV4 + IPV6",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat("localhost", "--udp");
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\" from localhost";
|
|
|
|
my ($c_pid1, $c_out1, $c_in1) = ncat("::1", "--udp");
|
|
syswrite($c_in1, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\" from ::1";
|
|
};
|
|
kill_children;
|
|
};
|
|
|
|
($s_pid, $s_out, $s_in) = ncat("-l", "-6", "--udp");
|
|
test "Server default listen address -6 --udp",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat("localhost", "--udp");
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server got \"$resp\", not \"\" from localhost";
|
|
|
|
my ($c_pid1, $c_out1, $c_in1) = ncat("::1", "--udp");
|
|
syswrite($c_in1, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\" from ::1";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat("-l", "-4", "--udp");
|
|
test "Server default listen address -4 --udp",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat("localhost", "--udp");
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\" from localhost";
|
|
|
|
my ($c_pid1, $c_out1, $c_in1) = ncat("::1", "--udp");
|
|
syswrite($c_in1, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server got \"$resp\", not \"\" from ::1";
|
|
};
|
|
kill_children;
|
|
|
|
# Test UNIX domain sockets listening
|
|
($s_pid, $s_out, $s_in) = ncat("-l", "-U", $UNIXSOCK);
|
|
test "Server UNIX socket listen on $UNIXSOCK (STREAM)",
|
|
sub {
|
|
my $resp;
|
|
|
|
unlink($UNIXSOCK);
|
|
my ($c_pid, $c_out, $c_in) = ncat("-U", $UNIXSOCK);
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\" from client";
|
|
};
|
|
kill_children;
|
|
unlink($UNIXSOCK);
|
|
|
|
($s_pid, $s_out, $s_in) = ncat("-l", "-U", "--udp", $UNIXSOCK);
|
|
test "Server UNIX socket listen on $UNIXSOCK --udp (DGRAM)",
|
|
sub {
|
|
my $resp;
|
|
|
|
unlink($UNIXSOCK);
|
|
my ($c_pid, $c_out, $c_in) = ncat("-U", "--udp", $UNIXSOCK);
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\" from client";
|
|
};
|
|
kill_children;
|
|
unlink($UNIXSOCK);
|
|
|
|
server_client_test "Connect success exit code",
|
|
[], ["--send-only"], sub {
|
|
my ($pid, $code);
|
|
local $SIG{CHLD} = sub { };
|
|
|
|
syswrite($c_in, "abc\n");
|
|
close($c_in);
|
|
do {
|
|
$pid = waitpid($c_pid, 0);
|
|
} while ($pid > 0 && $pid != $c_pid);
|
|
$pid == $c_pid or die;
|
|
$code = $? >> 8;
|
|
$code == 0 or die "Exit code was $code, not 0";
|
|
};
|
|
kill_children;
|
|
|
|
test "Connect connection refused exit code",
|
|
sub {
|
|
my ($pid, $code);
|
|
local $SIG{CHLD} = sub { };
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat($HOST, $PORT, "--send-only");
|
|
syswrite($c_in, "abc\n");
|
|
close($c_in);
|
|
do {
|
|
$pid = waitpid($c_pid, 0);
|
|
} while ($pid > 0 && $pid != $c_pid);
|
|
$pid == $c_pid or die;
|
|
$code = $? >> 8;
|
|
$code == 1 or die "Exit code was $code, not 1";
|
|
};
|
|
kill_children;
|
|
|
|
test "Connect connection interrupted exit code",
|
|
sub {
|
|
my ($pid, $code);
|
|
local $SIG{CHLD} = sub { };
|
|
local *SOCK;
|
|
local *S;
|
|
|
|
socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname("tcp")) or die;
|
|
setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die;
|
|
bind(SOCK, sockaddr_in($PORT, INADDR_ANY)) or die;
|
|
listen(SOCK, 1) or die;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat($HOST, $PORT);
|
|
|
|
accept(S, SOCK) or die;
|
|
# Shut down the socket with a RST.
|
|
setsockopt(S, SOL_SOCKET, SO_LINGER, pack("II", 1, 0)) or die;
|
|
close(S) or die;
|
|
|
|
do {
|
|
$pid = waitpid($c_pid, 0);
|
|
} while ($pid > 0 && $pid != $c_pid);
|
|
$pid == $c_pid or die;
|
|
$code = $? >> 8;
|
|
$code == 1 or die "Exit code was $code, not 1";
|
|
};
|
|
kill_children;
|
|
|
|
server_client_test "Listen success exit code",
|
|
[], ["--send-only"], sub {
|
|
my ($resp, $pid, $code);
|
|
local $SIG{CHLD} = sub { };
|
|
|
|
syswrite($c_in, "abc\n");
|
|
close($c_in);
|
|
do {
|
|
$pid = waitpid($s_pid, 0);
|
|
} while ($pid > 0 && $pid != $s_pid);
|
|
$pid == $s_pid or die "$pid != $s_pid";
|
|
$code = $? >> 8;
|
|
$code == 0 or die "Exit code was $code, not 0";
|
|
};
|
|
kill_children;
|
|
|
|
test "Listen connection interrupted exit code",
|
|
sub {
|
|
my ($pid, $code);
|
|
local $SIG{CHLD} = sub { };
|
|
local *SOCK;
|
|
|
|
my ($s_pid, $s_out, $s_in) = ncat_server();
|
|
|
|
socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname("tcp")) or die;
|
|
my $addr = gethostbyname($HOST);
|
|
connect(SOCK, sockaddr_in($PORT, $addr)) or die;
|
|
# Shut down the socket with a RST.
|
|
setsockopt(SOCK, SOL_SOCKET, SO_LINGER, pack("II", 1, 0)) or die;
|
|
close(SOCK) or die;
|
|
|
|
do {
|
|
$pid = waitpid($s_pid, 0);
|
|
} while ($pid > 0 && $pid != $s_pid);
|
|
$pid == $s_pid or die;
|
|
$code = $? >> 8;
|
|
$code == 1 or die "Exit code was $code, not 1";
|
|
};
|
|
kill_children;
|
|
|
|
test "Program error exit code",
|
|
sub {
|
|
my ($pid, $code);
|
|
local $SIG{CHLD} = sub { };
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat($HOST, $PORT, "--baffle");
|
|
do {
|
|
$pid = waitpid($c_pid, 0);
|
|
} while ($pid > 0 && $pid != $c_pid);
|
|
$pid == $c_pid or die;
|
|
$code = $? >> 8;
|
|
$code == 2 or die "Exit code was $code, not 2";
|
|
|
|
my ($s_pid, $s_out, $s_in) = ncat_server("--baffle");
|
|
do {
|
|
$pid = waitpid($s_pid, 0);
|
|
} while ($pid > 0 && $pid != $s_pid);
|
|
$pid == $s_pid or die;
|
|
$code = $? >> 8;
|
|
$code == 2 or die "Exit code was $code, not 2";
|
|
};
|
|
kill_children;
|
|
|
|
server_client_test_all "Messages are logged to output file",
|
|
["--output", "server.log"], ["--output", "client.log"], sub {
|
|
|
|
syswrite($c_in, "abc\n");
|
|
sleep 1;
|
|
syswrite($s_in, "def\n");
|
|
sleep 1;
|
|
close($c_in);
|
|
open(FH, "server.log");
|
|
my $contents = join("", <FH>);
|
|
close(FH);
|
|
$contents eq "abc\ndef\n" or die "Server logged " . d($contents);
|
|
open(FH, "client.log");
|
|
$contents = join("", <FH>);
|
|
close(FH);
|
|
$contents eq "abc\ndef\n" or die "Client logged " . d($contents);
|
|
};
|
|
unlink "server.log";
|
|
unlink "client.log";
|
|
kill_children;
|
|
|
|
server_client_test_tcp_sctp_ssl "Debug messages go to stderr",
|
|
["-vvv"], ["-vvv"], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
{
|
|
local $xfail = 1;
|
|
server_client_test_tcp_ssl "Client closes socket write and keeps running after stdin EOF",
|
|
[], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
|
|
close($c_in);
|
|
|
|
$resp = timeout_read($s_out);
|
|
!defined($resp) or die "Server didn't get EOF (got \"$resp\")";
|
|
sleep 1;
|
|
waitpid($c_pid, WNOHANG) != -1 or die "Client stopped running";
|
|
};
|
|
kill_children;
|
|
}
|
|
|
|
server_client_test_tcp_ssl "--send-only client closes socket write and stops running after stdin EOF",
|
|
[], ["--send-only"], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
|
|
close($c_in);
|
|
|
|
$resp = timeout_read($s_out);
|
|
!defined($resp) or die "Server didn't get EOF (got \"$resp\")";
|
|
sleep 1;
|
|
waitpid($c_pid, WNOHANG) == -1 or die "Client still running";
|
|
};
|
|
kill_children;
|
|
|
|
server_client_test_tcp_ssl "Server closes socket write and keeps running after stdin EOF",
|
|
[], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Client got \"$resp\", not \"abc\\n\"";
|
|
|
|
close($s_in);
|
|
|
|
$resp = timeout_read($c_out);
|
|
!defined($resp) or die "Client didn't get EOF (got \"$resp\")";
|
|
sleep 1;
|
|
waitpid($s_pid, WNOHANG) != -1 or die "Server stopped running";
|
|
};
|
|
kill_children;
|
|
|
|
server_client_test_tcp_ssl "--send-only server closes socket write and stops running after stdin EOF",
|
|
["--send-only"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Client got \"$resp\", not \"abc\\n\"";
|
|
|
|
close($s_in);
|
|
|
|
$resp = timeout_read($c_out);
|
|
!defined($resp) or die "Client didn't get EOF (got \"$resp\")";
|
|
sleep 1;
|
|
waitpid($s_pid, WNOHANG) == -1 or die "Server still running";
|
|
};
|
|
kill_children;
|
|
|
|
server_client_test_tcp_ssl "Client closes stdout and keeps running after socket EOF",
|
|
[], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Client got \"$resp\", not \"abc\\n\"";
|
|
|
|
close($s_in);
|
|
|
|
$resp = timeout_read($c_out);
|
|
!defined($resp) or die "Client didn't get EOF and didn't exit (got \"$resp\")";
|
|
sleep 1;
|
|
waitpid($c_pid, WNOHANG) != -1 or die "Client stopped running";
|
|
};
|
|
kill_children;
|
|
|
|
# SCTP doesn't have half-open sockets, so the program should exit.
|
|
# http://seclists.org/nmap-dev/2013/q1/203
|
|
server_client_test_sctp_ssl "Client closes stdout and stops running after socket EOF",
|
|
[], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Client got \"$resp\", not \"abc\\n\"";
|
|
|
|
close($s_in);
|
|
|
|
$resp = timeout_read($c_out);
|
|
!defined($resp) or die "Client didn't get EOF and didn't exit (got \"$resp\")";
|
|
sleep 1;
|
|
waitpid($c_pid, WNOHANG) == -1 or die "Client still running";
|
|
};
|
|
kill_children;
|
|
|
|
server_client_test_tcp_sctp_ssl "--recv-only client closes stdout and stops running after socket EOF",
|
|
[], ["--recv-only"], sub {
|
|
my $resp;
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Client got \"$resp\", not \"abc\\n\"";
|
|
|
|
close($s_in);
|
|
|
|
$resp = timeout_read($c_out);
|
|
!defined($resp) or die "Client didn't get EOF and didn't exit (got \"$resp\")";
|
|
sleep 1;
|
|
waitpid($c_pid, WNOHANG) == -1 or die "Client still running";
|
|
};
|
|
kill_children;
|
|
|
|
# Test that the server closes its output stream after a client disconnects.
|
|
# This is for uses like
|
|
# ncat -l | tar xzvf -
|
|
# tar czf - <files> | ncat localhost --send-only
|
|
# where tar on the listening side could be any program that potentially buffers
|
|
# its input. The listener must close its standard output so the program knows
|
|
# to stop reading and process what remains in its buffer.
|
|
{
|
|
# XFAIL because of http://seclists.org/nmap-dev/2013/q1/227. The "close stdout"
|
|
# part works, but not the "server keeps running" part.
|
|
local $xfail = 1;
|
|
server_client_test_tcp_ssl "Server closes stdout and keeps running after socket EOF",
|
|
[], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
|
|
close($c_in);
|
|
|
|
$resp = timeout_read($s_out);
|
|
!defined($resp) or die "Server didn't send EOF";
|
|
sleep 1;
|
|
waitpid($s_pid, WNOHANG) != -1 or die "Server stopped running";
|
|
};
|
|
kill_children;
|
|
}
|
|
|
|
server_client_test_sctp_ssl "Server closes stdout and stops running after socket EOF",
|
|
[], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
|
|
close($c_in);
|
|
|
|
$resp = timeout_read($s_out);
|
|
!defined($resp) or die "Server didn't send EOF";
|
|
sleep 1;
|
|
waitpid($s_pid, WNOHANG) == -1 or die "Server still running";
|
|
};
|
|
kill_children;
|
|
|
|
server_client_test_tcp_sctp_ssl "--recv-only server closes stdout and stops running after socket EOF",
|
|
["--recv-only"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
|
|
close($c_in);
|
|
|
|
$resp = timeout_read($s_out);
|
|
!defined($resp) or die "Server didn't send EOF";
|
|
sleep 1;
|
|
waitpid($s_pid, WNOHANG) == -1 or die "Server still running";
|
|
};
|
|
kill_children;
|
|
|
|
# Tests to check that server defaults to non-persistent without --keep-open.
|
|
|
|
# Server immediately quits after the first connection closed without --keep-open
|
|
($s_pid, $s_out, $s_in) = ncat_server();
|
|
test "Server quits without --keep-open",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
kill "TERM", $c_pid;
|
|
while (waitpid($c_pid, 0) > 0) {
|
|
}
|
|
sleep 1;
|
|
# -1 because children are automatically reaped; 0 means it's still running.
|
|
waitpid($s_pid, WNOHANG) == -1 or die "Server still running";
|
|
};
|
|
kill_children;
|
|
|
|
# Server with --exec immediately quits after the first connection closed without --keep-open
|
|
($s_pid, $s_out, $s_in) = ncat_server("--exec", "/bin/cat");
|
|
test "Server with --exec quits without --keep-open",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($c_out);
|
|
$resp eq "abc\n" or die "Client got back \"$resp\", not \"abc\\n\"";
|
|
kill "TERM", $c_pid;
|
|
while (waitpid($c_pid, 0) > 0) {
|
|
}
|
|
sleep 1;
|
|
waitpid($s_pid, WNOHANG) == -1 or die "Server still running";
|
|
};
|
|
kill_children;
|
|
|
|
# Server immediately quits after the first connection ssl negotiation fails without --keep-open
|
|
{
|
|
($s_pid, $s_out, $s_in) = ncat_server("--ssl");
|
|
test "Server quits after a failed ssl negotiation without --keep-open",
|
|
sub {
|
|
my $resp;
|
|
|
|
# Let's sleep for one second here, since in some cases the server might not
|
|
# get the chance to start listening before the client tries to connect.
|
|
sleep 1;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
syswrite($c_in, "abc\n");
|
|
|
|
kill "TERM", $c_pid;
|
|
while (waitpid($c_pid, 0) > 0) {
|
|
}
|
|
sleep 1;
|
|
# -1 because children are automatically reaped; 0 means it's still running.
|
|
waitpid($s_pid, WNOHANG) == -1 or die "Server still running";
|
|
};
|
|
kill_children;
|
|
}
|
|
|
|
# Server does not accept multiple connections without --keep-open
|
|
($s_pid, $s_out, $s_in) = ncat_server();
|
|
test "Server does not accept multiple conns. without --keep-open",
|
|
sub {
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client();
|
|
|
|
sleep 1;
|
|
|
|
waitpid($c2_pid, WNOHANG) == -1 or die "A second client could connect to the server";
|
|
|
|
};
|
|
kill_children;
|
|
|
|
# Test server persistence with --keep-open.
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--keep-open");
|
|
test "--keep-open",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
syswrite($c1_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client();
|
|
syswrite($c2_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--keep-open", "--exec", "/bin/cat");
|
|
test "--keep-open --exec",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
syswrite($c1_in, "abc\n");
|
|
$resp = timeout_read($c1_out);
|
|
$resp eq "abc\n" or die "Client 1 got back \"$resp\", not \"abc\\n\"";
|
|
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client();
|
|
syswrite($c2_in, "abc\n");
|
|
$resp = timeout_read($c2_out);
|
|
$resp eq "abc\n" or die "Client 2 got back \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--keep-open", "--udp", "--exec", "/bin/cat");
|
|
test "--keep-open --exec (udp)",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client("--udp");
|
|
syswrite($c1_in, "abc\n");
|
|
$resp = timeout_read($c1_out);
|
|
$resp eq "abc\n" or die "Client 1 got back \"$resp\", not \"abc\\n\"";
|
|
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client("--udp");
|
|
syswrite($c2_in, "abc\n");
|
|
$resp = timeout_read($c2_out);
|
|
$resp eq "abc\n" or die "Client 2 got back \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
# Test --exec and --sh-exec.
|
|
|
|
server_client_test_all "--exec",
|
|
["--exec", "/usr/bin/perl -e \$|=1;while(<>){tr/a-z/A-Z/;print}"], [], sub {
|
|
syswrite($c_in, "abc\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp eq "ABC\n" or die "Client received " . d($resp) . ", not " . d("ABC\n");
|
|
};
|
|
|
|
server_client_test_all "--sh-exec",
|
|
["--sh-exec", "perl -e '\$|=1;while(<>){tr/a-z/A-Z/;print}'"], [], sub {
|
|
syswrite($c_in, "abc\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp eq "ABC\n" or die "Client received " . d($resp) . ", not " . d("ABC\n");
|
|
};
|
|
|
|
server_client_test_all "--exec, quits instantly",
|
|
["--exec", "/bin/echo abc"], [], sub {
|
|
syswrite($c_in, "test\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Client received " . d($resp) . ", not " . d("abc\n");
|
|
};
|
|
|
|
server_client_test_all "--sh-exec with -C",
|
|
["--sh-exec", "/usr/bin/perl -e '\$|=1;while(<>){tr/a-z/A-Z/;print}'", "-C"], [], sub {
|
|
syswrite($c_in, "abc\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp eq "ABC\r\n" or die "Client received " . d($resp) . ", not " . d("ABC\r\n");
|
|
};
|
|
|
|
proxy_test "--exec through proxy",
|
|
[], [], ["--exec", "/bin/echo abc"], sub {
|
|
my $resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server received " . d($resp) . ", not " . d("abc\n");
|
|
};
|
|
|
|
# Do a syswrite and then a delay to force separate reads in the subprocess.
|
|
sub delaywrite {
|
|
my ($handle, $data) = @_;
|
|
my $delay = 0.1;
|
|
syswrite($handle, $data);
|
|
select(undef, undef, undef, $delay);
|
|
}
|
|
|
|
server_client_test_all "-C translation on input",
|
|
["-C"], ["-C"], sub {
|
|
my $resp;
|
|
my $expected = "\r\na\r\nb\r\n---\r\nc\r\nd\r\n---e\r\n\r\nf\r\n---\r\n";
|
|
|
|
delaywrite($c_in, "\na\nb\n");
|
|
delaywrite($c_in, "---");
|
|
delaywrite($c_in, "\r\nc\r\nd\r\n");
|
|
delaywrite($c_in, "---");
|
|
delaywrite($c_in, "e\n\nf\n");
|
|
delaywrite($c_in, "---\r");
|
|
delaywrite($c_in, "\n");
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp eq $expected or die "Server received " . d($resp) . ", not " . d($expected);
|
|
|
|
delaywrite($s_in, "\na\nb\n");
|
|
delaywrite($s_in, "---");
|
|
delaywrite($s_in, "\r\nc\r\nd\r\n");
|
|
delaywrite($s_in, "---");
|
|
delaywrite($s_in, "e\n\nf\n");
|
|
delaywrite($s_in, "---\r");
|
|
delaywrite($s_in, "\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp eq $expected or die "Client received " . d($resp) . ", not " . d($expected);
|
|
};
|
|
kill_children;
|
|
|
|
server_client_test_all "-C server no translation on output",
|
|
["-C"], [], sub {
|
|
my $resp;
|
|
my $expected = "\na\nb\n---\r\nc\r\nd\r\n";
|
|
|
|
delaywrite($c_in, "\na\nb\n");
|
|
delaywrite($c_in, "---");
|
|
delaywrite($c_in, "\r\nc\r\nd\r\n");
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp eq $expected or die "Server received " . d($resp) . ", not " . d($expected);
|
|
};
|
|
kill_children;
|
|
|
|
server_client_test_tcp_sctp_ssl "-C client no translation on output",
|
|
[], ["-C"], sub {
|
|
my $resp;
|
|
my $expected = "\na\nb\n---\r\nc\r\nd\r\n";
|
|
|
|
delaywrite($s_in, "\na\nb\n");
|
|
delaywrite($s_in, "---");
|
|
delaywrite($s_in, "\r\nc\r\nd\r\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp eq $expected or die "Client received " . d($resp) . ", not " . d($expected);
|
|
};
|
|
kill_children;
|
|
|
|
# Test that both reads and writes reset the idle counter, and that the client
|
|
# properly exits after the timeout expires.
|
|
server_client_test_all "idle timeout (connect mode)",
|
|
[], ["-i", "3000ms"], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
sleep 2;
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
sleep 2;
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
sleep 4;
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out);
|
|
!$resp or die "Client received \"$resp\" after delay of 4000 ms with idle timeout of 3000 ms."
|
|
};
|
|
|
|
# Test that both reads and writes reset the idle counter, and that the server
|
|
# properly exits after the timeout expires.
|
|
server_client_test_tcp_sctp_ssl "idle timeout (listen mode)",
|
|
["-i", "3000ms"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
sleep 2;
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
sleep 2;
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
sleep 4;
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server received \"$resp\" after delay of 4000 ms with idle timeout of 3000 ms."
|
|
};
|
|
|
|
server_client_test_multi ["udp"], "idle timeout (listen mode)",
|
|
["-i", "3000ms"], [], sub {
|
|
my $resp;
|
|
|
|
# when using UDP client must at least write something to the server
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out) or die "Server didn't receive the message";
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
sleep 2;
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
sleep 2;
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
sleep 4;
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server received \"$resp\" after delay of 4000 ms with idle timeout of 3000 ms."
|
|
};
|
|
|
|
# --send-only tests.
|
|
|
|
server_client_test_all "--send-only client",
|
|
[], ["--send-only"], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out);
|
|
!$resp or die "Client received \"$resp\" in --send-only mode";
|
|
};
|
|
|
|
server_client_test_all "--send-only server",
|
|
["--send-only"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server received \"$resp\" in --send-only mode";
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Client got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--broker", "--send-only");
|
|
test "--send-only broker",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client();
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c1_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Client got \"$resp\", not \"abc\\n\"";
|
|
$resp = timeout_read($c2_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Client got \"$resp\", not \"abc\\n\"";
|
|
|
|
syswrite($c1_in, "abc\n");
|
|
$resp = timeout_read($c2_out);
|
|
!$resp or die "--send-only broker relayed \"$resp\"";
|
|
};
|
|
kill_children;
|
|
|
|
# --recv-only tests.
|
|
|
|
# Note this test excludes UDP. The --recv-only UDP client never sends anything
|
|
# to the server, so the server never knows to start sending its data.
|
|
server_client_test_tcp_sctp_ssl "--recv-only client",
|
|
[], ["--recv-only"], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server received \"$resp\" from --recv-only client";
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Client got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
|
|
server_client_test_all "--recv-only server",
|
|
["--recv-only"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out);
|
|
!$resp or die "Client received \"$resp\" from --recv-only server";
|
|
};
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--broker", "--recv-only");
|
|
test "--recv-only broker",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client();
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c1_out);
|
|
!$resp or die "Client received \"$resp\" from --recv-only broker";
|
|
$resp = timeout_read($c2_out);
|
|
!$resp or die "Client received \"$resp\" from --recv-only broker";
|
|
|
|
syswrite($c1_in, "abc\n");
|
|
$resp = timeout_read($c2_out);
|
|
!$resp or die "Client received \"$resp\" from --recv-only broker";
|
|
};
|
|
kill_children;
|
|
|
|
#Broker Tests
|
|
($s_pid, $s_out, $s_in) = ncat_server("--broker");
|
|
test "--broker mode (tcp)",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client();
|
|
|
|
syswrite($c2_in, "abc\n");
|
|
$resp = timeout_read($c1_out);
|
|
$resp eq "abc\n" or die "Client 1 received \"$resp\", not abc";
|
|
|
|
syswrite($c1_in, "abc\n");
|
|
$resp = timeout_read($c2_out);
|
|
$resp eq "abc\n" or die "Client 2 received \"$resp\", not abc";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--broker", "--sctp");
|
|
test "--broker mode (sctp)",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client("--sctp");
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client("--sctp");
|
|
|
|
syswrite($c2_in, "abc\n");
|
|
$resp = timeout_read($c1_out);
|
|
$resp eq "abc\n" or die "Client 1 received \"$resp\", not abc";
|
|
|
|
syswrite($c1_in, "abc\n");
|
|
$resp = timeout_read($c2_out);
|
|
$resp eq "abc\n" or die "Client 2 received \"$resp\", not abc";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--broker", "--ssl");
|
|
test "--broker mode (tcp ssl)",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client("--ssl");
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client("--ssl");
|
|
|
|
syswrite($c2_in, "abc\n");
|
|
$resp = timeout_read($c1_out);
|
|
$resp eq "abc\n" or die "Client 1 received \"$resp\", not abc";
|
|
|
|
syswrite($c1_in, "abc\n");
|
|
$resp = timeout_read($c2_out);
|
|
$resp eq "abc\n" or die "Client 2 received \"$resp\", not abc";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--broker", "--sctp", "--ssl");
|
|
test "--broker mode (sctp ssl)",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client("--sctp", "--ssl");
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client("--sctp", "--ssl");
|
|
|
|
syswrite($c2_in, "abc\n");
|
|
$resp = timeout_read($c1_out);
|
|
$resp eq "abc\n" or die "Client 1 received \"$resp\", not abc";
|
|
|
|
syswrite($c1_in, "abc\n");
|
|
$resp = timeout_read($c2_out);
|
|
$resp eq "abc\n" or die "Client 2 received \"$resp\", not abc";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat("--broker");
|
|
test "IPV4 and IPV6 clients can talk to each other in broker mode",
|
|
sub {
|
|
my $resp;
|
|
sleep 1;
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat("-6","::1");
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat("localhost");
|
|
|
|
syswrite($c2_in, "abc\n");
|
|
$resp = timeout_read($c1_out, 2);
|
|
$resp eq "abc\n" or die "IPV6 Client received \"$resp\", not abc";
|
|
|
|
syswrite($c1_in, "abc\n");
|
|
$resp = timeout_read($c2_out, 2);
|
|
$resp eq "abc\n" or die "IPV4 Client received \"$resp\", not abc";
|
|
};
|
|
kill_children;
|
|
|
|
|
|
# Source address tests.
|
|
|
|
test "Connect with -p",
|
|
sub {
|
|
my ($pid, $code);
|
|
local $SIG{CHLD} = sub { };
|
|
local *SOCK;
|
|
local *S;
|
|
|
|
socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname("tcp")) or die;
|
|
setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die;
|
|
bind(SOCK, sockaddr_in($PORT, INADDR_ANY)) or die;
|
|
listen(SOCK, 1) or die;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat("-p", "1234", $HOST, $PORT);
|
|
|
|
accept(S, SOCK) or die;
|
|
my ($port, $addr) = sockaddr_in(getpeername(S));
|
|
$port == 1234 or die "Client connected to prosy with source port $port, not 1234";
|
|
};
|
|
kill_children;
|
|
|
|
test "Connect through HTTP proxy with -p",
|
|
sub {
|
|
my ($pid, $code);
|
|
local $SIG{CHLD} = sub { };
|
|
local *SOCK;
|
|
local *S;
|
|
|
|
socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname("tcp")) or die;
|
|
setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die;
|
|
bind(SOCK, sockaddr_in($PROXY_PORT, INADDR_ANY)) or die;
|
|
listen(SOCK, 1) or die;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat("--proxy-type", "http", "--proxy", "$HOST:$PROXY_PORT", "-p", "1234", $HOST, $PORT);
|
|
|
|
accept(S, SOCK) or die;
|
|
my ($port, $addr) = sockaddr_in(getpeername(S));
|
|
$port == 1234 or die "Client connected to proxy with source port $port, not 1234";
|
|
};
|
|
kill_children;
|
|
|
|
test "Connect through SOCKS4 proxy with -p",
|
|
sub {
|
|
my ($pid, $code);
|
|
local $SIG{CHLD} = sub { };
|
|
local *SOCK;
|
|
local *S;
|
|
|
|
socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname("tcp")) or die;
|
|
setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die;
|
|
bind(SOCK, sockaddr_in($PROXY_PORT, INADDR_ANY)) or die;
|
|
listen(SOCK, 1) or die;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat("--proxy-type", "socks4", "--proxy", "$HOST:$PROXY_PORT", "-p", "1234", $HOST, $PORT);
|
|
|
|
accept(S, SOCK) or die;
|
|
my ($port, $addr) = sockaddr_in(getpeername(S));
|
|
$port == 1234 or die "Client connected to prosy with source port $port, not 1234";
|
|
};
|
|
kill_children;
|
|
|
|
# Test connecting to UNIX datagram socket with -s
|
|
test "Connect to UNIX datagram socket with -s",
|
|
sub {
|
|
my ($pid, $code);
|
|
local $SIG{CHLD} = sub { };
|
|
local *SOCK;
|
|
my $buff;
|
|
|
|
unlink($UNIXSOCK);
|
|
unlink($UNIXSOCK_TMP);
|
|
|
|
socket(SOCK, AF_UNIX, SOCK_DGRAM, 0) or die;
|
|
bind(SOCK, sockaddr_un($UNIXSOCK)) or die;
|
|
|
|
my ($c_pid, $c_out, $c_in) = ncat("-U", "--udp", "-s", $UNIXSOCK_TMP, $UNIXSOCK);
|
|
syswrite($c_in, "abc\n");
|
|
close($c_in);
|
|
|
|
my $peeraddr = recv(SOCK, $buff, 4, 0) or die;
|
|
my ($path) = sockaddr_un($peeraddr);
|
|
$path eq $UNIXSOCK_TMP or die "Client connected to prosy with source socket path $path, not $UNIXSOCK_TMP";
|
|
};
|
|
kill_children;
|
|
unlink($UNIXSOCK);
|
|
unlink($UNIXSOCK_TMP);
|
|
|
|
|
|
# HTTP proxy tests.
|
|
|
|
sub http_request {
|
|
my ($method, $uri) = @_;
|
|
return "$method $uri HTTP/1.0\r\n\r\n";
|
|
};
|
|
|
|
server_client_test "HTTP proxy bad request",
|
|
["--proxy-type", "http"], [], sub {
|
|
syswrite($c_in, "bad\r\n\r\n");
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 400 or die "Expected response code 400, got $code";
|
|
};
|
|
|
|
server_client_test "HTTP CONNECT no port number",
|
|
["--proxy-type", "http"], [], sub {
|
|
# Supposed to have a port number.
|
|
my $req = http_request("CONNECT", "$HOST");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 400 or die "Expected response code 400, got $code";
|
|
};
|
|
|
|
server_client_test "HTTP CONNECT no port number",
|
|
["--proxy-type", "http"], [], sub {
|
|
# Supposed to have a port number.
|
|
my $req = http_request("CONNECT", "$HOST:");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 400 or die "Expected response code 400, got $code";
|
|
};
|
|
|
|
server_client_test "HTTP CONNECT good request",
|
|
["--proxy-type", "http"], [], sub {
|
|
my $req = http_request("CONNECT", "$HOST:$PORT");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 200 or die "Expected response code 200, got $code";
|
|
};
|
|
|
|
server_client_test "HTTP CONNECT IPv6 address, no port number",
|
|
["--proxy-type", "http", "-6"], ["-6"], sub {
|
|
# Supposed to have a port number.
|
|
my $req = http_request("CONNECT", "[$IPV6_ADDR]");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 400 or die "Expected response code 400, got $code";
|
|
};
|
|
|
|
server_client_test "HTTP CONNECT IPv6 address, no port number",
|
|
["--proxy-type", "http", "-6"], ["-6"], sub {
|
|
# Supposed to have a port number.
|
|
my $req = http_request("CONNECT", "[$IPV6_ADDR]:");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 400 or die "Expected response code 400, got $code";
|
|
};
|
|
|
|
server_client_test "HTTP CONNECT IPv6 address, good request",
|
|
["--proxy-type", "http", "-6"], ["-6"], sub {
|
|
my $req = http_request("CONNECT", "[$IPV6_ADDR]:$PORT");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 200 or die "Expected response code 200, got $code";
|
|
};
|
|
|
|
# Try accessing an IPv6 server with a proxy that uses -4, should fail.
|
|
proxy_test_raw "HTTP CONNECT IPv4-only proxy",
|
|
["-4"], ["-6"], ["-4"], sub {
|
|
my $req = http_request("CONNECT", "[$IPV6_ADDR]:$PORT");
|
|
syswrite($c_in, $req);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 504 or die "Expected response code 504, got $code";
|
|
};
|
|
|
|
# Try accessing an IPv4 server with a proxy that uses -6, should fail.
|
|
proxy_test_raw "HTTP CONNECT IPv6-only proxy",
|
|
["-6"], ["-4"], ["-6"], sub {
|
|
my $req = http_request("CONNECT", "$HOST:$PORT");
|
|
syswrite($c_in, $req);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 504 or die "Expected response code 504, got $code";
|
|
};
|
|
|
|
{
|
|
local $xfail = 1;
|
|
proxy_test_raw "HTTP CONNECT IPv4 client, IPv6 server",
|
|
[], ["-6"], ["-4"], sub {
|
|
my $req = http_request("CONNECT", "[$IPV6_ADDR]:$PORT");
|
|
syswrite($c_in, $req);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 200 or die "Expected response code 200, got $code";
|
|
};
|
|
}
|
|
|
|
# HTTP Digest functions.
|
|
sub H {
|
|
return md5_hex(shift);
|
|
}
|
|
sub KD {
|
|
my ($s, $d) = @_;
|
|
return H("$s:$d");
|
|
}
|
|
sub digest_response {
|
|
# Assume MD5 algorithm.
|
|
my ($user, $pass, $realm, $method, $uri, $nonce, $qop, $nc, $cnonce) = @_;
|
|
my $A1 = "$user:$realm:$pass";
|
|
my $A2 = "$method:$uri";
|
|
if ($qop) {
|
|
return KD(H($A1), "$nonce:$nc:$cnonce:$qop:" . H($A2));
|
|
} else {
|
|
return KD(H($A1), "$nonce:" . H($A2));
|
|
}
|
|
}
|
|
# Parse Proxy-Authenticate or Proxy-Authorization. Return ($scheme, %attrs).
|
|
sub parse_proxy_header {
|
|
my $s = shift;
|
|
my $scheme;
|
|
my %attrs;
|
|
|
|
if ($s =~ m/^\s*(\w+)/) {
|
|
$scheme = $1;
|
|
}
|
|
while ($s =~ m/(\w+)\s*=\s*(?:"([^"]*)"|(\w+))/g) {
|
|
$attrs{$1} = $2 || $3;
|
|
}
|
|
|
|
return ($scheme, %attrs);
|
|
}
|
|
|
|
server_client_test "HTTP proxy client prefers Digest auth",
|
|
["-k"], ["--proxy", "$HOST:$PORT", "--proxy-auth", "user:pass", "--proxy-type", "http"],
|
|
sub {
|
|
my $nonce = "0123456789abcdef";
|
|
my $realm = "realm";
|
|
my $req = timeout_read($s_out);
|
|
$req or die "No initial request from client";
|
|
syswrite($s_in, "HTTP/1.0 407 Authentication Required\r\
|
|
Proxy-Authenticate: Basic realm=\"$realm\"\r\
|
|
Proxy-Authenticate: Digest realm=\"$realm\", nonce=\"$nonce\", qop=\"auth\"\r\n\r\n");
|
|
$req = timeout_read($s_out);
|
|
$req or die "No followup request from client";
|
|
$req = HTTP::Request->parse($req);
|
|
foreach my $hdr ($req->header("Proxy-Authorization")) {
|
|
my ($scheme, %attrs) = parse_proxy_header($hdr);
|
|
if ($scheme eq "Basic") {
|
|
die "Client used Basic auth when Digest was available";
|
|
}
|
|
}
|
|
return 1;
|
|
};
|
|
|
|
server_client_test "HTTP proxy client prefers Digest auth, comma-separated",
|
|
["-k"], ["--proxy", "$HOST:$PORT", "--proxy-auth", "user:pass", "--proxy-type", "http"],
|
|
sub {
|
|
my $nonce = "0123456789abcdef";
|
|
my $realm = "realm";
|
|
my $req = timeout_read($s_out);
|
|
$req or die "No initial request from client";
|
|
syswrite($s_in, "HTTP/1.0 407 Authentication Required\r\
|
|
Proxy-Authenticate: Basic realm=\"$realm\", Digest realm=\"$realm\", nonce=\"$nonce\", qop=\"auth\"\r\n\r\n");
|
|
$req = timeout_read($s_out);
|
|
$req or die "No followup request from client";
|
|
$req = HTTP::Request->parse($req);
|
|
foreach my $hdr ($req->header("Proxy-Authorization")) {
|
|
my ($scheme, %attrs) = parse_proxy_header($hdr);
|
|
if ($scheme eq "Basic") {
|
|
die "Client used Basic auth when Digest was available";
|
|
}
|
|
}
|
|
return 1;
|
|
};
|
|
|
|
server_client_test "HTTP proxy Digest client auth",
|
|
["-k"], ["--proxy", "$HOST:$PORT", "--proxy-auth", "user:pass", "--proxy-type", "http"],
|
|
sub {
|
|
my $nonce = "0123456789abcdef";
|
|
my $realm = "realm";
|
|
my $req = timeout_read($s_out);
|
|
$req or die "No initial request from client";
|
|
syswrite($s_in, "HTTP/1.0 407 Authentication Required\r\
|
|
Proxy-Authenticate: Digest realm=\"$realm\", nonce=\"$nonce\", qop=\"auth\", opaque=\"abcd\"\r\n\r\n");
|
|
$req = timeout_read($s_out);
|
|
$req or die "No followup request from client";
|
|
$req = HTTP::Request->parse($req);
|
|
foreach my $hdr ($req->header("Proxy-Authorization")) {
|
|
my ($scheme, %attrs) = parse_proxy_header($hdr);
|
|
next if $scheme ne "Digest";
|
|
die "no qop" if not $attrs{"qop"};
|
|
die "no nonce" if not $attrs{"nonce"};
|
|
die "no uri" if not $attrs{"uri"};
|
|
die "no nc" if not $attrs{"nc"};
|
|
die "no cnonce" if not $attrs{"cnonce"};
|
|
die "no response" if not $attrs{"response"};
|
|
die "no opaque" if not $attrs{"opaque"};
|
|
die "qop mismatch" if $attrs{"qop"} ne "auth";
|
|
die "nonce mismatch" if $attrs{"nonce"} ne $nonce;
|
|
die "opaque mismatch" if $attrs{"opaque"} ne "abcd";
|
|
my $expected = digest_response("user", "pass", $realm, "CONNECT", $attrs{"uri"}, $nonce, "auth", $attrs{"nc"}, $attrs{"cnonce"});
|
|
die "auth mismatch: $attrs{response} but expected $expected" if $attrs{"response"} ne $expected;
|
|
return 1;
|
|
}
|
|
die "No Proxy-Authorization: Digest in client request";
|
|
};
|
|
|
|
server_client_test "HTTP proxy Digest client auth, no qop",
|
|
["-k"], ["--proxy", "$HOST:$PORT", "--proxy-auth", "user:pass", "--proxy-type", "http"],
|
|
sub {
|
|
my $nonce = "0123456789abcdef";
|
|
my $realm = "realm";
|
|
my $req = timeout_read($s_out);
|
|
$req or die "No initial request from client";
|
|
syswrite($s_in, "HTTP/1.0 407 Authentication Required\r\
|
|
Proxy-Authenticate: Digest realm=\"$realm\", nonce=\"$nonce\", opaque=\"abcd\"\r\n\r\n");
|
|
$req = timeout_read($s_out);
|
|
$req or die "No followup request from client";
|
|
$req = HTTP::Request->parse($req);
|
|
foreach my $hdr ($req->header("Proxy-Authorization")) {
|
|
my ($scheme, %attrs) = parse_proxy_header($hdr);
|
|
next if $scheme ne "Digest";
|
|
die "no nonce" if not $attrs{"nonce"};
|
|
die "no uri" if not $attrs{"uri"};
|
|
die "no response" if not $attrs{"response"};
|
|
die "no opaque" if not $attrs{"opaque"};
|
|
die "nonce mismatch" if $attrs{"nonce"} ne $nonce;
|
|
die "opaque mismatch" if $attrs{"opaque"} ne "abcd";
|
|
die "nc present" if $attrs{"nc"};
|
|
die "cnonce present" if $attrs{"cnonce"};
|
|
my $expected = digest_response("user", "pass", $realm, "CONNECT", $attrs{"uri"}, $nonce, undef, undef, undef);
|
|
die "auth mismatch: $attrs{response} but expected $expected" if $attrs{"response"} ne $expected;
|
|
return 1;
|
|
}
|
|
die "No Proxy-Authorization: Digest in client request";
|
|
};
|
|
|
|
# This violates RFC 2617 section 1.2, which requires at least one auth-param.
|
|
# But NTLM and Negotiate don't use any.
|
|
server_client_test "HTTP proxy client handles scheme without auth-params",
|
|
["-k"], ["--proxy", "$HOST:$PORT", "--proxy-auth", "user:pass", "--proxy-type", "http"],
|
|
sub {
|
|
my $nonce = "0123456789abcdef";
|
|
my $realm = "realm";
|
|
my $req = timeout_read($s_out);
|
|
$req or die "No initial request from client";
|
|
syswrite($s_in, "HTTP/1.0 407 Authentication Required\r\
|
|
Proxy-Authenticate: Basic realm=\"$realm\"\r\
|
|
Proxy-Authenticate: NTLM\r\
|
|
Proxy-Authenticate: Digest realm=\"$realm\", nonce=\"$nonce\", qop=\"auth\"\r\n\r\n");
|
|
$req = timeout_read($s_out);
|
|
$req or die "No followup request from client";
|
|
$req = HTTP::Request->parse($req);
|
|
$req->header("Proxy-Authorization") or die "Client didn't sent Proxy-Authorization";
|
|
};
|
|
|
|
server_client_test "HTTP proxy client handles scheme without auth-params, comma-separated",
|
|
["-k"], ["--proxy", "$HOST:$PORT", "--proxy-auth", "user:pass", "--proxy-type", "http"],
|
|
sub {
|
|
my $nonce = "0123456789abcdef";
|
|
my $realm = "realm";
|
|
my $req = timeout_read($s_out);
|
|
$req or die "No initial request from client";
|
|
syswrite($s_in, "HTTP/1.0 407 Authentication Required\r\
|
|
Proxy-Authenticate: Basic realm=\"$realm\", NTLM, Digest realm=\"$realm\", nonce=\"$nonce\", qop=\"auth\"\r\n\r\n");
|
|
$req = timeout_read($s_out);
|
|
$req or die "No followup request from client";
|
|
$req = HTTP::Request->parse($req);
|
|
$req->header("Proxy-Authorization") or die "Client didn't sent Proxy-Authorization";
|
|
};
|
|
|
|
# Check that the proxy relays in both directions.
|
|
proxy_test "HTTP CONNECT proxy relays",
|
|
[], [], [], sub {
|
|
syswrite($c_in, "abc\n");
|
|
my $resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Proxy relayed \"$resp\", not \"abc\\n\"";
|
|
syswrite($s_in, "def\n");
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp eq "def\n" or die "Proxy relayed \"$resp\", not \"abc\\n\"";
|
|
};
|
|
|
|
# Proxy client shouldn't see the status line returned by the proxy server.
|
|
server_client_test "HTTP CONNECT client hides proxy server response",
|
|
["--proxy-type", "http"], ["--proxy", "$HOST:$PORT", "--proxy-type", "http"], sub {
|
|
my $resp = timeout_read($c_out);
|
|
!$resp or die "Proxy client sent " . d($resp) . " to the user stream";
|
|
};
|
|
|
|
server_client_test "HTTP CONNECT client, different Status-Line",
|
|
[], ["--proxy", "$HOST:$PORT", "--proxy-type", "http"], sub {
|
|
my $resp;
|
|
syswrite($s_in, "HTTP/1.1 200 Go ahead\r\n\r\nabc\n");
|
|
$resp = timeout_read($c_out);
|
|
if (!defined($resp)) {
|
|
die "Client didn't recognize connection";
|
|
} elsif ($resp ne "abc\n") {
|
|
die "Proxy client sent " . d($resp) . " to the user stream";
|
|
}
|
|
return 1;
|
|
};
|
|
|
|
server_client_test "HTTP CONNECT client, server sends header",
|
|
[], ["--proxy", "$HOST:$PORT", "--proxy-type", "http"], sub {
|
|
my $resp;
|
|
syswrite($s_in, "HTTP/1.0 200 OK\r\nServer: ncat-test 1.2.3\r\n\r\nabc\n");
|
|
$resp = timeout_read($c_out);
|
|
if (!defined($resp)) {
|
|
die "Client didn't recognize connection";
|
|
} elsif ($resp ne "abc\n") {
|
|
die "Proxy client sent " . d($resp) . " to the user stream";
|
|
}
|
|
return 1;
|
|
};
|
|
|
|
# Check that the proxy doesn't consume anything following the request when
|
|
# request and body are combined in one send. Section 3.3 of the CONNECT spec
|
|
# explicitly allows the client to send data before the connection is
|
|
# established.
|
|
proxy_test_raw "HTTP CONNECT server doesn't consume anything after request",
|
|
[], [], [], sub {
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\nUser-Agent: ncat-test\r\n\r\nabc\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 200 or die "Expected response code 200, got $code";
|
|
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp eq "abc\n" or die "Proxy relayed \"$resp\", not \"abc\\n\"";
|
|
};
|
|
|
|
server_client_test "HTTP CONNECT overlong Request-Line",
|
|
["--proxy-type", "http"], [], sub {
|
|
syswrite($c_in, "CONNECT " . ("A" x 24000) . ":$PORT HTTP/1.0\r\n\r\n");
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 413 or $code == 414 or die "Expected response code 413 or 414, got $code";
|
|
};
|
|
|
|
server_client_test "HTTP CONNECT overlong header",
|
|
["--proxy-type", "http"], [], sub {
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n");
|
|
for (my $i = 0; $i < 10000; $i++) {
|
|
syswrite($c_in, "Header: Value\r\n");
|
|
}
|
|
syswrite($c_in, "\r\n");
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 413 or die "Expected response code 413, got $code";
|
|
};
|
|
|
|
server_client_test "HTTP GET hostname only",
|
|
["--proxy-type", "http"], [], sub {
|
|
my $req = http_request("GET", "$HOST");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 400 or die "Expected response code 400, got $code";
|
|
};
|
|
|
|
server_client_test "HTTP GET path only",
|
|
["--proxy-type", "http"], [], sub {
|
|
my $req = http_request("GET", "/");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 400 or die "Expected response code 400, got $code";
|
|
};
|
|
|
|
proxy_test_raw "HTTP GET absolute URI",
|
|
[], [], [], sub {
|
|
my $req = http_request("GET", "http://$HOST:$PORT/");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp =~ /^GET \/ HTTP\/1\./ or die "Proxy sent \"$resp\"";
|
|
};
|
|
|
|
proxy_test_raw "HTTP GET absolute URI, no path",
|
|
[], [], [], sub {
|
|
my $req = http_request("GET", "http://$HOST:$PORT");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp =~ /^GET \/ HTTP\/1\./ or die "Proxy sent \"$resp\"";
|
|
};
|
|
|
|
proxy_test_raw "HTTP GET percent escape",
|
|
[], [], [], sub {
|
|
my $req = http_request("GET", "http://$HOST:$PORT/%41");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($s_out) or die "Read timeout";
|
|
uri_unescape($resp) =~ /^GET \/A HTTP\/1\./ or die "Proxy sent \"$resp\"";
|
|
};
|
|
|
|
proxy_test_raw "HTTP GET remove Connection header fields",
|
|
[], [], [], sub {
|
|
my $req = "GET http://$HOST:$PORT/ HTTP/1.0\r\nKeep-Alive: 300\r\nOne: 1\r\nConnection: keep-alive, two, close\r\nTwo: 2\r\nThree: 3\r\n\r\n";
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp = HTTP::Request->parse($resp);
|
|
!defined($resp->header("Keep-Alive")) or die "Proxy did not remove Keep-Alive header field";
|
|
!defined($resp->header("Two")) or die "Proxy did not remove Two header field";
|
|
$resp->header("One") eq "1" or die "Proxy modified One header field";
|
|
$resp->header("Three") eq "3" or die "Proxy modified Three header field";
|
|
};
|
|
|
|
proxy_test_raw "HTTP GET combine multiple headers with the same name",
|
|
[], [], [], sub {
|
|
my $req = "GET http://$HOST:$PORT/ HTTP/1.0\r\nConnection: keep-alive\r\nKeep-Alive: 300\r\nConnection: two\r\nOne: 1\r\nConnection: close\r\nTwo: 2\r\nThree: 3\r\n\r\n";
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp = HTTP::Request->parse($resp);
|
|
!defined($resp->header("Keep-Alive")) or die "Proxy did not remove Keep-Alive header field";
|
|
!defined($resp->header("Two")) or die "Proxy did not remove Keep-Alive header field";
|
|
$resp->header("One") eq "1" or die "Proxy modified One header field";
|
|
$resp->header("Three") eq "3" or die "Proxy modified Three header field";
|
|
};
|
|
|
|
# RFC 2616 section 5.1.2: "In order to avoid request loops, a proxy MUST be able
|
|
# to recognize all of its server names, including any aliases, local variations,
|
|
# and the numeric IP address."
|
|
server_client_test "HTTP GET request loop",
|
|
["--proxy-type", "http"], [], sub {
|
|
my $req = http_request("GET", "http://$HOST:$PORT/");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 403 or die "Expected response code 403, got $code";
|
|
};
|
|
|
|
server_client_test "HTTP GET IPv6 request loop",
|
|
["-6", "--proxy-type", "http"], ["-6"], sub {
|
|
my $req = http_request("GET", "http://[$IPV6_ADDR]:$PORT/");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 403 or die "Expected response code 403, got $code";
|
|
};
|
|
|
|
proxy_test_raw "HTTP HEAD absolute URI",
|
|
[], [], [], sub {
|
|
my $req = http_request("HEAD", "http://$HOST:$PORT/");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp = HTTP::Request->parse($resp);
|
|
$resp->method eq "HEAD" or die "Proxy sent \"" . $resp->method . "\"";
|
|
};
|
|
|
|
proxy_test_raw "HTTP POST",
|
|
[], [], [], sub {
|
|
my $req = "POST http://$HOST:$PORT/ HTTP/1.0\r\nContent-Length: 4\r\n\r\nabc\n";
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp = HTTP::Request->parse($resp);
|
|
$resp->method eq "POST" or die "Proxy sent \"" . $resp->method . "\"";
|
|
$resp->content eq "abc\n" or die "Proxy sent \"" . $resp->content . "\"";
|
|
};
|
|
|
|
proxy_test_raw "HTTP POST short Content-Length",
|
|
[], [], [], sub {
|
|
my $req = "POST http://$HOST:$PORT/ HTTP/1.0\r\nContent-Length: 2\r\n\r\nabc\n";
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp = HTTP::Request->parse($resp);
|
|
$resp->method eq "POST" or die "Proxy sent \"" . $resp->method . "\"";
|
|
$resp->content eq "ab" or die "Proxy sent \"" . $resp->content . "\"";
|
|
};
|
|
|
|
proxy_test_raw "HTTP POST long Content-Length",
|
|
[], [], [], sub {
|
|
my $req = "POST http://$HOST:$PORT/ HTTP/1.0\r\nContent-Length: 10\r\n\r\nabc\n";
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($s_out) or die "Read timeout";
|
|
$resp = HTTP::Request->parse($resp);
|
|
$resp->method eq "POST" or die "Proxy sent \"" . $resp->method . "\"";
|
|
$resp->content eq "abc\n" or die "Proxy sent \"" . $resp->content . "\"";
|
|
};
|
|
|
|
proxy_test_raw "HTTP POST chunked transfer encoding",
|
|
[], [], [], sub {
|
|
my $req = "POST http://$HOST:$PORT/ HTTP/1.1\r\nTransfer-Encoding: chunked\r\n\r\n4\r\nabc\n0\r\n";
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($s_out);
|
|
# We expect the proxy to relay the request or else die with an error
|
|
# saying it can't do it.
|
|
if ($resp) {
|
|
$resp = HTTP::Request->parse($resp);
|
|
$resp->method eq "POST" or die "Proxy sent \"" . $resp->method . "\"";
|
|
$resp->content eq "abc\n" or die "Proxy sent \"" . $resp->content . "\"";
|
|
} else {
|
|
$resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp = HTTP::Response->parse($resp);
|
|
$resp->code == 400 or $resp->code == 411 or die "Proxy returned code " . $resp->code;
|
|
}
|
|
};
|
|
|
|
server_client_test "HTTP proxy unknown method",
|
|
["--proxy-type", "http"], [], sub {
|
|
# Supposed to have a port number.
|
|
my $req = http_request("NOTHING", "http://$HOST:$PORT/");
|
|
syswrite($c_in, $req);
|
|
close($c_in);
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
my $code = HTTP::Response->parse($resp)->code;
|
|
$code == 405 or die "Expected response code 405, got $code";
|
|
};
|
|
|
|
# Check that proxy auth is base64 encoded properly. 's' and '~' are 0x77 and
|
|
# 0x7E respectively, printing characters with many bits set.
|
|
for my $auth ("", "a", "a:", ":a", "user:sss", "user:ssss", "user:sssss", "user:~~~", "user:~~~~", "user:~~~~~") {
|
|
server_client_test "HTTP proxy auth base64 encoding: \"$auth\"",
|
|
["-k"], ["--proxy", "$HOST:$PORT", "--proxy-type", "http", "--proxy-auth", $auth], sub {
|
|
my $resp = timeout_read($s_out) or die "Read timeout";
|
|
syswrite($s_in, "HTTP/1.0 407 Auth\r\nProxy-Authenticate: Basic realm=\"Ncat\"\r\n\r\n");
|
|
$resp = timeout_read($s_out) or die "Read timeout";
|
|
my $auth_header = HTTP::Response->parse($resp)->header("Proxy-Authorization") or die "Proxy client didn't send Proxy-Authorization header field";
|
|
my ($b64_auth) = ($auth_header =~ /^Basic (.*)/) or die "No auth data in \"$auth_header\"";
|
|
my $dec_auth = decode_base64($b64_auth);
|
|
$auth eq $dec_auth or die "Proxy client sent \"$b64_auth\" for \"$auth\", decodes to \"$dec_auth\"";
|
|
};
|
|
}
|
|
|
|
server_client_test_multi ["tcp", "tcp ssl"], "HTTP proxy server auth challenge",
|
|
["--proxy-type", "http", "--proxy-auth", "user:pass"],
|
|
[],
|
|
sub {
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n\r\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$code == 407 or die "Expected response code 407, got $code";
|
|
my $auth = $resp->header("Proxy-Authenticate");
|
|
$auth or die "Proxy server didn't send Proxy-Authenticate header field";
|
|
};
|
|
|
|
server_client_test_multi ["tcp", "tcp ssl"], "HTTP proxy server correct auth",
|
|
["--proxy-type", "http", "--proxy-auth", "user:pass"],
|
|
[],
|
|
sub {
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n");
|
|
syswrite($c_in, "Proxy-Authorization: Basic " . encode_base64("user:pass") . "\r\n");
|
|
syswrite($c_in, "\r\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$code == 200 or die "Expected response code 200, got $code";
|
|
};
|
|
|
|
server_client_test_multi ["tcp", "tcp ssl"], "HTTP proxy Basic wrong user",
|
|
["--proxy-type", "http", "--proxy-auth", "user:pass"],
|
|
[],
|
|
sub {
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n");
|
|
syswrite($c_in, "Proxy-Authorization: Basic " . encode_base64("nobody:pass") . "\r\n");
|
|
syswrite($c_in, "\r\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$code == 407 or die "Expected response code 407, got $code";
|
|
};
|
|
|
|
server_client_test_multi ["tcp", "tcp ssl"], "HTTP proxy Basic wrong pass",
|
|
["--proxy-type", "http", "--proxy-auth", "user:pass"],
|
|
[],
|
|
sub {
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n");
|
|
syswrite($c_in, "Proxy-Authorization: Basic " . encode_base64("user:word") . "\r\n");
|
|
syswrite($c_in, "\r\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$code == 407 or die "Expected response code 407, got $code";
|
|
};
|
|
|
|
server_client_test_multi ["tcp", "tcp ssl"], "HTTP proxy Basic correct auth, different case",
|
|
["--proxy-type", "http", "--proxy-auth", "user:pass"],
|
|
[],
|
|
sub {
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n");
|
|
syswrite($c_in, "pROXY-aUTHORIZATION: BASIC " . encode_base64("user:pass") . "\r\n");
|
|
syswrite($c_in, "\r\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$code == 200 or die "Expected response code 200, got $code";
|
|
};
|
|
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--proxy-type", "http", "--proxy-auth", "user:pass");
|
|
test "HTTP proxy Digest wrong user",
|
|
sub {
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n\r\n");
|
|
my $resp = timeout_read($c_out);
|
|
$resp or die "No response from server";
|
|
$resp = HTTP::Response->parse($resp);
|
|
foreach my $hdr ($resp->header("Proxy-Authenticate")) {
|
|
my ($scheme, %attrs) = parse_proxy_header($hdr);
|
|
next if $scheme ne "Digest";
|
|
die "no nonce" if not $attrs{"nonce"};
|
|
die "no realm" if not $attrs{"realm"};
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
my $response = digest_response("xxx", "pass", $attrs{"realm"}, "CONNECT", "$HOST:$PORT", $attrs{"nonce"}, undef, undef, undef);
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\
|
|
Proxy-Authorization: Digest username=\"xxx\", realm=\"$attrs{realm}\", nonce=\"$attrs{nonce}\", uri=\"$HOST:$PORT\", response=\"$response\"\r\n\r\n");
|
|
$resp = timeout_read($c_out);
|
|
$resp or die "No response from server";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$resp->code == 407 or die "Expected response code 407, got $code";
|
|
return 1;
|
|
}
|
|
die "No Proxy-Authenticate: Digest in server response";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--proxy-type", "http", "--proxy-auth", "user:pass");
|
|
test "HTTP proxy Digest wrong pass",
|
|
sub {
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n\r\n");
|
|
my $resp = timeout_read($c_out);
|
|
$resp or die "No response from server";
|
|
$resp = HTTP::Response->parse($resp);
|
|
foreach my $hdr ($resp->header("Proxy-Authenticate")) {
|
|
my ($scheme, %attrs) = parse_proxy_header($hdr);
|
|
next if $scheme ne "Digest";
|
|
die "no nonce" if not $attrs{"nonce"};
|
|
die "no realm" if not $attrs{"realm"};
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
my $response = digest_response("user", "xxx", $attrs{"realm"}, "CONNECT", "$HOST:$PORT", $attrs{"nonce"}, undef, undef, undef);
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\
|
|
Proxy-Authorization: Digest username=\"user\", realm=\"$attrs{realm}\", nonce=\"$attrs{nonce}\", uri=\"$HOST:$PORT\", response=\"$response\"\r\n\r\n");
|
|
$resp = timeout_read($c_out);
|
|
$resp or die "No response from server";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$resp->code == 407 or die "Expected response code 407, got $code";
|
|
return 1;
|
|
}
|
|
die "No Proxy-Authenticate: Digest in server response";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--proxy-type", "http", "--proxy-auth", "user:pass");
|
|
test "HTTP proxy Digest correct auth",
|
|
sub {
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n\r\n");
|
|
my $resp = timeout_read($c_out);
|
|
$resp or die "No response from server";
|
|
$resp = HTTP::Response->parse($resp);
|
|
foreach my $hdr ($resp->header("Proxy-Authenticate")) {
|
|
my ($scheme, %attrs) = parse_proxy_header($hdr);
|
|
next if $scheme ne "Digest";
|
|
die "no nonce" if not $attrs{"nonce"};
|
|
die "no realm" if not $attrs{"realm"};
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
my $response = digest_response("user", "pass", $attrs{"realm"}, "CONNECT", "$HOST:$PORT", $attrs{"nonce"}, "auth", "00000001", "abcdefg");
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\
|
|
Proxy-Authorization: Digest username=\"user\", realm=\"$attrs{realm}\", nonce=\"$attrs{nonce}\", uri=\"$HOST:$PORT\", qop=\"auth\", nc=\"00000001\", cnonce=\"abcdefg\", response=\"$response\"\r\n\r\n");
|
|
$resp = timeout_read($c_out);
|
|
$resp or die "No response from server";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$resp->code == 200 or die "Expected response code 200, got $code";
|
|
return 1;
|
|
}
|
|
die "No Proxy-Authenticate: Digest in server response";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--proxy-type", "http", "--proxy-auth", "user:pass");
|
|
test "HTTP proxy Digest correct auth, no qop",
|
|
sub {
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n\r\n");
|
|
my $resp = timeout_read($c_out);
|
|
$resp or die "No response from server";
|
|
$resp = HTTP::Response->parse($resp);
|
|
foreach my $hdr ($resp->header("Proxy-Authenticate")) {
|
|
my ($scheme, %attrs) = parse_proxy_header($hdr);
|
|
next if $scheme ne "Digest";
|
|
die "no nonce" if not $attrs{"nonce"};
|
|
die "no realm" if not $attrs{"realm"};
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
my $response = digest_response("user", "pass", $attrs{"realm"}, "CONNECT", "$HOST:$PORT", $attrs{"nonce"}, undef, undef, undef);
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\
|
|
Proxy-Authorization: Digest username=\"user\", realm=\"$attrs{realm}\", nonce=\"$attrs{nonce}\", uri=\"$HOST:$PORT\", response=\"$response\"\r\n\r\n");
|
|
$resp = timeout_read($c_out);
|
|
$resp or die "No response from server";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$resp->code == 200 or die "Expected response code 200, got $code";
|
|
return 1;
|
|
}
|
|
die "No Proxy-Authenticate: Digest in server response";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--proxy-type", "http", "--proxy-auth", "user:pass");
|
|
test "HTTP proxy Digest missing fields",
|
|
sub {
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n\r\n");
|
|
my $resp = timeout_read($c_out);
|
|
$resp or die "No response from server";
|
|
$resp = HTTP::Response->parse($resp);
|
|
foreach my $hdr ($resp->header("Proxy-Authenticate")) {
|
|
my ($scheme, %attrs) = parse_proxy_header($hdr);
|
|
next if $scheme ne "Digest";
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
my $response = digest_response("user", "pass", $attrs{"realm"}, "CONNECT", "$HOST:$PORT", $attrs{"nonce"}, undef, undef, undef);
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\
|
|
Proxy-Authorization: Digest username=\"user\", nonce=\"$attrs{nonce}\", response=\"$response\"\r\n\r\n");
|
|
$resp = timeout_read($c_out);
|
|
$resp or die "No response from server";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$resp->code == 407 or die "Expected response code 407, got $code";
|
|
return 1;
|
|
}
|
|
die "No Proxy-Authenticate: Digest in server response";
|
|
};
|
|
kill_children;
|
|
|
|
{
|
|
local $xfail = 1;
|
|
($s_pid, $s_out, $s_in) = ncat_server("--proxy-type", "http", "--proxy-auth", "user:pass");
|
|
test "HTTP proxy Digest prevents replay",
|
|
sub {
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n\r\n");
|
|
my $resp = timeout_read($c_out);
|
|
$resp or die "No response from server";
|
|
$resp = HTTP::Response->parse($resp);
|
|
foreach my $hdr ($resp->header("Proxy-Authenticate")) {
|
|
my ($scheme, %attrs) = parse_proxy_header($hdr);
|
|
next if $scheme ne "Digest";
|
|
die "no nonce" if not $attrs{"nonce"};
|
|
die "no realm" if not $attrs{"realm"};
|
|
my ($c_pid, $c_out, $c_in) = ncat_client();
|
|
my $response = digest_response("user", "pass", $attrs{"realm"}, "CONNECT", "$HOST:$PORT", $attrs{"nonce"}, "auth", "00000001", "abcdefg");
|
|
my $req = "CONNECT $HOST:$PORT HTTP/1.0\r\
|
|
Proxy-Authorization: Digest username=\"user\", realm=\"$attrs{realm}\", nonce=\"$attrs{nonce}\", uri=\"$HOST:$PORT\", qop=\"auth\", nc=\"00000001\", cnonce=\"abcdefg\", response=\"$response\"\r\n\r\n";
|
|
syswrite($c_in, $req);
|
|
$resp = timeout_read($c_out);
|
|
$resp or die "No response from server";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$resp->code == 200 or die "Expected response code 200, got $code";
|
|
syswrite($c_in, $req);
|
|
$resp = timeout_read($c_out);
|
|
if ($resp) {
|
|
$resp = HTTP::Response->parse($resp);
|
|
$code = $resp->code;
|
|
$resp->code == 407 or die "Expected response code 407, got $code";
|
|
}
|
|
return 1;
|
|
}
|
|
die "No Proxy-Authenticate: Digest in server response";
|
|
};
|
|
kill_children;
|
|
}
|
|
|
|
# Test that header field values can be split across lines with LWS.
|
|
server_client_test_multi ["tcp", "tcp ssl"], "HTTP proxy server LWS",
|
|
["--proxy-type", "http", "--proxy-auth", "user:pass"],
|
|
[],
|
|
sub {
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n");
|
|
syswrite($c_in, "Proxy-Authorization:\t Basic \r\n\t \n dXNlcjpwYXNz\r\n");
|
|
syswrite($c_in, "\r\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$code == 200 or die "Expected response code 200, got $code";
|
|
};
|
|
|
|
server_client_test_multi ["tcp", "tcp ssl"], "HTTP proxy server LWS",
|
|
["--proxy-type", "http", "--proxy-auth", "user:pass"],
|
|
[],
|
|
sub {
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n");
|
|
syswrite($c_in, "Proxy-Authorization: Basic\r\n dXNlcjpwYXNz\r\n");
|
|
syswrite($c_in, "\r\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$code == 200 or die "Expected response code 200, got $code";
|
|
};
|
|
|
|
server_client_test_multi ["tcp", "tcp ssl"], "HTTP proxy server no auth",
|
|
["--proxy-type", "http", "--proxy-auth", "user:pass"],
|
|
[],
|
|
sub {
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n");
|
|
syswrite($c_in, "Proxy-Authorization: \r\n");
|
|
syswrite($c_in, "\r\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$code != 200 or die "Got unexpected 200 response";
|
|
};
|
|
|
|
server_client_test_multi ["tcp", "tcp ssl"], "HTTP proxy server broken auth",
|
|
["--proxy-type", "http", "--proxy-auth", "user:pass"],
|
|
[],
|
|
sub {
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n");
|
|
syswrite($c_in, "Proxy-Authorization: French fries\r\n");
|
|
syswrite($c_in, "\r\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$code != 200 or die "Got unexpected 200 response";
|
|
};
|
|
|
|
server_client_test_multi ["tcp", "tcp ssl"], "HTTP proxy server extra auth",
|
|
["--proxy-type", "http", "--proxy-auth", "user:pass"],
|
|
[],
|
|
sub {
|
|
syswrite($c_in, "CONNECT $HOST:$PORT HTTP/1.0\r\n");
|
|
syswrite($c_in, "Proxy-Authorization: Basic " . encode_base64("user:pass") . " extra\r\n");
|
|
syswrite($c_in, "\r\n");
|
|
my $resp = timeout_read($c_out) or die "Read timeout";
|
|
$resp = HTTP::Response->parse($resp);
|
|
my $code = $resp->code;
|
|
$code != 200 or die "Got unexpected 200 response";
|
|
};
|
|
|
|
# Allow and deny list tests.
|
|
|
|
server_client_test_all "Allow localhost (IPv4 address)",
|
|
["--allow", "127.0.0.1"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
|
|
server_client_test_all "Allow localhost (host name)",
|
|
["--allow", "localhost"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
|
|
# Anyone not allowed is denied.
|
|
server_client_test_all "Allow non-localhost",
|
|
["--allow", "1.2.3.4"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server did not reject host not in allow list";
|
|
};
|
|
|
|
# --allow options should accumulate.
|
|
server_client_test_all "--allow options accumulate",
|
|
["--allow", "127.0.0.1", "--allow", "1.2.3.4"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
|
|
server_client_test_all "Deny localhost (IPv4 address)",
|
|
["--deny", "127.0.0.1"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server did not reject host in deny list";
|
|
};
|
|
|
|
server_client_test_all "Deny localhost (host name)",
|
|
["--deny", "localhost"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server did not reject host in deny list";
|
|
};
|
|
|
|
# Anyone not denied is allowed.
|
|
server_client_test_all "Deny non-localhost",
|
|
["--deny", "1.2.3.4"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
|
|
# --deny options should accumulate.
|
|
server_client_test_all "--deny options accumulate",
|
|
["--deny", "127.0.0.1", "--deny", "1.2.3.4"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server did not reject host in deny list";
|
|
};
|
|
|
|
# If a host is both allowed and denied, denial takes precedence.
|
|
server_client_test_all "Allow and deny",
|
|
["--allow", "127.0.0.1", "--deny", "127.0.0.1"], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server did not reject host in deny list";
|
|
};
|
|
|
|
# Test that --allowfile and --denyfile handle blank lines and more than one
|
|
# specification per line.
|
|
for my $contents (
|
|
"1.2.3.4
|
|
|
|
localhost",
|
|
"1.2.3.4 localhost"
|
|
) {
|
|
my ($fh, $filename) = tempfile("ncat-test-XXXXX", SUFFIX => ".txt");
|
|
print $fh $contents;
|
|
server_client_test_all "--allowfile",
|
|
["--allowfile", $filename], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
server_client_test_all "--denyfile",
|
|
["--denyfile", $filename], [], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server did not reject host in --denyfile list";
|
|
};
|
|
unlink $filename;
|
|
}
|
|
|
|
# Test --ssl sending.
|
|
server_client_test "SSL server relays",
|
|
["--ssl", "--ssl-key", "test-cert.pem", "--ssl-cert", "test-cert.pem"], ["--ssl"], sub {
|
|
my $resp;
|
|
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Client got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
|
|
# Test that an SSL server gracefully handles non-SSL connections.
|
|
($s_pid, $s_out, $s_in) = ncat_server("--ssl", "--ssl-key", "test-cert.pem", "--ssl-cert", "test-cert.pem", "--keep-open");
|
|
test "SSL server handles non-SSL connections",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
syswrite($c1_in, "abc\n");
|
|
kill "TERM", $c1_pid;
|
|
waitpid $c1_pid, 0;
|
|
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client("--ssl");
|
|
syswrite($c2_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
kill "TERM", $c2_pid;
|
|
waitpid $c2_pid, 0;
|
|
};
|
|
kill_children;
|
|
|
|
{
|
|
($s_pid, $s_out, $s_in) = ncat_server("--ssl", "--ssl-key", "test-cert.pem", "--ssl-cert", "test-cert.pem");
|
|
test "SSL server doesn't block during handshake",
|
|
sub {
|
|
my $resp;
|
|
|
|
# Connect without SSL so the handshake isn't completed.
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client("--ssl");
|
|
syswrite($c2_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server is still accepting connections.";
|
|
};
|
|
kill_children;
|
|
}
|
|
|
|
{
|
|
($s_pid, $s_out, $s_in) = ncat_server("--ssl", "--ssl-key", "test-cert.pem", "--ssl-cert", "test-cert.pem", "--keep-open");
|
|
test "SSL server doesn't block during handshake(--keep-open)",
|
|
sub {
|
|
my $resp;
|
|
|
|
# Connect without SSL so the handshake isn't completed.
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client("--ssl");
|
|
syswrite($c2_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
}
|
|
{
|
|
($s_pid, $s_out, $s_in) = ncat_server("--ssl", "--exec","/usr/bin/perl -e \$|=1;while(<>){tr/a-z/A-Z/;print}", "--ssl-key", "test-cert.pem", "--ssl-cert", "test-cert.pem", "--keep-open");
|
|
test "SSL --exec server doesn't block during handshake",
|
|
sub {
|
|
my $resp;
|
|
|
|
# Connect without SSL so the handshake isn't completed.
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client("--ssl");
|
|
syswrite($c2_in, "abc\n");
|
|
|
|
$resp = timeout_read($c2_out);
|
|
$resp eq "ABC\n" or die "Client2 got \"$resp\", not \"ABC\\n\"";
|
|
};
|
|
kill_children;
|
|
}
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--ssl", "--ssl-key", "test-cert.pem", "--ssl-cert", "test-cert.pem");
|
|
test "SSL verification, correct domain name",
|
|
sub {
|
|
my $resp;
|
|
|
|
($c_pid, $c_out, $c_in) = ncat($HOST, $PORT, "--ssl-verify", "--ssl-trustfile", "test-cert.pem");
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp or die "Read timeout";
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--ssl", "--ssl-key", "test-cert.pem", "--ssl-cert", "test-cert.pem");
|
|
test "SSL verification, wrong domain name",
|
|
sub {
|
|
my $resp;
|
|
|
|
# Use the IPv6 address as an alternate name that doesn't match the one
|
|
# on the certificate.
|
|
($c_pid, $c_out, $c_in) = ncat($IPV6_ADDR, $PORT, "-6", "--ssl-verify", "--ssl-trustfile", "test-cert.pem");
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server got \"$resp\" when verification should have failed";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--ssl");
|
|
test "SSL verification, no server cert",
|
|
sub {
|
|
my $resp;
|
|
|
|
($c_pid, $c_out, $c_in) = ncat($HOST, $PORT, "--ssl-verify", "--ssl-trustfile", "test-cert.pem");
|
|
syswrite($c_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
!$resp or die "Server got \"$resp\" when verification should have failed";
|
|
};
|
|
kill_children;
|
|
|
|
# Test --max-conns.
|
|
($s_pid, $s_out, $s_in) = ncat_server("--keep-open", "--max-conns", "1");
|
|
test "--keep-open server keeps connection count properly.",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
kill "TERM", $c1_pid;
|
|
waitpid $c1_pid, 0;
|
|
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client();
|
|
syswrite($c2_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--broker", "--max-conns", "1");
|
|
test "--broker server keeps connection count properly.",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
kill "TERM", $c1_pid;
|
|
waitpid $c1_pid, 0;
|
|
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client();
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c2_out);
|
|
$resp eq "abc\n" or die "Second client got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--ssl", "--ssl-key", "test-cert.pem", "--ssl-cert", "test-cert.pem", "--keep-open", "--max-conns", "1");
|
|
test "SSL --keep-open server keeps connection count properly.",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
kill "TERM", $c1_pid;
|
|
waitpid $c1_pid, 0;
|
|
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client("--ssl");
|
|
syswrite($c2_in, "abc\n");
|
|
$resp = timeout_read($s_out);
|
|
$resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
($s_pid, $s_out, $s_in) = ncat_server("--ssl", "--ssl-key", "test-cert.pem", "--ssl-cert", "test-cert.pem", "--broker", "--max-conns", "1");
|
|
test "SSL --broker server keeps connection count properly.",
|
|
sub {
|
|
my $resp;
|
|
|
|
my ($c1_pid, $c1_out, $c1_in) = ncat_client();
|
|
syswrite($c1_in, "abc\n");
|
|
kill "TERM", $c1_pid;
|
|
waitpid $c1_pid, 0;
|
|
|
|
my ($c2_pid, $c2_out, $c2_in) = ncat_client("--ssl");
|
|
syswrite($s_in, "abc\n");
|
|
$resp = timeout_read($c2_out);
|
|
$resp eq "abc\n" or die "Second client got \"$resp\", not \"abc\\n\"";
|
|
};
|
|
kill_children;
|
|
|
|
for my $count (0, 1, 10) {
|
|
max_conns_test_tcp_sctp_ssl("--max-conns $count --keep-open", ["--keep-open"], [], $count);
|
|
}
|
|
|
|
for my $count (0, 1, 10) {
|
|
max_conns_test_tcp_ssl("--max-conns $count --broker", ["--broker"], [], $count);
|
|
}
|
|
|
|
max_conns_test_all("--max-conns 0 --keep-open with exec", ["--keep-open", "--exec", "/bin/cat"], [], 0);
|
|
for my $count (1, 10) {
|
|
max_conns_test_multi(["tcp", "sctp", "udp xfail", "tcp ssl", "sctp ssl"],
|
|
"--max-conns $count --keep-open with exec", ["--keep-open", "--exec", "/bin/cat"], [], $count);
|
|
}
|
|
|
|
# Without --keep-open, just make sure that --max-conns 0 disallows any connection.
|
|
max_conns_test_all("--max-conns 0", [], [], 0);
|
|
max_conns_test_all("--max-conns 0 with exec", ["--exec", "/bin/cat"], [], 0);
|
|
|
|
print "$num_expected_failures expected failures.\n" if $num_expected_failures > 0;
|
|
print "$num_unexpected_passes unexpected passes.\n" if $num_unexpected_passes > 0;
|
|
print "$num_failures unexpected failures.\n";
|
|
print "$num_tests tests total.\n";
|
|
|
|
if ($num_failures + $num_unexpected_passes == 0) {
|
|
exit 0;
|
|
} else {
|
|
exit 1;
|
|
}
|