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