From: djk <djk>
Date: Sat, 28 Nov 1998 00:26:36 +0000 (+0000)
Subject: release 1.5
X-Git-Tag: SPIDER_1_5~11
X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=b060a0a3ee72530aa3f10d453186a662b66d7efe

release 1.5
loads of fixes, but can now connect outbound, do logging, more messages
remote commands for outside now work
---

diff --git a/cmd/Aliases b/cmd/Aliases
index f83d2641..6089171f 100644
--- a/cmd/Aliases
+++ b/cmd/Aliases
@@ -33,13 +33,13 @@ package CmdAlias;
 	],
 	d => [
 	  '^del', 'kill', 'kill',
-	  '^di.*/all', 'directory all', 'directory',
-	  '^di.*/b.*', 'directory bulletins', 'directory',
-	  '^di.*/n.*', 'directory new', 'directory',
-	  '^di.*/o.*', 'directory own', 'directory',
-	  '^di.*/s.*', 'directory subject', 'directory',
-	  '^di.*/(\d+)-(\d+)', 'directory $1-$2', 'directory',
-	  '^di.*/(\d+)', 'directory $1', 'directory',
+	  '^di\w*/a\w*', 'directory all', 'directory',
+	  '^di\w*/b\w*', 'directory bulletins', 'directory',
+	  '^di\w*/n\w*', 'directory new', 'directory',
+	  '^di\w*/o\w*', 'directory own', 'directory',
+	  '^di\w*/s\w*', 'directory subject', 'directory',
+	  '^di\w*/(\d+)-(\d+)', 'directory $1-$2', 'directory',
+	  '^di\w*/(\d+)', 'directory $1', 'directory',
 	],
 	e => [
 	],
diff --git a/cmd/debug.pl b/cmd/debug.pl
index 608f1daf..9b71d53c 100644
--- a/cmd/debug.pl
+++ b/cmd/debug.pl
@@ -9,7 +9,7 @@
 #
 
 my $self = shift;
-return if $self->priv < 9;
+return (0) if $self->priv < 9;
 
 $DB::single = 1;
 
diff --git a/cmd/dx.pl b/cmd/dx.pl
index fdd07bf3..394cb7ab 100644
--- a/cmd/dx.pl
+++ b/cmd/dx.pl
@@ -28,14 +28,12 @@ if ($f[0] =~ /[A-Za-z]/) {
   $line =~ s/^$f[0]\s+$f[1]\s*//;
 }
 
-# check the freq, if the number is < 1800 it is in Mhz (probably)
-$freq = $freq * 1000 if $freq < 1800;
-
 # bash down the list of bands until a valid one is reached
 my $bandref;
 my @bb;
 my $i;
 
+# first in KHz
 L1:
 foreach $bandref (Bands::get_all()) {
   @bb = @{$bandref->band};
@@ -47,11 +45,31 @@ foreach $bandref (Bands::get_all()) {
   }
 }
 
-push @out, "Frequency $freq not in band [usage: DX freq call comments]" if !$valid;
+if (!$valid) {
+
+	# try again in MHZ 
+	$freq = $freq * 1000 if $freq;
+
+L2:
+    foreach $bandref (Bands::get_all()) {
+		@bb = @{$bandref->band};
+		for ($i = 0; $i < @bb; $i += 2) {
+			if ($freq >= $bb[$i] && $freq <= $bb[$i+1]) {
+				$valid = 1;
+				last L2;
+			}
+		}
+	}
+}
+
+
+
+push @out, $self->msg('dx1', $freq) if !$valid;
 
 # check we have a callsign :-)
 if ($spotted le ' ') {
-  push @out, "Need a callsign for the spot [usage: DX freq call comments]" ;
+	push @out, $self->msg('dx2');
+	
   $valid = 0;
 }
 
diff --git a/cmd/kill.pl b/cmd/kill.pl
index d3de0beb..b6d193fe 100644
--- a/cmd/kill.pl
+++ b/cmd/kill.pl
@@ -12,6 +12,7 @@ my $msgno;
 my @out;
 my @body;
 my $ref;
+my $call = $self->call;
 
 # $DB::single = 1;
 
@@ -27,6 +28,7 @@ for $msgno (@f) {
     push @out, "Msg $msgno not available";
 	next;
   } 
+  Log('msg', "Message $ref->{msgno} from $ref->{from} to $ref->{to} deleted by $call");
   $ref->del_msg;
   push @out, "Message $msgno deleted";
 }
