Commit | Line | Data |
4536f655 |
1 | # File: Stem/Socket.pm |
2 | |
3 | # This file is part of Stem. |
4 | # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc. |
5 | |
6 | # Stem is free software; you can redistribute it and/or modify |
7 | # it under the terms of the GNU General Public License as published by |
8 | # the Free Software Foundation; either version 2 of the License, or |
9 | # (at your option) any later version. |
10 | |
11 | # Stem is distributed in the hope that it will be useful, |
12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
14 | # GNU General Public License for more details. |
15 | |
16 | # You should have received a copy of the GNU General Public License |
17 | # along with Stem; if not, write to the Free Software |
18 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
19 | |
20 | # For a license to use the Stem under conditions other than those |
21 | # described here, to purchase support for this software, or to purchase a |
22 | # commercial warranty contract, please contact Stem Systems at: |
23 | |
24 | # Stem Systems, Inc. 781-643-7504 |
25 | # 79 Everett St. info@stemsystems.com |
26 | # Arlington, MA 02474 |
27 | # USA |
28 | |
29 | ####################################################### |
30 | |
31 | #print "LOADED\n" ; |
32 | |
33 | package Stem::Socket ; |
34 | |
35 | use strict ; |
36 | |
37 | use IO::Socket ; |
38 | use Symbol ; |
39 | use Errno qw( EINPROGRESS ) ; |
40 | |
41 | use Stem::Class ; |
42 | |
43 | my $attr_spec = [ |
44 | |
45 | { |
46 | 'name' => 'object', |
47 | 'required' => 1, |
48 | 'type' => 'object', |
49 | 'help' => <<HELP, |
50 | This is the owner object which has the methods that get called when Stem::Socket |
51 | has either connected, timed out or accepted a socket connection |
52 | HELP |
53 | }, |
54 | { |
55 | 'name' => 'server', |
56 | 'type' => 'boolean', |
57 | 'help' => <<HELP, |
58 | If set, then this is a server socket. |
59 | HELP |
60 | }, |
61 | { |
62 | 'name' => 'sync', |
63 | 'type' => 'boolean', |
64 | 'default' => 0, |
65 | 'help' => <<HELP, |
66 | Mark this as a synchronously connecting socket. Default is asyncronous |
67 | connections. In both cases the same method callbacks are used. |
68 | HELP |
69 | }, |
70 | { |
71 | 'name' => 'port', |
72 | 'required' => 1, |
73 | 'help' => <<HELP, |
74 | This is the TCP port number for listening or connecting. |
75 | HELP |
76 | }, |
77 | { |
78 | 'name' => 'host', |
79 | 'default' => 'localhost', |
80 | 'help' => <<HELP, |
81 | Host to connect to or listen on. If a listen socket host is explicitly |
82 | set to '', then the host will be INADDR_ANY which allows a server to |
83 | listen on all host interfaces. |
84 | HELP |
85 | }, |
86 | { |
87 | 'name' => 'method', |
88 | 'default' => 'connected', |
89 | 'help' => <<HELP, |
90 | This method is called in the owner object when when a socket |
91 | connection or accept happens. |
92 | HELP |
93 | }, |
94 | { |
95 | 'name' => 'timeout_method', |
96 | 'default' => 'connect_timeout', |
97 | 'help' => <<HELP, |
98 | This method is called in the owner object when when a socket |
99 | connection times out. |
100 | HELP |
101 | }, |
102 | { |
103 | 'name' => 'timeout', |
104 | 'default' => 10, |
105 | 'help' => <<HELP, |
106 | How long to wait (in seconds) before a connection times out. |
107 | HELP |
108 | }, |
109 | { |
110 | 'name' => 'max_retries', |
111 | 'default' => 0, |
112 | 'help' => <<HELP, |
113 | The maximum number of connection retries before an error is returned. |
114 | HELP |
115 | }, |
116 | { |
117 | 'name' => 'listen', |
118 | 'default' => '5', |
119 | 'help' => <<HELP, |
120 | This sets how many socket connections can be queued by a server socket. |
121 | HELP |
122 | }, |
123 | { |
124 | 'name' => 'ssl_args', |
125 | 'type' => 'list', |
126 | 'help' => <<HELP, |
127 | This makes the socket use the IO::Socket::SSL module for secure sockets. The |
128 | arguments are passed to the new() method of that module. |
129 | HELP |
130 | }, |
131 | { |
132 | 'name' => 'id', |
133 | 'help' => <<HELP, |
134 | The id is passed to the callback method as its only argument. Use it to |
135 | identify different instances of this object. |
136 | HELP |
137 | |
138 | }, |
139 | ] ; |
140 | |
141 | sub new { |
142 | |
143 | my( $class ) = shift ; |
144 | |
145 | my $self = Stem::Class::parse_args( $attr_spec, @_ ) ; |
146 | return $self unless ref $self ; |
147 | |
148 | if ( $self->{ 'server' } ) { |
149 | |
150 | $self->{'type'} = 'server' ; |
151 | my $listen_err = $self->listen_to() ; |
152 | |
153 | #print "ERR [$listen_err]\n" ; |
154 | return $listen_err if $listen_err ; |
155 | } |
156 | else { |
157 | |
158 | $self->{'type'} = 'client' ; |
159 | my $connect_err = $self->connect_to() ; |
160 | return $connect_err if $connect_err ; |
161 | } |
162 | |
163 | return( $self ) ; |
164 | } |
165 | |
166 | use Carp 'cluck' ; |
167 | |
168 | sub shut_down { |
169 | |
170 | my( $self ) = @_ ; |
171 | |
172 | #cluck "SOCKET SHUT" ; |
173 | |
174 | if ( $self->{'type'} eq 'server' ) { |
175 | |
176 | #print "SOCKET SHUT server" ; |
177 | |
178 | if ( my $read_event = delete $self->{'read_event'} ) { |
179 | |
180 | $read_event->cancel() ; |
181 | } |
182 | |
183 | my $listen_sock = delete $self->{'listen_sock'} ; |
184 | $listen_sock->close() ; |
185 | |
186 | return ; |
187 | } |
188 | |
189 | #print "SOCKET SHUT client" ; |
190 | |
191 | $self->_write_cancel() ; |
192 | |
193 | return ; |
194 | } |
195 | |
196 | sub type { |
197 | $_[0]->{'type'} ; |
198 | } |
199 | |
200 | sub connect_to { |
201 | |
202 | my( $self ) = @_ ; |
203 | |
204 | my $connect_sock = Stem::Socket::get_connected_sock( |
205 | $self->{'host'}, |
206 | $self->{'port'}, |
207 | $self->{'sync'}, |
208 | ) ; |
209 | |
210 | return $connect_sock unless ref $connect_sock ; |
211 | |
212 | $self->{'connected_sock'} = $connect_sock ; |
213 | |
214 | if( $self->{'sync'} ) { |
215 | |
216 | $self->connect_writeable() ; |
217 | return ; |
218 | } |
219 | |
220 | # create and save the write event watcher |
221 | |
222 | my $write_event = Stem::Event::Write->new( |
223 | 'object' => $self, |
224 | 'fh' => $connect_sock, |
225 | 'timeout' => $self->{'timeout'}, |
226 | 'method' => 'connect_writeable', |
227 | 'timeout_method' => 'connect_timeout', |
228 | ) ; |
229 | |
230 | return $write_event unless ref $write_event ; |
231 | $self->{'write_event'} = $write_event ; |
232 | $write_event->start() ; |
233 | |
234 | return ; |
235 | } |
236 | |
237 | # callback when a socket is connected (the socket is writeable) |
238 | |
239 | sub connect_writeable { |
240 | |
241 | my( $self ) = @_ ; |
242 | |
243 | # get the connected socket |
244 | |
245 | my $connected_sock = $self->{'connected_sock'} ; |
246 | |
247 | if ( my $ssl_args = $self->{'ssl_args'} ) { |
248 | |
249 | require IO::Socket::SSL ; |
250 | IO::Socket::SSL->VERSION(0.96); |
251 | |
252 | my $err = IO::Socket::SSL->start_SSL( |
253 | $connected_sock, |
254 | @{$ssl_args} |
255 | ) ; |
256 | |
257 | $err || die |
258 | "bad ssl connect socket: " . IO::Socket::SSL::errstr() ; |
259 | } |
260 | |
261 | # the i/o for sockets is always non-blocking in stem. |
262 | |
263 | $connected_sock->blocking( 0 ) ; |
264 | |
265 | # callback the owner object with the connected socket as the argument |
266 | |
267 | my $method = $self->{'method'} ; |
268 | $self->{'object'}->$method( $connected_sock, $self->{'id'} ); |
269 | |
270 | $self->_write_cancel() ; |
271 | |
272 | return ; |
273 | } |
274 | |
275 | sub connect_timeout { |
276 | |
277 | my( $self ) = @_ ; |
278 | |
279 | $self->_write_cancel() ; |
280 | |
281 | $self->{'connected_sock'}->close() ; |
282 | delete $self->{'connected_sock'} ; |
283 | |
284 | if ( $self->{'max_retries'} && --$self->{'retry_count'} > 0 ) { |
285 | |
286 | my $method = $self->{'timeout_method'} ; |
287 | $self->{'object'}->$method( $self->{'id'} ); |
288 | return ; |
289 | } |
290 | |
291 | $self->connect_to() ; |
292 | |
293 | return ; |
294 | } |
295 | |
296 | sub _write_cancel { |
297 | |
298 | my( $self ) = @_ ; |
299 | |
300 | # my $sock = delete $self->{'connected_sock'} ; |
301 | # $sock->close() ; |
302 | |
303 | my $event = delete $self->{'write_event'} ; |
304 | return unless $event ; |
305 | $event->cancel() ; |
306 | } |
307 | |
308 | sub get_connected_sock { |
309 | |
310 | my( $host, $port, $sync ) = @_ ; |
311 | |
312 | unless( $port ) { |
313 | |
314 | my $err = "get_connected_sock Missing port" ; |
315 | return $err ; |
316 | } |
317 | |
318 | # get the host name or IP and convert it to an inet address |
319 | |
320 | my $inet_addr = inet_aton( $host ) ; |
321 | |
322 | unless( $inet_addr ) { |
323 | |
324 | my $err = "get_connected_sock Unknown host [$host]" ; |
325 | return $err ; |
326 | } |
327 | |
328 | # check if it is a get the service name or numeric port and convert it |
329 | # to a port number |
330 | |
331 | if ( $port =~ /\D/ and not $port = getservbyname( $port, 'tcp' ) ) { |
332 | |
333 | my $err = "get_connected_sock: unknown port [$port]" ; |
334 | return $err ; |
335 | } |
336 | |
337 | # prepare the socket address |
338 | |
339 | my $sock_addr = pack_sockaddr_in( $port, $inet_addr ) ; |
340 | |
341 | my $connect_sock = IO::Socket::INET->new( Domain => AF_INET) ; |
342 | |
343 | #print "connect $connect_sock [", $connect_sock->fileno(), "]\n" ; |
344 | |
345 | # set the sync (connect blocking) mode |
346 | |
347 | $connect_sock->blocking( $sync ) ; |
348 | |
349 | unless ( connect( $connect_sock, $sock_addr ) ) { |
350 | |
351 | # handle linux false error of EINPROGRESS |
352 | |
353 | return <<ERR unless $! == EINPROGRESS ; |
354 | get_connected_sock: connect to '$host:$port' error $! |
355 | ERR |
356 | } |
357 | |
358 | return $connect_sock ; |
359 | } |
360 | |
361 | sub listen_to { |
362 | |
363 | my( $self ) = @_ ; |
364 | |
365 | my $listen_sock = get_listen_sock( |
366 | $self->{'host'}, |
367 | $self->{'port'}, |
368 | $self->{'listen'}, |
369 | ) ; |
370 | |
371 | return $listen_sock unless ref $listen_sock ; |
372 | |
373 | $self->{'listen_sock'} = $listen_sock ; |
374 | |
375 | # create and save the read event watcher |
376 | |
377 | my $read_event = Stem::Event::Read->new( |
378 | 'object' => $self, |
379 | 'fh' => $listen_sock, |
380 | 'method' => 'listen_readable', |
381 | ) ; |
382 | |
383 | $self->{'read_event'} = $read_event ; |
384 | |
385 | return ; |
386 | } |
387 | |
388 | # callback when a socket can be accepted (the listen socket is readable) |
389 | |
390 | sub listen_readable { |
391 | |
392 | my( $self ) = @_ ; |
393 | |
394 | # get the accepted socket |
395 | |
396 | my $accepted_sock = $self->{'listen_sock'}->accept() ; |
397 | |
398 | # $accepted_sock || die "bad accept socket: "; |
399 | my $fileno = fileno $accepted_sock ; |
400 | #print "ACCEPT [$accepted_sock] ($fileno)\n" ; |
401 | |
402 | if ( my $ssl_args = $self->{'ssl_args'} ) { |
403 | |
404 | require IO::Socket::SSL ; |
405 | IO::Socket::SSL->VERSION(0.96); |
406 | |
407 | my $err = IO::Socket::SSL->start_SSL( |
408 | $accepted_sock, |
409 | SSL_server => 1, |
410 | @{$ssl_args} |
411 | ) ; |
412 | |
413 | $err || die |
414 | "bad ssl accept socket: " . IO::Socket::SSL::errstr() ; |
415 | } |
416 | |
417 | # the i/o for sockets is always non-blocking in stem. |
418 | |
419 | $accepted_sock->blocking( 0 ) ; |
420 | |
421 | # callback the object/method with the accepted socket as the argument |
422 | |
423 | my $method = $self->{'method'} ; |
424 | $self->{'object'}->$method( $accepted_sock, $self->{'id'} ); |
425 | return ; |
426 | } |
427 | |
428 | sub stop_listening { |
429 | |
430 | my( $self ) = @_ ; |
431 | |
432 | my $read_event = $self->{'read_event'} ; |
433 | return unless $read_event ; |
434 | $read_event->stop() ; |
435 | } |
436 | |
437 | sub start_listening { |
438 | |
439 | my( $self ) = @_ ; |
440 | |
441 | my $read_event = $self->{'read_event'} ; |
442 | return unless $read_event ; |
443 | $read_event->start() ; |
444 | } |
445 | |
446 | sub get_listen_sock { |
447 | |
448 | my( $host, $port, $listen ) = @_ ; |
449 | |
450 | return "get_listen_sock Missing port" unless $port ; |
451 | |
452 | # get the host name or IP and convert it to an inet address |
453 | # an empty host ('') will force INADDR_ANY |
454 | |
455 | my $inet_addr = length( $host ) ? inet_aton( $host ) : INADDR_ANY ; |
456 | |
457 | #print "HOST [$host]\n" ; |
458 | #print inet_ntoa( $inet_addr ), "\n" ; |
459 | |
460 | return "get_listen_sock Unknown host [$host]" unless $inet_addr ; |
461 | |
462 | # check if it is a get the service name or numeric port and convert it |
463 | # to a port number |
464 | |
465 | if ( $port =~ /\D/ and not $port = getservbyname( $port, 'tcp' ) ) { |
466 | |
467 | return "get_listen_sock: unknown port [$port]" ; |
468 | } |
469 | |
470 | # prepare the socket address |
471 | |
472 | my $sock_addr = pack_sockaddr_in( $port, $inet_addr ) ; |
473 | |
474 | my $listen_sock = IO::Socket::INET->new( |
475 | |
476 | Proto => 'tcp', |
477 | LocalAddr => $host, |
478 | LocalPort => $port, |
479 | Listen => $listen, |
480 | Reuse => 1, |
481 | ) ; |
482 | |
483 | return( "get_listen_sock: $host:$port $!" ) unless $listen_sock ; |
484 | return $listen_sock ; |
485 | } |
486 | |
487 | 1 ; |