From 4b207544da78b182bd12e94eab01451694749012 Mon Sep 17 00:00:00 2001
From: Dirk Koopman <djk@tobit.co.uk>
Date: Fri, 7 Jan 2022 23:47:56 +0000
Subject: [PATCH] mega-merge of major parts of mojo

The point of this is to make it easier to maintain both branches.

DXProt (DXProtHandle has already been copied) route/* DXChannel
DXCommandmode and console.pl have been either copied wholesale,
where necessary, modified to use the old Msg based networking stack.
---
 Changes               |   2 +
 cmd/announce.pl       |   4 +-
 cmd/chat.pl           |   2 +-
 cmd/dx.pl             | 103 +++++++++++--------
 cmd/links.pl          |  29 +++---
 cmd/reply.pl          |   2 +-
 cmd/send.pl           |   2 +-
 cmd/show/cluster.pl   |  11 ++-
 cmd/spoof.pl          |   3 +-
 cmd/talk.pl           |   2 +-
 cmd/unset/register.pl |   2 +-
 cmd/who.pl            |   8 +-
 cmd/wx.pl             |   2 +-
 perl/Console.pm       |  43 ++++----
 perl/DXChannel.pm     | 140 +++++++++++++++-----------
 perl/DXCommandmode.pm | 105 +++++++++++++-------
 perl/DXProt.pm        |   3 +
 perl/Messages         |  35 ++++---
 perl/Route.pm         |  18 +++-
 perl/Route/Node.pm    |  15 ++-
 perl/Route/User.pm    |   7 --
 perl/cluster.pl       |   5 +-
 perl/console.pl       | 224 ++++++++++++++++++++++--------------------
 perl/watchdbg         |  33 ++++---
 24 files changed, 475 insertions(+), 325 deletions(-)

diff --git a/Changes b/Changes
index 8c8829e3..de0f78c9 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,5 @@
+07Jan22=======================================================================
+1. Backport console.pl from the Mojo Branch.
 06Jan22=======================================================================
 1. Backport various Mojo branch "security" fixes. 
 12Dec21=======================================================================
diff --git a/cmd/announce.pl b/cmd/announce.pl
index 7f52a461..9065993b 100644
--- a/cmd/announce.pl
+++ b/cmd/announce.pl
@@ -17,10 +17,12 @@
 
 my ($self, $line) = @_;
 #$DB::single = 1;
+my $addr = $self->hostname || '127.0.0.1';
+Log('cmd', "$self->{call}|$addr|announce|$line");
 my @f = split /\s+/, $line;
 return (1, $self->msg('e5')) if $self->remotecmd || $self->inscript;
 return (1, $self->msg('e9')) if !@f;
-return (1, $self->msg('e28')) unless $self->registered;
+return (1, $self->msg('e28')) unless $self->isregistered;
 
 my $sort = uc $f[0];
 my $to = '*';
diff --git a/cmd/chat.pl b/cmd/chat.pl
index b65ca928..13018765 100644
--- a/cmd/chat.pl
+++ b/cmd/chat.pl
@@ -13,7 +13,7 @@ my ($self, $line) = @_;
 my @f = split /\s+/, $line, 2;
 return (1, $self->msg('e5')) if $self->remotecmd || $self->inscript;
 return (1, $self->msg('e34')) unless @f >= 1;
-return (1, $self->msg('e28')) unless $self->registered;
+return (1, $self->msg('e28')) unless $self->isregistered;
 
 my $target = uc $f[0];
 
diff --git a/cmd/dx.pl b/cmd/dx.pl
index 18687a68..a5d3b425 100644
--- a/cmd/dx.pl
+++ b/cmd/dx.pl
@@ -16,8 +16,16 @@ my $freq;
 my @out;
 my $valid = 0;
 my $localonly;
+my $oline = $line;
+
+#$DB::single=1;
+
 return (1, $self->msg('e5')) if $self->remotecmd || $self->inscript;
-return (1, $self->msg('e28')) unless $self->registered;
+return (1, $self->msg('e28')) unless $self->isregistered;
+
+
+my $addr = $self->hostname || '127.0.0.1';
+Log('cmd', "$self->{call}|$addr|dx|$line");
 
 my @bad;
 if (@bad = BadWords::check($line)) {	
@@ -34,14 +42,27 @@ return (1, $self->msg('dx2')) unless @f >= 2;
 # can be in any order
 
 if ($f[0] =~ /^by$/i) {
-	return (1, $self->msg('e5')) unless $main::allowdxby || $self->priv;
+	return (1, $self->msg('e5')) unless $main::allowdxby || $self->priv > 1;
     $spotter = uc $f[1];
-    $line =~ s/\s*$f[0]\s+$f[1]\s+//;
-#	$line = $f[2];
-	@f = split /\s+/, $line, 3;
+    $line =~ s/^\s*$f[0]\s+$f[1]\s+//;
+	@f = split /\s+/, $line, 3; 
 	return (1, $self->msg('dx2')) unless @f >= 2;
 }
 
+my $ipaddr;
+@f = split /\s+/, $line, 3;
+if ($f[0] eq 'ip') {
+	return (1, $self->msg('e5')) unless $spotter &&  $self->priv > 1;
+	if (is_ipaddr($f[1])) {
+		$ipaddr = $f[1];
+	} else {
+		return (1, $self->msg('dx4', $f[1]));
+	}
+	$line =~ s/^\s*$f[0]\s+$f[1]\s+//;
+	@f = split /\s+/, $line, 3;
+}
+
+
 # get the freq and callsign either way round
 if (is_freq($f[1]) && $f[0] =~ m{^[\w\d]+(?:/[\w\d]+){0,2}$}) {
 	$spotted = uc $f[0];
@@ -52,28 +73,39 @@ if (is_freq($f[1]) && $f[0] =~ m{^[\w\d]+(?:/[\w\d]+){0,2}$}) {
 } else {
 	return (1, $self->msg('dx3'));
 }
+$line =~ s/^\s*$f[0]//;
+$line =~ s/^\s*$f[1]//;
+$line =~ unpad($line);
+$line =~ s/\t+/ /g;				# do this here because it needs to be stopped ASAP!
+$line ||= ' ';
+
+if ($self->conn && $self->conn->peerhost) {
+	$ipaddr ||= $addr; # force a PC61 
+} elsif ($self->inscript) {
+	$ipaddr = "script";
+}
 
 # check some other things
 # remove ssid from calls
-my $callnoid = $self->call;
-$callnoid =~ s/-\d+$//;
-my $spotternoid = $spotter;
-$spotternoid =~ s/-\d+$//;
+my $spotternoid = basecall($spotter);
+my $callnoid = basecall($self->{call});
+
+#$DB::single = 1;
+
 if ($DXProt::baddx->in($spotted)) {
 	$localonly++; 
 }
-if ($DXProt::badspotter->in($callnoid)) { 
-	LogDbg('DXCommand', "$self->{call} badspotter with $callnoid ($line)");
-	$localonly++; 
-}
-if ($callnoid ne $spotternoid && $DXProt::badspotter->in($spotternoid)) { 
-	LogDbg('DXCommand', "$self->{call} badspotter with $spotternoid ($line)");
+if ($DXProt::badspotter->in($spotternoid)) { 
+	LogDbg('DXCommand', "badspotter $spotternoid as $spotter ($oline) from $addr");
 	$localonly++; 
 }
 
-# make line the rest of the line
-$line = $f[2] || " ";
-@f = split /\s+/, $line;
+dbg "spotter $spotternoid/$callnoid\n";
+
+if (($spotted =~ /$spotternoid/ || $spotted =~ /$callnoid/) && $freq < $Spot::minselfspotqrg) {
+	LogDbg('DXCommand', "$spotternoid/$callnoid trying to self spot below ${Spot::minselfspotqrg}KHz ($oline) from $addr, not passed on to cluster");
+	$localonly++;
+}
 
 # bash down the list of bands until a valid one is reached
 my $bandref;
@@ -120,20 +152,13 @@ if ($spotted le ' ') {
 
 return (1, @out) unless $valid;
 
-my $ipaddr;
-
-if ($self->conn && $self->conn->peerhost) {
-	my $addr = $self->conn->peerhost;
-	$ipaddr = $addr unless !is_ipaddr($addr) || $addr =~ /^127\./ || $addr =~ /^::[0-9a-f]+$/;
-} elsif ($self->inscript) {
-	$ipaddr = "script";
-}
-
 # Store it here (but only if it isn't baddx)
 my $t = (int ($main::systime/60)) * 60;
-return (1, $self->msg('dup')) if Spot::dup($freq, $spotted, $t, $line, $spotter);
+return (1, $self->msg('dup')) if Spot::dup($freq, $spotted, $t, $line, $spotter, $main::mycall);
 my @spot = Spot::prepare($freq, $spotted, $t, $line, $spotter, $main::mycall, $ipaddr);
 
+#$DB::single = 1;
+
 if ($freq =~ /^69/ || $localonly) {
 
 	# heaven forfend that we get a 69Mhz band :-)
@@ -142,18 +167,20 @@ if ($freq =~ /^69/ || $localonly) {
 	}
 
 	$self->dx_spot(undef, undef, @spot);
+
 	return (1);
 } else {
-	if (@spot) {
-		# store it 
+	# send orf to the users
+	$ipaddr ||= $main::mycall;	# emergency backstop
+	my $spot = DXProt::pc61($spotter, $freq, $spotted, unpad($line),  $ipaddr);
+	
+	$self->dx_spot(undef, undef, @spot);
+	if ($self->isslugged) {
+		push @{$self->{sluggedpcs}}, [61, $spot, \@spot];
+	} else {
+		# store in spots database 
 		Spot::add(@spot);
-
-		# send orf to the users
-		if ($ipaddr) {
-			DXProt::send_dx_spot($self, DXProt::pc61($spotter, $freq, $spotted, $line, $ipaddr), @spot);
-		} else {
-			DXProt::send_dx_spot($self, DXProt::pc11($spotter, $freq, $spotted, $line), @spot);
-		}
+		DXProt::send_dx_spot($self, $spot, @spot);
 	}
 }
 
@@ -161,5 +188,3 @@ return (1, @out);
 
 
 
-
-
diff --git a/cmd/links.pl b/cmd/links.pl
index 8856ba27..ed4082ff 100644
--- a/cmd/links.pl
+++ b/cmd/links.pl
@@ -15,20 +15,22 @@ my $dxchan;
 my @out;
 my $nowt = time;
 
-push @out, "                                      Ave  Obs  Ping  Next      Filters";
-push @out, "  Callsign Type Started               RTT Count Int.  Ping Iso? In  Out PC92? Address";
+push @out, "                                                  Ave  Obs  Ping  Next      Filters";
+push @out, "  Callsign Type Started                 Uptime    RTT Count Int.  Ping Iso? In  Out PC92? Address";
 
-foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all_nodes ) {
-	my $call = $dxchan->call();
+foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all ) {
 	next if $dxchan == $main::me;
+	next unless $dxchan->is_node || $dxchan->is_rbn;
+	my $call = $dxchan->call();
 	my $t = cldatetime($dxchan->startt);
 	my $sort;
 	my $name = $dxchan->user->name || " ";
 	my $obscount = $dxchan->nopings;
 	my $pingint = $dxchan->pingint;
 	my $lastt = $dxchan->lastping ? ($dxchan->pingint - ($nowt - $dxchan->lastping)) : $pingint;
-	my $ping = $dxchan->is_node && $dxchan != $main::me ? sprintf("%8.2f",$dxchan->pingave) : "";
-	my $iso = $dxchan->isolate ? 'Y' :' ';
+	my $ping = sprintf("%7.2f", $dxchan->pingave || 0);
+	my $iso = $dxchan->isolate ? 'Y' : ' ';
+	my $uptime = difft($dxchan->startt, 1);
 	my ($fin, $fout, $pc92) = (' ', ' ', ' ');
 	if ($dxchan->do_pc9x) {
 		$pc92 = 'Y';
@@ -41,27 +43,28 @@ foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all_nodes ) {
 			$fout = $dxchan->routefilter =~ /node_default/ ? 'D' : 'Y';
 		}
 	}
-	unless ($pingint) {
+	unless ($pingint && $ping) {
 		$lastt = 0;
-		$ping = "        ";
+		$ping = '       ';
+		$obscount = ' ';
 	}
 
-	$sort = 'ANEA' if $dxchan->is_aranea;
 	$sort = "DXSP" if $dxchan->is_spider;
 	$sort = "CLX " if $dxchan->is_clx;
 	$sort = "DXNT" if $dxchan->is_dxnet;
 	$sort = "AR-C" if $dxchan->is_arcluster;
 	$sort = "AK1A" if $dxchan->is_ak1a;
+	$sort = "RBN " if $dxchan->is_rbn;
 	my $ipaddr;
 
-	if ($dxchan->conn->peerhost) {
-		my $addr = $dxchan->conn->peerhost;
-		$ipaddr = $addr if is_ipaddr($addr);
+	my $addr = $dxchan->hostname;
+	if ($addr) {
+	    $ipaddr = $addr if is_ipaddr($addr);
 		$ipaddr = 'local' if $addr =~ /^127\./ || $addr =~ /^::[0-9a-f]+$/;
 	}
 	$ipaddr = 'ax25' if $dxchan->conn->ax25;
 
-	push @out, sprintf "%10s $sort $t$ping   $obscount  %5d %5d  $iso    $fin   $fout   $pc92    $ipaddr", $call, $pingint, $lastt;
+	push @out, sprintf "%10s $sort $t%13s$ping   $obscount  %5d %5d  $iso    $fin   $fout   $pc92    $ipaddr", $call, $uptime ,$pingint, $lastt;
 }
 
 return (1, @out)
diff --git a/cmd/reply.pl b/cmd/reply.pl
index 292316b5..22f04b85 100644
--- a/cmd/reply.pl
+++ b/cmd/reply.pl
@@ -67,7 +67,7 @@ if ($self->state eq "prompt") {
 		@extra = ();
 	} 
 
-	return (1, $self->msg('e28')) unless $self->registered || $to eq $main::myalias;
+	return (1, $self->msg('e28')) unless $self->isregistered || $to eq $main::myalias;
 	
 	$loc->{to} = [ $to, @extra ];       # to is an array
 	$loc->{subject} = $oref->subject;
diff --git a/cmd/send.pl b/cmd/send.pl
index 08b2aa43..0fb91e10 100644
--- a/cmd/send.pl
+++ b/cmd/send.pl
@@ -39,7 +39,7 @@ if ($self->state eq "prompt") {
 	
 	# any thing after send?
 	return (1, $self->msg('e6')) if !@f;
-	return (1, $self->msg('e28')) unless $self->registered || uc $f[0] eq $main::myalias;
+	return (1, $self->msg('e28')) unless $self->isregistered || uc $f[0] eq $main::myalias;
 
 	while (@f) {
 		my $f = uc shift @f; 
diff --git a/cmd/show/cluster.pl b/cmd/show/cluster.pl
index 066ef7bf..d61eaa84 100644
--- a/cmd/show/cluster.pl
+++ b/cmd/show/cluster.pl
@@ -1,4 +1,13 @@
 #
 # show some statistics
 #
-return (1, Route::cluster() );
+
+my $self = shift;
+
+my ($nodes, $tot, $users, $maxlocalusers, $maxusers, $uptime, $localnodes) = Route::cluster();
+
+$localnodes = $main::routeroot->nodes;
+$users = $main::routeroot->users;
+$uptime = difft($main::starttime, ' ');
+
+return (1, $self->msg('cluster', $localnodes, $nodes, $users, $tot, $maxlocalusers, $maxusers, $uptime));
diff --git a/cmd/spoof.pl b/cmd/spoof.pl
index e0194a11..d4be673f 100644
--- a/cmd/spoof.pl
+++ b/cmd/spoof.pl
@@ -35,7 +35,8 @@ unless ($user) {
 # set up basic environment
 $self->call($call);
 $self->user($user);
-Log('DXCommand', "spoof '$newline' as $call by $mycall");
+my $addr = $self->hostname || '127.0.0.1';
+Log('cmd', "$self->{call}|$addr|spoof|$line");
 my @in = $self->run_cmd($newline);
 push @out, map {"spoof $call: $_"} @in;
 $self->call($mycall);
diff --git a/cmd/talk.pl b/cmd/talk.pl
index acd2eba5..dae38e24 100644
--- a/cmd/talk.pl
+++ b/cmd/talk.pl
@@ -33,7 +33,7 @@ return (1, $self->msg('e8')) unless $to;
 $to = uc $to;
 
 return (1, $self->msg('e22', $to)) unless is_callsign($to);
-return (1, $self->msg('e28')) unless $self->registered || $to eq $main::myalias;
+return (1, $self->msg('e28')) unless $self->isregistered || $to eq $main::myalias;
 
 $via = uc $via if $via;
 my $call = $via || $to;
diff --git a/cmd/unset/register.pl b/cmd/unset/register.pl
index a0c36d78..c18ac3c7 100644
--- a/cmd/unset/register.pl
+++ b/cmd/unset/register.pl
@@ -17,7 +17,7 @@ if ($self->priv < 9) {
 	Log('DXCommand', $self->call . " attempted to unregister @args");
 	return (1, $self->msg('e5'));
 }
-return (1, $self->msg('reginac')) unless $main::reqreg;
+#return (1, $self->msg('reginac')) unless $main::reqreg;
 
 foreach $call (@args) {
 	$call = uc $call;
diff --git a/cmd/who.pl b/cmd/who.pl
index b068c586..4371b08d 100644
--- a/cmd/who.pl
+++ b/cmd/who.pl
@@ -19,19 +19,23 @@ foreach $dxchan ( sort {$a->call cmp $b->call} DXChannel::get_all ) {
 	my $type = $dxchan->is_node ? "NODE" : "USER";
 	my $sort = "    ";
 	if ($dxchan->is_node) {
-		$sort = 'ANEA' if $dxchan->is_aranea;
 		$sort = "DXSP" if $dxchan->is_spider;
 		$sort = "CLX " if $dxchan->is_clx;
 		$sort = "DXNT" if $dxchan->is_dxnet;
 		$sort = "AR-C" if $dxchan->is_arcluster;
 		$sort = "AK1A" if $dxchan->is_ak1a;
+	} else {
+		$sort = "LOCL" if $dxchan->conn->isa('IntMsg');
+		$sort = "WEB " if $dxchan->is_web;
+		$sort = "EXT " if $dxchan->conn->isa('ExtMsg');
+		$type = "RBN " if $dxchan->is_rbn;              # Yes, this is NOT a typo
 	}
 	my $name = $dxchan->user->name || " ";
 	my $ping = $dxchan->is_node && $dxchan != $main::me ? sprintf("%5.2f", $dxchan->pingave) : "     ";
 	my $conn = $dxchan->conn;
 	my $ip = '';
 	if ($conn) {
-		$ip = $conn->{peerhost} if exists $conn->{peerhost};
+		$ip = $dxchan->hostname;
 		$ip = "AGW Port ($conn->{agwport})" if exists $conn->{agwport};
 	}
 	push @out, sprintf "%10s $type $sort $t %-10.10s $ping $ip", $call, $name;
diff --git a/cmd/wx.pl b/cmd/wx.pl
index 73e2e566..57147190 100644
--- a/cmd/wx.pl
+++ b/cmd/wx.pl
@@ -23,7 +23,7 @@ my $t = ztime(time);
 my $tonode;
 my $via;
 return (1, $self->msg('e5')) if $self->remotecmd || $self->inscript;
-return (1, $self->msg('e28')) unless $self->registered;
+return (1, $self->msg('e28')) unless $self->isregistered;
 
 if ($sort eq "FULL") {
   $line =~ s/^$f[0]\s+//;    # remove it
diff --git a/perl/Console.pm b/perl/Console.pm
index a6dc6613..9dfacfb6 100644
--- a/perl/Console.pm
+++ b/perl/Console.pm
@@ -39,33 +39,34 @@ if ($ENV{'TERM'} =~ /(xterm|ansi)/) {
 	$background = COLOR_WHITE();
 	$mycallcolor = COLOR_PAIR(1);
 	@colors = (
-		   [ '^DX de [\-A-Z0-9]+:\s+([57][01]\d\d\d\.|\d\d\d\d\d\d+.)', COLOR_PAIR(1) ],
-		   [ '^DX', COLOR_PAIR(5) ],
-		   [ '^To', COLOR_PAIR(3) ],
-		   [ '^(?:WWV|WCY)', COLOR_PAIR(4) ],
-		   [ '^[-A-Z0-9]+ de [-A-Z0-9]+ \d\d-\w\w\w-\d\d\d\d \d\d\d\dZ', COLOR_PAIR(0) ],
-		   [ '^[-A-Z0-9]+ de [-A-Z0-9]+ ', COLOR_PAIR(6) ],
-		   [ '^WX', COLOR_PAIR(3) ],
-		   [ '^(User|Node|Buddy)\b', COLOR_PAIR(8) ],
-		   [ '^New mail', A_BOLD|COLOR_PAIR(5) ],
-		    
-		   );
+			   [ '^[-A-Z0-9]+ de [-A-Z0-9]+ \d\d-\w\w\w-\d\d\d\d \d\d\d\dZ', COLOR_PAIR(0) ],
+			   [ '^DX de [\-A-Z0-9]+:\s+([57][01]\d\d\d\.|\d\d\d\d\d\d+.)', COLOR_PAIR(1) ],
+			   [ '-#', COLOR_PAIR(2) ],
+			   [ '^To', COLOR_PAIR(3) ],
+			   [ '^WX', COLOR_PAIR(3) ],
+			   [ '^(?:WWV|WCY)', COLOR_PAIR(4) ],
+			   [ '^DX', COLOR_PAIR(5) ],
+			   [ '^[-A-Z0-9]+ de [-A-Z0-9]+ ', COLOR_PAIR(6) ],
+			   [ '^(User|Node|Buddy)\b', COLOR_PAIR(8) ],
+			   [ '^New mail', A_BOLD|COLOR_PAIR(5) ],
+			  );
 }
 if ($ENV{'TERM'} =~ /(console|linux)/) {
 	$foreground = COLOR_WHITE();
 	$background = COLOR_BLACK();
 	$mycallcolor = COLOR_PAIR(1);
 	@colors = (
-		   [ '^DX de [\-A-Z0-9]+:\s+([57][01]\d\d\d\.|\d\d\d\d\d\d+.)', COLOR_PAIR(1) ],
-		   [ '^DX', COLOR_PAIR(4) ],
-		   [ '^To', COLOR_PAIR(3) ],
-		   [ '^(?:WWV|WCY)', COLOR_PAIR(5) ],
-		   [ '^[-A-Z0-9]+ de [-A-Z0-9]+ \d\d-\w\w\w-\d\d\d\d \d\d\d\dZ', COLOR_PAIR(0) ],
-		   [ '^[-A-Z0-9]+ de [-A-Z0-9]+ ', COLOR_PAIR(6) ],
-		   [ '^WX', COLOR_PAIR(3) ],
-		   [ '^(User|Node)\b', A_BOLD|COLOR_PAIR(8) ],
-		   [ '^New mail', A_BOLD|COLOR_PAIR(5) ],
-		   );
+			   [ '^DX de [\-A-Z0-9]+:\s+([57][01]\d\d\d\.|\d\d\d\d\d\d+.)', COLOR_PAIR(1) ],
+			   [ '^-#:', COLOR_PAIR(2) ],
+			   [ '^DX', COLOR_PAIR(4) ],
+			   [ '^To', COLOR_PAIR(3) ],
+			   [ '^(?:WWV|WCY)', COLOR_PAIR(5) ],
+			   [ '^[-A-Z0-9]+ de [-A-Z0-9]+ \d\d-\w\w\w-\d\d\d\d \d\d\d\dZ', COLOR_PAIR(0) ],
+			   [ '^[-A-Z0-9]+ de [-A-Z0-9]+ ', COLOR_PAIR(6) ],
+			   [ '^WX', COLOR_PAIR(3) ],
+			   [ '^(User|Node)\b', A_BOLD|COLOR_PAIR(8) ],
+			   [ '^New mail', A_BOLD|COLOR_PAIR(5) ],
+			  );
 }
 
 
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index f2a1638c..c2358c3d 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -19,7 +19,7 @@
 # firstly and OO about ninthly (if you don't like the design and you can't 
 # improve it with better OO and thus make it smaller and more efficient, then tough). 
 #
-# Copyright (c) 1998-2000 - Dirk Koopman G1TLH
+# Copyright (c) 1998-2016 - Dirk Koopman G1TLH
 #
 #
 #
@@ -80,12 +80,14 @@ $count = 0;
 		  wcyfilter => '5,WCY Filt-out',
 		  spotsfilter => '5,Spot Filt-out',
 		  routefilter => '5,Route Filt-out',
+		  rbnfilter => '5,RBN Filt-out',
 		  pc92filter => '5,PC92 Route Filt-out',
 		  inannfilter => '5,Ann Filt-inp',
 		  inwwvfilter => '5,WWV Filt-inp',
 		  inwcyfilter => '5,WCY Filt-inp',
 		  inspotsfilter => '5,Spot Filt-inp',
 		  inroutefilter => '5,Route Filt-inp',
+		  inrbnfilter => '5,RBN Filt-inp',
 		  inpc92filter => '5,PC92 Route Filt-inp',
 		  passwd => '9,Passwd List,yesno',
 		  pingint => '5,Ping Interval ',
@@ -125,6 +127,9 @@ $count = 0;
 		  inqueue => '9,Input Queue,parray',
 		  next_pc92_update => '9,Next PC92 Update,atime',
 		  next_pc92_keepalive => '9,Next PC92 KeepAlive,atime',
+		  hostname => '0,Hostname',
+		  isslugged => '9,Still Slugged,yesno',
+		  sluggedpcs => '9,Slugged PCxx Queue,parray',
 		 );
 
 $maxerrors = 20;				# the maximum number of concurrent errors allowed before disconnection
@@ -161,20 +166,19 @@ sub alloc
 		$self->{sort} = $user->sort;
 		$self->{width} = $user->width;
 	}
-	$self->{startt} = $self->{t} = time;
+	$self->{startt} = $self->{t} = $main::systime;
 	$self->{state} = 0;
 	$self->{oldstate} = 0;
 	$self->{lang} = $main::lang if !$self->{lang};
 	$self->{func} = "";
 	$self->{width} ||=  80;
-	
 
 	# add in all the dxcc, itu, zone info
 	my @dxcc = Prefix::extract($call);
 	if (@dxcc > 0) {
 		$self->{dxcc} = $dxcc[1]->dxcc;
 		$self->{itu} = $dxcc[1]->itu;
-		$self->{cq} = $dxcc[1]->cq;						
+		$self->{cq} = $dxcc[1]->cq;
 	}
 	$self->{inqueue} = [];
 
@@ -216,6 +220,7 @@ sub rec
 	if (defined $msg) {
 		push @{$self->{inqueue}}, $msg;
 	}
+	$self->process_one;
 }
 
 # obtain a channel object by callsign [$obj = DXChannel::get($call)]
@@ -301,69 +306,70 @@ sub del
 # is it a bbs
 sub is_bbs
 {
-	my $self = shift;
-	return $self->{'sort'} eq 'B';
+	return $_[0]->{sort} eq 'B';
 }
 
 sub is_node
 {
-	my $self = shift;
-	return $self->{'sort'} =~ /[ACRSXW]/;
+	return $_[0]->{sort} =~ /^[ACRSX]$/;
 }
 # is it an ak1a node ?
 sub is_ak1a
 {
-	my $self = shift;
-	return $self->{'sort'} eq 'A';
+	return $_[0]->{sort} eq 'A';
 }
 
 # is it a user?
 sub is_user
 {
-	my $self = shift;
-	return $self->{'sort'} eq 'U';
+	return $_[0]->{sort} =~ /^[UW]$/;
 }
 
 # is it a clx node
 sub is_clx
 {
-	my $self = shift;
-	return $self->{'sort'} eq 'C';
+	return $_[0]->{sort} eq 'C';
 }
 
-# it is Aranea
-sub is_aranea
+# it is a Web connected user
+sub is_web
 {
-	my $self = shift;
-	return $self->{'sort'} eq 'W';
+	return $_[0]->{sort} eq 'W';
 }
 
 # is it a spider node
 sub is_spider
 {
-	my $self = shift;
-	return $self->{'sort'} eq 'S';
+	return $_[0]->{sort} eq 'S';
 }
 
 # is it a DXNet node
 sub is_dxnet
 {
-	my $self = shift;
-	return $self->{'sort'} eq 'X';
+	return $_[0]->{sort} eq 'X';
 }
 
 # is it a ar-cluster node
 sub is_arcluster
 {
-	my $self = shift;
-	return $self->{'sort'} eq 'R';
+	return $_[0]->{sort} eq 'R';
+}
+
+sub is_rbn
+{
+	return $_[0]->{sort} eq 'N';
+}
+
+sub is_dslink
+{
+	return $_[0]->{sort} eq 'L';
 }
 
 # for perl 5.004's benefit
 sub sort
 {
 	my $self = shift;
-	return @_ ? $self->{'sort'} = shift : $self->{'sort'} ;
+	return @_ ? $self->{sort} = shift : $self->{sort} ;
 }
 
 # find out whether we are prepared to believe this callsign on this interface
@@ -502,7 +508,7 @@ sub disconnect
 	my $self = shift;
 	my $user = $self->{user};
 	
-	$user->close() if defined $user;
+	$user->close($self->{startt}, $self->{hostname}) if defined $user;
 	$self->{conn}->disconnect if $self->{conn};
 	$self->del();
 }
@@ -589,7 +595,7 @@ sub decode_input
 {
 	my $dxchan = shift;
 	my $data = shift;
-	my ($sort, $call, $line) = $data =~ /^([A-Z])([A-Z0-9\-]{3,9})\|(.*)$/;
+	my ($sort, $call, $line) = $data =~ /^([A-Z])(#?[A-Z0-9\/\-]{3,25})\|(.*)$/;
 
 	my $chcall = (ref $dxchan) ? $dxchan->call : "UN.KNOWN";
 	
@@ -681,7 +687,7 @@ sub broadcast_list
 		
 		if ($sort eq 'dx') {
 		    next unless $dxchan->{dx};
-			($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref;
+			($filter) = $dxchan->{spotsfilter}->it($fref) if $dxchan->{spotsfilter} && ref $fref;
 			next unless $filter;
 		}
 		next if $sort eq 'ann' && !$dxchan->{ann} && $s !~ /^To\s+LOCAL\s+de\s+(?:$main::myalias|$main::mycall)/i;
@@ -699,42 +705,48 @@ sub broadcast_list
 	}
 }
 
-sub process
+sub process_one
 {
-	foreach my $dxchan (get_all()) {
-		next if $dxchan->{disconnecting};
+	my $self = shift;
+
+	while (my $data = shift @{$self->{inqueue}}) {
+		my ($sort, $call, $line) = $self->decode_input($data);
+		next unless defined $sort;
 		
-		while (my $data = shift @{$dxchan->{inqueue}}) {
-			my ($sort, $call, $line) = $dxchan->decode_input($data);
-			next unless defined $sort;
-
-			# do the really sexy console interface bit! (Who is going to do the TK interface then?)
-			dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan');
-
-			# handle A records
-			my $user = $dxchan->user;
-			if ($sort eq 'A' || $sort eq 'O') {
-				$dxchan->start($line, $sort);
-			} elsif ($sort eq 'I') {
-				die "\$user not defined for $call" if !defined $user;
+		# do the really sexy console interface bit! (Who is going to do the TK interface then?)
+		dbg("<- $sort $call $line") if $sort ne 'D' && isdbg('chan');
+		
+		# handle A records
+		my $user = $self->user;
+		if ($sort eq 'I') {
+			die "\$user not defined for $call" unless defined $user;
 			
-				# normal input
-				$dxchan->normal($line);
-			} elsif ($sort eq 'Z') {
-				$dxchan->disconnect;
-			} elsif ($sort eq 'D') {
-				;				# ignored (an echo)
-			} elsif ($sort eq 'C') {
-				$dxchan->width($line); # change number of columns
-			} elsif ($sort eq 'G') {
-				$dxchan->enhanced($line);
-			} else {
-				print STDERR atime, " Unknown command letter ($sort) received from $call\n";
-			}
+			# normal input
+			$self->normal($line);
+		} elsif ($sort eq 'G') {
+			$self->enhanced($line);
+		} elsif ($sort eq 'A' || $sort eq 'O' || $sort eq 'W') {
+			$self->start($line, $sort);
+		} elsif ($sort eq 'C') {
+			$self->width($line); # change number of columns
+		} elsif ($sort eq 'Z') {
+			$self->disconnect;
+		} elsif ($sort eq 'D') {
+			;				# ignored (an echo)
+		} else {
+			dbg atime . " DXChannel::process_one: Unknown command letter ($sort) received from $call\n";
 		}
 	}
 }
 
+sub process
+{
+	foreach my $dxchan (values %channels) {
+		next if $dxchan->{disconnecting};
+		$dxchan->process_one;
+	}
+}
+
 sub handle_xml
 {
 	my $self = shift;
@@ -748,12 +760,22 @@ sub handle_xml
 	return $r;
 }
 
-sub registered
+sub error_handler
+{
+	my $self = shift;
+	my $error = shift || '';
+	dbg("$self->{call} ERROR '$error', closing") if isdbg('chan');
+	$self->{conn}->set_error(undef) if exists $self->{conn};
+	$self->disconnect(1);
+}
+
+
+sub isregistered
 {
 	my $self = shift;
 
 	# the sysop is registered!
-	return 1 if $self->call eq $main::myalias || $self->call eq $main::mycall;
+	return 1 if $self->{call} eq $main::myalias || $self->{call} eq $main::mycall;
 	
 	if ($main::reqreg) {
 		return $self->{registered};
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 6023320d..5ea58ea1 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -13,6 +13,8 @@ package DXCommandmode;
 
 @ISA = qw(DXChannel);
 
+use 5.10.1;
+
 use POSIX qw(:math_h);
 use DXUtil;
 use DXChannel;
@@ -40,7 +42,7 @@ use AsyncMsg;
 
 use strict;
 use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase %nothereslug
-	$maxbadcount $msgpolltime $default_pagelth $cmdimportdir);
+	$maxbadcount $msgpolltime $default_pagelth $cmdimportdir $users $maxusers);
 
 %Cache = ();					# cache of dynamically loaded routine's mod times
 %cmd_cache = ();				# cache of short names
@@ -51,7 +53,8 @@ $maxbadcount = 3;				# no of bad words allowed before disconnection
 $msgpolltime = 3600;			# the time between polls for new messages 
 $cmdimportdir = "$main::root/cmd_import"; # the base directory for importing command scripts 
                                           # this does not exist as default, you need to create it manually
-#
+$users = 0;					  # no of users on this node currently
+$maxusers = 0;				  # max no users on this node for this run
 
 #
 # obtain a new connection this is derived from dxchannel
@@ -65,7 +68,7 @@ sub new
 	my $pkg = shift;
 	my $call = shift;
 #	my @rout = $main::routeroot->add_user($call, Route::here(1));
-	DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $self->{conn}->peerhost], );
+	DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $self->hostname], );
 
 	# ALWAYS output the user
 	my $ref = Route::User::get($call);
@@ -92,7 +95,7 @@ sub start
 	my $host = $self->{conn}->peerhost;
 	$host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport};
 	$host ||= "unknown";
-	LogDbg('DXCommand', "$call connected from $host");
+	$self->{hostname} = $host;
 
 	$self->{name} = $name ? $name : $call;
 	$self->send($self->msg('l2',$self->{name}));
@@ -102,10 +105,22 @@ sub start
 	my $pagelth = $user->pagelth;
 	$pagelth = $default_pagelth unless defined $pagelth;
 	$self->{pagelth} = $pagelth;
-	($self->{width}) = $line =~ /width=(\d+)/; $line =~ s/\s*width=\d+\s*//;
+	($self->{width}) = $line =~ /\s*width=(\d+)/; $line =~ s/\s*width=\d+//;
+	$self->{enhanced} = $line =~ /\s+enhanced/; $line =~ s/\s*enhanced//;
+	if ($line =~ /host=/) {
+		my ($h) = $line =~ /host=(\d+\.\d+\.\d+\.\d+)/;
+		$line =~ s/\s*host=\d+\.\d+\.\d+\.\d+// if $h;
+		unless ($h) {
+			($h) = $line =~ /host=([\da..fA..F:]+)/;
+			$line =~ s/\s*host=[\da..fA..F:]+// if $h;
+		}
+		$self->{hostname} = $h if $h;
+	}
 	$self->{width} = 80 unless $self->{width} && $self->{width} > 80;
 	$self->{consort} = $line;	# save the connection type
