X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=9888380adcad3fe9d1e8fb7a86dd4019e90327df;hb=6975c4b4c8b210af067efab767bc1656786f70f2;hp=25d862cfa52910b8d9b8922fa5e6331c73b1cf45;hpb=4f2384c7d1e6ea06fc2d258a02b54409bf324f12;p=spider.git

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 25d862cf..9888380a 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -24,6 +24,8 @@ use DXProtout;
 use DXDebug;
 use Filter;
 use Local;
+use DXDb;
+use Time::HiRes qw(gettimeofday tv_interval);
 
 use Carp;
 
@@ -37,10 +39,10 @@ $me = undef;					# the channel id for this cluster
 $decode_dk0wcy = undef;			# if set use this callsign to decode announces from the EU WWV data beacon
 $pc11_max_age = 1*3600;			# the maximum age for an incoming 'real-time' pc11
 $pc23_max_age = 1*3600;			# the maximum age for an incoming 'real-time' pc23
-$pc11_dup_age = 24*3600;		# the maximum time to keep the spot dup list for
-$pc23_dup_age = 24*3600;		# the maximum time to keep the wwv dup list for
-$pc12_dup_age = 12*3600;		# the maximum time to keep the ann dup list for
-$pc12_dup_lth = 72;				# the length of ANN text to save for deduping 
+$pc11_dup_age = 3*3600;			# the maximum time to keep the spot dup list for
+$pc23_dup_age = 3*3600;			# the maximum time to keep the wwv dup list for
+$pc12_dup_age = 24*3600;		# the maximum time to keep the ann dup list for
+$pc12_dup_lth = 60;				# the length of ANN text to save for deduping 
 %spotdup = ();				    # the pc11 and 26 dup hash 
 %wwvdup = ();				    # the pc23 and 27 dup hash
 %anndup = ();                               # the PC12 dup hash
@@ -50,6 +52,7 @@ $last_hour = time;				# last time I did an hourly periodic update
 %nodehops = ();                 # node specific hop control
 @baddx = ();                    # list of illegal spotted callsigns
 
+
 $baddxfn = "$main::data/baddx.pl";
 
 sub init
@@ -130,6 +133,11 @@ sub start
 	}
 	$self->state('init');
 	$self->pc50_t(time);
+	$self->pingint($user->pingint || 3*60);
+	$self->nopings(3);
+	$self->lastping($main::systime);
+	$self->pingtime(0);
+	$self->pingrec(0);
 
 	Log('DXProt', "$call connected");
 }
@@ -181,7 +189,7 @@ sub normal
 				my $ref = DXChannel->get($call);
 				$ref->send("$call de $field[1]: $text") if $ref && $ref->{talk};
 			} else {
-				route($field[2], $line); # relay it on its way
+				$self->route($field[2], $line); # relay it on its way
 			}
 			return;
 		}
@@ -191,7 +199,7 @@ sub normal
 			# route 'foreign' pc26s 
 			if ($pcno == 26) {
 				if ($field[7] ne $main::mycall) {
-					route($field[7], $line);
+					$self->route($field[7], $line);
 					return;
 				}
 			}
