trunk/tests/netcat.pl

use strict;
use warnings;

use Socket;

binmode(STDIN);
$| = 1;
binmode(STDOUT);

if (@ARGV != 2) {
  die "Usage: netcat.pl HOST PORT\n";
}

my $host = shift;
my $port = shift;

my $address = inet_aton($host) or die;
my $address_and_port = sockaddr_in($port, $address);
my $protocol = getprotobyname('tcp');
socket(SOCKET, PF_INET, SOCK_STREAM, $protocol) or die;

my $old = select(SOCKET);
$| = 1;
select($old);
binmode(SOCKET);

connect(SOCKET, $address_and_port) or die;
while (<STDIN>) {
  print SOCKET $_;
}
while (<SOCKET>) {
  print;
}
close(SOCKET);
exit 0;
1	use strict;
2	use warnings;
3
4	use Socket;
5
6	binmode(STDIN);
7	$\| = 1;
8	binmode(STDOUT);
9
10	if (@ARGV != 2) {
11	die "Usage: netcat.pl HOST PORT\n";
12	}
13
14	my $host = shift;
15	my $port = shift;
16
17	my $address = inet_aton($host) or die;
18	my $address_and_port = sockaddr_in($port, $address);
19	my $protocol = getprotobyname('tcp');
20	socket(SOCKET, PF_INET, SOCK_STREAM, $protocol) or die;
21
22	my $old = select(SOCKET);
23	$\| = 1;
24	select($old);
25	binmode(SOCKET);
26
27	connect(SOCKET, $address_and_port) or die;
28	while (<STDIN>) {
29	print SOCKET $_;
30	}
31	while (<SOCKET>) {
32	print;
33	}
34	close(SOCKET);
35	exit 0;