1 # ho_gline.pl
2 #
3 # $Id: ho_gline.pl,v 1.10 2004/10/02 10:31:31 jvunder REL_0_3 $
4 #
5 # Part of the Hybrid Oper Script Collection.
6 #
7 # Makes it easier to request or support G-lines.
8 #
9
10 # TODO
11 # - Add logging of G-lines to file.
12 # - Add supporting based on the nick of the G-line requester
13
14 use strict;
15 use vars qw($VERSION %IRSSI $SCRIPT_NAME);
16
17 use Irssi;
18 use Irssi::Irc;
19
20 use HOSC::again;
21 use HOSC::again 'HOSC::Base';
22 use HOSC::again 'HOSC::Tools';
23
24 # ---------------------------------------------------------------------
25
26 ($VERSION) = '$Revision: 1.10 $' =~ / (\d+\.\d+) /;
27 $SCRIPT_NAME = 'G-line';
28 %IRSSI = (
29 authors => 'Garion',
30 contact => 'garion@efnet.nl',
31 name => 'ho_gline',
32 description => 'Makes supporting G-lines on EFnet-like servers easier.',
33 license => 'Public Domain',
34 url => 'http://www.garion.org/irssi/hosc.php',
35 changed => '6 August 2004 15:54:32',
36 );
37
38 # Hashref of G-lines. Contains $index => { details } pairs.
39 my $glines;
40
41 # ---------------------------------------------------------------------
42 # A Server Event has occurred. Check if it is a server GLINE NOTICE;
43 # if so, process it.
44
45 sub event_serverevent {
46 my ($server, $msg, $nick, $hostmask) = @_;
47
48 return if $msg !~ /^NOTICE/;
49
50 # If the hostmask is set, it is not a server NOTICE, so we'll ignore it
51 # as well.
52 # TODO: we need to check if the source is indeed OUR server. Problems
53 # appeared when getting a notice from another server.
54 return if length($hostmask) > 0;
55
56 my $ownnick = $server->{nick};
57
58 # G-line request: opernick, operuser, operhost, server, mask, reason
59 if ($msg =~ /(\S+)!([^@]+)@(\S+) on (\S+) is requesting gline for \[(\S+)\] \[(.+)\]/) {
60 clean_glines();
61 process_gline_request(
62 server_obj => $server,
63 server_tag => $server->{tag},
64 nick => $1,
65 user => $2,
66 host => $3,
67 server => $4,
68 glinemask => $5,
69 glinereason => $6,
70 );
71 Irssi::signal_stop()
72 if Irssi::settings_get_bool('ho_gline_suppress_server_notices');
73 }
74
75 # G-line trigger: opernick, operuser, operhost, server, mask, reason
76 if ($msg =~ /(\S+)!(\S+)@(\S+) on (\S+) (?:(?:has triggered)|(?:added)) gline for \[(\S+)\] \[(.+)\]/) {
77 process_gline_trigger(
78 server_obj => $server,
79 server_tag => $server->{tag},
80 nick => $1,
81 user => $2,
82 host => $3,
83 server => $4,
84 glinemask => $5,
85 glinereason => $6,
86 );
87 clean_glines();
88 Irssi::signal_stop()
89 if Irssi::settings_get_bool('ho_gline_suppress_server_notices');
90 }
91
92 # Already voted
93 if ($msg =~ /(serv|op)er or (op|serv)er has already voted/) {
94 process_already_voted(
95 server_obj => $server,
96 server_tag => $server->{tag},
97 );
98 clean_glines();
99 Irssi::signal_stop()
100 if Irssi::settings_get_bool('ho_gline_suppress_server_notices');
101 }
102 }
103
104 # ---------------------------------------------------------------------
105 # G-line request: opernick, operuser, operhost, server, mask, reason
106
107 sub process_gline_request {
108 my %args = @_;
109 my $index;
110
111 my $tag = lc $args{server_tag};
112 my @allowed_tags =
113 split / +/, lc Irssi::settings_get_str('ho_gline_network_tags');
114 return unless grep /^$tag$/, @allowed_tags;
115
116 my $owin_name = Irssi::settings_get_str('ho_gline_output_window');
117 my $owin = Irssi::window_find_name($owin_name);
118
119 $index = find_gline($tag, $args{glinemask});
120 if ($index == -1) {
121 # A new G-line. Create it.
122 $index = gline_add(%args);
123 if ($owin) {
124 $owin->printformat(MSGLEVEL_CRAP, 'ho_gline_request', $index,
125 $tag, $args{nick}, $args{user}, $args{host}, $args{server},
126 $args{glinemask}, $args{glinereason});
127 } else {
128 Irssi::printformat(MSGLEVEL_CRAP, 'ho_gline_request', $index,
129 $tag, $args{nick}, $args{user}, $args{host}, $args{server},
130 $args{glinemask}, $args{glinereason});
131 }
132 } else {
133 # Existing G-line supported.
134 gline_support(%args);
135 if ($owin) {
136 $owin->printformat(MSGLEVEL_CRAP, 'ho_gline_support', $index,
137 $tag, $args{nick}, $args{user}, $args{host}, $args{server});
138 } else {
139 Irssi::printformat(MSGLEVEL_CRAP, 'ho_gline_support', $index,
140 $tag, $args{nick}, $args{user}, $args{host}, $args{server});
141 }
142 }
143 Irssi::signal_stop()
144 if Irssi::settings_get_bool('ho_gline_suppress_server_notices');
145 }
146
147 # ---------------------------------------------------------------------
148 # G-line trigger: opernick, operuser, operhost, server, mask, reason
149
150 sub process_gline_trigger {
151 my %args = @_;
152
153 my $tag = lc $args{server_obj}->{tag};
154 my @allowed_tags =
155 split / +/, lc Irssi::settings_get_str('ho_gline_network_tags');
156 return unless grep /^$tag$/, @allowed_tags;
157
158 my $owin_name = Irssi::settings_get_str('ho_gline_output_window');
159 my $owin = Irssi::window_find_name($owin_name);
160
161 my $index = find_gline($tag, $args{glinemask});
162 if ($index == -1) {
163 ho_print('Ignoring G-line trigger for unknown G-line on '.
164 $args{glinemask});
165 } else {
166 if ($owin) {
167 $owin->printformat(MSGLEVEL_CRAP, 'ho_gline_trigger', $index,
168 $tag, $args{nick}, $args{user}, $args{host}, $args{server});
169 } else {
170 Irssi::printformat(MSGLEVEL_CRAP, 'ho_gline_trigger', $index,
171 $tag, $args{nick}, $args{user}, $args{host}, $args{server});
172 }
173 $glines->{$index}->{triggered} = 1;
174 }
175 Irssi::signal_stop()
176 if Irssi::settings_get_bool('ho_gline_suppress_server_notices');
177 }
178
179 # ---------------------------------------------------------------------
180
181 sub process_already_voted {
182 my %args = @_;
183
184 my $tag = lc $args{server_obj}->{tag};
185 my @allowed_tags =
186 split / +/, lc Irssi::settings_get_str('ho_gline_network_tags');
187 return unless grep $tag, @allowed_tags;
188
189 my $index = find_gline($tag, $args{glinemask});
190 if ($index == -1) {
191 # Ignoring already voted on non-present G-line
192 } else {
193 $glines->{$index}->{alreadyvoted}++;
194 }
195 Irssi::signal_stop()
196 if Irssi::settings_get_bool('ho_gline_suppress_server_notices');
197 }
198
199 # ---------------------------------------------------------------------
200 # Adds a G-line to the list of pending G-lines.
201 # If succesful addition, the location of this new G-line is returned.
202 # If already present, -1 is returned.
203
204 sub gline_add {
205 my %args = @_;
206 my $tag = $args{server_obj}->{tag};
207
208 # Test if this G-line is already present. If so, return -1.
209 my $index = find_gline($tag, $args{glinemask});
210
211 if ($index != -1) {
212 return -1;
213 }
214
215 $index = get_new_index($tag);
216
217 my $gline = {
218 tag => $tag,
219 index => $index,
220 mask => $args{glinemask},
221 reason => $args{glinereason},
222 support => 0,
223 triggered => 0,
224 opernick => $args{nick},
225 operuser => $args{user},
226 operhost => $args{host},
227 operserver => $args{server},
228 votedopers => $args{nick},
229 votedservers => $args{server},
230 voted => 0,
231 alreadyvoted => 0,
232 time => time(),
233 };
234
235 if ($args{server} eq $args{server_obj}->{real_address}) {
236 ho_print("GLINE $tag:$index requested by our server.")
237 if Irssi::settings_get_bool('ho_gline_verbose');
238 $gline->{voted} = 1;
239 }
240 $glines->{$index} = $gline;
241
242 return $index;
243 }
244
245 # ---------------------------------------------------------------------
246
247 sub gline_support {
248 my %args = @_;
249 my $tag = $args{server_obj}->{tag};
250 my $index = find_gline($tag, $args{glinemask});
251
252 return if $index == -1;
253
254 $glines->{$index}->{support}++;
255
256 if ($args{server} eq $args{server_obj}->{real_address}) {
257 ho_print("GLINE $index supported by our server.")
258 if Irssi::settings_get_bool('ho_gline_verbose');
259 $glines->{$index}->{voted} = 1;
260 }
261 }
262
263 # ---------------------------------------------------------------------
264 # Searches the @glines array for a G-line matching $host. If found, the
265 # position in the array is returned. Otherwise, -1 is returned.
266
267 sub find_gline {
268 my ($tag, $mask) = @_;
269
270 for my $index (keys %$glines) {
271 return $index
272 if $glines->{$index}->{mask} eq $mask &&
273 lc $glines->{$index}->{tag} eq lc $tag;
274 }
275
276 return -1;
277 }
278
279 # ---------------------------------------------------------------------
280 # Returns the highest index that's being used for this tag, plus one.
281
282 sub get_new_index {
283 my ($tag) = @_;
284
285 my @keys = sort { $a <=> $b } keys %$glines;
286
287 return (pop @keys) + 1;
288 }
289
290 # ---------------------------------------------------------------------
291 # Removes all Glines that have expired.
292
293 sub clean_glines {
294 my $ptime = Irssi::settings_get_int('ho_gline_pending_remove_time');
295 my $ttime = Irssi::settings_get_int('ho_gline_triggered_remove_time');
296 my $now = time();
297
298 for my $index (keys %$glines) {
299 if (( $glines->{$index}->{triggered} &&
300 $now > $glines->{$index}->{time} + $ttime) ||
301 $now > $glines->{$index}->{time} + $ptime
302 ) {
303 delete $glines->{$index};
304 }
305 }
306 }
307
308 # ---------------------------------------------------------------------
309 # /gline
310 # need:
311 # - show the list
312 # - support a gline
313 # - support multiple glines
314 # - support all glines
315 # - request new gline
316
317 sub cmd_gline {
318 my ($args, $server, $item) = @_;
319
320 clean_glines();
321 if ($args =~ m/^(help)|(status)/i ) {
322 Irssi::command_runsub ('gline', $args, $server, $item);
323 return;
324 }
325
326 if (length $args == 0) {
327 print_usage();
328 } elsif ($args =~ /^[0-9\s]+$/) {
329 my @indices = split /\s+/, $args;
330 cmd_gline_support_index($server, $item, @indices);
331 } elsif ($args =~ /^([0-9]+)-([0-9]+)$/) {
332 my @indices = ($1..$2);
333 ho_print("Supporting G-lines $1 - $2.");
334 cmd_gline_support_index($server, $item, @indices);
335 } elsif ($args =~ /^\s*all\s+(\S+)\s*$/i) {
336 ho_print("Supporting all pending G-lines for tag $1.");
337 cmd_gline_support_all($server, $item, $1);
338 } elsif ($args =~ /^\s*all\s*$/i) {
339 ho_print("Supporting all pending G-lines.");
340 cmd_gline_support_all($server, $item, undef);
341 } elsif ($args =~ /^([^@]+@\S+)\s+(.+)$/) {
342 cmd_gline_place($server, $item, $1, $2);
343 }
344 }
345
346 # ---------------------------------------------------------------------
347
348 sub cmd_gline_help {
349 print_help();
350 }
351
352 # ---------------------------------------------------------------------
353
354 sub cmd_gline_status {
355 clean_glines();
356 print_status();
357 }
358
359 # ---------------------------------------------------------------------
360 # Prints the status info on current G-lines.
361
362 sub print_status {
363 my ($data, $server, $item) = @_;
364
365 my $num_glines = 0;
366 for my $index (keys %$glines) {
367 $num_glines++ unless $glines->{$index}->{triggered};
368 }
369
370 if ($num_glines == 0) {
371 ho_print("No pending G-lines.");
372 return;
373 }
374
375 if ($num_glines == 1) {
376 ho_print("There is 1 pending G-line:");
377 } else {
378 ho_print("There are $num_glines pending G-lines:");
379 }
380
381 for my $index (sort { $a <=> $b } keys %$glines) {
382 print_gline_details($glines->{$index});
383 }
384 }
385
386 # ---------------------------------------------------------------------
387
388 sub print_gline_details {
389 my ($gline) = @_;
390 return if $gline->{triggered};
391
392 Irssi::printformat(MSGLEVEL_CRAP, 'ho_gline_details',
393 $gline->{index}, $gline->{tag},
394 $gline->{opernick}, $gline->{operuser},
395 $gline->{operhost}, $gline->{operserver},
396 $gline->{mask}, $gline->{reason},
397 (time() - $gline->{time}));
398
399 ho_print(" supported by us.") if $gline->{voted};
400 }
401
402 # ---------------------------------------------------------------------
403
404 sub cmd_gline_place {
405 my ($server, $item, $hostmask, $reason) = @_;
406
407 if (!$server) {
408 ho_print("Please use the GLINE command in a window with a ".
409 "server connection.");
410 return;
411 }
412
413 ho_print("Requesting G-line [" . $server->{tag} . "] on $hostmask " .
414 "($reason).");
415 $server->send_raw_now("GLINE $hostmask :$reason");
416 }
417
418 # ---------------------------------------------------------------------
419 # /gline <num>
420
421 sub cmd_gline_support_index {
422 my ($server, $item, @indices) = @_;
423
424 for my $index (@indices) {
425 gline_support_index($index);
426 }
427 }
428
429 # ---------------------------------------------------------------------
430 # Tries to support all G-lines. Network tag is optional. If the network
431 # tag is not given, this function will only work if it has been enabled
432 # for exactly one network tag.
433
434 sub cmd_gline_support_all {
435 my ($server, $item, $support_tag) = @_;
436
437 my @tags = split / +/, lc Irssi::settings_get_str('ho_gline_network_tags');
438 if (@tags == 0) {
439 ho_print("No tags set. Not supporting any G-lines.");
440 return;
441 }
442
443 if (keys %$glines == 0) {
444 ho_print("No pending G-lines.");
445 return;
446 }
447
448 if (@tags > 1) {
449 if (defined $support_tag && !grep /^$support_tag$/i, @tags) {
450 ho_print("Script not enabled for tag $support_tag.");
451 return;
452 }
453
454 my %pending_tags;
455 for my $index (keys %$glines) {
456 $pending_tags{ $glines->{$index}->{tag} } = 1;
457 }
458 my $num_tags = keys %pending_tags;
459 if (!defined $support_tag && $num_tags > 1) {
460 ho_print("There are pending G-lines for $num_tags network tags. " .
461 "Please specify the tag with /gline all <tag>.");
462 return;
463 } else {
464 $support_tag = (keys %pending_tags)[0];
465 }
466 } else {
467 if (defined $support_tag) {
468 if ($support_tag ne $tags[0]) {
469 ho_print("Script not enabled for tag $support_tag.");
470 return;
471 }
472 } else {
473 $support_tag = $tags[0];
474 }
475 }
476
477 my @indices;
478 for my $index (sort { $a <=> $b } keys %$glines) {
479 push @indices, $index
480 if lc $glines->{$index}->{tag} eq lc $support_tag;
481 }
482 if (@indices) {
483 ho_print("Supporting all G-lines (" . scalar @indices . ") for ".
484 $support_tag . ".");
485 cmd_gline_support_index($server, $item, @indices);
486 } else {
487 ho_print("No pending G-lines for $support_tag.");
488 }
489 }
490
491
492 sub gline_support_index {
493 my ($data) = @_;
494
495 unless (defined $glines->{$data}) {
496 ho_print_error("No such G-line $data.");
497 return;
498 }
499
500 if ($glines->{$data}->{voted}) {
501 ho_print("We have already voted on G-line $data.");
502 return;
503 }
504
505 my $mask = $glines->{$data}->{mask};
506 if (length $mask == 0) {
507 ho_print_error("G-line mask of $data is empty!");
508 return;
509 }
510
511 my $reason = $glines->{$data}->{reason};
512 if (length $reason == 0) {
513 ho_print_error("G-line reason of $data is empty!");
514 return;
515 }
516
517 my $gserver = Irssi::server_find_tag($glines->{$data}->{tag});
518 unless (defined $gserver) {
519 ho_print_error("No server found with tag " . $glines->{$data}->{tag} .
520 "for G-line $data.");
521 return;
522 }
523
524 # Issue the support
525 ho_print("Supporting G-line $data.")
526 if Irssi::settings_get_bool('ho_gline_verbose');
527 $gserver->send_raw_now("GLINE $mask :$reason");
528 }
529
530 # ---------------------------------------------------------------------
531
532 ho_print_init_begin();
533
534 Irssi::signal_add_first('server event', 'event_serverevent');
535
536 Irssi::command_bind('gline', 'cmd_gline');
537 Irssi::command_bind('gline help', 'cmd_gline_help');
538 Irssi::command_bind('gline status', 'cmd_gline_status');
539
540 Irssi::settings_add_bool('ho', 'ho_gline_suppress_server_notices', 0);
541 Irssi::settings_add_int('ho', 'ho_gline_pending_remove_time', 3600);
542 Irssi::settings_add_int('ho', 'ho_gline_triggered_remove_time', 300);
543
544 Irssi::settings_add_str('ho', 'ho_gline_network_tags', '');
545 Irssi::settings_add_bool('ho', 'ho_gline_verbose', 0);
546
547 Irssi::settings_add_str('ho', 'ho_gline_output_window', '');
548
549 Irssi::theme_register([
550 # num, tag, nick, user, host, server, mask, reason
551 'ho_gline_request',
552 '%Cho%n %CGREQ%n %Y$0%n %c$1%n %_$2%_ ($3@$4) [$5] %_$6%_ $7',
553
554 # num, tag, nick, user, host, server
555 'ho_gline_support',
556 '%Cho%n %cGSUP%n %Y$0%n %c$1%n $2 ($3@$4) [$5]',
557
558 # num, tag, nick, user, host, server
559 'ho_gline_trigger',
560 '%Cho%n %CGTRG%n %Y$0%n %c$1%n $2 ($3@$4) [$5]',
561
562 # num, tag, nick, user, host, server, mask, reason, secs_ago
563 'ho_gline_details',
564 '%Cho%n %cPEND%n %Y$0%n %c$1%n [$8 secs ago] %_$2%_ ($3@$4) [$5] %_$6%_ $7',
565 ]);
566
567 ho_print_init_end();
568 ho_print("Use /GLINE for help.");
569 if (length Irssi::settings_get_str('ho_gline_network_tags') == 0) {
570 ho_print('You have no networks set for this script. Please set them '.
571 'via the ho_gline_network_tags setting, or see /GLINE HELP for help.');
572 }
573 my $owin_name = Irssi::settings_get_str('ho_gline_output_window');
574 my $owin = Irssi::window_find_name($owin_name);
575 if (defined $owin) {
576 ho_print("Sending GLINE messages to window '$owin_name'.");
577 } else {
578 ho_print_warning("Window named '$owin_name' not found. Not sending " .
579 "GLINE mesages there.");
580 }
581 # ---------------------------------------------------------------------
582
583 sub print_help {
584 ho_print_help('head', $SCRIPT_NAME);
585
586 ho_print_help('section', 'Syntax');
587 print_usage();
588
589 ho_print_help('section', 'Description');
590 ho_print_help('This script makes it easier to support G-lines, both ' .
591 'single ones and multiple at the same time.');
592 ho_print_help('Each G-line that is requested is stored under a '.
593 'unique identifier, an integer number. The standard way to support '.
594 'that G-line is to call /GLINE with as only argument the number '.
595 'of the G-line.');
596 ho_print_help('As soon as a G-line is triggered, it is removed from ' .
597 'the pending G-line list.');
598 ho_print_help('To support multiple G-lines, you can use one of the ' .
599 'following commands:');
600 ho_print_help('/GLINE 1 4 5 - supports G-lines 1, 4 and 5.');
601 ho_print_help('/GLINE 2-6 - supports all G-lines from 2 to 6.');
602 ho_print_help('/GLINE ALL efnet - supports all G-lines of tag "efnet".');
603 ho_print_help(' ');
604
605 ho_print_help('section', 'Settings');
606 ho_print_help('setting', 'ho_gline_network_tags',
607 'A space separated list of network tags that this script should '.
608 'facilitate G-lines on.');
609 ho_print_help('setting', 'ho_gline_output_window',
610 'The name of the output window of the request and trigger messages.');
611 }
612
613 sub print_usage {
614 ho_print_help('syntax', '/GLINE help');
615 ho_print_help('syntax', '/GLINE status');
616 ho_print_help('syntax', '/GLINE <index> [<index> ...]');
617 ho_print_help('syntax', '/GLINE <firstindex>-<lastindex>');
618 ho_print_help('syntax', '/GLINE <user@host> <reason>');
619 }
620
621 # ---------------------------------------------------------------------
syntax highlighted by Code2HTML, v. 0.9.1