view release on metacpan or  search on metacpan

scripts/arcx  view on Meta::CPAN

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,
		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()) {
				$_ = $term->readline("ARC> ");
				last unless defined $_;
				next unless $_;

				last if ($_ eq "\\q");

				if ($_ eq "?") {
					showhelp();
					next;
				}
				addhistoryfile($_);
				while (!$arc->ProcessCommand($_)) {
					err($arc->IsError());