From: minima <minima>
Date: Wed, 11 Jan 2006 20:21:50 +0000 (+0000)
Subject: fix badspotters and local ann/full.
X-Git-Tag: 1.53~89
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=4937d077fd03279aae2cbba6f1252ffdb04cc7a5;p=spider.git

fix badspotters and local ann/full.
do more development work on XML Interface, get pings basically working.
---

diff --git a/Changes b/Changes
index fdc64510..b94c786d 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,6 @@
+11Jan06=======================================================================
+1. Fixed problem with badspotters doing ann/full as pointed out by Luigi 
+IK5ZUK.
 07Jan06=======================================================================
 1. Fixed problem with the standalone 'showdx' program pointed out by Leo,
 IZ5FSA.
diff --git a/cmd/announce.pl b/cmd/announce.pl
index 9a1cbd37..e8056222 100644
--- a/cmd/announce.pl
+++ b/cmd/announce.pl
@@ -48,10 +48,24 @@ if ($sort eq "FULL") {
 # change ^ into : for transmission
 $line =~ s/\^/:/og;
 
+# if this is a 'bad spotter' user then ignore it
+my $nossid = $from;
+my $drop = 0;
+$nossid =~ s/-\d+$//;
+if ($DXProt::badspotter->in($nossid)) {
+	LogDbg('DXCommand', "bad spotter ($from) announcement: $line");
+	$drop++;
+}
+
+# have they sworn?
 my @bad;
 if (@bad = BadWords::check($line)) {
 	$self->badcount(($self->badcount||0) + @bad);
 	LogDbg('DXCommand', "$self->{call} swore: $line (with words:" . join(',', @bad) . ")");
+	$drop++;
+}
+
+if ($drop) {
 	Log('ann', $to, $from, "[to $from only] $line");
 	$self->send("To $to de $from <$t>: $line");
 	return (1, ());
diff --git a/cmd/ping.pl b/cmd/ping.pl
index aab2a3e6..f577bff1 100644
--- a/cmd/ping.pl
+++ b/cmd/ping.pl
@@ -26,7 +26,7 @@ $noderef = RouteDB::get($call) unless $noderef;
 return (1, $self->msg('e7', $call)) unless $noderef;
 
 # ping it
-DXProt::addping($self->call, $call);
+DXXml::Ping::add($self, $call);
 
 return (1, $self->msg('pingo', $call));
 
diff --git a/cmd/set/newprotocol.pl b/cmd/set/newprotocol.pl
deleted file mode 100644
index ae2054a2..00000000
--- a/cmd/set/newprotocol.pl
+++ /dev/null
@@ -1,27 +0,0 @@
-#
-# set the new protocol flag
-#
-# Copyright (c) 1998 - Dirk Koopman
-#
-# $Id$
-#
-
-my ($self, $line) = @_;
-my @args = split /\s+/, $line;
-my $call;
-my @out;
-
-@args = $self->call if (!@args || $self->priv < 9);
-
-foreach $call (@args) {
-	$call = uc $call;
-	my $user = DXUser->get_current($call);
-	if ($user) {
-		$user->wantnp(1);
-		$user->put;
-		push @out, $self->msg('set', 'New Protocol', $call);
-	} else {
-		push @out, $self->msg('e3', "Set New Protocol", $call);
-	}
-}
-return (1, @out);
diff --git a/cmd/set/wantpc90.pl b/cmd/set/wantpc90.pl
deleted file mode 100644
index 81cd2e12..00000000
--- a/cmd/set/wantpc90.pl
+++ /dev/null
@@ -1,28 +0,0 @@
-#
-# set the want PC90 flag
-#
-# Copyright (c) 2002 - Dirk Koopman
-#
-# $Id$
-#
-
-my ($self, $line) = @_;
-my @args = split /\s+/, uc $line;
-my $call;
-my @out;
-
-return (1, $self->msg('e5')) if $self->priv < 9;
-
-foreach $call (@args) {
-	return (1, $self->msg('e12')) unless is_callsign($call);
-
-	my $user = DXUser->get_current($call);
-	if ($user) {
-		$user->wantpc90(1);
-		$user->put;
-		push @out, $self->msg('wpc90s', $call);
-	} else {
-		push @out, $self->msg('e3', "set/wantpc90", $call);
-	}
-}
-return (1, @out);
diff --git a/cmd/unset/newprotocol.pl b/cmd/unset/newprotocol.pl
deleted file mode 100644
index e14c2df0..00000000
--- a/cmd/unset/newprotocol.pl
+++ /dev/null
@@ -1,27 +0,0 @@
-#
-# unset the new protocol flag
-#
-# Copyright (c) 1998 - Dirk Koopman
-#
-# $Id$
-#
-
-my ($self, $line) = @_;
-my @args = split /\s+/, $line;
-my $call;
-my @out;
-
-@args = $self->call if (!@args || $self->priv < 9);
-
-foreach $call (@args) {
-	$call = uc $call;
-	my $user = DXUser->get_current($call);
-	if ($user) {
-		$user->wantnp(0);
-		$user->put;
-		push @out, $self->msg('unset', 'New Protocol', $call);
-	} else {
-		push @out, $self->msg('e3', "Unset New Protocol", $call);
-	}
-}
-return (1, @out);
diff --git a/cmd/unset/wantpc90.pl b/cmd/unset/wantpc90.pl
deleted file mode 100644
index a4684c13..00000000
--- a/cmd/unset/wantpc90.pl
+++ /dev/null
@@ -1,28 +0,0 @@
-#
-# unset the want PC90 flag
-#
-# Copyright (c) 2002 - Dirk Koopman
-#
-# $Id$
-#
-
-my ($self, $line) = @_;
-my @args = split /\s+/, uc $line;
-my $call;
-my @out;
-
-return (1, $self->msg('e5')) if $self->priv < 9;
-
-foreach $call (@args) {
-	return (1, $self->msg('e12')) unless is_callsign($call);
-
-	my $user = DXUser->get_current($call);
-	if ($user) {
-		$user->wantpc90(0);
-		$user->put;
-		push @out, $self->msg('wpc90u', $call);
-	} else {
-		push @out, $self->msg('e3', "unset/wantpc90", $call);
-	}
-}
-return (1, @out);
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 6da3ecbe..adf7c358 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -178,6 +178,14 @@ sub alloc
 	return $channels{$call} = $self;
 }
 
+# rebless this channel as something else
+sub rebless
+{
+	my $self = shift;
+	my $class = shift;
+	return $channels{$self->{call}} = bless $self, $class;
+}
+
 sub rec	
 {
 	my ($self, $msg) = @_;
diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 404a7391..ecd65716 100644
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -35,6 +35,7 @@ use Net::Telnet;
 use QSL;
 use DB_File;
 use VE7CC;
+use DXXml;
 
 use strict;
 use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index d51b9f1a..4a43ef08 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;
@@ -57,7 +56,6 @@ $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
@@ -1550,7 +1548,7 @@ sub handle_51
 		if ($flag == 1) {
 			$self->send(pc51($from, $to, '0'));
 		} else {
-			$self->handle_ping_reply($from);
+			DXXml::Ping::handle_ping_reply($self, $from);
 		}
 	} else {
 
@@ -1565,56 +1563,6 @@ sub handle_51
 	}
 }
 
