From: djk <djk>
Date: Sun, 13 Dec 1998 00:47:32 +0000 (+0000)
Subject: 1. Incorporated sh/st, (un)set/lockout, forward/opername from Iain G0RDI
X-Git-Tag: R_1_10^0
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=337f38bfac57a5e5df34c63094fb869b0e2f6bee;p=spider.git

1. Incorporated sh/st, (un)set/lockout, forward/opername from Iain G0RDI
2. Added group handling with (un)set/group, show/group. This allows arbitrary
groups to be formed (for ann/<group> for example) and is also used to 'filter'
spots, announces, wwvs etc into groups of cluster nodes (useful for creating
disjoint cluster networks)
3. **** CHANGE mylongtitude to mylongitude in DXVars.pm ****
4. Altered QRA locator routines so they work correctly!
5. Fixed all commands that had the wrong mylat(itude) and mylong(itude) names
in.
---

diff --git a/Changes b/Changes
index 8b155a08..19c7570f 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,13 @@
+12Dec98========================================================================
+1. Incorporated sh/st, (un)set/lockout, forward/opername from Iain G0RDI
+2. Added group handling with (un)set/group, show/group. This allows arbitrary
+groups to be formed (for ann/<group> for example) and is also used to 'filter' 
+spots, announces, wwvs etc into groups of cluster nodes (useful for creating 
+disjoint cluster networks)
+3. **** CHANGE mylongtitude to mylongitude in DXVars.pm ****
+4. Altered QRA locator routines so they work correctly!
+5. Fixed all commands that had the wrong mylat(itude) and mylong(itude) names
+in.
 07Dec98========================================================================
 1. Added set/name, set/qra, set/location, set/qth, set/homenode, set/bbs, 
 set/email
