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