1 # ho_sversion.pl
2 #
3 # $Id: ho_sversion.pl,v 1.3 2004/08/15 08:53:05 jvunder REL_0_3 $
4 #
5 # Part of the Hybrid Oper Script Collection.
6 #
7 # Provides an easy way to get the version of all linked servers.
8 # NOTE: This server only works well for opered clients on a
9 # hybrid-compatible network, since it uses the flooding capabilities
10 # of opers on such servers.
11 # Known bugs:
12 # * Doing /VERSION <server> while the script is doing its thing doesn't
13 # give any output.
14 # * Servers that
15
16 use strict;
17 use vars qw($VERSION %IRSSI $SCRIPT_NAME);
18
19 use Irssi;
20 use Irssi::Irc; # necessary for redirect_register()
21 use HOSC::again;
22 use HOSC::again 'HOSC::Base';
23 use HOSC::again 'HOSC::Tools';
24
25 # ---------------------------------------------------------------------
26
27 ($VERSION) = '$Revision: 1.3 $' =~ / (\d+\.\d+) /;
28 %IRSSI = (
29 authors => 'Garion',
30 contact => 'garion@efnet.nl',
31 name => 'ho_sversion',
32 description => 'Checks the version of all linked servers.',
33 license => 'Public Domain',
34 url => 'http://www.garion.org/irssi/hosc.php',
35 changed => '07 August 2004 12:27:30',
36 );
37 $SCRIPT_NAME = 'Sversion';
38
39 # Hashtable with server versions.
40 # Key is the server name.
41 # Value is the version.
42 my %server_versions;
43
44 my %data = (
45 currently_busy => 0,
46 servers_linked => 0,
47 servers_processed => 0,
48 my_server_tag => undef,
49 timer_gather_id => undef,
50 timer_gather_done_id => undef,
51 );
52
53 # ---------------------------------------------------------------------
54
55 sub cmd_sversion {
56 my ($data, $server, $item) = @_;
57 if ($data =~ m/^[(help)]/i ) {
58 Irssi::command_runsub ('sversion', $data, $server, $item);
59 return;
60 }
61
62 if ($data{currently_busy}) {
63 ho_print_error("Sorry, already performing a version check.");
64 return;
65 }
66
67 ho_print("Checking version of all linked servers.");
68 ho_print("Please wait up to " .
69 Irssi::settings_get_int('ho_sversion_max_time') . " seconds.");
70 $server->redirect_event('command cmd_sversion', 1, undef, 0, undef,
71 {
72 'event 364' => 'redir event_links_line',
73 'event 365' => 'redir event_links_end',
74 }
75 );
76 delete $server_versions{$_} for keys %server_versions;
77 $data{currently_busy} = 1;
78 $data{servers_linked} = 0;
79 $data{servers_processed} = 0;
80 $data{my_server_tag} = $server->{tag};
81
82 # Now send LINKS to obtain a list of all linked servers. Then we can
83 # send a VERSION for each server.
84 $server->send_raw_now('LINKS');
85 }
86
87 # ---------------------------------------------------------------------
88
89 sub cmd_sversion_help {
90 print_help();
91 }
92
93 # ---------------------------------------------------------------------
94
95 sub event_links_line {
96 my ($server, $args, $nick, $address) = @_;
97 if ($args =~ /^\S+\s+(\S+)\s/) {
98 $server_versions{$1} = undef;
99 }
100 Irssi::signal_stop();
101 $data{servers_linked}++;
102 }
103
104 # ---------------------------------------------------------------------
105
106 sub event_links_end {
107 my ($server, $args, $nick, $address) = @_;
108
109 # We've obtained the complete list of servers. Now go send a VERSION
110 # for each one.
111 get_versions($server);
112 Irssi::signal_stop();
113 }
114
115 # ---------------------------------------------------------------------
116
117 sub get_versions {
118 my ($server) = @_;
119
120 # Here we'll just issue a VERSION $servername for each server.
121 # Then we wait until the last version gets back, or up to
122 # sversion_max_time seconds, whichever occurs first. During this
123 # time we will steal all 351 (version) and 005 (isupport) numerics
124 # and signal_stop them.
125 for my $sname (keys %server_versions) {
126 $server->command("QUOTE VERSION $sname");
127 }
128
129 # We -must- have a timeout on this version gathering in case one or
130 # more servers fail to reply. The version gathering is considered to
131 # be complete as soon as all version replies have been received, or
132 # this timer is executed, whichever occurs first.
133 my $time = Irssi::settings_get_int('ho_sversion_max_time');
134 $time = 10 if $time < 10;
135 $data{timer_gather_id} =
136 Irssi::timeout_add($time * 1000, 'gather_completed', undef);
137 }
138
139 # ---------------------------------------------------------------------
140 # The 351 numeric.
141 # :towel.carnique.nl 351 Garion hybrid-7.0(20030611_2). towel.carnique.nl :egGHIKMpZ6 TS5ow
142
143 sub event_server_version {
144 my ($server, $args, $nick, $address, $target) = @_;
145
146 # We always stop this signal.
147 Irssi::signal_stop();
148
149 # But if we're not busy with gathering a version list, we'll have to
150 # re-emit this signal.
151 if (!$data{currently_busy}) {
152 # For some reason I do not comprehend, Irssi does not display
153 # the first word of $args when re-emitting this signal. Hence
154 # the 'dummy_data' addition.
155 # Perhaps the number of the numeric should be here.
156 # Perhaps there is a rational explanation.
157 # I do not know, but this seems to work properly.
158 Irssi::signal_emit("default event numeric",
159 $server, "dummy_data " . $args, $nick, $address);
160 return;
161 }
162
163 # RFC dictates that there should be four fields. The first is the
164 # version, the second is the server name. Any ircd doing it in a
165 # different way is not RFC compliant.
166 if ($args =~ /^\S+\s(\S+)\s(\S+)\s:/) {
167 $server_versions{$2} = $1;
168 $data{servers_processed}++;
169 if ($data{servers_processed} == $data{servers_linked}) {
170 # The gathering is complete. However, don't print the list
171 # of servers immediately, because it could be that we're
172 # still about to receive a few 105 numerics. We want those
173 # to be suppressed as well. So, wait 3 seconds before
174 # printing the list.
175 $data{timer_gather_done_id} =
176 Irssi::timeout_add(3000, 'gather_completed', undef);
177 }
178 }
179 }
180
181 # ---------------------------------------------------------------------
182 # The 005 numeric.
183
184 sub event_server_isupport_local {
185 my ($server, $args, $nick, $address) = @_;
186
187 # We don't do anything with the isupport numeric (yet), but we want
188 # to stop it anyway. Otherwise you'd get a lot of scroll.
189 Irssi::signal_stop();
190
191 if (!$data{currently_busy}) {
192 # See event_server_version for 'dummy_data' explanation.
193 Irssi::signal_emit("default event numeric",
194 $server, "dummy_data " . $args, $nick, $address);
195 return;
196 }
197 }
198
199 # ---------------------------------------------------------------------
200 # The 105 numeric.
201
202 sub event_server_isupport_remote {
203 my ($server, $args, $nick, $address) = @_;
204
205 # We don't do anything with the isupport numeric (yet), but we want
206 # to stop it anyway. Otherwise you'd get a lot of scroll.
207 Irssi::signal_stop();
208
209 if (!$data{currently_busy}) {
210 # See event_server_version for 'dummy_data' explanation.
211 Irssi::signal_emit("default event numeric",
212 $server, "dummy_data " . $args, $nick, $address);
213 return;
214 }
215 }
216
217 # ---------------------------------------------------------------------
218
219 sub gather_completed {
220 if ($data{timer_gather_id}) {
221 Irssi::timeout_remove($data{timer_gather_id});
222 undef $data{timer_gather_id};
223 }
224 if ($data{timer_gather_done_id}) {
225 Irssi::timeout_remove($data{timer_gather_done_id});
226 undef $data{timer_gather_done_id};
227 }
228 $data{currently_busy} = 0;
229 print_versions();
230 }
231
232 # ---------------------------------------------------------------------
233
234 sub print_versions {
235 my ($server) = @_;
236
237 ho_print('Server versions:');
238 for my $sname (sort keys %server_versions) {
239 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'ho_sversion_line',
240 $sname, $server_versions{$sname});
241 }
242 ho_print("Total servers linked: $data{servers_linked}.");
243 }
244
245 # ---------------------------------------------------------------------
246
247 ho_print_init_begin($SCRIPT_NAME);
248
249 # The redirect for LINKS output.
250 Irssi::Irc::Server::redirect_register('command cmd_sversion', 0, 0,
251 {
252 'event 364' => 1,
253 },
254 {
255 'event 365' => 1,
256 },
257 undef
258 );
259
260 Irssi::signal_add('redir event_links_line', 'event_links_line');
261 Irssi::signal_add('redir event_links_end', 'event_links_end');
262
263 Irssi::signal_add_first('event 351', 'event_server_version');
264 Irssi::signal_add_first('event 005', 'event_server_isupport_local');
265 Irssi::signal_add_first('event 105', 'event_server_isupport_remote');
266
267 Irssi::command_bind('sversion', 'cmd_sversion');
268 Irssi::command_bind('sversion help', 'cmd_sversion_help');
269
270 Irssi::settings_add_int('ho', 'ho_sversion_max_time', 60);
271
272 Irssi::theme_register([
273 'ho_sversion_line',
274 '$[25]0 - $1',
275 ]);
276
277 ho_print_init_end($SCRIPT_NAME);
278 ho_print("Use /SVERSION HELP for help.");
279
280 # ---------------------------------------------------------------------
281
282 sub print_help {
283 ho_print_help('head', $SCRIPT_NAME);
284
285 ho_print_help('section', 'Description');
286 ho_print_help("This script displays a list of the server versions ".
287 "of all servers on the network.");
288 ho_print_help("It does so by first issuing /LINKS and then doing a ".
289 "/VERSION <server> for each server.");
290 ho_print_help("Make sure your settings 'cmds_max_at_once' and ".
291 "'cmd_queue_speed' are set to proper values so this script can ".
292 "issue the /VERSION commands as quickly as possible without ".
293 "being disconnected for excess flood.\n");
294
295 ho_print_help('section', 'Syntax');
296 ho_print_help('syntax', 'SVERSION [HELP]');
297
298 ho_print_help('section', 'Settings');
299 ho_print_help('setting', 'ho_sversion_max_time',
300 'Maximum time to wait for VERSION replies.');
301 }
302
303 # ---------------------------------------------------------------------
syntax highlighted by Code2HTML, v. 0.9.1