#!/usr/bin/perl
# 2007-09-26 tyler - see POD section at end of program for details

my $NAME='srrctl';
my $VERSION='0.31';
my $AUTHOR='Tyler J. Wagner <tyler@tolaris.com>';

use strict;

# includes
use Getopt::Long;
use Pod::Usage;
use IO::Socket;

# defaults
our $targettcpport = "9100";
our $targetaddress = "FF";
our ($setport, $getport, $debug, $target, $cmd);

# functions
sub app_options;
sub checksum;
sub srr_sendcmd;
sub srr_recvresponse;
sub srr_getport;
sub srr_setport;


##########################################################################
# begin main function
##########################################################################

# check program arguments
app_options();

# connect to SRR
our $socket = IO::Socket::INET->new(PeerAddr => "$target",
	PeerPort => "$targettcpport",
	Proto => 'tcp') or die "$@\n";

# convert -g or -s options to appropriate command
if ( defined $getport ) {
	$cmd="Q";
} elsif ( defined $setport ) {
	$cmd="S$setport";
}

srr_sendcmd($cmd);
print srr_recvresponse()."\n";

# tear down socket
$socket->shutdown(2);

# done
exit;

##########################################################################
# End main function
##########################################################################


##########################################################################
# Parses command-line arguments and sets related globals.
##########################################################################
sub app_options {
	my ($help, $man, $version);

	Getopt::Long::Configure ("bundling");
	GetOptions(
		'cmd|c=s'	=> \$cmd,
		'get|g!'		=>	\$getport,
		'set|s=i'	=>	\$setport,
		'port|p=i'	=> \$targettcpport,
		'address|a=i'	=> \$targetaddress,
		'debug|d!'	=>	\$debug,
		'help|h|?!'	=>	\$help,
		'man|m!'	=> \$man,
		'version|V!'	=> \$version)
		or pod2usage(-verbose => 1, -exitval => 1);

	# chatty output options
	if ( defined $help ) { pod2usage(-verbose => 1, -exitval => 0); }
	if ( defined $man ) { pod2usage(-verbose => 2, -exitval => 0); }
	if ( defined $version ) { warn "$NAME v$VERSION, by $AUTHOR\n"; exit; }

	# if no action defined, exit with error
   if ( ! defined $getport && ! defined $setport && ! defined $cmd ) {
		pod2usage(-verbose => 99,
			-sections => "SYNOPSIS",
			-message => "Error: you must use one of: -c, -g, -s, -h, -m, -V.\n");
	}

	# if more than one action defined, exit with error
   if ((defined $cmd && (defined $getport || defined $setport)) || defined $getport && defined $setport ) {
		pod2usage(-verbose => 99,
			-sections => "SYNOPSIS",
			-message => "Error: you must use only one of: -c, -g, -s.\n");
	}

	# if no target, exit with error
	if ( ! @ARGV ) { 
		pod2usage(-verbose => 99,
			-sections => "SYNOPSIS",
			-message => "Error: you must specify a target.\n");
	}
   $target = shift(@ARGV);

	if ( defined $debug ) {
		if ( defined $getport ) { print("Getting port.\n"); }
		if ( defined $setport ) { print("Setting port to $setport.\n"); }
		print("Target is $target on $targettcpport/tcp.\n");
		print("Using serial address $targetaddress.\n");
	}

}

##########################################################################
# Return a checksum byte.  This is a bitwise XOR of all the bytes in
# the message, from the header to the ETX.
##########################################################################
sub checksum {
	my $string = shift(@_);
	my ($sum, $char);
	foreach $char (split(//, $string)) {
		$sum = $char ^ $sum;
	}
	return $sum;
}

##########################################################################
# Sends command to SRR
##########################################################################
sub srr_sendcmd {
	my $instruction = shift(@_);
	$debug && print "Sending command $instruction\n";
   my $mesg = sprintf("%c%s%s%c",2,"$targetaddress","$instruction",3);
	$mesg .= checksum($mesg);
   print $socket $mesg;
}

##########################################################################
# Receives a response from SRR
##########################################################################
sub srr_recvresponse {
	my ($mesg,$char);
	my ($ack,$nack);
	$debug && print "Received: ";

	$socket->read($char,1);
	$debug && print unpack("H*",$char)." ";

	# read first byte - ACK, NACK, or error
	if (ord($char) == 0x06) { $ack = 1; }
	elsif (ord($char) == 0x15) { $nack = 1; }
	else {
		printf("Bad response byte from SRR!\n");
		exit 1;
	}

	# read serial address and ignore it
	$socket->read($char,2);
	$debug && print unpack("H*",$char)." ";

	# read up to ETX command
  	$socket->read($char,1);
	while (ord($char) != 0x3) {
		$debug && print unpack("H*",$char)." ";
      $mesg .= $char;
   	$socket->read($char,1);
   }
	$debug && print unpack("H*",$char)." ";
   
	# read checksum
  	$socket->read($char,1);
	$debug && print unpack("H*",$char)."\n";

	# return only content of reply
	return $mesg;
}

##########################################################################
# Gets current port
##########################################################################
sub srr_getport {
   return srr_sendcmd("Q");
}

##########################################################################
# Sets current port
##########################################################################
sub srr_setport {
	my $newport = shift(@_);
   return srr_sendcmd("S$newport");
}

__END__

##########################################################################
# POD section
##########################################################################

=head1 NAME

srrctl - Control a Quintech SRR-series L-band switch.


=head1 SYNOPSIS

srrctl [options] target

=head1 DESCRIPTION

The Quintech SRR Series L-band switch can be managed using Quintech's custom TCP-based protocol.  Most commonly, this is used to report or change the L-band monitor port. This tool implements this protocol in perl.

=head1 OPTIONS

 -c, --cmd <CMD>	command to send
 -g, --get		get monitor port (same as -c 'Q')
 -s, --set <NUM>	set monitor port (same as -c 'S<NUM>')
 -p, --port <NUM>	set TCP port (default 9100)
 -a, --address <00-FF>	set Quintech serial address (default FF)
 -d, --debug		enable debug output
 -h, --help		brief help message
 -m, --man		show man page
 -V, --version		show program version

=head1 ARGUMENTS

target - hostname or IP of Quintech SRR-series L-band switch

=head1 EXAMPLES

srrctl -g 192.168.0.1

   Display current monitor port of Quintech SRR switch at 192.168.0.1.

srrctl -s 1 192.168.0.1

   Set monitor port of Quintech SRR switch at 192.168.0.1 to port 1.

=head1 REQUIRES

Perl 5.004, Getopt::Long, Pod::Usage, IO::Socket

=head1 AUTHOR

Tyler J. Wagner <tyler@tolaris.com>

=head1 ACKNOWLEDGEMENTS

Quintech provides a complete documentation of the protocol used by this tool in "Quintech SRR Series Protocol v1.21", available online in PDF form from Quintech's website:

http://www.quintechelectronics.com/srr2150-l-band-router.php

The author would like to thank Quintech for their assistance in providing documentation of the SRR protocol.

=cut