html/people.pl
1 use strict;
2 use 5.005_62; # for 'our'
3 use Irssi 20020428; # for Irssi::signal_continue
4 use Time::HiRes;
5 use vars qw($VERSION %IRSSI);
6
7 our $has_crypt = 0;
8 eval {require Crypt::PasswdMD5};
9 unless ($@) {
10 $has_crypt = 1;
11 import Crypt::PasswdMD5;
12 }
13
14 $VERSION = "1.7";
15 %IRSSI =
16 (
17 authors => "Marcin 'Qrczak' Kowalczyk, Johan 'ion' Kiviniemi",
18 contact => 'qrczak@knm.org.pl',
19 name => 'People',
20 description => 'Userlist with autoopping, autokicking etc.',
21 license => 'GNU GPL',
22 url => 'http://qrnik.knm.org.pl/~qrczak/irc/people.pl',
23 url_ion => 'http://johan.kiviniemi.name/stuff/irssi/people.pl',
24 );
25
26 ######## STATE ########
27
28 our %handles;
29 our %user_masks;
30 our %user_flags;
31 our %channel_flags;
32 our %user_channel_flags;
33 our %authenticated = ();
34 our %expire_auth = ();
35
36 our $config = Irssi::get_irssi_dir . "/people.cfg";
37 our $config_tmp = Irssi::get_irssi_dir . "/people.tmp";
38 our $config_old = Irssi::get_irssi_dir . "/people.cfg~";
39
40 Irssi::settings_add_bool 'people', 'people_autosave', 1;
41 Irssi::settings_add_int 'people', 'people_op_delay_min', 10;
42 Irssi::settings_add_int 'people', 'people_op_delay_max', 20;
43 Irssi::settings_add_str 'people', 'people_default_chatnet', "DALnet";
44 Irssi::settings_add_bool 'people', 'people_color_friends', 0;
45 Irssi::settings_add_bool 'people', 'people_color_everybody', 0;
46 Irssi::settings_add_int 'people', 'people_expire_password', 60;
47 Irssi::settings_add_bool 'people', 'people_channel_notice', 1;
48 Irssi::settings_add_str 'people', 'people_colors', "rgybmcRGYBMC";
49
50 our $handle_re = qr/([^\0- &#+!,\-\177][^\0- ,\177]*)/;
51 our $mask_re = qr/([^\0- \177]+)/;
52 our $masks_re = qr/([^\0- \177]+(?: +[^\0- \177]+)*)/;
53 our $opt_masks_re = qr/((?: +[^\0- \177]+)*)/;
54 our $chatnet_re = qr/([\w-._]+)/;
55 our $channel_re = qr/([&#+!][^\0- ,\177]*)/;
56 our $channels_re = qr/([&#+!][^\0- ,\177]*(?:,[&#+!][^\0- ,\177]*)*)/;
57 our $mask_re = qr/([^\0- \177]+)/;
58 our $flags_re = qr/((?:[+\-!][a-zA-Z]+)+)/;
59 our $arg_re = qr/(?: (.*))?/;
60 our $nick_re = qr/([A-}][\-0-9A-}]*)/;
61 our $nicks_re = qr/([A-}][\-0-9A-}]*(?: +[A-}][\-0-9A-}]*)*)/;
62 our $nicks_commas_re = qr/([A-}][\-0-9A-}]*(?:,[A-}][\-0-9A-}]*)*)/;
63
64 our $master_set_flags = 'deikmopqrvx';
65 our $master_see_flags = 'deiklmopqrvx';
66 our $all_flags = 'cdeiklmnopqrvx';
67
68 sub tr_flag {
69 my ($flag) = @_;
70 $flag =~ tr/CIL/cil/;
71 return $flag;
72 }
73
74 our %master_set_flags = map {$_ => 1} split //, $master_set_flags;
75 our %master_see_flags = map {$_ => 1} split //, $master_see_flags;
76 our %all_flags = map {$_ => 1} split //, $all_flags;
77
78 ######## HELP ########
79
80 our $help_commands =
81
82 our %help = (
83 people => [
84 'When I meet people, they are recognized based on their nick and',
85 'address, and actions can be automatically performed upon them',
86 '(such as opping or kicking).',
87 '',
88 'Actions depend on flags associated with the user in the channel.',
89 'Flags can be specified globally for a user, for everybody in',
90 'a channel, or locally for a user in a channel. A flag setting',
91 'can be positive or negative. If conflicting settings are present',
92 'for a flag, local setting is more important than channel setting',
93 'which is more important than global setting.',
94 '',
95 'A user handle has a set of nick & address masks used to recognize',
96 'that person. If someone matches masks of several users, all their',
97 'flags are considered together, resolving conflicts in favor of',
98 'more specific masks.',
99 '',
100 'Commands which modify the user list may be given locally',
101 'by the owner of the script (e.g. /flag someone +o) or',
102 'remotely by someone with enough privileges, either by msg',
103 '(e.g. /msg Qrczak !flag someone +o), or ctcp',
104 '(e.g. /ctcp Qrczak flag someone +o).',
105 '',
106 'Commands which manage the user list can be used only by people',
107 'with the master status (+m). A local master can manage only',
108 'local users (+l) who don\'t have any flags outside his channels.',
109 'Commands which perform actions in channels can be used only',
110 'by people with the operator status (+o).',
111 '',
112 'You can use "help <command>" to learn details about the command.',
113 'Available commands: help, user add, user remove, mask add,',
114 'mask remove, user rename, user list, flag, find, trust, op, deop,',
115 'voice, devoice, kick, ban, unban, kickban, invite.',
116 ],
117 help => [
118 'HELP [<command>]',
119 '',
120 'Show details about the command, or introduction to the script',
121 'if no argument is given.',
122 ],
123 'user add' => [
124 'USER ADD <handle> <mask>...',
125 '',
126 'Add a user, recognized by address masks (nick!user@host or',
127 'user@host or host). <handle> is a user name for internal use by',
128 'the script. If <masks> are omitted and a user with nick <handle>',
129 'is on a channel with the owner of the script, try to guess the',
130 'mask basing on his address: replace the first part of host with *',
131 'if it contains any digits, or replace the last part of IP address',
132 'with * if the address is a numeric IP. You must be a master (+m)',
133 'somewhere to use this command.',
134 ],
135 'user remove' => [
136 'USER REMOVE <handle>',
137 '',
138 'Remove all information about the user <handle>.',
139 ],
140 'mask add' => [
141 'MASK ADD <handle> <mask>...',
142 '',
143 'Add more address masks to recognize user <handle>.',
144 ],
145 'mask remove' => [
146 'MASK REMOVE <handle> <mask>...',
147 '',
148 'Remove some address masks used to recognize user <handle>.',
149 ],
150 'user rename' => [
151 'USER RENAME <handle> <new-handle>',
152 '',
153 'Use a new internal name <new-handle> for the user <handle>.',
154 ],
155 'user list' => [
156 'USER LIST [[<chatnet>/]<#channels>] [+<flags>]',
157 'USER LIST text...',
158 '',
159 'List all users, or users having any flags in the specified',
160 'channels, or users having any of the specified flags somewhere,',
161 'or users having any of the specified flags in the channels,',
162 'or users having any of the specified texts in handle, address',
163 'masks or flag arguments.',
164 ],
165 flag => [
166 'FLAG <handle>',
167 'FLAG [<chatnet>/]<#channels>',
168 'FLAG <handle> <flags>',
169 'FLAG [<chatnet>/]<#channels> <flags>',
170 'FLAG <handle> [<chatnet>/]<#channels> <flags>',
171 '',
172 'Without flags given, show flags of the user or channel.',
173 'Otherwise add or remove flags globally for a user, for',
174 'everybody in a channel, or locally for a user in a channel.',
175 '',
176 '<flags> is +<letters> (add these flags), -<letters> (remove',
177 'these flags, or set them as a negative exception if the flag',
178 'would othwerise come from global or channel setting), !<letters>',
179 '(set these flags as a negative exception) or a combination of',
180 'such settings. If the last flag is being added, it may be followed',
181 'by space and <argument> for that flag whose meaning depends on',
182 'the flag.',
183 '',
184 'Meanings of flags:',
185 '',
186 '+c - Color nick on public messages. This flag is meaningful',
187 ' only for the owner of the script. The color will be',
188 ' computed from the handle. If people_color_friends variable',
189 ' is set, nicks of all recognized people will be colored.',
190 ' If people_color_everybody variable is set, every nick',
191 ' will be colored, basing on the nick if the person is not',
192 ' recognized. The color may be also specified explicitly in',
193 ' the argument of +c:',
194 ' %k - black, %r - red, %g - green, %y - yellow or brown,',
195 ' %b - blue, %m - magenta, %c - cyan, %w - white,',
196 ' %K %R %G %Y %B %M %C %W - bright variants of these colors.',
197 '',
198 '+d - Deop if he gets op, except when opped by you or by a',
199 ' master (+m). When flags conflict, +o and +r override +d.',
200 '',
201 '+e - Execute command given as the argument. $C is replaced with',
202 ' the channel the person entered, $N - nick, $A - address.',
203 '',
204 '+i - A comment or information which reminds why the person is',
205 ' interesting can be stored in the argument of +i. It has',
206 ' no real effect. It\'s only shown with notification (+n).',
207 '',
208 '+k - Ban and kick out. The ban mask will be the mask used to',
209 ' recognize him, or based on his address if +k came from',
210 ' channel flags (replace the first part of host with * if it',
211 ' contains any digits, or replace the last part of IP address',
212 ' with * if the address is a numeric IP). The kick reason may',
213 ' be specified in the argument of the +k flag. When flags',
214 ' conflict, +o and +r override +k.',
215 '',
216 '+l - Local user. Can have address masks changed by a local master',
217 ' if the user doesn\'t have any flags outside the master\'s',
218 ' channels.',
219 '',
220 '+m - Master. Can manage the user list, or a local part of it if',
221 ' only a local master. His actions on other users (opping and',
222 ' deopping) will not be questioned by +r and +d of these users.',
223 '',
224 '+n - Notify you when the user joins or leaves channels. This flag',
225 ' is meaningful only for the owner of the script.',
226 '',
227 '+o - Op, after a short random delay to avoid op flood when he',
228 ' would be opped by others anyway.',
229 '',
230 '+p - Password is needed to recognize that person. This flag',
231 ' should be used when address masks are not secure, i.e.',
232 ' unwanted people can have the same addresses. When +p has',
233 ' no argument, the person doesn\'t have the password set',
234 ' yet and should use the PASS command to set it. Once set,',
235 ' the password is stored encrypted in the argument of +p',
236 ' and the person must use the PASS command to be recognized.',
237 ' The people_expire_password variable tells how many seconds',
238 ' to remember the authorization if the person is not seen',
239 ' on any channels.',
240 '',
241 '+q - Devoice if he gets voiced, except when voiced by you or',
242 ' by a master (+m).',
243 '',
244 '+r - Reop if somebody deops him, except when deopped by you,',
245 ' by himself, or by a master (+m).',
246 '',
247 '+v - Voice, after a short random delay to avoid voice flood',
248 ' when he would be voiced or opped by others anyway.',
249 '',
250 '+x - Disable all other flags, except perhaps notification (+n).',
251 ],
252 find => [
253 'FIND',
254 'FIND [<chatnet>/]<#channel>',
255 'FIND <mask>',
256 'FIND <nick>',
257 '',
258 'Find recognized users on all channels (only owner can do this),',
259 'or on the channel, or matching the mask, or having the nick if',
260 'present on a channel with me.',
261 ],
262 trust => [
263 'TRUST [<nick>]...',
264 '',
265 'Set these nicks as authenticated.',
266 ],
267 op => [
268 'OP <#channel> [<nick>]...',
269 '',
270 'Op these nicks in the channel. If nicks are not given, ops you.',
271 ],
272 deop => [
273 'DEOP <#channel> [<nick>]...',
274 '',
275 'Deop these nicks in the channel. If nicks are not given,',
276 'deops you.',
277 ],
278 voice => [
279 'VOICE <#channel> [<nick>]...',
280 '',
281 'Voices these nicks in the channel. If nicks are not given,',
282 'voices you.',
283 ],
284 devoice => [
285 'DEVOICE <#channel> [<nick>]...',
286 '',
287 'Devoices these nicks in the channel. If nicks are not given,',
288 'devoices you.',
289 ],
290 kick => [
291 'KICK <#channel> <nicks> [<reason>]',
292 '',
293 'Kick these nicks out of the channel.',
294 ],
295 ban => [
296 'BAN <#channel> <mask/nick>...',
297 '',
298 'Ban address masks from the channel. If a nick of a person',
299 'sitting there is given, the mask is derived from his address.',
300 ],
301 unban => [
302 'UNBAN <#channel> [<masks>]',
303 '',
304 'Remove some bans from the channel. If no masks are given,',
305 'remove all bans against you.',
306
307 ],
308 kickban => [
309 'KICKBAN <#channel> <nicks> [<reason>]',
310 '',
311 'Ban and kick out people from the channel. The mask to ban',
312 'is derived from their addresses.',
313 ],
314 invite => [
315 'INVITE <#channel> [<nick>]',
316 '',
317 'Invite the person to the channel. If the nick is not given,',
318 'invite you.',
319 ],
320 pass => [
321 'PASS <password>',
322 'PASS <password> <new-password>',
323 '',
324 'Authenticate with the password to ensure the owner that you',
325 'are the right person (if you have the +p flag), or set the',
326 'password if it wasn\'t set yet. To change the password once',
327 'it was set, give both old and new passwords.',
328 ]
329 );
330
331 our %local_help = (people => 1);
332
333 sub cmd_help($$) {
334 my ($context, $args) = @_;
335 my $command = join(' ', split(' ', lc $args));
336 $command = 'people' if !$context->{owner} && $command eq '';
337 my $text = $help{$command};
338 if (!$text || $context->{owner} && !$local_help{$command}) {
339 $context->{error}("No help for $command") unless $context->{owner};
340 return;
341 }
342 foreach my $line ('', @$text, '') {
343 $context->{crap}($line eq '' ? ' ' : $line);
344 }
345 Irssi::signal_stop if $context->{owner};
346 }
347
348 ######## A REGEXP OF ALL MASKS TO IMPROVE PERFORMANCE ########
349
350 our %mask_to_regexp = ();
351 foreach my $i (0..255) {
352 my $ch = chr $i;
353 $mask_to_regexp{$ch} = "\Q$ch\E";
354 }
355 $mask_to_regexp{'?'} = '.';
356 $mask_to_regexp{'*'} = '.*';
357
358 sub mask_to_regexp($) {
359 my ($mask) = @_;
360 $mask =~ s/(.)/$mask_to_regexp{$1}/g;
361 return $mask;
362 }
363
364 our $all_masks;
365
366 sub update_all_masks() {
367 my @masks = ();
368 foreach my $hdl (keys %handles) {
369 push @masks, @{$user_masks{$hdl}};
370 }
371 $all_masks = join('|', map {mask_to_regexp $_} @masks);
372 $all_masks = qr/^(?:$all_masks)$/i;
373 }
374
375 ######## CONTEXT OF COMMANDS: LOCAL OR REPLYING TO MESSAGES ########
376
377 our $local_context = {
378 crap => sub {my ($msg) = @_; $msg =~ s/%/%%/g; print CLIENTCRAP $msg},
379 notice => sub {my ($msg) = @_; $msg =~ s/%/%%/g; print CLIENTNOTICE $msg},
380 error => sub {my ($msg) = @_; $msg =~ s/%/%%/g; print CLIENTERROR $msg},
381 usage => sub {my ($msg) = @_; $msg =~ s/%/%%/g; print CLIENTERROR "Usage: /$msg"},
382 usage_next => sub {my ($msg) = @_; $msg =~ s/%/%%/g; print CLIENTERROR " /$msg"},
383 owner => 1,
384 set_flags => \%all_flags,
385 set_flags_str => $all_flags,
386 see_flags => \%all_flags,
387 server => undef,
388 };
389
390 ######## CHECK PRIVILEGES TO PERFORM COMMANDS ########
391
392 sub has_global_flag($$) {
393 my ($context, $flag) = @_;
394 return $context->{owner} || defined $context->{globals}{$flag};
395 }
396
397 sub has_local_flag($$$$) {
398 my ($context, $chatnet, $channel, $flag) = @_;
399 return 1 if $context->{owner};
400 return
401 exists $context->{locals}{$chatnet}{$channel}{$flag} ?
402 defined $context->{locals}{$chatnet}{$channel}{$flag} :
403 exists $channel_flags{$chatnet}{$channel}{$flag} ?
404 defined $channel_flags{$chatnet}{$channel}{$flag} :
405 defined $context->{globals}{$flag};
406 }
407
408 sub has_flag_somewhere($$) {
409 my ($context, $flag) = @_;
410 return 1 if $context->{owner} || defined $context->{globals}{$flag};
411 my $locals = $context->{locals};
412 foreach my $chatnet (keys %$locals) {
413 my $channels = $locals->{$chatnet};
414 foreach my $channel (keys %$channels) {
415 my $flags = $channels->{$channel};
416 return 1 if defined $flags->{$flag};
417 }
418 }
419 return 0;
420 }
421
422 sub must_be_master($) {
423 my ($context) = @_;
424 return 1 if has_flag_somewhere($context, 'm');
425 $context->{error}("Sorry, you don't have master privileges.");
426 return 0;
427 }
428
429 sub must_be_operator($) {
430 my ($context) = @_;
431 return 1 if has_flag_somewhere($context, 'o') ||
432 has_flag_somewhere($context, 'm');
433 $context->{error}("Sorry, you don't have operator privileges.");
434 return 0;
435 }
436
437 sub may_manage($$) {
438 my ($context, $hdl) = @_;
439 return 1 if has_global_flag($context, 'm');
440 unless (defined $user_flags{$hdl}{l}) {
441 $context->{error}("Sorry, \cc04$handles{$hdl}\co isn't local to your channels.");
442 return 0;
443 }
444 my $locals = $user_channel_flags{$hdl};
445 foreach my $chatnet (keys %$locals) {
446 my $channels = $locals->{$chatnet};
447 foreach my $channel (keys %$channels) {
448 my $flags = $channels->{$channel};
449 foreach my $flag (keys %$flags) {
450 next unless defined $flags->{$flag};
451 unless (defined $context->{locals}{$chatnet}{$channel}{m}) {
452 $context->{error}("Sorry, \cc04$handles{$hdl}\co has flags outside your channels.");
453 return 0;
454 }
455 }
456 }
457 }
458 return 1;
459 }
460
461 ######## FIND USERS AND FLAGS ########
462
463 sub more_specific($$) {
464 my ($user1, $user2) = @_;
465 return 0 unless $user1 && $user2;
466 my $mask1 = $user1->[1];
467 my $mask2 = $user2->[1];
468 return 0 if $mask1 eq $mask2;
469 $mask1 =~ /^(.*)!(.*)$/ or return 0;
470 my ($nick1, $address1) = ($1, $2);
471 $mask2 =~ /^(.*)!(.*)$/ or return 0;
472 my ($nick2, $address2) = ($1, $2);
473 return 0 if Irssi::mask_match_address($mask1, $nick2, $address2);
474 return 1 if Irssi::mask_match_address($mask2, $nick1, $address1);
475 return 0 if Irssi::mask_match_address($address1, $address2, undef);
476 return 1 if Irssi::mask_match_address($address2, $address1, undef);
477 $address1 =~ s/^.*\@/*\@/;
478 $address2 =~ s/^.*\@/*\@/;
479 return 0 if Irssi::mask_match_address($address1, $address2, undef);
480 return 1 if Irssi::mask_match_address($address2, $address1, undef);
481 return 0;
482 }
483
484 sub find_users($$$) {
485 my ($chatnet, $nick, $address) = @_;
486 return () unless "$nick!$address" =~ $all_masks;
487 my @users = ();
488 foreach my $hdl (keys %user_masks) {
489 next if defined $chatnet &&
490 defined $user_flags{$hdl}{p} &&
491 !$authenticated{$chatnet}{$address}{$hdl};
492 my $masks = $user_masks{$hdl};
493 foreach my $mask (@$masks) {
494 if (Irssi::mask_match_address($mask, $nick, $address)) {
495 push @users, [$hdl, $mask];
496 }
497 }
498 }
499 return @users;
500 }
501
502 sub find_best_user($$$) {
503 my ($chatnet, $nick, $address) = @_;
504 my $best = undef;
505 foreach my $user (find_users $chatnet, $nick, $address) {
506 $best = $user unless more_specific($best, $user);
507 }
508 return $best ? @$best : ();
509 }
510
511 sub add_flag($$$$$) {
512 my ($flags, $users, $flag, $arg, $user) = @_;
513 return if
514 exists $flags->{$flag} &&
515 more_specific($users->{$flag}, $user);
516 $flags->{$flag} = $arg;
517 $users->{$flag} = $user;
518 }
519
520 sub find_global_flags($$$) {
521 my ($chatnet, $nick, $address) = @_;
522 my $flags = {}; my $users = {};
523 foreach my $user (find_users $chatnet, $nick, $address) {
524 my ($hdl, $mask) = @$user;
525 my $globals = $user_flags{$hdl};
526 foreach my $flag (keys %$globals) {
527 my $arg = $globals->{$flag};
528 add_flag $flags, $users, $flag, $arg, $user;
529 }
530 add_flag $flags, $users, '', '', $user;
531 }
532 return ($flags, $users);
533 }
534
535 sub find_local_flags($$$$) {
536 my ($chatnet, $channel, $nick, $address) = @_;
537 my @users = find_users $chatnet, $nick, $address;
538 my $flags = {}; my $users = {};
539 foreach my $user (@users) {
540 my ($hdl, $mask) = @$user;
541 my $globals = $user_flags{$hdl};
542 foreach my $flag (keys %$globals) {
543 my $arg = $globals->{$flag};
544 add_flag $flags, $users, $flag, $arg, $user;
545 }
546 add_flag $flags, $users, '', '', $user;
547 }
548 my $chan_flags = $channel_flags{$chatnet}{$channel};
549 foreach my $flag (keys %$chan_flags) {
550 my $arg = $chan_flags->{$flag};
551 add_flag $flags, $users, $flag, $arg, undef;
552 }
553 foreach my $user (@users) {
554 my ($hdl, $mask) = @$user;
555 my $locals = $user_channel_flags{$hdl}{$chatnet}{$channel};
556 foreach my $flag (keys %$locals) {
557 my $arg = $locals->{$flag};
558 add_flag $flags, $users, $flag, $arg, $user;
559 }
560 }
561 return ($flags, $users);
562 }
563
564 sub find_local_flags_if_matches($$$$$) {
565 my ($hdl, $chatnet, $channel, $nick, $address) = @_;
566 my $user = undef;
567 foreach my $mask (@{$user_masks{$hdl}}) {
568 if (Irssi::mask_match_address($mask, $nick, $address)) {
569 $user = [$hdl, $mask]; last;
570 }
571 }
572 return ({}, {}) unless $user;
573 my $flags = {}; my $users = {};
574 my $globals = $user_flags{$hdl};
575 foreach my $flag (keys %$globals) {
576 my $arg = $globals->{$flag};
577 add_flag $flags, $users, $flag, $arg, $user;
578 }
579 add_flag $flags, $users, '', '', $user;
580 my $chan_flags = $channel_flags{$chatnet}{$channel};
581 foreach my $flag (keys %$chan_flags) {
582 my $arg = $chan_flags->{$flag};
583 add_flag $flags, $users, $flag, $arg, undef;
584 }
585 my $locals = $user_channel_flags{$hdl}{$chatnet}{$channel};
586 foreach my $flag (keys %$locals) {
587 my $arg = $locals->{$flag};
588 add_flag $flags, $users, $flag, $arg, $user;
589 }
590 return ($flags, $users);
591 }
592
593 sub find_all_flags($$$) {
594 my ($chatnet, $nick, $address) = @_;
595 my $globals = {}; my $global_users = {};
596 my $locals = {}; my $local_users = {};
597 foreach my $user (find_users $chatnet, $nick, $address) {
598 my ($hdl, $mask) = @$user;
599 my $flags = $user_flags{$hdl};
600 foreach my $flag (keys %$flags) {
601 my $arg = $flags->{$flag};
602 add_flag $globals, $global_users, $flag, $arg, $user;
603 }
604 my $chatnets = $user_channel_flags{$hdl};
605 foreach my $chatnet (keys %$chatnets) {
606 my $channels = $chatnets->{$chatnet};
607 foreach my $channel (keys %$channels) {
608 my $flags = $channels->{$channel};
609 foreach my $flag (keys %$flags) {
610 my $arg = $flags->{$flag};
611 add_flag
612 \%{$locals->{$chatnet}{$channel}},
613 \%{$local_users->{$chatnet}{$channel}},
614 $flag, $arg, $user;
615 }
616 }
617 }
618 }
619 return ($globals, $locals);
620 }
621
622 ######## SHOW USERLIST ########
623
624 sub handle_exists($$) {
625 my ($context, $handle) = @_;
626 unless (defined $handles{lc $handle}) {
627 $context->{error}("User \cc04$handle\co doesn't exist.");
628 return 0;
629 }
630 return 1;
631 }
632
633 sub filter_flags($$) {
634 my ($flags, $filter) = @_;
635 my %filtered = ();
636 foreach my $flag (keys %$flags) {
637 $filtered{$flag} = $flags->{$flag} if $filter->{$flag};
638 }
639 return \%filtered;
640 }
641
642 sub show_flags($) {
643 my ($flags) = @_;
644 return "(none)" unless $flags && %$flags;
645 my @on = ();
646 my @off = ();
647 foreach my $flag (sort keys %$flags) {
648 push @{defined $flags->{$flag} ? \@on : \@off}, $flag;
649 }
650 return
651 "\cc9" .
652 (@off ? "-" . join('', @off) : '') .
653 (@on ? '+' .
654 join('', grep {$flags->{$_} eq ''} @on) .
655 join('', map {"$_\cc3($flags->{$_})\cc9"} grep {$flags->{$_} ne ''} @on) :
656 '') .
657 "\co";
658 }
659
660 sub show_handle($$) {
661 my ($context, $hdl) = @_;
662 handle_exists $context, $hdl or return;
663 my $globals = $user_flags{$hdl} || {};
664 $globals = filter_flags $globals, $context->{see_flags}
665 unless $context->{owner};
666 my @locals = ();
667 my $chatnets = $user_channel_flags{$hdl};
668 foreach my $chatnet (sort keys %$chatnets) {
669 my $channels = $chatnets->{$chatnet};
670 foreach my $channel (sort keys %$channels) {
671 my $flags = $channels->{$channel} || {};
672 $flags = filter_flags $flags, $context->{see_flags}
673 unless $context->{owner};
674 push @locals, [$chatnet, $channel, $flags] if %$flags;
675 }
676 }
677 my @masks = @{$user_masks{$hdl}};
678 if (@masks) {
679 my $plural = @masks == 1 ? "" : "s";
680 $context->{crap}("\cc04$handles{$hdl}\co is \cc10@masks\co");
681 } else {
682 $context->{crap}("\cc04$handles{$hdl}\co exists but has no address masks");
683 }
684 my @flags = %$globals ? (show_flags($globals)) : ();
685 foreach my $local (@locals) {
686 my ($chatnet, $channel, $flags) = @$local;
687 push @flags, "\cb$chatnet/$channel\cb " . show_flags($flags)
688 if has_local_flag($context, $chatnet, $channel, 'm');
689 }
690 @flags = ("(none)") unless @flags;
691 $context->{crap}(" flags: " . join("; ", @flags));
692 }
693
694 sub show_channel($$$$) {
695 my ($context, $chatnet, $channel, $show_empty) = @_;
696 my $flags = $channel_flags{$chatnet}{$channel} || {};
697 $flags = filter_flags $flags, $context->{see_flags}
698 unless $context->{owner};
699 return unless $show_empty || %$flags;
700 $context->{crap}("Flags of \cb$chatnet/$channel\cb are " . show_flags($flags));
701 }
702
703 sub filter_handle($$$$$) {
704 my ($context, $hdl,
705 $filter_channels, $filter_flags, $filter_text) = @_;
706 return 1 unless $filter_channels || $filter_flags || $filter_text;
707 my $globals = $user_flags{$hdl};
708 my $locals = $user_channel_flags{$hdl};
709 if ($filter_text) {
710 foreach my $re (@$filter_text) {
711 return 1 if $hdl =~ $re;
712 my $masks = $user_masks{$hdl};
713 foreach my $mask (@$masks) {
714 return 1 if $mask =~ $re;
715 }
716 foreach my $flag (keys %$globals) {
717 return 1 if $globals->{$flag} =~ $re;
718 }
719 foreach my $chatnet (keys %$locals) {
720 my $channels = $locals->{$chatnet};
721 foreach my $channel (keys %$channels) {
722 my $flags = $channels->{$channel};
723 foreach my $flag (keys %$flags) {
724 return 1 if defined $flags->{$flag} && $flags->{$flag} =~ $re;
725 }
726 }
727 }
728 }
729 return 0;
730 }
731 if ($filter_flags) {
732 foreach my $flag (@$filter_flags) {
733 next unless $context->{owner} || $context->{see_flags}{$flag};
734 return 1 if defined $globals->{$flag};
735 foreach my $chatnet (keys %$locals) {
736 my $channels = $locals->{$chatnet};
737 foreach my $channel (keys %$channels) {
738 next unless has_local_flag($context, $chatnet, $channel, 'm') &&
739 (!$filter_channels || $filter_channels->{$chatnet}{$channel});
740 my $flags = $channels->{$channel};
741 return 1 if exists $flags->{$flag};
742 }
743 }
744 }
745 return 0;
746 } else {
747 return 1 if $globals && %$globals;
748 foreach my $chatnet (keys %$locals) {
749 my $channels = $locals->{$chatnet};
750 foreach my $channel (keys %$channels) {
751 next unless has_local_flag($context, $chatnet, $channel, 'm') &&
752 $filter_channels->{$chatnet}{$channel};
753 my $flags = $channels->{$channel};
754 return 1 if %$flags;
755 }
756 }
757 return 0;
758 }
759 }
760
761 sub filter_channel($$$$$$) {
762 my ($context, $chatnet, $channel,
763 $filter_channels, $filter_flags, $filter_text) = @_;
764 return 0 unless has_local_flag($context, $chatnet, $channel, 'm');
765 if ($filter_text) {
766 my $flags = $channel_flags{$chatnet}{$channel};
767 foreach my $re (@$filter_text) {
768 return 1 if $channel =~ $re;
769 foreach my $flag (keys %$flags) {
770 return 1 if $flags->{$flag} =~ $re;
771 }
772 }
773 return 0;
774 }
775 return 0 if $filter_channels && !$filter_channels->{$chatnet}{$channel};
776 return 1 unless $filter_flags;
777 my $flags = $channel_flags{$chatnet}{$channel};
778 foreach my $flag (@$filter_flags) {
779 next unless $context->{owner} || $context->{see_flags}{$flag};
780 return 1 if defined $flags->{$flag};
781 }
782 return 0;
783 }
784
785 sub default_chatnet($) {
786 my ($context) = @_;
787 my $server = $context->{server} || $context->{owner} && Irssi::active_server;
788 return $server->{chatnet} if $server;
789 return Irssi::settings_get_str('people_default_chatnet');
790 }
791
792 sub cmd_user_list($$) {
793 my ($context, $args) = @_;
794 must_be_master $context or return;
795 my $filter_channels = undef;
796 my $filter_flags = undef;
797 my $filter_text = undef;
798 if ($args =~ /^ *(?:(?:$chatnet_re\/)?$channels_re +)?\+([a-zA-Z]+) *$/o ||
799 $args =~ /^ *(?:$chatnet_re\/)?$channels_re *$/o ||
800 $args =~ /^ *$/) {
801 my ($chatnet, $channels, $flags) = ($1, $2, $3);
802 if (defined $channels) {
803 $chatnet = default_chatnet $context unless defined $chatnet;
804 $chatnet = lc $chatnet;
805 $channels = lc $channels;
806 $filter_channels = {$chatnet => {map {$_ => 1} split /,/, $channels}};
807 }
808 $filter_flags = [split //, $flags] if defined $flags;
809 $context->{crap}(
810 $filter_flags ?
811 "Users having " .
812 (length $flags == 1 ? "\cc9+$flags\co flag" : "any of \cc9+$flags\co flags") .
813 ($filter_channels ? " on \cb$chatnet/$channels\cb:" : ":") :
814 $filter_channels ?
815 "Users having any flags on \cb$chatnet/$channels\cb:" :
816 "User list:");
817 } else {
818 my @texts = split ' ', $args;
819 $context->{crap}("Users having something common with \cb@texts\cb:");
820 $filter_text = [map {qr/\Q$_\E/i} @texts];
821 }
822 foreach my $hdl (sort keys %handles) {
823 show_handle $context, $hdl
824 if filter_handle $context, $hdl,
825 $filter_channels, $filter_flags, $filter_text;
826 }
827 foreach my $chatnet (sort keys %channel_flags) {
828 my $channels = $channel_flags{$chatnet};
829 foreach my $channel (sort keys %$channels) {
830 show_channel $context, $chatnet, $channel, 0
831 if filter_channel $context, $chatnet, $channel,
832 $filter_channels, $filter_flags, $filter_text;
833 }
834 }
835 $context->{crap}("End of user list");
836 }
837
838 ######## WORK WHEN MEETING PEOPLE ########
839
840 sub channel_notice($$$) {
841 my ($server, $channel, $msg) = @_;
842 $server->command("notice $channel -!- $msg")
843 if Irssi::settings_get_bool('people_channel_notice');
844 }
845
846 sub disappeared($) {
847 my ($chatnet, $nick, $address, $hdl) = @{$_[0]};
848 delete $authenticated{$chatnet}{$address}{$hdl};
849 delete $authenticated{$chatnet}{$address} unless %{$authenticated{$chatnet}{$address}};
850 delete $expire_auth{$chatnet}{$address}{$hdl};
851 delete $expire_auth{$chatnet}{$address} unless %{$expire_auth{$chatnet}{$address}};
852 print CLIENTNOTICE "\cc11*!$address\co is no longer recognized as \cc04$handles{$hdl}\co (authentication expired).";
853 }
854
855 sub disappears($$$) {
856 my ($chatnet, $nick, $address) = @_;
857 my $handles = $authenticated{$chatnet}{$address} or return;
858 my $delay = Irssi::settings_get_int('people_expire_password') * 1000;
859 foreach my $hdl (keys %$handles) {
860 my $expiring = $expire_auth{$chatnet}{$address}{$hdl};
861 Irssi::timeout_remove $expiring if $expiring;
862 my $tag = Irssi::timeout_add_once $delay, \&disappeared,
863 [$chatnet, $nick, $address, $hdl];
864 $expire_auth{$chatnet}{$address}{$hdl} = $tag;
865 }
866 }
867
868 sub maybe_disappears($$$$$) {
869 my ($chatnet, $server, $channel, $nick, $address) = @_;
870 foreach my $chan ($server->channels()) {
871 next if defined $channel && lc $chan->{name} eq $channel;
872 return if $chan->nick_find_mask("*!$address");
873 }
874 disappears $chatnet, $nick, $address;
875 }
876
877 sub appears($$$) {
878 my ($chatnet, $nick, $address) = @_;
879 my $handles = $expire_auth{$chatnet}{$address} or return;
880 my @handles = keys %$handles;
881 foreach my $hdl (@handles) {
882 my $tag = $handles->{$hdl};
883 Irssi::timeout_remove $tag;
884 delete $handles->{$hdl};
885 }
886 }
887
888 our %queued_actions = ();
889
890 our %action_not_needed = (
891 '+o' => sub {$_[0]->{op}},
892 '-o' => sub {not $_[0]->{op}},
893 '+v' => sub {$_[0]->{op} || $_[0]->{voice}},
894 '-v' => sub {$_[0]->{op} || not $_[0]->{voice}},
895 );
896
897 # Delete/create an appropriate timeout.
898 sub queue_handle($$) {
899 my ($chatnet, $channel) = @_;
900 my $ref = $queued_actions{$chatnet}{$channel};
901 $ref->{queue} ||= [];
902
903 if (defined $ref->{tag} and @{ $ref->{queue} } == 0) {
904 Irssi::timeout_remove $ref->{tag};
905 delete $ref->{tag};
906 delete $ref->{time};
907 }
908
909 unless (@{ $ref->{queue} } == 0) {
910 my $time = $ref->{queue}[0]{time};
911 unless (defined $ref->{time} and $ref->{time} == $time) {
912 Irssi::timeout_remove $ref->{tag} if defined $ref->{tag};
913 $ref->{time} = $time;
914 my $delay = 1000 * ($time - Time::HiRes::time);
915 $delay = 10 if $delay < 10;
916 $ref->{tag} = Irssi::timeout_add_once $delay, \&queue_run,
917 [$chatnet, $channel];
918 }
919 }
920 }
921
922 # Run the first items from the queue.
923 sub queue_run(\@) {
924 my ($chatnet, $channel) = @{ $_[0] };
925 delete $queued_actions{$chatnet}{$channel}{tag};
926 delete $queued_actions{$chatnet}{$channel}{time};
927
928 my $server = Irssi::server_find_chatnet $chatnet;
929 my $queue = $queued_actions{$chatnet}{$channel}{queue};
930 my $chan;
931 $chan = $server->channel_find($channel) if defined $server;
932 unless (defined $server and defined $chan) {
933 @$queue = ();
934 return;
935 }
936
937 my $max_modes = $server->isupport('modes') || 1;
938 my (@modes);
939 while (@modes < $max_modes and @$queue > 0) {
940 my $action = shift @$queue;
941 my $who = $chan->nick_find($action->{nick});
942 next unless defined $who;
943 next if $action_not_needed{$action->{action}}($who);
944 push @modes, [$action->{action}, $action->{nick}];
945 }
946
947 if (@modes) {
948 my ($mode_actions, @mode_params) = ('');
949 for my $mode (sort { $a->[0] cmp $b->[0] } @modes) {
950 $mode_actions .= $mode->[0];
951 push @mode_params, $mode->[1];
952 }
953 $server->command("mode $channel $mode_actions @mode_params");
954 }
955
956 queue_handle $chatnet, $channel;
957 }
958
959 sub queue_nick_changed($$$) {
960 my ($chatnet, $old_nick, $nick) = @_;
961 while (my ($channel, $ref) = each %{ $queued_actions{$chatnet} }) {
962 next unless defined $ref->{queue};
963 foreach (grep { $_->{nick} eq $old_nick } @{ $ref->{queue} }) {
964 $_->{nick} = $nick;
965 }
966 }
967 }
968
969 sub cancel_queued($$$) {
970 my ($chatnet, $channel, $nick) = @_;
971 my $queue = $queued_actions{$chatnet}{$channel}{queue};
972 return unless defined $queue;
973 @$queue = grep { $_->{nick} ne $nick } @$queue;
974 queue_handle $chatnet, $channel;
975 }
976
977 sub cancel_queued_everywhere($$) {
978 my ($chatnet, $nick) = @_;
979 while (my ($channel, $ref) = each %{ $queued_actions{$chatnet} }) {
980 cancel_queued $chatnet, $channel, $nick;
981 }
982 }
983
984 sub queue_action($$$$;$) {
985 my ($chatnet, $action, $channel, $nick, $delay) = @_;
986 unless (defined $delay) {
987 my $delay_min = Irssi::settings_get_int('people_op_delay_min');
988 my $delay_max = Irssi::settings_get_int('people_op_delay_max');
989 $delay_min = $delay_max if $delay_min > $delay_max;
990 $delay = $delay_min + rand ($delay_max - $delay_min);
991 }
992 my $queue = ($queued_actions{$chatnet}{$channel}{queue} ||= []);
993 @$queue = sort { $a->{time} <=> $b->{time} } @$queue, {
994 time => Time::HiRes::time + $delay,
995 action => $action,
996 nick => $nick
997 };
998 queue_handle $chatnet, $channel;
999 }
1000
1001 sub improve_mask($) {
1002 my ($mask) = @_;
1003 return "$1*" if $mask =~ /^(.*\@\d+\.\d+\.\d+\.)\d+$/;
1004 return "$1*$2" if $mask =~ /^(.*\@)[^.]*\d[^.]*(\..*)$/;
1005 return $mask;
1006 }
1007
1008 sub ban($$$$$$) {
1009 my ($server, $channel, $nick, $address, $is_op, $users) = @_;
1010 my $mask = $users->{k} ? $users->{k}[1] : "*!" . improve_mask $address;
1011 $server->command("mode $channel " . ($is_op ? "-o+b $nick $mask" : "+b $mask"));
1012 }
1013
1014 sub kick($$$$) {
1015 my ($server, $channel, $nick, $flags) = @_;
1016 $server->command("kick $channel $nick" . ($flags->{k} eq '' ? "" : " $flags->{k}"));
1017 }
1018
1019 sub execute($$$$$) {
1020 my ($server, $channel, $nick, $address, $flags) = @_;
1021 my $cmd = $flags->{e};
1022 $cmd =~ s/\$([CNA])/{
1023 C => $channel,
1024 N => $nick,
1025 A => $address,
1026 }->{$1}/eg;
1027 $server->command($cmd);
1028 }
1029
1030 sub show_who($$$) {
1031 my ($hdl, $nick, $address) = @_;
1032 return
1033 (defined $hdl ?
1034 $hdl eq lc $nick ?
1035 "\cc04$handles{$hdl}\co" :
1036 $nick =~ s/\Q$hdl\E/\cc04$handles{$hdl}\cc11/i ?
1037 "\cc11$nick\co" :
1038 "\cc04$handles{$hdl}\co = \cc11$nick\co" :
1039 "\cc11$nick\co") .
1040 " \cc14[\cc10$address\cc14]\co";
1041 }
1042
1043 sub notify($$$$$$) {
1044 my ($nick, $address, $flags, $users, $str, $beep) = @_;
1045 return unless defined $flags->{n};
1046 my $hdl = $users->{''}[0];
1047 $str =~ s/\{who\}/show_who $hdl, $nick, $address/eg;
1048 print CLIENTCRAP $str . ($flags->{i} eq '' ? "" : " ($flags->{i})");
1049 Irssi::command "beep" if $beep;
1050 }
1051
1052 sub process_user($$$$$$$$) {
1053 my ($server, $chan, $is_op, $is_voice, $nick, $address, $flags, $users) = @_;
1054 return if defined $flags->{x};
1055 return unless $chan->{chanop};
1056 my $chatnet = lc $server->{chatnet};
1057 my $channel = lc $chan->{name};
1058 if (defined $flags->{r}) {
1059 queue_action $chatnet, '+o', $channel, $nick unless $is_op;
1060 } elsif (defined $flags->{o}) {
1061 } elsif (defined $flags->{k}) {
1062 ban $server, $channel, $nick, $address, $is_op, $users;
1063 kick $server, $channel, $nick, $flags;
1064 } elsif (defined $flags->{d}) {
1065 queue_action $chatnet, '-o', $channel, $nick, 0.1 if $is_op;
1066 }
1067 if (defined $flags->{v}) {
1068 } elsif (defined $flags->{q}) {
1069 queue_action $chatnet, '-v', $channel, $nick, 0.2 if $is_voice;
1070 }
1071 if ($flags->{e} ne '') {
1072 execute $server, $channel, $nick, $address, $flags;
1073 }
1074 }
1075
1076 Irssi::signal_add_last 'event join', sub {
1077 my ($server, $args, $nick, $address) = @_;
1078 $args =~ /^:(.*)$/ or $args =~ /^([^ ]+)$/ or return;
1079 my $channel = lc $1;
1080 return if $nick eq $server->{nick};
1081 my $chatnet = lc $server->{chatnet};
1082 my $chan = $server->channel_find($channel) or return;
1083 appears $chatnet, $nick, $address;
1084 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address;
1085 notify $nick, $address, $flags, $users, "{who} has joined \cb$channel\cb", 1;
1086 return if defined $flags->{x};
1087 return unless $chan->{chanop};
1088 if (defined $flags->{r} || defined $flags->{o}) {
1089 queue_action $chatnet, '+o', $channel, $nick;
1090 } elsif (defined $flags->{k}) {
1091 ban $server, $channel, $nick, $address, 0, $users;
1092 kick $server, $channel, $nick, $flags;
1093 }
1094 if (defined $flags->{v}) {
1095 queue_action $chatnet, '+v', $channel, $nick;
1096 }
1097 if ($flags->{e} ne '') {
1098 execute $server, $channel, $nick, $address, $flags;
1099 }
1100 };
1101
1102 sub process_channel($$$) {
1103 my ($server, $chan, $notify) = @_;
1104 my $chatnet = lc $server->{chatnet};
1105 my $channel = lc $chan->{name};
1106 foreach my $who ($chan->nicks()) {
1107 my $nick = $who->{nick};
1108 next if $nick eq $server->{nick};
1109 my $address = $who->{host};
1110 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address;
1111 notify $nick, $address, $flags, $users,
1112 "{who} is on \cb$channel\cb", 0 if $notify;
1113 process_user $server, $chan, $who->{op}, $who->{voice}, $nick, $address, $flags, $users;
1114 }
1115 }
1116
1117 Irssi::signal_add_last 'channel wholist', sub {
1118 my ($chan) = @_;
1119 my $server = $chan->{server};
1120 my $chatnet = lc $server->{chatnet};
1121 foreach my $who ($chan->nicks()) {
1122 appears $chatnet, $who->{nick}, $who->{host};
1123 }
1124 process_channel $server, $chan, 1;
1125 };
1126
1127 Irssi::signal_add_first 'channel destroyed', sub {
1128 my ($chan) = @_;
1129 my $server = $chan->{server};
1130 my $chatnet = lc $server->{chatnet};
1131 foreach my $who ($chan->nicks()) {
1132 maybe_disappears $chatnet, $server, lc $chan->{name}, $who->{nick}, $who->{host};
1133 }
1134 };
1135
1136 sub is_master($$$$) {
1137 my ($chatnet, $chan, $channel, $nick) = @_;
1138 return 1 if $nick eq $chan->{server}{nick};
1139 my $who = $chan->nick_find($nick);
1140 my $address = $who ? $who->{host} : '';
1141 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address;
1142 return defined $flags->{m};
1143 }
1144
1145 Irssi::signal_add_last 'nick mode changed', sub {
1146 my ($chan, $who, $setter) = @_;
1147 my $server = $chan->{server};
1148 my $nick = $who->{nick};
1149 if ($nick eq $server->{nick}) {
1150 return unless $chan->{chanop};
1151 process_channel $server, $chan, 0 if $chan->{wholist};
1152 } else {
1153 my $chatnet = lc $server->{chatnet};
1154 my $channel = lc $chan->{name};
1155 my $address = $who->{host};
1156 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address;
1157 return if defined $flags->{x};
1158 return unless $chan->{chanop};
1159 if (defined $flags->{r}) {
1160 queue_action $chatnet, '+o', $channel, $nick
1161 unless $who->{op} ||
1162 $setter eq $nick ||
1163 is_master($chatnet, $chan, $channel, $setter);
1164 } elsif (defined $flags->{o}) {
1165 } elsif (defined $flags->{d}) {
1166 queue_action $chatnet, '-o', $channel, $nick, 0.1
1167 unless !$who->{op} ||
1168 is_master($chatnet, $chan, $channel, $setter);
1169 }
1170 if (defined $flags->{v}) {
1171 } elsif (defined $flags->{q}) {
1172 queue_action $chatnet, '-v', $channel, $nick, 0.2
1173 unless !$who->{voice} ||
1174 is_master($chatnet, $chan, $channel, $setter);
1175 }
1176 }
1177 };
1178
1179 Irssi::signal_add_last 'event part', sub {
1180 my ($server, $args, $nick, $address) = @_;
1181 $args =~ /^([^ ]+) +:(.*)$/ or $args =~ /^([^ ]+) +([^ ]+)$/ or $args =~ /^([^ ]+)()$/ or return;
1182 my ($channel, $reason) = (lc $1, $2);
1183 my $chatnet = lc $server->{chatnet};
1184 my $chan = $server->channel_find($channel) or return;
1185 maybe_disappears $chatnet, $server, $channel, $nick, $address;
1186 cancel_queued $chatnet, $channel, $nick;
1187 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address;
1188 notify $nick, $address, $flags, $users,
1189 "{who} has left \cb$channel\cb \cc14[\co$reason\cc14]\co", 0;
1190 };
1191
1192 Irssi::signal_add_last 'event quit', sub {
1193 my ($server, $args, $nick, $address) = @_;
1194 $args =~ /^:(.*)$/ or $args =~ /^([^ ]+)$/ or $args =~ /^()$/ or return;
1195 my $reason = $1;
1196 my $chatnet = lc $server->{chatnet};
1197 maybe_disappears $chatnet, $server, undef, $nick, $address;
1198 cancel_queued_everywhere $chatnet, $nick;
1199 my ($flags, $users) = find_global_flags $chatnet, $nick, $address;
1200 delete $flags->{n};
1201 foreach my $chan ($server->channels()) {
1202 next unless $chan->nick_find($nick);
1203 my $channel = lc $chan->{name};
1204 my ($local_flags, $local_users) = find_local_flags $chatnet, $channel, $nick, $address;
1205 if (defined $local_flags->{n}) {
1206 $flags->{n} = '';
1207 last;
1208 }
1209 }
1210 notify $nick, $address, $flags, $users,
1211 "{who} has quit \cc14[\co$reason\cc14]\co", 0;
1212 };
1213
1214 Irssi::signal_add_last 'event kick', sub {
1215 my ($server, $args, $kicker, $kicker_address) = @_;
1216 $args =~ /^([^ ]+) +([^ ]+) +:(.*)$/ or $args =~ /^([^ ]+) +([^ ]+) +([^ ]+)$/ or
1217 $args =~ /^([^ ]+) +([^ ]+)()$/ or return;
1218 my ($channel, $nick, $reason) = (lc $1, $2, $3);
1219 my $chatnet = lc $server->{chatnet};
1220 my $chan = $server->channel_find($channel) or return;
1221 my $who = $chan->nick_find($nick);
1222 return unless defined $who;
1223 my $address = $who->{host};
1224 maybe_disappears $chatnet, $server, $channel, $nick, $address;
1225 cancel_queued $chatnet, $channel, $nick;
1226 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address;
1227 notify $nick, $address, $flags, $users,
1228 "{who} was kicked from \cb$channel\cb by \cb$kicker\cb \cc14[\co$reason\cc14]\co", 0;
1229 };
1230
1231 Irssi::signal_add_last 'event nick', sub {
1232 my ($server, $args, $old_nick, $address) = @_;
1233 $args =~ /^:(.*)$/ or $args =~ /^([^ ]+)$/ or return;
1234 my $new_nick = $1;
1235 my $chatnet = lc $server->{chatnet};
1236 queue_nick_changed $chatnet, $old_nick, $new_nick;
1237 foreach my $chan ($server->channels()) {
1238 my @nicks = map {$_->{nick}} $chan->nicks();
1239 my $who = $chan->nick_find($new_nick);
1240 next unless $who;
1241 my $channel = lc $chan->{name};
1242 my ($old_flags, $old_users) = find_local_flags $chatnet, $channel, $old_nick, $address;
1243 my ($new_flags, $new_users) = find_local_flags $chatnet, $channel, $new_nick, $address;
1244 if (defined $new_flags->{n} &&
1245 (!defined $old_flags->{n} || $old_users->{''}[0] ne $new_users->{''}[0])) {
1246 notify $new_nick, $address, $new_flags, $new_users,
1247 "{who} is on \cb$channel\cb", 1;
1248 }
1249 next if defined $new_flags->{x};
1250 next unless $chan->{chanop};
1251 if (defined $new_flags->{o}) {
1252 queue_action $chatnet, '+o', $channel, $new_nick
1253 if !defined $old_flags->{o} && !$who->{op};
1254 } elsif (defined $new_flags->{k}) {
1255 ban $server, $channel, $new_nick, $address, $who->{op}, $new_users;
1256 kick $server, $channel, $new_nick, $new_flags;
1257 } elsif (defined $new_flags->{d}) {
1258 queue_action $chatnet, '-o', $channel, $new_nick, 0.1
1259 if !defined $old_flags->{d} && $who->{op};
1260 }
1261 if (defined $new_flags->{v}) {
1262 queue_action $chatnet, '+v', $channel, $new_nick
1263 if !defined $old_flags->{v} && !$who->{op} && !$who->{voice};
1264 } elsif (defined $new_flags->{q}) {
1265 queue_action $chatnet, '-v', $channel, $new_nick, 0.2
1266 if !defined $old_flags->{q} && $who->{voice};
1267 }
1268 if ($new_flags->{e} ne '') {
1269 execute $server, $channel, $new_nick, $address, $new_flags;
1270 }
1271 }
1272 };
1273
1274 ######## NICK COLORS ########
1275
1276 sub compute_color($) {
1277 my ($text) = @_;
1278 my $sum = 0;
1279 foreach my $ch (lc($text) =~ /[a-z]/g) {
1280 $sum += ord $ch;
1281 }
1282 my @colors = split(//, Irssi::settings_get_str('people_colors'));
1283 return '%' . $colors[$sum % @colors];
1284 }
1285
1286 Irssi::signal_add_last 'message public', sub {
1287 my ($server, $msg, $nick, $address, $channel) = @_;
1288 my $chatnet = lc $server->{chatnet};
1289 $channel = lc $channel;
1290 my $chan = $server->channel_find($channel) or return;
1291 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address;
1292 return unless defined $flags->{c} ||
1293 Irssi::settings_get_bool('people_color_friends') && defined $flags->{''} ||
1294 Irssi::settings_get_bool('people_color_everybody');
1295 my $color = $flags->{c} ne '' ? $flags->{c} :
1296 compute_color(defined $flags->{c} && $users->{c} ? $handles{$users->{c}[0]} :
1297 defined $flags->{''} ? $handles{$users->{''}[0]} : $nick);
1298 my $window = $server->window_find_item($channel);
1299 my $theme = $window->{theme} || Irssi::current_theme;
1300 my $oform = $theme->get_format('fe-common/core', 'pubmsg');
1301 my $nform = $oform;
1302 $nform =~ s/(\$(?:\[-?\d+\])?0)/$color$1%n/g;
1303 $window->command("^format pubmsg $nform") if $window;
1304 Irssi::signal_continue @_;
1305 $window->command("^format pubmsg $oform") if $window;
1306 };
1307
1308 ######## WORK WHEN USERLIST CHANGED ########
1309
1310 sub user_changed_on_channel($$$$$) {
1311 my ($hdl, $server, $chatnet, $chan, $channel) = @_;
1312 foreach my $who ($chan->nicks()) {
1313 my $nick = $who->{nick};
1314 next if $nick eq $server->{nick};
1315 my $address = $who->{host};
1316 my ($flags, $users) = find_local_flags_if_matches $hdl, $chatnet, $channel, $nick, $address;
1317 notify $nick, $address, $flags, $users,
1318 "{who} is on \cb$channel\cb", 0;
1319 process_user $server, $chan, $who->{op}, $who->{voice}, $nick, $address, $flags, $users;
1320 }
1321 }
1322
1323 sub user_changed($) {
1324 my ($hdl) = @_;
1325 foreach my $server (Irssi::servers) {
1326 my $chatnet = lc $server->{chatnet};
1327 foreach my $chan ($server->channels()) {
1328 next unless $chan->{wholist};
1329 my $channel = lc $chan->{name};
1330 user_changed_on_channel $hdl, $server, $chatnet, $chan, $channel;
1331 }
1332 }
1333 }
1334
1335 sub user_channel_changed($$$) {
1336 my ($hdl, $chatnet, $channel) = @_;
1337 my $server = Irssi::server_find_chatnet $chatnet or return;
1338 my $chan = $server->channel_find($channel) or return;
1339 user_changed_on_channel $hdl, $server, $chatnet, $chan, $channel;
1340 }
1341
1342 sub channel_changed($$) {
1343 my ($chatnet, $channel) = @_;
1344 my $server = Irssi::server_find_chatnet $chatnet or return;
1345 my $chan = $server->channel_find($channel) or return;
1346 process_channel $server, $chan, 0 if $chan->{wholist};
1347 }
1348
1349 sub all_changed() {
1350 foreach my $server (Irssi::servers) {
1351 foreach my $chan ($server->channels()) {
1352 process_channel $server, $chan, 0 if $chan->{wholist};
1353 }
1354 }
1355 }
1356
1357 ######## STORE CONFIGURATION IN A FILE ########
1358
1359 sub show_flag($$) {
1360 my ($flag, $arg) = @_;
1361 return defined $arg ? $arg eq '' ? "+$flag" : "+$flag $arg" : "-$flag";
1362 }
1363
1364 sub save_config() {
1365 open CONFIG, ">$config_tmp";
1366 foreach my $hdl (sort keys %handles) {
1367 my $handle = $handles{$hdl};
1368 my @masks = sort @{$user_masks{$hdl}};
1369 print CONFIG "user $handle @masks\n";
1370 my $globals = $user_flags{$hdl};
1371 foreach my $flag (sort keys %$globals) {
1372 print CONFIG "flag $handle " .
1373 show_flag($flag, $globals->{$flag}) . "\n";
1374 }
1375 my $chatnets = $user_channel_flags{$hdl};
1376 foreach my $chatnet (sort keys %$chatnets) {
1377 my $channels = $chatnets->{$chatnet};
1378 foreach my $channel (sort keys %$channels) {
1379 my $locals = $channels->{$channel};
1380 foreach my $flag (sort keys %$locals) {
1381 print CONFIG "flag $handle $chatnet/$channel " .
1382 show_flag($flag, $locals->{$flag}) . "\n";
1383 }
1384 }
1385 }
1386 print CONFIG "\n";
1387 }
1388 foreach my $chatnet (sort keys %channel_flags) {
1389 my $channels = $channel_flags{$chatnet};
1390 foreach my $channel (sort keys %$channels) {
1391 my $flags = $channels->{$channel};
1392 next unless %$flags;
1393 foreach my $flag (sort keys %$flags) {
1394 print CONFIG "flag $chatnet/$channel " .
1395 show_flag($flag, $flags->{$flag}) . "\n";
1396 }
1397 print CONFIG "\n";
1398 }
1399 }
1400 close CONFIG;
1401 rename $config, $config_old;
1402 rename $config_tmp, $config;
1403 }
1404
1405 sub autosave_config() {
1406 save_config if Irssi::settings_get_bool 'people_autosave';
1407 }
1408
1409 Irssi::signal_add 'setup saved', sub {
1410 my ($main_config, $auto) = @_;
1411 save_config unless $auto;
1412 };
1413
1414 sub unique_masks(@) {
1415 my %masks = ();
1416 foreach my $mask (@_) {
1417 $mask = "*\@$mask" if $mask !~ /\@|!\*$/;
1418 $mask = "*!$mask" if $mask !~ /!/;
1419 $masks{$mask} = 1;
1420 }
1421 return sort keys %masks;
1422 }
1423
1424 sub load_config() {
1425 %handles = ();
1426 %user_masks = ();
1427 %user_flags = ();
1428 %channel_flags = ();
1429 %user_channel_flags = ();
1430 open CONFIG, $config or return;
1431 while (<CONFIG>) {
1432 chomp;
1433 next if /^ *$/ || /^#/;
1434 if (/^user +$handle_re$opt_masks_re *$/o) {
1435 my ($handle, $masks) = ($1, $2);
1436 $handles{lc $handle} = $handle;
1437 $user_masks{lc $handle} = [unique_masks(split(' ', $masks))];
1438 } elsif (/^flag +$handle_re +$chatnet_re\/$channel_re +\+([a-zA-Z])$arg_re$/o) {
1439 my ($handle, $chatnet, $channel, $flag, $arg) = ($1, $2, $3, $4, $5);
1440 $flag = tr_flag $flag;
1441 $arg = '' unless defined $arg;
1442 $user_channel_flags{lc $handle}{$chatnet}{$channel}{$flag} = $arg;
1443 } elsif (/^flag +$handle_re +$chatnet_re\/$channel_re +-([a-zA-Z]) *$/o) {
1444 my ($handle, $chatnet, $channel, $flag) = ($1, $2, $3, $4);
1445 $flag = tr_flag $flag;
1446 $user_channel_flags{lc $handle}{$chatnet}{$channel}{$flag} = undef;
1447 } elsif (/^flag +$chatnet_re\/$channel_re +\+([a-zA-Z])$arg_re$/o) {
1448 my ($chatnet, $channel, $flag, $arg) = ($1, $2, $3, $4);
1449 $flag = tr_flag $flag;
1450 $arg = '' unless defined $arg;
1451 $channel_flags{$chatnet}{$channel}{$flag} = $arg;
1452 } elsif (/^flag +$chatnet_re\/$channel_re +-([a-zA-Z]) *$/o) {
1453 my ($chatnet, $channel, $flag) = ($1, $2, $3);
1454 $flag = tr_flag $flag;
1455 $channel_flags{$chatnet}{$channel}{$flag} = undef;
1456 } elsif (/^flag +$handle_re +\+([a-zA-Z])$arg_re$/o) {
1457 my ($handle, $flag, $arg) = ($1, $2, $3);
1458 $flag = tr_flag $flag;
1459 $arg = '' unless defined $arg;
1460 $user_flags{lc $handle}{$flag} = $arg;
1461 } elsif (/^flag +$handle_re +-([a-zA-Z]) *$/o) {
1462 my ($handle, $flag) = ($1, $2);
1463 $flag = tr_flag $flag;
1464 $user_flags{lc $handle}{$flag} = undef;
1465 } else {
1466 print CLIENTERROR "Syntax error in $config: $_";
1467 }
1468 }
1469 update_all_masks;
1470 all_changed;
1471 }
1472
1473 Irssi::signal_add 'setup reread', \&load_config;
1474
1475 ######## MANAGE THE USER LIST ########
1476
1477 sub find_nick($) {
1478 my ($nick) = @_;
1479 foreach my $chan (Irssi::channels) {
1480 my $who = $chan->nick_find($nick) or next;
1481 my $address = $who->{host};
1482 return $address if $address ne '';
1483 }
1484 return undef;
1485 }
1486
1487 sub find_server_nick($$) {
1488 my ($server, $nick) = @_;
1489 foreach my $chan ($server->channels) {
1490 my $who = $chan->nick_find($nick) or next;
1491 my $address = $who->{host};
1492 return $address if $address ne '';
1493 }
1494 return undef;
1495 }
1496
1497 sub guess_mask($) {
1498 my ($nick) = @_;
1499 my $address = find_nick $nick;
1500 return defined $address ? (improve_mask $address) : ();
1501 }
1502
1503 sub cmd_user_add($$) {
1504 my ($context, $args) = @_;
1505 must_be_master $context or return;
1506 unless ($args =~ /^ *$handle_re$opt_masks_re *$/o) {
1507 $context->{usage}("user add <handle> <mask>...");
1508 return;
1509 }
1510 my ($handle, $masks) = ($1, $2);
1511 my $hdl = lc $handle;
1512 if (defined $handles{$hdl}) {
1513 $context->{error}("User \cc04$handles{$hdl}\co already exists");
1514 return;
1515 }
1516 my @masks = split(' ', $masks);
1517 @masks = guess_mask $handle unless @masks;
1518 @masks = unique_masks(@masks);
1519 $handles{$hdl} = $handle;
1520 $user_masks{$hdl} = [@masks];
1521 $user_flags{$hdl}{l} = ''
1522 unless $context->{owner} || defined $context->{globals}{m};
1523 if (@masks) {
1524 my $plural = @masks == 1 ? "" : "s";
1525 $context->{notice}("Added user \cc04$handle\co with address mask$plural \cc10@masks\co");
1526 } else {
1527 $context->{notice}("Added user \cc04$handle\co with no address masks.");
1528 }
1529 update_all_masks;
1530 user_changed $hdl;
1531 autosave_config;
1532 }
1533
1534 sub cmd_user_remove($$) {
1535 my ($context, $args) = @_;
1536 must_be_master $context or return;
1537 unless ($args =~ /^ *$handle_re *$/o) {
1538 $context->{usage}("user remove <handle>");
1539 return;
1540 }
1541 my $handle = $1;
1542 handle_exists $context, $handle or return;
1543 my $hdl = lc $handle;
1544 may_manage $context, $hdl or return;
1545 $context->{notice}("Removed user \cc04$handles{$hdl}\co.");
1546 delete $user_flags{$hdl};
1547 delete $user_channel_flags{$hdl};
1548 user_changed $hdl;
1549 delete $handles{$hdl};
1550 delete $user_masks{$hdl};
1551 update_all_masks;
1552 autosave_config;
1553 };
1554
1555 sub cmd_mask_add($$) {
1556 my ($context, $args) = @_;
1557 must_be_master $context or return;
1558 unless ($args =~ /^ *$handle_re +$masks_re *$/o) {
1559 $context->{usage}("mask add <handle> <mask>...");
1560 return;
1561 }
1562 my ($handle, $masks) = ($1, $2);
1563 handle_exists $context, $handle or return;
1564 my $hdl = lc $handle;
1565 may_manage $context, $hdl or return;
1566 my %masks = map {$_ => 1} @{$user_masks{$hdl}};
1567 foreach my $mask (unique_masks(split(' ', $masks))) {
1568 $masks{$mask} = 1;
1569 }
1570 $user_masks{$hdl} = [sort keys %masks];
1571 show_handle $context, $hdl;
1572 update_all_masks;
1573 user_changed $hdl;
1574 autosave_config;
1575 }
1576
1577 sub cmd_mask_remove($$) {
1578 my ($context, $args) = @_;
1579 must_be_master $context or return;
1580 unless ($args =~ /^ *$handle_re +$masks_re *$/o) {
1581 $context->{usage}("mask remove <handle> <mask>...");
1582 return;
1583 }
1584 my ($handle, $masks) = ($1, $2);
1585 handle_exists $context, $handle or return;
1586 my $hdl = lc $handle;
1587 may_manage $context, $hdl or return;
1588 my %masks = map {$_ => 1} @{$user_masks{$hdl}};
1589 foreach my $mask (unique_masks(split(' ', $masks))) {
1590 delete $masks{$mask};
1591 }
1592 $user_masks{$hdl} = [sort keys %masks];
1593 show_handle $context, $hdl;
1594 update_all_masks;
1595 user_changed $hdl;
1596 autosave_config;
1597 }
1598
1599 sub cmd_user_rename($$) {
1600 my ($context, $args) = @_;
1601 must_be_master $context or return;
1602 unless ($args =~ /^ *$handle_re +$handle_re *$/o) {
1603 $context->{usage}("user rename <handle> <new-handle>");
1604 return;
1605 }
1606 my ($old_handle, $new_handle) = ($1, $2);
1607 handle_exists $context, $old_handle or return;
1608 my $old_hdl = lc $old_handle;
1609 my $new_hdl = lc $new_handle;
1610 may_manage $context, $old_hdl or return;
1611 if ($new_hdl ne $old_hdl && defined $handles{$new_hdl}) {
1612 $context->{error}("User \cc04$handles{$new_hdl}\co already exists.");
1613 return;
1614 }
1615 $handles{$new_hdl} = $new_handle;
1616 if ($new_hdl ne $old_hdl) {
1617 delete $handles{$old_hdl};
1618 $user_masks{$new_hdl} = $user_masks{$old_hdl};
1619 delete $user_masks{$old_hdl};
1620 if ($user_flags{$old_hdl}) {
1621 $user_flags{$new_hdl} = $user_flags{$old_hdl};
1622 delete $user_flags{$old_hdl};
1623 }
1624 if ($user_channel_flags{$old_hdl}) {
1625 $user_channel_flags{$new_hdl} = $user_channel_flags{$old_hdl};
1626 delete $user_channel_flags{$old_hdl};
1627 }
1628 }
1629 $context->{notice}("Renamed user \cc04$old_handle\co to \cc04$new_handle\co.");
1630 autosave_config;
1631 }
1632
1633 ######## MANAGE FLAGS ########
1634
1635 sub flag_usage($) {
1636 my ($context) = @_;
1637 $context->{usage} ("flag <handle>");
1638 $context->{usage_next}("flag [<chatnet>/]<#channels>");
1639 $context->{usage_next}("flag <handle> <flags>");
1640 $context->{usage_next}("flag [<chatnet>/]<#channels> <flags>");
1641 $context->{usage_next}("flag <handle> [<chatnet>/]<#channels> <flags>");
1642 $context->{error}("<flags> is (+<letter>...|-<letter>...)...");
1643 $context->{error}("The last +<letter> may be followed by space and <argument>");
1644 }
1645
1646 sub parse_flags($) {
1647 my ($flags) = @_;
1648 return map {
1649 my ($dir, $force) = /^\+/ ? ('', 0) : /^-/ ? (undef, 0) : (undef, 1);
1650 map {[$_, $dir, $force]} (/[a-zA-Z]/g)
1651 } ($flags =~ /[+\-!][a-zA-Z]+/g);
1652 }
1653
1654 sub cmd_flag($$) {
1655 my ($context, $args) = @_;
1656 must_be_master $context or return;
1657 if ($args =~ /^ *(?:$chatnet_re\/)?$channels_re *$/o) {
1658 my ($chatnet, $channels) = ($1, lc $2);
1659 $chatnet = default_chatnet $context unless defined $chatnet;
1660 $chatnet = lc $chatnet;
1661 foreach my $channel (split /,/, $channels) {
1662 show_channel $context, $chatnet, $channel, 1;
1663 }
1664 return;
1665 }
1666 if ($args =~ /^ *$handle_re *$/o) {
1667 my ($hdl) = lc $1;
1668 show_handle $context, $hdl;
1669 return;
1670 }
1671 unless ($args =~ /^ *(?:$handle_re +)??(?:(?:$chatnet_re\/)?$channels_re +)?$flags_re$arg_re$/o) {
1672 flag_usage $context; return;
1673 }
1674 my ($handle, $chatnet, $channels, $flags, $arg) = ($1, $2, $3, $4, $5);
1675 unless (defined $handle || defined $channels) {
1676 flag_usage $context; return;
1677 }
1678 $arg = '' unless defined $arg;
1679 if (defined $handle) {
1680 handle_exists $context, $handle or return;
1681 }
1682 my $hdl = lc $handle;
1683 my @channels = ();
1684 if (defined $channels) {
1685 $chatnet = default_chatnet $context unless defined $chatnet;
1686 $chatnet = lc $chatnet;
1687 @channels = map {[$chatnet, lc $_]} split /,/, $channels;
1688 }
1689 my @changes = parse_flags $flags;
1690 if ($arg ne '') {
1691 unless (defined $changes[$#changes][1]) {
1692 flag_usage $context; return;
1693 }
1694 $changes[$#changes][1] = $arg;
1695 }
1696 foreach my $change (@changes) {
1697 my ($flag, $arg, $force) = @$change;
1698 my $new_flag = tr_flag $flag;
1699 if ($new_flag ne $flag) {
1700 $context->{error}("Please use \cc9+$new_flag\co instead of \cc9+$flag\co.");
1701 $flag = $new_flag;
1702 $change->[0] = $flag;
1703 }
1704 unless ($context->{set_flags}{$flag}) {
1705 if ($context->{owner}) {
1706 $context->{error}("Warning, only flags \cc9$context->{set_flags_str}\co are meaningful.");
1707 } else {
1708 $context->{error}("Sorry, you can only set flags \cc9$context->{set_flags_str}\co.");
1709 return;
1710 }
1711 }
1712 }
1713 unless ($context->{owner} || defined $context->{globals}{m}) {
1714 if (@channels) {
1715 foreach my $chatnet_channel (@channels) {
1716 my ($chatnet, $channel) = @$chatnet_channel;
1717 unless (defined $context->{locals}{$chatnet}{$channel}{m}) {
1718 $context->{error}("Sorry, you don't have master privileges in \cb$channel\cb.");
1719 return;
1720 }
1721 }
1722 } else {
1723 my $chatnets = $context->{locals};
1724 foreach my $chatnet (keys %$chatnets) {
1725 my $channels = $chatnets->{$chatnet};
1726 foreach my $channel (keys %$channels) {
1727 my $flags = $channels->{$channel};
1728 push @channels, [$chatnet, $channel] if defined $flags->{m};
1729 }
1730 }
1731 }
1732 }
1733 if (defined $handle) {
1734 if (@channels) {
1735 foreach my $chatnet_channel (@channels) {
1736 my ($chatnet, $channel) = @$chatnet_channel;
1737 my $flags = \%{$user_channel_flags{$hdl}{$chatnet}{$channel}};
1738 foreach my $change (@changes) {
1739 my ($flag, $arg, $force) = @$change;
1740 my $global =
1741 exists $channel_flags{$chatnet}{$channel}{$flag} ?
1742 $channel_flags{$chatnet}{$channel}{$flag} :
1743 $user_flags{$hdl}{$flag};
1744 if ($force ||
1745 defined $arg != defined $global ||
1746 defined $arg && defined $global &&
1747 $arg ne $global && $arg ne '') {
1748 $flags->{$flag} = $arg;
1749 } else {
1750 delete $flags->{$flag};
1751 }
1752 }
1753 }
1754 show_handle $context, $hdl;
1755 foreach my $chatnet_channel (@channels) {
1756 my ($chatnet, $channel) = @$chatnet_channel;
1757 user_channel_changed $hdl, $chatnet, $channel;
1758 }
1759 } else {
1760 my $flags = \%{$user_flags{$hdl}};
1761 foreach my $change (@changes) {
1762 my ($flag, $arg, $force) = @$change;
1763 if ($force || defined $arg) {
1764 $flags->{$flag} = $arg;
1765 } else {
1766 delete $flags->{$flag};
1767 }
1768 }
1769 show_handle $context, $hdl;
1770 user_changed $hdl;
1771 }
1772 } else {
1773 foreach my $chatnet_channel (@channels) {
1774 my ($chatnet, $channel) = @$chatnet_channel;
1775 my $flags = \%{$channel_flags{$chatnet}{$channel}};
1776 foreach my $change (@changes) {
1777 my ($flag, $arg, $force) = @$change;
1778 if ($force || defined $arg) {
1779 $flags->{$flag} = $arg;
1780 } else {
1781 delete $flags->{$flag};
1782 }
1783 }
1784 show_channel $context, $chatnet, $channel, 1;
1785 channel_changed $chatnet, $channel;
1786 }
1787 }
1788 autosave_config;
1789 }
1790
1791 ######## FIND USERS ########
1792
1793 sub cmd_find($$) {
1794 my ($context, $args) = @_;
1795 if ($args =~ /^ *(?:$chatnet_re\/)?$channel_re *$/o) {
1796 my ($chatnet, $channel) = ($1, lc $2);
1797 must_be_master $context or return;
1798 $chatnet = default_chatnet $context unless defined $chatnet;
1799 $chatnet = lc $chatnet;
1800 my $server = Irssi::server_find_chatnet $chatnet;
1801 unless ($server) {
1802 $context->{error}("Sorry, I'm not connected to $chatnet.");
1803 return;
1804 }
1805 my $chan = $server->channel_find($channel);
1806 unless ($chan) {
1807 $context->{error}("Sorry, I'm not on $channel.");
1808 }
1809 my @people = ();
1810 foreach my $who ($chan->nicks()) {
1811 my $nick = $who->{nick};
1812 next if $nick eq $server->{nick};
1813 my $address = $who->{host};
1814 my ($hdl, $mask) = find_best_user undef, $nick, $address;
1815 next unless defined $hdl;
1816 push @people, [$hdl, $nick, $address];
1817 }
1818 unless (@people) {
1819 $context->{crap}("I don't recognize any people from \cb$channel\cb.");
1820 return;
1821 }
1822 $context->{crap}("Recognized people on \cb$channel\cb:");
1823 foreach my $person (sort {$a->[0] cmp $b->[0]} @people) {
1824 my ($hdl, $nick, $address) = @$person;
1825 $context->{crap}(show_who $hdl, $nick, $address);
1826 }
1827 } elsif ($args =~ /^ *$mask_re *$/o) {
1828 my $mask = $1;
1829 must_be_master $context or return;
1830 my ($nick, $address);
1831 if ($mask =~ /^(.*)!(.*)$/) {
1832 ($nick, $address) = ($1, $2);
1833 } elsif ($mask =~ /\@/) {
1834 ($nick, $address) = ('*', $mask);
1835 } else {
1836 $nick = $mask;
1837 $address = find_nick $nick;
1838 unless (defined $address) {
1839 $context->{error}("I don't see \cc11$nick\co on my channels.");
1840 return;
1841 }
1842 }
1843 my @users = find_users undef, $nick, $address;
1844 unless (@users) {
1845 $context->{error}("I don't know who \cc11$nick\co \cc14[\cc10$address\cc14]\co is.");
1846 return;
1847 }
1848 foreach my $user (@users) {
1849 my ($hdl, $mask) = @$user;
1850 my $who = show_who $hdl, $nick, $address;
1851 $context->{crap}("$who \cc14(\cc10$mask\cc14)\co");
1852 }
1853 } elsif ($context->{owner} && $args =~ /^ *$/) {
1854 my %people = ();
1855 my %channels = ();
1856 foreach my $server (Irssi::servers) {
1857 my $chatnet = lc $server->{chatnet};
1858 foreach my $chan ($server->channels()) {
1859 my $channel = lc $chan->{name};
1860 foreach my $who ($chan->nicks()) {
1861 my $nick = $who->{nick};
1862 next if $nick eq $server->{nick};
1863 my $address = $who->{host};
1864 my ($hdl, $mask) = find_best_user undef, $nick, $address;
1865 next unless defined $hdl;
1866 $people{$chatnet}{$nick} = [$address, $hdl];
1867 push @{$channels{$chatnet}{$nick}}, $channel;
1868 }
1869 }
1870 }
1871 my @people = ();
1872 foreach my $chatnet (keys %people) {
1873 my $nicks = $people{$chatnet};
1874 foreach my $nick (keys %$nicks) {
1875 my ($address, $hdl) = @{$nicks->{$nick}};
1876 my $channels = $channels{$chatnet}{$nick};
1877 push @people, [$hdl, $chatnet, $nick, $address, $channels];
1878 }
1879 }
1880 foreach my $person (sort {$a->[0] cmp $b->[0]} @people) {
1881 my ($hdl, $chatnet, $nick, $address, $channels) = @$person;
1882 my $who = show_who $hdl, $nick, $address;
1883 my $channels_txt = join(", ", sort @$channels);
1884 $context->{crap}("\cc14[\co$chatnet\cc14]\co $who is on \cb$channels_txt\cb");
1885 }
1886 } else {
1887 if ($context->{owner}) {
1888 $context->{usage} ("find");
1889 $context->{usage_next}("find <#channel>");
1890 } else {
1891 $context->{usage} ("find <#channel>");
1892 }
1893 $context->{usage_next}("find <mask>");
1894 $context->{usage_next}("find <nick>");
1895 }
1896 };
1897
1898 ######## OPERATOR COMMANDS ########
1899
1900 sub find_channel($$$) {
1901 my ($context, $channel, $need_op) = @_;
1902 my $chan = $context->{server}->channel_find($channel);
1903 if ($chan) {
1904 if ($need_op && !$chan->{chanop}) {
1905 $context->{error}("Sorry, I'm not an operator on \cb$channel\cb.");
1906 return undef;
1907 }
1908 return $chan;
1909 } else {
1910 $context->{error}("Sorry, I'm not on \cb$channel\cb.");
1911 return undef;
1912 }
1913 }
1914
1915 sub must_be_channel_operator($$$) {
1916 my ($context, $chatnet, $channel) = @_;
1917 return 1 if has_local_flag($context, $chatnet, $channel, 'o') ||
1918 has_local_flag($context, $chatnet, $channel, 'm');
1919 $context->{error}("Sorry, you don't have operator privileges on \cb$channel\cb.");
1920 return 0;
1921 }
1922
1923 sub cmd_trust($$) {
1924 my ($context, $args) = @_;
1925 must_be_master $context or return;
1926 my @nicks = map { lc } split /\s+/, $args;
1927 my $chatnet = lc default_chatnet $context;
1928 my $server = Irssi::server_find_chatnet $chatnet;
1929 foreach my $nick (@nicks) {
1930 my $address = find_server_nick $server, $nick;
1931 unless (defined $address) {
1932 $context->{error}("I don't see \cc11$nick\co in \cb$chatnet\cb.");
1933 next;
1934 }
1935 my @users = find_users undef, $nick, $address;
1936 unless (@users) {
1937 $context->{error}("I don't recognize \cc11$nick\co.");
1938 }
1939 foreach my $user (@users) {
1940 my ($hdl, $mask) = @$user;
1941 unless (defined $user_flags{$hdl}{p}) {
1942 $context->{error}("\cc04$hdl\co doesn't need a password.");
1943 next;
1944 }
1945 $context->{notice}("Trusting \cc11$nick\co to be \cc04$hdl\co " .
1946 "on \cb$chatnet\cb.");
1947 $authenticated{$chatnet}{$address}{$hdl} = 1;
1948 maybe_disappears $chatnet, $server, undef, $nick, $address;
1949 foreach my $chan ($server->channels()) {
1950 next unless $chan->{wholist};
1951 next unless $chan->{chanop};
1952 my $channel = lc $chan->{name};
1953 # nick_find_mask() only returns one nick.
1954 foreach my $who (grep { $_->{host} eq $address } $chan->nicks()) {
1955 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address;
1956 next if defined $flags->{x};
1957 if (defined $flags->{r} || defined $flags->{o}) {
1958 queue_action $chatnet, '+o', $channel, $who->{nick};
1959 }
1960 if (defined $flags->{v}) {
1961 queue_action $chatnet, '+v', $channel, $who->{nick};
1962 }
1963 # FIXME: flag +e?
1964 }
1965 }
1966 }
1967 }
1968 }
1969
1970 sub cmd_op($$) {
1971 my ($context, $args) = @_;
1972 must_be_operator $context or return;
1973 unless ($args =~ /^ *$channel_re(?: +$nicks_re)? *$/o) {
1974 $context->{usage}("op <#channel> [<nick>]...");
1975 return;
1976 }
1977 my ($channel, $nicks) = (lc $1, $2);
1978 my @nicks = defined $nicks ? split ' ', $nicks : ($context->{nick});
1979 my $server = $context->{server};
1980 my $chatnet = lc $server->{chatnet};
1981 must_be_channel_operator $context, $chatnet, $channel or return;
1982 my $chan = find_channel $context, $channel, 1 or return;
1983 my @good = ();
1984 foreach my $nick (@nicks) {
1985 my $who = $chan->nick_find($nick);
1986 unless ($who) {
1987 $context->{error}("\cb$nick\cb is not on \cb$channel\cb.");
1988 next;
1989 }
1990 next if $who->{op};
1991 unless (has_local_flag($context, $chatnet, $channel, 'm')) {
1992 my $address = $who->{host};
1993 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address;
1994 if (!defined $flags->{o} && defined $flags->{d}) {
1995 $context->{error}("I refuse to op \cb$nick\cb on \cb$channel\cb - has \cc9+d\co flag.");
1996 next;
1997 }
1998 }
1999 push @good, $nick;
2000 }
2001 if (@good) {
2002 my $cmd = "+" . "o" x @good . " @good";
2003 channel_notice $server, $channel, "mode/$channel [$cmd] by $context->{nick}";
2004 $server->command("mode $channel $cmd");
2005 }
2006 }
2007
2008 sub cmd_deop($$) {
2009 my ($context, $args) = @_;
2010 must_be_operator $context or return;
2011 unless ($args =~ /^ *$channel_re(?: +$nicks_re)? *$/o) {
2012 $context->{usage}("deop <#channel> [<nick>]...");
2013 return;
2014 }
2015 my ($channel, $nicks) = (lc $1, $2);
2016 my @nicks = defined $nicks ? split ' ', $nicks : ($context->{nick});
2017 my $server = $context->{server};
2018 my $chatnet = lc $server->{chatnet};
2019 must_be_channel_operator $context, $chatnet, $channel or return;
2020 my $chan = find_channel $context, $channel, 1 or return;
2021 my @good = ();
2022 foreach my $nick (@nicks) {
2023 my $who = $chan->nick_find($nick);
2024 unless ($who) {
2025 $context->{error}("\cb$nick\cb is not on \cb$channel\cb.");
2026 next;
2027 }
2028 next unless $who->{op};
2029 unless (has_local_flag($context, $chatnet, $channel, 'm')) {
2030 if ($nick eq $server->{nick}) {
2031 $context->{error}("I refuse to deop myself on \cb$channel\cb.");
2032 next;
2033 }
2034 my $address = $who->{host};
2035 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address;
2036 if (defined $flags->{r} && $nick ne $context->{nick}) {
2037 $context->{error}("I refuse to deop \cb$nick\cb on \cb$channel\cb - has \cc9+r\co flag.");
2038 next;
2039 }
2040 }
2041 push @good, $nick;
2042 }
2043 if (@good) {
2044 my $cmd = "-" . "o" x @good . " @good";
2045 channel_notice $server, $channel, "mode/$channel [$cmd] by $context->{nick}";
2046 $server->command("mode $channel $cmd");
2047 }
2048 }
2049
2050 sub cmd_voice($$) {
2051 my ($context, $args) = @_;
2052 must_be_operator $context or return;
2053 unless ($args =~ /^ *$channel_re(?: +$nicks_re)? *$/o) {
2054 $context->{usage}("voice <#channel> [<nick>]...");
2055 return;
2056 }
2057 my ($channel, $nicks) = (lc $1, $2);
2058 my @nicks = defined $nicks ? split ' ', $nicks : ($context->{nick});
2059 my $server = $context->{server};
2060 my $chatnet = lc $server->{chatnet};
2061 must_be_channel_operator $context, $chatnet, $channel or return;
2062 my $chan = find_channel $context, $channel, 1 or return;
2063 my @good = ();
2064 foreach my $nick (@nicks) {
2065 my $who = $chan->nick_find($nick);
2066 unless ($who) {
2067 $context->{error}("\cb$nick\cb is not on \cb$channel\cb.");
2068 next;
2069 }
2070 next if $who->{voice};
2071 unless (has_local_flag($context, $chatnet, $channel, 'm')) {
2072 my $address = $who->{host};
2073 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address;
2074 if (!defined $flags->{v} && defined $flags->{q}) {
2075 $context->{error}("I refuse to voice \cb$nick\cb on \cb$channel\cb - has \cc9+q\co flag.");
2076 next;
2077 }
2078 }
2079 push @good, $nick;
2080 }
2081 if (@good) {
2082 my $cmd = "+" . "v" x @good . " @good";
2083 channel_notice $server, $channel, "mode/$channel [$cmd] by $context->{nick}";
2084 $server->command("mode $channel $cmd");
2085 }
2086 }
2087
2088 sub cmd_devoice($$) {
2089 my ($context, $args) = @_;
2090 must_be_operator $context or return;
2091 unless ($args =~ /^ *$channel_re(?: +$nicks_re)? *$/o) {
2092 $context->{usage}("devoice <#channel> [<nick>]...");
2093 return;
2094 }
2095 my ($channel, $nicks) = (lc $1, $2);
2096 my @nicks = defined $nicks ? split ' ', $nicks : ($context->{nick});
2097 my $server = $context->{server};
2098 my $chatnet = lc $server->{chatnet};
2099 must_be_channel_operator $context, $chatnet, $channel or return;
2100 my $chan = find_channel $context, $channel, 1 or return;
2101 my @good = ();
2102 foreach my $nick (@nicks) {
2103 my $who = $chan->nick_find($nick);
2104 unless ($who) {
2105 $context->{error}("\cb$nick\cb is not on \cb$channel\cb.");
2106 next;
2107 }
2108 next unless $who->{voice};
2109 push @good, $nick;
2110 }
2111 if (@good) {
2112 my $cmd = "-" . "v" x @good . " @good";
2113 channel_notice $server, $channel, "mode/$channel [$cmd] by $context->{nick}";
2114 $server->command("mode $channel $cmd");
2115 }
2116 }
2117
2118 sub cmd_kick($$) {
2119 my ($context, $args) = @_;
2120 must_be_operator $context or return;
2121 unless ($args =~ /^ *$channel_re +$nicks_commas_re(| .*)$/o) {
2122 $context->{usage}("kick <#channel> <nicks> [<reason>]");
2123 return;
2124 }
2125 my ($channel, $nicks, $reason) = (lc $1, $2, $3);
2126 my @nicks = split /,/, $nicks;
2127 my $server = $context->{server};
2128 my $chatnet = lc $server->{chatnet};
2129 must_be_channel_operator $context, $chatnet, $channel or return;
2130 my $chan = find_channel $context, $channel, 1 or return;
2131 $reason = " $context->{nick}" if $reason =~ /^ ?$/;
2132 $reason =~ s/^ //;
2133 foreach my $nick (@nicks) {
2134 my $who = $chan->nick_find($nick);
2135 unless ($who) {
2136 $context->{error}("\cb$nick\cb is not on \cb$channel\cb.");
2137 next;
2138 }
2139 unless (has_local_flag($context, $chatnet, $channel, 'm')) {
2140 if ($nick eq $server->{nick}) {
2141 $context->{error}("I refuse to kick myself from \cb$channel\cb.");
2142 next;
2143 }
2144 }
2145 channel_notice $server, $channel, "$nick was kicked from $channel by $context->{nick} [$reason]";
2146 $server->command("kick $channel $nick $reason");
2147 }
2148 }
2149
2150 sub cmd_ban($$) {
2151 my ($context, $args) = @_;
2152 must_be_operator $context or return;
2153 unless ($args =~ /^ *$channel_re +$masks_re *$/o) {
2154 $context->{usage}("ban <#channel> <mask/nick>...");
2155 return;
2156 }
2157 my ($channel, $masks) = (lc $1, $2);
2158 my @masks = split ' ', $masks;
2159 my $server = $context->{server};
2160 my $chatnet = lc $server->{chatnet};
2161 must_be_channel_operator $context, $chatnet, $channel or return;
2162 my $chan = find_channel $context, $channel, 1 or return;
2163 my @good = ();
2164 foreach my $mask (@masks) {
2165 if ($mask !~ /!/) {
2166 if ($mask =~ /\@/) {
2167 $mask = "*!$mask";
2168 } else {
2169 my $who = $chan->nick_find($mask);
2170 unless ($who) {
2171 $context->{error}("\cb$mask\cb is not on \cb$channel\cb.");
2172 next;
2173 }
2174 my $address = $who->{host};
2175 if ($address eq '') {
2176 $context->{error}("Sorry, I don't know \cb$mask\cb's address yet.");
2177 next;
2178 }
2179 $mask = "*!" . improve_mask $address;
2180 }
2181 }
2182 push @good, $mask;
2183 }
2184 if (@good) {
2185 my $cmd = "+" . "b" x @good . " @good";
2186 channel_notice $server, $channel, "mode/$channel [$cmd] by $context->{nick}";
2187 $server->command("mode $channel $cmd");
2188 }
2189 }
2190
2191 sub cmd_unban($$) {
2192 my ($context, $args) = @_;
2193 must_be_operator $context or return;
2194 unless ($args =~ /^ *$channel_re(?: +$masks_re)? *$/o) {
2195 $context->{usage}("unban <#channel> [<masks>]");
2196 return;
2197 }
2198 my ($channel, $masks) = (lc $1, $2);
2199 my $server = $context->{server};
2200 my $chatnet = lc $server->{chatnet};
2201 must_be_channel_operator $context, $chatnet, $channel or return;
2202 my $chan = find_channel $context, $channel, 1 or return;
2203 my @masks = ();
2204 if (defined $masks) {
2205 @masks = split ' ', $masks;
2206 } else {
2207 my $nick = $context->{nick};
2208 my $address = $context->{address};
2209 foreach my $ban ($chan->bans()) {
2210 push @masks, $ban->{ban}
2211 if Irssi::mask_match_address($ban->{ban}, $nick, $address);
2212 }
2213 unless (@masks) {
2214 $context->{notice}("There are no bans against you on \cb$channel\cb.");
2215 return;
2216 }
2217 }
2218 my $cmd = "-" . "b" x @masks . " @masks";
2219 channel_notice $server, $channel, "mode/$channel [$cmd] by $context->{nick}";
2220 $server->command("mode $channel $cmd");
2221 unless (defined $masks) {
2222 $context->{notice}("Any bans against you on \cb$channel\cb have been cleared.");
2223 }
2224 }
2225
2226 sub cmd_kickban($$) {
2227 my ($context, $args) = @_;
2228 must_be_operator $context or return;
2229 unless ($args =~ /^ *$channel_re +$nicks_commas_re(| .*)$/o) {
2230 $context->{usage}("kickban <#channel> <nicks> [<reason>]");
2231 return;
2232 }
2233 my ($channel, $nicks, $reason) = (lc $1, $2, $3);
2234 my @nicks = split /,/, $nicks;
2235 my $server = $context->{server};
2236 my $chatnet = lc $server->{chatnet};
2237 must_be_channel_operator $context, $chatnet, $channel or return;
2238 my $chan = find_channel $context, $channel, 1 or return;
2239 $reason = " $context->{nick}" if $reason =~ /^ ?$/;
2240 $reason =~ s/^ //;
2241 foreach my $nick (@nicks) {
2242 my $who = $chan->nick_find($nick);
2243 unless ($who) {
2244 $context->{error}("\cb$nick\cb is not on \cb$channel\cb.");
2245 next;
2246 }
2247 unless (has_local_flag($context, $chatnet, $channel, 'm')) {
2248 if ($nick eq $server->{nick}) {
2249 $context->{error}("I refuse to kick myself from \cb$channel\cb.");
2250 next;
2251 }
2252 }
2253 my $address = $who->{host};
2254 if ($address eq '') {
2255 $context->{error}("Sorry, I don't know \cb$nick\cb's address yet.");
2256 } else {
2257 ban $server, $channel, $nick, $address, $$who->{op}, {};
2258 }
2259 channel_notice $server, $channel, "$nick was kicked from $channel by $context->{nick} [$reason]";
2260 $server->command("kick $channel $nick $reason");
2261 }
2262 }
2263
2264 sub cmd_invite($$) {
2265 my ($context, $args) = @_;
2266 must_be_operator $context or return;
2267 my ($channel, $nick);
2268 if ($args =~ /^ *$channel_re(?: +$nick_re)? *$/o) {
2269 ($channel, $nick) = (lc $1, $2);
2270 } elsif ($args =~ /^ *$nick_re +$channel_re *$/o) {
2271 ($nick, $channel) = ($1, lc $2);
2272 } else {
2273 $context->{usage}("invite <#channel> [<nick>]");
2274 return;
2275 }
2276 $nick = $context->{nick} unless defined $nick;
2277 my $server = $context->{server};
2278 my $chatnet = lc $server->{chatnet};
2279 must_be_channel_operator $context, $chatnet, $channel or return;
2280 my $chan = find_channel $context, $channel, 1 or return;
2281 if ($chan->nick_find($nick)) {
2282 $context->{error}("\cb$nick\cb is already on \cb$channel\cb");
2283 return;
2284 }
2285 channel_notice $server, "$nick,$channel", "$context->{nick} invited $nick into $channel";
2286 $server->command("invite $nick $channel");
2287 }
2288
2289 ######## AUTHENTICATION ########
2290
2291 sub must_have_crypt($) {
2292 my ($context) = @_;
2293 $context->{error}("Sorry, passwords don't work here - Crypt::PasswdMD5 module not found.")
2294 unless $has_crypt;
2295 return $has_crypt;
2296 }
2297
2298 our @salt_chars = ('.', '/', '0'..'9', 'A'..'Z', 'a'..'z');
2299
2300 sub crypt_new_password($) {
2301 my ($password) = @_;
2302 my $salt = join('', map {$salt_chars[rand @salt_chars]} (1..8));
2303 return unix_md5_crypt($password, $salt);
2304 }
2305
2306 sub check_password($$) {
2307 my ($password, $required) = @_;
2308 return $required eq unix_md5_crypt($password, $required);
2309 }
2310
2311 sub cmd_pass($$) {
2312 my ($context, $args) = @_;
2313 unless ($args =~ /^ *([^ ]+)(?: +([^ ]+))? *$/) {
2314 $context->{usage} ("pass <password> - authenticate or set password for the first time");
2315 $context->{usage_next}("pass <password> <new-password> - change password");
2316 return;
2317 }
2318 my ($password, $new_password) = ($1, $2);
2319 my $server = $context->{server};
2320 my $chatnet = lc $server->{chatnet};
2321 my $nick = $context->{nick};
2322 my $address = $context->{address};
2323 my $password_set = 0;
2324 my $right_password = 0;
2325 my $wrong_password = 0;
2326 foreach my $user (find_users undef, $nick, $address) {
2327 my ($hdl, $mask) = @$user;
2328 my $required = $user_flags{$hdl}{p};
2329 next unless defined $required;
2330 must_have_crypt $context or return;
2331 my $who_nick = "\cc11$nick\co \cc14[\cc10$address\cc14]\co";
2332 my $who_hdl = "\cc04$handles{$hdl}\co";
2333 if ($required ne '' && !check_password($password, $required)) {
2334 print CLIENTNOTICE "$who_nick gave \cbwrong\cb password for $who_hdl.";
2335 $wrong_password = 1;
2336 next;
2337 }
2338 if ($required eq '' || defined $new_password) {
2339 $password = $new_password if defined $new_password;
2340 $user_flags{$hdl}{p} = crypt_new_password $password;
2341 print CLIENTNOTICE "$who_nick \cbset\cb the password for $who_hdl.";
2342 $password_set = 1;
2343 } else {
2344 print CLIENTNOTICE "$who_nick gave \cbright\cb password for $who_hdl.";
2345 $right_password = 1;
2346 }
2347 $authenticated{$chatnet}{$address}{$hdl} = 1;
2348 maybe_disappears $chatnet, $server, undef, $nick, $address;
2349 foreach my $chan ($server->channels()) {
2350 next unless $chan->{wholist};
2351 next unless $chan->{chanop};
2352 my $channel = lc $chan->{name};
2353 # nick_find_mask() only returns one nick.
2354 foreach my $who (grep { $_->{host} eq $address } $chan->nicks()) {
2355 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address;
2356 next if defined $flags->{x};
2357 if (defined $flags->{r} || defined $flags->{o}) {
2358 queue_action $chatnet, '+o', $channel, $who->{nick};
2359 }
2360 if (defined $flags->{v}) {
2361 queue_action $chatnet, '+v', $channel, $who->{nick};
2362 }
2363 # FIXME: flag +e?
2364 }
2365 }
2366 }
2367 if ($password_set || $right_password) {
2368 $context->{notice}("Your password has been set.") if $password_set;
2369 $context->{notice}("Right password.") if $right_password;
2370 } elsif ($wrong_password) {
2371 $context->{error}("Wrong password.");
2372 } else {
2373 $context->{error}("Sorry, I don't recognize you.");
2374 }
2375 save_config if $password_set;
2376 }
2377
2378 ######## LOCAL COMMANDS ########
2379
2380 Irssi::command_bind 'user', sub {
2381 my ($args, $server, $target) = @_;
2382 Irssi::command_runsub 'user', $args, $server, $target;
2383 };
2384
2385 Irssi::command_bind 'mask', sub {
2386 my ($args, $server, $target) = @_;
2387 Irssi::command_runsub 'mask', $args, $server, $target;
2388 };
2389
2390 sub local_command($$) {
2391 my ($command, $func) = @_;
2392 Irssi::command_bind $command, sub {
2393 my ($args, $server, $target) = @_;
2394 $func->($local_context, $args);
2395 };
2396 $local_help{$command} = 1;
2397 }
2398
2399 local_command 'help', \&cmd_help;
2400 delete $local_help{help};
2401 local_command 'user add', \&cmd_user_add;
2402 local_command 'user remove', \&cmd_user_remove;
2403 local_command 'mask add', \&cmd_mask_add;
2404 local_command 'mask remove', \&cmd_mask_remove;
2405 local_command 'user rename', \&cmd_user_rename;
2406 local_command 'user list', \&cmd_user_list;
2407 local_command 'flag', \&cmd_flag;
2408 local_command 'find', \&cmd_find;
2409 local_command 'trust', \&cmd_trust;
2410
2411 ######## RESPOND TO MESSAGES ########
2412
2413 our %commands;
2414
2415 sub run_subcommand($$$) {
2416 my ($command, $context, $args) = @_;
2417 if ($args =~ / *([a-zA-Z]+)(| .*)$/) {
2418 my ($subcommand, $subargs) = ($1, $2);
2419 my $func = $commands{"$command " . lc $subcommand} or return;
2420 $func->($context, $subargs);
2421 }
2422 }
2423
2424 %commands = (
2425 help => \&cmd_help,
2426 user => sub {&run_subcommand('user', @_)},
2427 mask => sub {&run_subcommand('mask', @_)},
2428 'user add' => \&cmd_user_add,
2429 'user remove' => \&cmd_user_remove,
2430 'mask add' => \&cmd_mask_add,
2431 'mask remove' => \&cmd_mask_remove,
2432 'user rename' => \&cmd_user_rename,
2433 'user list' => \&cmd_user_list,
2434 flag => \&cmd_flag,
2435 find => \&cmd_find,
2436 trust => \&cmd_trust,
2437 op => \&cmd_op,
2438 deop => \&cmd_deop,
2439 voice => \&cmd_voice,
2440 devoice => \&cmd_devoice,
2441 kick => \&cmd_kick,
2442 ban => \&cmd_ban,
2443 unban => \&cmd_unban,
2444 kickban => \&cmd_kickban,
2445 invite => \&cmd_invite,
2446 pass => \&cmd_pass,
2447 );
2448
2449 sub remote_command($$$$$$) {
2450 my ($server, $msg, $nick, $address, $reply, $prefix) = @_;
2451 return 0 unless $msg =~ /^([a-zA-Z]+)(| .*)$/;
2452 my ($command, $args) = ($1, $2);
2453 my $func = $commands{lc $command} or return 0;
2454 my $chatnet = lc $server->{chatnet};
2455 my ($globals, $locals) = find_all_flags $chatnet, $nick, $address;
2456 my $context = {
2457 crap => sub {$server->command("$reply $nick $_[0]")},
2458 notice => sub {$server->command("$reply $nick $_[0]")},
2459 error => sub {$server->command("$reply $nick $_[0]")},
2460 usage => sub {$server->command("$reply $nick Usage: $prefix$_[0]")},
2461 usage_next => sub {$server->command("$reply $nick $prefix$_[0]")},
2462 owner => 0,
2463 globals => $globals,
2464 locals => $locals,
2465 set_flags => \%master_set_flags,
2466 set_flags_str => $master_set_flags,
2467 see_flags => \%master_see_flags,
2468 server => $server,
2469 nick => $nick,
2470 address => $address,
2471 };
2472 $func->($context, $args);
2473 return 1;
2474 }
2475
2476 Irssi::signal_add_last 'message private', sub {
2477 my ($server, $msg, $nick, $address) = @_;
2478 return unless $msg =~ /^!(.*)$/;
2479 Irssi::signal_continue @_;
2480 remote_command $server, $1, $nick, $address, "notice", "!";
2481 };
2482
2483 Irssi::signal_add_last "ctcp msg", sub {
2484 my ($server, $args, $nick, $address, $target) = @_;
2485 return unless lc $target eq lc $server->{nick};
2486 remote_command $server, $args, $nick, $address, "notice", ""
2487 and Irssi::signal_stop;
2488 };
2489
2490 ######## INITIALIZATION ########
2491
2492 load_config;