ARCv2
view release on metacpan or search on metacpan
1.05- Tue Mar 22 2005
- fixed authentication/decryption problem, which lead to
staling connections when the client thought it is authenticated,
but the server doesn't know that
- correct the exit-code handling in the arcx-client-script
- another patch by Tony Fraser (ACLs, CheckCmd for the Server-Connection)
- command-server-mapping-file for arcx-client-script
1.04 Tue Jan 04 2005
- Fixed timeout again
- command error handling improved, passed to the client separatly now
1.03 Tue Dec 02 2004
- Documentation has to be created
- line feed when command sprays an error (thanks to Wolfgang Friebel)
- pid file
- removed errornous white space
1.02 Tue Nov 02 2004
- corrected a typo (forgot a $) (thanks to Tony Fraser)
- added a member-variable to allow changable server connection type
this makes extending Arc::Connection::Server more easier to use it then
with Arc::Server (suggested by Tony Fraser, thanks)
- timeout behaviour for command connection fixed (thanks to Wolfgang Friebel)
- workaround bug regarding asynchonous sasl-encryption within one connection
1.01 Wed Jul 28 2004
$Contact = "Patrick Boettcher <patrick.boettcher\@desy.de>, Wolfgang Friebel <wolfgang.friebel\@desy.de>";
my @syslog_arr = ('emerg','alert','crit','err','warning','notice','info','debug');
# package member vars
sub members
{
return {
# private:
# protected:
_error => undef, # contains the error message
_syslog => 1, # log to syslog or to STDERR
# public:
loglevel => 7, # loglevel is combination of bits (1=AUTH,2=USER,4=ERR,8=CMDDEBUG,16=VERBSIDE,32=DEBUG) see _Log method
logfileprefix => "", # Prepended to every log entry
logdestination => 'syslog', # Where should all the log output go to ('stderr','syslog')
};
}
## Constructor.
## Initializes the object and returns it blessed.
##eg> $this->_Debug("hello","world"); # message will be "hello world"
sub _Debug
{
my $this = shift;
$this->Log(LOG_DEBUG,@_);
}
## Log function.
## Logs messages to 'logdestination' if 'loglevel' is is set appropriatly.
## loglevel behaviour has changed in the 1.0 release of ARCv2, the "Arc"-class can export
## LOG_AUTH (authentication information), LOG_USER (connection information), LOG_ERR (errors),
## LOG_CMD (ARCv2 addition internal command information), LOG_SIDE (verbose client/server-specific
## information), LOG_DEBUG (verbose debug information). It possible to combine the
## levels with or (resp. +) to allow a message to appear when not all loglevels are
## requested by the user.
## Commonly used for logging errors from application level.
##in> $facility, ... (message)
##out> always false
##eg> return $arc->Log(LOG_ERR,"Message");
sub Log
{
my $this = shift;
my $pr = shift;
my $ll = $this->{loglevel};
my $lev = 1;
my @syslog_arr = ('err','info','debug');
if ($this->{_syslog}) {
syslog $syslog_arr[$lev], $this->{logfileprefix}." ".join(" ",@_);
} else {
print STDERR "[",$syslog_arr[$lev],"]: (",$this->{logfileprefix},") ",join(" ",@_),"\n";
}
}
return;
}
## SetError function.
## This function prepends the error message (@_) to an existing error message (if any) and
## logs the message with LOG_ERR facility.
## Use this function for setting an error from class level. Users should use IsError
## to get the message if a function failed.
##in> ... (message)
##out> always false
##eg> return $this->_SetError("User is not allowed to do this."); # breaks when an error occured
sub _SetError
{
my $this = shift;
$this->Log(LOG_ERR,@_);
my $errstr = "";
if ($this->{_error}) {
$errstr = ' maybe caused by: '.$this->{_error};
}
unless (@_) {
$errstr .= 'Error, but no message.';
} else {
$errstr = join(" ",@_).$errstr ;
}
$errstr =~ s/\r//g;
$errstr =~ s/\n/ /g;
$this->{_error} = $errstr;
return;
}
## User function to get the error msg.
##out> the error message if any otherwise undef
##eg> unless (my $err = $arc->IsError()) { .. } else { print STDERR $err; }
sub IsError
{
my $this = shift;
my $ret = $this->{_error};
$this->{_error} = undef;
return $ret;
}
## Destructor
sub DESTROY {
my $this = shift;
closelog() if $this->{_syslog};
}
lib/Arc.pod view on Meta::CPAN
=back
=over 2
=back
=head3 PROTECTED MEMBERS
=over 2
=item _error
B<Description>: contains the error message
B<Default value>: undef
=item _syslog
B<Description>: log to syslog or to STDERR
B<Default value>: 1
=back
lib/Arc.pod view on Meta::CPAN
=over 2
=item DESTROY ( )
B<Description>: Destructor
=item IsError ( )
B<Description>: User function to get the error msg.
B<Returns:> the error message if any otherwise undef
B<Example:>
unless (my $err = $arc->IsError()) { .. } else { print STDERR $err; }
=item Log ( $facility, ... (message) )
B<Description>: Log function.
Logs messages to 'logdestination' if 'loglevel' is is set appropriatly.
loglevel behaviour has changed in the 1.0 release of ARCv2, the "Arc"-class can export
LOG_AUTH (authentication information), LOG_USER (connection information), LOG_ERR (errors),
LOG_CMD (ARCv2 addition internal command information), LOG_SIDE (verbose client/server-specific
information), LOG_DEBUG (verbose debug information). It possible to combine the
levels with or (resp. +) to allow a message to appear when not all loglevels are
requested by the user.
Commonly used for logging errors from application level.
B<Returns:> always false
B<Example:>
return $arc->Log(LOG_ERR,"Message");
lib/Arc.pod view on Meta::CPAN
B<Example:>
see source code of any non-abstract sub class of Arc
=item _SetError ( ... (message) )
B<Description>: SetError function.
This function prepends the error message (@_) to an existing error message (if any) and
logs the message with LOG_ERR facility.
Use this function for setting an error from class level. Users should use IsError
to get the message if a function failed.
B<Returns:> always false
B<Example:>
return $this->_SetError("User is not allowed to do this."); # breaks when an error occured
=back
=over 2
=back
=head3 PRIVATE METHODS
lib/Arc/Command.pod view on Meta::CPAN
{
while ($_ = <STDIN>) { # ends on EOF
s/a/b/g; print;
}
}
If you want to implement a new Command for ARCv2 you have to derive from
Arc::Command and override the sub C<Execute>. See existing Arc::Command::*
classes for examples. To get your Command recognised you have to assign a
B<Command Name> to your command class. ARCv2 ignores the return code of
B<Execute>. If your command runs into an error use the _SetError function
and return immediately. This is what ARCv2 will evaluate and send to the
client.
B<Example>:
sub Execute
{
my $this = shift;
my $pw = <>;
if ($pw ne "klaus") {
return $this->_SetError("Wrong password.");
lib/Arc/Command.pod view on Meta::CPAN
=item _username
B<Description>: user, who has authenticated against ARCv2 Server by using SASL
B<Default value>: ""
=back
=over 2
=item _error I<inherited from Arc>
B<Description>: contains the error message
B<Default value>: undef
=item _syslog I<inherited from Arc>
B<Description>: log to syslog or to STDERR
B<Default value>: 1
=back
lib/Arc/Command.pod view on Meta::CPAN
=over 2
=item DESTROY ( ) I<inherited from Arc>
B<Description>: Destructor
=item IsError ( ) I<inherited from Arc>
B<Description>: User function to get the error msg.
B<Returns:> the error message if any otherwise undef
B<Example:>
unless (my $err = $arc->IsError()) { .. } else { print STDERR $err; }
=item Log ( $facility, ... (message) ) I<inherited from Arc>
B<Description>: Log function.
Logs messages to 'logdestination' if 'loglevel' is is set appropriatly.
loglevel behaviour has changed in the 1.0 release of ARCv2, the "Arc"-class can export
LOG_AUTH (authentication information), LOG_USER (connection information), LOG_ERR (errors),
LOG_CMD (ARCv2 addition internal command information), LOG_SIDE (verbose client/server-specific
information), LOG_DEBUG (verbose debug information). It possible to combine the
levels with or (resp. +) to allow a message to appear when not all loglevels are
requested by the user.
Commonly used for logging errors from application level.
B<Returns:> always false
B<Example:>
return $arc->Log(LOG_ERR,"Message");
lib/Arc/Command.pod view on Meta::CPAN
B<Example:>
see source code of any non-abstract sub class of Arc
=item _SetError ( ... (message) ) I<inherited from Arc>
B<Description>: SetError function.
This function prepends the error message (@_) to an existing error message (if any) and
logs the message with LOG_ERR facility.
Use this function for setting an error from class level. Users should use IsError
to get the message if a function failed.
B<Returns:> always false
B<Example:>
return $this->_SetError("User is not allowed to do this."); # breaks when an error occured
=back
=over 2
=back
=head3 PRIVATE METHODS
lib/Arc/Connection.pm view on Meta::CPAN
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
lib/Arc/Connection.pm view on Meta::CPAN
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;
lib/Arc/Connection.pm view on Meta::CPAN
$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;
lib/Arc/Connection.pod view on Meta::CPAN
=item _username
B<Description>: username extracted from SASL
B<Default value>: "anonymous"
=back
=over 2
=item _error I<inherited from Arc>
B<Description>: contains the error message
B<Default value>: undef
=item _syslog I<inherited from Arc>
B<Description>: log to syslog or to STDERR
B<Default value>: 1
=back
lib/Arc/Connection.pod view on Meta::CPAN
=over 2
=item DESTROY ( ) I<inherited from Arc>
B<Description>: Destructor
=item IsError ( ) I<inherited from Arc>
B<Description>: User function to get the error msg.
B<Returns:> the error message if any otherwise undef
B<Example:>
unless (my $err = $arc->IsError()) { .. } else { print STDERR $err; }
=item Log ( $facility, ... (message) ) I<inherited from Arc>
B<Description>: Log function.
Logs messages to 'logdestination' if 'loglevel' is is set appropriatly.
loglevel behaviour has changed in the 1.0 release of ARCv2, the "Arc"-class can export
LOG_AUTH (authentication information), LOG_USER (connection information), LOG_ERR (errors),
LOG_CMD (ARCv2 addition internal command information), LOG_SIDE (verbose client/server-specific
information), LOG_DEBUG (verbose debug information). It possible to combine the
levels with or (resp. +) to allow a message to appear when not all loglevels are
requested by the user.
Commonly used for logging errors from application level.
B<Returns:> always false
B<Example:>
return $arc->Log(LOG_ERR,"Message");
lib/Arc/Connection.pod view on Meta::CPAN
B<Example:>
$this->_Debug("hello","world"); # message will be "hello world"
=item _SetError ( ... (message) ) I<inherited from Arc>
B<Description>: SetError function.
This function prepends the error message (@_) to an existing error message (if any) and
logs the message with LOG_ERR facility.
Use this function for setting an error from class level. Users should use IsError
to get the message if a function failed.
B<Returns:> always false
B<Example:>
return $this->_SetError("User is not allowed to do this."); # breaks when an error occured
=back
=over 2
=back
=head3 PRIVATE METHODS
lib/Arc/Connection/Client.pm view on Meta::CPAN
my $sasl = $this->{_sasl} = $this->{__sasl}->client_new(
$this->{service},
$this->{server},
$this->{_connection}->sockhost.";".$this->{_connection}->sockport,
$this->{_connection}->peerhost.";".$this->{_connection}->peerport,
);
# 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
lib/Arc/Connection/Client.pm view on Meta::CPAN
$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
lib/Arc/Connection/Client.pm view on Meta::CPAN
## 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
lib/Arc/Connection/Client.pm view on Meta::CPAN
## to be able to run ARCv2 commands afterwards.
##out> true if authentication was successful, otherwise false.
##eg> if ($arc->StartSession()) { .. }
sub StartSession
{
my $this = shift;
return $this->_SetError("There is already a command running.") if $this->IsConnected();
return $this->_SetError("Connection to host ",$this->{server},":",$this->{port}," failed") unless $this->_Connect();
$this->_InitARC2();
while (!$this->{_error} && ($this->{_authenticated} == 0) && (my $cmd = $this->_RecvCommand())) {
last unless $this->_ProcessLine($cmd);
}
return !$this->{_error} && $this->{_authenticated};
}
## ends the connection.
## Tells the server that we want to end the conversation. (Userlevel)
## Protocol command: QUIT\r\n
##out> always true
##eg> $arc->Quit();
sub Quit
{
my $this = shift;
lib/Arc/Connection/Client.pm view on Meta::CPAN
##out> true if successful, false if not. (IsError is set appropriatly)
##eg> if ($arc->CommandStart()) { ... }
sub CommandStart
{
my $this = shift;
return $this->_SetError("You are not authenticated.") unless $this->{_authenticated};
return $this->_SetError("Already running a command.") if defined $this->{_cmdclientsock};
return unless @_;
return unless $this->_Cmd(@_);
while (!$this->{_error} && (not defined $this->{_cmdclientsock}) && (my $cmd = $this->_RecvCommand()) ) {
$this->_ProcessLine($cmd);
last if $cmd eq "DONE";
}
return 1 if defined $this->{_cmdclientsock};
return;
}
## write something to the command.
## Write something to the standard input of the command started by C<CommandStart>.
##in> ... (data)
lib/Arc/Connection/Client.pm view on Meta::CPAN
}
$this->{_cmdclientsock}->close();
$this->{_cmdclientsock} = undef;
while (my $cmd = $this->_RecvCommand()) {
last unless $this->_ProcessLine($cmd);
last if $cmd eq "DONE";
}
return if $this->{_error};
return 1;
}
return 1;
lib/Arc/Connection/Client.pod view on Meta::CPAN
=item _username I<inherited from Arc::Connection>
B<Description>: username extracted from SASL
B<Default value>: "anonymous"
=back
=over 2
=item _error I<inherited from Arc>
B<Description>: contains the error message
B<Default value>: undef
=item _syslog I<inherited from Arc>
B<Description>: log to syslog or to STDERR
B<Default value>: 1
=back
lib/Arc/Connection/Client.pod view on Meta::CPAN
=over 2
=item DESTROY ( ) I<inherited from Arc>
B<Description>: Destructor
=item IsError ( ) I<inherited from Arc>
B<Description>: User function to get the error msg.
B<Returns:> the error message if any otherwise undef
B<Example:>
unless (my $err = $arc->IsError()) { .. } else { print STDERR $err; }
=item Log ( $facility, ... (message) ) I<inherited from Arc>
B<Description>: Log function.
Logs messages to 'logdestination' if 'loglevel' is is set appropriatly.
loglevel behaviour has changed in the 1.0 release of ARCv2, the "Arc"-class can export
LOG_AUTH (authentication information), LOG_USER (connection information), LOG_ERR (errors),
LOG_CMD (ARCv2 addition internal command information), LOG_SIDE (verbose client/server-specific
information), LOG_DEBUG (verbose debug information). It possible to combine the
levels with or (resp. +) to allow a message to appear when not all loglevels are
requested by the user.
Commonly used for logging errors from application level.
B<Returns:> always false
B<Example:>
return $arc->Log(LOG_ERR,"Message");
lib/Arc/Connection/Client.pod view on Meta::CPAN
=item _RAUTHTYPE ( )
B<Description>: parses the AUTHTYPE <SASL mech>\r\n, sent by the server.
Which SASL mech the server will use.
=item _RCMDERR ( )
B<Description>: parses the CMDERR <msg>\r\n, sent by the server.
Command specific error, which reports an error during the command
=item _RCMDPASV ( )
B<Description>: parses CMDPASV <host:port>\r\n, sent by the server.
Establish the encrypted command connection.
=item _RDONE ( )
B<Description>: parses DONE\r\n, sent by the server.
This is received when a command is done.
=item _RERR ( )
B<Description>: parses the ERR <msg>\r\n, sent by the server.
Server command, which reports an server-side error
=item _RSASL ( )
B<Description>: parses the SASL <base64 encoded SASL string>\r\n, sent by the server.
Sasl response from the server
=item _StartAuthentication ( )
lib/Arc/Connection/Client.pod view on Meta::CPAN
B<Example:>
$this->_Debug("hello","world"); # message will be "hello world"
=item _SetError ( ... (message) ) I<inherited from Arc>
B<Description>: SetError function.
This function prepends the error message (@_) to an existing error message (if any) and
logs the message with LOG_ERR facility.
Use this function for setting an error from class level. Users should use IsError
to get the message if a function failed.
B<Returns:> always false
B<Example:>
return $this->_SetError("User is not allowed to do this."); # breaks when an error occured
=back
=over 2
=back
=head3 PRIVATE METHODS
lib/Arc/Connection/Server.pm view on Meta::CPAN
##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.
lib/Arc/Connection/Server.pm view on Meta::CPAN
my $sasl = $this->{_sasl} =
$this->{__sasl}->server_new(
$this->{service},
"",
inet_ntoa($this->{_connection}->sockaddr).";".$this->{_connection}->sockport,
inet_ntoa($this->{_connection}->peeraddr).";".$this->{_connection}->peerport,
);
if ((!defined $sasl) or ($sasl->code != 0)) {
return $this->_SetError("SASL: ",$sasl->error());
}
$this->_Debug("Available mechanisms. ",$sasl->listmech("","|",""));
return $this->_StepAuthentication(1);
}
## Another SASL step
## Response of a SASL command from the client
## Protocol command: SASL <base64 encoded SASL outout>\r\n
lib/Arc/Connection/Server.pm view on Meta::CPAN
$this->{_realm} = $sasl->property("realm");
$this->Log(LOG_AUTH,"SASL: Negotiation complete. User '".$this->{_username}.
"' is authenticated using ".$this->{_saslmech}.". (".$this->{_connection}->peerhost.")");
$ret = 1;
} else {
$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;
lib/Arc/Connection/Server.pm view on Meta::CPAN
my ($cmd,$para) = split(/\s+/,$this->{_cmdparameter},2);
$this->_Error("Command not found.") unless defined $cmd;
my $perlcmd = $this->{commands}->{$cmd};
my $reason = $this->_CheckCmd($cmd, $perlcmd);
if (defined $reason) {
$this->Log(LOG_USER, "Command '$cmd' requested by user '".$this->{_username}.
"' not ok", $reason ? ": $reason" : "");
$this->_Error("Command $cmd not ok", $reason ? ": $reason" : "");
} elsif( !$this->{_error} && defined $perlcmd ) {
$this->Log(LOG_USER,"Command '$cmd' requested by user '".$this->{_username}.
"' mapped to '$perlcmd'",$para ? "with parameters '$para'" : "");
if (eval "require $perlcmd;") {
my $in = new IO::Pipe || return $this->_SetError("Could not create in-Pipe");
my $out = new IO::Pipe || return $this->_SetError("Could not create out-Pipe");
my $err = new IO::Pipe || return $this->_SetError("Could not create err-Pipe");
my $oldsigchld = $SIG{CHLD};
$SIG{CHLD} = 'IGNORE';
lib/Arc/Connection/Server.pm view on Meta::CPAN
$out->autoflush(1);
$this->_ReadWriteBinary($in,$out);
$this->{_cmdclientsock}->close();
$this->Log(LOG_CMD,"Command done.");
while (<$err>) {
$this->_CmdError($_);
# $this->_Debug("command errors: $_");
}
close $in; close $out; close $err;
} else {
$this->_SetError("Unknown host wanted ".
"to use our command connection. ($peeraddr)");
}
wait();
} else {
$this->_SetError("Fork error.");
}
$SIG{CHLD} = $oldsigchld;
} else {
my $e = $@;
$this->Log(LOG_CMD,"$perlcmd: ",$e);
$this->_Error("Command $perlcmd not found or error: ".$e);
}
} else {
$this->Log(LOG_USER,"Command '$cmd' requested by user '".$this->{_username}.
"'",$para ? "with parameters '$para'" : "","was not found!");
$this->_Error("Command $cmd not found (Unknown Command).");
}
$this->_Done();
$SIG{__WARN__} = 'DEFAULT';
if ($this->{_error}) {
$this->_Debug("_RCMD ended with an error");
} else {
$this->_Debug("_RCMD ended ok");
}
return !$this->{_error};
}
sub _CheckCmd
{
my $this = shift;
my ($cmd, $perlcmd) = @_;
# Do nothing by default.
# This method is mearly here so a sub-class can override it.
lib/Arc/Connection/Server.pm view on Meta::CPAN
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;
while ((!$this->{_error}) && ($cmd = $this->_RecvCommand())) {
last unless $this->_ProcessLine($cmd);
last if $cmd eq "QUIT";
}
$this->Quit();
} else {
return $line;
}
}
return !$this->{_error};
}
## Ends the connection.
## Do some cleanup.
##out> always true
##eg> $arc->Quit();
sub Quit
{
my $this = shift;
lib/Arc/Connection/Server.pod view on Meta::CPAN
=item _username I<inherited from Arc::Connection>
B<Description>: username extracted from SASL
B<Default value>: "anonymous"
=back
=over 2
=item _error I<inherited from Arc>
B<Description>: contains the error message
B<Default value>: undef
=item _syslog I<inherited from Arc>
B<Description>: log to syslog or to STDERR
B<Default value>: 1
=back
lib/Arc/Connection/Server.pod view on Meta::CPAN
=over 2
=item DESTROY ( ) I<inherited from Arc>
B<Description>: Destructor
=item IsError ( ) I<inherited from Arc>
B<Description>: User function to get the error msg.
B<Returns:> the error message if any otherwise undef
B<Example:>
unless (my $err = $arc->IsError()) { .. } else { print STDERR $err; }
=item Log ( $facility, ... (message) ) I<inherited from Arc>
B<Description>: Log function.
Logs messages to 'logdestination' if 'loglevel' is is set appropriatly.
loglevel behaviour has changed in the 1.0 release of ARCv2, the "Arc"-class can export
LOG_AUTH (authentication information), LOG_USER (connection information), LOG_ERR (errors),
LOG_CMD (ARCv2 addition internal command information), LOG_SIDE (verbose client/server-specific
information), LOG_DEBUG (verbose debug information). It possible to combine the
levels with or (resp. +) to allow a message to appear when not all loglevels are
requested by the user.
Commonly used for logging errors from application level.
B<Returns:> always false
B<Example:>
return $arc->Log(LOG_ERR,"Message");
lib/Arc/Connection/Server.pod view on Meta::CPAN
=item _CBCanonUser ( )
B<Description>: Callback function to canonicalize the username (SASL)
see Authen::SASL(::Cyrus) for parameter list and how to use.
=item _CheckCmd ( )
=item _CmdError ( )
B<Description>: send a command error msg to client.
Protocol command: CMDERR <msg>\r\n
B<Returns:> true when succesful, otherwise false
B<Example:>
$this->_CmdError("failure.");
lib/Arc/Connection/Server.pod view on Meta::CPAN
B<Returns:> true when succesful, otherwise false
B<Example:>
$this->_Done();
=item _Error ( )
B<Description>: send an error msg to client (Server error).
Protocol command: ERR <msg>\r\n
B<Returns:> true when succesful, otherwise false
B<Example:>
$this->_Error("failure.");
lib/Arc/Connection/Server.pod view on Meta::CPAN
B<Example:>
$this->_Debug("hello","world"); # message will be "hello world"
=item _SetError ( ... (message) ) I<inherited from Arc>
B<Description>: SetError function.
This function prepends the error message (@_) to an existing error message (if any) and
logs the message with LOG_ERR facility.
Use this function for setting an error from class level. Users should use IsError
to get the message if a function failed.
B<Returns:> always false
B<Example:>
return $this->_SetError("User is not allowed to do this."); # breaks when an error occured
=back
=over 2
=back
=head3 PRIVATE METHODS
lib/Arc/Server.pod view on Meta::CPAN
=back
=over 2
=back
=head3 PROTECTED MEMBERS
=over 2
=item _error I<inherited from Arc>
B<Description>: contains the error message
B<Default value>: undef
=item _syslog I<inherited from Arc>
B<Description>: log to syslog or to STDERR
B<Default value>: 1
=back
lib/Arc/Server.pod view on Meta::CPAN
=over 2
=item DESTROY ( ) I<inherited from Arc>
B<Description>: Destructor
=item IsError ( ) I<inherited from Arc>
B<Description>: User function to get the error msg.
B<Returns:> the error message if any otherwise undef
B<Example:>
unless (my $err = $arc->IsError()) { .. } else { print STDERR $err; }
=item Log ( $facility, ... (message) ) I<inherited from Arc>
B<Description>: Log function.
Logs messages to 'logdestination' if 'loglevel' is is set appropriatly.
loglevel behaviour has changed in the 1.0 release of ARCv2, the "Arc"-class can export
LOG_AUTH (authentication information), LOG_USER (connection information), LOG_ERR (errors),
LOG_CMD (ARCv2 addition internal command information), LOG_SIDE (verbose client/server-specific
information), LOG_DEBUG (verbose debug information). It possible to combine the
levels with or (resp. +) to allow a message to appear when not all loglevels are
requested by the user.
Commonly used for logging errors from application level.
B<Returns:> always false
B<Example:>
return $arc->Log(LOG_ERR,"Message");
lib/Arc/Server.pod view on Meta::CPAN
B<Example:>
see source code of any non-abstract sub class of Arc
=item _SetError ( ... (message) ) I<inherited from Arc>
B<Description>: SetError function.
This function prepends the error message (@_) to an existing error message (if any) and
logs the message with LOG_ERR facility.
Use this function for setting an error from class level. Users should use IsError
to get the message if a function failed.
B<Returns:> always false
B<Example:>
return $this->_SetError("User is not allowed to do this."); # breaks when an error occured
=back
=over 2
=back
=head3 PRIVATE METHODS
scripts/arcx view on Meta::CPAN
my @server_list;
if ($args{h}) {
push @server_list, $args{h}.($args{p} ? ":".$args{p} : "");
# only use the cmd2server maplist, when we have a command given
} elsif (!$intact && $args{C}) {
unless (-e $args{C}) {
err("Configfile $args{C} not found.");
} else {
my $cf = new Config::IniFiles( -file => $args{C});
my $err = @Config::IniFiles::errors;
usage($err) if $err;
foreach ($cf->Parameters('server_command_map')) {
my ($host,$cmdlist) = ($_,$cf->val('server_command_map',$_));
push @server_list, $host
if $cmdlist eq '*' || grep( { $_ eq $ARGV[0] } split(/[,:;]/, $cmdlist));
}
}
}
scripts/arcx view on Meta::CPAN
-U <username> username for authentication (dep. on SASL mechanism)
-u ask for username
-A <authz name> username for authorization (dep. SASL mechanism)
-a ask for authname
-W <password> password (dep. on SASL mechanism)
-w ask for password
-f <history> filename for command history (def: $ENV{HOME}/.archistory)
-F don't add commands to the history file
-l <loglevel> loglevel (see man Arc) (default: 0, error msgs will be on stderr)
-L <logdest> log destination (possible values: 'syslog' (def) or 'stderr')
-V display version information
$Arc::Copyright
$Arc::Contact
EOT
exit 1;
}
scripts/arcxd view on Meta::CPAN
$SIG{CHLD} = 'IGNORE';
my %args;
getopts("d:F:p:vP:",\%args) || usage("Wrong parameter construction.");
$args{F} = $Arc::ConfigPath."/arcxd.conf" unless $args{F};
usage("Configuration file ($args{F}) not found.") unless -e $args{F};
my $cf;
(print @Config::IniFiles::errors or exit 1) unless $cf = new Config::IniFiles(-file => $args{F});
my %log;
$log{loglevel} = $args{d} ? $args{d} : $cf->val("logging","level",7);
$log{logdestination} = $args{d} ? 'stderr' :$cf->val("logging","destination",'syslog');
my %def;
$def{server} = {};
my $prop = $def{server};
$prop->{port} = [split(/,/,$args{p} ? $args{p} : $cf->val("arcd","port",$Arc::DefaultPort))];
( run in 0.773 second using v1.01-cache-2.11-cpan-65fba6d93b7 )