view release on metacpan or  search on metacpan

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

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

## another SASL step.
## Response of a SASL command from the server.
## Protocol command: SASL <base64 encoded SASL outout>\r\n
##in> $first_step
##out> true when succesful, otherwise false
##eg> return $this->_StepAuthentication(1);
sub _StepAuthentication
{
	my $this = shift;
	my $first = shift;
	my $sasl = $this->{_sasl};
	my $ret = 0;
	my $str;

	if ($first) {
		$str = $sasl->client_start();
	} else {
		$str = $sasl->client_step(decode_base64($this->{_cmdparameter}));
	}

	$str = "" unless defined $str;
		
	if ($sasl->need_step || $sasl->code == 0) {
		if ($sasl->code == 0) {
			$this->_Sasl($str) if $str ne "";
			
			$this->{_authenticated} = 1;
			@{$this->{_expectedcmds}} = qw(ERR);
			$this->{sasl_mechanism} = $this->{_saslmech};
			$this->Log(LOG_AUTH,"SASL: Negotiation complete. User is authenticated.");
			$ret = 1;
		} else {
			$ret = $this->_Sasl($str);
		}
	} else {
		$this->Quit();
		$ret = $this->_SetError("SASL: Negotiation failed. User is not authenticated. SASL error: (",$sasl->code,") ",$sasl->error);
	}
	return $ret
}

## send an ARCv2 command request
## Protocol command: CMD <cmd> <cmdparameter>\r\n
##in> ... (cmd and parameter)
##out> true when succesful, otherwise false
##eg> $this->_Cmd ("whoami");
sub _Cmd
{
	my $this = shift;
	my $str = join " ",@_;
	$str =~ s/[\r\n]//g;
	return $this->_SetError("Empty command won't be sent.") unless length $str;
	@{$this->{_expectedcmds}} = qw(ERR CMDPASV DONE);
	return $this->_SendCommand("CMD",$str);
}

# The _R subs are processing a server response, call resp. subs and set the expectedcmds array approp.
## parses the AUTH <list of SASL mech>\r\n, sent by the server
sub _RAUTH
{
	my $this = shift;
	@{$this->{server_sasl_mechanisms}} = split(',',$this->{_cmdparameter});

	return $this->_Authenticate();
}

## parses the AUTHTYPE <SASL mech>\r\n, sent by the server.
## Which SASL mech the server will use.
sub _RAUTHTYPE
{
	my $this = shift;
	$this->{_saslmech} = $this->{_cmdparameter};
	
	return $this->_StartAuthentication();
}

## parses the SASL <base64 encoded SASL string>\r\n, sent by the server.
## Sasl response from the server
sub _RSASL
{
	my $this = shift;
	return $this->_SetError("SASL Negotiation failed.") unless ($this->_StepAuthentication(0));
	return 1;
}

## parses the ERR <msg>\r\n, sent by the server.
## Server command, which reports an server-side error
sub _RERR
{
	my $this = shift;

	$this->_SetError("Server ERROR:",$this->{_cmdparameter});
	return 1;
}

## parses the CMDERR <msg>\r\n, sent by the server.
## Command specific error, which reports an error during the command
sub _RCMDERR
{
	my $this = shift;
	$this->_SetError("Command ERROR:",$this->{_cmdparameter});
	return 1;
}

## parses CMDPASV <host:port>\r\n, sent by the server.
## Establish the encrypted command connection.
sub _RCMDPASV
{
	my $this = shift;
	$this->Log(LOG_SIDE,"Try to connect to:",$this->{_cmdparameter});
	
	@{$this->{_expectedcmds}} = qw(ERR DONE CMDERR);