1#!./perl -w 2 3use strict; 4 5BEGIN { 6 unless(grep /blib/, @INC) { 7 chdir 't' if -d 't'; 8 @INC = '../lib'; 9 } 10} 11 12use Config; 13 14BEGIN { 15 if (-d "lib" && -f "TEST") { 16 my $reason; 17 if (! $Config{'d_fork'}) { 18 $reason = 'no fork'; 19 } 20 elsif ($Config{'extensions'} !~ /\bSocket\b/) { 21 $reason = 'Socket extension unavailable'; 22 } 23 elsif ($Config{'extensions'} !~ /\bIO\b/) { 24 $reason = 'IO extension unavailable'; 25 } 26 if ($reason) { 27 print "1..0 # Skip: $reason\n"; 28 exit 0; 29 } 30 } 31 if ($^O eq 'MSWin32') { 32 print "1..0 # Skip: accept() fails for IPv6 under MSWin32\n"; 33 exit 0; 34 } 35} 36 37$| = 1; 38print "1..20\n"; 39 40eval { 41 $SIG{ALRM} = sub { die; }; 42 alarm 120; 43}; 44 45use IO::Socket::INET6; 46 47my $listen = IO::Socket::INET6->new(Listen => 2, 48 Proto => 'tcp', 49 # some systems seem to need as much as 10, 50 # so be generous with the timeout 51 Timeout => 15, 52 ) or die "$@"; 53 54print "ok 1\n"; 55 56# Check if can fork with dynamic extensions (bug in CRT): 57if ($^O eq 'os2' and 58 system "$^X -I../lib -MOpcode -e 'defined fork or die' > /dev/null 2>&1") { 59 print "ok $_ # skipped: broken fork\n" for 2..5; 60 exit 0; 61} 62 63my $port = $listen->sockport; 64 65my ($pid, $sock); 66 67if($pid = fork()) { 68 69 $sock = $listen->accept() or die "accept failed: $!"; 70 print "ok 2\n"; 71 72 $sock->autoflush(1); 73 print $sock->getline(); 74 75 print $sock "ok 4\n"; 76 77 $sock->close; 78 79 waitpid($pid,0); 80 81 print "ok 5\n"; 82 83} elsif(defined $pid) { 84 85 $sock = IO::Socket::INET6->new(PeerPort => $port, 86 Proto => 'tcp', 87 PeerAddr => 'localhost' 88 ) 89 || IO::Socket::INET6->new(PeerPort => $port, 90 Proto => 'tcp', 91 PeerAddr => '::1' 92 ) 93 or die "$! (maybe your system does not have a localhost at all, 'localhost' or ::1)"; 94 95 $sock->autoflush(1); 96 97 print $sock "ok 3\n"; 98 99 print $sock->getline(); 100 101 $sock->close; 102 103 exit; 104} else { 105 die; 106} 107 108# Test various other ways to create INET sockets that should 109# also work. 110$listen = IO::Socket::INET6->new(Listen => '', Timeout => 15) or die "$@"; 111$port = $listen->sockport; 112 113if($pid = fork()) { 114 SERVER_LOOP: 115 while (1) { 116 last SERVER_LOOP unless $sock = $listen->accept; 117 while (<$sock>) { 118 last SERVER_LOOP if /^quit/; 119 last if /^done/; 120 print; 121 } 122 $sock = undef; 123 } 124 $listen->close; 125} elsif (defined $pid) { 126 # child, try various ways to connect 127 $sock = IO::Socket::INET6->new("localhost:$port") 128 || IO::Socket::INET6->new("[::1]:$port"); 129 if ($sock) { 130 print "not " unless $sock->connected; 131 print "ok 6\n"; 132 $sock->print("ok 7\n"); 133 sleep(1); 134 print "ok 8\n"; 135 $sock->print("ok 9\n"); 136 $sock->print("done\n"); 137 $sock->close; 138 } 139 else { 140 print "# $@\n"; 141 print "not ok 6\n"; 142 print "not ok 7\n"; 143 print "not ok 8\n"; 144 print "not ok 9\n"; 145 } 146 147 # some machines seem to suffer from a race condition here 148 sleep(2); 149 150 $sock = IO::Socket::INET6->new("[::1]:$port"); 151 if ($sock) { 152 $sock->print("ok 10\n"); 153 $sock->print("done\n"); 154 $sock->close; 155 } 156 else { 157 print "# $@\n"; 158 print "not ok 10\n"; 159 } 160 161 # some machines seem to suffer from a race condition here 162 sleep(1); 163 164 $sock = IO::Socket->new(Domain => AF_INET6, 165 PeerAddr => "localhost:$port") 166 || IO::Socket->new(Domain => AF_INET6, 167 PeerAddr => "[::1]:$port"); 168 if ($sock) { 169 $sock->print("ok 11\n"); 170 $sock->print("quit\n"); 171 } else { 172 print "not ok 11\n"; 173 } 174 $sock = undef; 175 sleep(1); 176 exit; 177} else { 178 die; 179} 180 181# Then test UDP sockets 182 183# Test the numeric address directly because "localhost" usually maps 184# to an IPv4 address. 185 186my $server = IO::Socket->new( 187 Domain => AF_INET6, 188 Proto => 'udp', 189 LocalAddr => '::1'); 190$port = $server->sockport; 191 192if ($^O eq 'mpeix') { 193 print("ok 12 # skipped\n") 194} else { 195 if ($pid = fork()) { 196 my $buf; 197 $server->recv($buf, 100); 198 print $buf; 199 } elsif (defined($pid)) { 200 #child 201 202 # Test the numeric address directly because "localhost" usually maps 203 # to an IPv4 address. 204 205 $sock = IO::Socket::INET6->new(Proto => 'udp', 206 Domain => AF_INET6, 207 PeerAddr => "[::1]:$port"); 208 $sock->send("ok 12\n"); 209 sleep(1); 210 $sock->send("ok 12\n"); 211 exit; 212 } else { 213 die; 214 } 215} 216 217print "not " unless $server->blocking; 218print "ok 13\n"; 219 220if ( $^O eq 'qnx' ) { 221 # QNX library bug: Can set non-blocking on socket, but 222 # cannot return that status. 223 print "ok 14 # skipped\n"; 224} else { 225 $server->blocking(0); 226 print "not " if $server->blocking; 227 print "ok 14\n"; 228} 229 230### TEST 15 231### Set up some data to be transfered between the server and 232### the client. We'll use own source code ... 233# 234my @data; 235if( !open( SRC, "< $0")) { 236 print "not ok 15 - $!"; 237} else { 238 @data = <SRC>; 239 close( SRC); 240} 241print "ok 15\n"; 242 243### TEST 16 244### Start the server 245# 246$listen = IO::Socket::INET6->new( Listen => 2, Proto => 'tcp', Timeout => 15) || 247 print "not "; 248print "ok 16\n"; 249die if( !defined( $listen)); 250my $serverport = $listen->sockport; 251 252my $server_pid = fork(); 253if( $server_pid) { 254 255 ### TEST 17 Client/Server establishment 256 # 257 print "ok 17\n"; 258 259 ### TEST 18 260 ### Get data from the server using a single stream 261 # 262 $sock = IO::Socket::INET6->new("localhost:$serverport") 263 || IO::Socket::INET6->new("[::1]:$serverport"); 264 265 if ($sock) { 266 $sock->print("send\n"); 267 268 my @array = (); 269 while( <$sock>) { 270 push( @array, $_); 271 } 272 273 $sock->print("done\n"); 274 $sock->close; 275 276 print "not " if( @array != @data); 277 } else { 278 print "not "; 279 } 280 print "ok 18\n"; 281 282 ### TEST 19 283 ### Get data from the server using a stream, which is 284 ### interrupted by eof calls. 285 ### On perl-5.7.0@7673 this failed in a SOCKS environment, because eof 286 ### did an getc followed by an ungetc in order to check for the streams 287 ### end. getc(3) got replaced by the SOCKS funktion, which ended up in 288 ### a recv(2) call on the socket, while ungetc(3) put back a character 289 ### to an IO buffer, which never again was read. 290 # 291 if ($^O eq 'mpeix') { 292 print "ok 19 # skipped: broken on MPE/iX\n"; 293 } else { 294 $sock = IO::Socket::INET6->new("localhost:$serverport") 295 || IO::Socket::INET6->new("[::1]:$serverport"); 296 297 if ($sock) { 298 $sock->print("send\n"); 299 300 my @array = (); 301 while( !eof( $sock ) ){ 302 while( <$sock>) { 303 push( @array, $_); 304 last; 305 } 306 } 307 308 $sock->print("done\n"); 309 $sock->close; 310 311 print "not " if( @array != @data); 312 } else { 313 print "not "; 314 } 315 print "ok 19\n"; 316 } 317 318 ### TEST 20 319 ### Stop the server 320 # 321 $sock = IO::Socket::INET6->new("localhost:$serverport") 322 || IO::Socket::INET6->new("[::1]:$serverport"); 323 324 if ($sock) { 325 $sock->print("done\n"); 326 $sock->close; 327 328 print "not " if( 1 != kill 0, $server_pid); 329 } else { 330 print "not "; 331 } 332 print "ok 20\n"; 333 334} elsif( defined( $server_pid)) { 335 336 ### Child 337 # 338 SERVER_LOOP: while (1) { 339 last SERVER_LOOP unless $sock = $listen->accept; 340 while (<$sock>) { 341 last SERVER_LOOP if /^quit/; 342 last if /^done/; 343 if( /^send/) { 344 print $sock @data; 345 last; 346 } 347 print; 348 } 349 $sock = undef; 350 } 351 $listen->close; 352 353} else { 354 355 ### Fork failed 356 # 357 print "not ok 17\n"; 358 die; 359} 360 361