diff --git a/cmd/forward/opername.pl b/cmd/forward/opername.pl
new file mode 100644
index 00000000..c8db6567
--- /dev/null
+++ b/cmd/forward/opername.pl
@@ -0,0 +1,33 @@
+#
+# Cause node to send PC41 info frames
+#
+# Copyright (c) 1998 - Iain Philipps G0RDI
+#
+# Mods by Dirk Koopman G1TLH 12Dec98
+#
+
+my ($self, $line) = @_;
+my @f = split /\s+/, uc $line;
+my @out;
+my $call;
+
+if (@f == 0) {
+	return (1, $self->('e6')) if ($self->priv < 5); 
+} else {
+	foreach $call (@f) {
+		my $ref = DXUser->get_current($call);
+		if ($ref) {
+			my $name = $ref->name;  
+			my $qth = $ref->qth;
+			my $lat = $ref->lat;
+			my $long = $ref->long;
+			my $node = $ref->homenode;
+			my $latlong = DXBearing::lltos($lat, $long) if $lat && $long;
+			DXProt::broadcast_ak1a(DXProt::pc41($call, 1, $name), $DXProt::me) if $name;
+			DXProt::broadcast_ak1a(DXProt::pc41($call, 2, $qth), $DXProt::me) if $qth;
+			DXProt::broadcast_ak1a(DXProt::pc41($call, 3, $latlong), $DXProt::me) if $latlong;
+			DXProt::broadcast_ak1a(DXProt::pc41($call, 4, $node), $DXProt::me) if $node;
+		}
+	}
+}
+return (1, @out);
diff --git a/cmd/reply.pl b/cmd/reply.pl
index ce9d6916..c5ceaddf 100644
--- a/cmd/reply.pl
+++ b/cmd/reply.pl
@@ -23,60 +23,64 @@ my $loc;
 #$DB::single = 1;
 
 if ($self->state eq "prompt") {
-
-  my @f = split /\s+/, $line;
-  
-  # now deal with real message inputs 
-  # parse out send line for various possibilities
-  $loc = $self->{loc} = {};
-  
-  my $i = 0;
-  $f[0] = uc $f[0];
-  $loc->{private} = '1';
-  if ($f[0] eq 'B' || $f[0] =~ /^NOP/oi) {
-    $loc->{private} = '0';
-	$i += 1;
-  } elsif ($f[0] eq 'P' || $f[0] =~ /^PRI/oi) {
-    $i += 1;
-  }
-  
-  $loc->{rrreq} = '0';
-  if (uc $f[$i] eq 'RR') {
-    $loc->{rrreq} = '1';
-	$i++;
-  }
-  
-  my $oref; 
-  
-  # check we have a reply number
-  if ($i  >  @f) {
-    if (!($oref = DXMsg::get($self->lastread))) {
-      delete $self->{loc};
-      #return (0, $self->msg('esend2'));
-      return (0, "need a message number");
+	
+	my @f = split /\s+/, $line if $line;
+	
+	# now deal with real message inputs 
+	# parse out send line for various possibilities
+	$loc = $self->{loc} = {};
+	
+	my $i = 0;
+	$loc->{private} = '1';
+	if ($i < @f) {
+		if ($f[0] =~ /^(B|NOP)/oi) {
+			$loc->{private} = '0';
+			$i += 1;
+		} elsif ($f[0] =~ /^P/oi) {
+			$i += 1;
+		}
 	}
-  } else {
-    $oref = DXMsg::get($f[$i]);
-	if (!$oref) {
-	  delete $self->{loc};
-	  return (0, "can't access message $i");
+	
+	if ($i < @f) {
+		$loc->{rrreq} = '0';
+		if (uc $f[$i] eq 'RR') {
+			$loc->{rrreq} = '1';
+			$i++;
+		}
 	}
-  }
-  
-  # now save all the 'to' callsigns for later
-  my $to = $oref->from;
-  $loc->{to} = [ $to ];       # to is an array
-  $loc->{subject} = $oref->subject;
-  $loc->{subject} = "Re: " . $loc->{subject} if !($loc->{subject} =~ /^Re:.\s/io); 
-
-  # find me and set the state and the function on my state variable to
-  # keep calling me for every line until I relinquish control
-  $self->func("DXMsg::do_send_stuff");
-  $self->state('sendbody');
-  #push @out, $self->msg('sendsubj');
-  push @out, "Reply to: $to";
-  push @out, "Subject : $loc->{subject}";
-  push @out, "Enter Message /EX (^Z) to send or /ABORT (^Y) to exit";
+	my $oref; 
+	
+	# check we have a reply number
+	#  $DB::single = 1;
+	
+	if ($i < @f) {
+		$oref = DXMsg::get($f[$i]);
+		if (!$oref) {
+			delete $self->{loc};
+			return (0, "can't access message $i");
+		}
+	} else {
+		if (!($oref = DXMsg::get($self->lastread))) {
+			delete $self->{loc};
+			#return (0, $self->msg('esend2'));
+			return (0, "need a message number");
+		}
+	}
+	
+	# now save all the 'to' callsigns for later
+	my $to = $oref->from;
+	$loc->{to} = [ $to ];       # to is an array
+	$loc->{subject} = $oref->subject;
+	$loc->{subject} = "Re: " . $loc->{subject} if !($loc->{subject} =~ /^Re:\s/io); 
+	
+	# find me and set the state and the function on my state variable to
+	# keep calling me for every line until I relinquish control
+	$self->func("DXMsg::do_send_stuff");
+	$self->state('sendbody');
+	#push @out, $self->msg('sendsubj');
+	push @out, "Reply to: $to";
+	push @out, "Subject : $loc->{subject}";
+	push @out, "Enter Message /EX (^Z) to send or /ABORT (^Y) to exit";
 }
 
 return (1, @out);
diff --git a/cmd/set/lockout.pl b/cmd/set/lockout.pl
new file mode 100644
index 00000000..a1e83c32
--- /dev/null
+++ b/cmd/set/lockout.pl
@@ -0,0 +1,28 @@
+#
+# lock a user out
+#
+# Copyright (c) 1998 Iain Phillips G0RDI
+#
+# $Id$
+#
+my ($self, $line) = @_;
+my @args = split /\s+/, $line;
+my $call;
+# my $priv = shift @args;
+my @out;
+my $user;
+my $ref;
+
+return (1, $self->msg('e5')) if $self->priv < 9;
+
+foreach $call (@args) {
+	$call = uc $call;
+	if ($ref = DXUser->get_current($call)) {
+		$ref->lockout(1);
+		$ref->put();
+		push @out, $self->msg("lockout", $call);
+	} else {
+		push @out, $self->msg('e3', 'set/lockout', $call);
+	}
+}
+return (1, @out);
diff --git a/cmd/show/heading.pl b/cmd/show/heading.pl
index b7dd05c9..aa7bb2f8 100644
--- a/cmd/show/heading.pl
+++ b/cmd/show/heading.pl
@@ -13,8 +13,8 @@ my $lat = $self->user->lat;
 my $long = $self->user->long;
 if (!$long && !$lat) {
 	push @out, $self->msg('heade1');
-	$lat = $main::mylat;
-	$long = $main::mylong;
+	$lat = $main::mylatitude;
+	$long = $main::mylongitude;
 }
 
 foreach $l (@list) {
diff --git a/cmd/show/qra.pl b/cmd/show/qra.pl
index 8e91cf5f..fe3f08ab 100644
--- a/cmd/show/qra.pl
+++ b/cmd/show/qra.pl
@@ -1,5 +1,7 @@
 #
-# show the distance and bearing each QRA locator
+# show the distance and bearing to a  QRA locator
+#
+# you can enter two qra locators and it will calc the distance between them
 #
 # $Id$
 #
@@ -13,21 +15,37 @@ my $lat = $self->user->lat;
 my $long = $self->user->long;
 if (!$long && !$lat) {
 	push @out, $self->msg('heade1');
-	$lat = $main::mylat;
-	$long = $main::mylong;
+	$lat = $main::mylatitude;
+	$long = $main::mylongitude;
 }
 
-foreach $l (@list) {
-	# locators --->
-	if (DXBearing::is_qra($l) || $l =~ /^[A-Za-z][A-Za-z]\d\d$/) {
-		my $qra = uc $l;
-		$qra .= 'MM' if $l =~ /^[A-Za-z][A-Za-z]\d\d$/;
-		
-		my ($qlat, $qlong) = DXBearing::qratoll($qra);
-		my ($b, $dx) = DXBearing::bdist($lat, $long, $qlat, $qlong);
-		my ($r, $rdx) = DXBearing::bdist($qlat, $qlong, $lat, $long);
-		push @out, sprintf "%-9s Bearing: %.0f Recip: %.0f %.0fKm %.0fMi", $qra, $b, $r, $dx, $dx * 0.62133785;
-	}
+return (1, $self->msg('qrashe1')) unless @list > 0;
+return (1, $self->msg('qrae2')) unless (DXBearing::is_qra($list[0]) || $list[0] =~ /^[A-Za-z][A-Za-z]\d\d$/);
+
+#print "$lat $long\n";
+
+my $l = uc $list[0];
+my $f;
+
+if (@list > 1) {
+	$f = $l;
+	$f .= 'MM' if $f =~ /^[A-Z][A-Z]\d\d$/;
+	($lat, $long) = DXBearing::qratoll($f);
+    #print "$lat $long\n";
+	
+	return (1, $self->msg('qrae2')) unless (DXBearing::is_qra($list[1]) || $list[1] =~ /^[A-Za-z][A-Za-z]\d\d$/);
+	$l = uc $list[1];
 }
 
+$l .= 'MM' if $l =~ /^[A-Z][A-Z]\d\d$/;
+		
+my ($qlat, $qlong) = DXBearing::qratoll($l);
+#print "$qlat $qlong\n";
+my ($b, $dx) = DXBearing::bdist($lat, $long, $qlat, $qlong);
+my ($r, $rdx) = DXBearing::bdist($qlat, $qlong, $lat, $long);
+my $to = " -> $list[1]" if $f;
+my $from = $list[0];
+
+push @out, sprintf "$list[0]$to Bearing: %.0f Deg. Recip: %.0f Deg. %.0fMi. %.0fKm.", $b, $r, $dx * 0.62133785, $dx;
+
 return (1, @out);
diff --git a/cmd/show/station.pl b/cmd/show/station.pl
index 0f214033..d3a70865 100644
--- a/cmd/show/station.pl
+++ b/cmd/show/station.pl
@@ -3,40 +3,73 @@
 #
 # Copyright (c) 1998 - Dirk Koopman G1TLH
 #
-# $Id$
+# Modifications by Iain Philipps G0RDI, 07-Dec-1998
 #
 
 my ($self, $line) = @_;
 my @f = split /\s+/, uc $line;
 my @out;
 my $call;
+my $seek;
 
 if (@f == 0) {
-  return (1, "*** no station specified ***") if ($self->priv < 5); 
-  my @calls = DXUser::get_all_calls();
-  foreach $call (@calls) {
-    my $ref = DXUser->get_current($call);
-	next if !$ref;
-	my $sort = $ref->sort;
-	my $qth = $ref->qth;
-	my $home = $ref->node;
-    push @out, "$call $sort $qth $home";
-  }
+	return (1, $self->msg('e6')) if ($self->priv < 5); 
+	my @calls = DXUser::get_all_calls();
+	foreach $call (@calls) {
+		my $ref = DXUser->get_current($call);
+		next if !$ref;
+		my $lat = $ref->lat;
+		my $long = $ref->long;
+		my $latlong = DXBearing::lltos($lat, $long) if $lat && $long;
+		push @out, sprintf "%-9s %s %-12.12s %-27.27s %-9s %s %s", $call, $ref->sort, $ref->name, $ref->qth, $ref->homenode, $latlong, $ref->qra;
+	}
 } else {
-  foreach $call (@f) {
-    my $ref = DXUser->get_current($call);
-	if ($ref) {
-	  my $name = $ref->name;  
-      my $qth = $ref->qth;
-	  my $lat = $ref->lat;
-	  my $long = $ref->long;
-	  my $node = $ref->node;
-#	  my $homenode = $ref->homenode;
-	  push @out, "$call $qth $lat $long $node";
-	} else {
-	  push @out, "$call not known";
+	foreach $call (@f) {
+		my $ref = DXUser->get_current($call);
+		if ($ref) {
+			my $name = $ref->name;  
+			my $qth = $ref->qth;
+			my $lat = $ref->lat;
+			my $long = $ref->long;
+			my $node = $ref->node;
+			my $homenode = $ref->homenode;
+			my $lastin = $ref->lastin;
+			my $latlong = DXBearing::lltos($lat, $long) if $lat || $long;
+			my $last = DXUtil::cldatetime($lastin) if $ref->lastin;
+			my $qra = $ref->qra;
+			$qra = DXBearing::lltoqra($lat, $long) if !$qra && ($lat || $long);
+			my $from;
+			my ($dx, $bearing, $miles);
+			if ($latlong) {
+				my ($hlat, $hlong) = ($self->user->lat, $self->user->long);
+				($hlat, $hlong) = DXBearing::qratoll($self->user->qra) if $self->user->qra && !$hlat && !$hlong;
+				if (!$hlat && !$hlong) {
+					$from = "From $main::mycall";
+					$hlat = $main::mylatitude;
+					$hlong = $main::mylongitude;
+				}
+				($bearing, $dx) = DXBearing::bdist($hlat, $hlong, $lat, $long);
+				$miles = $dx * 0.62133785;
+			}
+			
+			my $cref = DXCluster->get($call);
+			my $seek = $cref->mynode->call if $cref;
+
+			if ($seek) {
+				push @out, "User         :   $call (at $seek)";
+			} else {
+				push @out, "User         :   $call";
+			}
+			push @out, "Name         :   $name" if $name;
+			push @out, "Last Connect :   $last" if $last;
+			push @out, "QTH          :   $qth" if $qth;
+			push @out, "Location     :   $latlong ($qra)" if $latlong || $qra ;
+			push @out, sprintf("Heading      :   %.0f Deg %.0f Mi. %.0f Km. $from", $bearing, $miles, $dx) if $latlong;
+			push @out, "Home Node    :   $homenode" if $homenode;
+		} else {
+			push @out, $self->msg('usernf', $call);
+		}
 	}
-  }
 }
 
 return (1, @out);
diff --git a/cmd/unset/lockout.pl b/cmd/unset/lockout.pl
new file mode 100644
index 00000000..71641c6e
--- /dev/null
+++ b/cmd/unset/lockout.pl
@@ -0,0 +1,28 @@
+#
+# unlock a locked out user 
+#
+# Copyright (c) 1998 Iain Phillips G0RDI
+#
+# $Id$
+#
+my ($self, $line) = @_;
+my @args = split /\s+/, $line;
+my $call;
+# my $priv = shift @args;
+my @out;
+my $user;
+my $ref;
+
+return (1, $self->msg('e5')) if $self->priv < 9;
+
+foreach $call (@args) {
+	$call = uc $call;
+	if ($ref = DXUser->get_current($call)) {
+		$ref->lockout(0);
+		$ref->put();
+		push @out, $self->msg("lockoutun", $call);
+	} else {
+		push @out, $self->msg('e3', 'unset/lockout', $call);
+	}
+}
+return (1, @out);
diff --git a/perl/DXBearing.pm b/perl/DXBearing.pm
index 4c8c3eea..a2eaeba5 100644
--- a/perl/DXBearing.pm
+++ b/perl/DXBearing.pm
@@ -14,60 +14,54 @@
 package DXBearing;
 
 use POSIX;
+use DXUtil;
 
 use strict;
 use vars qw($pi);
 
 $pi = 3.14159265358979;
 
-# half a qra to lat long translation
-sub _half_qratoll
-{
-	my ($l, $n, $m) = @_;
-	my $lat = ord($l) - ord('A');
-	$lat = $lat * 10 + (ord($n) - ord('0'));
-	$lat = $lat * 24 + (ord($m) - ord('A'));
-	$lat -= (2160 + 0.5);
-	$lat = $lat * ($pi/4320);
-	
-} 
 # convert a qra locator into lat/long in DEGREES
 sub qratoll
 {
 	my $qra = uc shift;
-	my $long = _half_qratoll((unpack 'AAAAAA', $qra)[0,2,4]) * 2;
-	my $lat = _half_qratoll((unpack 'AAAAAA', $qra)[1,3,5]);
-	return (rd($lat), rd($long));
-}
-
-sub _part_lltoqra
-{
-	my ($t, $f, $n, $e) = @_;
-	$n = $f * ($n - int($n));
-	$e = $f * ($e - int($e));
-	my $q = chr($t+$e) . chr($t+$n);
-	return ($q, $n, $e);
+	my ($p1, $p2, $p3, $p4, $p5, $p6) = unpack 'AAAAAA', $qra;
+	($p1, $p2, $p3, $p4, $p5, $p6) = (ord($p1)-ord('A'), ord($p2)-ord('A'), ord($p3)-ord('0'), ord($p4)-ord('0'), ord($p5)-ord('A'), ord($p6)-ord('A') );
+	
+	my $long = ($p1*20) + ($p3*2) + (($p5+0.5)/12) - 180;
+    my $lat = ($p2*10) + $p4 + (($p6+0.5)/24) - 90;
+	return ($lat, $long);
 }
 
 # convert a lat, long in DEGREES to a qra locator 
 sub lltoqra
 {
-	my $lat = dr(shift);
-	my $long = dr(shift);
-	my $t = 1/6.283185;
+	my $lat = shift;
+	my $long = shift;
 
-	$long = $long * $t +.5 ;
-	$lat = $lat * $t * 2 + .5 ;
+	my $v;
+	my ($p1, $p2, $p3, $p4, $p5, $p6);
+	
+	$lat += 90;
+	$long += 180;
+	$v = int($long / 20); 
+	$long -= ($v * 20);
+	$p1 = chr(ord('A') + $v);
+	$v = int($lat / 10);			   
+	$lat -= ($v * 10);
+	$p2 = chr(ord('A') + $v);
+	$p3 = int($long/2);
+	$p4 = int($lat);
+	$long -= $p3*2;
+	$lat -= $p4;
+	$p3 = chr(ord('0')+$p3);
+	$p4 = chr(ord('0')+$p4);
+	$p5 = int((12 * $long) );
+	$p6 = int((24 * $lat) );
+	$p5 = chr(ord('A')+$p5);
+	$p6 = chr(ord('A')+$p6);
 
-	my $q;
-	my $qq;
-	($q, $lat, $long) = _part_lltoqra(ord('A'), 18, $lat, $long);
-	$qq = $q;
-	($q, $lat, $long) = _part_lltoqra(ord('0'), 10, $lat, $long);
-	$qq .= $q;
-	($q, $lat, $long) = _part_lltoqra(ord('A'), 24, $lat, $long);
-	$qq .= $q;
-	return $qq;
+	return "$p1$p2$p3$p4$p5$p6";
 }
 
 # radians to degrees
@@ -100,6 +94,7 @@ sub bdist
 	my $he = dr(shift);
 	my $n = dr(shift);
 	my $e = dr(shift);
+	return (0, 0) if $hn == $n && $he == $e;
 	my $co = cos($he-$e)*cos($hn)*cos($n)+sin($hn)*sin($n);
 	my $ca = atan(abs(sqrt(1-$co*$co)/$co));
 	$ca = $pi-$ca if $co < 0;
@@ -129,19 +124,8 @@ sub stoll
 sub lltos
 {
 	my ($lat, $long) = @_;
-	my ($latd, $latm, $longd, $longm);
-	my $latl = $lat > 0 ? 'N' : 'S';
-	my $longl = $long > 0 ? 'E' : 'W';
-	
-	$lat = abs $lat;
-	$latd = int $lat;
-	$lat -= $latd;
-	$latm = int (60 * $lat);
-	
-	$long = abs $long;
-	$longd = int $long;
-	$long -= $longd;
-	$longm = int (60 * $long);
-	return "$latd $latm $latl $longd $longm $longl";
+	my $slat = slat($lat);
+	my $slong = slong($long);
+	return "$slat $slong";
 }
 1;
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 692bf98b..640bc4e5 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -66,6 +66,7 @@ use vars qw(%channels %valid);
   remotecmd => '9,doing rcmd,yesno',
   pagelth => '0,Page Length',
   pagedata => '9,Page Data Store',
+  group => '0,Access Group,parray',               # used to create a group of users/nodes for some purpose or other
 );
 
 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
@@ -83,6 +84,8 @@ sub alloc
   $self->{oldstate} = 0;
   $self->{lang} = $user->{lang} if defined $user;
   $self->{lang} = $main::lang if !$self->{lang};
+  $user->new_group() if !$user->group;
+  $self->{group} = $user->group;
   bless $self, $pkg; 
   return $channels{$call} = $self;
 }
@@ -117,6 +120,7 @@ sub get_by_cnum
 sub del
 {
   my $self = shift;
+  $self->{group} = undef;      # belt and braces
   delete $channels{$self->{call}};
 }
 
diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm
index 09001b20..0eb98a4b 100644
--- a/perl/DXCluster.pm
+++ b/perl/DXCluster.pm
@@ -224,6 +224,7 @@ sub new
   my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
   $self->{pcversion} = $pcversion;
   $self->{list} = { } ;
+  $self->{mynode} = $self;   # for sh/station
   $nodes++;
   dbg('cluster', "allocating node $call to cluster\n");
   return $self;
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index a6e5e2f7..91d268b0 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -86,7 +86,7 @@ sub start
 	$self->send($self->msg('qthe1')) if !$user->qth;
 	$self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long);
 	$self->send($self->msg('hnodee1')) if !$user->qth;
-	
+
 	
 	$self->send($self->msg('pr', $call));
 }
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 35aae2e5..4fce8298 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -80,6 +80,7 @@ sub start
 	}
 	$self->state('init');
 	$self->pc50_t(time);
