view release on metacpan or  search on metacpan

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

##out> true (and the line) if everything worked fine, otherwise false (undef)
##eg> if (my $line = $this->_RecvLine()) { ... }
sub _RecvLine
{
	my $this = shift;

	return shift @{$this->{__linequeue}} if scalar @{$this->{__linequeue}};

	# no connection is set not connected
	return $this->_SetError("RecvCommand only Available when connection and select is set.") unless $this->{_connected};

	my $partial = defined($this->{__partial}) ? $this->{__partial} : "";

	my $buf = "";
	until (scalar @{$this->{__linequeue}}) {
		if ($this->{_select}->can_read($this->{timeout})) { # true if select thinks there is data 
			my $inbuf;
			unless ($this->{_connection}->sysread($inbuf,4096)) {
				$this->{_connected} = 0;
				$this->{_connection}->close();
				return $this->_SetError("Connection closed by foreign host.");
			}
# decrypt if possible and necessary
			$buf = $this->{_sasl}->decode($inbuf) 
				if $this->{_authenticated} == 1 and $this->{protocol} == 1;
				
# if authentication went wrong on the server side, but client thought it was ok
			$buf = $inbuf unless $buf;
			
			substr($buf,0,0) = $partial;
			my @buf1 = split (/\015?\012/,$buf,-1);
			$partial = pop @buf1;
			
			push(@{$this->{__linequeue}}, map { "$_\n" } @buf1);
		} else {
			$this->{_connected} = 0;
			$this->{_connection}->close();
			# if timed out, 
			return $this->_SetError("Connection timed out.");
		}
	}
	$this->{__partial} = $partial;
	return shift @{$this->{__linequeue}};
}

## receives an ARCv2 Command. (protocol)
## This function gets a line from C<_RecvLine> and extracts the ARCv2 command and
## the optional command parameter C<_cmdparameter>.
##out> ARCv2 command and true if everything works fine, otherwise false
##eg> while (my $cmd = $this->_RecvCommand()) { ... }
sub _RecvCommand
{
	my $this = shift;

	my $command = undef;
	if (my $line = $this->_RecvLine()) { # Fetch and parse a cmd from queue
		$line =~ s/[\r\n]//g;
		($command,$this->{_cmdparameter}) = $line =~ m/^([A-Z]+)\ ?(.*)?$/;
	}
		
	return $command; # There was an error if undef is return 
}

## process an ARCv2 command. (protocol)
## Process a command by evaling $this->_R$cmd. Also checks if 
## this command was expected now (looks into the $this->{_expectedcmds} array). 
## Used by client and server.
##in> $cmd
##out> true, if ARCv2 command has been in place, otherwise false
##eg> while (my $cmd = $this->_RecvCommand() && $this->_ProcessLine($cmd)) {}
sub _ProcessLine
{
	my $this = shift;
	my $cmd = shift;
	my $ret = 1;

	$this->_Debug("Received Command: $cmd (",@{$this->{_expectedcmds}},")");
	if (grep { $_ eq $cmd } @{$this->{_expectedcmds}} ) {
		$cmd = "_R".$cmd;
		$ret = $this->_SetError("Evaluation of command $cmd failed ($@).") 
			unless eval { $this->$cmd; }
	} else {
		$ret = $this->_SetError("Unexpected command: $cmd");
	}
	return $ret;
}

## send the ARCv2 SASL command. (protocol)
## This function encodes the output from sasl_*_start and sasl_*_step with Base-64 and sends
## it to the other side
##in> $saslstr
##out> true if successful, otherwise false
##eg> $this->_Sasl($sasl->client_start());
sub _Sasl
{
	my ($this,$str) = @_;
	return $this->_SendCommand("SASL",encode_base64($str,""));
}

## initialize sasl.
## This function initializes the C<__sasl> member with an object
## of C<Authen::SASL>.
##out> true if successful, otherwise false
##eg> $this->_PrepareAuthentication() || return;
sub _PrepareAuthentication
{
	my $this = shift;
	
	# Authen::SASL Instance creation
	$this->{__sasl} = Authen::SASL->new(
		mechanism => "".$this->{_saslmech},
	);

	if (!defined $this->{__sasl}) {
		return $this->_SetError("SASL error. No SASL object created.");
	}
	return 1;
}

## are we connected?
##out> true, if the ARCv2 control connection is connected, otherwise false
##eg> last unless $arc->IsConnected;
sub IsConnected
{
	my $this = shift;
	return $this->{_connected};
}


sub clean
{
	my $this = shift;
	delete $this->{__sasl};
	$this->{__linequeue} = [];
	$this->{__partial} = ""; 
	
	$this->{_authenticated} = 0;
	$this->{_sasl} = undef;
	$this->{_saslmech} = "";

	$this->{_cmdparameter} = undef;
	$this->{_expectedcmds} = undef;
	$this->{_connected} = 0;
	$this->{_username} = "anonymous";
	$this->{_error} = undef;		

# public:
	$this->{protocol} = undef;
}

1;