X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FThingy%2FPing.pm;h=de295c556c939909dbe062793842867e9942ba2a;hb=809ac2e606559d68ff6e0580c0681fc71c6bc4b9;hp=09d0e59225c542020f1511d9e8e4114e4c11ab16;hpb=57740a288c82793988be72c9b5666087d636344f;p=spider.git diff --git a/perl/Thingy/Ping.pm b/perl/Thingy/Ping.pm index 09d0e592..de295c55 100644 --- a/perl/Thingy/Ping.pm +++ b/perl/Thingy/Ping.pm @@ -19,17 +19,21 @@ use DXDebug; use DXUtil; use Thingy; use Spot; +use Time::HiRes qw(gettimeofday tv_interval); -use vars qw(@ISA @ping); + +use vars qw(@ISA %ping $ping_ttl); @ISA = qw(Thingy); my $id; +$ping_ttl = 300; # default ping ttl + sub gen_Aranea { my $thing = shift; unless ($thing->{Aranea}) { - $thing->{Aranea} = Aranea::genmsg($thing); + $thing->{Aranea} = Aranea::genmsg($thing, qw(id out o)); } return $thing->{Aranea}; } @@ -45,6 +49,28 @@ sub gen_DXProt { my $thing = shift; my $dxchan = shift; + unless ($thing->{DXProt}) { + # we need to tease out the nodes out of all of this. + # bear in mind that a proxied PC prot node could be in + # {user} as well as a true user and also it may not + # have originated here. + + my ($from, $to); + if ($thing->{out}) { + $from = $thing->{o}; + $from ||= $thing->{user} unless Route::User::get($thing->{user}); + $from ||= $thing->{origin}; + $to = $thing->{touser} unless Route::User::get($thing->{touser}); + $to ||= $thing->{group}; + } else { + $from ||= $thing->{user} unless Route::User::get($thing->{user}); + $from ||= $thing->{origin}; + $to = $thing->{o}; + $to ||= $thing->{touser} unless Route::User::get($thing->{touser}); + $to ||= $thing->{group}; + } + $thing->{DXProt} = DXProt::pc51($to, $from, $thing->{out}); + } return $thing->{DXProt}; } @@ -53,18 +79,25 @@ sub gen_DXCommandmode my $thing = shift; my $dxchan = shift; my $buf; - + if ($dxchan->{call} eq $thing->{touser}) { + $buf = $dxchan->msg('pingi', ($thing->{user} || $thing->{origin}), $thing->{ft}, $thing->{fave}); + } return $buf; } +# called with the dxchan, line and the split out arguments sub from_DXProt { - my $thing = ref $_[0] ? shift : $thing->SUPER::new(); - - while (@_) { - my $k = shift; - $thing->{$k} = shift; - } + my $thing = ref $_[0] ? shift : $_[0]->SUPER::new(origin=>$main::mycall); + my $dxchan = shift; + $thing->{DXProt} = shift; + shift; # PC51 + $thing->{group} = shift; # to call + my $from = shift; + $thing->{out} = shift; # 1 = ping, 0 = pong; + $thing->{user} = $dxchan->{call}; + $thing->{o} = $from unless $from eq $dxchan->{call}; + $thing->remember if $thing->{out} && $thing->{group} ne $main::mycall; return $thing; } @@ -76,62 +109,44 @@ sub handle # 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); - } + my $repthing = $thing->new_reply; + $repthing->{out} = 0; + $repthing->{id} = $thing->{id}; + $repthing->{o} = $thing->{o} if $thing->{o}; $repthing->send($dxchan) if $repthing; } else { # it's a reply, look in the ping list for this one - my $ref = $pings{$from}; + my $ref; + $ref = $ping{$thing->{id}} if exists $thing->{id}; + $ref = find(($thing->{user}||$thing->{origin}), ($thing->{touser}||$thing->{group})) unless $ref; 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; - } - } + my $t = tv_interval($ref->{t}, [ gettimeofday ]); + my $tochan = DXChannel::get($ref->{touser} || $ref->{group}); + 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 $dxc = DXChannel::get($ref->{user} || $ref->{origin})) { + $thing->{ft} = sprintf "%.2f", $t; + $thing->{fave} = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t; + $thing->send($dxc); } + delete $ping{$ref->{id}}; } } } else { @@ -156,10 +171,10 @@ sub remember $thing->{id} = ++$id; my $u = DXUser->get_current($thing->{to}); if ($u) { - $u->lastping(($thing->{group} || $thing->{user}), $main::systime); + $u->lastping(($thing->{user} || $thing->{group}), $main::systime); $u->put; } - push @ping, $thing; + $ping{$id} = $thing; } # remove any pings outstanding that we have remembered for this @@ -169,29 +184,27 @@ sub forget my $call = shift; my $count = 0; my @out; - for (@ping) { - if ($thing->{user} eq $call) { + foreach my $thing (values %ping) { + if (($thing->{user} || $thing->{group}) eq $call) { $count++; - } else { - push @out, $_; + delete $ping{$thing->{id}}; } } - @ping = @out; return $count; } sub find { - my $from = shift; my $to = shift; - my $via = shift; + my $from = shift; + my $user = shift; - for (@ping) { - if ($_->{user} eq $from && $_->{to} eq $to) { - if ($via) { - return $_ if $_->{group} eq $via; + foreach my $thing (values %ping) { + if ($thing->{origin} eq $from && $thing->{group} eq $to) { + if ($user) { + return if $thing->{user} && $thing->{user} eq $user; } else { - return $_; + return $thing; } } }