From cce161221036760959ff1d0b7628a55942bf558a Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 21 Dec 1998 10:24:48 +0000 Subject: [PATCH] pre 1.13 release --- Changes | 7 ++ cmd/Aliases | 52 +++++++------- cmd/load/hops.pl | 8 +++ cmd/set/password.pl | 0 cmd/talk.pl | 35 ++++++---- html/connect.html | 76 +++++++++++++------- html/hops.html | 159 ++++++++++++++++++++++++++++++++++++++++++ html/index.html | 3 +- html/install.html | 76 ++++++++++++++++---- perl/DXChannel.pm | 11 +-- perl/DXCluster.pm | 3 +- perl/DXCommandmode.pm | 29 ++++---- perl/DXCron.pm | 2 +- perl/DXDebug.pm | 3 +- perl/DXLog.pm | 18 ++--- perl/DXMsg.pm | 20 +++--- perl/DXProt.pm | 138 +++++++++++++++++++++++++----------- perl/DXUser.pm | 8 +-- perl/DXUtil.pm | 4 +- perl/DXVars.pm | 2 +- perl/Messages | 1 + perl/Prefix.pm | 6 +- perl/cluster.pl | 4 +- 23 files changed, 493 insertions(+), 172 deletions(-) create mode 100644 cmd/load/hops.pl create mode 100644 cmd/set/password.pl create mode 100644 html/hops.html diff --git a/Changes b/Changes index 35fa1d84..d74a7b85 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,10 @@ +20Dec98======================================================================== +1. Removed all the warnings I get with perl -w (at least for just starting the +cluster and running a few commands). +2. Added per node hop control. +3. Added some docs on how to use it and isolation +4. Made talk command more intelligent in that if the user isn't seen and the +user's last node is visible it tries the talk anyway. 19Dec98======================================================================== 1. Fixed problems with sh/rcmd (talk/ann/log) with a callsign as argument and also made what G0RDI wanted work as well! diff --git a/cmd/Aliases b/cmd/Aliases index 0d64571e..bef5f9d1 100644 --- a/cmd/Aliases +++ b/cmd/Aliases @@ -25,16 +25,16 @@ package CmdAlias; '?' => [ '^\?', 'help', 'help', ], - a => [ + 'a' => [ '^ann.*/full', 'announce full', 'announce', '^ann.*/sysop', 'announce sysop', 'announce', '^ann.*/(.*)$', 'announce $1', 'announce', ], - b => [ + 'b' => [ ], - c => [ + 'c' => [ ], - d => [ + 'd' => [ '^del', 'kill', 'kill', '^del.*/fu', 'kill full', 'kill', '^di\w*/a\w*', 'directory all', 'directory', @@ -45,41 +45,41 @@ package CmdAlias; '^di\w*/(\d+)-(\d+)', 'directory $1-$2', 'directory', '^di\w*/(\d+)', 'directory $1', 'directory', ], - e => [ + 'e' => [ ], - f => [ + 'f' => [ ], - g => [ + 'g' => [ ], - h => [ + 'h' => [ ], - i => [ + 'i' => [ ], - j => [ + 'j' => [ ], - k => [ + 'k' => [ ], - l => [ + 'l' => [ '^l$', 'directory', 'directory', '^ll$', 'directory', 'directory', '^ll/(\d+)', 'directory $1', 'directory', ], - m => [ + 'm' => [ ], - n => [ + 'n' => [ ], - o => [ + 'o' => [ ], - p => [ + 'p' => [ ], - q => [ + 'q' => [ '^q', 'bye', 'bye', ], - r => [ + 'r' => [ '^r$', 'read', 'read', '^rcmd/(\S+)', 'rcmd $1', 'rcmd', ], - s => [ + 's' => [ '^set/nobe', 'unset/beep', 'unset/beep', '^set/nohe', 'unset/here', 'unset/here', '^sh.*/c/n', 'show/configuration nodes', 'show/configuration', @@ -92,20 +92,20 @@ package CmdAlias; '^sh.*/wwv/(\d+)-(\d+)', 'show/wwv $1-$2', 'show/wwv', '^sh.*/wwv/(\d+)', 'show/wwv $1', 'show/wwv', ], - t => [ + 't' => [ ], - u => [ + 'u' => [ ], - v => [ + 'v' => [ ], - w => [ + 'w' => [ '^wx/full', 'wx full', 'wx', '^wx/sysop', 'wx sysop', 'wx', ], - x => [ + 'x' => [ ], - y => [ + 'y' => [ ], - z => [ + 'z' => [ ], ) diff --git a/cmd/load/hops.pl b/cmd/load/hops.pl new file mode 100644 index 00000000..592b7920 --- /dev/null +++ b/cmd/load/hops.pl @@ -0,0 +1,8 @@ +# +# load the node hop count table after changing it +# +my $self = shift; +return (0, $self->msg('e5')) if $self->priv < 9; +my @out = DXProt::load_hops($self); +@out = ($self->msg('ok')) if !@out; +return (1, @out); diff --git a/cmd/set/password.pl b/cmd/set/password.pl new file mode 100644 index 00000000..e69de29b diff --git a/cmd/talk.pl b/cmd/talk.pl index 4002c828..899a4430 100644 --- a/cmd/talk.pl +++ b/cmd/talk.pl @@ -7,35 +7,46 @@ # my ($self, $line) = @_; -my @argv = split /\s+/, $line; # generate an argv +my @argv = split /\s+/, $line; # generate an argv my $to = uc $argv[0]; my $via; my $from = $self->call(); +my @out; # have we a callsign and some text? return (1, $self->msg('e8')) if @argv < 2; if ($argv[1] eq '>') { - $via = uc $argv[2]; - $line =~ s/^$argv[0]\s+>\s+$argv[2]\s*//; + $via = uc $argv[2]; + $line =~ s/^$argv[0]\s+>\s+$argv[2]\s*//; } else { - $line =~ s/^$argv[0]\s*//; + $line =~ s/^$argv[0]\s*//; } my $call = $via ? $via : $to; my $ref = DXCluster->get($call); + +# if we haven't got an explicit via and we can't see them, try their node +unless ($ref || $via) { + my $user = DXUser->get($call); + $ref = DXCluster->get_exact($user->node); + if ($ref) { + $via = $user->node; + push @out, "trying via $via.."; + } +} return (1, "$call not visible on the cluster") if !$ref; -my $dxchan = DXCommandmode->get($to); # is it for us? +my $dxchan = DXCommandmode->get($to); # is it for us? if ($dxchan && $dxchan->is_user) { - $dxchan->send("$to de $from $line"); - Log('talk', $to, $from, $main::mycall, $line); + $dxchan->send("$to de $from $line"); + Log('talk', $to, $from, $main::mycall, $line); } else { - $line =~ s/\^//og; # remove any ^ characters - my $prot = DXProt::pc10($from, $to, $via, $line); - DXProt::route($via?$via:$to, $prot); - Log('talk', $to, $from, $via?$via:$main::mycall, $line); + $line =~ s/\^//og; # remove any ^ characters + my $prot = DXProt::pc10($from, $to, $via, $line); + DXProt::route($via?$via:$to, $prot); + Log('talk', $to, $from, $via?$via:$main::mycall, $line); } -return (1, ()); +return (1, @out); diff --git a/html/connect.html b/html/connect.html index cb349e6c..902af164 100644 --- a/html/connect.html +++ b/html/connect.html @@ -19,7 +19,7 @@

-Last modified: Thu Dec 17 00:06:40 GMT 1998 +Last modified: Sun Dec 20 17:04:05 GMT 1998

At the moment, anybody can connect inwards at any time from outside, either by ax25 or by telnet (assuming you have followed the instructions in installation @@ -90,31 +90,59 @@ Last modified: Thu Dec 17 00:06:40 GMT 1998 etc -

The connect scripts consist of lines which start with the following keywords or symbols:- +

The connect scripts consist of lines which start with the + following keywords or symbols:- +

diff --git a/html/hops.html b/html/hops.html new file mode 100644 index 00000000..5ffa84c3 --- /dev/null +++ b/html/hops.html @@ -0,0 +1,159 @@ + + + + Hops, Network Isolation and other matters... + + + + + + + +
+

Hops, Network Isolation and other matters...

+
+ + + +
Dirk Koopman G1TLH
+

+ + +Last modified: Sun Dec 20 18:15:15 GMT 1998 + + +

Introduction

+ + Starting with version 1.13 there is simple hop control available on a per + node basis. Also it is possible to isolate a network completely so that you + get all the benefits of being on that network, but can't pass on information + from it to + to any other networks you may be connected to (or vice versa). + +

Basic Hop Control

+ + The number of hops that are set for all PC protocol messages (that require them) + are specified in /spider/perl/DXProtVars.pm. + +

In versions prior to 1.13 you would move this file to + /spider/local/ and modify the perl variables: + $def_hopcount and %hopcount to some reasonable + values. + +

From version 1.13 onwards a new mechanism has been introduced + which uses a file called /spider/data/hop_count.pl. The + prefered way of doing basic hop control is now to create this file + and modify it as you wish. Eventually this file will contain all + the hop control and related information. An example of the + hop_count.pl file can be found in the + /spider/examples directory. + +

You can change this file at any time, including when the + cluster is running. If you do this then the changes only take + effect after you have run the load/hops command on a + client console with full sysop privileges. + +

Per Node Hop Control

+ + From version 1.13 it is possible to control the number of hops to each + node. This is done by adding information to the %nodehops perl + variable in the hop_count.pl file (as described above). This + variable is a perl "hash of hashes", which means that you create an + entry for every callsign you wish to control and then one line for + every PC protocol message that you wish to alter. + +

You can also have a entry called default for every callsign + so you can set the hops as a whole for all PC messages to just that + callsign. This is overridden by any specific hop counts you may have. + +

Example hop_count.pl File

+ + An example for you:- + + 

+#
+# hop table construction
+#
+
+package DXProt;
+
+# default hopcount to use
+$def_hopcount = 15;
+
+# some variable hop counts based on message type
+%hopcount =
+(
+    11 => 10,
+    16 => 10,
+    17 => 10,
+    19 => 10,
+    21 => 10,
+);
+
+#
+# the per node hop control thingy
+#
+ 
+%nodehops =
+(
+    GB7DJK-1 => 
+    {
+         11 => 5,
+         16 => 23,
+         17 => 23,
+         default => 50,
+    },
+
+    GB7TLH => 
+    {
+         19 => 45,
+         21 => 45,
+         16 => 45,
+         17 => 45,
+         default => 15, 
+    },
+);                              
+
+ +

The figures chosen are not necessarily what I use. What I would say is that + until you are certain that you know what you are doing (and that the software + is working at least as well as advertised) you should keep the default hop + counts down to the sort of levels shown above. + +

Isolated Networks

+ + It is possible to isolate networks from each other on a "gateway" node using + the set/isolate <node call> command. + +

The effect of this is to partition an isolated network + completely from another nodes connected to your node. Your node + will appear on and otherwise behave normally on every network to + which you are connected, but data from isolated network will not + cross onto any other network or vice versa. + +

However all the spot, announce and WWV traffic and personal + messages will still be handled locally (because you are a real + node on all connected networks), that is locally connected users + will appear on all networks and will be able to access and receive + information from all networks transparently. + +

All routed messages will be sent as normal, so if a user on one + network knows that you are a gateway for another network, he can still + still send a talk/announce etc message via your node and it will + be routed across. + +

The only limitation currently is that non-private messages + cannot be passed down isolated links regardless of whether they + are generated locally. This will change when the bulletin routing + facility is added. + + +

 

+

+

+ + Copyright © 1998 by Dirk Koopman G1TLH. All Rights Reserved
+ + $Id$ + + diff --git a/html/index.html b/html/index.html index e3a73743..72e277a5 100644 --- a/html/index.html +++ b/html/index.html @@ -18,7 +18,7 @@

-Last modified: Thu Dec 17 00:06:39 GMT 1998 +Last modified: Sun Dec 20 16:25:28 GMT 1998

The DXSpider dx cluster system is written in perl5 as an exercise in self-training for both protocol research and teaching myself perl. @@ -29,6 +29,7 @@ Last modified: Thu Dec 17 00:06:39 GMT 1998

  • Installation of the main cluster software.
  • Installing the lastest version of CPAN.
  • Connecting to other clusters. +
  • Hop control, network isolation etc.
  • Download the software and any patches. diff --git a/html/install.html b/html/install.html index 74c432ce..089854b7 100644 --- a/html/install.html +++ b/html/install.html @@ -17,7 +17,7 @@
    Iain Phillips G0RDI
    -Last modified: Sat Dec 19 16:10:14 GMT 1998 +Last modified: Sun Dec 20 17:55:19 GMT 1998

    This HOWTO describes the installation for DX Spider v1.11 on a "vanilla" RedHat 5.1 platform, @@ -158,25 +158,76 @@ spider:x:251:sysop,g0rdi,root

    This last step allows various users of group spider to have write access to all the directories. Not really needed for now but will be useful when web interfaces start to appear. -

  • Should you have any users that require network logins, set them up as real users with 'useradd -m <callsign>'. Alter the default .bashrc so that it contains just one line (assuming you use the default bash shell). - 
    -exec /spider/perl/client.pl <callsign> telnet
-
    -

    Alternatively you can set up a real login for a person (or another cluster) by creating a login using:- - 

    -# useradd gb7djk
+		
  • If you want to be able to allow people or clusters
+		to login via IP then you will need to set up logins for them.
+
+		
    +# useradd -m gb7djk
 # passwd gb7djk
 New UNIX password: 
 Retype new UNIX password: 
 passwd: all authentication tokens updated successfully
 		
    
-		
    and editing the /etc/passwd file to look like this (do substitute the correct callsigns here ;-):-
+
+		
    You can then either alter the default .bashrc so that it
+		contains just one line (assuming you use the default bash
+		shell).
+	
+		
    +exec /spider/perl/client.pl <callsign> telnet
+		
    
+		
+		
    Alternatively you can alter the /etc/passwd thus:-
+
 		
     fbb:x:505:505::/home/fbb:/bin/bash
 gb7djk:x:506:506::/home/gb7djk:/usr/bin/perl /spider/perl/client.pl gb7djk telnet
 		
    
-		
    Don't forget to give them a real password. This is really for network cluster logins. The telnet argument does two things, it sets the EOL convention to \n rather than AX25's \r and it automatically reduces the privilege of the <callsign> to a 'safe[r]' level.). 
 		
+		Don't forget to give them a real password. The telnet argument
+		does two things, it sets the EOL convention to \n rather than
+		AX25's \r and it automatically reduces the privilege of the
+		<callsign> to a 'safe[r]' level.). If the user or other cluster
+		program requires AX25 conventions to operate then you can use 
+		ax25 instead.
+
+		
    Another thing you can do is to get inetd to listen
+		on a specific port and then start the client up directly. To
+		  do this, create an entry in /etc/services with a
+		  port number > 1000 that isn't used elsewhere eg:-
+
+		
    +gb7djk     8001/tcp 
+gb7tlh     8002/tcp
+        
    
+
+		Then create some lines in /etc/inetd.conf that look 
+		like this:-
+		
+		
    +gb7djk  stream tcp   nowait   sysop /usr/sbin/tcpd /usr/bin/perl /spider/perl/client.pl gb7djk telnet
+gb7tlh  stream tcp   nowait   sysop /usr/sbin/tcpd /usr/bin/perl /spider/perl/client.pl gb7tlh telnet
+		
    
+
+		Please DON'T run the client as root you will only 
+		come to regret it later when the next person finds a security hole
+		in DX Spider (there are bound to be some although I have tried to
+		avoid the obvious ones I could think of).
+
+		
    The only reason I would use this mechanism is for Internet connections
+		  to other or from other clusters. Don't use this for normal users.
+
+		
    In the example I have used tcpd as the access control 
+		  mechanism to the port. Don't (I can't be bothered to emphasize 
+		  it any more) run a system like this without one, you are asking
+		  for trouble. In fact I use the TIS
+		  Firewall Toolkit myself, you may find this more intuitive 
+		  to use. The point is that gb7djk would only be coming
+		  from one IP address, if it coming from another, it is an imposter!
+
+		
    You are responsible for arranging and looking after your 
+			security - not me.
+
 		
  • As mentioned earlier, for AX25 connections you are expected to have the AX25 utilities installed, setup, tested and working. See the AX25-HOWTO for more info on this - it really is beyond the scope of this document DX Spider uses ax25d for incoming connections. You need to have entries like this:- 
 		
     [ether]                                                                         
@@ -258,8 +309,7 @@ PC38^GB7JIM^~           <- the cluster thinks this is a cluster
 	
 
 	
    You should now have a basic working system. Best of luck! Can I now draw your attention to
-	  the Bug Reporting System. Some mailing lists will
-	  be created RSN for more general discussions.
+	  the Bug Reporting System. 
 
 	
    Can I commend to you the Announcements mailing list to which you may 
 	  subscribe.
@@ -268,7 +318,7 @@ PC38^GB7JIM^~           <- the cluster thinks this is a cluster
 
 	
    If you like what you see and want to be a part of the ongoing development then 
 	  subscribe 
-	  to the support mailing list which will be the initial focus of any discussions.
+	  to the support mailing list which will be the focus of any discussion/bug fixing etc.
 
 
 	
     
    
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index c494f59b..7319344c 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -34,7 +34,7 @@ use Carp;
 use strict;
 use vars qw(%channels %valid);
 
-%channels = undef;
+%channels = ();
 
 %valid = (
 		  call => '0,Callsign',
@@ -49,7 +49,7 @@ use vars qw(%channels %valid);
 		  list => '9,Dep Chan List',
 		  name => '0,User Name',
 		  consort => '9,Connection Type',
-		  sort => '9,Type of Channel',
+		  'sort' => '9,Type of Channel',
 		  wwv => '0,Want WWV,yesno',
 		  talk => '0,Want Talk,yesno',
 		  ann => '0,Want Announce,yesno',
@@ -87,6 +87,7 @@ sub alloc
 	$self->{lang} = $main::lang if !$self->{lang};
 	$user->new_group() if !$user->group;
 	$self->{group} = $user->group;
+	$self->{func} = "";
 	bless $self, $pkg; 
 	return $channels{$call} = $self;
 }
@@ -130,21 +131,21 @@ sub del
 sub is_ak1a
 {
 	my $self = shift;
-	return $self->{sort} eq 'A';
+	return $self->{'sort'} eq 'A';
 }
 
 # is it a user?
 sub is_user
 {
 	my $self = shift;
-	return $self->{sort} eq 'U';
+	return $self->{'sort'} eq 'U';
 }
 
 # is it a connect type
 sub is_connect
 {
 	my $self = shift;
-	return $self->{sort} eq 'C';
+	return $self->{'sort'} eq 'C';
 }
 
 # handle out going messages, immediately without waiting for the select to drop
diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm
index 0eb98a4b..153c70e9 100644
--- a/perl/DXCluster.pm
+++ b/perl/DXCluster.pm
@@ -225,6 +225,7 @@ sub new
   $self->{pcversion} = $pcversion;
   $self->{list} = { } ;
   $self->{mynode} = $self;   # for sh/station
+  $self->{users} = 0;
   $nodes++;
   dbg('cluster', "allocating node $call to cluster\n");
   return $self;
@@ -266,7 +267,7 @@ sub update_users
   } else {
     $self->{users} = $count;
   }
-  $users += $self->{users};
+  $users += $self->{users} if $self->{users};
   $maxusers = $users+$nodes if $users+$nodes > $maxusers;
 }
 
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 91d268b0..e8fd7d5a 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -39,7 +39,7 @@ $errstr = ();					# error string from eval
 sub new 
 {
 	my $self = DXChannel::alloc(@_);
-	$self->{sort} = 'U';		# in absence of how to find out what sort of an object I am
+	$self->{'sort'} = 'U';		# in absence of how to find out what sort of an object I am
 	return $self;
 }
 
@@ -237,16 +237,16 @@ sub run_cmd
 sub process
 {
 	my $t = time;
-	my @chan = DXChannel->get_all();
-	my $chan;
+	my @dxchan = DXChannel->get_all();
+	my $dxchan;
 	
-	foreach $chan (@chan) {
-		next if $chan->sort ne 'U';  
+	foreach $dxchan (@dxchan) {
+		next if $dxchan->sort ne 'U';  
 		
 		# send a prompt if no activity out on this channel
-		if ($t >= $chan->t + $main::user_interval) {
-			$chan->prompt() if $chan->{state} =~ /^prompt/o;
-			$chan->t($t);
+		if ($t >= $dxchan->t + $main::user_interval) {
+			$dxchan->prompt() if $dxchan->{state} =~ /^prompt/o;
+			$dxchan->t($t);
 		}
 	}
 }
@@ -293,14 +293,14 @@ sub broadcast
 	my $s = shift;				# the line to be rebroadcast
 	my @except = @_;			# to all channels EXCEPT these (dxchannel refs)
 	my @list = DXChannel->get_all(); # just in case we are called from some funny object
-	my ($chan, $except);
+	my ($dxchan, $except);
 	
- L: foreach $chan (@list) {
-		next if !$chan->sort eq 'U'; # only interested in user channels  
+ L: foreach $dxchan (@list) {
+		next if !$dxchan->sort eq 'U'; # only interested in user channels  
 		foreach $except (@except) {
-			next L if $except == $chan;	# ignore channels in the 'except' list
+			next L if $except == $dxchan;	# ignore channels in the 'except' list
 		}
-		chan->send($s);			# send it
+		$dxchan->send($s);			# send it
 	}
 }
 
@@ -333,7 +333,7 @@ sub search
 	return () if $short_cmd =~ /\/$/;
 
 	# return immediately if we have it
-	my ($apath, $acmd) = split ',', $cmd_cache{$short_cmd};
+	($apath, $acmd) = split ',', $cmd_cache{$short_cmd} if $cmd_cache{$short_cmd};
 	if ($apath && $acmd) {
 		dbg('command', "cached $short_cmd = ($apath, $acmd)\n");
 		return ($apath, $acmd);
@@ -369,6 +369,7 @@ sub search
 					pop @lparts; #  remove the suffix
 					$l = join '.', @lparts;
 					#		  chop $dirfn;               # remove trailing /
+					$dirfn = "" unless $dirfn;
 					$cmd_cache{"$short_cmd"} = join(',', ($path, "$dirfn$l")); # cache it
 					dbg('command', "got path: $path cmd: $dirfn$l\n");
 					return ($path, "$dirfn$l"); 
diff --git a/perl/DXCron.pm b/perl/DXCron.pm
index ba200502..961fa3a6 100644
--- a/perl/DXCron.pm
+++ b/perl/DXCron.pm
@@ -25,7 +25,7 @@ $lasttime = 0;
 
 
 my $fn = "$main::cmd/crontab";
-my $localfn = "$main::local_cmd/crontab";
+my $localfn = "$main::localcmd/crontab";
 
 # cron initialisation / reading in cronjobs
 sub init
diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm
index 530f3b21..c03f92af 100644
--- a/perl/DXDebug.pm
+++ b/perl/DXDebug.pm
@@ -64,7 +64,8 @@ sub dbglist
 
 sub isdbg
 {
-	return $dbglevel{shift};
+	my $s = shift;
+	return $dbglevel{$s};
 }
 1;
 __END__
diff --git a/perl/DXLog.pm b/perl/DXLog.pm
index 3a6e0e35..c6994137 100644
--- a/perl/DXLog.pm
+++ b/perl/DXLog.pm
@@ -50,7 +50,7 @@ sub new
 	my $ref = {};
 	$ref->{prefix} = "$main::data/$prefix";
 	$ref->{suffix} = $suffix if $suffix;
-	$ref->{sort} = $sort;
+	$ref->{'sort'} = $sort;
 		
 	# make sure the directory exists
 	mkdir($ref->{prefix}, 0777) if ! -e $ref->{prefix};
@@ -71,8 +71,8 @@ sub open
 		delete $self->{mode};
 	}
 	
-	$self->{fn} = sprintf "$self->{prefix}/$year/%02d", $thing if $self->{sort} eq 'm';
-	$self->{fn} = sprintf "$self->{prefix}/$year/%03d", $thing if $self->{sort} eq 'd';
+	$self->{fn} = sprintf "$self->{prefix}/$year/%02d", $thing if $self->{'sort'} eq 'm';
+	$self->{fn} = sprintf "$self->{prefix}/$year/%03d", $thing if $self->{'sort'} eq 'd';
 	$self->{fn} .= ".$self->{suffix}" if $self->{suffix};
 	
 	$mode = 'r' if !$mode;
@@ -93,9 +93,9 @@ sub open
 sub openprev
 {
 	my $self = shift;
-	if ($self->{sort} eq 'm') {
+	if ($self->{'sort'} eq 'm') {
 		($self->{year}, $self->{thing}) = Julian::subm($self->{year}, $self->{thing}, 1);
-	} elsif ($self->{sort} eq 'd') {
+	} elsif ($self->{'sort'} eq 'd') {
 		($self->{year}, $self->{thing}) = Julian::sub($self->{year}, $self->{thing}, 1);
 	}
 	return $self->open($self->{year}, $self->{thing}, @_);
@@ -105,9 +105,9 @@ sub openprev
 sub opennext
 {
 	my $self = shift;
-	if ($self->{sort} eq 'm') {
+	if ($self->{'sort'} eq 'm') {
 		($self->{year}, $self->{thing}) = Julian::addm($self->{year}, $self->{thing}, 1);
-	} elsif ($self->{sort} eq 'd') {
+	} elsif ($self->{'sort'} eq 'd') {
 		($self->{year}, $self->{thing}) = Julian::add($self->{year}, $self->{thing}, 1);
 	}
 	return $self->open($self->{year}, $self->{thing}, @_);
@@ -118,9 +118,9 @@ sub unixtoj
 {
 	my $self = shift;
 	
-	if ($self->{sort} eq 'm') {
+	if ($self->{'sort'} eq 'm') {
 		return Julian::unixtojm(shift);
-	} elsif ($self->{sort} eq 'd') {
+	} elsif ($self->{'sort'} eq 'd') {
 		return Julian::unixtoj(shift);
 	}
 	confess "shouldn't get here";
diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm
index 63710e4b..262a4155 100644
--- a/perl/DXMsg.pm
+++ b/perl/DXMsg.pm
@@ -50,7 +50,7 @@ $last_clean = 0;				# last time we did a clean
 		  file => '9,File?,yesno',
 		  gotit => '9,Got it Nodes,parray',
 		  lines => '9,Lines,parray',
-		  read => '9,Times read',
+		  'read' => '9,Times read',
 		  size => '0,Size',
 		  msgno => '0,Msgno',
 		  keep => '0,Keep this?,yesno',
@@ -73,7 +73,7 @@ sub alloc
 	$self->{private} = shift;
 	$self->{subject} = shift;
 	$self->{origin} = shift;
-	$self->{read} = shift;
+	$self->{'read'} = shift;
 	$self->{rrreq} = shift;
 	$self->{gotit} = [];
     
@@ -201,11 +201,11 @@ sub process
 					}
 				}
 				$ref->stop_msg($self);
-				queue_msg();
+				queue_msg(0);
 			} else {
 				$self->send(DXProt::pc42($f[2], $f[1], $f[3]));	# unknown stream
 			}
-			queue_msg();
+			queue_msg(0);
 			last SWITCH;
 		}
 		
@@ -224,7 +224,7 @@ sub process
 			} else {
 				$self->send(DXProt::pc42($f[2], $f[1], $f[3]));	# unknown stream
 			} 
-			queue_msg();
+			queue_msg(0);
 			last SWITCH;
 		}
 		
@@ -328,7 +328,7 @@ sub store
 		if (defined $fh) {
 			my $rr = $ref->{rrreq} ? '1' : '0';
 			my $priv = $ref->{private} ? '1': '0';
-			print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$priv^$ref->{subject}^$ref->{origin}^$ref->{read}^$rr\n";
+			print $fh "=== $ref->{msgno}^$ref->{to}^$ref->{from}^$ref->{t}^$priv^$ref->{subject}^$ref->{origin}^$ref->{'read'}^$rr\n";
 			print $fh "=== ", join('^', @{$ref->{gotit}}), "\n";
 			my $line;
 			$ref->{size} = 0;
@@ -484,20 +484,20 @@ sub queue_msg
 	
 	# bat down the message list looking for one that needs to go off site and whose
 	# nearest node is not busy.
-	
+
 	dbg('msg', "queue msg ($sort)\n");
 	foreach $ref (@msg) {
 		# firstly, is it private and unread? if so can I find the recipient
 		# in my cluster node list offsite?
 		if ($ref->{private}) {
-			if ($ref->{read} == 0) {
+			if ($ref->{'read'} == 0) {
 				$clref = DXCluster->get_exact($ref->{to});
 				if ($clref && !grep { $clref->{dxchan} == $_ } DXCommandmode::get_all) {
 					$dxchan = $clref->{dxchan};
 					$ref->start_msg($dxchan) if $clref && !get_busy($dxchan->call) && $dxchan->state eq 'normal';
 				}
 			}
-		} elsif ($sort == undef) {
+		} elsif (!$sort) {
 			# otherwise we are dealing with a bulletin, compare the gotit list with
 			# the nodelist up above, if there are sites that haven't got it yet
 			# then start sending it - what happens when we get loops is anyone's
@@ -719,7 +719,7 @@ sub do_send_stuff
 			delete $self->{loc};
 			$self->state('prompt');
 			$self->func(undef);
-			DXMsg::queue_msg();
+			DXMsg::queue_msg(0);
 		} elsif ($line eq "\031" || uc $line eq "/ABORT" || uc $line eq "/QUIT") {
 			#push @out, $self->msg('sendabort');
 			push @out, "aborted";
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index f3612791..655da52b 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -24,7 +24,7 @@ use DXProtout;
 use Carp;
 
 use strict;
-use vars qw($me $pc11_max_age $pc11_dup_age %dup $last_hour %pings %rcmds);
+use vars qw($me $pc11_max_age $pc11_dup_age %dup $last_hour %pings %rcmds %nodehops);
 
 $me = undef;					# the channel id for this cluster
 $pc11_max_age = 1*3600;			# the maximum age for an incoming 'real-time' pc11
@@ -33,13 +33,18 @@ $pc11_dup_age = 24*3600;		# the maximum time to keep the dup list for
 $last_hour = time;				# last time I did an hourly periodic update
 %pings = ();                    # outstanding ping requests outbound
 %rcmds = ();                    # outstanding rcmd requests outbound
+%nodehops = ();                 # node specific hop control
+
 
 sub init
 {
 	my $user = DXUser->get($main::mycall);
 	$DXProt::myprot_version += $main::version*100;
-	$me = DXProt->new($main::mycall, undef, $user); 
+	$me = DXProt->new($main::mycall, 0, $user); 
 	$me->{here} = 1;
+	$me->{state} = "indifferent";
+	do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
+	confess $@ if $@;
 	#  $me->{sort} = 'M';    # M for me
 }
 
@@ -50,7 +55,7 @@ sub init
 sub new 
 {
 	my $self = DXChannel::alloc(@_);
-	$self->{sort} = 'A';		# in absence of how to find out what sort of an object I am
+	$self->{'sort'} = 'A';		# in absence of how to find out what sort of an object I am
 	return $self;
 }
 
@@ -99,6 +104,7 @@ sub normal
 	
 	# process PC frames
 	my ($pcno) = $field[0] =~ /^PC(\d\d)/; # just get the number
+	return unless $pcno;
 	return if $pcno < 10 || $pcno > 51;
 	
  SWITCH: {
@@ -282,7 +288,7 @@ sub normal
 			}
 			
 			# queue up any messages
-			DXMsg::queue_msg() if $self->state eq 'normal';
+			DXMsg::queue_msg(0) if $self->state eq 'normal';
 			last SWITCH;
 		}
 		
@@ -292,7 +298,7 @@ sub normal
 			$self->state('normal');
 			
 			# queue mail
-			DXMsg::queue_msg();
+			DXMsg::queue_msg(0);
 			return;
 		}
 		
@@ -309,7 +315,7 @@ sub normal
 			$self->state('normal');
 			
 			# queue mail
-			DXMsg::queue_msg();
+			DXMsg::queue_msg(0);
 			return;
 		}
 		
@@ -467,13 +473,8 @@ sub normal
 	 #        REBROADCAST!!!!
 	 #
 	 
-	my $hops;
-	if (!$self->{isolate} && (($hops) = $line =~ /H(\d+)\^\~?$/o)) {
-		my $newhops = $hops - 1;
-		if ($newhops > 0) {
-			$line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/;	# change the hop count
-			broadcast_ak1a($line, $self); # send it to everyone but me
-		}
+	if (!$self->{isolate}) {
+		broadcast_ak1a($line, $self); # send it to everyone but me
 	}
 }
 
@@ -484,16 +485,17 @@ sub normal
 sub process
 {
 	my $t = time;
-	my @chan = DXChannel->get_all();
-	my $chan;
+	my @dxchan = DXChannel->get_all();
+	my $dxchan;
 	
-	foreach $chan (@chan) {
-		next if !$chan->is_ak1a();
+	foreach $dxchan (@dxchan) {
+		next unless $dxchan->is_ak1a();
+		next if $dxchan == $me;
 		
 		# send a pc50 out on this channel
-		if ($t >= $chan->pc50_t + $DXProt::pc50_interval) {
-			$chan->send(pc50());
-			$chan->pc50_t($t);
+		if ($t >= $dxchan->pc50_t + $DXProt::pc50_interval) {
+			$dxchan->send(pc50());
+			$dxchan->pc50_t($t);
 		}
 	}
 	
@@ -560,12 +562,21 @@ sub send_local_config
 		@nodes = DXNode::get_all();
 		@nodes = grep { $_->dxchan != $self } @nodes;
 	}
-	$self->send($me->pc19(@nodes));
+
+	my @s = $me->pc19(@nodes);
+	for (@s) {
+		my $routeit = adjust_hops($self, $_);
+		$self->send($_) if $routeit;
+	}
 	
 	# get all the users connected on the above nodes and send them out
 	foreach $n (@nodes) {
 		my @users = values %{$n->list};
-		$self->send(DXProt::pc16($n, @users));
+		my @s = pc16($n, @users);
+		for (@s) {
+			my $routeit = adjust_hops($self, $_);
+			$self->send($_) if $routeit;
+		}
 	}
 }
 
@@ -581,14 +592,11 @@ sub route
 	if ($cl) {
 		my $hops;
 		my $dxchan = $cl->{dxchan};
-		if (($hops) = $line =~ /H(\d+)\^\~?$/o) {
-			my $newhops = $hops - 1;
-			if ($newhops > 0) {
-				$line =~ s/\^H$hops(\^\~?)$/\^H$newhops$1/;	# change the hop count
+		if ($dxchan) {
+			my $routeit = adjust_hops($dxchan, $line);   # adjust its hop count by node name
+			if ($routeit) {
 				$dxchan->send($line) if $dxchan;
 			}
-		} else {
-			$dxchan->send($line) if $dxchan; # for them wot don't have Hops
 		}
 	}
 }
@@ -598,12 +606,14 @@ sub broadcast_ak1a
 {
 	my $s = shift;				# the line to be rebroadcast
 	my @except = @_;			# to all channels EXCEPT these (dxchannel refs)
-	my @chan = get_all_ak1a();
-	my $chan;
+	my @dxchan = get_all_ak1a();
+	my $dxchan;
 	
-	foreach $chan (@chan) {
-		next if grep $chan == $_, @except;
-		$chan->send($s) unless $chan->{isolate};		# send it if it isn't the except list
+	# send it if it isn't the except list and isn't isolated and still has a hop count
+	foreach $dxchan (@dxchan) {
+		next if grep $dxchan == $_, @except;
+		my $routeit = adjust_hops($dxchan, $s);      # adjust its hop count by node name       
+		$dxchan->send($s) unless $dxchan->{isolate} || !$routeit; 
 	}
 }
 
@@ -612,13 +622,13 @@ sub broadcast_users
 {
 	my $s = shift;				# the line to be rebroadcast
 	my @except = @_;			# to all channels EXCEPT these (dxchannel refs)
-	my @chan = get_all_users();
-	my $chan;
+	my @dxchan = get_all_users();
+	my $dxchan;
 	
-	foreach $chan (@chan) {
-		next if grep $chan == $_, @except;
-		$s =~ s/\a//og if !$chan->{beep};
-		$chan->send($s);		# send it if it isn't the except list or hasn't a passout flag
+	foreach $dxchan (@dxchan) {
+		next if grep $dxchan == $_, @except;
+		$s =~ s/\a//og if !$dxchan->{beep};
+		$dxchan->send($s);		# send it if it isn't the except list or hasn't a passout flag
 	}
 }
 
@@ -626,10 +636,10 @@ sub broadcast_users
 sub broadcast_list
 {
 	my $s = shift;
-	my $chan;
+	my $dxchan;
 	
-	foreach $chan (@_) {
-		$chan->send($s);		# send it 
+	foreach $dxchan (@_) {
+		$dxchan->send($s);		# send it 
 	}
 }
 
@@ -683,6 +693,50 @@ sub get_hops
 	return "H$hops";       
 }
 
+# 
+# adjust the hop count on a per node basis using the user loadable 
+# hop table if available or else decrement an existing one
+#
+
+sub adjust_hops
+{
+	my $self = shift;
+	my $call = $self->{call};
+	my $hops;
+	
+	if (($hops) = $_[0] =~ /\^H(\d+)\^~?$/o) {
+		my ($pcno) = $_[0] =~ /^PC(\d\d)/o;
+		confess "$call called adjust_hops with '$_[0]'" unless $pcno;
+		my $ref = $nodehops{$call} if %nodehops;
+		if ($ref) {
+			my $newhops = $ref->{$pcno};
+			return 0 if defined $newhops && $newhops == 0;
+			$newhops = $ref->{default} unless $newhops;
+			return 0 if defined $newhops && $newhops == 0;
+			$newhops = $hops if !$newhops;
+			$_[0] =~ s/\^H(\d+)(\^~?)$/\^H$newhops$2/ if $newhops;
+		} else {
+			# simply decrement it
+			$hops--;
+			return 0 if !$hops;
+			$_[0] =~ s/\^H(\d+)(\^~?)$/\^H$hops$2/ if $hops;
+		}
+	}
+	return 1;
+}
+
+# 
+# load hop tables
+#
+sub load_hops
+{
+	my $self = shift;
+	return $self->msg('lh1') unless -e "$main::data/hop_table.pl";
+	do "$main::data/hop_table.pl";
+	return $@ if $@;
+	return 0;
+}
+
 # remove leading and trailing spaces from an input string
 sub unpad
 {
diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index e1b44dfa..0ef376f0 100644
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -18,7 +18,7 @@ use Carp;
 use strict;
 use vars qw(%u $dbm $filename %valid);
 
-%u = undef;
+%u = ();
 $dbm = undef;
 $filename = undef;
 
@@ -36,7 +36,7 @@ $filename = undef;
   lastin => '0,Last Time in,cldatetime',
   passwd => '9,Password',
   addr => '0,Full Address',
-  sort => '0,Type of User',                # A - ak1a, U - User, S - spider cluster, B - BBS
+  'sort' => '0,Type of User',                # A - ak1a, U - User, S - spider cluster, B - BBS
   xpert => '0,Expert Status,yesno',
   bbs => '0,Home BBS',
   node => '0,Last Node',
@@ -106,7 +106,7 @@ sub new
 
   my $self = {};
   $self->{call} = $call;
-  $self->{sort} = 'U';
+  $self->{'sort'} = 'U';
   $self->{dxok} = 1;
   $self->{annok} = 1;
   $self->{lang} = $main::lang;
@@ -272,7 +272,7 @@ sub field_prompt
 sub sort
 {
   my $self = shift;
-  @_ ? $self->{sort} = shift : $self->{sort} ;
+  @_ ? $self->{'sort'} = shift : $self->{'sort'} ;
 }
 1;
 __END__
diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 81bace8c..5c6c51af 100644
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -148,11 +148,9 @@ sub print_all_fields
 {
 	my $self = shift;			# is a dxchan
 	my $ref = shift;			# is a thingy with field_prompt and fields methods defined
-	my @out = @_;
- 
+	my @out;
 	my @fields = $ref->fields;
 	my $field;
-	my @out;
 
 	foreach $field (sort @fields) {
 		if (defined $ref->{$field}) {
diff --git a/perl/DXVars.pm b/perl/DXVars.pm
index 91f43707..4d208b1b 100644
--- a/perl/DXVars.pm
+++ b/perl/DXVars.pm
@@ -18,7 +18,7 @@ require Exporter;
                 $def_hopcount $data $system $cmd
 				$userfn $motd $local_cmd $mybbsaddr
                 $lang
-				$pc50_interval, $user_interval
+				$pc50_interval $user_interval
                );
 			   
 			   
diff --git a/perl/Messages b/perl/Messages
index a7250016..26bf7fa8 100644
--- a/perl/Messages
+++ b/perl/Messages
@@ -56,6 +56,7 @@ package DXM;
 				isoc => '$_[0] created and Isolated',
 				l1 => 'Sorry $_[0], you are already logged on on another channel',
 				l2 => 'Hello $_[0], this is $main::mycall in $main::myqth running DXSpider V$main::version',
+				lh1 => '$main::data/hop_table.pl doesn\'t exist',
 				loce1 => 'Please enter your location,, set/location ',
 				loce2 => 'Don\'t recognise \"$_[0]\" as a Lat/Long (eg 52 20 N 0 16 E)',
 				loc => 'Your Lat/Long is now \"$_[0]\"',
diff --git a/perl/Prefix.pm b/perl/Prefix.pm
index ae431485..cab54cd8 100644
--- a/perl/Prefix.pm
+++ b/perl/Prefix.pm
@@ -17,9 +17,9 @@ use Carp;
 use strict;
 use vars qw($db  %prefix_loc %pre);
 
-$db;     # the DB_File handle
-%prefix_loc;   # the meat of the info
-%pre;       # the prefix list
+$db = undef;     # the DB_File handle
+%prefix_loc = ();   # the meat of the info
+%pre = ();       # the prefix list
 
 sub load
 {
diff --git a/perl/cluster.pl b/perl/cluster.pl
index ad71b688..b7bdd037 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -110,7 +110,7 @@ sub rec
 
 		
 		# the user MAY have an SSID if local, but otherwise doesn't
-		my $user = DXUser->get($call);
+		$user = DXUser->get($call);
 		if (!defined $user) {
 			$user = DXUser->new($call);
 		} else {
@@ -149,7 +149,7 @@ sub cease
 {
 	my $dxchan;
 	foreach $dxchan (DXChannel->get_all()) {
-		disconnect($dxchan);
+		disconnect($dxchan) unless $dxchan == $DXProt::me;
 	}
 	Log('cluster', "DXSpider V$version stopped");
 	exit(0);
-- 
2.34.1