+
 	Log('DXProt', "$call connected");
 }
 
@@ -219,6 +220,7 @@ sub normal
 				my $user = DXUser->get_current($call);
 				$user = DXUser->new($call) if !$user;
 				$user->node($node->call);
+				$user->lastin($main::systime);
 				$user->homenode($node->call) if !$user->homenode;
 				$user->put;
 			}
@@ -269,6 +271,7 @@ sub normal
 					$user->sort('A');
 					$user->node($call);
 					$user->homenode($call);
+					$user->lastin($main::systime);
 					$user->put;
 				}
 			}
@@ -528,6 +531,7 @@ sub finish
 	
 	# now broadcast to all other ak1a nodes that I have gone
 	broadcast_ak1a(pc21($call, 'Gone.'), $self);
+	
 	Log('DXProt', $call . " Disconnected");
 	$ref->del() if $ref;
 }
diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index 0af77f04..65948d59 100644
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -47,6 +47,7 @@ $filename = undef;
   reg => '0,Registered?,yesno',            # is this user registered?
   lang => '0,Language',
   hmsgno => '0,Highest Msgno',
+  group => '0,Access Group,parray',               # used to create a group of users/nodes for some purpose or other
 );
 
 no strict;
@@ -195,6 +196,67 @@ sub fields
   return keys(%valid);
 }
 
