From: djk <djk>
Date: Mon, 22 Jun 1998 20:05:22 +0000 (+0000)
Subject: We have lift off, we are CONNECTED. We aren't doing much but we can
X-Git-Tag: SPIDER_1_5~48
X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=1cf4bd14be226274d5deb05da8480ab91a5dac52

We have lift off, we are CONNECTED. We aren't doing much but we can
get on and we have a structure in place which is workable. It now needs
fleshing out.
---

diff --git a/cmd/set/address.pl b/cmd/set/address.pl
index e69de29b..f5922d9c 100644
--- a/cmd/set/address.pl
+++ b/cmd/set/address.pl
@@ -0,0 +1,27 @@
+#
+# set the address field
+#
+# Copyright (c) 1998 - Dirk Koopman
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my $call;
+my @out;
+my $user;
+
+if ($self->priv >= 5) {             # allow a callsign as first arg
+  my @args = split /\s+/, $line;
+  $call = UC $args[0];
+  $user = DXUser->get_current($call);
+  shift @args if $user;
+  $line = join ' ', @args;
+} else {
+  $user = $self->user;
+}
+
+$user->addr($line);
+push @out, DXM::msg('addr', $call);
+
+return (1, @out);
diff --git a/cmd/set/announce.pl b/cmd/set/announce.pl
index 8fce45ca..8a77f1ea 100644
--- a/cmd/set/announce.pl
+++ b/cmd/set/announce.pl
@@ -15,9 +15,9 @@ my @out;
 
 foreach $call (@args) {
   $call = uc $call;
-  my $user = ($call eq $self->call) ? $self->user :  DXUser->get($call);
-  if ($user) {
-    $user->ann(1);
+  my $chan = DXChannel->get($call);
+  if ($chan) {
+    $chan->ann(1);
 	push @out, DXM::msg('anns', $call);
   } else {
     push @out, DXM::msg('e3', "Set Announce", $call);
diff --git a/cmd/set/dx.pl b/cmd/set/dx.pl
index 00ea0328..0acb39db 100644
--- a/cmd/set/dx.pl
+++ b/cmd/set/dx.pl
@@ -15,9 +15,9 @@ my @out;
 
 foreach $call (@args) {
   $call = uc $call;
-  my $user = ($call eq $self->call) ? $self->user : DXUser->get($call);
-  if ($user) {
-    $user->dx(1);
+  my $chan = DXChannel->get($call);
+  if ($chan) {
+    $chan->dx(1);
 	push @out, DXM::msg('dxs', $call);
   } else {
     push @out, DXM::msg('e3', "Set DX Spots", $call);
diff --git a/cmd/set/here.pl b/cmd/set/here.pl
index acccbcc4..b89d47d7 100644
--- a/cmd/set/here.pl
+++ b/cmd/set/here.pl
@@ -15,9 +15,9 @@ my @out;
 
 foreach $call (@args) {
   $call = uc $call;
-  my $user = ($call eq $self->call) ? $self->user : DXUser->get($call);
-  if ($user) {
-    $user->here(1);
+  my $chan = DXChannel->get($call);
+  if ($chan) {
+    $chan->here(1);
 	push @out, DXM::msg('heres', $call);
   } else {
     push @out, DXM::msg('e3', "Set Here", $call);
diff --git a/cmd/set/node.pl b/cmd/set/node.pl
new file mode 100644
index 00000000..78baa189
--- /dev/null
+++ b/cmd/set/node.pl
@@ -0,0 +1,35 @@
+#
+# set user type to 'A' for AK1A node
+#
+# Please note that this is only effective if the user is not on-line
+#
+# Copyright (c) 1998 - Dirk Koopman
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, $line;
+my $call;
+my @out;
+my $user;
+
+return (0) if $self->priv < 5;
+
+foreach $call (@args) {
+  $call = uc $call;
+  my $chan = DXChannel->get($call);
+  if ($chan) {
+	push @out, DXM::msg('nodee1', $call);
+  } else {
+    $user = DXUser->get($call);
+	if ($user) {
+	  $user->sort('A');
+	  $user->close();
+      push @out, DXM::msg('node', $call);
+	} else {
+      push @out, DXM::msg('e3', "Set Node", $call);
+	}
+  }
+}
+return (1, @out);
diff --git a/cmd/set/talk.pl b/cmd/set/talk.pl
index 8c4d3ac4..85b66c04 100644
--- a/cmd/set/talk.pl
+++ b/cmd/set/talk.pl
@@ -15,9 +15,9 @@ my @out;
 
 foreach $call (@args) {
   $call = uc $call;
-  my $user = ($call eq $self->call) ? $self->user : DXUser->get($call);
-  if ($user) {
-    $user->talk(1);
+  my $chan = DXChannel->get($call);
+  if ($chan) {
+    $chan->talk(1);
 	push @out, DXM::msg('talks', $call);
   } else {
     push @out, DXM::msg('e3', "Set Talk", $call);
diff --git a/cmd/set/wwv.pl b/cmd/set/wwv.pl
index 2e403cec..bfa04f25 100644
--- a/cmd/set/wwv.pl
+++ b/cmd/set/wwv.pl
@@ -15,9 +15,9 @@ my @out;
 
 foreach $call (@args) {
   $call = uc $call;
-  my $user = ($call eq $self->call) ? $self->user : DXUser->get($call);
-  if ($user) {
-    $user->wwv(1);
+  my $chan = DXChannel->get($call);
+  if ($chan) {
+    $chan->wwv(1);
 	push @out, DXM::msg('wwvs', $call);
   } else {
     push @out, DXM::msg('e3', "Set WWV", $call);
diff --git a/cmd/show/user.pl b/cmd/show/user.pl
index 3b277774..997ae542 100644
--- a/cmd/show/user.pl
+++ b/cmd/show/user.pl
@@ -12,7 +12,7 @@ my $call;
 my @out;
 foreach $call (@list) {
   $call = uc $call;
-  my $ref = DXUser->get($call);
+  my $ref = DXUser->get_current($call);
   if ($ref) {
     @out = print_all_fields($self, $ref, "User Information $call");
   } else {
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 24b87566..fc0305a7 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -30,9 +30,11 @@ use DXUtil;
 use DXM;
 use DXDebug;
 
-%channels = undef;
+use strict;
 
-%valid = (
+my %channels = undef;
+
+my %valid = (
   call => '0,Callsign',
   conn => '9,Msg Conn ref',
   user => '9,DXUser ref',
@@ -45,11 +47,17 @@ use DXDebug;
   name => '0,User Name',
   consort => '9,Connection Type',
   sort => '9,Type of Channel',
+  wwv => '0,Want WWV,yesno',
+  talk => '0,Want Talk,yesno',
+  ann => '0,Want Announce,yesno',
+  here => '0,Here?,yesno',
+  confmode => '0,In Conference?,yesno',
+  dx => '0,DX Spots,yesno',
 );
 
 
 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
-sub new
+sub alloc
 {
   my ($pkg, $call, $conn, $user) = @_;
   my $self = {};
@@ -98,6 +106,19 @@ sub del
   delete $channels{$self->{call}};
 }
 
+# is it an ak1a cluster ?
+sub is_ak1a
+{
+  my $self = shift;
+  return $self->{sort} eq 'A';
+}
+
+# is it a user?
+sub is_user
+{
+  my $self = shift;
+  return $self->{sort} eq 'U';
+}
 
 # handle out going messages, immediately without waiting for the select to drop
 # this could, in theory, block
@@ -186,11 +207,11 @@ sub field_prompt
   return $valid{$ele};
 }
 
+no strict;
 sub AUTOLOAD
 {
   my $self = shift;
   my $name = $AUTOLOAD;
-  
   return if $name =~ /::DESTROY$/;
   $name =~ s/.*:://o;
   
diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm
index 2dad1cb6..920a33fb 100644
--- a/perl/DXCluster.pm
+++ b/perl/DXCluster.pm
@@ -17,17 +17,28 @@ package DXCluster;
 use Exporter;
 @ISA = qw(Exporter);
 
-%cluster = ();            # this is where we store the dxcluster database
+use strict;
+
+my %cluster = ();            # this is where we store the dxcluster database
+
+my %valid = (
+  mynode => '0,Parent Node',
+  call => '0,Callsign',
+  confmode => '0,Conference Mode,yesno',
+  here => '0,Here?,yesno',
+  dxchan => '5,Channel ref',
+  pcversion => '5,Node Version',
+);
 
 sub alloc
 {
-  my ($pkg, $call, $confmode, $here, $dxprot) = @_;
+  my ($pkg, $call, $confmode, $here, $dxchan) = @_;
   die "$call is already alloced" if $cluster{$call};
   my $self = {};
   $self->{call} = $call;
   $self->{confmode} = $confmode;
   $self->{here} = $here;
-  $self->{dxprot} = $dxprot;
+  $self->{dxchan} = $dxchan;
 
   $cluster{$call} = bless $self, $pkg;
   return $self;
@@ -52,14 +63,6 @@ sub delcluster;
   delete $cluster{$self->{call}};
 }
 
-%valid = (
-  mynode => '0,Parent Node',
-  call => '0,Callsign',
-  confmode => '5,Conference Mode,yesno',
-  here => '5,Here?,yesno',
-  dxprot => '5,Channel ref',
-  version => '5,Node Version',
-);
 
 # return a prompt for a field
 sub field_prompt
@@ -68,6 +71,7 @@ sub field_prompt
   return $valid{$ele};
 }
 
+no strict;
 sub AUTOLOAD
 {
   my $self = shift;
@@ -84,16 +88,17 @@ sub AUTOLOAD
 # USER special routines
 #
 
-package DXUser;
+package DXNodeuser;
 
 @ISA = qw(DXCluster);
 
-%users = ();
+use strict;
+my %users = ();
 
 sub new 
 {
-  my ($pkg, $mynode, $call, $confmode, $here, $dxprot) = @_;
-  my $self = $pkg->alloc($call, $confmode, $here, $dxprot);
+  my ($pkg, $mynode, $call, $confmode, $here, $dxchan) = @_;
+  my $self = $pkg->alloc($call, $confmode, $here, $dxchan);
   $self->{mynode} = $mynode;
 
   $users{$call} = $self;
@@ -112,6 +117,8 @@ sub count
   return %users + 1;                 # + 1 for ME (naf eh!)
 }
 
+no strict;
+
 #
 # NODE special routines
 #
@@ -120,13 +127,14 @@ package DXNode;
 
 @ISA = qw(DXCluster);
 
-%nodes = ();
+use strict;
+my %nodes = ();
 
 sub new 
 {
-  my ($pkg, $call, $confmode, $here, $version, $dxprot) = @_;
-  my $self = $pkg->alloc($call, $confmode, $here, $dxprot);
-  $self->{version} = $version;
+  my ($pkg, $call, $confmode, $here, $pcversion, $dxchan) = @_;
+  my $self = $pkg->alloc($call, $confmode, $here, $dxchan);
+  $self->{version} = $pcversion;
   $nodes{$call} = $self;
   return $self;
 }
@@ -144,7 +152,7 @@ sub get_all
   my $list;
   my @out;
   foreach $list (values(%nodes)) {
-    push @out, $list if $list->{version};
+    push @out, $list if $list->{pcversion};
   }
   return @out;
 }
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index d48de1c8..474d2c9c 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -18,10 +18,22 @@ use DXVars;
 use DXDebug;
 
 use strict;
-use vars qw( %Cache $last_dir_mtime @cmd);
 
-$last_dir_mtime = 0;          # the last time one of the cmd dirs was modified
-@cmd = undef;                 # a list of commands+path pairs (in alphabetical order)
+#use vars qw( %Cache $last_dir_mtime @cmd);
+my %Cache = ();                  # cache of dynamically loaded routine's mod times
+my $last_dir_mtime = 0;          # the last time one of the cmd dirs was modified
+my @cmd = undef;                 # a list of commands+path pairs (in alphabetical order)
+
+#
+# obtain a new connection this is derived from dxchannel
+#
+
+sub new 
+{
+  my $self = DXChannel::alloc(@_);
+  $self->{sort} = 'U';   # in absence of how to find out what sort of an object I am
+  return $self;
+}
 
 # this is how a a connection starts, you get a hello message and the motd with
 # possibly some other messages asking you to set various things up if you are
@@ -42,7 +54,10 @@ sub start
   $self->{priv} = $user->priv;
   $self->{priv} = 0 if $line =~ /^(ax|te)/;     # set the connection priv to 0 - can be upgraded later
   $self->{consort} = $line;                # save the connection type
-  $self->sort('U');                        # set the channel type
+
+  # set some necessary flags on the user if they are connecting
+  $self->{wwv} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1;
+
 }
 
 #
@@ -127,6 +142,36 @@ sub prompt
   DXChannel::msg($self, 'pr', $call);
 }
 
+# broadcast a message to all users [except those mentioned after buffer]
+sub broadcast
+{
+  my $pkg = shift;                # ignored
+  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);
+  
+L: foreach $chan (@list) {
+     next if !$chan->sort eq 'U';  # only interested in user channels  
+	 foreach $except (@except) {
+	   next L if $except == $chan;  # ignore channels in the 'except' list
+	 }
+	 chan->send($s);              # send it
+  }
+}
+
+# gimme all the users
+sub get_all
+{
+  my @list = DXChannel->get_all();
+  my $ref;
+  my @out;
+  foreach $ref (@list) {
+    push @out, $ref if $ref->sort eq 'U';
+  }
+  return @out;
+}
+
 #
 # search for the command in the cache of short->long form commands
 #
diff --git a/perl/DXM.pm b/perl/DXM.pm
index 80b2fbc7..5c735fc7 100644
--- a/perl/DXM.pm
+++ b/perl/DXM.pm
@@ -39,6 +39,8 @@ require Exporter;
   l1 => 'Sorry $_[0], you are already logged on on another channel',
   l2 => 'Hello $_[0], this is $main::mycall located in $main::myqth',
   m2 => '$_[0] Information: $_[1]',
+  node => '$_[0] set as AK1A style Node',
+  nodee1 => 'You cannot use this command whilst your target ($_[0]) is on-line',
   pr => '$_[0] de $main::mycall $main::cldate $main::ztime >',
   prx => '$main::$mycall >',
   talks => 'Talk flag set on $_[0]',
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 88fed5e3..3001d263 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -11,31 +11,44 @@ package DXProt;
 
 @ISA = qw(DXChannel);
 
-use strict;
-
 use DXUtil;
 use DXChannel;
 use DXUser;
 use DXM;
 use DXCluster;
+use DXProtVars;
+use DXCommandmode;
+
+use strict;
+
+#
+# obtain a new connection this is derived from dxchannel
+#
+
+sub new 
+{
+  my $self = DXChannel::alloc(@_);
+  $self->{sort} = 'A';   # in absence of how to find out what sort of an object I am
+  return $self;
+}
 
 # this is how a pc connection starts (for an incoming connection)
 # issue a PC38 followed by a PC18, then wait for a PC20 (remembering
 # all the crap that comes between).
 sub start
 {
-  my $self = shift;
+  my ($self, $line) = shift;
   my $call = $self->call;
   
-  # set the channel sort
-  $self->sort('A');
+  # remember type of connection
+  $self->{consort} = $line;
 
   # set unbuffered
-  self->send_now('B',"0");
+  $self->send_now('B',"0");
   
-  # do we have him connected on the cluster somewhere else?
-  $self->send(pc38());
-  $self->send(pc18());
+  # send initialisation string
+  $self->send($self->pc38()) if DXNode->get_all();
+  $self->send($self->pc18());
   $self->{state} = 'incoming';
 }
 
@@ -44,7 +57,95 @@ sub start
 #
 sub normal
 {
+  my ($self, $line) = @_;
+  my @field = split /[\^\~]/, $line;
+  
+  # ignore any lines that don't start with PC
+  return if !$field[0] =~ /^PC/;
 
+  # process PC frames
+  my ($pcno) = $field[0] =~ /^PC(\d\d)/;          # just get the number
+  return if $pcno < 10 || $pcno > 51;
+  
+  SWITCH: {
+    if ($pcno == 10) {last SWITCH;}
+    if ($pcno == 11) {last SWITCH;}
+    if ($pcno == 12) {last SWITCH;}
+    if ($pcno == 13) {last SWITCH;}
+    if ($pcno == 14) {last SWITCH;}
+    if ($pcno == 15) {last SWITCH;}
+    if ($pcno == 16) {last SWITCH;}
+    if ($pcno == 17) {last SWITCH;}
+    if ($pcno == 18) {last SWITCH;}
+    if ($pcno == 19) {last SWITCH;}
+    if ($pcno == 20) {              # send local configuration
+
+      # set our data (manually 'cos we only have a psuedo channel [at the moment])
+	  my $hops = $self->get_hops();
+	  $self->send("PC19^1^$main::mycall^0^$DXProt::myprot_version^$hops^");
+	  
+      # get all the local users and send them out
+      my @list;
+	  for (@list = DXCommandmode::get_all(); @list; ) {
+	    @list = $self->pc16(@list);
+	    my $out = shift @list;
+		$self->send($out);
+	  }
+	  $self->send($self->pc22());
+	  last SWITCH;
+	}
+    if ($pcno == 21) {last SWITCH;}
+    if ($pcno == 22) {last SWITCH;}
+    if ($pcno == 23) {last SWITCH;}
+    if ($pcno == 24) {last SWITCH;}
+    if ($pcno == 25) {last SWITCH;}
+    if ($pcno == 26) {last SWITCH;}
+    if ($pcno == 27) {last SWITCH;}
+    if ($pcno == 28) {last SWITCH;}
+    if ($pcno == 29) {last SWITCH;}
+    if ($pcno == 30) {last SWITCH;}
+    if ($pcno == 31) {last SWITCH;}
+    if ($pcno == 32) {last SWITCH;}
+    if ($pcno == 33) {last SWITCH;}
+    if ($pcno == 34) {last SWITCH;}
+    if ($pcno == 35) {last SWITCH;}
+    if ($pcno == 36) {last SWITCH;}
+    if ($pcno == 37) {last SWITCH;}
+    if ($pcno == 38) {last SWITCH;}
+    if ($pcno == 39) {last SWITCH;}
+    if ($pcno == 40) {last SWITCH;}
+    if ($pcno == 41) {last SWITCH;}
+    if ($pcno == 42) {last SWITCH;}
+    if ($pcno == 43) {last SWITCH;}
+    if ($pcno == 44) {last SWITCH;}
+    if ($pcno == 45) {last SWITCH;}
+    if ($pcno == 46) {last SWITCH;}
+    if ($pcno == 47) {last SWITCH;}
+    if ($pcno == 48) {last SWITCH;}
+    if ($pcno == 49) {last SWITCH;}
+    if ($pcno == 50) {last SWITCH;}
+    if ($pcno == 51) {last SWITCH;}
+  }
+  
+  # if get here then rebroadcast the thing with its Hop count decremented (if
+  # the is one). If it has a hop count and it decrements to zero then don't
+  # rebroadcast it.
+  #
+  # NOTE - don't arrive here UNLESS YOU WANT this lump of protocol to be
+  #        REBROADCAST!!!!
+  #
+  
+  my $hopfield = pop @field;
+  push @field, $hopfield; 
+  
+  if ($hopfield =~ /H\d\d./o) {
+    my ($hops) = $hopfield =~ /H(\d+)/o;
+	$hops--;
+	if ($hops > 0) {
+	  $line =~ s/\^H\d+(\^\~.)$/\^H$hops$1/;       # change the hop count
+	  DXProt->broadcast($line, $self);             # send it to everyone but me
+	}
+  }
 }
 
 #
@@ -58,10 +159,10 @@ sub process
   my $chan;
   
   foreach $chan (@chan) {
-    next if $chan->sort ne 'A';  
+    next if !$chan->is_ak1a();
 
     # send a pc50 out on this channel
-    if ($t >= $chan->t + $main::pc50_interval) {
+    if ($t >= $chan->t + $DXProt::pc50_interval) {
       $chan->send(pc50());
 	  $chan->t($t);
 	}
@@ -76,20 +177,56 @@ sub finish
 
 }
  
+# 
+# add a (local) user to the cluster
+#
+
+sub adduser
+{
+
+}
+
+#
+# delete a (local) user to the cluster
+#
+
+sub deluser
+{
+
+}
+
+#
+# add a (locally connected) node to the cluster
+#
+
+sub addnode
+{
+
+}
+
+#
+# delete a (locally connected) node to the cluster
+#
+sub delnode
+{
+
+}
+
 #
 # some active measures
 #
 
+# broadcast a message to all clusters [except those mentioned after buffer]
 sub broadcast
 {
-  my $s = shift;
-  $s = shift if ref $s;           # if I have been called $self-> ignore it.
+  my $pkg = shift;                # ignored
+  my $s = shift;                  # the line to be rebroadcast
   my @except = @_;                # to all channels EXCEPT these (dxchannel refs)
   my @chan = DXChannel->get_all();
   my ($chan, $except);
   
 L: foreach $chan (@chan) {
-     next if $chan->sort != 'A';  # only interested in ak1a channels  
+     next if !$chan->sort eq 'A';  # only interested in ak1a channels  
 	 foreach $except (@except) {
 	   next L if $except == $chan;  # ignore channels in the 'except' list
 	 }
@@ -97,13 +234,108 @@ L: foreach $chan (@chan) {
   }
 }
 
+#
+# gimme all the ak1a nodes
+#
+sub get_all
+{
+  my @list = DXChannel->get_all();
+  my $ref;
+  my @out;
+  foreach $ref (@list) {
+    push @out, $ref if $ref->sort eq 'A';
+  }
+  return @out;
+}
+
+#
+# obtain the hops from the list for this callsign and pc no 
+#
+
+sub get_hops
+{
+  my ($self, $pcno) = @_;
+  return "H$DXProt::def_hopcount";       # for now
+}
+
 #
 # All the PCxx generation routines
 #
 
+#
+# add one or more users (I am expecting references that have 'call', 
+# 'confmode' & 'here' method) 
+# 
+# NOTE this sends back a list containing the PC string (first element)
+# and the rest of the users not yet processed
+# 
+sub pc16
+{
+  my $self = shift;    
+  my @list = @_;       # list of users
+  my @out = ('PC16', $main::mycall);
+  my $i;
+  
+  for ($i = 0; @list && $i < $DXProt::pc16_max_users; $i++) {
+    my $ref = shift @list;
+	my $call = $ref->call;
+	my $s = sprintf "%s %s %d", $call, $ref->confmode ? '*' : '-', $ref->here;
+	push @out, $s;
+  }
+  push @out, $self->get_hops();
+  my $str = join '^', @out;
+  $str .= '^';
+  return ($str, @list);
+}
+
+# Request init string
 sub pc18
 {
-  return "PC18^wot a load of twaddle^$main::myprot_version^~";
+  return "PC18^wot a load of twaddle^$DXProt::myprot_version^~";
+}
+
+#
+# add one or more nodes 
+# 
+# NOTE this sends back a list containing the PC string (first element)
+# and the rest of the nodes not yet processed (as PC16)
+# 
+sub pc19
+{
+  my $self = shift;    
+  my @list = @_;       # list of users
+  my @out = ('PC19', $main::mycall);
+  my $i;
+  
+  for ($i = 0; @list && $i < $DXProt::pc19_max_nodes; $i++) {
+    my $ref = shift @list;
+	push @out, $ref->here, $ref->call, $ref->confmode, $ref->pcversion;
+  }
+  push @out, $self->get_hops();
+  my $str = join '^', @out;
+  $str .= '^';
+  return ($str, @list);
+}
+
+# end of Rinit phase
+sub pc20
+{
+  return 'PC20^';
+}
+
+# delete a node
+sub pc21
+{
+  my ($self, $ref, $reason) = @_;
+  my $call = $ref->call;
+  my $hops = $self->get_hops();
+  return "PC21^$call^$reason^$hops^";
+}
+
+# end of init phase
+sub pc22
+{
+  return 'PC22^';
 }
 
 # send all the DX clusters I reckon are connected
@@ -121,7 +353,7 @@ sub pc38
 
 sub pc50
 {
-  my $n = DXUsers->count;
+  my $n = DXNodeuser->count;
   return "PC50^$main::mycall^$n^H99^";
 }
 
diff --git a/perl/DXProtVars.pm b/perl/DXProtVars.pm
new file mode 100644
index 00000000..52477433
--- /dev/null
+++ b/perl/DXProtVars.pm
@@ -0,0 +1,38 @@
+#
+#
+# These are various values used by the AK1A protocol stack
+#
+# Change these at your peril (or if you know what you are doing)!
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+package DXProt;
+
+# maximum number of users in a PC16 message
+$pc16_max_users = 5;
+
+# maximum number of nodes in a PC19 message
+$pc19_max_nodes = 5;
+
+# the interval between pc50s (in seconds)
+$pc50_interval = 14*60;
+
+# the version of DX cluster (tm) software I am masquerading as
+$myprot_version = "5447";
+
+# default hopcount to use
+$def_hopcount = 15;
+
+# some variable hop counts based on message type
+%hopcount = (
+  11 => 25,
+  16 => 10,
+  17 => 10,
+  19 => 10,
+  21 => 10,
+);
+
+
diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index b593a6b2..cdbc0b23 100644
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -32,15 +32,14 @@ $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
-  wwv => '0,Want WWV,yesno',
-  talk => '0,Want Talk,yesno',
-  ann => '0,Want Announce,yesno',
-  here => '0,Here Status,yesno',
+  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,Home Node',
-  dx => '0,DX Spots,yesno',
+  lockout => '9,Locked out?,yesno',        # won't let them in at all
+  dxok => '9,DX Spots?,yesno',            # accept his dx spots?
+  annok => '9,Announces?,yesno',            # accept his announces?
+  reg => '0,Registered?,yesno',            # is this user registered? 
 );
 
 sub AUTOLOAD
@@ -92,12 +91,16 @@ sub new
 
   my $self = {};
   $self->{call} = $call;
+  $self->{sort} = 'U';
+  $self->{dxok} = 1;
+  $self->{annok} = 1;
   bless $self, $pkg;
   $u{call} = $self;
 }
 
 #
-# get - get an existing user
+# get - get an existing user - this seems to return a different reference everytime it is
+#       called - see below
 #
 
 sub get
@@ -106,6 +109,22 @@ sub get
   return $u{$call};
 }
 
+#
+# get an existing either from the channel (if there is one) or from the database
+#
+# It is important to note that if you have done a get (for the channel say) and you
+# want access or modify that you must use this call (and you must NOT use get's all
+# over the place willy nilly!)
+#
+
+sub get_current
+{
+  my ($pkg, $call) = @_;
+  my $dxchan = DXChannel->get($call);
+  return $dxchan->user if $dxchan;
+  return $u{$call};
+}
+
 #
 # put - put a user
 #
diff --git a/perl/DXVars.pm b/perl/DXVars.pm
index 362f26e2..8cc17e6c 100644
--- a/perl/DXVars.pm
+++ b/perl/DXVars.pm
@@ -57,24 +57,15 @@ $clusterport = 27754;
 # cluster debug file
 $debugfn = "/tmp/debug_cluster";
 
-# the version of DX cluster (tm) software I am masquerading as
-$myprot_version = "5447";
-
 # your favorite way to say 'Yes'
 $yes = 'Yes';
 
 # your favorite way to say 'No'
 $no = 'No';
 
-# the interval between pc50s (in seconds)
-$pc50_interval = 14*60;
-
 # the interval between unsolicited prompts if not traffic
 $user_interval = 11*60;
 
-# default hopcount to use - note this will override any incoming hop counts, if they are greater
-$def_hopcount = 7;
-
 # root of directory tree for this system
 $root = "/spider"; 
 
diff --git a/perl/client.pl b/perl/client.pl
index f44120f2..84541433 100755
--- a/perl/client.pl
+++ b/perl/client.pl
@@ -143,11 +143,15 @@ sub rec_stdin
 }
 
 $call = uc shift @ARGV;
-$call = uc $mycall if !$call; 
+$call = uc $myalias if !$call; 
 $connsort = lc shift @ARGV;
 $connsort = 'local' if !$connsort;
 $mode = ($connsort =~ /^ax/o) ? 1 : 2;
 setmode();
+if ($call eq $mycall) {
+  print "You cannot connect as your cluster callsign ($mycall)", $nl;
+  cease(0);
+}
 
 #select STDOUT; $| = 1;
 STDOUT->autoflush(1);
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 76dea219..f9bc45ff 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -59,17 +59,13 @@ sub rec
   # set up the basic channel info - this needs a bit more thought - there is duplication here
   if (!defined $dxchan) {
      my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
-     my $user = DXUser->get($call);
-	 if (!defined $user) {
-	   $user = DXUser->new($call);
-	 }
-	 my $sort = $user->sort();
-	 
-	 # is there one already connected?
+
+     # is there one already connected?
 	 if (DXChannel->get($call)) {
 	   my $mess = DXM::msg('conother', $call);
 	   dbg('chan', "-> D $call $mess\n"); 
        $conn->send_now("D$call|$mess");
+	   sleep(1);
 	   dbg('chan', "-> Z $call bye\n");
        $conn->send_now("Z$call|bye");          # this will cause 'client' to disconnect
 	   return;
@@ -80,21 +76,20 @@ sub rec
 	   my $mess = DXM::msg('concluster', $call);
 	   dbg('chan', "-> D $call $mess\n"); 
        $conn->send_now("D$call|$mess");
+	   sleep(1);
 	   dbg('chan', "-> Z $call bye\n");
        $conn->send_now("Z$call|bye");          # this will cause 'client' to disconnect
 	   return;
      }
 
-     # set some necessary flags on the user if they are connecting
-	 $user->wwv(1) if !$user->wwv();
-	 $user->talk(1) if !$user->talk();
-	 $user->ann(1) if !$user->ann();
-	 $user->here(1) if !$user->here();
-	 $user->sort('U') if !$user->sort();
+     my $user = DXUser->get($call);
+	 if (!defined $user) {
+	   $user = DXUser->new($call);
+	 }
 
-	 # create the channel
-     $dxchan = DXCommandmode->new($call, $conn, $user) if ($sort eq 'U');
-     $dxchan = DXProt->new($call, $conn, $user) if ($sort eq 'A');
+     # create the channel
+     $dxchan = DXCommandmode->new($call, $conn, $user) if ($user->sort eq 'U');
+     $dxchan = DXProt->new($call, $conn, $user) if ($user->sort eq 'A');
 	 die "Invalid sort of user on $call = $sort" if !$dxchan;
   }
   
diff --git a/perl/create_sysop.pl b/perl/create_sysop.pl
index a08bb9ff..3b1196fe 100755
--- a/perl/create_sysop.pl
+++ b/perl/create_sysop.pl
@@ -28,6 +28,8 @@ sub create_it
   $self->{sort} = 'U';           # C - Console user, S - Spider cluster, A - AK1A, U - User, B - BBS
   $self->{priv} = 9;             # 0 - 9 - with 9 being the highest
   $self->{lastin} = 0;
+  $self->{dxok} = 1;
+  $self->{annok} = 1;
 
   # write it away
   $self->close();
@@ -44,6 +46,8 @@ sub create_it
   $self->{sort} = 'U';           # C - Console user, S - Spider cluster, A - AK1A, U - User, B - BBS
   $self->{priv} = 9;             # 0 - 9 - with 9 being the highest
   $self->{lastin} = 0;
+  $self->{dxok} = 1;
+  $self->{annok} = 1;
 
   # write it away
   $self->close();