1 # ho_netmon.pl
2 #
3 # $Id: ho_netmon.pl,v 1.4 2004/09/06 10:29:20 jvunder REL_0_3 $
4 #
5 # Part of the Hybrid Oper Script Collection.
6 #
7 # Monitors the linked servers of one or more networks.
8 # Requires you to be opered, because it looks at the server split/join
9 # server notices.
10
11 use strict;
12 use vars qw($VERSION %IRSSI $SCRIPT_NAME);
13 use POSIX;
14
15 use Irssi;
16 use Irssi::Irc; # for redirect_register()
17 use Irssi::TextUI; # for statusbar
18 use HOSC::again;
19 use HOSC::again 'HOSC::Base';
20 use HOSC::again 'HOSC::Tools';
21 import HOSC::Tools qw{is_server_notice seconds_to_dhms};
22
23 use constant NETMON_FILENAME => 'netmon.data';
24
25 # ---------------------------------------------------------------------
26
27 ($VERSION) = '$Revision: 1.4 $' =~ / (\d+\.\d+) /;
28 %IRSSI = (
29 authors => 'Garion',
30 contact => 'garion@efnet.nl',
31 name => 'ho_netmon',
32 description => 'Monitors the network for split 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 = 'Netmon';
38
39 # Data hash.
40 my %status;
41
42 # Temp hash for server checking.
43 my %checked_servers;
44
45 my @subcommands = qw[help status check list learn save load add remove name];
46
47 sub event_serverevent {
48 my ($server, $msg, $nick, $hostmask) = @_;
49 my ($nickname, $username, $hostname);
50
51 return unless is_server_notice(@_);
52
53 my $tag = lc $server->{tag};
54 return unless grep /^$tag$/,
55 split / +/, lc Irssi::settings_get_str('ho_netmon_network_tags');
56
57 my $ownnick = $server->{nick};
58
59 # Remove the NOTICE part from the message
60 # NOTE: this is probably unnecessary.
61 $msg =~ s/^NOTICE $ownnick ://;
62 $msg =~ s/^NOTICE . ://;
63 $msg =~ s/\*\*\* Notice -- //;
64
65 # -- Server split messages (all splits create this):
66 # Server services.eu split from hub.dk
67 # -- Server join messages:
68 # Server hub.efnet.nl being introduced by hub.uk
69 # Link with chanfix.carnique.nl[unknown@255.255.255.255] established:
70 # We need the second message too because not all joins generate the
71 # first message.
72 if ($msg =~ /^Server (\S+) split from \S+$/) {
73 process_split($tag, $1);
74 } elsif ($msg =~ /^Server (\S+) being introduced by \S+$/) {
75 process_join($tag, $1);
76 } elsif ($msg =~ /^Link with ([^[]+)\[.+\] established:/) {
77 process_join($tag, $1);
78 }
79 }
80
81 # ---------------------------------------------------------------------
82 # Statusbar item determination function.
83
84 sub netmon_sb {
85 my ($item, $get_size_only) = @_;
86
87 my $txt = '';# = "{sb ";
88
89 for my $tag (sort keys %status) {
90 my $missing = 0;
91 my $tag_txt = "$tag: ";
92 for my $server (sort keys %{ $status{$tag} }) {
93 if ($status{$tag}->{$server}->{status} eq 'missing') {
94 $missing++;
95 $tag_txt .= $status{$tag}->{$server}->{name} . ",";
96 }
97 }
98 $tag_txt =~ s/,$/ /;
99 if ($missing > Irssi::settings_get_int('ho_netmon_sb_max_servers')) {
100 $txt .= "$tag: $missing missing ";
101 } elsif ($missing > 0) {
102 $txt .= $tag_txt
103 }
104 }
105
106 $txt =~ s/ $//;
107 if (length $txt) {
108 $item->default_handler($get_size_only, "{sb nm: $txt}", undef, 1);
109 } else {
110 $item->default_handler($get_size_only, "{sb nm: all ok}", undef, 1);
111 }
112 }
113
114 # ---------------------------------------------------------------------
115
116 sub cmd_netmon {
117 my ($data, $server, $item) = @_;
118
119 for my $cmd (@subcommands) {
120 if ($data =~ m/^$cmd/i ) {
121 Irssi::command_runsub ('netmon', $data, $server, $item);
122 Irssi::statusbar_items_redraw('netmon');
123 return;
124 }
125 }
126
127 print_syntax();
128 }
129
130 # ---------------------------------------------------------------------
131
132 sub cmd_netmon_help {
133 print_help();
134 }
135
136 # ---------------------------------------------------------------------
137
138 sub cmd_netmon_load {
139 if (load_netmon_data()) {
140 ho_print("Loaded netmon data successfully.");
141 } else {
142 ho_print("Not loaded netmon data.");
143 }
144 }
145
146 # ---------------------------------------------------------------------
147
148 sub cmd_netmon_save {
149 if (save_netmon_data()) {
150 ho_print("Saved netmon data successfully.");
151 } else {
152 ho_print("Not saved netmon data.");
153 }
154 }
155
156 # ---------------------------------------------------------------------
157
158 sub cmd_netmon_status {
159 my ($data, $server, $item) = @_;
160
161 if ($data) {
162 my $tag = lc $data;
163 print_status($tag);
164 } else {
165 ho_print("Status is available for the following tags: " .
166 lc Irssi::settings_get_str('ho_netmon_network_tags'));
167 }
168 }
169
170 # ---------------------------------------------------------------------
171
172 sub cmd_netmon_list {
173 my ($data, $server, $item) = @_;
174
175 if ($data) {
176 my $tag = lc $data;
177 print_list($tag);
178 } else {
179 ho_print("List is available for the following tags: " .
180 lc Irssi::settings_get_str('ho_netmon_network_tags'));
181 }
182 }
183
184 # ---------------------------------------------------------------------
185
186 sub cmd_netmon_learn {
187 my ($data, $srv, $item) = @_;
188
189 if (length $data == 0) {
190 ho_print("Please use /NETMON LEARN <tag>.");
191 return;
192 }
193
194 my $server = Irssi::server_find_tag($data);
195 if (!defined $server) {
196 ho_print("Not connected to server with tag $data.");
197 return;
198 }
199
200 ho_print("Learning the servers on network $data.");
201
202 $server->redirect_event('command cmd_netmon', 1, undef, 0, undef,
203 {
204 'event 364' => 'redir event_links_line_learn',
205 'event 365' => 'redir event_links_end_learn',
206 }
207 );
208
209 # Now send LINKS to obtain a list of all linked servers.
210 $server->send_raw_now('LINKS');
211 }
212
213 # ---------------------------------------------------------------------
214 # Performs a /LINKS for this network tag and inspects if all servers
215 # are present. This command will not add new servers to the list; it
216 # will only update the status of the already defined servers.
217
218 sub cmd_netmon_check {
219 my ($data, $srv, $item) = @_;
220
221 if (length $data == 0) {
222 ho_print("Please use /NETMON CHECK <tag>.");
223 return;
224 }
225
226 my $server = Irssi::server_find_tag($data);
227 if (!defined $server) {
228 ho_print("Not connected to server with tag $data.");
229 return;
230 }
231
232 ho_print("Checking the servers on network $data.");
233 %checked_servers = ();
234
235 $server->redirect_event('command cmd_netmon', 1, undef, 0, undef,
236 {
237 'event 364' => 'redir event_links_line_check',
238 'event 365' => 'redir event_links_end_check',
239 }
240 );
241
242 # Now send LINKS to obtain a list of all linked servers.
243 $server->send_raw_now('LINKS');
244 }
245
246 # ---------------------------------------------------------------------
247
248 sub cmd_netmon_add {
249 my ($data, $srv, $item) = @_;
250
251 if ($data =~ /^(\S+)\s+(\S+)\s*$/) {
252 my ($tag, $server) = (lc $1, $2);
253 if (grep /^$tag$/,
254 split / +/, lc Irssi::settings_get_str('ho_netmon_network_tags')
255 ) {
256 if (exists $status{$tag}->{$server}) {
257 ho_print("Server $server already present in tag $tag.");
258 return;
259 }
260
261 ho_print("Adding server $server to tag $tag.");
262 $status{$tag}->{$server} = {
263 status => 'unknown',
264 ts => time,
265 full_name => $server,
266 name => $server,
267 split_ts => undef,
268 split_count => 0,
269 };
270 }
271 } else {
272 ho_print("Use /NETMON HELP for help.");
273 }
274 }
275
276 # ---------------------------------------------------------------------
277
278 sub cmd_netmon_remove {
279 my ($data, $srv, $item) = @_;
280
281 if ($data =~ /^(\S+)\s+(\S+)\s*$/) {
282 my ($tag, $server) = (lc $1, $2);
283 if (grep /^$tag$/,
284 split / +/, lc Irssi::settings_get_str('ho_netmon_network_tags')
285 ) {
286 if (!exists $status{$tag}->{$server}) {
287 ho_print("No server $server present in tag $tag.");
288 return;
289 }
290 ho_print("Removing server $server from tag $tag.");
291 delete $status{$tag}->{$server};
292 save_netmon_data();
293 }
294 } else {
295 ho_print("Use /NETMON HELP for help.");
296 }
297 }
298
299 # ---------------------------------------------------------------------
300
301 sub cmd_netmon_name {
302 my ($data, $srv, $item) = @_;
303
304 if ($data =~ /^(\S+)\s+(\S+)\s+(\S+)\s*$/) {
305 my ($tag, $server, $name) = (lc $1, $2, $3);
306 if (exists $status{$tag}->{$server}) {
307 $status{$tag}->{$server}->{name} = $3;
308 ho_print("Changed name of server $server to $name.");
309 save_netmon_data();
310 } else {
311 ho_print("No server $server present in tag $tag.");
312 }
313 } else {
314 ho_print("Use /NETMON HELP for help.");
315 }
316 }
317
318 # ---------------------------------------------------------------------
319
320 sub process_join {
321 my ($tag, $server) = @_;
322
323 if (grep /^$tag:$server$/,
324 (split / +/, lc Irssi::settings_get_str('ho_netmon_ignore_servers'))
325 ) {
326 return;
327 }
328
329 if (exists $status{$tag}->{$server}) {
330 ho_print("[$tag] Rejoin: $server.")
331 if Irssi::settings_get_bool('ho_netmon_verbose');
332 } else {
333 ho_print("[$tag] Join new server: $server.")
334 if Irssi::settings_get_bool('ho_netmon_verbose');
335 $status{$tag}->{$server}->{name} = $server;
336 $status{$tag}->{$server}->{split_count} = 0;
337 }
338 $status{$tag}->{$server}->{status} = 'present';
339 $status{$tag}->{$server}->{ts} = time;
340
341 Irssi::statusbar_items_redraw('netmon');
342 }
343
344 # ---------------------------------------------------------------------
345
346 sub process_split {
347 my ($tag, $server) = @_;
348
349 if (grep /^$tag:$server$/,
350 (split / +/, lc Irssi::settings_get_str('ho_netmon_ignore_servers'))
351 ) {
352 return;
353 }
354
355 if (exists $status{$tag}->{$server}) {
356 ho_print("[$tag] Split: $server.")
357 if Irssi::settings_get_bool('ho_netmon_verbose');
358 } else {
359 ho_print("[$tag] Split new server: $server.")
360 if Irssi::settings_get_bool('ho_netmon_verbose');
361 $status{$tag}->{$server}->{name} = $server;
362 }
363 $status{$tag}->{$server}->{status} = 'missing';
364 $status{$tag}->{$server}->{ts} = time;
365 $status{$tag}->{$server}->{split_ts} = time;
366 $status{$tag}->{$server}->{split_count}++;
367
368 Irssi::statusbar_items_redraw('netmon');
369 }
370
371 # ---------------------------------------------------------------------
372
373 sub print_list {
374 my ($tag) = @_;
375
376 if (!exists $status{$tag}) {
377 ho_print("No list for tag $tag.");
378 return;
379 }
380
381 my $now = time;
382 ho_print("Server list for tag $tag:");
383 for my $server (sort keys %{ $status{$tag} }) {
384 my $format = 'ho_netmon_list_line_' .
385 $status{$tag}->{$server}->{status};
386 my $time = strftime "%Y-%m-%d %H:%M:%S",
387 localtime($status{$tag}->{$server}->{ts});
388 my ($d, $h, $m, $s) =
389 seconds_to_dhms($now - $status{$tag}->{$server}->{ts});
390 my $timediff = "$d+$h:$m:$s";
391 Irssi::printformat(MSGLEVEL_CRAP, $format,
392 $server, $status{$tag}->{$server}->{name},
393 $status{$tag}->{$server}->{split_count}, $timediff, $time);
394 }
395 }
396
397 # ---------------------------------------------------------------------
398
399 sub print_status {
400 my ($tag) = @_;
401
402 if (!exists $status{$tag}) {
403 ho_print("No status for tag $tag.");
404 return;
405 }
406
407 my $now = time;
408 ho_print("Status report for tag $tag:");
409 my @missing;
410 for my $server (sort keys %{ $status{$tag} }) {
411 if ($status{$tag}->{$server}->{status} eq 'missing') {
412 push @missing, $status{$tag}->{$server}->{name};
413 }
414 }
415 if (@missing) {
416 ho_print("Missing servers (" . scalar @missing . "/" .
417 scalar (keys %{ $status{$tag} }) . "): " . join ' ', @missing);
418 } else {
419 ho_print("All " . scalar (keys %{ $status{$tag} }).
420 " servers are present.");
421 }
422 }
423
424 # ---------------------------------------------------------------------
425
426 sub event_links_line_learn {
427 my ($server, $args, $nick, $address) = @_;
428 Irssi::signal_stop();
429 my $tag = lc $server->{tag};
430
431 # hoscgaar hub.nl towel.carnique.nl :1 Carnique main hub server
432 if ($args =~ /^\S+\s(\S+)\s(\S+) :/) {
433 if (!exists $status{$tag}->{$1}) {
434 ho_print("Learned new server: $1.")
435 if Irssi::settings_get_bool('ho_netmon_verbose');
436 $status{$tag}->{$1} = {
437 status => 'present',
438 ts => time,
439 full_name => $1,
440 name => $1,
441 split_ts => undef,
442 split_count => 0,
443 };
444 }
445 }
446 }
447
448 # ---------------------------------------------------------------------
449
450 sub event_links_end_learn {
451 my ($server, $args, $nick, $address) = @_;
452
453 Irssi::signal_stop();
454 Irssi::statusbar_items_redraw('netmon');
455 ho_print("Done learning.");
456 save_netmon_data();
457 }
458
459 # ---------------------------------------------------------------------
460
461 sub event_links_line_check {
462 my ($server, $args, $nick, $address) = @_;
463 Irssi::signal_stop();
464
465 my $tag = lc $server->{tag};
466
467 # hoscgaar hub.nl towel.carnique.nl :1 Carnique main hub server
468 if ($args =~ /^\S+\s(\S+)\s(\S+) :/) {
469 $checked_servers{$1} = 1;
470 if (exists $status{$tag}->{$1}) {
471 if ($status{$tag}->{$1}->{status} ne 'present') {
472 $status{$tag}->{$1}->{status} = 'present';
473 $status{$tag}->{$1}->{ts} = time;
474 }
475 }
476 }
477 }
478
479 # ---------------------------------------------------------------------
480
481 sub event_links_end_check {
482 my ($server, $args, $nick, $address) = @_;
483
484 my ($present, $missing, $total) = (0, 0, 0);
485
486 my $tag = lc $server->{tag};
487 my $now = time;
488
489 # All servers we did not find can be changed from whatever status they
490 # currently have to missing.
491 for my $server (sort keys %{ $status{$tag} }) {
492 if (!$checked_servers{$server} &&
493 $status{$tag}->{$server}->{status} ne 'missing'
494 ) {
495 $status{$tag}->{$server}->{status} = 'missing';
496 $status{$tag}->{$server}->{ts} = $now;
497 }
498 }
499
500
501 for my $server (sort keys %{ $status{$tag} }) {
502 $present++ if $status{$tag}->{$server}->{status} eq 'present';
503 $missing++ if $status{$tag}->{$server}->{status} eq 'missing';
504 }
505 $total = $present + $missing;
506
507 ho_print("[$tag] Found $present present and $missing missing servers.");
508 Irssi::signal_stop();
509 Irssi::statusbar_items_redraw('netmon');
510 }
511
512 # ---------------------------------------------------------------------
513
514 sub save_netmon_data {
515 my $file = Irssi::get_irssi_dir() . '/' . NETMON_FILENAME;
516
517 open F, ">$file"
518 or return ho_print_error("Error opening outputfile $file: $!");
519
520 for my $tag (sort keys %status) {
521 for my $server (sort keys %{ $status{$tag} }) {
522 my $msg = "$tag $server " . $status{$tag}->{$server}->{name};
523 print F "$msg\n";
524 }
525 }
526
527 close F;
528 return 1;
529 }
530
531 # ---------------------------------------------------------------------
532
533 sub load_netmon_data {
534 my $file = Irssi::get_irssi_dir() . '/' . NETMON_FILENAME;
535 return unless -f $file;
536 open F, $file
537 or return ho_print_error("Error opening inputfile $file: $!");
538
539 my @lines = <F>;
540 close F;
541
542 %status = ();
543 # Each line is like this:
544 # EFNet efnet.demon.co.uk demon
545 # Being the tag, complete server name, and short server name.
546 my $now = time;
547 for my $line (@lines) {
548 if ($line =~ /^\s*(\S+)\s+(\S+)\s+(\S+)\s*$/) {
549 my $tag = lc $1;
550 $status{$tag}->{$2} = {
551 full_name => $2,
552 name => $3,
553 status => 'unknown',
554 ts => $now,
555 split_ts => undef,
556 split_count => 0,
557 };
558 }
559 }
560 return 1;
561 }
562
563 # ---------------------------------------------------------------------
564
565 ho_print_init_begin();
566
567 # The redirect for LINKS output.
568 Irssi::Irc::Server::redirect_register('command cmd_netmon', 0, 0,
569 {
570 'event 364' => 1,
571 },
572 {
573 'event 365' => 1,
574 },
575 undef
576 );
577
578 Irssi::signal_add_first('server event', 'event_serverevent');
579
580 Irssi::signal_add('redir event_links_line_learn', 'event_links_line_learn');
581 Irssi::signal_add('redir event_links_end_learn', 'event_links_end_learn');
582
583 Irssi::signal_add('redir event_links_line_check', 'event_links_line_check');
584 Irssi::signal_add('redir event_links_end_check', 'event_links_end_check');
585
586 Irssi::command_bind('netmon', 'cmd_netmon');
587 Irssi::command_bind("netmon $_", "cmd_netmon_$_")
588 for @subcommands;
589
590 Irssi::settings_add_str('ho', 'ho_netmon_network_tags', '');
591 Irssi::settings_add_int('ho', 'ho_netmon_sb_max_servers', 3);
592 Irssi::settings_add_str('ho', 'ho_netmon_ignore_servers', '');
593 Irssi::settings_add_bool('ho', 'ho_netmon_verbose', 1);
594
595 Irssi::statusbar_item_register('netmon', '{sb $1-}', 'netmon_sb');
596
597 Irssi::theme_register([
598 'ho_netmon_line',
599 '$[25]0 - $1',
600
601 'ho_netmon_list_line',
602 '$[25]0 - $1',
603
604 'ho_netmon_list_line_unknown',
605 '$[25]0 - $[20]1 ($[-2]2) $[-12]3',
606
607 'ho_netmon_list_line_present',
608 '%G$[25]0%n - $[20]1 ($[-2]2) %g$[-12]3%n',
609
610 'ho_netmon_list_line_missing',
611 '%R$[25]0%n - $[20]1 ($[-2]2) %r$[-12]3%n',
612 ]);
613
614 load_netmon_data();
615
616 {
617 my @tags = split / +/, lc Irssi::settings_get_str('ho_netmon_network_tags');
618 ho_print("Checking all configured networks...") if @tags;
619 for my $tag (@tags) {
620 cmd_netmon_check($tag);
621 }
622 }
623
624 ho_print_init_end();
625 ho_print("Use /NETMON HELP for help.");
626
627 # ---------------------------------------------------------------------
628
629 sub print_syntax {
630 ho_print_help('section', 'Syntax');
631 ho_print_help('syntax', 'NETMON HELP');
632 ho_print_help('syntax', 'NETMON LIST <tag>');
633 ho_print_help('syntax', 'NETMON STATUS <tag>');
634 ho_print_help('syntax', 'NETMON CHECK <tag>');
635 ho_print_help('syntax', 'NETMON LEARN <tag>');
636 ho_print_help('syntax', 'NETMON LOAD');
637 ho_print_help('syntax', 'NETMON SAVE');
638 ho_print_help('syntax', 'NETMON ADD <tag> <server>');
639 ho_print_help('syntax', 'NETMON REMOVE <tag> <server>');
640 ho_print_help('syntax', 'NETMON NAME <tag> <server> <name>');
641 }
642
643 sub print_help {
644 ho_print_help('head', $SCRIPT_NAME);
645
646 print_syntax();
647
648 ho_print_help('section', 'Description');
649 ho_print_help("This script monitors the presence of all servers on one ".
650 "or more networks. It provides a statusbar item which shows which ".
651 "servers, if any, are missing (split).");
652 ho_print_help("Each network has a list of servers, and each server has ".
653 "a full name and a short name. The short name is what shows up in ".
654 "the statusbar item.");
655 ho_print_help("Typical usage of this script is as follows. Load, set the ".
656 "network tags, do /netmon learn for each of those tags, and add a ".
657 "few servers that are missing. Then /statusbar <bar> add netmon, and ".
658 "you're all set.");
659
660 ho_print_help('section', 'Commands');
661 ho_print_help('command', 'NETMON LIST <tag>',
662 'Prints a list of all servers on <tag> and their status.');
663 ho_print_help('command', 'NETMON STATUS <tag>',
664 'Shows a status report of <tag>.');
665 ho_print_help('command', 'NETMON CHECK <tag>',
666 'Does a /LINKS and checks which servers are present.');
667 ho_print_help('command', 'NETMON LEARN <tag>',
668 'Does a /LINKS and learns the servers which are on the network. '.
669 'This means the server list for this network is updated.');
670 ho_print_help('command', 'NETMON LOAD',
671 'Loads the datafile "netmon.data" from disk.');
672 ho_print_help('command', 'NETMON SAVE',
673 'Saves the server data to "netmon.data".');
674 ho_print_help('command', 'NETMON ADD <tag> <server>',
675 'Adds server <server> to the list of servers this script knows for '.
676 '<tag>.');
677 ho_print_help('command', 'NETMON REMOVE <tag> <server>',
678 'Removes server <server> from the serverlist of <tag>.');
679 ho_print_help('command', 'NETMON NAME <tag> <server> <name>',
680 'Sets the short name of <server> in network <tag> to <name>.');
681
682 ho_print_help('section', 'Statusbar item');
683 ho_print_help("The statusbar item for this script is called 'netmon'. ".
684 "You can add that to an existing statusbar by calling ".
685 "'/STATUSBAR <name> add netmon'. Use /STATUSBAR to get a list ".
686 "of existing statusbars.\n");
687
688 ho_print_help('section', 'Settings');
689 ho_print_help('setting', 'ho_netmon_network_tags',
690 'Space separated list of network tags that this script should'.
691 'monitor.');
692 ho_print_help('setting', 'ho_netmon_ignore_servers',
693 'Space separated list of servers that must be ignored. Each server '.
694 'is denoted by <tag>:<server>. Example: e:stats.efnet.info');
695 ho_print_help('setting', 'ho_netmon_sb_max_servers',
696 'If the number of split servers is above this number, the statusbar '.
697 'item does not show a list of their names, but only the amount of '.
698 'servers missing. You can still use /NETMON STATUS to get the '.
699 'list of missing servers.');
700 ho_print_help('setting', 'ho_netmon_verbose',
701 'Print messages when servers join/split and be more verbose.');
702 }
703
704 # ---------------------------------------------------------------------
syntax highlighted by Code2HTML, v. 0.9.1