+#
+# group handling
+#
+
+# add one or more groups
+sub add_group
+{
+	my $self = shift;
+	my $ref = $self->{group} || [ 'local' ];
+	$self->{group} = $ref if !$self->{group};
+	push @$ref, @_ if @_;
+}
+
+# remove one or more groups
+sub del_group
+{
+	my $self = shift;
+	my $ref = $self->{group} || [ 'local' ];
+	my @in = @_;
+	
+	$self->{group} = $ref if !$self->{group};
+	
+	@$ref = map { my $a = $_; return (grep { $_ eq $a } @in) ? () : $a } @$ref;
+}
+
+# does this thing contain all the groups listed?
+sub union
+{
+	my $self = shift;
+	my $ref = $self->{group};
+	my $n;
+	
+	return 0 if !$ref || @_ == 0;
+	return 1 if @$ref == 0 && @_ == 0;
+	for ($n = 0; $n < @_; ) {
+		for (@$ref) {
+			my $a = $_;
+			$n++ if grep $_ eq $a, @_; 
+		}
+	}
+	return $n >= @_;
+}
+
+# simplified group test just for one group
+sub in_group
+{
+	my $self = shift;
+	my $s = shift;
+	my $ref = $self->{group};
+	
+	return 0 if !$ref;
+	return grep $_ eq $s, $ref;
+}
+
+# set up a default group (only happens for them's that connect direct)
+sub new_group
+{
+	my $self = shift;
+	$self->{group} = [ 'local' ];
+}
+
 #
 # return a prompt for a field
 #
