ARCv2

 view release on metacpan or  search on metacpan

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

{
	my $this = shift;
	return { %{$this->SUPER::members},
		# private:
			__sasl => undef,   # Authen::SASL Handle
			__linequeue => [], # internal line buffer (idea From Net::Cmd)
			__partial => "",   # a partial line (idea From Net::Cmd)
		# protected:
			_connection => undef,    # IO::Socket for the ARCv2 Connection
			_cmdclientsock => undef, # IO::Socket for the command connection (encrypted)
			_select => undef,        # IO::Select for the ARCv2 Connection
			
			_authenticated => 0,     # Are we authenticated
			#_sasl => undef,         # Authen::SASL::Cyrus Handle
			#_saslmech => "",        # SASL mechnanism used at authentication
			
			_cmdparameter => undef,   # parameter after the command
			_expectedcmds => undef,   # array, which ARCv2 protocol commands are allowed to come next
			_connected => 0,          # are we connected
			_username => "anonymous", # username extracted from SASL

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

				} elsif ($r->fileno == $netsock->fileno) {
					# on client-side the netsock is closed only
					# if the command on server side has ended.
					# so game over
					$stop = 1 if $client;
					close($locout) unless $stop; # Local pipe is not needed anymore
				}
				
				last if $stop;
			} else {
				# select the appropriate write-"select"
				my $tsel = $r->fileno == $locin->fileno ? $nwsel : $lwsel;
				# encryption, decode or encode
				$buf = $r->fileno == $locin->fileno ? 
						$this->{_sasl}->encode($buf) : 
						$this->{_sasl}->decode($buf); 

				# sometimes SASL replies NULL if something is missing	
				# this is normal behaviour, the next buf will complete it 
				next unless $buf; 
			

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

##in> ... (line)
##out> true if writing has succeeded, otherwise false.
##eg> $this->_SendLine($cmd,"test"); 
sub _SendLine
{
	my $this = shift;
	return unless @_;
	my $line = join("",@_);
	$line =~ s/\r//g;
	$line =~ s/\n/ /g;
	return $this->_SetError("SendLine only available when connection and select is set.") unless $this->{_connected};

	if ($this->{_select}->can_write($this->{timeout})) { 
		$this->_Debug(substr ($line,0,30),"..");
		$line .= "\015\012";
		
# encrypt if necessary
		$line = $this->{_sasl}->encode($line)
			if $this->{_authenticated} == 1 and $this->{protocol} == 1;

		return $this->{_connection}->syswrite($line,4096) > 0;
	} else {
		$this->{_connected} = 0;

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

## timeouts and "connection closed by foreign host"'s.
##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;
				

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

B<Description>: IO::Socket for the ARCv2 Connection

B<Default value>: undef

=item _expectedcmds 

B<Description>: array, which ARCv2 protocol commands are allowed to come next

B<Default value>: undef

=item _select 

B<Description>: IO::Select for the ARCv2 Connection

B<Default value>: undef

=item _username 

B<Description>: username extracted from SASL

B<Default value>: "anonymous"

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

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

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

B<Description>: IO::Socket for the ARCv2 Connection

B<Default value>: undef

=item _expectedcmds I<inherited from Arc::Connection>

B<Description>: array, which ARCv2 protocol commands are allowed to come next

B<Default value>: undef

=item _select I<inherited from Arc::Connection>

B<Description>: IO::Select for the ARCv2 Connection

B<Default value>: undef

=item _username I<inherited from Arc::Connection>

B<Description>: username extracted from SASL

B<Default value>: "anonymous"

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

			$ret = $this->_Sasl($str);
		}
	} else {
		$ret = $this->_Error("SASL: Negotiation failed. User is not authenticated. (",$sasl->code,") ",
			$sasl->error);
	}
	return $ret;
}
## parses the AUTHENTICATE[ <SASL mech>]\r\n, sent by the client.
## Checks if the demanded SASL mechanism is allowed and returns the
## selected mechanism.
sub _RAUTHENTICATE
{
	my $this = shift;

	if ( $this->{_cmdparameter} ne "") {
		if (grep ({ $_ eq $this->{_cmdparameter}} @{$this->{sasl_mechanisms}} )) {
			$this->{_saslmech} = $this->{_cmdparameter};
		} else {
			return $this->_Error("SASL mechanism not allowed by server.");
		}

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

## Handles a connection (main loop).
##in> $clientsock (IO::Socket)
##out> true on success, otherwise false
##eg> $arc->HandleClient(sock);
sub HandleClient
{
	my $this = shift;
	return $this->_SetError("Client socket needed.") unless (@_ == 1);
	my $client = shift;

# Fill the connected Socket into the select object
	$this->{_connection} = $client;
	$this->{_connected} = 1;
	$this->{_select} = new IO::Select( $client );

	my $line = $this->_RecvLine();
	unless ($this->{_error}) {
		if ($line =~ m/^ARC\/2.(0|1)\r?\n$/) { # Protocoltype 2

			$this->{protocol} = $1;
			$this->Log(LOG_USER,"Arc v2.$1 Session recognized.");
			$this->_Auth();

			my $cmd;

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

B<Description>: IO::Socket for the ARCv2 Connection

B<Default value>: undef

=item _expectedcmds I<inherited from Arc::Connection>

B<Description>: array, which ARCv2 protocol commands are allowed to come next

B<Default value>: undef

=item _select I<inherited from Arc::Connection>

B<Description>: IO::Select for the ARCv2 Connection

B<Default value>: undef

=item _username I<inherited from Arc::Connection>

B<Description>: username extracted from SASL

B<Default value>: "anonymous"

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

$this->_Error("failure.");


=item _Init (  ) I<reimplemented from Arc::Connection>

=item _RAUTHENTICATE (  ) 

B<Description>: parses the AUTHENTICATE[ <SASL mech>]\r\n, sent by the client.
Checks if the demanded SASL mechanism is allowed and returns the
selected mechanism.


=item _RCMD (  ) 

B<Description>: parses the CMD <cmd>\r\n, sent by the client.
check if the command exists, prepares the command connection, executes the command and
does cleanups after execution.


=item _RQUIT (  )