4 unless(grep /blib/, @INC) {
14 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bSocket\b/) {
15 $reason = 'Socket extension unavailable';
17 elsif ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/) {
18 $reason = 'IO extension unavailable';
23 ! defined($pid) and die "Fork failed!";
25 defined waitpid($pid, 0);
28 $reason = "no fork: $@";
31 print "1..0 # Skip: $reason\n";
36 my $has_perlio = $] >= 5.008 && find PerlIO::Layer 'perlio';
42 $SIG{ALRM} = sub { die; };
48 $listen = IO::Socket::INET->new(Listen => 2,
50 # some systems seem to need as much as 10,
51 # so be generous with the timeout
57 # Check if can fork with dynamic extensions (bug in CRT):
59 system "$^X -I../lib -MOpcode -e 'defined fork or die' > /dev/null 2>&1") {
60 print "ok $_ # skipped: broken fork\n" for 2..5;
64 $port = $listen->sockport;
68 $sock = $listen->accept() or die "accept failed: $!";
72 print $sock->getline();
82 } elsif(defined $pid) {
84 $sock = IO::Socket::INET->new(PeerPort => $port,
86 PeerAddr => 'localhost'
88 || IO::Socket::INET->new(PeerPort => $port,
90 PeerAddr => '127.0.0.1'
92 or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
98 print $sock->getline();
107 # Test various other ways to create INET sockets that should
109 $listen = IO::Socket::INET->new(Listen => '', Timeout => 15) or die "$!";
110 $port = $listen->sockport;
115 last SERVER_LOOP unless $sock = $listen->accept;
117 last SERVER_LOOP if /^quit/;
124 } elsif (defined $pid) {
125 # child, try various ways to connect
126 $sock = IO::Socket::INET->new("localhost:$port")
127 || IO::Socket::INET->new("127.0.0.1:$port");
129 print "not " unless $sock->connected;
131 $sock->print("ok 7\n");
134 $sock->print("ok 9\n");
135 $sock->print("done\n");
146 # some machines seem to suffer from a race condition here
149 $sock = IO::Socket::INET->new("127.0.0.1:$port");
151 $sock->print("ok 10\n");
152 $sock->print("done\n");
160 # some machines seem to suffer from a race condition here
163 $sock = IO::Socket->new(Domain => AF_INET,
164 PeerAddr => "localhost:$port")
165 || IO::Socket->new(Domain => AF_INET,
166 PeerAddr => "127.0.0.1:$port");
168 $sock->print("ok 11\n");
169 $sock->print("quit\n");
180 # Then test UDP sockets
181 $server = IO::Socket->new(Domain => AF_INET,
183 LocalAddr => 'localhost')
184 || IO::Socket->new(Domain => AF_INET,
186 LocalAddr => '127.0.0.1');
187 $port = $server->sockport;
191 $server->recv($buf, 100);
193 } elsif (defined($pid)) {
195 $sock = IO::Socket::INET->new(Proto => 'udp',
196 PeerAddr => "localhost:$port")
197 || IO::Socket::INET->new(Proto => 'udp',
198 PeerAddr => "127.0.0.1:$port");
199 $sock->send("ok 12\n");
201 $sock->send("ok 12\n"); # send another one to be sure
207 print "not " unless $server->blocking;
210 if ( $^O eq 'qnx' ) {
211 # QNX4 library bug: Can set non-blocking on socket, but
212 # cannot return that status.
213 print "ok 14 # skipped on QNX4\n";
215 $server->blocking(0);
216 print "not " if $server->blocking;
221 ### Set up some data to be transfered between the server and
222 ### the client. We'll use own source code ...
225 if( !open( SRC, "< $0")) {
226 print "not ok 15 - $!\n";
236 my $listen = IO::Socket::INET->new( Listen => 2, Proto => 'tcp', Timeout => 15) ||
239 die if( !defined( $listen));
240 my $serverport = $listen->sockport;
241 my $server_pid = fork();
244 ### TEST 17 Client/Server establishment
249 ### Get data from the server using a single stream
251 $sock = IO::Socket::INET->new("localhost:$serverport")
252 || IO::Socket::INET->new("127.0.0.1:$serverport");
255 $sock->print("send\n");
262 $sock->print("done\n");
265 print "not " if( @array != @data);
272 ### Get data from the server using a stream, which is
273 ### interrupted by eof calls.
274 ### On perl-5.7.0@7673 this failed in a SOCKS environment, because eof
275 ### did an getc followed by an ungetc in order to check for the streams
276 ### end. getc(3) got replaced by the SOCKS funktion, which ended up in
277 ### a recv(2) call on the socket, while ungetc(3) put back a character
278 ### to an IO buffer, which never again was read.
280 ### TESTS 19,20,21,22
281 ### Try to ping-pong some Unicode.
283 $sock = IO::Socket::INET->new("localhost:$serverport")
284 || IO::Socket::INET->new("127.0.0.1:$serverport");
287 print binmode($sock, ":utf8") ? "ok 19\n" : "not ok 19\n";
289 print "ok 19 - Skip: no perlio\n";
295 $sock->print("ping \x{100}\n");
296 chomp(my $pong = scalar <$sock>);
297 print $pong =~ /^pong (.+)$/ && $1 eq "\x{100}" ?
298 "ok 20\n" : "not ok 20\n";
300 $sock->print("ord \x{100}\n");
301 chomp(my $ord = scalar <$sock>);
302 print $ord == 0x100 ?
303 "ok 21\n" : "not ok 21\n";
305 $sock->print("chr 0x100\n");
306 chomp(my $chr = scalar <$sock>);
307 print $chr eq "\x{100}" ?
308 "ok 22\n" : "not ok 22\n";
310 print "ok $_ - Skip: no perlio\n" for 20..22;
313 $sock->print("send\n");
316 while( !eof( $sock ) ){
323 $sock->print("done\n");
326 print "not " if( @array != @data);
335 $sock = IO::Socket::INET->new("localhost:$serverport")
336 || IO::Socket::INET->new("127.0.0.1:$serverport");
339 $sock->print("done\n");
342 print "not " if( 1 != kill 0, $server_pid);
348 } elsif (defined($server_pid)) {
352 SERVER_LOOP: while (1) {
353 last SERVER_LOOP unless $sock = $listen->accept;
354 # Do not print ok/not ok for this binmode() since there's
355 # a race condition with our client, just die if we fail.
356 if ($has_perlio) { binmode($sock, ":utf8") or die }
358 last SERVER_LOOP if /^quit/;
361 print $sock "pong $1\n";
365 print $sock ord($1), "\n";
369 print $sock chr(hex($1)), "\n";
391 # test Blocking option in constructor
393 $sock = IO::Socket::INET->new(Blocking => 0)
397 if ( $^O eq 'qnx' ) {
398 print "ok 26 # skipped on QNX4\n";
399 # QNX4 library bug: Can set non-blocking on socket, but
400 # cannot return that status.
402 my $status = $sock->blocking;
403 print "not " unless defined $status && !$status;