-sub handle_ping_reply
-{
-	my $self = shift;
-	my $from = shift;
-	my $id = shift;
-	
-	# it's a reply, look in the ping list for this one
-	my $ref = $pings{$from};
-	return unless $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;
-				}
-			}
-		}
-	}
-}
-
 # dunno but route it
 sub handle_75
 {
@@ -1737,7 +1685,7 @@ 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}};
@@ -2195,29 +2143,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) = @_;
diff --git a/perl/DXXml.pm b/perl/DXXml.pm
index e3c5f270..1bea12c7 100644
--- a/perl/DXXml.pm
+++ b/perl/DXXml.pm
@@ -117,13 +117,75 @@ sub toxml
 {
 	my $self = shift;
 
-	$self->{o} ||= $main::mycall;
-	$self->{t} ||= IsoTime::dayms();
-	$self->{id} ||= nextid();
+	unless (exists $self->{'-xml'}) {
+		$self->{o} ||= $main::mycall;
+		$self->{t} ||= IsoTime::dayms();
+		$self->{id} ||= nextid();
+		
+		my ($name) = ref $self =~ /::(\w+)$/;
+		$self->{'-xml'} = $xs->XMLout($self, RootName =>lc $name, NumericEscape=>1);
+	}
+	return $self->{'-xml'};
+}
+
+sub route
+{
+	my $self = shift;
+	my $fromdxchan = shift;
+	my $to = shift;
+	my $via = $to || $self->{'-via'} || $self->{to};
+
+	unless ($via) {
+		dbg("XML: no route specified (" . $self->toxml . ")") if isdbg('chanerr');
+		return;
+	}
+	if (ref $fromdxchan && $via && $fromdxchan->call eq $via) {
+		dbg("XML: Trying to route back to source (" . $self->toxml . ")") if isdbg('chanerr');
+		return;
+	}
+
+	# always send it down the local interface if available
+	my $dxchan = DXChannel::get($via);
+	if ($dxchan) {
+		dbg("route: $via -> $dxchan->{call} direct" ) if isdbg('route');
+	} else {
+		my $cl = Route::get($via);
+		$dxchan = $cl->dxchan if $cl;
+		dbg("route: $via -> $dxchan->{call} using normal route" ) if isdbg('route');
+	}
 
-	my ($name) = ref $self =~ /::(\w+)$/;
-	my $s = $xs->XMLout($self, RootName =>lc $name, NumericEscape=>1);
-	return $self->{'-xml'} = $s;
+	# try the backstop method
+	unless ($dxchan) {
+		my $rcall = RouteDB::get($via);
+		if ($rcall) {
+			$dxchan = DXChannel::get($rcall);
+			dbg("route: $via -> $rcall using RouteDB" ) if isdbg('route') && $dxchan;
+		}
+	}
+	
+	unless ($dxchan) {
+		dbg("XML: no route available to $via") if isdbg('chanerr');
+		return;
+	}
+
+	if ($fromdxchan->call eq $via) {
+		dbg("XML: Trying to route back to source (" . $self->toxml . ")") if isdbg('chanerr');
+		return;
+	}
+
+	if ($dxchan == $main::me) {
+		dbg("XML: Trying to route to me (" . $self->toxml . ")") if isdbg('chanerr');
+		return;
+	}
+
+	if ($dxchan->handle_xml) {
+		$dxchan->send($self->toxml);
+	} else {
+		$self->{o} ||= $main::mycall;
+		$self->{id} ||= nextid();
+		$self->{'-timet'} ||= $main::systime;
+		$dxchan->send($self->topcxx);
+	}
 }
 
 sub has_xml