@@ -267,7 +275,7 @@ sub normal
 		if ($pcno == 12) {		# announces
 			# announce duplicate checking
 			my $text = substr(uc unpad($field[3]), 0, $pc12_dup_lth);
-			my $dupkey = $field[1].$field[2].$text.$field[4].$field[6];
+			my $dupkey = $field[1].$field[2].$text;
 			if ($anndup{$dupkey}) {
 				dbg('chan', "Duplicate Announce ignored\n");
 				return;
@@ -291,11 +299,11 @@ sub normal
 				if ($decode_dk0wcy && $field[1] eq $decode_dk0wcy) {
 					my ($hour, $k, $next, $a, $r, $sfi, $alarm) = $field[3] =~ /^Aurora Beacon\s+(\d+)UTC,\s+Kiel\s+K=(\d+),.*ed\s+K=(\d+),\s+A=(\d+),\s+R=(\d+),\s+SFI=(\d+),.*larm:\s+(\w+)/;
 					$alarm = ($alarm =~ /^Y/i) ? ', Aurora in DE' : ''; 
-					my $wwv = Geomag::update($main::systime, $hour, $sfi, $a, $k, "R=$r, Next K=$next$alarm", $decode_dk0wcy, $field[5], $r);
+					my $wwv = Geomag::update($main::systime, $hour, $sfi, $a, $k, "R=$r, Next K=$next$alarm", $decode_dk0wcy, $field[5], $r) if $sfi && $r;
 				}
 				
 			} else {
-				route($field[2], $line);
+				$self->route($field[2], $line);
 			}
 			
 			return;
@@ -360,13 +368,20 @@ sub normal
 		
 		if ($pcno == 17) {		# remove a user
 			my $node = DXCluster->get_exact($field[2]);
+			my $dxchan;
+			if (!$node && ($dxchan = DXChannel->get($field[2]))) {
+				# add it to the node table if it isn't present and it's
+				# connected locally
+				$node = DXNode->new($dxchan, $field[2], 0, 1, 5400);
+				broadcast_ak1a(pc19($dxchan, $node), $dxchan, $self) unless $dxchan->{isolate};
+				return;
+			}
 			return unless $node;
 			return unless $node->isa('DXNode');
 			if ($node->dxchan != $self) {
 				dbg('chan', "LOOP: $field[2] came in on wrong channel");
 				return;
 			}
-			my $dxchan;
 			if (($dxchan = DXChannel->get($field[2])) && $dxchan != $self) {
 				dbg('chan', "LOOP: $field[2] connected locally");
 				return;
@@ -491,7 +506,7 @@ sub normal
 			# route 'foreign' pc27s 
 			if ($pcno == 27) {
 				if ($field[8] ne $main::mycall) {
-					route($field[8], $line);
+					$self->route($field[8], $line);
 					return;
 				}
 			}
@@ -508,7 +523,7 @@ sub normal
 				dbg('chan', "Dup WWV Spot ignored\n");
 				return;
 			}
-			if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 900 || $field[2] < 0 || $field[2] > 23) {
+			if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $field[2] < 0 || $field[2] > 23) {
 				dbg('chan', "WWV Date ($field[1] $field[2]) out of range");
 				return;
 			}
@@ -541,7 +556,7 @@ sub normal
 		
 		if ($pcno == 25) {      # merge request
 			if ($field[1] ne $main::mycall) {
-				route($field[1], $line);
+				$self->route($field[1], $line);
 				return;
 			}
 			if ($field[2] eq $main::mycall) {
@@ -575,7 +590,7 @@ sub normal
 			if ($pcno == 49 || $field[1] eq $main::mycall) {
 				DXMsg::process($self, $line);
 			} else {
-				route($field[1], $line);
+				$self->route($field[1], $line);
 			}
 			return;
 		}
@@ -605,7 +620,7 @@ sub normal
 					$self->send(pc35($main::mycall, $field[2], "$main::mycall:your attempt is logged, Tut tut tut...!"));
 				}
 			} else {
-				route($field[1], $line);
+				$self->route($field[1], $line);
 			}
 			return;
 		}
@@ -619,7 +634,7 @@ sub normal
 					delete $rcmds{$field[2]} if !$dxchan;
 				}
 			} else {
-				route($field[1], $line);
+				$self->route($field[1], $line);
 			}
 			return;
 		}
@@ -663,11 +678,7 @@ sub normal
 			last SWITCH;
 		}
 		if ($pcno == 37 || $pcno == 44 || $pcno == 45 || $pcno == 46 || $pcno == 47) {
-			if ($field[1] eq $main::mycall) {
-				;
-			} else {
-				route($field[1], $line);
-			}
+			DXDb::process($self, $line);
 			return;
 		}
 		
