view release on metacpan or search on metacpan
lib/Arc/Connection.pm view on Meta::CPAN
1314151617181920212223242526272829303132{
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
132133134135136137138139140141142143144145146147148149150151152
}
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
167168169170171172173174175176177178179180181182183184185186187188189##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
214215216217218219220221222223224225226227228229230231232233234235236237238239240## 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
118119120121122123124125126127128129130131132133134135136137138B<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
57585960616263646566676869707172737475767778sub
_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
191192193194195196197198199200201202203204205206207208209210211B<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
187188189190191192193194195196197198199200201202203204205206207
$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
401402403404405406407408409410411412413414415416417418419420421422423424## 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
148149150151152153154155156157158159160161162163164165166167168B<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
399400401402403404405406407408409410411412413414415416417418419$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 ( )