]> gb7djk.dxcluster.net Git - spider.git/blob - perl/DXXml/Ping.pm
issue K records and start to use them
[spider.git] / 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 Investigate;
17 use Time::HiRes qw(gettimeofday tv_interval);
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                         }
120                         _handle_believe($from, $fromdxchan->{call});
121                 } 
122                 if (exists $r->{u} && ($dxchan = DXChannel::get($r->{u})) && $dxchan->is_user) {
123                         my $s = sprintf "%.2f", $t; 
124                         my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
125                         $dxchan->send($dxchan->msg('pingi', $from, $s, $ave))
126                 } 
127         }
128 }
129
130 sub _handle_believe
131 {
132         my ($from, $via) = @_;
133         
134         if (my $ivp = Investigate::get($from, $via)) {
135                 $ivp->handle_ping;
136         } else {
137                 my $user = DXUser->get_current($from);
138                 if ($user) {
139                         $user->set_believe($via);
140                         $user->put;
141                 }
142         }
143 }
144 1;