perl/DXXml/Ping.pm

   1 #
   2 # XML Ping handler
   3 #
   4 #
   5 #
   6 # Copyright (c) Dirk Koopman, G1TLH
   7 #
   8
   9 use strict;
  10
  11 package DXXml::Ping;
  12
  13 use DXDebug;
  14 use DXProt;
  15 use IsoTime;
  16 use Time::HiRes qw(gettimeofday tv_interval);
  17 use Route::Node;
  18
  19 use vars qw(@ISA %pings);
  20 @ISA = qw(DXXml);
  21 %pings = ();                    # outstanding ping requests outbound
  22
  23 sub handle_input
  24 {
  25         my $self = shift;
  26         my $dxchan = shift;
  27
  28         if ($self->{to} eq $main::mycall) {
  29                 if ($self->{s} eq '1') {
  30                         my $rep = DXXml::Ping->new(to=>$self->{o},
  31                                                                            s=>'0',
  32                                                                            oid=>$self->{id},
  33                                                                            ot=>$self->{t}
  34                                                                           );
  35                         $dxchan->send($rep->toxml);
  36                         if ($dxchan->{outgoing} && abs($dxchan->{lastping} - $main::systime) < 15) {
  37                                 $dxchan->{lastping} += $dxchan->{pingint} / 2;
  38                         }
  39                 } else {
  40                         handle_ping_reply($dxchan, $self->{o}, $self->{ot}, $self->{oid});
  41                 }
  42         } else {
  43                 $self->route($dxchan);
  44         }
  45 }
  46
  47 sub topcxx
  48 {
  49         my $self = shift;
  50         unless (exists $self->{'-pcxx'}) {
  51                 $self->{'-pcxx'} = DXProt::pc51($self->{to}, $self->{o}, $self->{s});
  52         }
  53         return $self->{'-pcxx'};
  54 }
  55
  56 # add a ping request to the ping queues
  57 sub add
  58 {
  59         my ($dxchan, $to, $via) = @_;
  60         my $from = $dxchan->call;
  61         my $ref = $pings{$to} || [];
  62         my $r = {};
  63         my $self = DXXml::Ping->new(to=>$to, '-hirestime'=>[ gettimeofday ], s=>'1');
  64         $self->{u} = $from unless $from eq $main::mycall;
  65         $self->{'-via'} = $via if $via && DXChannel::get($via);
  66         $self->{o} = $main::mycall;
  67         $self->route($dxchan);
  68
  69         push @$ref, $self;
  70         $pings{$to} = $ref;
  71         my $u = DXUser::get_current($to);
  72         if ($u) {
  73                 $u->lastping(($via || $from), $main::systime);
  74                 $u->put;
  75         }
  76 }
  77
  78 sub handle_ping_reply
  79 {
  80         my $fromdxchan = shift;
  81         my $from = shift;
  82         my $ot = shift;
  83         my $oid = shift;
  84         my $fromxml;
  85
  86         if (ref $from) {
  87                 $fromxml = $from;
  88                 $from = $from->{o};
  89         }
  90
  91         # it's a reply, look in the ping list for this one
  92         my $ref = $pings{$from};
  93         return unless $ref;
  94
  95         my $tochan = DXChannel::get($from);
  96         while (@$ref) {
  97                 my $r = shift @$ref;
  98                 my $dxchan = DXChannel::get($r->{o});
  99                 next unless $dxchan;
 100                 my $t = tv_interval($r->{'-hirestime'}, [ gettimeofday ]);
 101                 if ($dxchan->is_node) {
 102                         if ($tochan) {
 103                                 my $nopings = $tochan->user->nopings || $DXProt::obscount;
 104                                 push @{$tochan->{pingtime}}, $t;
 105                                 shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
 106
 107                                 # cope with a missed ping, this means you must set the pingint large enough
 108                                 if ($t > $tochan->{pingint}  && $t < 2 * $tochan->{pingint} ) {
 109                                         $t -= $tochan->{pingint};
 110                                 }
 111
 112                                 # calc smoothed RTT a la TCP
 113                                 if (@{$tochan->{pingtime}} == 1) {
 114                                         $tochan->{pingave} = $t;
 115                                 } else {
 116                                         $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
 117                                 }
 118                                 $tochan->{nopings} = $nopings; # pump up the timer
 119                                 dbg("ROUTE: $tochan->{call} ping obscount reset to $tochan->{nopings}") if isdbg('obscount');
 120                                 my $nref = Route::Node::get($tochan->{call});
 121                                 if ($nref) {
 122                                         my $n = $nref->reset_obs;
 123                                         dbg("ROUTE: reset obscount on $tochan->{call} to $n (ping)") if isdbg('obscount');
 124                                 }
 125                         }
 126                         _handle_believe($from, $fromdxchan->{call});
 127                 }
 128                 if (exists $r->{u} && ($dxchan = DXChannel::get($r->{u})) && $dxchan->is_user) {
 129                         my $s = sprintf "%.2f", $t;
 130                         my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
 131                         $dxchan->send($dxchan->msg('pingi', $from, $s, $ave))
 132                 }
 133         }
 134 }
 135
 136 sub _handle_believe
 137 {
 138         my ($from, $via) = @_;
 139
 140         my $user = DXUser::get_current($from);
 141         if ($user) {
 142                 $user->set_believe($via);
 143                 $user->put;
 144         }
 145 }
 146 1;