#!/usr/bin/perl
#
# This program works like a remote TNC for K1EA's Contest Software CT 
# when using Ethernet networking  la K1TTT. It opens a UDP socket
# for transmitting and receiving A and B type packets which - in the 
# CT network protocol - are traffic packets to and from the remote TNC.
#
# A second process is forked for the RX job while the main program
# keeps going with the TX task.
#
# RX means: take anything sent from CT packet terminal input window
# and send it to the net_usr process
#
# TX means: take anything that comes down the net_usr stream and
# send it out to the CT network. This program works as CT station
# number zero which is tolerated by the CT software obviously.
#
# This program is run as a connect script. Configure this in your
# ~/config/cluster_par file as a passive user link connection,
# using x as the connect interface, ct_server as the
# connect path, user as the connect protocol
#
# Additionally you may specify some parameters:
# 1.  indicating the callsign that the station connecting should 
#     show up with. By default it's your node's callsign with 
#     the -16 SSID.
# 2.  The Ethernet interface to be used. By default it's eth0.
# 3.  The Netmask to be used. By default, it's taken from the 
#     configuration parameter set for eth0.
# 4.  UDP-Port address to be used. Normaly, 9870 is the default
#     port used by K1TTT's nettsr.
#
# Here is an example
# SECTION:       cn8ww           	# partner call
# conn_int:      x               	# ax25/wampes/script
# conn_act:      passive         	# active/passive
# conn_type:     clx             	# partner type
# conn_prot:     user            	# protocol type
# conn_path:     ct_server cn8ww-3	# script name + parms
# conn_ping:     no              	# periodic link check
# mail_fwd:      no              	# mail forwarding
#
# Last Change: DL6RAI Sun Aug 20 21:03:23 GMT 2000

use IO::Socket;
use FileHandle;
use IPC::Open2;
use Time::localtime;

$quiet = 1; # for debugging

use constant MAXLEN => 8192;

#open(STDERR,"> /tmp/ct_server.err");

# Try to find my parent process' name
$ppid = `cat /proc/$$/status | awk '/PPid/ {print \$2}'`;
chop($ppid);
$caller = `cat /proc/$ppid/status | awk '/Name/  {print \$2}'`;
chop($caller);

# If this script is called interactively, it should print it's
# debug output to the terminal. If it's called by CLX, it should
# be quiet in order not to produce error messages in the log.
# Note:
# a) When called from the command line, first parameter is the login call. 
# b) When called from within con_ctl, first parameter is the node call, 
# second is (optionally) the login call.

$default_mycall = 'xx0xx-16';
$nodecall = 'CLX'; # default value

if ($caller ne "con_ctl") {
	open(OUT,">-");
} else {
	open(OUT,"> /dev/null");

	# and here we get a little more information:
	# Outgoing Node call is passed as a command line parameter from con_ctl
	$nodecall = shift; 	   # node call or outgoing call is sent first
	$nodecall = uc($nodecall); # looks nicer

	# A line containing "connect ax25 <destination>" is sent 
	# from con_ctl on STDIN
	$line = <STDIN>;
	# print STDERR "Line from con_ctl: $line\n";
	chop($line);
	$dnode_call = (split(' ',$line))[2];
	$dnode_call =~ s/-[0-9]+$//; # strip SSID

	# From that we can deduct a new default_mycall should nothing
	# else be specified in the cluster_par file
	$default_mycall = $dnode_call;
	$default_mycall =~ s/-[0-9]+$//; # strip SSID 
	$default_mycall =~ s/$/-16/; 	# and replace by -16
}

$mycall = shift || $default_mycall;	# we need a callsign
$ether = shift  || 'eth0'; 		# the default Ethernet device
$netmask = shift  || '255.255.255.0'; 	# last resort
$port = shift || '9870';		# Depends on your nettsr settings
$stn_nr = 0;				# CT Station number, no need to change

# get my own IP address and figure out the broadcast address
$n = `/sbin/ifconfig $ether`;
@a = split(' ',$n);
foreach (@a) {
	if (/^Mask:/) {
		$netmask = (split(':'))[1];
		$netmask = inet_aton($netmask);
	}
	if (/^addr:/) {
		$iaddr = (split(':'))[1];
		$iaddr = inet_aton($iaddr);
	}
}

# This is  the golden formula to calculate Broadcast address
# from my IP address plus netmask.
$bcast = "$iaddr" | ~ "$netmask"; # (my IP address) OR (NOT NETMASK)
$destpaddr = sockaddr_in($port,$bcast);

printf "BCAST: %s (%d)\n",aton_inet($bcast),length($bcast) if ! $quiet;


# print STDERR join(",",@ARGV),"\n";
# print STDERR "nodecall: $nodecall\n";
# print STDERR "mycall: $mycall\n";
# close(STDERR);

# The following statements are for opening a bidirectional pipe
# to net_usr.
$in  = 0;
$out = 0;
$net_usr_pid = open2(*in,*out,"/usr/local/clx/bin/net_usr $mycall") 
	|| die "Cannot open2() $!";
