Merge commit 'origin/master' into HEAD

[urisagit/Stem.git] / lib / Stem / Socket.pm

#  File: Stem/Socket.pm

#  This file is part of Stem.
#  Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.

#  Stem is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.

#  Stem is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.

#  You should have received a copy of the GNU General Public License
#  along with Stem; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

#  For a license to use the Stem under conditions other than those
#  described here, to purchase support for this software, or to purchase a
#  commercial warranty contract, please contact Stem Systems at:

#       Stem Systems, Inc.		781-643-7504
#  	79 Everett St.			info@stemsystems.com
#  	Arlington, MA 02474
#  	USA

#######################################################

#print "LOADED\n" ;

package Stem::Socket ;

use strict ;

use IO::Socket ;
use Symbol ;
use Errno qw( EINPROGRESS ) ;

use Stem::Class ;

my $attr_spec = [

	{
		'name'		=> 'object',
		'required'	=> 1,
		'type'		=> 'object',
		'help'		=> <<HELP,
This is the owner object which has the methods that get called when Stem::Socket
has either connected, timed out or accepted a socket connection
HELP
	},
	{
		'name'		=> 'server',
		'type'		=> 'boolean',
		'help'		=> <<HELP,
If set, then this is a server socket.
HELP
	},
	{
		'name'		=> 'sync',
		'type'		=> 'boolean',
		'default'	=> 0,
		'help'		=> <<HELP,
Mark this as a synchronously connecting socket. Default is asyncronous
connections. In both cases the same method callbacks are used.
HELP
	},
	{
		'name'		=> 'port',
		'required'	=> 1,
		'help'		=> <<HELP,
This is the TCP port number for listening or connecting.
HELP
	},
	{
		'name'		=> 'host',
		'default'	=> 'localhost',
		'help'		=> <<HELP,
Host to connect to or listen on. If a listen socket host is explicitly
set to '', then the host will be INADDR_ANY which allows a server to
listen on all host interfaces.
HELP
	},
	{
		'name'		=> 'method',
		'default'	=> 'connected',
		'help'		=> <<HELP,
This method is called in the owner object when when a socket
connection or accept happens.
HELP
	},
	{
		'name'		=> 'timeout_method',
		'default'	=> 'connect_timeout',
		'help'		=> <<HELP,
This method is called in the owner object when when a socket
connection times out.
HELP
	},
	{
		'name'		=> 'timeout',
		'default'	=> 10,
		'help'		=> <<HELP,
How long to wait (in seconds) before a connection times out.
HELP
	},
	{
		'name'		=> 'max_retries',
		'default'	=> 0,
		'help'		=> <<HELP,
The maximum number of connection retries before an error is returned.
HELP
	},
	{
		'name'		=> 'listen',
		'default'	=> '5',
		'help'		=> <<HELP,
This sets how many socket connections can be queued by a server socket.
HELP
	},
	{
		'name'		=> 'ssl_args',
		'type'		=> 'list',
		'help'		=> <<HELP,
This makes the socket use the IO::Socket::SSL module for secure sockets. The 
arguments are passed to the new() method of that module.
HELP
	},
	{
		'name'		=> 'id',
		'help'		=> <<HELP,
The id is passed to the callback method as its only argument. Use it to
identify different instances of this object.
HELP

	},
] ;

sub new {

	my( $class ) = shift ;

	my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
	return $self unless ref $self ;

	if ( $self->{ 'server' } ) {

		$self->{'type'} = 'server' ;
		my $listen_err = $self->listen_to() ;

#print "ERR [$listen_err]\n" ;
		return $listen_err if $listen_err ;
	}
	else {

		$self->{'type'} = 'client' ;
		my $connect_err = $self->connect_to() ;
		return $connect_err if $connect_err ;
	}

	return( $self ) ;
}

use Carp 'cluck' ;

sub shut_down {

	my( $self ) = @_ ;

#cluck "SOCKET SHUT" ;

	if ( $self->{'type'} eq 'server' ) {

#print "SOCKET SHUT server" ;

		if ( my $read_event = delete $self->{'read_event'} ) {

			$read_event->cancel() ;
		}

		my $listen_sock = delete $self->{'listen_sock'} ;
		$listen_sock->close() ;

		return ;
	}

#print "SOCKET SHUT client" ;

	$self->_write_cancel() ;

	return ;
}

sub type {
	$_[0]->{'type'} ;
}

sub connect_to {

	my( $self ) = @_ ;

	my $connect_sock = Stem::Socket::get_connected_sock(
		$self->{'host'},
		$self->{'port'},
		$self->{'sync'},
	) ;

	return $connect_sock unless ref $connect_sock ;

	$self->{'connected_sock'} = $connect_sock ;

	if( $self->{'sync'} ) {

		$self->connect_writeable() ;
		return ;
	}

# create and save the write event watcher

	my $write_event = Stem::Event::Write->new(
			'object'	=>	$self,
			'fh'		=>	$connect_sock,
			'timeout'	=>	$self->{'timeout'},
			'method'	=>	'connect_writeable',
			'timeout_method' =>	'connect_timeout',
	) ;

	return $write_event unless ref $write_event ;
	$self->{'write_event'} = $write_event ;
	$write_event->start() ;

	return ;
}

# callback when a socket is connected (the socket is writeable)

