X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=5133d9bcd12a0810ed28cd0cf916a1f525ff3e3a;hb=e06d5fa736172c044f769e791c23e7cd05ae3445;hp=4d9942dda505daefaf2a1b69815a32dbf9a2a6a1;hpb=21f2cad40da7d13aebf2c499d17bf2115d6d70f5;p=spider.git

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 4d9942dd..5133d9bc 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -34,7 +34,7 @@ use strict;
 use vars qw($me $pc11_max_age $pc23_max_age
 			$last_hour %pings %rcmds
 			%nodehops @baddx $baddxfn 
-			$allowzero $decode_dk0wcy);
+			$allowzero $decode_dk0wcy $send_opernam);
 
 $me = undef;					# the channel id for this cluster
 $pc11_max_age = 1*3600;			# the maximum age for an incoming 'real-time' pc11
@@ -96,8 +96,8 @@ sub start
 	# remember type of connection
 	$self->{consort} = $line;
 	$self->{outbound} = $sort eq 'O';
-	$self->{priv} = $user->priv;
-	$self->{lang} = $user->lang;
+	$self->{priv} = $user->priv || 1;     # other clusters can always be 'normal' users
+	$self->{lang} = $user->lang || 'en';
 	$self->{isolate} = $user->{isolate};
 	$self->{consort} = $line;	# save the connection type
 	$self->{here} = 1;
@@ -222,12 +222,13 @@ sub normal
 			}
 
 			# are any of the crucial fields invalid?
-            if ($field[2] =~ /[a-z]/ || $field[6] =~ /[a-z]/ || $field[7] =~ /[a-z]/) {
-				dbg('chan', "Spot contains lower case callsigns, rejected");
+            if ($field[2] =~ /(?:^\s*$|[a-z])/ || $field[6] =~ /(?:^\s*$|[a-z])/ || $field[7] =~ /(?:^\s*$|[a-z])/) {
+				dbg('chan', "Spot contains lower case callsigns or blanks, rejected");
 				return;
 			}
 			
 			# do some de-duping
+			$field[5] =~ s/^\s+//;      # take any leading blanks off
 			if (Spot::dup($field[1], $field[2], $d, $field[5])) {
 				dbg('chan', "Duplicate Spot ignored\n");
 				return;
@@ -242,6 +243,49 @@ sub normal
 			# you should be able to route on any of these
             #
 			
+			# fix up qra locators of known users 
+			my $user = DXUser->get_current($spot[4]);
+			if ($user) {
+				my $qra = $user->qra;
+				unless ($qra && DXBearing::is_qra($qra)) {
+					my $lat = $user->lat;
+					my $long = $user->long;
+					if (defined $lat && defined $long) {
+						$user->qra(DXBearing::lltoqra($lat, $long)); 
+						$user->put;
+					}
+				}
+
+				# send a remote command to a distant cluster if it is visible and there is no
+				# qra locator and we havn't done it for a month.
+
+				unless ($user->qra) {
+					my $node;
+					my $to = $user->homenode;
+					my $last = $user->lastoper || 0;
+					if ($send_opernam && $main::systime > $last + $DXUser::lastoperinterval && $to && ($node = DXCluster->get_exact($to)) ) {
+						my $cmd = "forward/opernam $spot[4]";
+						# send the rcmd but we aren't interested in the replies...
+						if ($node && $node->dxchan && $node->dxchan->is_clx) {
+							route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd));
+						} else {
+							route(undef, $to, pc34($main::mycall, $to, $cmd));
+						}
+						if ($to ne $field[7]) {
+							$to = $field[7];
+							$node = DXCluster->get_exact($to);
+							if ($node && $node->dxchan && $node->dxchan->is_clx) {
+								route(undef, $to, pc84($main::mycall, $to, $main::mycall, $cmd));
+							} else {
+								route(undef, $to, pc34($main::mycall, $to, $cmd));
+							}
+						}
+						$user->lastoper($main::systime);
+						$user->put;
+					}
+				}
+			}
+				
 			# local processing 
 			my $r;
 			eval {
@@ -260,6 +304,7 @@ sub normal
 		
 		if ($pcno == 12) {		# announces
 			# announce duplicate checking
+			$field[3] =~ s/^\s+//;  # remove leading blanks
 			if (AnnTalk::dup($field[1], $field[2], $field[3])) {
 				dbg('chan', "Duplicate Announce ignored\n");
 				return;
@@ -652,9 +697,13 @@ sub normal
 				my ($lat, $long) = DXBearing::stoll($field[3]);
 				$user->lat($lat);
 				$user->long($long);
+				my $qra = $user->qra || DXBearing::lltoqra($lat, $long);
+				$qra = DXBearing::lltoqra($lat, $long) unless $qra && DXBearing::is_qra($qra);
+				$user->qra($qra) if $qra ne $user->qra;
 			} elsif ($field[2] == 4) {
 				$user->homenode($field[3]);
 			}
+			$user->lastoper($main::systime);   # to cut down on excessive for/opers being generated
 			$user->put;
 			last SWITCH;
 		}
@@ -752,7 +801,7 @@ sub normal
 				my $ref = DXUser->get_current($field[2]);
 				my $cref = DXCluster->get($field[2]);
 				Log('rcmd', 'in', $ref->{priv}, $field[2], $field[4]);
-				unless ($field[3] =~ /rcmd/i || !$cref || !$ref || $cref->mynode->call ne $ref->homenode) {    # not allowed to relay RCMDS!
+				unless ($field[4] =~ /rcmd/i || !$cref || !$ref || $cref->mynode->call ne $ref->homenode) {    # not allowed to relay RCMDS!
 					if ($ref->{priv}) {	# you have to have SOME privilege, the commands have further filtering
 						$self->{remotecmd} = 1; # for the benefit of any command that needs to know
 						my $oldpriv = $self->{priv};
@@ -776,7 +825,7 @@ sub normal
 				if ($ref && $ref->is_clx) {
 					$self->route($field[1], $line);
 				} else {
-					route($field[1], pc34($field[2], $field[1], $field[3]));
+					route($field[1], pc34($field[2], $field[1], $field[4]));
 				}
 			}
 			return;
@@ -800,7 +849,7 @@ sub normal
 				if ($ref && $ref->is_clx) {
 					$self->route($field[1], $line);
 				} else {
-					route($field[1], pc35($field[2], $field[1], $field[3]));
+					route($field[1], pc35($field[2], $field[1], $field[4]));
 				}
 			}
 			return;
@@ -939,7 +988,7 @@ sub send_dx_spot
 				$dxchan->send($routeit) unless $dxchan->{isolate} || $self->{isolate};
 			}
 		} elsif ($dxchan->is_user && $dxchan->{dx}) {
-			my $buf = Spot::formatb($_[0], $_[1], $_[2], $_[3], $_[4]);
+			my $buf = Spot::formatb($dxchan->{user}->wantgrid, $_[0], $_[1], $_[2], $_[3], $_[4]);
 			$buf .= "\a\a" if $dxchan->{beep};
 			if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') {
 				$dxchan->send($buf);