@@ -205,40 +267,6 @@ sub field_prompt
   return $valid{$ele};
 }
 
-#
-# enter an element from input, returns 1 for success
-#
-
-sub enter
-{
-  my ($self, $ele, $value) = @_;
-  return 0 if (!defined $valid{$ele});
-  chomp $value;
-  return 0 if $value eq "";
-  if ($ele eq 'long') {
-    my ($longd, $longm, $longl) = $value =~ /(\d+) (\d+) ([EWew])/;
-	return 0 if (!$longl || $longd < 0 || $longd > 180 || $longm < 0 || $longm > 59);
-	$longd += ($longm/60);
-	$longd = 0-$longd if (uc $longl) eq 'W'; 
-	$self->{'long'} = $longd;
-	return 1;
-  } elsif ($ele eq 'lat') {
-    my ($latd, $latm, $latl) = $value =~ /(\d+) (\d+) ([NSns])/;
-	return 0 if (!$latl || $latd < 0 || $latd > 90 || $latm < 0 || $latm > 59);
-	$latd += ($latm/60);
-	$latd = 0-$latd if (uc $latl) eq 'S';
-	$self->{'lat'} = $latd;
-	return 1;
-  } elsif ($ele eq 'qra') {
-    $self->{'qra'} = UC $value;
-	return 1;
-  } else {
-    $self->{$ele} = $value;               # default action
-	return 1;
-  }
-  return 0;
-}
-
 # some variable accessors
 sub sort
 {
diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 667194af..9f63c890 100644
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -77,7 +77,7 @@ sub slat
   $let = $n >= 0 ? 'N' : 'S';
   $n = abs $n;
   $deg = int $n;
-  $min = int (($n - $deg) * 60);
+  $min = int ((($n - $deg) * 60) + 0.5);
   return "$deg $min $let";
 }
 
