]> dxcluster.net Git - spider.git/blob - perl/DXXml/Ping.pm
d70d6e9a46104cb379b95653af96862f4b0388b0
[spider.git] / 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;