diff --git a/perl/DXXml/Ping.pm b/perl/DXXml/Ping.pm
index 26dd864e..a1b0a6a1 100644
--- a/perl/DXXml/Ping.pm
+++ b/perl/DXXml/Ping.pm
@@ -13,14 +13,17 @@ package DXXml::Ping;
 use DXDebug;
 use DXProt;
 use IsoTime;
+use Investigate;
+use Time::HiRes qw(gettimeofday tv_interval);
 
-use vars qw($VERSION $BRANCH @ISA);
+use vars qw($VERSION $BRANCH @ISA %pings);
 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
 $main::build += $VERSION;
 $main::branch += $BRANCH;
 
 @ISA = qw(DXXml);
+%pings = ();                    # outstanding ping requests outbound
 
 sub handle_input
 {
@@ -29,4 +32,91 @@ sub handle_input
 	
 }
 
+sub topcxx
+{
+	my $self = shift;
+	unless (exists $self->{'-pcxx'}) {
+		$self->{'-pcxx'} = DXProt::pc51($self->{to}, $self->{o}, $self->{s});
+	}
+	return $self->{'-pcxx'};
+}
+
+# add a ping request to the ping queues
+sub add
+{
+	my ($dxchan, $to, $via) = @_;
+	my $from = $dxchan->call;
+	my $ref = $pings{$to} || [];
+	my $r = {};
+	my $self = DXXml::Ping->new(to=>$to, '-hirestime'=>[ gettimeofday ], s=>'1');
+	$self->{u} = $from unless $from eq $main::mycall;
+	$self->{'-via'} = $via if $via && DXChannel::get($via);
+	$self->{o} = $main::mycall;
+	$self->{id} = $self->nextid;
+	$self->route($dxchan);
+
+	push @$ref, $self;
+	$pings{$to} = $ref;
+	my $u = DXUser->get_current($to);
+	if ($u) {
+		$u->lastping(($via || $from), $main::systime);
+		$u->put;
+	}
+}
+
+sub handle_ping_reply
+{
+	my $fromdxchan = shift;
+	my $from = shift;
+	my $fromxml;
+	
+	if (ref $from) {
+		$fromxml = $from;
+		$from = $from->{o};
+	}
+
+	# it's a reply, look in the ping list for this one
+	my $ref = $pings{$from};
+	return unless $ref;
+
+	my $tochan = DXChannel::get($from);
+	while (@$ref) {
+		my $r = shift @$ref;
+		my $dxchan = DXChannel::get($r->{to});
+		next unless $dxchan;
+		my $t = tv_interval($r->{'-hirestime'}, [ 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 || $DXProt::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, $fromdxchan->{call})) {
+					$ivp->handle_ping;
+				}
+			} elsif (my $rref = Route::Node::get($r->{to})) {
+				if (my $ivp = Investigate::get($from, $fromdxchan->{to})) {
+					$ivp->handle_ping;
+				}
+			}
+		}
+	}
+}
+
 1;
diff --git a/perl/Investigate.pm b/perl/Investigate.pm
index 426e23eb..811d6380 100644
--- a/perl/Investigate.pm
+++ b/perl/Investigate.pm
@@ -124,7 +124,7 @@ sub process
 		if ($v->{state} eq 'start') {
 			my $via = $via{$v->{via}} || 0;
 			if ($main::systime > $via+$pingint) {
-				DXProt::addping($main::mycall, $v->{call}, $v->{via});
+				DXXml::Ping::add($main::me, $v->{call}, $v->{via});
 				$v->{start} = $lastping = $main::systime;
 				dbg("Investigate: ping sent to $v->{call} via $v->{via}") if isdbg('investigate');
 				$v->chgstate('waitping');
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 0ad54f31..6ed4c556 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -510,9 +510,8 @@ for (;;) {
 	
 	# do timed stuff, ongoing processing happens one a second
 	if ($timenow != $systime) {
-		reap if $zombies;
-		$systime = $timenow;
-		IsoTime::update($systime);
+		reap() if $zombies;
+		IsoTime::update($systime = $timenow);
 		DXCron::process();      # do cron jobs
 		DXCommandmode::process(); # process ongoing command mode stuff
 		DXXml::process();