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},
		loglevel=> $args{l},
		logdestination => $args{L},
		service => $args{S},
		sasl_mechanism => $args{s},
		sasl_cb_user => \&username,

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;

	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);
	}
}