ARCv2
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
},
dist => {
COMPRESS => 'gzip --best',
SUFFIX => 'gz',
PREOP => 'make -C doc'
},
'EXE_FILES' => [ 'scripts/arcx', 'scripts/arcxd' ],
);
sub Usage {
print STDERR <<EOH;
ARCv2 Makefile.PL
Usage: perl $0 [options]
Possible options are:
--help See this help
EOH
opt_help();
print @_,"\n";
exit 1;
}
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.
$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;
}
lib/Arc.pod view on Meta::CPAN
=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
lib/Arc/Command.pod view on Meta::CPAN
|--------| |-----------|
| User | | Command |
|--------| |-----------|
This design makes it easy for ARCv2 Commands to get input and produce output.
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.
lib/Arc/Command.pod view on Meta::CPAN
=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
lib/Arc/Command/Get.pm view on Meta::CPAN
};
}
sub Execute
{
my $this = shift;
return $this->_SetError("What shall I copy? Please give the filename.") unless @_;
return $this->_SetError($_[0]," not found or is not readable for me. $!") unless (open FH, "<", $_[0]);
print <FH>;
close FH;
}
return 1;
lib/Arc/Command/Help.pm view on Meta::CPAN
return { %{$this->SUPER::members},
# private:
# protected:
};
}
sub Execute
{
my $this = shift;
print "This is $Arc::Copyright\n";
print "Please report bugs to: $Arc::Contact\n";
print "\n";
print "Available Commands:\n";
# sort command
my %h;
foreach (keys %{$this->{_commands}}) {
push (@{$h{$this->{_commands}->{$_}}}, $_);
}
foreach (sort keys %h) {
print "\t",join (", ",@{$h{$_}}),"\n";
}
1;
}
1;
lib/Arc/Command/Put.pm view on Meta::CPAN
}
sub Execute
{
my $this = shift;
return $this->_SetError("No destination filename given!") unless (@_);
return $this->_SetError($_[0]," is not writeable for me. !") unless (open FH, ">".$_[0]);
while ($_ = <STDIN>)
{
print FH $_;
}
close FH;
return 1;
}
return 1;
lib/Arc/Command/Test.pm view on Meta::CPAN
return { %{$this->SUPER::members},
# private:
# protected:
};
}
sub Execute
{
my $this = shift;
print "Command line arguments: ", join("|",@_),"\n" if @_;
while ($_ = <STDIN>) {
my $y = length($_)/2;
print substr($_,(length($_)-$y)/2,$y),"\n";
}
return 1;
}
return 1;
lib/Arc/Command/Whoami.pm view on Meta::CPAN
return { %{$this->SUPER::members},
# private:
# protected:
};
}
sub Execute
{
my $this = shift;
my $name = gethostbyaddr(inet_aton($this->{_peeraddr}),AF_INET);
print $this->{_username}," coming from ",$name," [",$this->{_peeraddr},"] Port ",
$this->{_peerport},"\n";
return 1;
}
return 1;
lib/Arc/Connection.pod view on Meta::CPAN
=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
lib/Arc/Connection/Client.pod view on Meta::CPAN
);
if (my $m = $arc->IsError()) {
die $m;
}
if ($arc->StartSession) {
$arc->CommandStart("test");
$arc->CommandWrite("hallo\n");
if (my $t = $arc->CommandRead()) {
print $t,"\n"; # should give 'all'
}
$arc->CommandEnd();
}
sub username
{
return $ENV{'USER'};
}
sub password
lib/Arc/Connection/Client.pod view on Meta::CPAN
=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
lib/Arc/Connection/Server.pm view on Meta::CPAN
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.
lib/Arc/Connection/Server.pod view on Meta::CPAN
=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
lib/Arc/Server.pod view on Meta::CPAN
=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
scripts/PBConfig.pm view on Meta::CPAN
$ins = 0;
foreach (@config) {
if ($l =~ /^\$$_->[0]/) {
my ($v);
# Default values
$v = defined $opt->{$_->[0]} ? $opt->{$_->[0]} : $_->[2];
# String in "
$v = $_->[1] eq "s" ? '"'.$v.'"' : $v;
$c++;
print FD '$',$_->[0],' = ',$v,";\n";
$ins = 1;
last;
}
}
print FD $l unless $ins;
}
close(FS);
close(FD);
if ($c != scalar @config) {
#if (1) {
die "Could not find all hooks for setting default values in $fn.";
} else {
unlink("$fn");
rename("$fn.new","$fn");
}
}
sub opt_help
{
foreach (@config) {
my ($n);
$n = $_->[1] eq "b" ? "(no-)".$_->[0] : $_->[0];
print " --".$n."\t".$_->[3]."\n";
}
}
1;
scripts/arcx view on Meta::CPAN
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;
scripts/arcx view on Meta::CPAN
next;
}
verbout("Available SASL mechanisms return by the server: ",join(", ",@{$arc->{server_sasl_mechanisms}}));
last;
}
exit $retval;
sub showhelp
{
print <<EOT;
internal command for this client:
? 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
scripts/arcx view on Meta::CPAN
exit 1;
}
sub username
{
if (defined $args{U} && $args{U} ne "") {
return $args{U};
} elsif (defined $args{u}) {
print STDERR "Enter your username: "; return <STDIN>;
} else {
return $ENV{'USER'};
}
}
sub authname
{
if (defined $args{A} && $args{A} ne "") {
return $args{A};
} elsif (defined $args{a}) {
print STDERR "Enter your name for authorization: "; return <STDIN>;
} else {
return $ENV{'USER'};
}
}
sub password
{
if (defined $args{P} && $args{P} ne "") {
return $args{P};
} elsif (defined $args{p}) {
print STDERR "Enter your password: ";
ReadMode 2;
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;
scripts/arcx view on Meta::CPAN
}
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))];
scripts/arcxd view on Meta::CPAN
$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
-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
scripts/object.pl view on Meta::CPAN
showclass_members($base,0,0,"public");
showclass_members($base,0,0,"protected");
showclass_members($base,0,0,"private");
%ready = ();
podout("head1","Class METHODS");
showclass_methods($base,0,0,"public");
showclass_methods($base,0,0,"protected");
showclass_methods($base,0,0,"private");
print "\n";
sub access_level
{
$_ = $_[0];
if (/^__/) {
return "private";
} elsif (/^_/) {
return "protected";
} else {
return "public";
scripts/object.pl view on Meta::CPAN
foreach (split(/\s+/,$iter{$name})) {
showclass_members($_,$inl+1,1,$acc);
}
}
}
sub podout
{
my $h = shift;
print "\n=",$h," ",@_ ? join("",@_):"","\n";
}
sub textout
{
print "\n",@_,"\n";
}
sub verbout
{
# if ($args{v})
# print STDERR join(" ",@_),"\n";
}
if ($client->CommandEnd()) { ok(1); } else { ok(0); } #7
if ($client->CommandStart("whoami")) { ok(1); } else { ok(0); }
if ($s = $client->CommandRead()) { ok(1); } else { ok(0); }
if ($client->CommandEnd()) { ok(1); } else { ok(0); }
if ($client->CommandStart("uptime")) { ok(1); } else { ok(0); }
if ($s = $client->CommandRead()) { ok(1); } else { ok(0); }
if ($s =~ /load average/) { ok(1); } else { ok(0); }
if ($client->CommandEnd()) { ok(1); } else { ok(0); }
print $s;
if ($client->Quit()) { ok(1); } else { ok(0); }
kill 'INT', $pid;
wait();
} else {
ok(0);
}
ok(1);
( run in 1.033 second using v1.01-cache-2.11-cpan-de7293f3b23 )