view release on metacpan or  search on metacpan

lib/Arc/Connection/Client.pm  view on Meta::CPAN

use IO::Socket::INET; 
use IO::Select;
use Arc qw(LOG_AUTH LOG_USER LOG_ERR LOG_CMD LOG_SIDE LOG_DEBUG);
use Arc::Connection;
use MIME::Base64; 

@Arc::Connection::Client::ISA = qw(Arc::Connection);

sub members 
{
	my $this = shift;
	return { %{$this->SUPER::members},
		logfileprefix => "client",
		logdestination => "stderr",
		
		sasl_cb_user => $ENV{'USER'}, # SASL Callback for username (PLAIN and some other mechs only)
		sasl_cb_auth => $ENV{'USER'}, # SASL Callback for authname (PLAIN and some other mechs only)
		sasl_cb_pass => "",           # SASL Callback for password (PLAIN and some other mechs only)

		server => undef,              # Server to connect to
		port => undef,                # Port to connect to
		sasl_mechanism => undef,      # use this mechanism for authentication
		server_sasl_mechanisms => [], # filled by the sasl mechanisms
		protocol => 1,	              # Which protocol type the shall use.
	};
}

sub _Init
{
	my $this = shift;

	return 0 unless $this->SUPER::_Init(@_);

	# server
	return $this->_SetError("No ARCv2 server given.") unless defined $this->{server};

	# port
	unless (defined $this->{port}) {
		$this->Log(LOG_SIDE,"No port specified. Using $Arc::DefaultPort.");
		$this->{port} = $Arc::DefaultPort;
	}
	
	# sasl mech
	$this->Log(LOG_SIDE,"No sasl mechanism specified. Using the one supplied by the server.") 
		unless defined $this->{sasl_mechanism};
}

## connects to the server
##out> true when succesful, otherwise false
##eg> $this->_Connect();
sub _Connect
{
	my $this = shift;

	$this->{_connection} = new IO::Socket::INET(
				PeerAddr => $this->{server}, 
				PeerPort => $this->{port}, 
				Type => SOCK_STREAM,
	) || return $this->_SetError("Could not create Client socket: $! $@.");
	
# Fill the connected Socket into the select object
	$this->{_select} = new IO::Select($this->{_connection}) 
		|| return $this->_SetError("Select creation failed.");

	$this->{_connection}->autoflush(0);
	$this->{_connected} = 1;

	return 1;
}

## initialize the protocol.
## Sends the initial protocol message ARC/2.0
##out> true when succesful, otherwise false
##eg> $this->_InitARC2();
sub _InitARC2
{
	my $this = shift;
	@{$this->{_expectedcmds}} = qw(ERR AUTH);
	$this->{_authenticated} = 0;
	return $this->_SendCommand ("ARC/2.".$this->{protocol});
}

## initiate the authentication.
## Tells the server which authtype we want to use.
## Protocol command: AUTHENTICATE [<authtype>]\r\n
##out> true when succesful, otherwise false
##eg> $this->_Authenticate();
sub _Authenticate
{
	my $this = shift;
	@{$this->{_expectedcmds}} = qw(ERR AUTHTYPE);
	return $this->_SendCommand ("AUTHENTICATE",$this->{sasl_mechanism});
}

## initiate the authentication (sasl)
## Creates the sasl object (client_new).
## Client begins always and sends the first SASL challenge
## Protocol command: SASL <base64 encoded SASL output>\r\n
##out> true when succesful, otherwise false
##eg> $this->_StartAuthentication();
sub _StartAuthentication
{
	my $this = shift;

	$this->_PrepareAuthentication() || return;
	
	$this->{__sasl}->callback(
		user => $this->{sasl_cb_user}, 
		auth => $this->{sasl_cb_auth},
		pass => $this->{sasl_cb_pass},
	);

	my $sasl = $this->{_sasl} = $this->{__sasl}->client_new(
				$this->{service},
				$this->{server},
				$this->{_connection}->sockhost.";".$this->{_connection}->sockport,
				$this->{_connection}->peerhost.";".$this->{_connection}->peerport,
	);

	# sasl Context created
	if (!defined $sasl || $sasl->code != 0) {
		return $this->_SetError("creating SASL object failed: ",$sasl->error());