BEGIN {
unless(grep /blib/, @INC) {
chdir 't' if -d 't';
- unshift @INC, '../lib' if -d '../lib';
+ @INC = '../lib';
}
}
BEGIN {
if (-d "lib" && -f "TEST") {
- if (!$Config{'d_fork'} ||
- (($Config{'extensions'} !~ /\bSocket\b/ ||
- $Config{'extensions'} !~ /\bIO\b/) &&
- !(($^O eq 'VMS') && $Config{d_socket}))) {
- print "1..0\n";
+ 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..14\n";
+print "1..20\n";
use IO::Socket;
$listen = IO::Socket::INET->new(Listen => 2,
Proto => 'tcp',
- Timeout => 2,
+ # some systems seem to need as much as 10,
+ # so be generous with the timeout
+ Timeout => 15,
) or die "$!";
print "ok 1\n";
if($pid = fork()) {
- $sock = $listen->accept();
+ $sock = $listen->accept() or die "accept failed: $!";
print "ok 2\n";
$sock->autoflush(1);
} elsif(defined $pid) {
- # 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 "$! (maybe your system does not have the 'localhost' address defined)";
+ || IO::Socket::INET->new(PeerPort => $port,
+ Proto => 'tcp',
+ PeerAddr => '127.0.0.1'
+ )
+ or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
$sock->autoflush(1);
# Test various other ways to create INET sockets that should
# also work.
-$listen = IO::Socket::INET->new(Listen => '', Timeout => 2) or die "$!";
+$listen = IO::Socket::INET->new(Listen => '', Timeout => 15) or die "$!";
$port = $listen->sockport;
if($pid = fork()) {
$listen->close;
} elsif (defined $pid) {
# child, try various ways to connect
- $sock = IO::Socket::INET->new("localhost:$port");
+ $sock = IO::Socket::INET->new("localhost:$port")
+ || IO::Socket::INET->new("127.0.0.1:$port");
if ($sock) {
print "not " unless $sock->connected;
print "ok 6\n";
}
# some machines seem to suffer from a race condition here
-# sleep(1);
+ sleep(2);
$sock = IO::Socket::INET->new("127.0.0.1:$port");
if ($sock) {
}
# some machines seem to suffer from a race condition here
-# sleep(1);
+ sleep(1);
$sock = IO::Socket->new(Domain => AF_INET,
- PeerAddr => "localhost:$port");
+ PeerAddr => "localhost:$port")
+ || IO::Socket->new(Domain => AF_INET,
+ PeerAddr => "127.0.0.1:$port");
if ($sock) {
$sock->print("ok 11\n");
$sock->print("quit\n");
+ } else {
+ print "not ok 11\n";
}
$sock = undef;
sleep(1);
# Then test UDP sockets
$server = IO::Socket->new(Domain => AF_INET,
Proto => 'udp',
- LocalAddr => 'localhost');
+ LocalAddr => 'localhost')
+ || IO::Socket->new(Domain => AF_INET,
+ Proto => 'udp',
+ LocalAddr => '127.0.0.1');
$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;
+if ($^O eq 'mpeix') {
+ print("ok 12 # skipped\n")
} else {
- die;
+ 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")
+ || IO::Socket::INET->new(Proto => 'udp',
+ PeerAddr => "127.0.0.1:$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;
$server->blocking(0);
print "not " if $server->blocking;
print "ok 14\n";
+
+### TEST 15
+### Set up some data to be transfered between the server and
+### the client. We'll use own source code ...
+#
+local @data;
+if( !open( SRC, "< $0")) {
+ print "not ok 15 - $!";
+} else {
+ @data = <SRC>;
+ close( SRC);
+}
+print "ok 15\n";
+
+### TEST 16
+### Start the server
+#
+my $listen = IO::Socket::INET->new( Listen => 2, Proto => 'tcp', Timeout => 15) ||
+ print "not ";
+print "ok 16\n";
+die if( !defined( $listen));
+my $serverport = $listen->sockport;
+
+my $server_pid = fork();
+if( $server_pid) {
+
+ ### TEST 17 Client/Server establishment
+ #
+ print "ok 17\n";
+
+ ### TEST 18
+ ### Get data from the server using a single stream
+ #
+ $sock = IO::Socket::INET->new("localhost:$serverport")
+ || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+ if ($sock) {
+ $sock->print("send\n");
+
+ my @array = ();
+ while( <$sock>) {
+ push( @array, $_);
+ }
+
+ $sock->print("done\n");
+ $sock->close;
+
+ print "not " if( @array != @data);
+ } else {
+ print "not ";
+ }
+ print "ok 18\n";
+
+ ### TEST 19
+ ### Get data from the server using a stream, which is
+ ### interrupted by eof calls.
+ ### On perl-5.7.0@7673 this failed in a SOCKS environment, because eof
+ ### did an getc followed by an ungetc in order to check for the streams
+ ### end. getc(3) got replaced by the SOCKS funktion, which ended up in
+ ### a recv(2) call on the socket, while ungetc(3) put back a character
+ ### to an IO buffer, which never again was read.
+ #
+ $sock = IO::Socket::INET->new("localhost:$serverport")
+ || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+ if ($sock) {
+ $sock->print("send\n");
+
+ my @array = ();
+ while( !eof( $sock ) ){
+ while( <$sock>) {
+ push( @array, $_);
+ last;
+ }
+ }
+
+ $sock->print("done\n");
+ $sock->close;
+
+ print "not " if( @array != @data);
+ } else {
+ print "not ";
+ }
+ print "ok 19\n";
+
+ ### TEST 20
+ ### Stop the server
+ #
+ $sock = IO::Socket::INET->new("localhost:$serverport")
+ || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+ if ($sock) {
+ $sock->print("done\n");
+ $sock->close;
+
+ print "not " if( 1 != kill 0, $server_pid);
+ } else {
+ print "not ";
+ }
+ print "ok 20\n";
+
+} elsif( defined( $server_pid)) {
+
+ ### Child
+ #
+ SERVER_LOOP: while (1) {
+ last SERVER_LOOP unless $sock = $listen->accept;
+ while (<$sock>) {
+ last SERVER_LOOP if /^quit/;
+ last if /^done/;
+ if( /^send/) {
+ print $sock @data;
+ last;
+ }
+ print;
+ }
+ $sock = undef;
+ }
+ $listen->close;
+
+} else {
+
+ ### Fork failed
+ #
+ print "not ok 17\n";
+ die;
+}
+
projects / p5sagit/p5-mst-13.2.git / blobdiff