#!/usr/local/bin/perl
#
# qradbserver.pl
# Routines to open, query, and close connections to a radbserver server.
#
# OpenConnection(host,port):  does just that, and sets it in multi-query mode
# CloseConnection(host,port): does just that
# AskServer(query,answer):
#   query   radbserver protocol query (eg eas233 to get as-in lines of AS233)
#   answer  array into which each line of answer can be places
#   return:  0  no error, data coming back
#           -1  some error (msg in answer[0]
#           -9  key not found
#            n  N from end-of-data line from radbserver (cnt of diffs across dbs)
#
# Notes:
# 1. In AskServer, I don't fork a child for the sending of the query
#    as they do in the Prog. Perl example client.
#    I wonder if that will get me into trouble?
# 2. See client.pl for example usage.
#
# ===> How should I pass the S and ConnectionOpen around, to keep
#      then hidden to all but these routines?
#       AND to make this recurrently re-entrant?  (which its not)
#      ==> Should explicitly pass a server name (eg S<n> supplied by caller?
#
#############################################################################

$ConnectionOpen = 0;		# used by OpenConnection
$Server = "S";
$qradbserverErrorReturn = -1;
$qradbserverNoKeyReturn = -9;
$qradbserverNoServer    = -99;

sub AskServer { 
    local($query,*Answer) = @_;
    local($r) = 0;
	@Answer = ();

	if ( !$query ) {
			push(@Answer,' Null answer for empty query.');
			print STDERR "\nOtherError: msg 'empty query'\n" if $opt_d;
			return $qradbserverErrorReturn;
	}
	print STDERR "Asking server $Server...\n" if $opt_d;
   	print $Server "$query\n";

   	while (<$Server>) {
   		chop;
		if ( /^B(.*)/ ) {		# data
			push(@Answer,$1);
			print STDERR "\nDataLine: $1\n" if $opt_d;
		}
		elsif ( /^A(.*)/ ) {	# data length--not needed
			print STDERR "\nDataLength line, len = $1\n" if $opt_d;
			next;
		}
   		elsif ( /^C(.*)/ ) {   	# end-of-data
   			$r = $1;			# return cnt of differences
			print STDERR "\nEOD: return $1.\n" if $opt_d;
   			last;
   		}
		elsif ( /^D(.*)/ ) {	# key not found
			$r = $qradbserverNoKeyReturn;
			push(@Answer,$1);
			print STDERR "\nKeyNotFound.\n" if $opt_d;
			last;
		}
		elsif ( /^E(.*)/ ) {	# multiple keys in one DB!
			$r = $qradbserverErrorReturn;
			push(@Answer,$1);
			last;
		}
		elsif ( /^F(.*)/ ) {	# other error
			$r = $qradbserverErrorReturn;
			push(@Answer,$1);
			print STDERR "\nOtherError: msg '$1'\n" if $opt_d;
			last;
		}
   	}

    return $r;
}

#
# AskServerOnce: open, ask, and close.
#                query should NOT have /n at end.
#                returns answer in an array WITH \n's.
#                   or error msg in $Answer[0].
#

sub AskServerOnce {
	local( $query, $host, $port, *Answer ) = @_;
	local( $r ) = 0;
	@Answer = ();

	if ( &OpenConnection($host,$port) < 0 ) {
		print STDERR "\nError: couldn't open server at host $host, port $port.\n" if $opt_d;
		return( $qradbserverNoServer );
	}
	if ( $r = &AskServer( $query, *Answer ) == $qradbserverErrorReturn ) {
		print STDERR "\nError from server:", join("\n",@Answer), "\n" if $opt_d;
	}
	elsif ( $r == $qradbserverNoKeyReturn ) {
		print STdERR "\nNothing found for that key.\n" if $opt_d;
	}
	else {
		print STDERR "Answer lines:\n", join("\n",@Answer), "\n" if $opt_d;
	}
	&CloseConnection( $host, $port );
	return $r;
} 

#
# OpenConnection: borrowed from client example in Prog. Perl book.
#

sub OpenConnection {
	local($host,$port) = @_;
	local($sockaddr,$name,$aliases,$type,$len,$that,$thataddr,$proto);
	local($thishostname,$this,$thisaddr);
	local( $AF_INET, $SOCK_STREAM ) = ( 2, 1 );

	if ( $ConnectionOpen ) {
		print STDERR "\nConnection already open---can't reopen!\n";
		return -1;
	}

	$sockaddr = 'S n a4 x8';
	chop($thishostname = `hostname`);
	$Server .= "$$";

	($name,$aliases,$proto) = getprotobyname('tcp');
	($name,$aliases,$proto) = getservbyname($port,'tcp') unless $port =~ /^\d+$/;;
	($name,$aliases,$type,$len,$thisaddr) = gethostbyname($thishostname);
	($name,$aliases,$type,$len,$thataddr) = gethostbyname($host);

	$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
	$that = pack($sockaddr, $AF_INET, $port, $thataddr);

	socket($Server,$AF_INET,$SOCK_STREAM,$proto) || die "socket: $!\n"; # Make the socket filehandle

	bind($Server, $this) || die "bind: $!\n";	        # Give the socket an address
	connect($Server,$that) || die "connect: $!\n";   	# Call up the server
	select($Server); $| = 1; select(STDOUT);          # set socket to be command buffered

	print $Server "!!\n";			# enter radbserver multi-query mode
	print STDERR "\nopened server named '$Server'.\n" if $opt_d;
	return 0;
}

sub CloseConnection {
	local($host,$port) = @_;
	print STDERR "Closing server $Server...\n" if $opt_d;
	print $Server "q\n\n";
	$ConnectionOpen = 0;
}

1;