diff --git a/cmd/reply.pl b/cmd/reply.pl
index c655b505..ce9d6916 100644
--- a/cmd/reply.pl
+++ b/cmd/reply.pl
@@ -67,7 +67,7 @@ if ($self->state eq "prompt") {
   my $to = $oref->from;
   $loc->{to} = [ $to ];       # to is an array
   $loc->{subject} = $oref->subject;
-  $loc->{subject} = "Re: " . $loc->{subject} if !($loc->{subject} =~ /^Re/io); 
+  $loc->{subject} = "Re: " . $loc->{subject} if !($loc->{subject} =~ /^Re:.\s/io); 
 
   # find me and set the state and the function on my state variable to
   # keep calling me for every line until I relinquish control
diff --git a/cmd/set/address.pl b/cmd/set/address.pl
index f31a982e..15e42579 100644
--- a/cmd/set/address.pl
+++ b/cmd/set/address.pl
@@ -23,6 +23,6 @@ if ($self->priv >= 5) {             # allow a callsign as first arg
 }
 
 $user->addr($line);
-push @out, DXM::msg('addr', $call, $line);
+push @out, $self->msg('addr', $call, $line);
 
 return (1, @out);
diff --git a/cmd/set/dx.pl b/cmd/set/dx.pl
index 0acb39db..0edf6d54 100644
--- a/cmd/set/dx.pl
+++ b/cmd/set/dx.pl
@@ -18,9 +18,9 @@ foreach $call (@args) {
   my $chan = DXChannel->get($call);
   if ($chan) {
     $chan->dx(1);
-	push @out, DXM::msg('dxs', $call);
+	push @out, $self->msg('dxs', $call);
   } else {
-    push @out, DXM::msg('e3', "Set DX Spots", $call);
+    push @out, $self->msg('e3', "Set DX Spots", $call);
   }
 }
 return (1, @out);
diff --git a/cmd/set/here.pl b/cmd/set/here.pl
index aad69d02..136700f5 100644
--- a/cmd/set/here.pl
+++ b/cmd/set/here.pl
@@ -19,9 +19,9 @@ foreach $call (@args) {
   if ($ref) {
     $ref->here(1);
 	DXProt::broadcast_ak1a(DXProt::pc24($ref));
-	push @out, DXM::msg('heres', $call);
+	push @out, $self->msg('heres', $call);
   } else {
-    push @out, DXM::msg('e3', "Set Here", $call);
+    push @out, $self->msg('e3', "Set Here", $call);
   }
 }
 
diff --git a/cmd/set/node.pl b/cmd/set/node.pl
index 78baa189..fa0cf800 100644
--- a/cmd/set/node.pl
+++ b/cmd/set/node.pl
@@ -20,15 +20,15 @@ foreach $call (@args) {
   $call = uc $call;
   my $chan = DXChannel->get($call);
   if ($chan) {
-	push @out, DXM::msg('nodee1', $call);
+	push @out, $self->msg('nodee1', $call);
   } else {
     $user = DXUser->get($call);
 	if ($user) {
 	  $user->sort('A');
 	  $user->close();
-      push @out, DXM::msg('node', $call);
+      push @out, $self->msg('node', $call);
 	} else {
-      push @out, DXM::msg('e3', "Set Node", $call);
+      push @out, $self->msg('e3', "Set Node", $call);
 	}
   }
 }
diff --git a/cmd/set/privilege.pl b/cmd/set/privilege.pl
index 87be2aa8..2513f85b 100644
--- a/cmd/set/privilege.pl
+++ b/cmd/set/privilege.pl
@@ -13,8 +13,7 @@ my $call;
 my $priv = shift @args;
 my @out;
 my $user;
-
-$DB::single = 1;
+my $ref;
 
 return (0) if $self->priv < 9;
 
@@ -23,14 +22,20 @@ if ($priv < 0 || $priv > 9) {
 }
 
 foreach $call (@args) {
-  $call = uc $call;
-  my $user = DXUser->get_current($call);
-  if ($user) {
-    $user->priv($priv);
-	$user->put();
-    push @out, $self->msg('priv', $call);
-  } else {
-    push @out, $self->msg('e3', "Set Privilege", $call);
-  }
+	$call = uc $call;
+	if ($ref = DXChannel->get($call)) {
+		$ref->priv($priv);
+		$ref->user->priv($priv);
+		$ref->user->put();
+	}
+	if (!$ref && ($user = DXUser->get($call))) {
+		$user->priv($priv);
+		$user->put();
+	}
+	if ($ref || $user) {
+		push @out, $self->msg('priv', $call);
+	} else {
+		push @out, $self->msg('e3', "Set Privilege", $call);
+	}
 }
 return (1, @out);
diff --git a/cmd/set/talk.pl b/cmd/set/talk.pl
index 85b66c04..f24ede71 100644
--- a/cmd/set/talk.pl
+++ b/cmd/set/talk.pl
@@ -18,9 +18,9 @@ foreach $call (@args) {
   my $chan = DXChannel->get($call);
   if ($chan) {
     $chan->talk(1);
-	push @out, DXM::msg('talks', $call);
+	push @out, $self->msg('talks', $call);
   } else {
-    push @out, DXM::msg('e3', "Set Talk", $call);
+    push @out, $self->msg('e3', "Set Talk", $call);
   }
 }
 return (1, @out);
diff --git a/cmd/set/wwv.pl b/cmd/set/wwv.pl
index bfa04f25..701a385c 100644
--- a/cmd/set/wwv.pl
+++ b/cmd/set/wwv.pl
@@ -18,9 +18,9 @@ foreach $call (@args) {
   my $chan = DXChannel->get($call);
   if ($chan) {
     $chan->wwv(1);
-	push @out, DXM::msg('wwvs', $call);
+	push @out, $self->msg('wwvs', $call);
   } else {
-    push @out, DXM::msg('e3', "Set WWV", $call);
+    push @out, $self->msg('e3', "Set WWV", $call);
   }
 }
 return (1, @out);
diff --git a/cmd/shutdown.pl b/cmd/shutdown.pl
index 43b6fb75..c2350de0 100644
--- a/cmd/shutdown.pl
+++ b/cmd/shutdown.pl
@@ -4,7 +4,17 @@
 # $Id$
 #
 my $self = shift;
+my $call = $self->call;
+my $ref;
+
 if ($self->priv >= 5) {
-  &main::cease();
+	foreach $ref (DXChannel::get_all()) {
+		$ref->send_now("D", DXProt::pc39($main::mycall, "Shutdown by $call")) 
+			if $ref->is_ak1a  && $ref != $DXProt::me; 
+		$ref->send_now("D", $self->msg('shutting')) if $ref->is_user;
+	}
+    
+    # give some time for the buffers to empty and then shutdown (see cluster.pl)
+	$main::decease = 250;
 }
-return (0);
+return (1);
diff --git a/cmd/unset/announce.pl b/cmd/unset/announce.pl
index cf750e25..9c6e9a9a 100644
--- a/cmd/unset/announce.pl
+++ b/cmd/unset/announce.pl
@@ -18,9 +18,9 @@ foreach $call (@args) {
   my $user = ($call eq $self->call) ? $self->user :  DXUser->get($call);
   if ($user) {
     $user->ann(0);
-	push @out, DXM::msg('annu', $call);
+	push @out, $self->msg('annu', $call);
   } else {
-    push @out, DXM::msg('e3', "Unset Announce", $call);
+    push @out, $self->msg('e3', "Unset Announce", $call);
   }
 }
 return (1, @out);
diff --git a/cmd/unset/dx.pl b/cmd/unset/dx.pl
index 0ae6cc97..b1cf46ec 100644
--- a/cmd/unset/dx.pl
+++ b/cmd/unset/dx.pl
@@ -18,9 +18,9 @@ foreach $call (@args) {
   my $user = ($call eq $self->call) ? $self->user : DXUser->get($call);
   if ($user) {
     $user->dx(0);
-	push @out, DXM::msg('dxu', $call);
+	push @out, $self->msg('dxu', $call);
   } else {
-    push @out, DXM::msg('e3', "Unset DX Spots", $call);
+    push @out, $self->msg('e3', "Unset DX Spots", $call);
   }
 }
 return (1, @out);
diff --git a/cmd/unset/here.pl b/cmd/unset/here.pl
index 7311b5e8..48dbae2c 100644
--- a/cmd/unset/here.pl
+++ b/cmd/unset/here.pl
@@ -19,9 +19,9 @@ foreach $call (@args) {
   if ($ref) {
     $ref->here(0);
 	DXProt::broadcast_ak1a(DXProt::pc24($ref));
-	push @out, DXM::msg('hereu', $call);
+	push @out, $self->msg('hereu', $call);
   } else {
-    push @out, DXM::msg('e3', "Unset Here", $call);
+    push @out, $self->msg('e3', "Unset Here", $call);
   }
 }
 return (1, @out);
diff --git a/cmd/unset/talk.pl b/cmd/unset/talk.pl
index a3df8fa1..7b119c10 100644
--- a/cmd/unset/talk.pl
+++ b/cmd/unset/talk.pl
@@ -18,9 +18,9 @@ foreach $call (@args) {
   my $user = ($call eq $self->call) ? $self->user :  DXUser->get($call);
   if ($user) {
     $user->talk(0);
-	push @out, DXM::msg('talku', $call);
+	push @out, $self->msg('talku', $call);
   } else {
-    push @out, DXM::msg('e3', "Unset Talk", $call);
+    push @out, $self->msg('e3', "Unset Talk", $call);
   }
 }
 return (1, @out);
diff --git a/cmd/unset/wwv.pl b/cmd/unset/wwv.pl
index 6495235f..e7c2286a 100644
--- a/cmd/unset/wwv.pl
+++ b/cmd/unset/wwv.pl
@@ -18,9 +18,9 @@ foreach $call (@args) {
   my $user = ($call eq $self->call) ? $self->user : DXUser->get($call);
   if ($user) {
     $user->wwv(0);
-	push @out, DXM::msg('wwvu', $call);
+	push @out, $self->msg('wwvu', $call);
   } else {
-    push @out, DXM::msg('e3', "Unset WWV", $call);
+    push @out, $self->msg('e3', "Unset WWV", $call);
   }
 }
 return (1, @out);
diff --git a/connect/gb7tlh b/connect/gb7tlh
index 8cd7be8d..a844b21d 100644
--- a/connect/gb7tlh
+++ b/connect/gb7tlh
@@ -1,5 +1,6 @@
 timeout 15
-connect ax25 ax25_call g1tlh gb7djk
-'CONNECTED' 'cluster'
-'Connected' ''
-client /spider/perl/client.pl gb7tlh ax25
+connect ax25 /usr/sbin/netrom_call bbs gb7djk g1tlh
+'Connect' ''
+'Connect' 'cluster'
+'Connect'
+client /usr/bin/perl /spider/perl/client.pl gb7tlh ax25
diff --git a/data/bands.pl b/data/bands.pl
index 7ce539d1..7ac51e10 100644
--- a/data/bands.pl
+++ b/data/bands.pl
@@ -14,6 +14,12 @@
 
 
 %bands = (
+  '73khz' => bless ( { band => [71, 75],
+                      }, 'Bands'),
+		      
+  '136Khz' => bless ( { band => [135, 138],
+                      }, 'Bands'),
+
   '160m' => bless( { band => [ 1800, 2000 ], 
                      cw => [ 1800, 1830 ], 
                      rtty => [ 1838, 1841 ], 
@@ -175,6 +181,7 @@
 #
 
 %regions = (
+  vlf => [ '73khz', '136khz' ],
   hf => [ '160m', '80m', '40m', '30m', '20m', '17m', '15m', '12m', '10m' ],
   vhf => [ '6m', '4m', '2m', '220' ],
   vhfradio => [ 'band1', 'band2' ],
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 3eb387ef..eb306e67 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -61,6 +61,11 @@ use vars qw(%channels %valid);
   func => '9,Function',
   loc => '9,Local Vars',     # used by func to store local variables in
   lastread => '9,Last Msg Read',
+  outbound => '9,outbound?,yesno',
+  remotecmd => '9,doing rcmd,yesno',
+  pc34to => '9,last rcmd call',
+  pc34t => '9,last rcmd time,atime',
+  pings => '9,out/st pings',
 );
 
 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index aa4cb1a3..8af394b8 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -47,7 +47,7 @@ sub new
 
 sub start
 { 
-  my ($self, $line) = @_;
+  my ($self, $line, $sort) = @_;
   my $user = $self->{user};
   my $call = $self->{call};
   my $name = $user->{name};
@@ -81,7 +81,25 @@ sub start
 #
 # This is the normal command prompt driver
 #
+
 sub normal
+{
+	my $self = shift;
+	my $cmdline = shift;
+	
+	my @ans = run_cmd($self, $cmdline);
+	$self->send(@ans) if @ans > 0;
+	
+	# send a prompt only if we are in a prompt state
+	$self->prompt() if $self->{state} =~ /^prompt/o;
+}
+
+# 
+# this is the thing that runs the command, it is done like this for the 
+# benefit of remote command execution
+#
+
+sub run_cmd
 {
   my $self = shift;
   my $user = $self->{user};
@@ -141,18 +159,15 @@ sub normal
  	
   if ($ans[0]) {
     shift @ans;
-	$self->send(@ans) if @ans > 0;
   } else {
     shift @ans;
 	if (@ans > 0) {
-	  $self->send($self->msg('e2'), @ans);
+		unshift @ans, $self->msg('e2');
 	} else {
-      $self->send($self->msg('e1'));
+		@ans = $self->msg('e1');
 	}
   }
-  
-  # send a prompt only if we are in a prompt state
-  $self->prompt() if $self->{state} =~ /^prompt/o;
+  return @ans;
 }
 
 #
diff --git a/perl/DXCron.pm b/perl/DXCron.pm
index c31f4a92..ba200502 100644
--- a/perl/DXCron.pm
+++ b/perl/DXCron.pm
@@ -61,7 +61,7 @@ sub cread
 		next if /^\s*#/o or /^\s*$/o;
 		my ($min, $hour, $mday, $month, $wday, $cmd) = /^\s*(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s+(.+)$/o;
 		next if !$min;
-		my $ref = new();
+		my $ref = bless {};
 		my $err;
 		
 		$err |= parse($ref, 'min', $min, 0, 60);
diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm
index 611df547..ecf4c129 100644
--- a/perl/DXDebug.pm
+++ b/perl/DXDebug.pm
@@ -34,9 +34,9 @@ sub dbg
 		for (@_) {
 			s/\n$//og;
 		}
-		my $str = atime . "@_" ;
-		print "$str\n";
-		$fp->writenow($str);
+		print "@_\n" if defined \*STDOUT;
+		my $t = time;
+		$fp->writeunix($t, "$t^@_");
 	}
 }
 
diff --git a/perl/DXLog.pm b/perl/DXLog.pm
index e4f22803..96b39971 100644
--- a/perl/DXLog.pm
+++ b/perl/DXLog.pm
@@ -37,7 +37,6 @@ use Julian;
 use Carp;
 
 use strict;
-
 use vars qw($log);
 
 $log = new('log', 'dat', 'm');
diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index 6a6f104a..bbda05cb 100644
--- a/perl/DXMsg.pm
+++ b/perl/DXMsg.pm
@@ -24,12 +24,14 @@ use FileHandle;
 use Carp;
 
 use strict;
-use vars qw(%work @msg $msgdir %valid %busy);
+use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean);
 
 %work = ();                # outstanding jobs
 @msg = ();                 # messages we have
 %busy = ();                # station interlocks
 $msgdir = "$main::root/msg";              # directory contain the msgs
+$maxage = 30 * 86400;      # the maximum age that a message shall live for if not marked 
+$last_clean = 0;           # last time we did a clean
 
 %valid = (
   fromnode => '9,From Node',
@@ -51,6 +53,7 @@ $msgdir = "$main::root/msg";              # directory contain the msgs
   read => '9,Times read',
   size => '0,Size',
   msgno => '0,Msgno',
+  keep => '0,Keep this?,yesno',
 );
 
 # allocate a new object
@@ -170,6 +173,7 @@ sub process
 		  add_dir($ref);
 		  my $dxchan = DXChannel->get($ref->{to});
 		  $dxchan->send("New mail has arrived for you") if $dxchan;
+  		  Log('msg', "Message $ref->{msgno} from $ref->{from} received from $f[2] for $ref->{to}");
 		}
 		$ref->stop_msg($self);
 		queue_msg();
@@ -184,10 +188,12 @@ sub process
 	  my $ref = $work{"$f[2]$f[3]"};
 	  if ($ref) {
 		if ($ref->{private}) {                   # remove it if it private and gone off site#
-	      $ref->del_msg;
+			Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $f[2] and deleted");
+			$ref->del_msg;
 	    } else {
-	      push @{$ref->{gotit}}, $f[2];           # mark this up as being received
-		  $ref->store($ref->{lines});             # re- store the file
+			Log('msg', "Message $ref->{msgno} from $ref->{from} sent to $f[2]");
+			push @{$ref->{gotit}}, $f[2];           # mark this up as being received
+			$ref->store($ref->{lines});             # re- store the file
 	    }
     	$ref->stop_msg($self);
 	  } else {
@@ -242,6 +248,8 @@ sub process
 	  last SWITCH;
 	}
   }
+
+  clean_old() if $main::systime - $last_clean > 3600 ;    # clean the message queue
 }
 
 
