X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXProt.pm;h=143b71e48e4a98c0ff141479aa76f1b73efb96a9;hb=0148e301a41d89c154254a457f7d79334eea9442;hp=5bf0d1f935f367fe3dfdc110b3986706bc90a0be;hpb=be587fd8dade028c10545ffff4be13b0a18f3f91;p=spider.git

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 5bf0d1f9..143b71e4 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -27,7 +27,6 @@ use DXDb;
 use AnnTalk;
 use Geomag;
 use WCY;
-use Time::HiRes qw(gettimeofday tv_interval);
 use BadWords;
 use DXHash;
 use Route;
@@ -50,13 +49,13 @@ use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restim
 			$pingint $obscount %pc19list $chatdupeage $chatimportfn
 			$investigation_int $pc19_version $myprot_version
 			%nodehops $baddx $badspotter $badnode $censorpc $rspfcheck
-			$allowzero $decode_dk0wcy $send_opernam @checklist);
+			$allowzero $decode_dk0wcy $send_opernam @checklist
+			$handle_xml);
 
 $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
 
 $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
 %pc19list = ();					# list of outstanding PC19s that haven't had PC16s on them
@@ -78,6 +77,7 @@ $chatdupeage = 20 * 60 * 60;
 $chatimportfn = "$main::root/chat_import";
 $investigation_int = 12*60*60;	# time between checks to see if we can see this node
 $pc19_version = 5466;			# the visible version no for outgoing PC19s generated from pc59
+$handle_xml = 0;				# handle XML sentences
 
 @checklist = 
 (
@@ -299,7 +299,7 @@ sub start
 	$self->{pingave} = 999;
 	$self->{metric} ||= 100;
 	$self->{lastping} = $main::systime;
-
+	
 	# send initialisation string
 	unless ($self->{outbound}) {
 		$self->sendinit;
@@ -326,21 +326,6 @@ sub sendinit
 	$self->send(pc18());
 }
 
-sub removepc90
-{
-	$_[0] =~ s/^PC90\^[-A-Z0-9]+\^\d+\^//;
-	$_[0] =~ s/^PC91\^[-A-Z0-9]+\^\d+\^[-A-Z0-9]+\^//;
-}
-
-#sub send
-#{
-#	my $self = shift;
-#	while (@_) {
-#		my $line = shift;
-#		$self->SUPER::send($line);
-#	}
-#}
-
 #
 # This is the normal pcxx despatcher
 #
@@ -348,8 +333,10 @@ sub normal
 {
 	my ($self, $line) = @_;
 
-	# remove any incoming PC90 frames
-	removepc90($line);
+	if ($line =~ '^<\w+\s' && $main::do_xml) {
+		DXXml::normal($self, $line);
+		return;
+	}
 
 	my @field = split /\^/, $line;
 	return unless @field;
@@ -490,6 +477,18 @@ sub handle_11
 			
 	# rsfp check
 	#			return if $rspfcheck and !$self->rspfcheck(1, $_[7], $_[6]);
+	
+	# is the spotted callsign blank? This should really be trapped earlier but it
+	# could break other protocol sentences. Also check for lower case characters.
+	if ($_[2] =~ /^\s*$/) {
+		dbg("PCPROT: blank callsign, dropped") if isdbg('chanerr');
+		return;
+	}
+	if ($_[2] =~ /[a-z]/) {
+		dbg("PCPROT: lowercase characters, dropped") if isdbg('chanerr');
+		return;
+	}
+
 
 	# if this is a 'nodx' node then ignore it
 	if ($badnode->in($_[7])) {
@@ -846,9 +845,12 @@ sub handle_16
 			push @rout, $parent->add_user($call, $flags);
 		}
 		
+		# send info to all logged in thingies
+		$self->tell_login('loginu', "$ncall: $call") if DXUser->get_current($ncall)->is_local_node;
+		$self->tell_buddies('loginb', $call, $ncall);
 				
 		# add this station to the user database, if required
-		$call =~ s/-\d+$//o;	# remove ssid for users
+#		$call =~ s/-\d+$//o;	# remove ssid for users
 		my $user = DXUser->get_current($call);
 		$user = DXUser->new($call) if !$user;
 		$user->homenode($parent->call) if !$user->homenode;
@@ -917,6 +919,10 @@ sub handle_17
 		$parent = Route->new($ncall);  # throw away
 	}
 
+	# send info to all logged in thingies
+	$self->tell_login('logoutu', "$ncall: $ucall") if DXUser->get_current($ncall)->is_local_node;
+	$self->tell_buddies('logoutb', $ucall, $ncall);
+
 	if (eph_dup($line)) {
 		dbg("PCPROT: dup PC17 detected") if isdbg('chanerr');
 		return;
@@ -946,6 +952,7 @@ sub handle_18
 			$self->user->put;
 			$self->sort('S');
 		}
+		$self->{handle_xml}++ if $main::do_xml && $_[1] =~ /\bxml\b/;
 	} else {
 		$self->version(50.0);
 		$self->version($_[2] / 100) if $_[2] && $_[2] =~ /^\d+$/;
@@ -1014,6 +1021,7 @@ sub handle_19
 				
 		# check for sane parameters
 		#				$ver = 5000 if $ver eq '0000';
+		next unless $ver && $ver =~ /^\d+$/;
 		next if $ver < 5000;	# only works with version 5 software
 		next if length $call < 3; # min 3 letter callsigns
 		next if $call eq $main::mycall;
@@ -1236,21 +1244,22 @@ sub handle_23
 	}
 
 	# global wwv filtering on INPUT
