#!./perl
BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib' if -d '../lib';
- require Config; import Config;
- if ( ($Config{'extensions'} !~ /\bSocket\b/ ||
- $Config{'extensions'} !~ /\bIO\b/) &&
- !(($^O eq 'VMS') && $Config{d_socket})) {
- print "1..0\n";
- exit 0;
+ unless(grep /blib/, @INC) {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib' if -d '../lib';
+ }
+}
+
+use Config;
+
+BEGIN {
+ if (-d "lib" && -f "TEST") {
+ my $reason;
+ if (! $Config{'d_fork'}) {
+ $reason = 'no fork';
+ }
+ elsif ($Config{'extensions'} !~ /\bSocket\b/) {
+ $reason = 'Socket extension unavailable';
+ }
+ elsif ($Config{'extensions'} !~ /\bIO\b/) {
+ $reason = 'IO extension unavailable';
+ }
+ undef $reason if $^O eq 'VMS' and $Config{d_socket};
+ if ($reason) {
+ print "1..0 # Skip: $reason\n";
+ exit 0;
+ }
}
}
$| = 1;
-print "1..5\n";
+print "1..14\n";
use IO::Socket;
-$port = 4002 + int(rand(time) & 0xff);
-$SIG{ALRM} = sub {};
-
-$pid = fork();
+$listen = IO::Socket::INET->new(Listen => 2,
+ Proto => 'tcp',
+ # some systems seem to need as much as 10,
+ # so be generous with the timeout
+ Timeout => 15,
+ ) or die "$!";
-if($pid) {
+print "ok 1\n";
- $listen = IO::Socket::INET->new(Listen => 2,
- Proto => 'tcp',
- LocalPort => $port
- ) or die "$!";
+# Check if can fork with dynamic extensions (bug in CRT):
+if ($^O eq 'os2' and
+ system "$^X -I../lib -MOpcode -e 'defined fork or die' > /dev/null 2>&1") {
+ print "ok $_ # skipped: broken fork\n" for 2..5;
+ exit 0;
+}
- print "ok 1\n";
+$port = $listen->sockport;
- # Wake out child
- kill(ALRM => $pid);
+if($pid = fork()) {
- $sock = $listen->accept();
+ $sock = $listen->accept() or die "accept failed: $!";
print "ok 2\n";
$sock->autoflush(1);
waitpid($pid,0);
print "ok 5\n";
-} elsif(defined $pid) {
- # Wait for a small pause, so that we can ensure the listen socket is setup
- # the parent will awake us with a SIGALRM
+} elsif(defined $pid) {
- sleep(10);
+ # This can fail if localhost is undefined or the
+ # special 'loopback' address 127.0.0.1 is not configured
+ # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
+ # As a shortcut (not recommended) you could change 'localhost'
+ # here to be the name of this machine eg 'myhost.mycompany.com'.
$sock = IO::Socket::INET->new(PeerPort => $port,
Proto => 'tcp',
PeerAddr => 'localhost'
- ) or die "$!";
+ )
+ or die "$! (maybe your system does not have the 'localhost' address defined)";
$sock->autoflush(1);
+
print $sock "ok 3\n";
+
print $sock->getline();
+
$sock->close;
+
exit;
} else {
die;
}
+# Test various other ways to create INET sockets that should
+# also work.
+$listen = IO::Socket::INET->new(Listen => '', Timeout => 15) or die "$!";
+$port = $listen->sockport;
+
+if($pid = fork()) {
+ SERVER_LOOP:
+ while (1) {
+ last SERVER_LOOP unless $sock = $listen->accept;
+ while (<$sock>) {
+ last SERVER_LOOP if /^quit/;
+ last if /^done/;
+ print;
+ }
+ $sock = undef;
+ }
+ $listen->close;
+} elsif (defined $pid) {
+ # child, try various ways to connect
+ $sock = IO::Socket::INET->new("localhost:$port");
+ if ($sock) {
+ print "not " unless $sock->connected;
+ print "ok 6\n";
+ $sock->print("ok 7\n");
+ sleep(1);
+ print "ok 8\n";
+ $sock->print("ok 9\n");
+ $sock->print("done\n");
+ $sock->close;
+ }
+ else {
+ print "# $@\n";
+ print "not ok 6\n";
+ print "not ok 7\n";
+ print "not ok 8\n";
+ print "not ok 9\n";
+ }
+ # some machines seem to suffer from a race condition here
+ sleep(2);
+ $sock = IO::Socket::INET->new("127.0.0.1:$port");
+ if ($sock) {
+ $sock->print("ok 10\n");
+ $sock->print("done\n");
+ $sock->close;
+ }
+ else {
+ print "# $@\n";
+ print "not ok 10\n";
+ }
+ # some machines seem to suffer from a race condition here
+# sleep(1);
+
+ $sock = IO::Socket->new(Domain => AF_INET,
+ PeerAddr => "localhost:$port");
+ if ($sock) {
+ $sock->print("ok 11\n");
+ $sock->print("quit\n");
+ }
+ $sock = undef;
+ sleep(1);
+ exit;
+} else {
+ die;
+}
+
+# Then test UDP sockets
+$server = IO::Socket->new(Domain => AF_INET,
+ Proto => 'udp',
+ LocalAddr => 'localhost');
+$port = $server->sockport;
+
+if ($pid = fork()) {
+ my $buf;
+ $server->recv($buf, 100);
+ print $buf;
+} elsif (defined($pid)) {
+ #child
+ $sock = IO::Socket::INET->new(Proto => 'udp',
+ PeerAddr => "localhost:$port");
+ $sock->send("ok 12\n");
+ sleep(1);
+ $sock->send("ok 12\n"); # send another one to be sure
+ exit;
+} else {
+ die;
+}
+print "not " unless $server->blocking;
+print "ok 13\n";
+$server->blocking(0);
+print "not " if $server->blocking;
+print "ok 14\n";