3 # This file is part of Stem.
4 # Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
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.
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.
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
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:
24 # Stem Systems, Inc. 781-643-7504
25 # 79 Everett St. info@stemsystems.com
29 #######################################################
33 package Stem::Socket ;
39 use Errno qw( EINPROGRESS ) ;
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
58 If set, then this is a server socket.
66 Mark this as a synchronously connecting socket. Default is asyncronous
67 connections. In both cases the same method callbacks are used.
74 This is the TCP port number for listening or connecting.
79 'default' => 'localhost',
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.
88 'default' => 'connected',
90 This method is called in the owner object when when a socket
91 connection or accept happens.
95 'name' => 'timeout_method',
96 'default' => 'connect_timeout',
98 This method is called in the owner object when when a socket
106 How long to wait (in seconds) before a connection times out.
110 'name' => 'max_retries',
113 The maximum number of connection retries before an error is returned.
120 This sets how many socket connections can be queued by a server socket.
124 'name' => 'ssl_args',
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.
134 The id is passed to the callback method as its only argument. Use it to
135 identify different instances of this object.
143 my( $class ) = shift ;
145 my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
146 return $self unless ref $self ;
148 if ( $self->{ 'server' } ) {
150 $self->{'type'} = 'server' ;
151 my $listen_err = $self->listen_to() ;
153 #print "ERR [$listen_err]\n" ;
154 return $listen_err if $listen_err ;
158 $self->{'type'} = 'client' ;
159 my $connect_err = $self->connect_to() ;
160 return $connect_err if $connect_err ;
172 #cluck "SOCKET SHUT" ;
174 if ( $self->{'type'} eq 'server' ) {
176 #print "SOCKET SHUT server" ;
178 if ( my $read_event = delete $self->{'read_event'} ) {
180 $read_event->cancel() ;
183 my $listen_sock = delete $self->{'listen_sock'} ;
184 $listen_sock->close() ;
189 #print "SOCKET SHUT client" ;
191 $self->_write_cancel() ;
204 my $connect_sock = Stem::Socket::get_connected_sock(
210 return $connect_sock unless ref $connect_sock ;
212 $self->{'connected_sock'} = $connect_sock ;
214 if( $self->{'sync'} ) {
216 $self->connect_writeable() ;
220 # create and save the write event watcher
222 my $write_event = Stem::Event::Write->new(
224 'fh' => $connect_sock,
225 'timeout' => $self->{'timeout'},
226 'method' => 'connect_writeable',
227 'timeout_method' => 'connect_timeout',
230 return $write_event unless ref $write_event ;
231 $self->{'write_event'} = $write_event ;
232 $write_event->start() ;
237 # callback when a socket is connected (the socket is writeable)
239 sub connect_writeable {
243 # get the connected socket
245 my $connected_sock = $self->{'connected_sock'} ;
247 if ( my $ssl_args = $self->{'ssl_args'} ) {
249 require IO::Socket::SSL ;
250 IO::Socket::SSL->VERSION(0.96);
252 my $err = IO::Socket::SSL->start_SSL(
258 "bad ssl connect socket: " . IO::Socket::SSL::errstr() ;
261 # the i/o for sockets is always non-blocking in stem.
263 $connected_sock->blocking( 0 ) ;
265 # callback the owner object with the connected socket as the argument
267 my $method = $self->{'method'} ;
268 $self->{'object'}->$method( $connected_sock, $self->{'id'} );
270 $self->_write_cancel() ;
275 sub connect_timeout {
279 $self->_write_cancel() ;
281 $self->{'connected_sock'}->close() ;
282 delete $self->{'connected_sock'} ;
284 if ( $self->{'max_retries'} && --$self->{'retry_count'} > 0 ) {
286 my $method = $self->{'timeout_method'} ;
287 $self->{'object'}->$method( $self->{'id'} );
291 $self->connect_to() ;
300 # my $sock = delete $self->{'connected_sock'} ;
303 my $event = delete $self->{'write_event'} ;
304 return unless $event ;
308 sub get_connected_sock {
310 my( $host, $port, $sync ) = @_ ;
314 my $err = "get_connected_sock Missing port" ;
318 # get the host name or IP and convert it to an inet address
320 my $inet_addr = inet_aton( $host ) ;
322 unless( $inet_addr ) {
324 my $err = "get_connected_sock Unknown host [$host]" ;
328 # check if it is a get the service name or numeric port and convert it
331 if ( $port =~ /\D/ and not $port = getservbyname( $port, 'tcp' ) ) {
333 my $err = "get_connected_sock: unknown port [$port]" ;
337 # prepare the socket address
339 my $sock_addr = pack_sockaddr_in( $port, $inet_addr ) ;
341 my $connect_sock = IO::Socket::INET->new( Domain => AF_INET) ;
343 #print "connect $connect_sock [", $connect_sock->fileno(), "]\n" ;
345 # set the sync (connect blocking) mode
347 $connect_sock->blocking( $sync ) ;
349 unless ( connect( $connect_sock, $sock_addr ) ) {
351 # handle linux false error of EINPROGRESS
353 return <<ERR unless $! == EINPROGRESS ;
354 get_connected_sock: connect to '$host:$port' error $!
358 return $connect_sock ;
365 my $listen_sock = get_listen_sock(
371 return $listen_sock unless ref $listen_sock ;
373 $self->{'listen_sock'} = $listen_sock ;
375 # create and save the read event watcher
377 my $read_event = Stem::Event::Read->new(
379 'fh' => $listen_sock,
380 'method' => 'listen_readable',
383 $self->{'read_event'} = $read_event ;
388 # callback when a socket can be accepted (the listen socket is readable)
390 sub listen_readable {
394 # get the accepted socket
396 my $accepted_sock = $self->{'listen_sock'}->accept() ;
398 # $accepted_sock || die "bad accept socket: ";
399 my $fileno = fileno $accepted_sock ;
400 #print "ACCEPT [$accepted_sock] ($fileno)\n" ;
402 if ( my $ssl_args = $self->{'ssl_args'} ) {
404 require IO::Socket::SSL ;
405 IO::Socket::SSL->VERSION(0.96);
407 my $err = IO::Socket::SSL->start_SSL(
414 "bad ssl accept socket: " . IO::Socket::SSL::errstr() ;
417 # the i/o for sockets is always non-blocking in stem.
419 $accepted_sock->blocking( 0 ) ;
421 # callback the object/method with the accepted socket as the argument
423 my $method = $self->{'method'} ;
424 $self->{'object'}->$method( $accepted_sock, $self->{'id'} );
432 my $read_event = $self->{'read_event'} ;
433 return unless $read_event ;
434 $read_event->stop() ;
437 sub start_listening {
441 my $read_event = $self->{'read_event'} ;
442 return unless $read_event ;
443 $read_event->start() ;
446 sub get_listen_sock {
448 my( $host, $port, $listen ) = @_ ;
450 return "get_listen_sock Missing port" unless $port ;
452 # get the host name or IP and convert it to an inet address
453 # an empty host ('') will force INADDR_ANY
455 my $inet_addr = length( $host ) ? inet_aton( $host ) : INADDR_ANY ;
457 #print "HOST [$host]\n" ;
458 #print inet_ntoa( $inet_addr ), "\n" ;
460 return "get_listen_sock Unknown host [$host]" unless $inet_addr ;
462 # check if it is a get the service name or numeric port and convert it
465 if ( $port =~ /\D/ and not $port = getservbyname( $port, 'tcp' ) ) {
467 return "get_listen_sock: unknown port [$port]" ;
470 # prepare the socket address
472 my $sock_addr = pack_sockaddr_in( $port, $inet_addr ) ;
474 my $listen_sock = IO::Socket::INET->new(
483 return( "get_listen_sock: $host:$port $!" ) unless $listen_sock ;
484 return $listen_sock ;