*out->autoflush();
$tx_ct_server_pid = $$;

# set up the UDP socket
my $S = IO::Socket::INET->new(  PeerAdr   => "aton_inet($bcast)",
				Proto     => 'udp',
                                Type      => SOCK_DGRAM,
                                LocalPort => $port
                                ) || die "can't make socket: $!";
$S->setsockopt(SOL_SOCKET,SO_BROADCAST,1);
ct_send($S,$destpaddr,"*** connected to $nodecall by ct_server");

$child = fork();
die "Can't fork: $!" unless defined $child;

tx_data($S,*in)         if $child;
rx_data($S,*out)    unless $child;
close $S;

# -----------------------------------------------------------------------

sub tx_data {

# this is the main program loop - broadcast anything that comes from
# net_usr back into the ethernet.

	print "TX started to $destpaddr\n" if ! $quiet;

	my($S,$in) = @_;
	$0 = "ct_server (TX " . aton_inet($bcast) . ":$port)";
	syslog("$0 up (PID=$tx_ct_server_pid).");

	$SIG{TERM} = \&cleanup;
	$SIG{INT} = \&cleanup;
	$SIG{QUIT} = \&cleanup;
	$SIG{CHLD} = \&cleanup;

	while (<$in>) {

		chop;

		$raw_data = $_;
#		$stn_nr = 0;
#		$data = 'B0' . $raw_data;
#		$checksum = unpack("%32C*",$data);
#		$checksum |= 0x80;
#		$checksum &= 0xFF;
#		$data .= chr($checksum) . "\n";
#		send($S,$data,0,$destpaddr) || 
#			kill 'TERM',$child,$net_usr_pid && die "send(): $!";

		print "SEND: $data" if ! $quiet;

		ct_send($S,$destpaddr,$raw_data) || 
			cleanup;
	
		print OUT "  <- ($stn_nr): $raw_data\n";
	}

	cleanup;
}

# -----------------------------------------------------------------------

