perl/DXXml/Ping.pm

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