-	
+
+	LogDbg('DXCommand', "$call connected from $self->{hostname} cols $self->{width}" . ($self->{enhanced}?" enhanced":''));
+
 	# set some necessary flags on the user if they are connecting
 	$self->{beep} = $user->wantbeep;
 	$self->{ann} = $user->wantann;
@@ -118,24 +133,30 @@ sub start
 	$self->{ann_talk} = $user->wantann_talk;
 	$self->{here} = 1;
 	$self->{prompt} = $user->prompt if $user->prompt;
+	$self->{lastmsgpoll} = 0;
 
 	# sort out new dx spot stuff
 	$user->wantdxcq(0) unless defined $user->{wantdxcq};
 	$user->wantdxitu(0) unless defined $user->{wantdxitu};	
 	$user->wantusstate(0) unless defined $user->{wantusstate};
 
-	# sort out registration (who wanted 2???) Note registration *could* be used even when reqreg == 0
+	# sort out registration
 	if ($main::reqreg == 2) {
 		$self->{registered} = !$user->registered;
 	} else {
 		$self->{registered} = $user->registered;
-	}
+	} 
+
+	# establish slug queue, if required
+	$self->{sluggedpcs} = [];
+	$self->{isslugged} = $DXProt::pc92_slug_changes + $DXProt::last_pc92_slug + 5 if $DXProt::pc92_slug_changes;
+	$self->{isslugged} = 0 if $self->{priv} || $user->registered || ($user->homenode && $user->homenode eq $main::mycall);
 
 	# send the relevant MOTD
 	$self->send_motd;
 
 	# sort out privilege reduction