sub rx_data {

# this is the child program loop - wait for data sent from the CT
# terminal and pass them on to net_usr

	my($S,$out) = @_;

	%blist = (1,160,2,80,3,40,4,20,5,15,6,10);
	%mlist = (1,'CW',2,'SSB');

	$0 = "ct_server (RX *:"  . $port . ")";
	$SIG{ALRM} = \&main::check_status;

	$rx_ct_server_pid = $$;
	syslog("$0 up (PID=$rx_ct_server_pid).");

	print "RX on $S started\n" if ! $quiet;

	&main::check_status(); # set alarm timer first time
	while(1) {
		$sender = recv($S,$data,MAXLEN,0) || die "recv(): $!";
		($remote_port,$remote_host) = sockaddr_in($sender);
		$remote_host = inet_ntoa($remote_host);
		warn "Received ",length($data),
			" bytes from [$remote_host,$remote_port]\n" if ! $quiet;
		chomp($data);
		# warn "Received: >>$data<<\n";

		$checksum = ord(substr($data,-1));
		$data = substr($data,0,-1);
		$stn_nr = substr($data,1,1);

		$c_checksum = unpack("%32C*",$data);
		$c_checksum |= 0x80;
		$c_checksum &= 0xFF;
		if ( $c_checksum ne $checksum ) {
			print "Network received bad checksum\n" if ! $quiet;
		} else {
			$stn_nr = ord(substr($data,1,1))-48;
			printf("Stn %02d: ",$stn_nr) if ! $quiet;

			if ($data =~ /^A.*/) {
				$data = substr($data,2);
				print $out "$data\n";
				print OUT "  -> ($stn_nr): $data\n";
				goto DONE;
			}

			if ($data =~ /^B.*/) {
				$data = substr($data,2);
				# print OUT "<CLX: $data\n";
				# We copy our own signal anyway
				goto DONE;
			}

			if ($data =~ /^C.*/) {
				$data = substr($data,2);
				($rcvd_rst,$freq_a,$freq_b,$time,$status,
				$band_nr,$mode_nr,$call,$info,$qtc_num,$stn_num,
				$serial_num) = split(' ',$data);
        			$time_str = ctime($time);
				$band = $blist{$band_nr};
				$mode = $mlist{$mode_nr};
				print OUT "BMAP ($stn_nr): $time_str $call $band $freq_a $freq_b\n";
			}

			if ($data =~ /^E.*/) {
				$data = substr($data,2);
				($serial_num,$band,$time_str,$call,$note) 
					= split(' ',$data,5);
				print OUT "NOTE ($stn_nr): $serial_num $band $time_str $call $note\n";
			}

			if ($data =~ /^T.*/) {
				$data = substr($data,3);
				print OUT " GAB ($stn_nr): $data\n";
				goto DONE;
			}

			if ($data =~ /^Y.*/) {
				$data = substr($data,2);
				($hour,$min,$sec,$day,$month,$year) = 
					split(' ',$data);
				$time_str = sprintf("%02d-%02d-%04d %02d:%02d:%02d",$day,$month,$year,$hour,$min,$sec);
				print OUT "TIME ($stn_nr): $time_str\n";
				goto DONE;
			}

			if ($data =~ /^L.*/) {
				$data = substr($data,2);
				($rcvd_rst,$freq_a,$freq_b,$time,$status,
				$band_nr,$mode_nr,$call,$info,$qtc_num,$stn_num,
				$serial_num) = split(' ',$data);
        			$time_str = ctime($time);
				$band = $blist{$band_nr};
				$mode = $mlist{$mode_nr};
				print OUT " QSO ($stn_nr): $time_str $call $band $mode $info\n";
			}

			if ($data =~ /^M.*/) {
				$data = substr($data,3);
				print OUT "FREQ ($stn_nr): $data\n";
				goto DONE;
			}

			if ($data =~ /^U.*/) {
				$data = substr($data,2);
				($new_rcvd_rst,$new_freq_a,$new_freq_b,$new_time,$new_status,
				 $new_band_nr,$new_mode_nr,$new_call,$new_info,$new_qtc_num,$new_stn_num,
				 $new_serial_num,
				 $old_rcvd_rst,$old_freq_a,$old_freq_b,$old_time,$old_status,
				 $old_band_nr,$old_mode_nr,$old_call,$old_info,$old_qtc_num,$old_stn_num,
				 $old_serial_num) = split(' ',$data);
        			$new_time_str = ctime($new_time);
        			$old_time_str = ctime($old_time);
				$new_band = $blist{$new_band_nr};
				$old_band = $blist{$old_band_nr};
				$new_mode = $mlist{$new_mode_nr};
				$old_mode = $mlist{$old_mode_nr};
				print OUT " UPD ($stn_nr):";
				if ( $old_rcvd_rst ne $new_rcvd_rst ) { print OUT " RST $old_rcvd_rst -> $new_rcvd_rst"; }
				if ( $old_freq_a ne $new_freq_a ) { print OUT " FREQA $old_freq_a -> $new_freq_a"; }
				if ( $old_freq_b ne $new_freq_b ) { print OUT " FREQB $old_freq_b -> $new_freq_b"; }
				if ( $old_time ne $new_time ) { print OUT " TIME $old_time_str -> $new_time_str"; }
				if ( $old_status ne $new_status ) { print OUT " STATUS $old_status -> $new_status"; }
				if ( $old_band ne $new_band ) { print OUT " BAND $old_band -> $new_band"; }
				if ( $old_mode ne $new_mode ) { print OUT " MODE $old_mode -> $new_mode"; }
				if ( $old_call ne $new_call ) { print OUT " CALL $old_call -> $new_call"; }
				if ( $old_info ne $new_info ) { print OUT " INFO $old_info -> $new_info"; }
				if ( $old_qtc_num ne $new_qtc_num ) { print OUT " QTC-NUMBER $old_qtc_num -> $new_qtc_num"; }
				if ( $old_stn_num ne $new_stn_num ) { print OUT " STN-NUMBER $old_stn_num -> $new_stn_num"; }
				if ( $old_serial_num ne $new_serial_num ) { print OUT " SER-NUMBER $old_serial_num -> $new_serial_num"; }
				print OUT "\n";
			}


			DONE:
		}
	}
}

# -----------------------------------------------------------------------

sub aton_inet {
	my ($addr) = @_;
	@addr = unpack("C4",$addr);
	my $aton = sprintf("%d.%d.%d.%d",@addr);
	return $aton;
}

sub ct_send {
	my ($S,$destpaddr,$raw_data) = @_;
	my $data = 'B0' . $raw_data;
	my $checksum = unpack("%32C*",$data);
	$checksum |= 0x80;
	$checksum &= 0xFF;
	$data .= chr($checksum) . "\n";
	return send($S,$data,0,$destpaddr);
}

sub cleanup {

	ct_send($S,$destpaddr,"*** disconnected from $nodecall");
	kill 'TERM',$child if $child;
	kill 'TERM',$net_usr_pid if $net_usr_pid;
	kill 'TERM',$tx_server_pid if $tx_server_pid;
	kill 'TERM',$rx_server_pid if $rx_server_pid;
	exit;
}

sub syslog {
	my ($msg) = @_;
	system("logger -t ct_server -p local5.info \"$msg\"");
}

sub check_status {
	# Watchdog - if one of the processes is gone, kill the rest
	# so that everything can go back up.
	my $fail = 0;
	if ( ! -d "/proc/$tx_ct_server_pid" ) {
		$fail = 1;
	}
	if ( ! -d "/proc/$net_usr_pid" ) {
		$fail =+ 2;
	}
	if ( ! -d "/proc/$rx_ct_server_pid" ) {
		$fail =+ 4;
	}

	if ( $fail ) {
		syslog("check_status status: $fail - killing PIDs $tx_ct_server_pid $net_usr_pid $rx_ct_server_pid\n");
		cleanup();
	} else {
		alarm 5; # set next alarm
	}
}

__END__
