#!/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 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 one parameter indicating the callsign 
# that the station connecting should show up with. By default it's
# your node's callsign with the -16 SSID.
#
# 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
# conn_ping:     no              # periodic link check
# mail_fwd:      no              # mail forwarding
#
# Last Change: DL6RAI Thu Aug 17 18:12:32 GMT 2000

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

use constant MAXLEN => 8192;

$mycall = shift;   # default callsign for user

$quiet = 1; # for debugging
open(STDERR,"> /tmp/ct_server.err");

$ppid = `cat /proc/$$/status | awk '/PPid/ {print \$2}'`;
chop($ppid);
$caller = `cat /proc/$ppid/status | awk '/Name/  {print \$2}'`;
chop($caller);

#$is_a_tty = system("tty -s");
if ($caller ne "con_ctl") {
	open(OUT,">-");
} else {
	open(OUT,"> /dev/null");
	$mycall = shift;
}

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

# set up the UDP socket
$proto = getprotobyname('udp');
chop($hostname = `/bin/hostname`);
$iaddr = gethostbyname($hostname);
$port = 9870;
$paddr = sockaddr_in($port, $iaddr);

# figure out the broadcast address - this could be improved, but I
# am assuming class C network at this time.
@iaddr=unpack("C4",$iaddr);
pop(@iaddr); push(@iaddr,255);
$bcast = join(".",@iaddr);
print "BCAST: $bcast\n" if ! $quiet;
$destiaddr = inet_aton($bcast);
$destpaddr = sockaddr_in($port,$destiaddr);

# create the socket
my $S = IO::Socket::INET->new(  PeerAdr   => $bcast,
				Proto     => 'udp',
                                Type      => SOCK_DGRAM,
                                LocalPort => $port
                                ) || die "can't make socket: $!";
$S->setsockopt(SOL_SOCKET,SO_BROADCAST,1);

$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 (udp_tx $bcast:$port)";
	$SIG{TERM} = sub { kill 'TERM',$child ; exit };
	$SIG{CHLD} = sub { kill 'TERM',$child ; exit };

	while (<$in>) {

		chop;

		$raw_data = $_;
		$stn_nr = 0;
		$data = 'B0' . $raw_data;
		$checksum = unpack("%32C*",$data);
		$checksum |= 0x80;
		$checksum &= 0xFF;
		$data .= chr($checksum) . "\n";
		print "SEND: $data" if ! $quiet;

		send($S,$data,0,$destpaddr) || 
			kill 'TERM',$child && die "send(): $!";
		print OUT "  <- ($stn_nr): $raw_data\n";
	}

	kill 'TERM',$child;
	close(STDERR);
}

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

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) = @_;
	$0 = "ct_server (udp_rx $port)";

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

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

	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 -> $new_time"; }
				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:
		}
	}
}

__END__
