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