-	my @dxcc = ((Prefix::cty_data($_[6]))[0..2], (Prefix::cty_data($_[7]))[0..2]);
+	my @dxcc = ((Prefix::cty_data($_[7]))[0..2], (Prefix::cty_data($_[8]))[0..2]);
 	if ($self->{inwwvfilter}) {
 		my ($filter, $hops) = $self->{inwwvfilter}->it(@_[7,8], $origin, @dxcc);
 		unless ($filter) {
-			dbg("PCPROT: Rejected by input spot filter") if isdbg('chanerr');
+			dbg("PCPROT: Rejected by input wwv filter") if isdbg('chanerr');
 			return;
 		}
 	}
-	if (Geomag::dup($d,$sfi,$k,$i,$_[6])) {
+	$_[7] =~ s/-\d+$//o;		# remove spotter's ssid
+	if (Geomag::dup($d,$sfi,$k,$i,$_[6],$_[7])) {
 		dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chanerr');
 		return;
 	}
-	$_[7] =~ s/-\d+$//o;		# remove spotter's ssid
 		
-	my $wwv = Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r);
+	# note this only takes the first one it gets
+	Geomag::update($d, $_[2], $sfi, $k, $i, @_[6..8], $r);
 
 	my $rep;
 	eval {
@@ -1559,48 +1568,7 @@ sub handle_51
 		if ($flag == 1) {
 			$self->send(pc51($from, $to, '0'));
 		} else {
-			# it's a reply, look in the ping list for this one
-			my $ref = $pings{$from};
-			if ($ref) {
-				my $tochan =  DXChannel::get($from);
-				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 = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
-						$dxchan->send($dxchan->msg('pingi', $from, $s, $ave))
-					} elsif ($dxchan->is_node) {
-						if ($tochan) {
-							my $nopings = $tochan->user->nopings || $obscount;
-							push @{$tochan->{pingtime}}, $t;
-							shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
-							
-							# cope with a missed ping, this means you must set the pingint large enough
-							if ($t > $tochan->{pingint}  && $t < 2 * $tochan->{pingint} ) {
-								$t -= $tochan->{pingint};
-							}
-							
-							# calc smoothed RTT a la TCP
-							if (@{$tochan->{pingtime}} == 1) {
-								$tochan->{pingave} = $t;
-							} else {
-								$tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
-							}
-							$tochan->{nopings} = $nopings; # pump up the timer
-							if (my $ivp = Investigate::get($from, $self->{call})) {
-								$ivp->handle_ping;
-							}
-						} elsif (my $rref = Route::Node::get($r->{call})) {
-							if (my $ivp = Investigate::get($from, $self->{call})) {
-								$ivp->handle_ping;
-							}
-						}
-					}
-				}
-			}
+			DXXml::Ping::handle_ping_reply($self, $from);
 		}
 	} else {
 
@@ -1725,7 +1693,8 @@ sub process
 	}
 
 	foreach $dxchan (@dxchan) {
-		next unless $dxchan->is_node();
+		next unless $dxchan->is_node;
+		next if $dxchan->handle_xml;
 		next if $dxchan == $main::me;
 
 		# send the pc50
@@ -1736,9 +1705,10 @@ sub process
 			if ($dxchan->{nopings} <= 0) {
 				$dxchan->disconnect;
 			} else {
-				addping($main::mycall, $dxchan->call);
+				DXXml::Ping::add($main::me, $dxchan->call);
 				$dxchan->{nopings} -= 1;
 				$dxchan->{lastping} = $t;
+				$dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}};
 			}
 		}
 	}
@@ -2193,29 +2163,6 @@ sub load_hops
 	return ();
 }
 
-
-# add a ping request to the ping queues
-sub addping
-{
-	my ($from, $to, $via) = @_;
-	my $ref = $pings{$to} || [];
-	my $r = {};
-	$r->{call} = $from;
-	$r->{t} = [ gettimeofday ];
-	if ($via && (my $dxchan = DXChannel::get($via))) {
-		$dxchan->send(pc51($to, $main::mycall, 1));
-	} else {
-		route(undef, $to, pc51($to, $main::mycall, 1));
-	}
-	push @$ref, $r;
-	$pings{$to} = $ref;
-	my $u = DXUser->get_current($to);
-	if ($u) {
-		$u->lastping(($via || $from), $main::systime);
-		$u->put;
-	}
-}
-
 sub process_rcmd
 {
 	my ($self, $tonode, $fromnode, $user, $cmd) = @_;