perl/Thingy/Ping.pm

   1 #
   2 # Ping Thingy handling
   3 #
   4 # $Id$
   5 #
   6 # Copyright (c) 2005 Dirk Koopman G1TLH
   7 #
   8
   9 use strict;
  10
  11 package Thingy::Ping;
  12
  13 use vars qw($VERSION $BRANCH);
  14
  15 main::mkver($VERSION = q$Revision$);
  16
  17 use DXChannel;
  18 use DXDebug;
  19 use DXUtil;
  20 use Thingy;
  21 use Spot;
  22
  23 use vars qw(@ISA @ping);
  24 @ISA = qw(Thingy);
  25
  26 my $id;
  27
  28 sub gen_Aranea
  29 {
  30         my $thing = shift;
  31         unless ($thing->{Aranea}) {
  32                 $thing->{Aranea} = Aranea::genmsg($thing);
  33         }
  34         return $thing->{Aranea};
  35 }
  36
  37 sub from_Aranea
  38 {
  39         my $thing = shift;
  40         return unless $thing;
  41         return $thing;
  42 }
  43
  44 sub gen_DXProt
  45 {
  46         my $thing = shift;
  47         my $dxchan = shift;
  48         return $thing->{DXProt};
  49 }
  50
  51 sub gen_DXCommandmode
  52 {
  53         my $thing = shift;
  54         my $dxchan = shift;
  55         my $buf;
  56
  57         return $buf;
  58 }
  59
  60 sub from_DXProt
  61 {
  62         my $thing = ref $_[0] ? shift : $thing->SUPER::new();
  63
  64         while (@_) {
  65                 my $k = shift;
  66                 $thing->{$k} = shift;
  67         }
  68         return $thing;
  69 }
  70
  71 sub handle
  72 {
  73         my $thing = shift;
  74         my $dxchan = shift;
  75
  76         # is it for us?
  77         if ($thing->{group} eq $main::mycall) {
  78                 if ($thing->{out} == 1) {
  79                         my $repthing;
  80                         if ($thing->{touser}) {
  81                                 if (my $dxchan = DXChannel::get($thing->{touser})) {
  82                                         if ($dxchan->is_node) {
  83                                                 $thing->send($dxchan);
  84                                         } else {
  85                                                 $repthing = Thingy::Ping->new_reply($thing);
  86                                         }
  87                                 }
  88                         } else {
  89                                 $repthing = Thingy::Ping->new_reply($thing);
  90                         }
  91                         $repthing->send($dxchan) if $repthing;
  92                 } else {
  93
  94                         # it's a reply, look in the ping list for this one
  95                         my $ref = $pings{$from};
  96                         if ($ref) {
  97                                 my $tochan =  DXChannel::get($from);
  98                                 while (@$ref) {
  99                                         my $r = shift @$ref;
 100                                         my $dxchan = DXChannel::get($r->{call});
 101                                         next unless $dxchan;
 102                                         my $t = tv_interval($r->{t}, [ gettimeofday ]);
 103                                         if ($dxchan->is_user) {
 104                                                 my $s = sprintf "%.2f", $t;
 105                                                 my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
 106                                                 $dxchan->send($dxchan->msg('pingi', $from, $s, $ave))
 107                                         } elsif ($dxchan->is_node) {
 108                                                 if ($tochan) {
 109                                                         my $nopings = $tochan->user->nopings || $obscount;
 110                                                         push @{$tochan->{pingtime}}, $t;
 111                                                         shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
 112
 113                                                         # cope with a missed ping, this means you must set the pingint large enough
 114                                                         if ($t > $tochan->{pingint}  && $t < 2 * $tochan->{pingint} ) {
 115                                                                 $t -= $tochan->{pingint};
 116                                                         }
 117
 118                                                         # calc smoothed RTT a la TCP
 119                                                         if (@{$tochan->{pingtime}} == 1) {
 120                                                                 $tochan->{pingave} = $t;
 121                                                         } else {
 122                                                                 $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
 123                                                         }
 124                                                         $tochan->{nopings} = $nopings; # pump up the timer
 125                                                         if (my $ivp = Investigate::get($from, $origin)) {
 126                                                                 $ivp->handle_ping;
 127                                                         }
 128                                                 } elsif (my $rref = Route::Node::get($r->{call})) {
 129                                                         if (my $ivp = Investigate::get($from, $origin)) {
 130                                                                 $ivp->handle_ping;
 131                                                         }
 132                                                 }
 133                                         }
 134                                 }
 135                         }
 136                 }
 137         } else {
 138                 $thing->broadcast($dxchan);
 139         }
 140 }
 141
 142 # this just creates a ping for onward transmission
 143 # remember it if you want to ping someone from here
 144 sub new_ping
 145 {
 146         my $pkg = shift;
 147         my $thing = $pkg->SUPER::new(@_);
 148 }
 149
 150 # do this for pings we generate ourselves
 151 sub remember
 152 {
 153         my $thing = shift;
 154         $thing->{t} = [ gettimeofday ];
 155         $thing->{out} = 1;
 156         $thing->{id} = ++$id;
 157         my $u = DXUser->get_current($thing->{to});
 158         if ($u) {
 159                 $u->lastping(($thing->{group} || $thing->{user}), $main::systime);
 160                 $u->put;
 161         }
 162         push @ping, $thing;
 163 }
 164
 165 # remove any pings outstanding that we have remembered for this
 166 # callsign, return the number of forgotten pings
 167 sub forget
 168 {
 169         my $call = shift;
 170         my $count = 0;
 171         my @out;
 172         for (@ping) {
 173                 if ($thing->{user} eq $call) {
 174                         $count++;
 175                 } else {
 176                         push @out, $_;
 177                 }
 178         }
 179         @ping = @out;
 180         return $count;
 181 }
 182
 183 sub find
 184 {
 185         my $from = shift;
 186         my $to = shift;
 187         my $via = shift;
 188
 189         for (@ping) {
 190                 if ($_->{user} eq $from && $_->{to} eq $to) {
 191                         if ($via) {
 192                                 return $_ if $_->{group} eq $via;
 193                         } else {
 194                                 return $_;
 195                         }
 196                 }
 197         }
 198         return undef;
 199 }
 200 1;