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
$VERSION = '1.05';
$ConfigPath = "/etc/arcx";
$DefaultPort = 4242;
$DefaultHost = "arcdsrv";
$DefaultPIDFile = "/var/run/arcxd.pid";
$Copyright = "ARCv2 $VERSION (C) 2003-5 Patrick Boettcher and others. All right reserved.";
$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.
## For all sub classes, please override C<_Init> to check the
## parameter which are passed to the C<new> function. This
## is necessary because you are not able to call the the new method of a
## parent class, when having a class name (new $class::SUPER::new, does not work.).
##in> %hash, key => val, ...
##out> blessed object of the class
##eg> my $this = new Arc::Class ( key => value, key2 => value2 );
sub new
{
my $this = shift;
my $class = ref($this) || $this;
my $self = bless { },$class;
$self->_Init(@_);
return $self;
}
## Init function (initializes class context)
## Module dependent initialization, every subclass shall override it
## and call the _Init of its SUPER class. This method is called by the new method of C<Arc>.
##in> %hash, key => val, ...
##out> true, if all passed values are in their definition scope, otherwise false
##eg> see source code of any non-abstract sub class of Arc
sub _Init
{
my $this = shift;
my (%values) = @_;
my $members = $this->members;
while (my ($key,$val) = each(%$members)) {
$this->{$key} = exists($values{$key}) ? $values{$key} : $val;
delete $values{$key};
}
croak("Ignored values at object-creation (this is probably not what you want): ",join(" ",keys (%values))) if keys %values;
# loglevel
$this->{loglevel} = 4 if not defined $this->{loglevel};
$this->{_syslog} = ! (defined $this->{logdestination} && $this->{logdestination} eq "stderr");
openlog("arcv2","cons,pid","user") if $this->{_syslog};
1;
}
## Debug function.
## Logs messages with "DEBUG"
##in> ... (message)
##out> always false
##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');
$lev = 0 if $pr & LOG_ERR;
$lev = 2 if $pr & LOG_DEBUG;
if ($pr & $this->{loglevel}) {
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
=head1 Class VARIABLES
=head3 PUBLIC MEMBERS
=over 2
=item logdestination
B<Description>: Where should all the log output go to ('stderr','syslog')
B<Default value>: 'syslog'
=item logfileprefix
B<Description>: Prepended to every log entry
B<Default value>: ""
=item loglevel
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");
=item new ( %hash, key => val, ... )
B<Description>: Constructor.
Initializes the object and returns it blessed.
For all sub classes, please override C<_Init> to check the
parameter which are passed to the C<new> function. This
is necessary because you are not able to call the the new method of a
parent class, when having a class name (new $class::SUPER::new, does not work.).
B<Returns:> blessed object of the class
B<Example:>
lib/Arc.pod view on Meta::CPAN
B<Example:>
$this->_Debug("hello","world"); # message will be "hello world"
=item _Init ( %hash, key => val, ... )
B<Description>: Init function (initializes class context)
Module dependent initialization, every subclass shall override it
and call the _Init of its SUPER class. This method is called by the new method of C<Arc>.
B<Returns:> true, if all passed values are in their definition scope, otherwise false
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
{
my $object = new $perlcmd(
_username => $this->{_username},
_peeraddr => $this->{peeraddr},
_peerport => $this->{peerport},
_peername => $this->{peername},
_cmd => $cmd,
logfileprefix => "command",
);
$object->Execute(@a);
$cmderr = $object->IsError();
return -1;
};
When everything went alright, the command will be executed. The command runs
in a separate process. Therefore STDIN, STDOUT and STDERR are duped to two
pipes, one for the in, one for the out direction. In the parent process data
from the encrypted network command connection is read from and written to these pipes.
Same situation on the client side, STDIN and STDOUT are used to put and get the
data through the network.
lib/Arc/Command.pod view on Meta::CPAN
B<Example>:
sub Execute
{
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 logfileprefix I<reimplemented from Arc>
B<Default value>: "command"
=back
=over 2
=item logdestination I<inherited from Arc>
B<Description>: Where should all the log output go to ('stderr','syslog')
B<Default value>: 'syslog'
=item loglevel I<inherited from Arc>
B<Description>: loglevel is combination of bits (1=AUTH,2=USER,4=ERR,8=CMDDEBUG,16=VERBSIDE,32=DEBUG) see _Log method
B<Default value>: 7
=back
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");
=item new ( %hash, key => val, ... ) I<inherited from Arc>
B<Description>: Constructor.
Initializes the object and returns it blessed.
For all sub classes, please override C<_Init> to check the
parameter which are passed to the C<new> function. This
is necessary because you are not able to call the the new method of a
parent class, when having a class name (new $class::SUPER::new, does not work.).
B<Returns:> blessed object of the class
B<Example:>
lib/Arc/Command.pod view on Meta::CPAN
B<Example:>
$this->_Debug("hello","world"); # message will be "hello world"
=item _Init ( %hash, key => val, ... ) I<inherited from Arc>
B<Description>: Init function (initializes class context)
Module dependent initialization, every subclass shall override it
and call the _Init of its SUPER class. This method is called by the new method of C<Arc>.
B<Returns:> true, if all passed values are in their definition scope, otherwise false
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
B<Description>: timeout for all connections (ARCv2 and command) in seconds
B<Default value>: undef
=back
=over 2
=item logdestination I<inherited from Arc>
B<Description>: Where should all the log output go to ('stderr','syslog')
B<Default value>: 'syslog'
=item logfileprefix I<inherited from Arc>
B<Description>: Prepended to every log entry
B<Default value>: ""
=item loglevel I<inherited from Arc>
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");
=item new ( %hash, key => val, ... ) I<inherited from Arc>
B<Description>: Constructor.
Initializes the object and returns it blessed.
For all sub classes, please override C<_Init> to check the
parameter which are passed to the C<new> function. This
is necessary because you are not able to call the the new method of a
parent class, when having a class name (new $class::SUPER::new, does not work.).
B<Returns:> blessed object of the class
B<Example:>
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
use Arc::Connection;
use MIME::Base64;
@Arc::Connection::Client::ISA = qw(Arc::Connection);
sub members
{
my $this = shift;
return { %{$this->SUPER::members},
logfileprefix => "client",
logdestination => "stderr",
sasl_cb_user => $ENV{'USER'}, # SASL Callback for username (PLAIN and some other mechs only)
sasl_cb_auth => $ENV{'USER'}, # SASL Callback for authname (PLAIN and some other mechs only)
sasl_cb_pass => "", # SASL Callback for password (PLAIN and some other mechs only)
server => undef, # Server to connect to
port => undef, # Port to connect to
sasl_mechanism => undef, # use this mechanism for authentication
server_sasl_mechanisms => [], # filled by the sasl mechanisms
protocol => 1, # Which protocol type the shall use.
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
=head1 SYNOPSIS
Arc::Connection::Client - Client class for ARCv2
my $arc = new Arc::Connection::Client(
server => "hyade11",
port => 4242,
timeout => 30,
loglevel=> 7,
logdestination => 'stderr',
service => 'arc',
sasl_mechanism => undef,
sasl_cb_user => \&username,
sasl_cb_auth => \&username,
sasl_cb_pass => \&password,
);
if (my $m = $arc->IsError()) {
die $m;
}
lib/Arc/Connection/Client.pod view on Meta::CPAN
=head1 Class VARIABLES
=head3 PUBLIC MEMBERS
=over 2
=item logdestination I<reimplemented from Arc>
B<Default value>: "stderr"
=item logfileprefix I<reimplemented from Arc>
B<Default value>: "client"
=item port
B<Description>: Port to connect to
B<Default value>: undef
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");
=item new ( %hash, key => val, ... ) I<inherited from Arc>
B<Description>: Constructor.
Initializes the object and returns it blessed.
For all sub classes, please override C<_Init> to check the
parameter which are passed to the C<new> function. This
is necessary because you are not able to call the the new method of a
parent class, when having a class name (new $class::SUPER::new, does not work.).
B<Returns:> blessed object of the class
B<Example:>
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';
my $cmdpid = fork();
if ($cmdpid == 0) { # Child
$this->{logfileprefix} = "commandchild";
# prepare environment for the command
$in->writer(); $out->reader(); $err->writer();
open STDIN, "<&", $out;
open STDOUT, ">&", $in;
open STDERR, ">&", $err;
my @a = $this->_SplitCmdArgs($para);
my ($ret, $cmderr) = $this->_RunCmd($cmd, $perlcmd, \@a);
if ($cmderr) {
$ret = 1;
$cmderr =~ s/\r//g; $cmderr =~ s/\n/ /g; $cmderr =~ s/ +/ /g;
print $err $cmderr;
}
close $in; close $out; close $err;
exit $ret;
} elsif ($cmdpid) {
$this->Log(LOG_SIDE,"Awaiting command connection.");
$this->_CommandConnection();
# check that the connecting host is really the host we are expecting to be.
my ($peerport,$peeraddr) = sockaddr_in($this->{_cmdclientsock}->peername);
$peeraddr = inet_ntoa($peeraddr);
if ($peeraddr eq $this->{_connection}->peerhost) {
$this->Log(LOG_CMD,"Command connection established.");
$in->reader(); $out->writer(); $err->reader();
$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.
return undef;
}
sub _SplitCmdArgs
{
my $this = shift;
my $para = shift;
return split(/\s+/,$para) if defined $para; # better splitting for array TODO
return ();
}
sub _RunCmd
{
my $this = shift;
my ($cmd, $perlcmd, $argref) = @_;
my $cmderr;
my $ret = eval {
my $object = new $perlcmd (
_commands => $this->{commands},
_username => $this->{_username},
_realm => $this->{_realm},
_mech => $this->{_saslmech},
_peeraddr => $this->{_connection}->peerhost,
_peerport => $this->{_connection}->peerport,
_peername => $this->{_connection}->peername,
_cmd => $cmd,
logfileprefix => "command",
);
$object->Execute(@{ $argref });
$cmderr = $object->IsError();
return 0;
};
$ret = 2 unless defined($ret);
$cmderr .= " ".$@ if $@;
return ($ret, $cmderr);
}
## does nothing, placeholder for QUIT\r\n command, sent by the client.
sub _RQUIT
{
my $this = shift;
return 1;
}
## Public function, gets the clientsocket (from Arc::Server) and handles 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
B<Description>: timeout for all connections (ARCv2 and command) in seconds
B<Default value>: undef
=back
=over 2
=item logdestination I<inherited from Arc>
B<Description>: Where should all the log output go to ('stderr','syslog')
B<Default value>: 'syslog'
=item loglevel I<inherited from Arc>
B<Description>: loglevel is combination of bits (1=AUTH,2=USER,4=ERR,8=CMDDEBUG,16=VERBSIDE,32=DEBUG) see _Log method
B<Default value>: 7
=back
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");
=item new ( %hash, key => val, ... ) I<inherited from Arc>
B<Description>: Constructor.
Initializes the object and returns it blessed.
For all sub classes, please override C<_Init> to check the
parameter which are passed to the C<new> function. This
is necessary because you are not able to call the the new method of a
parent class, when having a class name (new $class::SUPER::new, does not work.).
B<Returns:> blessed object of the class
B<Example:>
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.pm view on Meta::CPAN
}
# net::server::* initilizations
$this->{server}->{proto} = 'tcp';
$this->{server}->{listen} = SOMAXCONN;
$this->{server}->{child_communication} = undef,
}
## start the server
## This function is used by the user to start the server and enter the main accept-loop.
## Only by calling the C<Interrupt> function this call can be aborted.
##out> return true if everything worked fine, otherwise false is returned and C<IsError> should be checked.
##eg> $arc->Start();
sub Start
{
my $this = shift;
my $ct = $this->{connection_type};
eval "require $ct";
croak "Please \"use $ct\" before calling Start(): $@" if $@;
$this->run();
return 1;
}
# Net::Server::* hooks and overrides
sub process_request
{
my $this = shift;
my $arc = $this->{__arc};
# my $arc = new Arc::Connection::Server(
# %{$this->{connection_vars}},
# );
return $this->_SetError("No Arc::Connection::Server object was created.")
unless $arc;
lib/Arc/Server.pod view on Meta::CPAN
be used for working with the ARC server from the command line, resp. to start the
server.
=head1 SYNOPSIS
Arc::Server - Class for the standalone server for ARCv2
my $arc = new Arc::Server(
port => [4242],
loglevel => 7,
logdestination => "stderr",
daemonize => 0,
connection_type => "Arc::Connection::Server",
connection_vars => {
loglevel => 7,
logdestination => 'syslog',
timeout => 30,
sasl_mechanisms => ["GSSAPI","KERBEROS_V4","PLAIN"],
sasl_cb_getsecret => &getsecret,
sasl_cb_checkpass => &checkpass,
commands => {
lib/Arc/Server.pod view on Meta::CPAN
B<Description>: attributes for Net::Server::PreFork
B<Default value>: undef
=back
=over 2
=item logdestination I<inherited from Arc>
B<Description>: Where should all the log output go to ('stderr','syslog')
B<Default value>: 'syslog'
=item logfileprefix I<inherited from Arc>
B<Description>: Prepended to every log entry
B<Default value>: ""
=item loglevel I<inherited from Arc>
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
=item child_init_hook ( )
=item post_accept ( )
=item process_request ( )
=item Start ( )
B<Description>: start the server
This function is used by the user to start the server and enter the main accept-loop.
Only by calling the C<Interrupt> function this call can be aborted.
B<Returns:> return true if everything worked fine, otherwise false is returned and C<IsError> should be checked.
B<Example:>
$arc->Start();
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");
=item new ( %hash, key => val, ... ) I<inherited from Arc>
B<Description>: Constructor.
Initializes the object and returns it blessed.
For all sub classes, please override C<_Init> to check the
parameter which are passed to the C<new> function. This
is necessary because you are not able to call the the new method of a
parent class, when having a class name (new $class::SUPER::new, does not work.).
B<Returns:> blessed object of the class
B<Example:>
lib/Arc/Server.pod view on Meta::CPAN
B<Example:>
$this->_Debug("hello","world"); # message will be "hello world"
=item _Init ( %hash, key => val, ... ) I<inherited from Arc>
B<Description>: Init function (initializes class context)
Module dependent initialization, every subclass shall override it
and call the _Init of its SUPER class. This method is called by the new method of C<Arc>.
B<Returns:> true, if all passed values are in their definition scope, otherwise false
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/arcx.pod view on Meta::CPAN
=item -h <hostname>
The hostname, where the ARCv2 server is running. If no -h option is given, arcx will use the one chosen at compile time ($Arc::DefaultHost).
=item -p <port>
The port, where the ARCv2 server is listening. If no -p option is given, arcx will use the one given at compile time ($Arc::DefaultPort).
=item -L <logdestination>
This option defines the log output destination. Possible values are "stderr" and "syslog". Default is "syslog". -L does not refer to the -v option and arcx.
=item -l <loglevel>
This option specifies the logging level of ARCv2. Default is 5, whereas 7 is the highest (DEBUG) and 1 is the lowest.
=item -v
The verbose option. If this option is set, arcx is verbose in its context. This option does not influence the ARCv2 object. Use -l and -L for it.
=item -n
lib/arcxd.pod view on Meta::CPAN
Start the ARCv2 server. The server will listen on the DefaultPort and all local addresses.
It will read the configuration file, located in the ConfigPath. After successful listening,
it will fork into the background.
=item arcxd -p 1234
Same as L<arcxd> but listens on port 1234.
=item arcxd -d 5
Stay in foreground and log messages to stderr.
=item arcxd -P arcxd.pid
Let arcxd store the pid of the master process in arcxd.pid.
=back
=head1 USAGE
Some parameters can be supplied to this scripts. The most of them come from the configuration file.
lib/arcxd.pod view on Meta::CPAN
The scheme looks like this:
arcxd [-d <loglevel>] [-p <port>] [-F <config file>] [-v]
=head2 Parameter
=over 4
=item -d <loglevel>
Let the server put its log output to "stderr" and set the log level to <loglevel>. Also tells the server to do not fork into the background.
=item -p <port>
On which port the server shall listen on. (override the one from the configuration file and the default port). Change this for testing purposes.
=item -P <pid_file>
Where should the Net::Server store the PID of the master process.
=item -F <config file>
Specify the configuration file, to fill ARCv2 appropriately. Default is arcxd.conf in the default path $Arc::Default Path.
=item -v
lib/arcxd.pod view on Meta::CPAN
=head2 arcd
=over 4
=item host
Here you can specify the address the server shall wait for connections. 0 lets the server listen on all interface on the host.
=item port
On which port the server shall listen on, can be overridden by the mentioned -p option.
=item max_requests
=item min_servers
=item max_servers
=item max_spare_servers
=item min_spare_servers
lib/arcxd.pod view on Meta::CPAN
=head2 logging
=over 4
=item loglevel
This option specifies the login level of ARCv2. Default is 5, whereas 7 is the highest (DEBUG) and 1 is the lowest.
=item destination
This option defines the log output destination. Possible values are "stderr" and "syslog".
=back
=head1 SEE ALSO
L<Arc>, L<Arc::Command>, L<Arc::Connection>,
L<Arc::Connection::Server>, L<Arc::Connection::Client>,
L<arcx>, L<arcxd>, L<Authen::SASL>, L<Authen::SASL::Cyrus>
L<Net::Server::PreFork>
scripts/arcx view on Meta::CPAN
#!perl
use strict;
use Getopt::Std;
use Config::IniFiles;
use Arc::Connection::Client;
use Term::ReadKey;
use Term::ReadLine;
my %args;
$SIG{KILL} = \&interrupt;
$SIG{INT} = \&interrupt;
$SIG{TERM} = \&interrupt;
$SIG{HUP} = \&interrupt;
getopts("01S:l:nh:s:p:L:r:t:vaA:uU:wW:f:FC:V",\%args) || usage("Wrong parameter construction.");
usage() if $args{V};
usage("Timeout value must be numeric.") if (defined $args{t} && $args{t} !~ /^\d+$/);
usage("If using -r, a string must be appended.") if (defined $args{r} && length($args{r}) == 0);
usage("Port must be a number correct number.") if (defined $args{p} && $args{p} != 1 && $args{p} !~ /^\d+$/);
usage("Logging destination not chosen correctly.") if (defined $args{L} && ($args{L} ne "syslog" && $args{L} ne "stderr"));
$args{t} = defined $args{t} ? $args{t} : undef;
$args{l} = defined $args{l} ? $args{l} : 0;
$args{L} = defined $args{L} ? $args{L} : 'stderr';
$args{S} = defined $args{S} ? $args{S} : 'arc';
$args{f} = defined $args{f} && $args{f} ne "" ? $args{f} : $ENV{HOME}.'/.archistory';
$args{C} = defined $args{C} && $args{C} ne "" ? $args{C} : $Arc::ConfigPath.'/arcx.conf';
my $intact = !@ARGV;
my $stop = 0;
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));
}
}
}
push @server_list, "$Arc::DefaultHost:$Arc::DefaultPort" unless @server_list;
scripts/arcx view on Meta::CPAN
logdestination => $args{L},
service => $args{S},
sasl_mechanism => $args{s},
sasl_cb_user => \&username,
sasl_cb_auth => \&authname,
sasl_cb_pass => \&password,
protocol => $args{0} ? 0 : 1,
);
if (my $msg = $arc->IsError()) {
err($msg);
$retval = 1;
next;
}
if ($arc->StartSession) {
err("You are authenticated to $arc->{server}:$arc->{port} using $arc->{sasl_mechanism}.") if $args{n} || $intact || $args{v};
if ($intact) {
my $term = new Term::ReadLine 'ARCv2 Terminal';
# Read from history
unless ($args{F}) {
unless (open(FH,"<$args{f}")) {
err("Cannot read from history file: $args{f}. (",$!,")");
} else {
while (<FH>) {
s/[\n\r]//g;
$term->AddHistory($_);
}
close (FH);
}
}
while (!$stop && $arc->IsConnected()) {
scripts/arcx view on Meta::CPAN
next unless $_;
last if ($_ eq "\\q");
if ($_ eq "?") {
showhelp();
next;
}
addhistoryfile($_);
while (!$arc->ProcessCommand($_)) {
err($arc->IsError());
unless ($arc->IsConnected) {
err("Try to reconnect.");
my $end = $arc->StartSession();
err($arc->IsError()) unless $end;
last unless $end;
} else {
last;
}
}
}
} elsif (!defined $args{r}) {
addhistoryfile(@ARGV);
unless ($arc->ProcessCommand(@ARGV)) {
err($arc->IsError());
$retval = 1;
next;
}
} else {
addhistoryfile(@ARGV);
if ($arc->CommandStart(@ARGV)) {
if ($arc->CommandWrite($args{r})) {
$arc->CommandEOF();
while ($_ = $arc->CommandRead()) {
print $_;
}
unless ($arc->CommandEnd()) {
err($arc->IsError());
$retval = 1;
next;
}
} else {
err($arc->IsError());
$retval = 1;
next;
}
} else {
err($arc->IsError());
$retval = 1;
next;
}
}
$arc->Quit();
} else {
err("Could not connect to '$args{h}:$args{p}': ",$arc->IsError());
$retval = 1;
next;
}
verbout("Available SASL mechanisms return by the server: ",join(", ",@{$arc->{server_sasl_mechanisms}}));
last;
}
exit $retval;
sub showhelp
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/arcx view on Meta::CPAN
my $pw = <STDIN>;
ReadMode 0;
return $pw;
} else {
return $ENV{'USER'};
}
}
sub verbout
{
err("verbose:",@_) if $args{v};
}
sub err
{
print STDERR join(" ",@_),"\n";
1;
}
sub interrupt
{
my $sig = shift;
verbout("Received signal: $sig.");
$stop = 1;
undef;
}
sub addhistoryfile
{
unless ($args{F}) {
unless (open(FH,">>$args{f}")) {
$args{F} = 1;
err("Cannot write to history file: $args{f}. (",$!,")");
return;
}
print FH join(" ",@_),"\n";
close (FH);
}
}
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))];
$prop->{host} = $cf->val("arcd","host",0);
$prop->{max_requests} = $cf->val("arcd","max_requests");
$prop->{min_servers} = $cf->val("arcd","min_servers");
scripts/arcxd view on Meta::CPAN
%log,
timeout => $cf->val("main","timeout"),
sasl_mechanisms => [$cf->val("arcd","sasl_mechanisms")],
commands => $cmds,
service => $cf->val("main","service"),
}
);
if (my $msg = $arc->IsError()) {
err($msg);
exit 1;
}
$arc->Start();
sub verbout
{
err("verbose:",@_) if $args{v};
}
sub err
{
print STDERR join(" ",@_),"\n";
1;
}
sub usage
{
my $msg = shift;
print STDERR <<EOT;
$msg
$0 -d <loglevel> -F <config file> -p <listenport> -v
my $user = "mannfred";
my $pass = "klaus";
if ($pid == 0) { # Child
use Arc::Server;
use Arc::Connection::Server;
my $server = new Arc::Server (
loglevel => 0,
logdestination => 'stderr',
server => {
port => [30001], # Testport
host => "localhost",
},
connection_vars => {
loglevel => 0,
logdestination => 'stderr',
sasl_mechanisms => ['PLAIN'],
sasl_cb_checkpass => \&checkpass,
sasl_cb_getsecret => \&getsecret,
service => "arc",
commands => {
test => 'Arc::Command::Test',
whoami => 'Arc::Command::Whoami',
uptime => 'Arc::Command::Uptime',
}
}
} elsif ($pid) { # Parent
use Arc::Connection::Client;
ok(1); #1
sleep(3); # Wait for the server to get ready
my $client = new Arc::Connection::Client (
server => "localhost",
port => 30001, # Testport
loglevel => 0,
logdestination => 'stderr',
service => 'arc',
sasl_mechanism => "PLAIN",
sasl_cb_user => $user,
sasl_cb_auth => $user,
sasl_cb_pass => $pass,
) or ok(0);
ok(1); #2
my $s;
if ($client->StartSession()) { ok(1); } else { ok(0); } #3
( run in 1.321 second using v1.01-cache-2.11-cpan-49f99fa48dc )