view release on metacpan or  search on metacpan

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

package Arc::Connection::Server;

use strict;
use warnings;
use Carp;

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

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

sub members
{
	my $this = shift;
	return { %{$this->SUPER::members},
		_realm => "",             # Name of the SASL realm, if the user is from the default realm, this is empty
		logfileprefix => "server",

		sasl_cb_getsecret => "",  # Callback for SASL (if PLAIN (or equal) mechanisms are used). See Authen::SASL(::Cyrus).
		sasl_cb_checkpass => 0,   # Callback for SASL (if PLAIN (or equal) mechanisms are used). See Authen::SASL(::Cyrus).
		sasl_mechanisms => undef, # array of allowed SASL mechanisms

		commands => undef,        # hash of assignment between B<Command Name> and B<Command Class>. See L<Arc::Command>
	};
}

sub _Init
{
	my $this = shift;

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

	# sasl_mechanisms
	return $this->_SetError("No SASL mechanisms given.")
		unless defined $this->{sasl_mechanisms};

	# commands
	return $this->_SetError("No ARCv2 commands given. There is no reason the run ARCv2.")
		unless defined $this->{commands};
}

## Callback function to canonicalize the username (SASL)
## see Authen::SASL(::Cyrus) for parameter list and how to use.
sub _CBCanonUser
{
	my ($this,$type,$realm,$maxlen,$user) = @_;
	return $user;
}

## send the available SASL mechanisms.
## Protocol command: AUTH <comma-seperated list of SASL mechansims>\r\n
##out> true when succesful, otherwise false
##eg> $this->_Auth();
sub _Auth
{
	my $this = shift;

	@{$this->{_expectedcmds}} = qw(QUIT AUTHENTICATE);
	return $this->_SendCommand("AUTH",join (",",@{$this->{sasl_mechanisms}}));
}

## send an error msg to client (Server error).
## Protocol command: ERR <msg>\r\n
##out> true when succesful, otherwise false
##eg> $this->_Error("failure.");
sub _Error
{
	my $this = shift;
	return $this->_SendCommand("ERR",join("",@_));
}

## send a command error msg to client.
## Protocol command: CMDERR <msg>\r\n
##out> true when succesful, otherwise false
##eg> $this->_CmdError("failure.");
sub _CmdError
{
	my $this = shift;
	return $this->_SendCommand("CMDERR",join("",@_));
}

## command is ready.
## When the ARCv2 command is ready with its work, the server
## sends the DONE command on the control connection.
## Protocol command: DONE\r\n
##out> true when succesful, otherwise false
##eg> $this->_Done();
sub _Done
{
	my $this = shift;
	return $this->_SendCommand("DONE");