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 |
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 |
24 | if ($reason) { |
25 | print "1..0 # Skip: $reason\n"; |
7a4c00b4 |
26 | exit 0; |
27 | } |
61f2b451 |
28 | } |
29 | } |
30 | |
31 | $| = 1; |
3c83a670 |
32 | print "1..22\n"; |
61f2b451 |
33 | |
560d348b |
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 |
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 |
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 |
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 |
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 |
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 |
119 | $sock = IO::Socket::INET->new("localhost:$port") |
120 | || IO::Socket::INET->new("127.0.0.1:$port"); |
cf7fe8a2 |
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 |
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 |
157 | PeerAddr => "localhost:$port") |
158 | || IO::Socket->new(Domain => AF_INET, |
159 | PeerAddr => "127.0.0.1:$port"); |
cf7fe8a2 |
160 | if ($sock) { |
161 | $sock->print("ok 11\n"); |
162 | $sock->print("quit\n"); |
9d44748a |
163 | } else { |
164 | print "not ok 11\n"; |
cf7fe8a2 |
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 |
176 | LocalAddr => 'localhost') |
177 | || IO::Socket->new(Domain => AF_INET, |
178 | Proto => 'udp', |
179 | LocalAddr => '127.0.0.1'); |
cf7fe8a2 |
180 | $port = $server->sockport; |
181 | |
0994c4d0 |
182 | if ($^O eq 'mpeix') { |
183 | print("ok 12 # skipped\n") |
cf7fe8a2 |
184 | } else { |
0994c4d0 |
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 |
192 | PeerAddr => "localhost:$port") |
193 | || IO::Socket::INET->new(Proto => 'udp', |
194 | PeerAddr => "127.0.0.1:$port"); |
0994c4d0 |
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 |
204 | print "not " unless $server->blocking; |
205 | print "ok 13\n"; |
61f2b451 |
206 | |
39990a16 |
207 | if ( $^O eq 'qnx' ) { |
6dea6691 |
208 | # QNX4 library bug: Can set non-blocking on socket, but |
39990a16 |
209 | # cannot return that status. |
6dea6691 |
210 | print "ok 14 # skipped on QNX4\n"; |
39990a16 |
211 | } else { |
212 | $server->blocking(0); |
213 | print "not " if $server->blocking; |
214 | print "ok 14\n"; |
215 | } |
cf829ab0 |
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")) { |
3c83a670 |
223 | print "not ok 15 - $!\n"; |
cf829ab0 |
224 | } else { |
225 | @data = <SRC>; |
226 | close( SRC); |
3c83a670 |
227 | print "ok 15\n"; |
cf829ab0 |
228 | } |
cf829ab0 |
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 |
278 | if ($^O eq 'mpeix') { |
279 | print "ok 19 # skipped: broken on MPE/iX\n"; |
280 | } else { |
cf829ab0 |
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 |
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; |
3c83a670 |
339 | exit 0; |
cf829ab0 |
340 | |
341 | } else { |
342 | |
343 | ### Fork failed |
344 | # |
345 | print "not ok 17\n"; |
346 | die; |
347 | } |
348 | |
3c83a670 |
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 | |
6dea6691 |
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 | } |