1 # ho_sping.pl
2 #
3 # $Id: ho_sping.pl,v 1.2 2004/09/04 11:20:45 jvunder REL_0_3 $
4 #
5 # Part of the Hybrid Oper Script Collection.
6 #
7 # Does a latency check of all linked servers on a network.
8 #
9 # Ping choopa from efnet.nl:
10 # /quote ping irc.efnet.nl :irc.choopa.net
11
12 use strict;
13 use vars qw($VERSION %IRSSI $SCRIPT_NAME);
14
15 use Irssi;
16 use Irssi::Irc; # necessary for redirect_register()
17 use HOSC::again;
18 use HOSC::again 'HOSC::Base';
19 use HOSC::again 'HOSC::Tools';
20
21 eval {
22 require Time::HiRes;
23 };
24 if ($@) {
25 Irssi::print("You need Time::HiRes for this script. Please install ".
26 "it or upgrade to Perl 5.8.");
27 return 0;
28 }
29 import Time::HiRes qw(gettimeofday tv_interval);
30
31 # Any server replying slower than this is considered to be slow.
32 my $SLOW_TIME = 2;
33
34 # ---------------------------------------------------------------------
35
36 ($VERSION) = '$Revision: 1.2 $' =~ / (\d+\.\d+) /;
37 %IRSSI = (
38 authors => 'Garion',
39 contact => 'garion@efnet.nl',
40 name => 'ho_sping',
41 description => 'Checks the latency of all linked servers.',
42 license => 'Public Domain',
43 url => 'http://www.garion.org/irssi/hosc.php',
44 changed => '07 August 2004 12:27:30',
45 );
46 $SCRIPT_NAME = 'Sping';
47
48 # Hashtable with server latency.
49 # Key is the server name.
50 # Value is the ping delay, in seconds.
51 my %server_pings;
52
53 my %data = (
54 currently_busy => 0,
55 servers_linked => 0,
56 servers_processed => 0,
57 my_server_tag => undef,
58 timer_gather_id => undef,
59 timer_gather_done_id => undef,
60 time_started_tv => undef,
61 );
62
63 # ---------------------------------------------------------------------
64
65 sub cmd_sping {
66 my ($data, $server, $item) = @_;
67 if ($data =~ m/^[(help)]/i ) {
68 Irssi::command_runsub ('sping', $data, $server, $item);
69 return;
70 }
71
72 if ($data{currently_busy}) {
73 ho_print_error("Sorry, already performing a latency check.");
74 return;
75 }
76
77 ho_print("Checking latency of all linked servers on " .
78 $server->{tag} . ".");
79 ho_print("Please wait up to " .
80 Irssi::settings_get_int('ho_sping_max_time') . " seconds.");
81 $server->redirect_event('command cmd_sping', 1, undef, 0, undef,
82 {
83 'event 364' => 'redir event_links_line',
84 'event 365' => 'redir event_links_end',
85 }
86 );
87 delete $server_pings{$_} for keys %server_pings;
88 $data{currently_busy} = 1;
89 $data{servers_linked} = 0;
90 $data{servers_processed} = 0;
91 $data{my_server_tag} = $server->{tag};
92 $data{time_started_tv} = [gettimeofday()];
93
94 # Now send LINKS to obtain a list of all linked servers. Then we can
95 # send a PING for each server.
96 $server->send_raw_now('LINKS');
97 }
98
99 # ---------------------------------------------------------------------
100
101 sub cmd_sping_help {
102 print_help();
103 }
104
105 # ---------------------------------------------------------------------
106
107 sub event_links_line {
108 my ($server, $args, $nick, $address) = @_;
109 if ($args =~ /^\S+\s+(\S+)\s/) {
110 $server_pings{$1} = undef;
111 }
112 Irssi::signal_stop();
113 $data{servers_linked}++;
114 }
115
116 # ---------------------------------------------------------------------
117
118 sub event_links_end {
119 my ($server, $args, $nick, $address) = @_;
120
121 # We've obtained the complete list of servers. Now go send a PING
122 # for each one.
123 send_pings($server);
124 Irssi::signal_stop();
125 }
126
127 # ---------------------------------------------------------------------
128
129 sub send_pings {
130 my ($server) = @_;
131
132 # Here we'll send a PING $myserver :$servername for each server.
133 # Then we wait until the last pong gets back, or up to
134 # sversion_max_time seconds, whichever occurs first. During this
135 # time we will steal all PONG replies and signal_stop them.
136 my $own_name = $server->{real_address};
137 for my $sname (keys %server_pings) {
138 $server->command("QUOTE PING $own_name :$sname");
139 #print ("QUOTE PING $own_name :$sname");
140 }
141
142 # We -must- have a timeout on this latency gathering in case one or
143 # more servers fail to reply. The latency gathering is considered to
144 # be complete as soon as all pong replies have been received, or
145 # this timer is executed, whichever occurs first.
146 my $time = Irssi::settings_get_int('ho_sping_max_time');
147 $time = 10 if $time < 10;
148 $data{timer_gather_id} =
149 Irssi::timeout_add($time * 1000, 'gather_completed', undef);
150 }
151
152 # ---------------------------------------------------------------------
153
154 sub event_pong {
155 my ($server, $args, $nick, $address, $target) = @_;
156
157 return unless $data{currently_busy};
158
159 my ($sname, $me) = $args =~ /^(\S+)\s+(\S+)$/;
160 if ($sname) {
161 $server_pings{$sname} = [gettimeofday()];
162 Irssi::signal_stop();
163 $data{servers_processed}++;
164 if ($data{servers_linked} == $data{servers_processed}) {
165 gather_completed();
166 }
167 }
168 }
169
170 # ---------------------------------------------------------------------
171
172 sub gather_completed {
173 if ($data{timer_gather_id}) {
174 Irssi::timeout_remove($data{timer_gather_id});
175 undef $data{timer_gather_id};
176 }
177 if ($data{timer_gather_done_id}) {
178 Irssi::timeout_remove($data{timer_gather_done_id});
179 undef $data{timer_gather_done_id};
180 }
181 $data{currently_busy} = 0;
182 print_pings();
183 }
184
185 # ---------------------------------------------------------------------
186
187 sub print_pings {
188 my ($server) = @_;
189
190 my @slow_servers = ();
191 my $num_total_servers = scalar keys %server_pings;
192 my %time_diffs;
193 for my $sname (keys %server_pings) {
194 my $timediff =
195 tv_interval($data{time_started_tv}, $server_pings{$sname});
196 my $timediff_fmt = sprintf "%.2f", $timediff;
197 $time_diffs{$sname} = $timediff_fmt;
198 if ($timediff > $SLOW_TIME) {
199 push @slow_servers, $sname;
200 }
201 }
202
203 # Print short report.
204 if (scalar @slow_servers == 0) {
205 ho_print("All $num_total_servers servers replied within ".
206 "$SLOW_TIME seconds.");
207 } elsif (scalar @slow_servers == 1) {
208 ho_print("All $num_total_servers servers except $slow_servers[0] ".
209 "replied within $SLOW_TIME seconds.");
210 } else {
211 ho_print("Out of $num_total_servers servers, the following " .
212 (scalar @slow_servers) . " servers ".
213 "replied slower than $SLOW_TIME seconds:");
214 ho_print(join ' ', @slow_servers);
215 }
216
217 # If desired, print full report.
218 if (Irssi::settings_get_bool('ho_sping_full_report')) {
219 ho_print('Server pings:');
220 for my $sname (sort keys %server_pings) {
221 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'ho_sping_line',
222 $sname, $time_diffs{$sname});
223 }
224 ho_print("Total servers linked: $data{servers_linked}.");
225 }
226 }
227
228 # ---------------------------------------------------------------------
229
230 ho_print_init_begin();
231
232 # The redirect for LINKS output.
233 Irssi::Irc::Server::redirect_register('command cmd_sping', 0, 0,
234 {
235 'event 364' => 1,
236 },
237 {
238 'event 365' => 1,
239 },
240 undef
241 );
242
243 Irssi::signal_add('redir event_links_line', 'event_links_line');
244 Irssi::signal_add('redir event_links_end', 'event_links_end');
245
246 Irssi::signal_add_first('event pong', 'event_pong');
247
248 Irssi::command_bind('sping', 'cmd_sping');
249 Irssi::command_bind('sping help', 'cmd_sping_help');
250
251 Irssi::settings_add_int('ho', 'ho_sping_max_time', 20);
252 Irssi::settings_add_bool('ho', 'ho_sping_full_report', 0);
253
254 Irssi::theme_register([
255 'ho_sping_line',
256 '$[25]0 - $1s',
257 ]);
258
259 ho_print_init_end();
260 ho_print("Use /SPING HELP for help.");
261
262 # ---------------------------------------------------------------------
263
264 sub print_help {
265 ho_print_help('head', $SCRIPT_NAME);
266
267 ho_print_help('section', 'Description');
268 ho_print_help("This script does a latency check ".
269 "of all servers on the network.");
270 ho_print_help("It does so by first issuing /LINKS and then doing a ".
271 "/PING <server> for each server.");
272 ho_print_help("Make sure your settings 'cmds_max_at_once' and ".
273 "'cmd_queue_speed' are set to proper values so this script can ".
274 "issue the /PING commands as quickly as possible without ".
275 "being disconnected for excess flood.\n");
276
277 ho_print_help('section', 'Syntax');
278 ho_print_help('syntax', 'SPING [HELP]');
279
280 ho_print_help('section', 'Settings');
281 ho_print_help('setting', 'ho_sping_max_time',
282 'Maximum time to wait for PONG replies.');
283 ho_print_help('setting', 'ho_sping_full_report',
284 'Whether or not to print a full report.');
285 }
286
287 # ---------------------------------------------------------------------
syntax highlighted by Code2HTML, v. 0.9.1