Commit | Line | Data |
61f2b451 |
1 | #!./perl |
2 | |
3 | BEGIN { |
7a4c00b4 |
4 | unless(grep /blib/, @INC) { |
5 | chdir 't' if -d 't'; |
93430cb4 |
6 | unshift @INC, '../lib' if -d '../lib'; |
7a4c00b4 |
7 | } |
8 | } |
9 | |
10 | use Config; |
11 | |
12 | BEGIN { |
774d564b |
13 | if (-d "lib" && -f "TEST") { |
14 | if (!$Config{'d_fork'} || |
15 | (($Config{'extensions'} !~ /\bSocket\b/ || |
16 | $Config{'extensions'} !~ /\bIO\b/) && |
17 | !(($^O eq 'VMS') && $Config{d_socket}))) { |
7a4c00b4 |
18 | print "1..0\n"; |
19 | exit 0; |
20 | } |
61f2b451 |
21 | } |
22 | } |
23 | |
24 | $| = 1; |
cf7fe8a2 |
25 | print "1..14\n"; |
61f2b451 |
26 | |
27 | use IO::Socket; |
28 | |
7a4c00b4 |
29 | $listen = IO::Socket::INET->new(Listen => 2, |
30 | Proto => 'tcp', |
862b0ad8 |
31 | # some systems seem to need as much as 10, |
32 | # so be generous with the timeout |
33 | Timeout => 15, |
7a4c00b4 |
34 | ) or die "$!"; |
61f2b451 |
35 | |
7a4c00b4 |
36 | print "ok 1\n"; |
61f2b451 |
37 | |
a245ea2d |
38 | # Check if can fork with dynamic extensions (bug in CRT): |
39 | if ($^O eq 'os2' and |
40 | system "$^X -I../lib -MOpcode -e 'defined fork or die' > /dev/null 2>&1") { |
41 | print "ok $_ # skipped: broken fork\n" for 2..5; |
42 | exit 0; |
43 | } |
44 | |
7a4c00b4 |
45 | $port = $listen->sockport; |
61f2b451 |
46 | |
7a4c00b4 |
47 | if($pid = fork()) { |
61f2b451 |
48 | |
e197ebb9 |
49 | $sock = $listen->accept() or die "accept failed: $!"; |
61f2b451 |
50 | print "ok 2\n"; |
51 | |
52 | $sock->autoflush(1); |
53 | print $sock->getline(); |
54 | |
55 | print $sock "ok 4\n"; |
56 | |
57 | $sock->close; |
58 | |
59 | waitpid($pid,0); |
60 | |
61 | print "ok 5\n"; |
61f2b451 |
62 | |
7a4c00b4 |
63 | } elsif(defined $pid) { |
61f2b451 |
64 | |
68820cec |
65 | # This can fail if localhost is undefined or the |
66 | # special 'loopback' address 127.0.0.1 is not configured |
67 | # on your system. (/etc/rc.config.d/netconfig on HP-UX.) |
9b599b2a |
68 | # As a shortcut (not recommended) you could change 'localhost' |
69 | # here to be the name of this machine eg 'myhost.mycompany.com'. |
68820cec |
70 | |
61f2b451 |
71 | $sock = IO::Socket::INET->new(PeerPort => $port, |
72 | Proto => 'tcp', |
73 | PeerAddr => 'localhost' |
9b599b2a |
74 | ) |
cf7fe8a2 |
75 | or die "$! (maybe your system does not have the 'localhost' address defined)"; |
61f2b451 |
76 | |
77 | $sock->autoflush(1); |
7a4c00b4 |
78 | |
61f2b451 |
79 | print $sock "ok 3\n"; |
7a4c00b4 |
80 | |
61f2b451 |
81 | print $sock->getline(); |
7a4c00b4 |
82 | |
61f2b451 |
83 | $sock->close; |
7a4c00b4 |
84 | |
61f2b451 |
85 | exit; |
86 | } else { |
87 | die; |
88 | } |
89 | |
cf7fe8a2 |
90 | # Test various other ways to create INET sockets that should |
91 | # also work. |
862b0ad8 |
92 | $listen = IO::Socket::INET->new(Listen => '', Timeout => 15) or die "$!"; |
cf7fe8a2 |
93 | $port = $listen->sockport; |
61f2b451 |
94 | |
cf7fe8a2 |
95 | if($pid = fork()) { |
96 | SERVER_LOOP: |
97 | while (1) { |
98 | last SERVER_LOOP unless $sock = $listen->accept; |
99 | while (<$sock>) { |
100 | last SERVER_LOOP if /^quit/; |
101 | last if /^done/; |
102 | print; |
103 | } |
104 | $sock = undef; |
105 | } |
106 | $listen->close; |
107 | } elsif (defined $pid) { |
108 | # child, try various ways to connect |
109 | $sock = IO::Socket::INET->new("localhost:$port"); |
110 | if ($sock) { |
111 | print "not " unless $sock->connected; |
112 | print "ok 6\n"; |
113 | $sock->print("ok 7\n"); |
114 | sleep(1); |
115 | print "ok 8\n"; |
116 | $sock->print("ok 9\n"); |
117 | $sock->print("done\n"); |
118 | $sock->close; |
119 | } |
120 | else { |
121 | print "# $@\n"; |
122 | print "not ok 6\n"; |
123 | print "not ok 7\n"; |
124 | print "not ok 8\n"; |
125 | print "not ok 9\n"; |
126 | } |
127 | |
128 | # some machines seem to suffer from a race condition here |
7e3cfbc1 |
129 | sleep(1); |
cf7fe8a2 |
130 | |
131 | $sock = IO::Socket::INET->new("127.0.0.1:$port"); |
132 | if ($sock) { |
133 | $sock->print("ok 10\n"); |
134 | $sock->print("done\n"); |
135 | $sock->close; |
136 | } |
137 | else { |
138 | print "# $@\n"; |
139 | print "not ok 10\n"; |
140 | } |
61f2b451 |
141 | |
cf7fe8a2 |
142 | # some machines seem to suffer from a race condition here |
143 | # sleep(1); |
61f2b451 |
144 | |
cf7fe8a2 |
145 | $sock = IO::Socket->new(Domain => AF_INET, |
146 | PeerAddr => "localhost:$port"); |
147 | if ($sock) { |
148 | $sock->print("ok 11\n"); |
149 | $sock->print("quit\n"); |
150 | } |
151 | $sock = undef; |
152 | sleep(1); |
153 | exit; |
154 | } else { |
155 | die; |
156 | } |
157 | |
158 | # Then test UDP sockets |
159 | $server = IO::Socket->new(Domain => AF_INET, |
160 | Proto => 'udp', |
161 | LocalAddr => 'localhost'); |
162 | $port = $server->sockport; |
163 | |
164 | if ($pid = fork()) { |
165 | my $buf; |
166 | $server->recv($buf, 100); |
167 | print $buf; |
168 | } elsif (defined($pid)) { |
169 | #child |
170 | $sock = IO::Socket::INET->new(Proto => 'udp', |
171 | PeerAddr => "localhost:$port"); |
172 | $sock->send("ok 12\n"); |
173 | sleep(1); |
174 | $sock->send("ok 12\n"); # send another one to be sure |
175 | exit; |
176 | } else { |
177 | die; |
178 | } |
61f2b451 |
179 | |
cf7fe8a2 |
180 | print "not " unless $server->blocking; |
181 | print "ok 13\n"; |
61f2b451 |
182 | |
cf7fe8a2 |
183 | $server->blocking(0); |
184 | print "not " if $server->blocking; |
185 | print "ok 14\n"; |