/ncat/test/ncat-test.pl
Perl | 3100 lines | 2703 code | 290 blank | 107 comment | 184 complexity | 0a602e6e697de6e154eef40ee301e853 MD5 | raw file
Possible License(s): BSD-3-Clause, GPL-2.0, Apache-2.0, LGPL-2.0, LGPL-2.1, MIT
Large files files are truncated, but you can click here to view the full 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 Socket6;
- use Digest::MD5 qw/md5_hex/;
- use POSIX ":sys_wait_h";
- use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
- use IPC::Open3;
- use strict;
- $| = 1;
- my $HOST = "127.0.0.1";
- my $IPV6_ADDR = "::1";
- my $PORT = 40000;
- my $PROXY_PORT = 40001;
- my $UNIXSOCK = "ncat.unixsock";
- my $UNIXSOCK_TMP = "ncat.unixsock_tmp";
- my $WIN32 = $^O eq "MSWin32" || $^O eq "cygwin";
- my $NCAT;
- if ($WIN32) {
- $NCAT = "../Debug/ncat.exe";
- } else {
- $NCAT = "../ncat";
- }
- my $HAVE_SCTP = !$WIN32;
- my $HAVE_UNIXSOCK = !$WIN32;
- 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 "open3 failed";
- }
- binmode *IN;
- binmode *OUT;
- binmode *ERR;
- return ($pid, *OUT, *IN, *ERR);
- }
- sub wait_listen {
- my $fh = shift;
- my $timeout = shift || 0.3;
- my $rd = "";
- vec($rd, fileno($fh), 1) = 1;
- my $partial = "";
- for (;;) {
- my ($n, $frag);
- ($n, $timeout) = select($rd, undef, undef, $timeout);
- last if $n == 0;
- $n = sysread($fh, $frag, $BUFSIZ);
- last if (not defined($n)) || $n == 0;
- $partial = $partial . $frag;
- while ($partial =~ /^(.*?)\n(.*)$/s) {
- my $line = $1;
- $partial = $2;
- if ($line =~ /^NCAT TEST: LISTEN/) {
- return;
- }
- }
- }
- }
- sub ncat_server {
- my @ret = ncat($PORT, "--test", "-l", @_);
- wait_listen($ret[3]);
- return @ret;
- }
- sub host_for_args {
- if (grep(/^-[^-]*6/, @_)) {
- return "::1";
- } else {
- return "127.0.0.1";
- }
- }
- sub ncat_client {
- my $host;
- my @ret = ncat(host_for_args(@_), $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) {
- print "XFAIL $desc\n";
- $num_expected_failures++;
- } 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;
- for my $spec (@$specs) {
- my @server_args = @$server_args_ref;
- my @client_args = @$client_args_ref;
- local $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");
- $xfail = 1 if !$HAVE_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_for_args(@$proxy_args), ($PROXY_PORT, "-l", "--proxy-type", "http"), @$proxy_args);
- ($s_pid, $s_out, $s_in) = ncat(host_for_args(@$server_args), ($PORT, "-l"), @$server_args);
- ($c_pid, $c_out, $c_in) = ncat(host_for_args(@$client_args), ($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_for_args(@$proxy_args), ($PROXY_PORT, "-l", "--proxy-type", "http"), @$proxy_args);
- ($s_pid, $s_out, $s_in) = ncat(host_for_args(@$server_args), ($PORT, "-l"), @$server_args);
- ($c_pid, $c_out, $c_in) = ncat(host_for_args(@$client_args), ($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;
- my @client_ins;
- ($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;
- push @client_ins, $c_in;
- 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;
- push @client_ins, $c_in;
- 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;
- push @client_ins, $c_in;
- 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"], @_);
- }
- sub match_ncat_environment {
- $_ = shift;
- return /NCAT_REMOTE_ADDR=.+\n
- NCAT_REMOTE_PORT=.+\n
- NCAT_LOCAL_ADDR=.+\n
- NCAT_LOCAL_PORT=.+\n
- NCAT_PROTO=.+
- /x;
- }
- # 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("127.0.0.1");
- 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", "::1");
- 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("127.0.0.1");
- 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("127.0.0.1", "--udp");
- syswrite($c_in, "abc\n");
- $resp = timeout_read($s_out);
- !$resp or die "Server got \"$resp\", not \"\" from 127.0.0.1";
- 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("127.0.0.1", "--udp");
- syswrite($c_in, "abc\n");
- $resp = timeout_read($s_out);
- $resp eq "abc\n" or die "Server got \"$resp\", not \"abc\\n\" from 127.0.0.1";
- 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
- {
- local $xfail = 1 if !$HAVE_UNIXSOCK;
- ($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);
- }
- {
- local $xfail = 1 if !$HAVE_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("-l", "--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");
- binmode FH;
- my $contents = join("", <FH>);
- close(FH);
- $contents eq "abc\ndef\n" or die "Server logged " . d($contents);
- open(FH, "client.log");
- binmode FH;
- $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, --sh-exec and --lua-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");
- };
- server_client_test_all "--lua-exec",
- ["--lua-exec", "toupper.lua"], [], 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");
- };
- # Test environment variables being set for --exec, --sh-exec and --lua-exec.
- server_client_test_all "--exec, environment variables",
- ["--exec", "/bin/sh test-environment.sh"], [], sub {
- syswrite($c_in, "abc\n");
- my $resp = timeout_read($c_out) or die "Read timeout";
- match_ncat_environment($resp) or die "Client received " . d($resp) . ".";
- };
- server_client_test_all "--sh-exec, environment variables",
- ["--sh-exec", "sh test-environment.sh"], [], sub {
- syswrite($c_in, "abc\n");
- my $resp = timeout_read($c_out) or die "Read timeout";
- match_ncat_environment($resp) or die "Client received " . d($resp) . ".";
- };
- proxy_test "--exec through proxy, environment variables",
- [], [], ["--exec", "/bin/sh test-environment.sh"], sub {
- my $resp = timeout_read($s_out) or die "Read timeout";
- match_ncat_environment($resp) or die "Client received " . d($resp) . ".";
- };
- server_client_test_all "--lua-exec, environment variables",
- ["--lua-exec", "test-environment.lua"], [], sub {
- syswrite($c_in, "abc\n");
- my $resp = timeout_read($c_out) or die "Read timeout";
- match_ncat_environment($resp) or die "Client received " . d($resp) . ".";
- };
- # 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 proxy with source port $port, not 1234";
- close(S);
- };
- 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";
- close(S);
- };
- 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 proxy with source port $port, not 1234";
- close(S);
- };
- 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 proxy 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 = ti…
Large files files are truncated, but you can click here to view the full file