-	$self->{priv} = 0 if $line =~ /^(ax|te)/ && !$self->conn->{usedpasswd};
+	$self->{priv} = 0 unless $self->{hostname} eq '127.0.0.1' || $self->{hostname} eq '::1' || $self->conn->{usedpasswd};
 
 	# get the filters
 	my $nossid = $call;
@@ -187,8 +208,7 @@ sub start
 	$script->run($self) if $script;
 
 	# send cluster info
-	my $info = Route::cluster();
-	$self->send("Cluster:$info");
+	$self->send($self->run_cmd("show/cluster"));
 
 	# send prompts for qth, name and things
 	$self->send($self->msg('namee1')) if !$user->name;
@@ -468,7 +488,7 @@ sub send_ans
 }
 
 # 
-# this is the thing that runs the command, it is done like this for the 
+# this is the thing that preps for running the command, it is done like this for the 
 # benefit of remote command execution
 #
 
@@ -490,7 +510,7 @@ sub run_cmd
 
 		# check cmd
 		if ($cmd =~ m|^/| || $cmd =~ m|[^-?\w/]|) {
-			LogDbg('DXCommand', "cmd: invalid characters in '$cmd'");
+			LogDbg('DXCommand', "cmd: $self->{call} - invalid characters in '$cmd'");
 			return $self->_error_out('e1');
 		}
 
