ARCv2
view release on metacpan or search on metacpan
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
- commandconnection is now using IO::Select for accepting
- added init.d script for solaris
1.00 Wed Jul 28 2004
- change the loglevel behaviour
- ported the server to Net::Server::PreFork
- encrypted protocol connection (new protocol version)
- added PBConfig for easier Makefile.PL
- Missing dependencies fix
- fix documentation for arcx (thanks to Andreas Haupt)
0.06 Mon Mar 08 2004
- Solaris make fix
package Arc;
use strict;
use warnings;
use Sys::Syslog;
use Exporter;
use constant LOG_AUTH => 1;
use constant LOG_USER => 2;
use constant LOG_ERR => 4;
use constant LOG_CMD => 8;
use constant LOG_SIDE => 16;
use constant LOG_DEBUG => 32;
use vars qw($VERSION $ConfigPath $DefaultPort $DefaultHost $Copyright $Contact @ISA @EXPORT_OK $DefaultPIDFile);
$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, ...
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 $ret = $this->{_error};
$this->{_error} = undef;
return $ret;
}
## Destructor
sub DESTROY {
my $this = shift;
closelog() if $this->{_syslog};
}
1;
lib/Arc.pod view on Meta::CPAN
This is the base class which defines the namespace for
the ARCv2 module suite.
=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
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
=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
=over 2
=back
=head3 PRIVATE MEMBERS
lib/Arc.pod view on Meta::CPAN
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
lib/Arc/Command.pm view on Meta::CPAN
_commands => {}, # the "available commands"-hash from the server,
_username => "", # user, who has authenticated against ARCv2 Server by using SASL
_realm => "", # the name of the realm, to which the user belongs (SASL)
_mech => undef, # user uses this authentication mechanism (e.g. GSSAPI)
_peeraddr => undef, # users ip address
_peername => undef, # users host address in sockaddr_in format
_peerport => undef, # users port
_cmd => undef, # user runs this command
# public:
logfileprefix => "command",
};
}
## execute this command.
## This function is called by the ARCv2 Server when the user wants
## to execute this command.
##in> ... (parameter from users request)
##out> true if the command has succeeded, false (and please set _SetError) if not.
sub Execute
{
lib/Arc/Command.pod view on Meta::CPAN
[..]
(fork)
my $ret = eval
{
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
lib/Arc/Command.pod view on Meta::CPAN
client. See 'Class VARIABLES' for a complete list of them. These values
are filled by Arc::Connection::Server, when the client wants to run a command.
=head1 Class VARIABLES
=head3 PUBLIC MEMBERS
=over 2
=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
=over 2
=back
=head3 PROTECTED MEMBERS
lib/Arc/Command.pod view on Meta::CPAN
=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
=over 2
=back
=head3 PRIVATE MEMBERS
lib/Arc/Command.pod view on Meta::CPAN
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
lib/Arc/Connection.pod view on Meta::CPAN
=item timeout
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>
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
=over 2
=back
=head3 PROTECTED MEMBERS
lib/Arc/Connection.pod view on Meta::CPAN
=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
=over 2
=back
=head3 PRIVATE MEMBERS
lib/Arc/Connection.pod view on Meta::CPAN
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
lib/Arc/Connection/Client.pm view on Meta::CPAN
use Arc qw(LOG_AUTH LOG_USER LOG_ERR LOG_CMD LOG_SIDE LOG_DEBUG);
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.pod view on Meta::CPAN
server.
=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
return <>;
}
=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
=item protocol I<reimplemented from Arc::Connection>
lib/Arc/Connection/Client.pod view on Meta::CPAN
=item timeout I<inherited from Arc::Connection>
B<Description>: timeout for all connections (ARCv2 and command) in seconds
B<Default value>: undef
=back
=over 2
=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
=over 2
=back
=head3 PROTECTED MEMBERS
lib/Arc/Connection/Client.pod view on Meta::CPAN
=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
=over 2
=back
=head3 PRIVATE MEMBERS
lib/Arc/Connection/Client.pod view on Meta::CPAN
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
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
lib/Arc/Connection/Server.pm view on Meta::CPAN
use Arc::Connection;
use MIME::Base64;
@Arc::Connection::Server::ISA = qw(Arc::Connection);
sub members
{
my $this = shift;
return { %{$this->SUPER::members},
_realm => "", # Name of the SASL realm, if the user is from the default realm, this is empty
logfileprefix => "server",
sasl_cb_getsecret => "", # Callback for SASL (if PLAIN (or equal) mechanisms are used). See Authen::SASL(::Cyrus).
sasl_cb_checkpass => 0, # Callback for SASL (if PLAIN (or equal) mechanisms are used). See Authen::SASL(::Cyrus).
sasl_mechanisms => undef, # array of allowed SASL mechanisms
commands => undef, # hash of assignment between B<Command Name> and B<Command Class>. See L<Arc::Command>
};
}
sub _Init
lib/Arc/Connection/Server.pm view on Meta::CPAN
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);
lib/Arc/Connection/Server.pm view on Meta::CPAN
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);
lib/Arc/Connection/Server.pod view on Meta::CPAN
=head3 PUBLIC MEMBERS
=over 2
=item commands
B<Description>: hash of assignment between B<Command Name> and B<Command Class>. See L<Arc::Command>
B<Default value>: undef
=item logfileprefix I<reimplemented from Arc>
B<Default value>: "server"
=item sasl_cb_checkpass
B<Description>: Callback for SASL (if PLAIN (or equal) mechanisms are used). See Authen::SASL(::Cyrus).
=item sasl_cb_getsecret
B<Description>: Callback for SASL (if PLAIN (or equal) mechanisms are used). See Authen::SASL(::Cyrus).
lib/Arc/Connection/Server.pod view on Meta::CPAN
=item timeout I<inherited from Arc::Connection>
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
=over 2
=back
=head3 PROTECTED MEMBERS
lib/Arc/Connection/Server.pod view on Meta::CPAN
=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
=over 2
=back
=head3 PRIVATE MEMBERS
lib/Arc/Connection/Server.pod view on Meta::CPAN
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
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
lib/Arc/Server.pm view on Meta::CPAN
my $this = shift;
return { %{$this->SUPER::members},
# private:
__arc => undef, # stores the Arc::Connection::Server object for optimal PreFork
# protected:
# public:
connection_type => 'Arc::Connection::Server', # Class to use for connections
connection_vars => undef, # variables passed directly to every connection handle See C<Arc::Connection::Server>
logfileprefix => "mainserver", # Logfileprefix
# net::server
server => undef, # attributes for Net::Server::PreFork
};
}
sub _Init
{
my $this = shift;
lib/Arc/Server.pm view on Meta::CPAN
# %{$this->{connection_vars}},
# );
return $this->_SetError("No Arc::Connection::Server object was created.")
unless $arc;
$this->Log(LOG_USER,"Client connection from",$this->{server}->{client}->peerhost);
$arc->HandleClient($this->{server}->{client});
$arc->clean;
$this->Log(LOG_USER,"Client connection closed.");
}
sub write_to_log_hook
{
my ($this,$loglevel,$msg) = @_;
$msg =~ s/[\n\r]//g;
$this->Log(LOG_SIDE,$msg);
1;
}
sub child_init_hook
{
my $this = shift;
my $ct = $this->{connection_type};
$this->{__arc} = new $ct (
lib/Arc/Server.pod view on Meta::CPAN
too. This package provides two perl command line scripts (arcx, arcxd). They can
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 => {
'whoami' => 'Arc::Command::Whoami,
'uptime' => 'Arc::Command::Uptime,
}
service => "arc",
}
lib/Arc/Server.pod view on Meta::CPAN
B<Description>: Class to use for connections
B<Default value>: 'Arc::Connection::Server'
=item connection_vars
B<Description>: variables passed directly to every connection handle See C<Arc::Connection::Server>
B<Default value>: undef
=item logfileprefix
B<Description>: Logfileprefix
B<Default value>: "mainserver"
=item server
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>
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
=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
=over 2
=back
=head3 PRIVATE MEMBERS
lib/Arc/Server.pod view on Meta::CPAN
B<Returns:> return true if everything worked fine, otherwise false is returned and C<IsError> should be checked.
B<Example:>
$arc->Start();
=item write_to_log_hook ( )
=back
=over 2
=item DESTROY ( ) I<inherited from Arc>
B<Description>: Destructor
lib/Arc/Server.pod view on Meta::CPAN
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
lib/arcx.pod view on Meta::CPAN
to /etc/passwd.
=back
=head1 USAGE
As usual a command line interface has some parameters to influence the behaviour.
The scheme looks like this:
arcx [-h <hostname>] [-p <port>] [-l <loglevel] [-L <logdestination] [-n] [-v] [-S <service>] [-F -f <history>] [-u|-U <username>] [-a|-A <authname>] [-w|-W <password>] [-s <mech>] [-t <timeout in sec>] [-r <string>] [command [command-arguments]]
=head2 Parameter
=over 4
=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
Do nothing, only try to authenticate.
=item -F
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.
By default arcxd fork itself into background. If you want to run arcx in the foreground set the -d option.
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>
lib/arcxd.pod view on Meta::CPAN
whoami = Arc::Command::Whoami
copy = Arc::Command::Get
cp = Arc::Command::Get
get = Arc::Command::Get
put = Arc::Command::Put
test = Arc::Command::Test
help = Arc::Command::Help
h = Arc::Command::Help
hlp = Arc::Command::Help
[logging]
level = 7
destination = syslog
The configuration file is based on .ini format, known from Windows (sorry).
In perl we can parse it, using Config::IniFiles. The configuration file is divided into
several sections. Each section can have a several number of key/value pairs.
=head2 main
=over 4
=item service
lib/arcxd.pod view on Meta::CPAN
=head2 commands
=over 4
=item B<Command Name> = B<Command Class>
The section [commands] defines the assignments of command names to their command class. Each line is a command in ARCv2. A class can be assigned to more than one name.
=back
=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
$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;
scripts/arcx view on Meta::CPAN
my $retval = 0;
verbout("Will try the following server: ",join(", ",@server_list));
foreach (@server_list) {
($args{h},$args{p}) = split(/:/,$_);
verbout("connecting to '$args{h}:$args{p}'");
verbout("timeout is set to '$args{t}'");
verbout("loglevel is set to '$args{l}'");
verbout("log output will go to '$args{L}'");
verbout("using service name '$args{S}'");
if (defined $args{s}) {
verbout("authentication mechanism forced by client: '$args{s}'");
} else {
verbout("we let the server choose the authentication mechanism.");
}
my $arc = new Arc::Connection::Client(
server => $args{h},
port => $args{p},
timeout => $args{t},
loglevel=> $args{l},
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);
scripts/arcx view on Meta::CPAN
? for this help
\\q,^D quit
EOT
}
sub usage
{
my $msg = shift;
print STDERR <<EOT;
$msg
$0 [-h <hostname>] [-p <port>] [-l <loglevel]
[-L <logdestination] [-n] [-v] [-S <service>]
[-F -f <history>] [-u|-U <username>] [-a|-A <authname>]
[-w|-W <password>] [-s <mech>] [-t <timeout in sec>]
[-r <string>] [-V] [-C <conffile>] [command [command-arguments]]
(Remark: Some parameters behave different in comparison to the old arc)
-h <hostname> specify the ARCv2 server
-p <port> port to connect (default: $Arc::DefaultPort)
-t <timeout> specify the timeout in seconds (default: 30 secs)
-0 use old protocol type (unencrypted protocol conn.)
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
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
}
close(FH);
my $cmds = {};
foreach ($cf->Parameters("commands")) {
$cmds->{$_} = $cf->val("commands",$_);
verbout("adding possible command:",$_);
}
verbout("Available SASL mechanisms:",join(",",$cf->val("arcd","sasl_mechanisms")));
verbout("Loglevel:",$log{loglevel});
verbout("Logdest:",$log{logdestination});
verbout("Listenport:",join(",",@{$prop->{port}}));
verbout("Forking into background.") unless $args{d};
verbout("Using $Arc::Copyright.");
verbout("Contact: $Arc::Contact.");
verbout("Service: ",$cf->val("main","service"));
verbout("PID-file: ",$prop->{pid_file});
my $arc = new Arc::Server(
%def,
%log,
connection_vars => {
%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);
scripts/arcxd view on Meta::CPAN
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
-d <loglevel> loglevel (see man Arc) and do not fork into backgroup
-p <port> port the server shall listen on
-P <pid_file> PID file
-F <config file> specify the config file, where the server finds information
-v produce some extra output (from this executable)
$Arc::Copyright
$Arc::Contact
EOT
exit 1;
}
scripts/arcxd.conf view on Meta::CPAN
pv = Pv
chown = Unix
mkdir = Unix
rmdir = Unix
mv = Unix
acl = Acl
kstart = Arc::Command::Kstart
[logging]
level = 7
destination = syslog
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',
}
}
exit 0;
} 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.262 second using v1.01-cache-2.11-cpan-49f99fa48dc )