@@ -692,15 +703,30 @@ sub normal
 					# it's a reply, look in the ping list for this one
 					my $ref = $pings{$field[2]};
 					if ($ref) {
-						my $r = shift @$ref;
-						my $dxchan = DXChannel->get($r->{call});
-						$dxchan->send($dxchan->msg('pingi', $field[2], atime($main::systime), $main::systime - $r->{t})) if $dxchan;
+						my $tochan =  DXChannel->get($field[2]);
+						while (@$ref) {
+							my $r = shift @$ref;
+							my $dxchan = DXChannel->get($r->{call});
+							next unless $dxchan;
+							my $t = tv_interval($r->{t}, [ gettimeofday ]);
+							if ($dxchan->is_user) {
+								my $s = sprintf "%.2f", $t; 
+								my $ave = $tochan->pingave if $tochan;
+								$dxchan->send($dxchan->msg('pingi', $field[2], $s, $ave))
+							} elsif ($dxchan->is_ak1a) {
+								if ($tochan) {
+									$tochan->nopings(3); # pump up the timer
+									$tochan->{pingtime} += $t;
+									$tochan->{pingrec} += 1;
+									$tochan->{pingave} = $tochan->{pingtime} / $tochan->{pingrec};
+								}
+							} 
+						}
 					}
 				}
-				
 			} else {
 				# route down an appropriate thingy
-				route($field[1], $line);
+				$self->route($field[1], $line);
 			}
 			return;
 		}
@@ -714,7 +740,7 @@ sub normal
 	 #        REBROADCAST!!!!
 	 #
 	 
-	if (!$self->{isolate}) {
+	unless ($self->{isolate}) {
 		broadcast_ak1a($line, $self); # send it to everyone but me
 	}
 }
@@ -737,6 +763,17 @@ sub process
 		if ($t >= $dxchan->pc50_t + $DXProt::pc50_interval) {
 			$dxchan->send(pc50());
 			$dxchan->pc50_t($t);
+		} 
+
+		# send a ping out on this channel
+		if ($t >= $dxchan->pingint + $dxchan->lastping) {
+			if ($dxchan->nopings <= 0) {
+				$dxchan->disconnect;
+			} else {
+				addping($main::mycall, $dxchan->call);
+				$dxchan->nopings($dxchan->nopings - 1);
+				$dxchan->lastping($t);
+			}
 		}
 	}
 	
@@ -996,9 +1033,13 @@ sub send_local_config
 #
 sub route
 {
-	my ($call, $line) = @_;
+	my ($self, $call, $line) = @_;
 	my $cl = DXCluster->get_exact($call);
-	if ($cl) {
+	if ($cl) {       # don't route it back down itself
+		if (ref $self && $call eq $self->{call}) {
+			dbg('chan', "Trying to route back to source, dropped");
+			return;
+		}
 		my $hops;
 		my $dxchan = $cl->{dxchan};
 		if ($dxchan) {
@@ -1200,13 +1241,13 @@ sub unpad
 sub addping
 {
 	my ($from, $to) = @_;
-	my $ref = $pings{$to};
-	$ref = $pings{$to} = [] if !$ref;
+	my $ref = $pings{$to} || [];
 	my $r = {};
 	$r->{call} = $from;
-	$r->{t} = $main::systime;
-	route($to, pc51($to, $main::mycall, 1));
+	$r->{t} = [ gettimeofday ];
+	route(undef, $to, pc51($to, $main::mycall, 1));
 	push @$ref, $r;
+	$pings{$to} = $ref;
 }
 
 # add a rcmd request to the rcmd queues
@@ -1217,7 +1258,7 @@ sub addrcmd
 	$r->{call} = $from;
 	$r->{t} = $main::systime;
 	$r->{cmd} = $cmd;
-	route($to, pc34($main::mycall, $to, $cmd));
+	route(undef, $to, pc34($main::mycall, $to, $cmd));
 	$rcmds{$to} = $r;
 }
 1;