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; |
cf7fe8a2 |
33 | print "1..14\n"; |
61f2b451 |
34 | |
35 | use IO::Socket; |
36 | |
7a4c00b4 |
37 | $listen = IO::Socket::INET->new(Listen => 2, |
38 | Proto => 'tcp', |
862b0ad8 |
39 | # some systems seem to need as much as 10, |
40 | # so be generous with the timeout |
41 | Timeout => 15, |
7a4c00b4 |
42 | ) or die "$!"; |
61f2b451 |
43 | |
7a4c00b4 |
44 | print "ok 1\n"; |
61f2b451 |
45 | |
a245ea2d |
46 | # Check if can fork with dynamic extensions (bug in CRT): |
47 | if ($^O eq 'os2' and |
48 | system "$^X -I../lib -MOpcode -e 'defined fork or die' > /dev/null 2>&1") { |
49 | print "ok $_ # skipped: broken fork\n" for 2..5; |
50 | exit 0; |
51 | } |
52 | |
7a4c00b4 |
53 | $port = $listen->sockport; |
61f2b451 |
54 | |
7a4c00b4 |
55 | if($pid = fork()) { |
61f2b451 |
56 | |
e197ebb9 |
57 | $sock = $listen->accept() or die "accept failed: $!"; |
61f2b451 |
58 | print "ok 2\n"; |
59 | |
60 | $sock->autoflush(1); |
61 | print $sock->getline(); |
62 | |
63 | print $sock "ok 4\n"; |
64 | |
65 | $sock->close; |
66 | |
67 | waitpid($pid,0); |
68 | |
69 | print "ok 5\n"; |
61f2b451 |
70 | |
7a4c00b4 |
71 | } elsif(defined $pid) { |
61f2b451 |
72 | |
73 | $sock = IO::Socket::INET->new(PeerPort => $port, |
74 | Proto => 'tcp', |
75 | PeerAddr => 'localhost' |
9b599b2a |
76 | ) |
6e806fe3 |
77 | || IO::Socket::INET->new(PeerPort => $port, |
78 | Proto => 'tcp', |
79 | PeerAddr => '127.0.0.1' |
80 | ) |
81 | or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)"; |
61f2b451 |
82 | |
83 | $sock->autoflush(1); |
7a4c00b4 |
84 | |
61f2b451 |
85 | print $sock "ok 3\n"; |
7a4c00b4 |
86 | |
61f2b451 |
87 | print $sock->getline(); |
7a4c00b4 |
88 | |
61f2b451 |
89 | $sock->close; |
7a4c00b4 |
90 | |
61f2b451 |
91 | exit; |
92 | } else { |
93 | die; |
94 | } |
95 | |
cf7fe8a2 |
96 | # Test various other ways to create INET sockets that should |
97 | # also work. |
862b0ad8 |
98 | $listen = IO::Socket::INET->new(Listen => '', Timeout => 15) or die "$!"; |
cf7fe8a2 |
99 | $port = $listen->sockport; |
61f2b451 |
100 | |
cf7fe8a2 |
101 | if($pid = fork()) { |
102 | SERVER_LOOP: |
103 | while (1) { |
104 | last SERVER_LOOP unless $sock = $listen->accept; |
105 | while (<$sock>) { |
106 | last SERVER_LOOP if /^quit/; |
107 | last if /^done/; |
108 | print; |
109 | } |
110 | $sock = undef; |
111 | } |
112 | $listen->close; |
113 | } elsif (defined $pid) { |
114 | # child, try various ways to connect |
6e806fe3 |
115 | $sock = IO::Socket::INET->new("localhost:$port") |
116 | || IO::Socket::INET->new("127.0.0.1:$port"); |
cf7fe8a2 |
117 | if ($sock) { |
118 | print "not " unless $sock->connected; |
119 | print "ok 6\n"; |
120 | $sock->print("ok 7\n"); |
121 | sleep(1); |
122 | print "ok 8\n"; |
123 | $sock->print("ok 9\n"); |
124 | $sock->print("done\n"); |
125 | $sock->close; |
126 | } |
127 | else { |
128 | print "# $@\n"; |
129 | print "not ok 6\n"; |
130 | print "not ok 7\n"; |
131 | print "not ok 8\n"; |
132 | print "not ok 9\n"; |
133 | } |
134 | |
135 | # some machines seem to suffer from a race condition here |
d6a255e6 |
136 | sleep(2); |
cf7fe8a2 |
137 | |
138 | $sock = IO::Socket::INET->new("127.0.0.1:$port"); |
139 | if ($sock) { |
140 | $sock->print("ok 10\n"); |
141 | $sock->print("done\n"); |
142 | $sock->close; |
143 | } |
144 | else { |
145 | print "# $@\n"; |
146 | print "not ok 10\n"; |
147 | } |
61f2b451 |
148 | |
cf7fe8a2 |
149 | # some machines seem to suffer from a race condition here |
e3e876cf |
150 | sleep(1); |
61f2b451 |
151 | |
cf7fe8a2 |
152 | $sock = IO::Socket->new(Domain => AF_INET, |
6e806fe3 |
153 | PeerAddr => "localhost:$port") |
154 | || IO::Socket->new(Domain => AF_INET, |
155 | PeerAddr => "127.0.0.1:$port"); |
cf7fe8a2 |
156 | if ($sock) { |
157 | $sock->print("ok 11\n"); |
158 | $sock->print("quit\n"); |
159 | } |
160 | $sock = undef; |
161 | sleep(1); |
162 | exit; |
163 | } else { |
164 | die; |
165 | } |
166 | |
167 | # Then test UDP sockets |
168 | $server = IO::Socket->new(Domain => AF_INET, |
169 | Proto => 'udp', |
6e806fe3 |
170 | LocalAddr => 'localhost') |
171 | || IO::Socket->new(Domain => AF_INET, |
172 | Proto => 'udp', |
173 | LocalAddr => '127.0.0.1'); |
cf7fe8a2 |
174 | $port = $server->sockport; |
175 | |
0994c4d0 |
176 | if ($^O eq 'mpeix') { |
177 | print("ok 12 # skipped\n") |
cf7fe8a2 |
178 | } else { |
0994c4d0 |
179 | if ($pid = fork()) { |
180 | my $buf; |
181 | $server->recv($buf, 100); |
182 | print $buf; |
183 | } elsif (defined($pid)) { |
184 | #child |
185 | $sock = IO::Socket::INET->new(Proto => 'udp', |
6e806fe3 |
186 | PeerAddr => "localhost:$port") |
187 | || IO::Socket::INET->new(Proto => 'udp', |
188 | PeerAddr => "127.0.0.1:$port"); |
0994c4d0 |
189 | $sock->send("ok 12\n"); |
190 | sleep(1); |
191 | $sock->send("ok 12\n"); # send another one to be sure |
192 | exit; |
193 | } else { |
194 | die; |
195 | } |
cf7fe8a2 |
196 | } |
61f2b451 |
197 | |
cf7fe8a2 |
198 | print "not " unless $server->blocking; |
199 | print "ok 13\n"; |
61f2b451 |
200 | |
cf7fe8a2 |
201 | $server->blocking(0); |
202 | print "not " if $server->blocking; |
203 | print "ok 14\n"; |