@@ -89,7 +89,7 @@ sub slong
   $let = $n >= 0 ? 'E' : 'W';
   $n = abs $n;
   $deg = int $n;
-  $min = int (($n - $deg) * 60);
+  $min = int ((($n - $deg) * 60) + 0.5);
   return "$deg $min $let";
 }
 
@@ -118,7 +118,8 @@ sub promptf
 # take an arg as an array list and print it
 sub parray
 {
-  return join(', ', @{shift});
+	my $ref = shift;
+	return join(', ', @{$ref});
 }
 
 # take the arg as an array reference and print as a list of pairs
diff --git a/perl/DXVars.pm b/perl/DXVars.pm
index b35689bc..91f43707 100644
--- a/perl/DXVars.pm
+++ b/perl/DXVars.pm
@@ -35,7 +35,7 @@ $myalias = "G1TLH";
 $mylatitude = +52.68584579;
 
 # Your Longtitude (+)ve = East, (-)ve = West in degrees and decimal degrees
-$mylongtitude = +0.94518260;
+$mylongitude = +0.94518260;
 
 # Your locator (yes I know I can calculate it - eventually)
 $mylocator = "JO02LQ";
diff --git a/perl/Messages b/perl/Messages
index 1dee13e3..16ad509e 100644
--- a/perl/Messages
+++ b/perl/Messages
@@ -34,7 +34,7 @@ package DXM;
 				e3 => '$_[0]: $_[1] not found',
 				e4 => 'Need at least a prefix or callsign',
 				e5 => 'Not Allowed',
