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