X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FThingy%2FPing.pm;h=09d0e59225c542020f1511d9e8e4114e4c11ab16;hb=57740a288c82793988be72c9b5666087d636344f;hp=1ee840858123836e6abe39fa1d19fd7bec851fdb;hpb=5764cc1c0f79b56fdf5389d2b0dcb2ab7e54723d;p=spider.git diff --git a/perl/Thingy/Ping.pm b/perl/Thingy/Ping.pm index 1ee84085..09d0e592 100644 --- a/perl/Thingy/Ping.pm +++ b/perl/Thingy/Ping.pm @@ -11,10 +11,8 @@ use strict; package Thingy::Ping; use vars qw($VERSION $BRANCH); -$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; + +main::mkver($VERSION = q$Revision$); use DXChannel; use DXDebug; @@ -22,15 +20,16 @@ use DXUtil; use Thingy; use Spot; -use vars qw(@ISA); +use vars qw(@ISA @ping); @ISA = qw(Thingy); +my $id; + sub gen_Aranea { my $thing = shift; unless ($thing->{Aranea}) { - my @items; - $thing->{Aranea} = Aranea::genmsg($thing, 'Rloc', @items); + $thing->{Aranea} = Aranea::genmsg($thing); } return $thing->{Aranea}; } @@ -60,12 +59,12 @@ sub gen_DXCommandmode sub from_DXProt { - my $thing = shift; + my $thing = ref $_[0] ? shift : $thing->SUPER::new(); + while (@_) { my $k = shift; $thing->{$k} = shift; } - ($thing->{hops}) = $thing->{DXProt} =~ /\^H(\d+)\^?~?$/ if exists $thing->{DXProt}; return $thing; } @@ -74,41 +73,128 @@ sub handle my $thing = shift; my $dxchan = shift; - $thing->broadcast($dxchan); + # is it for us? + if ($thing->{group} eq $main::mycall) { + if ($thing->{out} == 1) { + my $repthing; + if ($thing->{touser}) { + if (my $dxchan = DXChannel::get($thing->{touser})) { + if ($dxchan->is_node) { + $thing->send($dxchan); + } else { + $repthing = Thingy::Ping->new_reply($thing); + } + } + } else { + $repthing = Thingy::Ping->new_reply($thing); + } + $repthing->send($dxchan) if $repthing; + } 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, $origin)) { + $ivp->handle_ping; + } + } elsif (my $rref = Route::Node::get($r->{call})) { + if (my $ivp = Investigate::get($from, $origin)) { + $ivp->handle_ping; + } + } + } + } + } + } + } else { + $thing->broadcast($dxchan); + } +} + +# this just creates a ping for onward transmission +# remember it if you want to ping someone from here +sub new_ping +{ + my $pkg = shift; + my $thing = $pkg->SUPER::new(@_); } -sub in_filter +# do this for pings we generate ourselves +sub remember { my $thing = shift; - my $dxchan = shift; - - # global route filtering on INPUT - if ($dxchan->{inroutefilter}) { - my ($filter, $hops) = $dxchan->{inroutefilter}->it($thing->{routedata}); - unless ($filter) { - dbg("PCPROT: Rejected by input route filter") if isdbg('chanerr'); - return; + $thing->{t} = [ gettimeofday ]; + $thing->{out} = 1; + $thing->{id} = ++$id; + my $u = DXUser->get_current($thing->{to}); + if ($u) { + $u->lastping(($thing->{group} || $thing->{user}), $main::systime); + $u->put; + } + push @ping, $thing; +} + +# remove any pings outstanding that we have remembered for this +# callsign, return the number of forgotten pings +sub forget +{ + my $call = shift; + my $count = 0; + my @out; + for (@ping) { + if ($thing->{user} eq $call) { + $count++; + } else { + push @out, $_; } } - return 1; + @ping = @out; + return $count; } -sub out_filter +sub find { - my $thing = shift; - my $dxchan = shift; + my $from = shift; + my $to = shift; + my $via = shift; - # global route filtering on INPUT - if ($dxchan->{routefilter}) { - my ($filter, $hops) = $dxchan->{routefilter}->it($thing->{routedata}); - unless ($filter) { - dbg("PCPROT: Rejected by output route filter") if isdbg('chanerr'); - return; + for (@ping) { + if ($_->{user} eq $from && $_->{to} eq $to) { + if ($via) { + return $_ if $_->{group} eq $via; + } else { + return $_; + } } - $thing->{hops} = $hops if $hops; - } elsif ($dxchan->{isolate}) { - return; } - return 1; + return undef; } 1;