-				e6 => 'Need a callsign',
+				e6 => '*** No station specified ***',
 				e7 => 'callsign $_[0] not visible on the cluster',
 				e8 => 'Need a callsign and some text',
 				e9 => 'Need at least some text',
@@ -56,6 +56,8 @@ package DXM;
 				loce1 => 'Please enter your location,, set/location <latitude longitude>',
 				loce2 => 'Don\'t recognise \"$_[0]\" as a Lat/Long (eg 52 20 N 0 16 E)',
 				loc => 'Your Lat/Long is now \"$_[0]\"',
+				lockout => '$_[0] Locked out',
+				lockoutun => '$_[0] Unlocked',
 				m2 => '$_[0] Information: $_[1]',
 				namee1 => 'Please enter your name, set/name <your name>',
 				namee2 => 'Can\'t find user $_[0]!',
@@ -74,7 +76,8 @@ package DXM;
 				qll => 'Please enter your location with set/location or set/qra',
 				qthe1 => 'Please enter your QTH, set/qth <your qth>',
 				qth => 'Your QTH is now \"$_[0]\"',
-				qrae1 => 'Please enter your QRA locator, set/qra <qra locator>',
+				qrae1 => 'Please enter your QRA locator, set/qra <qra locator> (eg set/qra JO02LQ)',
+				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]\"',
 				rcmdo => 'RCMD \"$_[0]\" sent to $_[1]',
@@ -84,6 +87,7 @@ package DXM;
 				shutting => '$main::mycall shutting down...',
 				talks => 'Talk flag set on $_[0]',
 				talku => 'Talk flag unset on $_[0]',
+				usernf => '*** User record for $_[0] not found ***',
 				wwvs => 'WWV flag set on $_[0]',
 				wwvu => 'WWV flag unset on $_[0]',
 		},
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 1eb82078..e343cc0b 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -48,7 +48,7 @@ package main;
 
 @inqueue = ();					# the main input queue, an array of hashes
 $systime = 0;					# the time now (in seconds)
-$version = 1.9;					# the version no of the software
+$version = "1.10";				# the version no of the software
 $starttime = 0;                 # the starting time of the cluster   
  
 # handle disconnections
@@ -108,7 +108,13 @@ sub rec
 			$user->{lang} = $main::lang if !$user->{lang}; # to autoupdate old systems
 		}
 		
-		
+		# is he locked out ?
+		if ($user->lockout) {
+			Log('DXCommand', "$call is locked out, disconnected");
+			$conn->send_now("Z$call|bye"); # this will cause 'client' to disconnect
+			return;
+		}
+
 		# 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');