From 4937d077fd03279aae2cbba6f1252ffdb04cc7a5 Mon Sep 17 00:00:00 2001 From: minima Date: Wed, 11 Jan 2006 20:21:50 +0000 Subject: [PATCH] fix badspotters and local ann/full. do more development work on XML Interface, get pings basically working. --- Changes | 3 ++ cmd/announce.pl | 14 ++++++ cmd/ping.pl | 2 +- cmd/set/newprotocol.pl | 27 ------------ cmd/set/wantpc90.pl | 28 ------------ cmd/unset/newprotocol.pl | 27 ------------ cmd/unset/wantpc90.pl | 28 ------------ perl/DXChannel.pm | 8 ++++ perl/DXCommandmode.pm | 1 + perl/DXProt.pm | 79 +--------------------------------- perl/DXXml.pm | 74 +++++++++++++++++++++++++++++--- perl/DXXml/Ping.pm | 92 +++++++++++++++++++++++++++++++++++++++- perl/Investigate.pm | 2 +- perl/cluster.pl | 5 +-- 14 files changed, 191 insertions(+), 199 deletions(-) delete mode 100644 cmd/set/newprotocol.pl delete mode 100644 cmd/set/wantpc90.pl delete mode 100644 cmd/unset/newprotocol.pl delete mode 100644 cmd/unset/wantpc90.pl 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(); -- 2.43.0