sub connect_writeable {

	my( $self ) = @_ ;

# get the connected socket

	my $connected_sock = $self->{'connected_sock'} ;

	if ( my $ssl_args = $self->{'ssl_args'} ) {

		require IO::Socket::SSL ;
		IO::Socket::SSL->VERSION(0.96);

		my $err = IO::Socket::SSL->start_SSL(
			$connected_sock,
			@{$ssl_args}
		) ;

		$err || die
			"bad ssl connect socket: " . IO::Socket::SSL::errstr() ;
	}

# the i/o for sockets is always non-blocking in stem.

	$connected_sock->blocking( 0 ) ;

# callback the owner object with the connected socket as the argument

	my $method = $self->{'method'} ;
	$self->{'object'}->$method( $connected_sock, $self->{'id'} );

	$self->_write_cancel() ;

	return ;
}

sub connect_timeout {

	my( $self ) = @_ ;

	$self->_write_cancel() ;

	$self->{'connected_sock'}->close() ;
	delete $self->{'connected_sock'} ;

	if ( $self->{'max_retries'} && --$self->{'retry_count'} > 0 ) {

		my $method = $self->{'timeout_method'} ;
		$self->{'object'}->$method( $self->{'id'} );
		return ;
	}

	$self->connect_to() ;

	return ;
}

sub _write_cancel {

	my( $self ) = @_ ;

#	my $sock = delete $self->{'connected_sock'} ;
#	$sock->close() ;

	my $event = delete $self->{'write_event'} ;
	return unless $event ;
	$event->cancel() ;
}

sub get_connected_sock {

	my( $host, $port, $sync ) = @_ ;

	unless( $port ) {

		my $err = "get_connected_sock Missing port" ;
		return $err ;
	}

# get the host name or IP and convert it to an inet address

	my $inet_addr = inet_aton( $host ) ;

	unless( $inet_addr ) {

		my $err = "get_connected_sock Unknown host [$host]" ;
		return $err ;
	}

# check if it is a get the service name or numeric port and convert it
# to a port number

	if ( $port =~ /\D/ and not $port = getservbyname( $port, 'tcp' ) ) {

		my $err = "get_connected_sock: unknown port [$port]" ;
		return $err ;
	}

# prepare the socket address

	my $sock_addr = pack_sockaddr_in( $port, $inet_addr ) ;

	my $connect_sock = IO::Socket::INET->new( Domain => AF_INET) ;

#print "connect $connect_sock [", $connect_sock->fileno(), "]\n" ;

# set the sync (connect blocking) mode

	$connect_sock->blocking( $sync ) ;

	unless ( connect( $connect_sock, $sock_addr ) ) {

# handle linux false error of EINPROGRESS

		return <<ERR unless $! == EINPROGRESS ;
get_connected_sock: connect to '$host:$port' error $!
ERR
	}

	return $connect_sock ;
}

sub listen_to {

	my( $self ) = @_ ;

	my $listen_sock = get_listen_sock(
		$self->{'host'},
		$self->{'port'},
		$self->{'listen'},
	) ;

	return $listen_sock unless ref $listen_sock ;

	$self->{'listen_sock'} = $listen_sock ;

# create and save the read event watcher

	my $read_event = Stem::Event::Read->new(
				'object'	=> $self,
				'fh'		=> $listen_sock,
				'method'	=> 'listen_readable',
	) ;
					
	$self->{'read_event'} = $read_event ;

	return ;
}

# callback when a socket can be accepted (the listen socket is readable)

sub listen_readable {

	my( $self ) = @_ ;

# get the accepted socket

	my $accepted_sock = $self->{'listen_sock'}->accept() ;

# $accepted_sock || die "bad accept socket: ";
my $fileno = fileno $accepted_sock ;
#print "ACCEPT [$accepted_sock] ($fileno)\n" ;

	if ( my $ssl_args = $self->{'ssl_args'} ) {

		require IO::Socket::SSL ;
		IO::Socket::SSL->VERSION(0.96);

		my $err = IO::Socket::SSL->start_SSL(
			$accepted_sock,
			SSL_server	=> 1,
			@{$ssl_args}
		) ;

		$err || die
			"bad ssl accept socket: " . IO::Socket::SSL::errstr() ;
	}

# the i/o for sockets is always non-blocking in stem.

	$accepted_sock->blocking( 0 ) ;

# callback the object/method with the accepted socket as the argument

	my $method = $self->{'method'} ;
	$self->{'object'}->$method( $accepted_sock, $self->{'id'} );
	return ;
}

sub stop_listening {

	my( $self ) = @_ ;

	my $read_event = $self->{'read_event'} ;
	return unless $read_event ;
	$read_event->stop() ;
}

sub start_listening {

	my( $self ) = @_ ;

	my $read_event = $self->{'read_event'} ;
	return unless $read_event ;
	$read_event->start() ;
}

sub get_listen_sock {

	my( $host, $port, $listen ) = @_ ;

	return "get_listen_sock Missing port" unless $port ;

# get the host name or IP and convert it to an inet address
# an empty host ('') will force INADDR_ANY

	my $inet_addr = length( $host ) ? inet_aton( $host ) : INADDR_ANY ;

#print "HOST [$host]\n" ;
#print inet_ntoa( $inet_addr ), "\n" ;

	return "get_listen_sock Unknown host [$host]" unless $inet_addr ;

# check if it is a get the service name or numeric port and convert it
# to a port number

	if ( $port =~ /\D/ and not $port = getservbyname( $port, 'tcp' ) ) {

		return "get_listen_sock: unknown port [$port]" ;
	}

# prepare the socket address

	my $sock_addr = pack_sockaddr_in( $port, $inet_addr ) ;

	my $listen_sock = IO::Socket::INET->new( 

		Proto     => 'tcp',
		LocalAddr => $host,
		LocalPort => $port,
		Listen    => $listen,
		Reuse     => 1,
	) ;

	return( "get_listen_sock: $host:$port $!" ) unless $listen_sock ;
	return $listen_sock ;
}

1 ;