lib/Stem/Socket.pm

   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 ;