view release on metacpan or  search on metacpan

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;

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},