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