]> dxcluster.net Git - spider.git/blob - perl/Thingy/Ping.pm
60c68078452abdec6529be9c6d3094ce3f490f72
[spider.git] / 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 = $thing->{o};
59             $from ||= $thing->{user} if Route::Node::get($thing->{user});
60                 $from ||= $thing->{origin};
61                 my $to = $thing->{touser} if Route::Node::get($thing->{touser});
62                 $to ||= $thing->{group};
63
64                 
65                 $thing->{DXProt} = DXProt::pc51($to, $from, $thing->{out});
66         }
67         return $thing->{DXProt};
68 }
69
70 sub gen_DXCommandmode
71 {
72         my $thing = shift;
73         my $dxchan = shift;
74         my $buf;
75
76         return $buf;
77 }
78
79 # called with the dxchan, line and the split out arguments
80 sub from_DXProt
81 {
82         my $thing = ref $_[0] ? shift : $_[0]->SUPER::new(origin=>$main::mycall);
83         my $dxchan = shift;
84         $thing->{DXProt} = shift;
85         $thing->{group} = shift;        # to call
86         my $from = shift;
87         $thing->{out} = shift;          # 1 = ping, 0 = pong;
88         $thing->{user} = $dxchan->{call};
89         $thing->{o} = $from unless $from eq $dxchan->{call};
90         $thing->remember if $thing->{out};
91         return $thing;
92 }
93
94 sub handle
95 {
96         my $thing = shift;
97         my $dxchan = shift;
98
99         # is it for us?
100         if ($thing->{group} eq $main::mycall) {
101                 if ($thing->{out} == 1) {
102                         my $repthing = $thing->new_reply;
103                         $repthing->{out} = 0;
104                         $repthing->{id} = $thing->{id};
105                         $repthing->{o} = $thing->{o} if $thing->{o};
106                         $repthing->send($dxchan) if $repthing;
107                 } else {
108
109                         # it's a reply, look in the ping list for this one
110                         my $ref = $ping{$thing->{id}} if exists $thing->{id};
111                         $ref ||= find(($thing->{user}||$thing->{origin}), ($thing->{touser}||$thing->{group}));
112                         if ($ref) {
113                                 my $t = tv_interval($ref->{t}, [ gettimeofday ]);
114                                 my $tochan = DXChannel::get($ref->{touser} || $ref->{group});
115                                 if ($tochan) {
116                                         my $nopings = $tochan->user->nopings || $DXProt::obscount;
117                                         push @{$tochan->{pingtime}}, $t;
118                                         shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6;
119                                         
120                                         # cope with a missed ping, this means you must set the pingint large enough
121                                         if ($t > $tochan->{pingint}  && $t < 2 * $tochan->{pingint} ) {
122                                                 $t -= $tochan->{pingint};
123                                         }
124                                         
125                                         # calc smoothed RTT a la TCP
126                                         if (@{$tochan->{pingtime}} == 1) {
127                                                 $tochan->{pingave} = $t;
128                                         } else {
129                                                 $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6);
130                                         }
131                                         $tochan->{nopings} = $nopings; # pump up the timer
132                                 }
133                                 if (my $dxc = DXChannel::get($ref->{user} || $ref->{origin})) {
134                                         if ($dxc->is_user) {
135                                                 my $s = sprintf "%.2f", $t; 
136                                                 my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t;
137                                                 $dxc->send($dxc->msg('pingi', ($ref->{touser} || $ref->{group}), $s, $ave))
138                                         } 
139                                 }
140                                 delete $ping{$ref->{id}};
141                         }
142                 }
143         } else {
144                 $thing->{route} = $thing->{o} if $thing->{o};
145                 $thing->broadcast($dxchan);
146         }
147 }
148
149 # this just creates a ping for onward transmission
150 # remember it if you want to ping someone from here     
151 sub new_ping
152 {
153         my $pkg = shift;
154         my $thing = $pkg->SUPER::new(@_);
155 }
156
157 # do this for pings we generate ourselves
158 sub remember
159 {
160         my $thing = shift;
161         $thing->{t} = [ gettimeofday ];
162         $thing->{out} = 1;
163         $thing->{id} = ++$id;
164         my $u = DXUser->get_current($thing->{to});
165         if ($u) {
166                 $u->lastping(($thing->{user} || $thing->{group}), $main::systime);
167                 $u->put;
168         }
169         $ping{$id} = $thing;
170 }
171
172 # remove any pings outstanding that we have remembered for this
173 # callsign, return the number of forgotten pings
174 sub forget
175 {
176         my $call = shift;
177         my $count = 0;
178         my @out;        
179         foreach my $thing (values %ping) {
180                 if (($thing->{user} || $thing->{group}) eq $call) {
181                         $count++;
182                         delete $ping{$thing->{id}};
183                 }
184         }
185         return $count;
186 }
187
188 sub find
189 {
190         my $to = shift;
191         my $from = shift;
192         my $user = shift;
193         
194         foreach my $thing (values %ping) {
195                 if ($thing->{origin} eq $from && $thing->{group} eq $to) {
196                         if ($user) {
197                                 return if $thing->{user} && $thing->{user} eq $user; 
198                         } else {
199                                 return $thing;
200                         }
201                 }
202         }
203         return undef;
204 }
205 1;