@@ -556,9 +576,10 @@ sub process
 	my $t = time;
 	my @dxchan = DXChannel::get_all();
 	my $dxchan;
-	
+
+	$users = 0;
 	foreach $dxchan (@dxchan) {
-		next if $dxchan->sort ne 'U';  
+		next unless $dxchan->is_user;  
 	
 		# send a outstanding message prompt if required
 		if ($t >= $dxchan->lastmsgpoll + $msgpolltime) {
@@ -571,11 +592,19 @@ sub process
 			$dxchan->prompt() if $dxchan->{state} =~ /^prompt/o;
 			$dxchan->t($t);
 		}
-	}
+		++$users;
+		$maxusers = $users if $users > $maxusers;
+
+		if ($dxchan->{isslugged} && $main::systime > $dxchan->{isslugged}) {
+			foreach my $ref (@{$dxchan->{sluggedpcs}}) {
+				if ($ref->[0] == 61) {
+					Spot::add(@{$ref->[2]});
+					DXProt::send_dx_spot($dxchan, $ref->[1], @{$ref->[2]});
+				}
+			}
 
-	while (my ($k, $v) = each %nothereslug) {
-		if ($main::systime >= $v + 300) {
-			delete $nothereslug{$k};
+			$dxchan->{isslugged} = 0;
+			$dxchan->{sluggedpcs} = [];
 		}
 	}
 
@@ -600,7 +629,7 @@ sub disconnect
 #		@rout = $main::routeroot->del_user($uref);
 		@rout = DXProt::_del_thingy($main::routeroot, [$call, 0]);
 
-		dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route');
+		# dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route');
 
 		# issue a pc17 to everybody interested
 		$main::me->route_pc17($main::mycall, undef, $main::routeroot, $uref);
@@ -652,7 +681,7 @@ sub broadcast
 	my $s = shift;				# the line to be rebroadcast
 	
     foreach my $dxchan (DXChannel::get_all()) {
-		next unless $dxchan->{sort} eq 'U'; # only interested in user channels  
+		next unless $dxchan->is_user; # only interested in user channels  
 		next if grep $dxchan == $_, @_;
 		$dxchan->send($s);			# send it
 	}
@@ -661,7 +690,7 @@ sub broadcast
 # gimme all the users
 sub get_all
 {
-	return grep {$_->{sort} eq 'U'} DXChannel::get_all();
+	goto &DXChannel::get_all_users;
 }
 
 # run a script for this user
@@ -791,7 +820,7 @@ sub find_cmd_name {
 		#we have compiled this subroutine already,
 		#it has not been updated on disk, nothing left to do
 		#print STDERR "already compiled $package->handler\n";
-		;
+		dbg("find_cmd_name: $package cached") if isdbg('command');
 	} else {
 
 		my $sub = readfilestr($filename);
@@ -801,7 +830,7 @@ sub find_cmd_name {
 		};
 		
 		#wrap the code into a subroutine inside our unique package
-		my $eval = qq(package DXCommandmode::$package; use POSIX qw{:math_h}; use DXLog; use DXDebug; use DXUser; use DXUtil; our \@ISA = qw{DXCommandmode}; );
+		my $eval = qq(package DXCommandmode::$package; use 5.10.1; use POSIX qw{:math_h}; use DXLog; use DXDebug; use DXUser; use DXUtil; our \@ISA = qw{DXCommandmode}; );
 
 
 		if ($sub =~ m|\s*sub\s+handle\n|) {
@@ -921,7 +950,7 @@ sub announce
 		$buf = dd(['ann', $to, $target, $text, @_])
 	} else {
 		$buf = "$to$target de $_[0]: $text";
-		$buf =~ s/\%5E/^/g;
+		#$buf =~ s/\%5E/^/g;
 		$buf .= "\a\a" if $self->{beep};
 	}
 	$self->local_send($target eq 'WX' ? 'W' : 'N', $buf);
@@ -946,7 +975,7 @@ sub chat
 		$buf = dd(['chat', $to, $target, $text, @_])
 	} else {
 		$buf = "$target de $_[0]: $text";
-		$buf =~ s/\%5E/^/g;
+		#$buf =~ s/\%5E/^/g;
 		$buf .= "\a\a" if $self->{beep};
 	}
 	$self->local_send('C', $buf);
@@ -957,15 +986,15 @@ sub format_dx_spot
 	my $self = shift;
 
 	my $t = ztime($_[2]);
-	my $loc = '';
 	my ($slot1, $slot2) = ('', '');
 	
 	my $clth = 30 + $self->{width} - 80;    # allow comment to grow according the screen width 
-	my $comment = substr (($_[3] || ''), 0, $clth);
-	$comment =~ s/\t/ /g;
+	my $c = $_[3];
+	$c =~ s/\t/ /g;
+	my $comment = substr (($c || ''), 0, $clth);
 	$comment .= ' ' x ($clth - (length($comment)));
-
-	if (!$slot1 && $self->{user}->wantgrid) {
+	
+    if (!$slot1 && $self->{user}->wantgrid) {
 		my $ref = DXUser::get_current($_[1]);
 		if ($ref && $ref->qra) {
 			$slot1 = ' ' . substr($ref->qra, 0, 4);
@@ -1005,6 +1034,7 @@ sub format_dx_spot
 	return sprintf "DX de %-8.8s%10.1f  %-12.12s %-s $t$slot2", "$_[4]:", $_[0], $_[1], $comment;
 }
 
+
 # send a dx spot
 sub dx_spot
 {
@@ -1046,7 +1076,7 @@ sub dx_spot
 	} else {
 		$buf = $self->format_dx_spot(@_);
 		$buf .= "\a\a" if $self->{beep};
-		$buf =~ s/\%5E/^/g;
+		#$buf =~ s/\%5E/^/g;
 	}
 
 	$self->local_send('X', $buf);
@@ -1106,7 +1136,7 @@ sub broadcast_debug
 {
 	my $s = shift;				# the line to be rebroadcast
 	
-	foreach my $dxchan (DXChannel::get_all) {
+	foreach my $dxchan (DXChannel::get_all_users) {
 		next unless $dxchan->{enhanced} && $dxchan->{senddbg};
 		if ($dxchan->{gtk}) {
 			$dxchan->send_later('L', dd(['db', $s]));
@@ -1182,6 +1212,9 @@ sub import_cmd
 	my @names = readdir(DIR);
 	closedir(DIR);
 	my $name;
+
+	return unless @names;
+	
 	foreach $name (@names) {
 		next if $name =~ /^\./;
 
@@ -1246,7 +1279,7 @@ sub send_motd
 	my $self = shift;
 	my $motd;
 
-	unless ($self->registered) {
+	unless ($self->isregistered) {
 		$motd = "${main::motd}_nor_$self->{lang}";
 		$motd = "${main::motd}_nor" unless -e $motd;
 	}
@@ -1262,6 +1295,10 @@ sub send_motd
 	$self->send_file($motd) if -e $motd;
 }
 
+sub user_count
+{
+	return ($users, $maxusers);
+}
 
 1;
 __END__
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index fae6dde0..b6c0b759 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -248,6 +248,7 @@ sub init
 	$main::me->{version} = $main::version;
 	$main::me->{build} = $main::build;
 	$main::me->{do_pc9x} = 1;
+	$main::me->{hostname} = $main::clusteraddr;
 	$main::me->update_pc92_next($pc92_short_update_period);
 	$main::me->update_pc92_keepalive;
 }
@@ -288,7 +289,9 @@ sub start
 	# log it
 	my $host = $self->{conn}->peerhost;
 	$host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport};
+	$host ||= $host if is_ipaddr($host);
 	$host ||= "unknown";
+	$self->{hostname} = $host;
 
 	Log('DXProt', "$call connected from $host");
 
diff --git a/perl/Messages b/perl/Messages
index 565ec38f..2554d270 100644
--- a/perl/Messages
+++ b/perl/Messages
@@ -34,6 +34,7 @@ package DXM;
 				chatinst => 'Entering Chatmode on $_[0], /EX to end, /<cmd> to run a command',
 				chatprompt => 'Chat ($_[0])>',
 				chattoomany => 'Not allowed, already in $_[1], use /chat $_[0]',
+				cluster => 'Nodes: $_[0]/$_[1] Users [Loc/Clr]: $_[2]/$_[3] Max: $_[4]/$_[5] - Uptime: $_[6]',
 				conother => 'Sorry $_[0] you are connected to me on another port',
 				concluster => 'Sorry $_[0] you are already connected elsewhere on the cluster (on $_[1])',
 				contomany => 'Sorry $_[0] but you are already connected to $_[1] other nodes (on $_[2])',
@@ -67,6 +68,7 @@ package DXM;
 				dx1 => 'Frequency $_[0] not in band (see show/band); usage: DX [BY call] freq call comments',
 				dx2 => 'Need a callsign; usage: DX [BY call] freq call comments',
 				dx3 => 'The callsign or frequency is invalid',
+				dx4 => 'The ip address ($_[0]) is invalid',
 				dxcqs => 'DX CQ Zones enabled for $_[0]',
 				dxcqu => 'DX CQ Zones disabled for $_[0]',
 				dxitus => 'DX ITU Zones enabled for $_[0]',
@@ -91,8 +93,8 @@ package DXM;
 				e16 => 'File \"$_[0]\" exists',
 				e17 => 'Please don\'t use the words: @_ on here',
 				e18 => 'Cannot connect to $_[0] ($!)',
-				e19 => 'Invalid character in line',
-				e20 => 'token $_[0] not recognised',
+				e19 => 'Invalid character(s) in line $_[0]',
+				e20 => qq{token '$_[0]' not recognised},
 				e21 => '$_[0] is not numeric',
 				e22 => '$_[0] is not a callsign',
 				e23 => '$_[0] is not a range (eg 0/30000)',
@@ -111,6 +113,7 @@ package DXM;
 				e36 => 'You can only do this in normal user prompt state',
 				e37 => 'Need at least a callsign',
 				e38 => 'This is not a valid regex',
+				e39 => 'Sorry $_[0] is not a valid argument',
 
 				echoon => 'Echoing enabled',
 				echooff => 'Echoing disabled',
@@ -127,6 +130,7 @@ package DXM;
 				filter4 => '$_[0]$_[1] Filter $_[2] deleted for $_[3]',
 				filter5 => 'need some filter commands...',
 				filter6 => '$_[0]$_[1] Filter for $[2] not found',
+				filter7 => '$_[0] parse error $_[1] on $_[2]', 
 				grayline1 => '                                                 Beg of               End of',
 				grayline2 => 'Location                              dd/mm/yyyy Dawn   Rise   Set    Dusk',
 				grids => 'DX Grid enabled for $_[0]',
@@ -160,7 +164,7 @@ package DXM;
 				isow => '$_[0] is isolated; unset/isolate $_[0] first',
 				join => 'joining group $_[0]',
 				l1 => 'Sorry $_[0], you are already logged on on another channel',
-				l2 => 'Hello $_[0], this is $main::mycall in $main::myqth\nrunning DXSpider V$main::version build $main::build on $^O',
+				l2 => 'Hello $_[0], this is $main::mycall in $main::myqth\nrunning DXSpider V$main::version build $main::build',
 				lang => 'Language is now English',
 				lange1 => 'set/language <lang> where <lang> is one of ($_[0])',
 				lange2 => 'failed to set language on $_[0]', 
@@ -206,8 +210,9 @@ package DXM;
 				m17 => 'Sorry, cannot send messages in $_[0] mode',
 				m18 => 'Sorry, message $_[0] is currently set to KEEP',
 				m19 => 'Startup Script for $_[0] saved, $_[1] lines',
-				m20 => 'Empty Startup Script for $_[0] deleted',
+				m20 => 'Startup Script for $_[0] deleted',
 				m21 => '$_[0] Working...',
+				m22 => 'Startup Script for $_[0] not found/error $!',
 				maxconnect => 'Max connections on $_[0] set to $_[1]',
 				msg1 => 'Bulletin Messages Queued',
 				msg2 => 'Private Messages Queued',
@@ -232,6 +237,8 @@ package DXM;
 				noderc => '$_[0] created as AR-Cluster style Node',
 				nodes => '$_[0] set as DXSpider style Node',
 				nodesc => '$_[0] created as DXSpider style Node',
+				noden => '$_[0] set as RBN Feed ',
+				nodenc => '$_[0] created as RBN Feed',
 				nodex => '$_[0] set as DXNET style Node',
 				nodexc => '$_[0] created as DXNET style Node',
 				nodeu => '$_[0] set back as a User',
@@ -242,7 +249,7 @@ package DXM;
 				ok => 'Operation successful',
 				outconn => 'Outstanding connect to $_[0]',
 				page => 'Press Enter to continue, A to abort ($_[0] lines) >',
-				pagelth => 'Page Length is now $_[0]',
+				pagelth => 'Page Length is now $_[0] lines',
 				pagewidth => 'Page width is now $_[0] columns',
 				passerr => 'Please use: SET/PASS <password> <callsign>',
 				passphrase => 'Passphrase set or changed for $_[0]',
@@ -273,6 +280,7 @@ package DXM;
 				qrashe1 => 'Please enter a QRA locator, eg sh/qra JO02LQ or sh/qra JO02LQ IO93NS',
 				qrae2 => 'Don\'t recognise \"$_[0]\" as a QRA locator (eg JO02LQ)',
 				qra => 'Your QRA Locator is now \"$_[0]\"',
+				rbnusers => qq{RBN User List},
 				qsl1 => 'Call           Manager   Times  Last Time Seen      De',
 				rcmdo => 'RCMD \"$_[0]\" sent to $_[1]',
 				read1 => 'Sorry, no new messages for you',
@@ -298,6 +306,7 @@ package DXM;
 				showconf => 'Node         Callsigns',
 				shu => '\"SHU\" is not enough! you need to type at least \"SHUT\" to shutdown the node',
 				shutting => '$main::mycall shutting down...',
+				skims => 'RBN/Skimming set to $_[1] for $_[0]',
 				sloc => 'Cluster lat $_[0] long $_[1], DON\'T FORGET TO CHANGE YOUR DXVars.pm',
 				snode1 => 'Node Call   Sort    Version',
 				snode2 => '$_[0] $_[1]  $_[2]',
@@ -339,6 +348,8 @@ package DXM;
 				usernf => '*** User record for $_[0] not found ***',
 				usstates => 'US State display enabled for $_[0]',
 				usstateu => 'US State display disabled for $_[0]',
+				wante => 'Want $_[0] enabled for $_[1]',
+				wantd => 'Want $_[0] disabled for $_[1]',
 				wcy1 => '$_[0] is missing or out of range',
 				wcy2 => 'Duplicate WCY',
 				wcy3 => 'Date        Hour   SFI   A   K Exp.K   R SA    GMF   Aurora   Logger',
@@ -352,7 +363,7 @@ package DXM;
 				wpc9xu => 'PC9X for $_[0] disabled',
 				wwv1 => '$_[0] is missing or out of range',
 				wwv2 => 'Duplicate WWV',
-				wwv3 => 'Date        Hour   SFI   A   K Forecast                               Logger',
+				wwv3 => 'Date        Hour   SFI   A   K Forecast                              Logger',
 				wwvs => 'WWV enabled for $_[0]',
 				wwvu => 'WWV disabled $_[0]',
 				wxs => 'WX enabled for $_[0]',
@@ -524,7 +535,7 @@ package DXM;
 				e16 => 'Le fichier \"$_[0]\" existe déjà',
 				e17 => 'Prière de ne pas utiliser les mots : @_ ici !', 
 				e18 => 'Connexion impossible avec $_[0] ($!)',
-				e19 => 'Caractère non valide dans la ligne',
+				e19 => 'Caractère non valide dans la ligne $_[0]',
 				e20 => 'Symbole $_[0] non reconnu',
 				e21 => '$_[0] n\'est pas une valeur numérique',
 				e22 => '$_[0] n\'est pas un indicatif',
@@ -846,7 +857,7 @@ package DXM;
 				e16 => 'El fichero \"$_[0]\" ya existe',
 				e17 => 'Por favor no uses la palabra: @_ aquí',
 				e18 => 'No se puede conectar con $_[0] ($!)',
-				e19 => 'Carácter no válido en la línea',
+				e19 => 'Carácter no válido en la línea $_[0]',
 				e20 => 'Símbolo $_[0] no reconocido',
 				e21 => '$_[0] no es numérico',
 				e22 => '$_[0] no es un indicativo',
@@ -1171,7 +1182,7 @@ package DXM;
 				e16 => 'Datei \"$_[0]\" existiert',
 				e17 => 'Bitte gebrauche dieses Wort: @_ nicht hier',
 				e18 => 'Kann nicht verbinden mit $_[0] ($!)',
-				e19 => 'Ungueltiger Character in der Zeile',
+				e19 => 'Ungueltiger Character in der Zeile $_[0]',
 				e20 => 'Kuerzel $_[0] nicht erkannt',
 				e21 => '$_[0] nicht numerisch',
 				e22 => '$_[0] kein Rufzeichen',
@@ -1445,7 +1456,7 @@ package DXM;
 				e16 => 'Il file \"$_[0]\" esiste',
 				e17 => 'Non usare le parole: @_ qui', 
 				e18 => 'Impossibile connettere $_[0] ($!)',
-				e19 => 'Carattere non valido nella linea',
+				e19 => 'Carattere non valido nella linea  $_[0]',
 				e20 => 'separatore $_[0] non riconosciuto',
 				e21 => '$_[0] non e\' numerico',
 				e22 => '$_[0] non e\' un nominativo',
@@ -1718,7 +1729,7 @@ package DXM;
 				e16 => 'Soubor \"$_[0]\" uz existuje',
 				e17 => 'Prosim nepouzivej zde toto slovo: @_', 
 				e18 => 'Nemohu se pripojit na $_[0] ($!)',
-				e19 => 'neplatny znak v radku',
+				e19 => 'neplatny znak v radku  $_[0]',
 				e20 => 'retezec $_0] nebyl rozpoznan',
 				e21 => '$_[0] neni cislo',
 				e22 => '$_[0] neni znacka',
@@ -2010,7 +2021,7 @@ package DXM;
 				e16 => 'O ficheiro \"$_[0]\" existe',
 				e17 => 'Por favor no use as palavras: @_ aqui', 
 				e18 => 'No posso ligar a $_[0] ($!)',
-				e19 => 'Caracter invlido na linha',
+				e19 => 'Caracter invlido na linha $_[0]',
 				e20 => 'sinal $_[0] no reconhecido',
 				e21 => '$_[0] no  numrico',
 				e22 => '$_[0] no  um indicativo',
diff --git a/perl/Route.pm b/perl/Route.pm
index c43fd34d..304b9c68 100644
--- a/perl/Route.pm
+++ b/perl/Route.pm
@@ -25,6 +25,7 @@ use strict;
 use vars qw(%list %valid $filterdef $maxlevel);
 
 %valid = (
+		  parent => '0,Parent Calls,parray',
 		  call => "0,Callsign",
 		  flags => "0,Flags,phex",
 		  dxcc => '0,Country Code',
@@ -32,6 +33,7 @@ use vars qw(%list %valid $filterdef $maxlevel);
 		  cq => '0,CQ Zone',
 		  state => '0,State',
 		  city => '0,City',
+		  ip => '0,IP Address',
 		 );
 
 $filterdef = bless ([
@@ -222,12 +224,14 @@ sub config
 					my $c;
 					if ($uref) {
 						$c = $uref->user_call;
-					} else {
+					}
+					else {
 						$c = "$ucall?";
 					}
 					if ((length $line) + (length $c) + 1 < $width) {
 						$line .= $c . ' ';
-					} else {
+					}
+					else {
 						$line =~ s/\s+$//;
 						push @out, $line;
 						$line = ' ' x ($level*2) . "$pcall->$c ";
@@ -238,7 +242,8 @@ sub config
 		$line =~ s/->$//g;
 		$line =~ s/\s+$//;
 		push @out, $line if length $line;
-	} else {
+	}
+	else {
 		# recursion detector
 		if ((DXChannel::get($call) && $level > 1) || $seen->{$call} || $level > $maxlevel) {
 			return @out;
@@ -270,11 +275,14 @@ sub cluster
 {
 	my $nodes = Route::Node::count();
 	my $tot = Route::User::count();
-	my $users = scalar DXCommandmode::get_all();
+	my ($users, $maxlocalusers) = DXCommandmode::user_count(); # the user count is wrong because of skimmers
 	my $maxusers = Route::User::max();
 	my $uptime = main::uptime();
+	my $localnodes = $DXChannel::count - $users;   # this is now wrong because of skimmers
+	
+	return ($nodes, $tot, $users, $maxlocalusers, $maxusers, $uptime, $localnodes);
+	
 
-	return " $nodes nodes, $users local / $tot total users  Max users $maxusers  Uptime $uptime";
 }
 
 #
diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm
index 89e84d40..76d98757 100644
--- a/perl/Route/Node.pm
+++ b/perl/Route/Node.pm
@@ -19,7 +19,6 @@ use vars qw(%list %valid @ISA $max $filterdef $obscount);
 @ISA = qw(Route);
 
 %valid = (
-		  parent => '0,Parent Calls,parray',
 		  nodes => '0,Nodes,parray',
 		  users => '0,Users,parray',
 		  usercount => '0,User Count',
@@ -29,11 +28,10 @@ use vars qw(%list %valid @ISA $max $filterdef $obscount);
 		  lastmsg => '0,Last Route Msg,atime',
 		  lastid => '0,Last Route MsgID',
 		  do_pc9x => '0,Uses pc9x,yesno',
-		  via_pc92 => '0,Came in via pc92,yesno',
+		  via_pc92 => '0,In via pc92?,yesno',
 		  obscount => '0,Obscount',
 		  last_PC92C => '9,Last PC92C',
-		  PC92C_dxchan => '9,Channel of PC92C,phash',
-		  ip => '0,IP Address',
+		  PC92C_dxchan => '9,PC92C hops,phash',
 );
 
 $filterdef = $Route::filterdef;
@@ -205,6 +203,14 @@ sub del_user
 	return @out;
 }
 
+# is a user on this node
+sub is_user
+{
+	my $self = shift;
+	my $call = shift;
+	return scalar grep {$_ eq $call} @{$self->{users}};
+}
+
 sub usercount
 {
 	my $self = shift;
@@ -272,6 +278,7 @@ sub calc_config_changes
 	return (\@dnodes, \@dusers, \@nnodes, \@nusers);
 }
 
+
 sub new
 {
 	my $pkg = shift;
diff --git a/perl/Route/User.pm b/perl/Route/User.pm
index 0cd17029..8c1c824d 100644
--- a/perl/Route/User.pm
+++ b/perl/Route/User.pm
@@ -17,11 +17,6 @@ use strict;
 use vars qw(%list %valid @ISA $max $filterdef);
 @ISA = qw(Route);
 
-%valid = (
-		  parent => '0,Parent Calls,parray',
-		  ip => '0,IP Address',
-);
-
 $filterdef = $Route::filterdef;
 %list = ();
 $max = 0;
@@ -99,8 +94,6 @@ sub delparent
     return $self->_dellist('parent', @_);
 }
 
-
-
 #
 # generic AUTOLOAD for accessors
 #
diff --git a/perl/cluster.pl b/perl/cluster.pl
index c2cb8e08..f1eade41 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -18,8 +18,6 @@ package main;
 use vars qw($data $system $cmd $localcmd $userfn $clusteraddr $clusterport $yes $no $user_interval $lang);
 
 $lang = 'en';                   # default language
-$clusteraddr = '127.0.0.1';     # cluster tcp host address - used for things like console.pl
-$clusterport = 27754;           # cluster tcp port
 $yes = 'Yes';                   # visual representation of yes
 $no = 'No';                     # ditto for no
 $user_interval = 11*60;         # the interval between unsolicited prompts if no traffic
@@ -141,6 +139,9 @@ use vars qw(@inqueue $systime $starttime $lockfn @outstanding_connects
 			$can_encode $maxconnect_user $maxconnect_node
 		   );
 
+
+$clusteraddr //= '127.0.0.1';     # cluster tcp host address - used for things like console.pl
+$clusterport //= 27754;           # cluster tcp port
 @inqueue = ();					# the main input queue, an array of hashes
 $systime = 0;					# the time now (in seconds)
 $starttime = 0;                 # the starting time of the cluster
diff --git a/perl/console.pl b/perl/console.pl
index 3fbc46fe..8de22e82 100755
--- a/perl/console.pl
+++ b/perl/console.pl
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/env perl
 #
 # this is the operators console.
 #
@@ -13,8 +13,8 @@
 #
 # 
 
-require 5.004;
-package main;
+require 5.10.1;
+use warnings;
 
 use vars qw($data $clusteraddr $clusterport);
 
@@ -42,7 +42,7 @@ use DXDebug;
 use IO::File;
 use Time::HiRes qw(gettimeofday tv_interval);
 use Curses 1.06;
-use Text::Wrap;
+use Text::Wrap qw(wrap);
 
 use Console;
 
@@ -50,27 +50,24 @@ use Console;
 # initialisation
 #
 
+$clusteraddr //= '127.0.0.1';
+$clusterport //= 27754;
+
 $call = "";                     # the callsign being used
 $node = "";                     # the node callsign being used
-
 $conn = 0;                      # the connection object for the cluster
 $lasttime = time;               # lasttime something happened on the interface
 
 $connsort = "local";
 @kh = ();
 @sh = ();
-$khistpos = 0;
+$kpos = 0;
 $spos = $pos = $lth = 0;
 $inbuf = "";
-@time = ();
+$inscroll = 0;
 
-#$SIG{WINCH} = sub {@time = gettimeofday};
 
-sub mydbg
-{
-	local *STDOUT = undef;
-	dbg(@_);
-}
+#$SIG{WINCH} = sub {@time = gettimeofday};
 
 # do the screen initialisation
 sub do_initscr
@@ -99,19 +96,21 @@ sub do_initscr
 
 	$top = $scr->subwin($lines-4, $cols, 0, 0);
 	$top->intrflush(0);
-	$top->scrollok(1);
+	$top->scrollok(0);
 	$top->idlok(1);
 	$top->meta(1);
-#	$scr->addstr($lines-4, 0, '-' x $cols);
+	$top->leaveok(1);
+	$top->clrtobot();
 	$bot = $scr->subwin(3, $cols, $lines-3, 0);
 	$bot->intrflush(0);
 	$bot->scrollok(1);
-	$top->idlok(1);
 	$bot->keypad(1);
 	$bot->move(1,0);
 	$bot->meta(1);
 	$bot->nodelay(1);
+	$bot->clrtobot();
 	$scr->refresh();
+
 	
 	$pagel = $lines-4;
 	$mycallcolor = COLOR_PAIR(1) unless $mycallcolor;
@@ -128,11 +127,11 @@ sub do_resize
 	$cols = COLS;
 	$has_colors = has_colors();
 	do_initscr();
+
 	$inscroll = 0;
 	$spos = @sh < $pagel ? 0 :  @sh - $pagel;
 	show_screen();
 	$conn->send_later("C$call|$cols") if $conn;
-	
 }
 
 # cease communications
@@ -168,7 +167,8 @@ sub setattr
 
 # display the top screen
 sub show_screen
-{	if ($inscroll) {
+{
+	if ($inscroll) {
 		
 		dbg("B: s:$spos h:" . scalar @sh) if isdbg('console');
 		my ($i, $l);
@@ -234,72 +234,12 @@ sub show_screen
 #	$top->refresh();
 }
 
-# add a line to the end of the top screen
-sub addtotop
-{
-	while (@_) {
-		my $inbuf = shift;
-		my $l = length $inbuf;
-		if ($l > $cols) {
-			$inbuf =~ s/\s+/ /g;
-			if (length $inbuf > $cols) {
-				$Text::Wrap::columns = $cols;
-				my $token;
-				($token) = $inbuf =~ m!^(.* de [-\w\d/\#]+:?\s+|\w{9}\@\d\d:\d\d:\d\d )!;
-				$token ||= ' ' x 19;
-				push @sh, split /\n/, wrap('', ' ' x length($token), $inbuf);
-			} else {
-				push @sh, $inbuf;
-			}
-		} else {
-			push @sh, $inbuf;
-		}
-	}
-#	shift @sh while @sh > $maxshist;
-	show_screen();
-}
-
-# handle incoming messages
-sub rec_socket
-{
-	my ($con, $msg, $err) = @_;
-	if (defined $err && $err) {
-		cease(1);
-	}
-	if (defined $msg) {
-		my ($sort, $incall, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
-		if ($line =~ s/\x07+$//) {
-			beep();
-		}
-		$line =~ s/[\r\n]+//s;
-
-		# change my call if my node says "tonight Michael you are Jane" or something like that...
-		$call = $incall if $call ne $incall;
-		
-		$line =~ s/[\x00-\x06\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
-		if ($sort && $sort eq 'D') {
-			$line = " " unless length($line);
-			addtotop($line);
-		} elsif ($sort && $sort eq 'Z') { # end, disconnect, go, away .....
-			cease(0);
-		}	  
-		
-		# ******************************************************
-		# ******************************************************
-		# any other sorts that might happen are silently ignored.
-		# ******************************************************
-		# ******************************************************
-	} else {
-		cease(0);
-	}
-	$top->refresh();
-	$lasttime = time; 
-}
-
 sub rec_stdin
 {
-	my $r = shift;;
+	my $r = shift;
 	
+	dbg("KEY: " . unpack("H*", $r). " '$r'") if isdbg('console');
+
 	#  my $prbuf;
 	#  $prbuf = $buf;
 	#  $prbuf =~ s/\r/\\r/;
@@ -308,7 +248,7 @@ sub rec_stdin
 	if (defined $r) {
 
 		$r = '0' if !$r;
-		
+
 		if ($r eq KEY_ENTER || $r eq "\n" || $r eq "\r") {
 			
 			# save the lines
@@ -331,7 +271,7 @@ sub rec_stdin
 			}
 			push @kh, $inbuf if length $inbuf;
 			shift @kh if @kh > $maxkhist;
-			$khistpos = @kh;
+			$kpos = @kh;
 			$bot->move(0,0);
 			$bot->clrtoeol();
 			$bot->addstr(substr($inbuf, 0, $cols));
@@ -342,25 +282,24 @@ sub rec_stdin
 				show_screen();
 			}
 
-			# add it to the monitor window
-			addtotop($inbuf);
+			addtotop(' ', $inbuf);
 		
 			# send it to the cluster
 			$conn->send_later("I$call|$inbuf");
 			$inbuf = "";
 			$pos = $lth = 0;
 		} elsif ($r eq KEY_UP || $r eq "\020") {
-			if ($khistpos > 0) {
-				--$khistpos;
-				$inbuf = $kh[$khistpos];
+			if ($kpos > 0) {
+				--$kpos;
+				$inbuf = $kh[$kpos];
 				$pos = $lth = length $inbuf;
 			} else {
 				beep();
 			}
 		} elsif ($r eq KEY_DOWN || $r eq "\016") {
-			if ($khistpos < @kh - 1) {
-				++$khistpos;
-				$inbuf = $kh[$khistpos];
+			if ($kpos < @kh - 1) {
+				++$kpos;
+				$inbuf = $kh[$kpos];
 				$pos = $lth = length $inbuf;
 			} else {
 				beep();
@@ -377,6 +316,7 @@ sub rec_stdin
 		} elsif ($r eq KEY_NPAGE || $r eq "\026") {
 			if ($inscroll && $spos < @sh) {
 
+				dbg("NPAGE sp:$spos $sh:". scalar @sh . " pl: $pagel") if isdbg('console');
 				$spos += int($pagel/2);
 				if ($spos > @sh - $pagel) {
 					$spos = @sh - $pagel;
@@ -429,12 +369,21 @@ sub rec_stdin
 				beep();
 			}
 		} elsif ($r eq KEY_RESIZE || $r eq "\0632") {
-			do_resize();
+			doresize();
+			return;
+		} elsif ($r eq "\x12" || $r eq "\x0c") {
+			dbg("REDRAW called") if isdbg('console');
+			doresize();
 			return;
+		} elsif ($r eq "\013") {
+			$inbuf = substr($inbuf, 0, $pos);
+			$lth = length $inbuf;
 		} elsif (defined $r && is_pctext($r)) {
 			# move the top screen back to the bottom if you type something
-			if ($spos < @sh) {
-				$spos = @sh;
+			
+			if ($inscroll && $spos < @sh) {
+				$spos = @sh - $pagel;
+				$inscroll = 0;
 				show_screen();
 			}
 
@@ -450,16 +399,10 @@ sub rec_stdin
 			}
 			$pos++;
 			$lth++;
-		} elsif ($r eq "\014" || $r eq "\022") {
-			touchwin(curscr, 1);
-			refresh(curscr);
-			return;
-		} elsif ($r eq "\013") {
-			$inbuf = substr($inbuf, 0, $pos);
-			$lth = length $inbuf;
 		} else {
 			beep();
 		}
+
 		$bot->move(1, 0);
 		$bot->clrtobot();
 		$bot->addstr($inbuf);
@@ -469,18 +412,87 @@ sub rec_stdin
 }
 
 
+# add a line to the end of the top screen
+sub addtotop
+{
+	my $sort = shift;
+	while (@_) {
+		my $inbuf = shift;
+		my $l = length $inbuf;
+		if ($l > $cols) {
+			$inbuf =~ s/\s+/ /g;
+			if (length $inbuf > $cols) {
+				$Text::Wrap::columns = $cols;
+				my $token;
+				($token) = $inbuf =~ m!^(.* de [-\w\d/\#]+:?\s+|\w{9}\@\d\d:\d\d:\d\d )!;
+				$token ||= ' ' x 19;
+				push @sh, split /\n/, wrap('', ' ' x length($token), $inbuf);
+			} else {
+				push @sh, $inbuf;
+			}
+		} else {
+			push @sh, $inbuf;
+		}
+	}
+	
+	show_screen() unless $inscroll;
+}
+
+# handle incoming messages
+sub rec_socket
+{
+	my ($con, $msg, $err) = @_;
+	if (defined $err && $err) {
+		cease(1);
+	}
+	if (defined $msg) {
+		my ($sort, $incall, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
+		dbg("msg: " . length($msg) . " '$msg'") if isdbg('console');
+		if ($line =~ s/\x07+$//) {
+			beep();
+		}
+		$line =~ s/[\r\n]+//s;
+
+		# change my call if my node says "tonight Michael you are Jane" or something like that...
+		$call = $incall if $call ne $incall;
+		
+		$line =~ s/[\x00-\x06\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
+		if ($sort && $sort eq 'Z') { # end, disconnect, go, away .....
+			cease(0);
+		} else {
+			$line = " " unless length($line);
+			addtotop($sort, $line);
+		}
+
+	} else {
+		cease(0);
+	}
+	$top->refresh();
+	$lasttime = time; 
+}
+
 #
 # deal with args
 #
 
+while (@ARGV && $ARGV[0] =~ /^-/) {
+	my $arg = shift;
+	if ($arg eq '-x') {
+		dbginit('console');
+		dbgadd('console');
+		$maxshist = 200;
+	}
+}
+
 $call = uc shift @ARGV if @ARGV;
-$call = uc $myalias if !$call;
+$call = uc $myalias unless $call;
 $node = uc $mycall unless $node;
 
+$call = normalise_call($call);
 my ($scall, $ssid) = split /-/, $call;
 $ssid = undef unless $ssid && $ssid =~ /^\d+$/;  
 if ($ssid) {
-	$ssid = 15 if $ssid > 15;
+	$ssid = 99 if $ssid > 99;
 	$call = "$scall-$ssid";
 }
 
@@ -489,7 +501,6 @@ if ($call eq $mycall) {
 	exit(0);
 }
 
-dbginit();
 
 $conn = IntMsg->connect("$clusteraddr", $clusterport, \&rec_socket);
 if (! $conn) {
@@ -520,7 +531,8 @@ do_resize();
 
 $SIG{__DIE__} = \&sig_term;
 
-$conn->send_later("A$call|$connsort width=$cols");
+$Text::Wrap::columns = $cols;
+$conn->send_later("A$call|$connsort width=$cols enhanced");
 $conn->send_later("I$call|set/page $maxshist");
 $conn->send_later("I$call|set/nobeep");
 
@@ -554,4 +566,4 @@ for (;;) {
 	$bot->refresh();
 }
 
-exit(0);
+cease(0);
diff --git a/perl/watchdbg b/perl/watchdbg
index 84a74c8f..79a72f60 100755
--- a/perl/watchdbg
+++ b/perl/watchdbg
@@ -3,15 +3,18 @@
 # watch the end of the current debug file (like tail -f) applying
 # any regexes supplied on the command line.
 #
+# There can be more than one <regexp>. a <regexp> preceeded by a '!' is
+# treated as NOT <regexp>. Each <regexp> is implcitly ANDed together.
+# All <regexp> are caseless.
+#
 # examples:-
 # 
 #   watchdbg g1tlh       # watch everything g1tlh does
-#   watchdbg 2 PCPROT       # watch all PCPROT messages + up to 2 lines before
+#   watchdbg -2 PCPROT       # watch all PCPROT messages + up to 2 lines before
 #   watchdbg gb7baa gb7djk   # watch the conversation between BAA and DJK 
 #
 
 require 5.004;
-package main;
 
 # search local then perl directories
 BEGIN {
@@ -23,8 +26,6 @@ BEGIN {
 	unshift @INC, "$root/local";
 }
 
-$data = "$root/data";
-
 use IO::File;
 use DXVars;
 use DXUtil;
@@ -38,18 +39,28 @@ my $fh = $fp->open($today) or die $!;
 my $nolines = 1;
 $nolines = shift if $ARGV[0] =~ /^-?\d+$/;
 $nolines = abs $nolines if $nolines < 0;  
-my $exp = join '|', @ARGV;
+my @patt = @ARGV;
 my @prev;
 
 # seek to end of file
 $fh->seek(0, 2);
 for (;;) {
-	my $line = <$fh>;
+	my $line = $fh->getline;
 	if ($line) {
-		if ($exp) {
+		if (@patt) {
 			push @prev, $line;
 			shift @prev while @prev > $nolines; 
-			if ($line =~ m{(?:$exp)}oi) {
+			my $flag = 0;
+			foreach my $p (@patt) {
+				if ($p =~ /^!/) {
+					my $r = substr $p, 1;
+					last if $line =~ m{$r}i;
+				} else {
+					last unless $line =~ m{$p}i;
+				}
+				++$flag;
+			}		
+			if ($flag == @patt) {
 				printit(@prev);	
 				@prev = ();
 			}
@@ -82,10 +93,8 @@ sub printit
 		chomp $line;
 		$line =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%02X", ord($1))/eg; 
 		my ($t, $l) =  split /\^/, $line, 2;
-		my ($sec,$min,$hour) = gmtime((defined $t) ? $t : time);
-		my $buf = sprintf "%02d:%02d:%02d", $hour, $min, $sec;
-		
-		print $buf, ' ', $l, "\n"; 
+		$t = time unless defined $t;
+		printf "%02d:%02d:%02d %s\n", (gmtime($t))[2,1,0], $l;
 	}
 }
 exit(0);
-- 
2.43.0