@@ -320,6 +328,27 @@ sub del_msg
   dbg('msg', "deleting $self->{msgno}\n");
 }
 
+# clean out old messages from the message queue
+sub clean_old
+{
+	my $ref;
+	
+	# mark old messages for deletion
+	foreach $ref (@msg) {
+		if (!$ref->{keep} && $ref->{t} < $main::systime - $maxage) {
+			$ref->{deleteme} = 1;
+			delete $ref->{gotit};
+			delete $ref->{list};
+			unlink filename($ref->{msgno});
+			dbg('msg', "deleting old $ref->{msgno}\n");
+		}
+	}
+
+	# remove them all from the active message list
+	@msg = map { $_->{deleteme} ? () : $_ } @msg;
+	$last_clean = $main::systime;
+}
+
 # read in a message header
 sub read_msg_header
 { 
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index ab9e0e33..18fafa82 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -55,18 +55,26 @@ sub new
 # all the crap that comes between).
 sub start
 {
-  my ($self, $line) = shift;
-  my $call = $self->call;
-  
+  my ($self, $line, $sort) = @_;
+  my $call = $self->{call};
+  my $user = $self->{user};
+      
   # remember type of connection
   $self->{consort} = $line;
-
+  $self->{outbound} = $sort eq 'O';
+  $self->{priv} = $user->priv;
+  $self->{lang} = $user->lang;
+  $self->{consort} = $line;                # save the connection type
+  $self->{here} = 1;
+  
   # set unbuffered
   $self->send_now('B',"0");
   
   # send initialisation string
-  $self->send(pc38()) if DXNode->get_all();
-  $self->send(pc18());
+  if (!$self->{outbound}) {
+	  $self->send(pc38()) if DXNode->get_all();
+	  $self->send(pc18());
+  }
   $self->state('init');
   $self->pc50_t(time);
   Log('DXProt', "$call connected");
@@ -235,6 +243,13 @@ sub normal
         # unbusy and stop and outgoing mail (ie if somehow we receive another PC19 without a disconnect)
 		my $mref = DXMsg::get_busy($call);
 		$mref->stop_msg($self) if $mref;
+
+		# add this station to the user database, if required
+		my $user = DXUser->get_current($call);
+		$user = DXUser->new($call) if !$user;
+		$user->node($call) if !$user->node;
+		$user->sort('A');
+		$user->put;
 	  }
 	  
 	  # queue up any messages
@@ -279,16 +294,39 @@ sub normal
     if ($pcno == 25) {last SWITCH;}
 
     if (($pcno >= 28 && $pcno <= 33) || $pcno == 40 || $pcno == 42) {   # mail/file handling
-	  DXMsg::process($self, $line);
-	  return;
+		DXMsg::process($self, $line);
+		return;
 	}
 	
     if ($pcno == 34 || $pcno == 36) {   # remote commands (incoming)
-	  last SWITCH;
+		if ($field[1] eq $main::mycall) {
+			if ($self->{priv}) {        # you have to have SOME privilege, the commands have further filtering
+				$self->{remotecmd} = 1; # for the benefit of any command that needs to know
+				for (DXCommandmode::run_cmd($self, $field[3])) {
+					s/\s*$//og;
+					$self->send(pc35($main::mycall, $self->{call}, "$main::mycall:$_"));
+				}
+				delete $self->{remotecmd};
+			}
+		} else {
+			route($field[1], $line);
+		}
+		return;
 	}
 	
     if ($pcno == 35) {                  # remote command replies
-	  last SWITCH;
+		if ($field[1] eq $main::mycall) {
+			my $s = DXChannel::get($main::myalias); 
+			my @ref = grep { $_->pc34to eq $field[2] } DXChannel::get_all();     # people that have rcmded someone
+			push @ref, $s if $s;
+			
+			foreach (@ref) {
+				$_->send($field[3]);
+			}
+		} else {
+			route($field[1], $line);
+		}
+		return;
 	}
 	
     if ($pcno == 37) {last SWITCH;}
@@ -446,7 +484,7 @@ sub send_local_config
   my @nodes = DXNode::get_all();
   
   # create a list of all the nodes that are not connected to this connection
-  @nodes = map { $_->dxchan != $self ? $_ : () } @nodes;
+  @nodes = grep { $_->dxchan != $self } @nodes;
   $self->send($me->pc19(@nodes));
 	  
   # get all the users connected on the above nodes and send them out
diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm
index af833183..555bc0c7 100644
--- a/perl/DXProtout.pm
+++ b/perl/DXProtout.pm
@@ -199,6 +199,20 @@ sub pc33
   return "PC33^$fromnode^$tonode^$stream^";
 }
 
+# remote cmd send
+sub pc34
+{
+	my($fromnode, $tonode, $msg) = @_;
+	return "PC34^$tonode^$fromnode^$msg^~";
+}
+
+# remote cmd reply
+sub pc35
+{
+	my($fromnode, $tonode, $msg) = @_;
+	return "PC35^$tonode^$fromnode^$msg^~";
+}
+
 # send all the DX clusters I reckon are connected
 sub pc38
 {
diff --git a/perl/Messages b/perl/Messages
index 34f0576a..4ef03985 100644
--- a/perl/Messages
+++ b/perl/Messages
@@ -11,10 +11,15 @@ package DXM;
 %msgs = (
 		 en => {
 				addr => 'Address set to: $_[0]',
+                already => '$_[0] already connnected',
 				anns => 'Announce flag set on $_[0]',
 				annu => 'Announce flag unset on $_[0]',
 				conother => 'Sorry $_[0] you are connected on another port',
 				concluster => 'Sorry $_[0] you are already connected elsewhere on the cluster',
+				confail => 'connection to $_[0] failed ($_[1])',
+				constart => 'connection to $_[0] started',
+				dx1 => 'Frequency $_[0] not in band [usage: DX freq call comments](see sh/band)',
+				dx2 => 'Need a callsign [usage: DX freq call comments]',
 				dxs => 'DX Spots flag set on $_[0]',
 				dxu => 'DX Spots flag unset on $_[0]',
 				e1 => 'Invalid command',
@@ -35,7 +40,8 @@ package DXM;
 				ok => 'Operation successful',
 				pr => '$_[0] de $main::mycall $main::cldate $main::ztime >',
 				priv => 'Privilege level changed on $_[0]',
-				prx => '$main::$mycall >',
+				prx => '$main::mycall >',
+				shutting => '$main::mycall shutting down...',
 				talks => 'Talk flag set on $_[0]',
 				talku => 'Talk flag unset on $_[0]',
 				wwvs => 'WWV flag set on $_[0]',
diff --git a/perl/Spot.pm b/perl/Spot.pm
index e53880e1..7fb1c227 100644
--- a/perl/Spot.pm
+++ b/perl/Spot.pm
@@ -172,6 +172,7 @@ sub formatl
   my $t = ztime($dx[2]);
   my $d = cldate($dx[2]);
   return sprintf "%8.1f  %-11s %s %s  %-28.28s%7s>", $dx[0], $dx[1], $d, $t, $dx[3], "<$dx[4]" ;
-} 
+}
+
 
 1;
diff --git a/perl/client.pl b/perl/client.pl
index cff140b2..32271957 100755
--- a/perl/client.pl
+++ b/perl/client.pl
@@ -29,207 +29,369 @@
 
 # search local then perl directories
 BEGIN {
-  # root of directory tree for this system
-  $root = "/spider"; 
-  $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
-
-  unshift @INC, "$root/perl";   # this IS the right way round!
-  unshift @INC, "$root/local";
+	# root of directory tree for this system
+	$root = "/spider"; 
+	$root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
+	
+	unshift @INC, "$root/perl";	# this IS the right way round!
+	unshift @INC, "$root/local";
 }
 
 use Msg;
 use DXVars;
+use DXDebug;
+use IO::Socket;
+use IPC::Open2;
+use FileHandle;
 use Carp;
 
-$mode = 2;                      # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent
-$call = "";                     # the callsign being used
-@stdoutq = ();                  # the queue of stuff to send out to the user
-$conn = 0;                      # the connection object for the cluster
-$lastbit = "";                  # the last bit of an incomplete input line
-$mynl = "\n";                   # standard terminator
-$lasttime = time;               # lasttime something happened on the interface
-$outqueue = "";                 # the output queue length
-$buffered = 1;                  # buffer output
-$savenl = "";                   # an NL that has been saved from last time
-
 # cease communications
 sub cease
 {
-  my $sendz = shift;
-  if (defined $conn && $sendz) {
-    $conn->send_now("Z$call|bye...\n");
-  }
-  STDOUT->flush;
-  sleep(2);
-  exit(0);	
+	my $sendz = shift;
+	if ($conn && $sendz) {
+		$conn->send_now("Z$call|bye...\n");
+	}
+	$stdout->flush;
+	kill(15, $pid) if $pid;
+	sleep(1);
+	exit(0);	
 }
 
 # terminate program from signal
 sub sig_term
 {
-  cease(1);
+	cease(1);
 }
 
 # terminate a child
 sub sig_chld
 {
-  $SIG{CHLD} = \&sig_chld;
-  $waitedpid = wait;
+	$SIG{CHLD} = \&sig_chld;
+	$waitedpid = wait;
 }
 
 
 sub setmode
 {
-  if ($mode == 1) {
-    $mynl = "\r";
-  } else {
-	$mynl = "\n";
-  }
-  $/ = $mynl;
+	if ($mode == 1) {
+		$mynl = "\r";
+	} else {
+		$mynl = "\n";
+	}
+	$/ = $mynl;
 }
 
 # handle incoming messages
 sub rec_socket
 {
-  my ($con, $msg, $err) = @_;
-  if (defined $err && $err) {
-    cease(1);
-  }
-  if (defined $msg) {
-    my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
-	
-	if ($sort eq 'D') {
-	   my $snl = $mynl;
-	   my $newsavenl = "";
-	   $snl = "" if $mode == 0;
-	   if ($mode == 2 && $line =~ />$/) {
-	     $newsavenl = $snl;
-		 $snl = ' ';
-	   }
-	   $line =~ s/\n/\r/og if $mode == 1;
-	   #my $p = qq($line$snl);
-	   if ($buffered) {
-	     if (length $outqueue >= 128) {
-	       print $outqueue;
-		   $outqueue = "";
-	     }
-	     $outqueue .= "$savenl$line$snl";
-		 $lasttime = time;
-	   } else {
-	     print $savenl, $line, $snl;;
-	   }
-	   $savenl = $newsavenl;
-	} elsif ($sort eq 'M') {
-	  $mode = $line;               # set new mode from cluster
-      setmode();
-	} elsif ($sort eq 'B') {
-	  if ($buffered && $outqueue) {
-	    print $outqueue;
-		$outqueue = "";
-	  }
-	  $buffered = $line;           # set buffered or unbuffered
-    } elsif ($sort eq 'Z') {       # end, disconnect, go, away .....
-	  cease(0);
-    }	  
-  }
-  $lasttime = time; 
+	my ($con, $msg, $err) = @_;
+	if (defined $err && $err) {
+		cease(1);
+	}
+	if (defined $msg) {
+		my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
+		
+		if ($sort eq 'D') {
+			my $snl = $mynl;
+			my $newsavenl = "";
+			$snl = "" if $mode == 0;
+			if ($mode == 2 && $line =~ />$/) {
+				$newsavenl = $snl;
+				$snl = ' ';
+			}
+			$line =~ s/\n/\r/og if $mode == 1;
+			#my $p = qq($line$snl);
+			if ($buffered) {
+				if (length $outqueue >= 128) {
+					print $stdout $outqueue;
+					$outqueue = "";
+				}
+				$outqueue .= "$savenl$line$snl";
+				$lasttime = time;
+			} else {
+				print $stdout $savenl, $line, $snl;;
+			}
+			$savenl = $newsavenl;
+		} elsif ($sort eq 'M') {
+			$mode = $line;		# set new mode from cluster
+			setmode();
+		} elsif ($sort eq 'B') {
+			if ($buffered && $outqueue) {
+				print $stdout $outqueue;
+				$outqueue = "";
+			}
+			$buffered = $line;	# set buffered or unbuffered
+		} elsif ($sort eq 'Z') { # end, disconnect, go, away .....
+			cease(0);
+		}	  
+	}
+	$lasttime = time; 
 }
 
 sub rec_stdin
 {
-  my ($fh) = @_;
-  my $buf;
-  my @lines;
-  my $r;
-  my $first;
-  my $dangle = 0;
-  
-  $r = sysread($fh, $buf, 1024);
-#  print "sys: $r $buf";
-  if ($r > 0) {
-    if ($mode) {
-	  $buf =~ s/\r/\n/og if $mode == 1;
-	  $dangle = !($buf =~ /\n$/);
-	  if ($buf eq "\n") {
-	    @lines = (" ");
-	  } else {
-	    @lines = split /\n/, $buf;
-	  }
-	  if ($dangle) {                # pull off any dangly bits
-	    $buf = pop @lines;
-	  } else {
-	    $buf = "";
-	  }
-	  $first = shift @lines;
-	  unshift @lines, ($lastbit . $first) if ($first);
-	  foreach $first (@lines) {
-	    $conn->send_now("D$call|$first");
-	  }
-	  $lastbit = $buf;
-	  $savenl = "";     # reset savenl 'cos we will have done a newline on input
+	my ($fh) = @_;
+	my $buf;
+	my @lines;
+	my $r;
+	my $first;
+	my $dangle = 0;
+	
+	$r = sysread($fh, $buf, 1024);
+	#  my $prbuf;
+	#  $prbuf = $buf;
+	#  $prbuf =~ s/\r/\\r/;
+	#  $prbuf =~ s/\n/\\n/;
+	#  print "sys: $r ($prbuf)\n";
+	if ($r > 0) {
+		if ($mode) {
+			$buf =~ s/\r/\n/og if $mode == 1;
+			$dangle = !($buf =~ /\n$/);
+			if ($buf eq "\n") {
+				@lines = (" ");
+			} else {
+				@lines = split /\n/, $buf;
+			}
+			if ($dangle) {		# pull off any dangly bits
+				$buf = pop @lines;
+			} else {
+				$buf = "";
+			}
+			$first = shift @lines;
+			unshift @lines, ($lastbit . $first) if ($first);
+			foreach $first (@lines) {
+				#		  print "send_now $call $first\n";
+				$conn->send_now("D$call|$first");
+			}
+			$lastbit = $buf;
+			$savenl = "";		# reset savenl 'cos we will have done a newline on input
+		} else {
+			$conn->send_now("D$call|$buf");
+		}
+	} elsif ($r == 0) {
+		cease(1);
+	}
+	$lasttime = time;
+}
+
+sub doconnect
+{
+	my ($sort, $line) = @_;
+	dbg('connect', "CONNECT sort: $sort command: $line");
+	if ($sort eq 'telnet') {
+		# this is a straight network connect
+		my ($host) = $line =~ /host\s+(\w+)/o;
+		my ($port) = $line =~ /port\s+(\d+)/o;
+		$port = 23 if !$port;
+		
+		$sock = IO::Socket::INET->new(PeerAddr => "$host", PeerPort => "$port", Proto => 'tcp')
+			or die "Can't connect to $host port $port $!";
+		
+	} elsif ($sort eq 'ax25') {
+		my @args = split /\s+/, $line;
+		$rfh = new FileHandle;
+		$wfh = new FileHandle;
+		$pid = open2($rfh, $wfh, "$line") or die "can't do $line $!";
+		dbg('connect', "got pid $pid");
+		$wfh->autoflush(1);
 	} else {
-	  $conn->send_now("D$call|$buf");
+		die "invalid type of connection ($sort)";
 	}
-  } elsif ($r == 0) {
-    cease(1);
-  }
-  $lasttime = time;
+	$csort = $sort;
+}
+
+sub doabort
+{
+	my $string = shift;
+	dbg('connect', "abort $string");
+	$abort = $string;
 }
 
+sub dotimeout
+{
+	my $val = shift;
+	dbg('connect', "timeout set to $val");
+	$timeout = $val;
+}
+
+sub dochat
+{
+	my ($expect, $send) = @_;
+	dbg('connect', "CHAT \"$expect\" -> \"$send\"");
+    my $line;
+	
+	#	alarm($timeout);
+	
+    if ($expect) {
+		if ($csort eq 'telnet') {
+			$line = <$sock>;
+			chomp;
+		} elsif ($csort eq 'ax25') {
+			local $/ = "\r";
+			$line = <$rfh>;
+			$line =~ s/\r//og;
+		}
+		dbg('connect', "received \"$line\"");
+		if ($abort && $line =~ /$abort/i) {
+			dbg('connect', "aborted on /$abort/");
+			cease(11);
+		}
+	}
+	if ($send && (!$expect || $line =~ /$expect/i)) {
+		if ($csort eq 'telnet') {
+			$sock->print("$send\n");
+		} elsif ($csort eq 'ax25') {
+			local $\ = "\r";
+			$wfh->print("$send\r");
+		}
+		dbg('connect', "sent \"$send\"");
+	}
+}
+
+sub timeout
+{
+	dbg('connect', "timed out after $timeout seconds");
+	cease(10);
+}
+
+
+#
+# initialisation
+#
+
+$mode = 2;                      # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent
+$call = "";                     # the callsign being used
+@stdoutq = ();                  # the queue of stuff to send out to the user
+$conn = 0;                      # the connection object for the cluster
+$lastbit = "";                  # the last bit of an incomplete input line
+$mynl = "\n";                   # standard terminator
+$lasttime = time;               # lasttime something happened on the interface
+$outqueue = "";                 # the output queue length
+$buffered = 1;                  # buffer output
+$savenl = "";                   # an NL that has been saved from last time
+$timeout = 30;                  # default timeout for connects
+$abort = "";                    # the current abort string
+$cpath = "$root/connect";		# the basic connect directory
+
+$pid = 0;                       # the pid of the child program
+$csort = "";                    # the connection type
+$sock = 0;                      # connection socket
+
+$stdin = *STDIN;
+$stdout = *STDOUT;
+$rfh = 0;
+$wfh = 0;
+
+
+#
+# deal with args
+#
+
 $call = uc shift @ARGV;
 $call = uc $myalias if !$call; 
 $connsort = lc shift @ARGV;
 $connsort = 'local' if !$connsort;
-$mode = ($connsort =~ /^ax/o) ? 1 : 2;
-
-# is this an out going connection?
-if ($ARGV[0] eq "connect") {
-  shift @ARGV;          # lose the keyword
-  
-}
 
+$mode = ($connsort =~ /^ax/o) ? 1 : 2;
 setmode();
+
 if ($call eq $mycall) {
-  print "You cannot connect as your cluster callsign ($mycall)", $nl;
-  cease(0);
+	print $stdout "You cannot connect as your cluster callsign ($mycall)", $nl;
+	cease(0);
 }
 
-#select STDOUT; $| = 1;
-STDOUT->autoflush(1);
+$stdout->autoflush(1);
 
 $SIG{'INT'} = \&sig_term;
 $SIG{'TERM'} = \&sig_term;
-$SIG{'HUP'} = \&sig_term;
+$SIG{'HUP'} = 'IGNORE';
 $SIG{'CHLD'} = \&sig_chld;
 
+dbgadd('connect');
+
+# is this an out going connection?
+if ($connsort eq "connect") {
+	my $mcall = lc $call;
+	
+	open(IN, "$cpath/$mcall") or cease(2);
+	@in = <IN>;
+	close IN;
+	
+	#	alarm($timeout);
+	
+	for (@in) {
+		chomp;
+		next if /^\s*\#/o;
+		next if /^\s*$/o;
+		doconnect($1, $2) if /^\s*co\w*\s+(\w+)\s+(.*)$/io;
+		doabort($1) if /^\s*a\w*\s+(.*)/io;
+		dotimeout($1) if /^\s*t\w*\s+(\d+)/io;
+		dochat($1, $2) if /\s*\'(.*)\'\s+\'(.*)\'/io;          
+	}
+	
+    dbg('connect', "Connected to $call, starting normal protocol");
+	dbgsub('connect');
+	
+	# if we get here we are connected
+	if ($csort eq 'ax25') {
+		#		open(STDIN, "<&R"); 
+		#		open(STDOUT, ">&W"); 
+		#		close R;
+		#		close W;
+        $stdin = $rfh;
+		$stdout = $wfh;
+	} elsif ($csort eq 'telnet') {
+		#		open(STDIN, "<&$sock"); 
+		#		open(STDOUT, ">&$sock"); 
+		#		close $sock;
+		$stdin = $sock;
+		$stdout = $sock;
+	}
+    alarm(0);
+    $outbound = 1;
+	$connsort = $csort;
+	$stdout->autoflush(1);
+	close STDIN;
+	close STDOUT;
+	close STDERR;
+	
+	
+	$mode = ($connsort =~ /^ax/o) ? 1 : 2;
+	setmode();
+}
+
+setmode();
+
 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
 if (! $conn) {
-  if (-r "$data/offline") {
-    open IN, "$data/offline" or die;
-    while (<IN>) {
-	  s/\n/\r/og if $mode == 1;
-	  print;
+	if (-r "$data/offline") {
+		open IN, "$data/offline" or die;
+		while (<IN>) {
+			s/\n/\r/og if $mode == 1;
+			print $stdout;
+		}
+		close IN;
+	} else {
+		print $stdout "Sorry, the cluster $mycall is currently off-line", $mynl;
 	}
-	close IN;
-  } else {
-    print "Sorry, the cluster $mycall is currently off-line", $mynl;
-  }
-  cease(0);
+	cease(0);
 }
 
-$conn->send_now("A$call|$connsort");
-Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
+$let = $outbound ? 'O' : 'A';
+$conn->send_now("$let$call|$connsort");
+Msg->set_event_handler($stdin, "read" => \&rec_stdin);
 
 for (;;) {
-  my $t;
-  Msg->event_loop(1, 0.010);
-  $t = time;
-  if ($t > $lasttime) {
-    if ($outqueue) {
-	  print $outqueue;
-	  $outqueue = "";
+	my $t;
+	Msg->event_loop(1, 0.010);
+	$t = time;
+	if ($t > $lasttime) {
+		if ($outqueue) {
+			print $stdout $outqueue;
+			$outqueue = "";
+		}
+		$lasttime = $t;
 	}
-	$lasttime = $t;
-  }
 }
 
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 848131f7..8e888842 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -47,7 +47,7 @@ package main;
 
 @inqueue = ();					# the main input queue, an array of hashes
 $systime = 0;					# the time now (in seconds)
-$version = 1.4;					# the version no of the software
+$version = 1.5;					# the version no of the software
 
 # handle disconnections
 sub disconnect
@@ -133,6 +133,12 @@ sub cease
 	exit(0);
 }
 
+# the reaper of children
+sub reap
+{
+	my $cpid = wait;
+}
+
 # this is where the input queue is dealt with and things are dispatched off to other parts of
 # the cluster
 sub process_inqueue
@@ -142,15 +148,15 @@ sub process_inqueue
 	
 	my $data = $self->{data};
 	my $dxchan = $self->{dxchan};
-	my ($sort, $call, $line) = $data =~ /^(\w)(\S+)\|(.*)$/;
+	my ($sort, $call, $line) = $data =~ /^(\w)(\w+)\|(.*)$/;
 	
 	# do the really sexy console interface bit! (Who is going to do the TK interface then?)
 	dbg('chan', "<- $sort $call $line\n");
 	
 	# handle A records
 	my $user = $dxchan->user;
-	if ($sort eq 'A') {
-		$dxchan->start($line);  
+	if ($sort eq 'A' || $sort eq 'O') {
+		$dxchan->start($line, $sort);  
 	} elsif ($sort eq 'D') {
 		die "\$user not defined for $call" if !defined $user;
 		
@@ -171,6 +177,8 @@ sub process_inqueue
 #
 #############################################################
 
+$systime = time;
+
 # open the debug file, set various FHs to be unbuffered
 foreach (@debug) {
 	dbgadd($_);
@@ -202,6 +210,7 @@ Msg->new_server("$clusteraddr", $clusterport, \&login);
 $SIG{'INT'} = \&cease;
 $SIG{'TERM'} = \&cease;
 $SIG{'HUP'} = 'IGNORE';
+$SIG{'CHLD'} = \&reap;
 
 # read in system messages
 DXM->init();
@@ -221,9 +230,10 @@ Spot->init();
 # put in a DXCluster node for us here so we can add users and take them away
 DXNode->new(0, $mycall, 0, 1, $DXProt::myprot_version); 
 
-# read in any existing message headers
+# read in any existing message headers and clean out old crap
 print "reading existing message headers\n";
 DXMsg->init();
+DXMsg::clean_old();
 
 # read in any cron jobs
 print "reading cron jobs\n";
@@ -247,6 +257,9 @@ for (;;) {
 		DXProt::process();		# process ongoing ak1a pcxx stuff
 		DXConnect::process();
 	}
+	if ($decease) {
+		last if --$decease <= 0;
+	}
 }
 
 
diff --git a/perl/connect.pl b/perl/connect.pl
index f50c89dd..590660fa 100755
--- a/perl/connect.pl
+++ b/perl/connect.pl
@@ -28,66 +28,182 @@
 
 # search local then perl directories
 BEGIN {
-  # root of directory tree for this system
-  $root = "/spider"; 
-  $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
-
-  unshift @INC, "$root/perl";   # this IS the right way round!
-  unshift @INC, "$root/local";
+	# root of directory tree for this system
+	$root = "/spider"; 
+	$root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
+	
+	unshift @INC, "$root/perl";	# this IS the right way round!
+	unshift @INC, "$root/local";
 }
 
 use DXVars;
 use IO::Socket;
-use POSIX;
+use FileHandle;
+use Open2;
+use DXDebug;
+use POSIX qw(dup);
 use Carp;
 
-$timeout = 30;         # default timeout for each stage of the connect
-$abort = '';           # default connection abort string
-$path = "$root/connect";    # the basic connect directory
-$client = "$root/perl/client.pl";   # default client
+$timeout = 30;					# default timeout for each stage of the connect
+$abort = '';					# default connection abort string
+$path = "$root/connect";		# the basic connect directory
+$client = "$root/perl/client.pl"; # default client
+
+$connected = 0;					# we have successfully connected or started an interface program
+$pid = 0;                       # the pid of the child program
+$csort = "";                    # the connection type
+$sock = 0;                      # connection socket
 
-$connected = 0;        # we have successfully connected or started an interface program
+sub timeout;
+sub term;
+sub reap;
 
-exit(1) if !$ARGV[0];       # bang out if no callsign
+$SIG{ALRM} = \&timeout;
+$SIG{TERM} = \&term;
+$SIG{INT} = \&term;
+$SIG{REAP} = \&reap;
+$SIG{HUP} = 'IGNORE';
+
+exit(1) if !$ARGV[0];			# bang out if no callsign
 open(IN, "$path/$ARGV[0]") or exit(2);
+@in = <IN>;
+close IN;
+STDOUT->autoflush(1);
+dbgadd('connect');
+
+alarm($timeout);
 
-while (<IN>) {
-  chomp;
-  next if /^\s*#/o;
-  next if /^\s*$/o;
-  doconnect($1, $2) if /^\s*co\w*\s+(.*)$/io;
-  doclient($1) if /^\s*cl\w*\s+(.*)$/io;
-  doabort($1) if /^\s*a\w*\s+(.*)/io;
-  dotimeout($1) if /^\s*t\w*\s+(\d+)/io;
-  dochat($1, $2) if /\s*\'(.*)\'\s+\'(.*)'/io;
+for (@in) {
+	chomp;
+	next if /^\s*\#/o;
+	next if /^\s*$/o;
+	doconnect($1, $2) if /^\s*co\w*\s+(\w+)\s+(.*)$/io;
+	doclient($1) if /^\s*cl\w*\s+(\w+)\s+(.*)$/io;
+	doabort($1) if /^\s*a\w*\s+(.*)/io;
+	dotimeout($1) if /^\s*t\w*\s+(\d+)/io;
+	dochat($1, $2) if /\s*\'(.*)\'\s+\'(.*)\'/io;          
 }
 
 sub doconnect
 {
-  my ($sort, $name) = @_;
-  print "connect $sort $name\n";
+	my ($sort, $line) = @_;
+	dbg('connect', "CONNECT sort: $sort command: $line");
+	if ($sort eq 'net') {
+		# this is a straight network connect
+		my ($host) = $line =~ /host\s+(\w+)/o;
+		my ($port) = $line =~ /port\s+(\d+)/o;
+		$port = 23 if !$port;
+		
+		$sock = IO::Socket::INET->new(PeerAddr => "$host", PeerPort => "$port", Proto => 'tcp')
+			or die "Can't connect to $host port $port $!";
+		
+	} elsif ($sort eq 'ax25') {
+		my @args = split /\s+/, $line;
+		$pid = open2(\*R, \*W, "$line") or die "can't do $line $!";
+		dbg('connect', "got pid $pid");
+		W->autoflush(1);
+	} else {
+		die "can't get here";
+	}
+	$csort = $sort;
 }
 
 sub doabort
 {
-  my $string = shift;
-  print "abort $string\n";
+	my $string = shift;
+	dbg('connect', "abort $string");
+	$abort = $string;
 }
 
 sub dotimeout
 {
-  my $val = shift;
-  print "timeout $val\n";
+	my $val = shift;
+	dbg('connect', "timeout set to $val");
+	alarm($timeout = $val);
 }
 
 sub dochat
 {
-  my ($expect, $send) = @_;
-  print "chat '$expect' '$send'\n";
+	my ($expect, $send) = @_;
+	dbg('connect', "CHAT \"$expect\" -> \"$send\"");
+    my $line;
+
+	alarm($timeout);
+	
+    if ($expect) {
+		if ($csort eq 'net') {
+			$line = <$sock>;
+			chomp;
+		} elsif ($csort eq 'ax25') {
+			local $/ = "\r";
+			$line = <R>;
+			$line =~ s/\r//og;
+		}
+		dbg('connect', "received \"$line\"");
+		if ($abort && $line =~ /$abort/i) {
+			dbg('connect', "aborted on /$abort/");
+			exit(11);
+		}
+	}
+	if ($send && (!$expect || $line =~ /$expect/i)) {
+		if ($csort eq 'net') {
+			$sock->print("$send\n");
+		} elsif ($csort eq 'ax25') {
+			local $\ = "\r";
+			W->print("$send\r");
+		}
+		dbg('connect', "sent \"$send\"");
+	}
 }
 
 sub doclient
 {
-  my $cl = shift;
-  print "client $cl\n";
+	my ($cl, $args) = @_;
+	dbg('connect', "client: $cl args: $args");
+    my @args = split /\s+/, $args;
+
+#	if (!defined ($pid = fork())) {
+#		dbg('connect', "can't fork");
+#		exit(13);
+#	}
+#	if ($pid) {
+#		sleep(1);
+#		exit(0);
+#	} else {
+		
+		close(STDIN);
+		close(STDOUT);
+		if ($csort eq 'net') {
+			open STDIN, "<&$sock";
+			open STDOUT, ">&$sock";
+			exec $cl, @args;
+		} elsif ($csort eq 'ax25') {
+			open STDIN, "<&R";
+			open STDOUT, ">&W";
+			exec $cl, @args;
+		} else {
+			dbg('connect', "client can't get here");
+			exit(13);
+		}
+#    }
+}
+
+sub timeout
+{
+	dbg('connect', "timed out after $timeout seconds");
+	exit(10);
+}
+
+sub term
+{
+	dbg('connect', "caught INT or TERM signal");
+	kill $pid if $pid;
+	sleep(2);
+	exit(12);
+}
+
+sub reap
+{
+    my $wpid = wait;
+	dbg('connect', "pid $wpid has died");
 }