1use strict; 2use 5.005_62; # for 'our' 3use Irssi 20020428; # for Irssi::signal_continue 4use Time::HiRes; 5use vars qw($VERSION %IRSSI); 6 7our $has_crypt = 0; 8eval {require Crypt::PasswdMD5}; 9unless ($@) { 10 $has_crypt = 1; 11 import Crypt::PasswdMD5; 12} 13 14$VERSION = "1.8"; 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 28our %handles; 29our %user_masks; 30our %user_flags; 31our %channel_flags; 32our %user_channel_flags; 33our %authenticated = (); 34our %expire_auth = (); 35 36our $config = Irssi::get_irssi_dir . "/people.cfg"; 37our $config_tmp = Irssi::get_irssi_dir . "/people.tmp"; 38our $config_old = Irssi::get_irssi_dir . "/people.cfg~"; 39 40Irssi::settings_add_bool 'people', 'people_autosave', 1; 41Irssi::settings_add_int 'people', 'people_op_delay_min', 10; 42Irssi::settings_add_int 'people', 'people_op_delay_max', 20; 43Irssi::settings_add_str 'people', 'people_default_chatnet', "DALnet"; 44Irssi::settings_add_bool 'people', 'people_color_friends', 0; 45Irssi::settings_add_bool 'people', 'people_color_everybody', 0; 46Irssi::settings_add_int 'people', 'people_expire_password', 60; 47Irssi::settings_add_bool 'people', 'people_channel_notice', 1; 48Irssi::settings_add_str 'people', 'people_colors', "rgybmcRGYBMC"; 49 50our $handle_re = qr/([^\0- &#+!,\-\177][^\0- ,\177]*)/; 51our $mask_re = qr/([^\0- \177]+)/; 52our $masks_re = qr/([^\0- \177]+(?: +[^\0- \177]+)*)/; 53our $opt_masks_re = qr/((?: +[^\0- \177]+)*)/; 54our $chatnet_re = qr/([\w-._]+)/; 55our $channel_re = qr/([&#+!][^\0- ,\177]*)/; 56our $channels_re = qr/([&#+!][^\0- ,\177]*(?:,[&#+!][^\0- ,\177]*)*)/; 57our $mask_re = qr/([^\0- \177]+)/; 58our $flags_re = qr/((?:[+\-!][a-zA-Z]+)+)/; 59our $arg_re = qr/(?: (.*))?/; 60our $nick_re = qr/([A-}][\-0-9A-}]*)/; 61our $nicks_re = qr/([A-}][\-0-9A-}]*(?: +[A-}][\-0-9A-}]*)*)/; 62our $nicks_commas_re = qr/([A-}][\-0-9A-}]*(?:,[A-}][\-0-9A-}]*)*)/; 63 64our $master_set_flags = 'deikmopqrvx'; 65our $master_see_flags = 'deiklmopqrvx'; 66our $all_flags = 'cdeiklmnopqrvx'; 67 68sub tr_flag { 69 my ($flag) = @_; 70 $flag =~ tr/CIL/cil/; 71 return $flag; 72} 73 74our %master_set_flags = map {$_ => 1} split //, $master_set_flags; 75our %master_see_flags = map {$_ => 1} split //, $master_see_flags; 76our %all_flags = map {$_ => 1} split //, $all_flags; 77 78######## HELP ######## 79 80our $help_commands = 81 82our %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 331our %local_help = (people => 1); 332 333sub 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 350our %mask_to_regexp = (); 351foreach 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 358sub mask_to_regexp($) { 359 my ($mask) = @_; 360 $mask =~ s/(.)/$mask_to_regexp{$1}/g; 361 return $mask; 362} 363 364our $all_masks; 365 366sub 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 377our $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 392sub has_global_flag($$) { 393 my ($context, $flag) = @_; 394 return $context->{owner} || defined $context->{globals}{$flag}; 395} 396 397sub 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 408sub 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 422sub 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 429sub 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 437sub 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 463sub 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 484sub 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 502sub 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 511sub 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 520sub 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 535sub 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 564sub 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 593sub 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 624sub 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 633sub 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 642sub 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 660sub 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 694sub 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 703sub 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 761sub 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 785sub 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 792sub 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 840sub channel_notice($$$) { 841 my ($server, $channel, $msg) = @_; 842 $server->command("notice $channel -!- $msg") 843 if Irssi::settings_get_bool('people_channel_notice'); 844} 845 846sub 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 855sub 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 868sub 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 877sub 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 888our %queued_actions = (); 889 890our %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. 898sub 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. 923sub 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 959sub 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 969sub 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 977sub 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 984sub 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 1001sub 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 1008sub 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 1014sub kick($$$$) { 1015 my ($server, $channel, $nick, $flags) = @_; 1016 $server->command("kick $channel $nick" . ($flags->{k} eq '' ? "" : " $flags->{k}")); 1017} 1018 1019sub 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 1030sub 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 1043sub 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 1052sub 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 1076Irssi::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 1102sub 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 1117Irssi::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 1127Irssi::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 1136sub 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 1145Irssi::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 1179Irssi::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 1192Irssi::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 1214Irssi::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 1231Irssi::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 1276sub 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 1286Irssi::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 1310sub 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 1323sub 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 1335sub 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 1342sub 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 1349sub 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 1359sub show_flag($$) { 1360 my ($flag, $arg) = @_; 1361 return defined $arg ? $arg eq '' ? "+$flag" : "+$flag $arg" : "-$flag"; 1362} 1363 1364sub 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 1405sub autosave_config() { 1406 save_config if Irssi::settings_get_bool 'people_autosave'; 1407} 1408 1409Irssi::signal_add 'setup saved', sub { 1410 my ($main_config, $auto) = @_; 1411 save_config unless $auto; 1412}; 1413 1414sub 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 1424sub load_config() { 1425 %handles = (); 1426 %user_masks = (); 1427 %user_flags = (); 1428 %channel_flags = (); 1429 %user_channel_flags = (); 1430 local $/ = "\n"; 1431 open CONFIG, $config or return; 1432 while (<CONFIG>) { 1433 chomp; 1434 next if /^ *$/ || /^#/; 1435 if (/^user +$handle_re$opt_masks_re *$/o) { 1436 my ($handle, $masks) = ($1, $2); 1437 $handles{lc $handle} = $handle; 1438 $user_masks{lc $handle} = [unique_masks(split(' ', $masks))]; 1439 } elsif (/^flag +$handle_re +$chatnet_re\/$channel_re +\+([a-zA-Z])$arg_re$/o) { 1440 my ($handle, $chatnet, $channel, $flag, $arg) = ($1, $2, $3, $4, $5); 1441 $flag = tr_flag $flag; 1442 $arg = '' unless defined $arg; 1443 $user_channel_flags{lc $handle}{$chatnet}{$channel}{$flag} = $arg; 1444 } elsif (/^flag +$handle_re +$chatnet_re\/$channel_re +-([a-zA-Z]) *$/o) { 1445 my ($handle, $chatnet, $channel, $flag) = ($1, $2, $3, $4); 1446 $flag = tr_flag $flag; 1447 $user_channel_flags{lc $handle}{$chatnet}{$channel}{$flag} = undef; 1448 } elsif (/^flag +$chatnet_re\/$channel_re +\+([a-zA-Z])$arg_re$/o) { 1449 my ($chatnet, $channel, $flag, $arg) = ($1, $2, $3, $4); 1450 $flag = tr_flag $flag; 1451 $arg = '' unless defined $arg; 1452 $channel_flags{$chatnet}{$channel}{$flag} = $arg; 1453 } elsif (/^flag +$chatnet_re\/$channel_re +-([a-zA-Z]) *$/o) { 1454 my ($chatnet, $channel, $flag) = ($1, $2, $3); 1455 $flag = tr_flag $flag; 1456 $channel_flags{$chatnet}{$channel}{$flag} = undef; 1457 } elsif (/^flag +$handle_re +\+([a-zA-Z])$arg_re$/o) { 1458 my ($handle, $flag, $arg) = ($1, $2, $3); 1459 $flag = tr_flag $flag; 1460 $arg = '' unless defined $arg; 1461 $user_flags{lc $handle}{$flag} = $arg; 1462 } elsif (/^flag +$handle_re +-([a-zA-Z]) *$/o) { 1463 my ($handle, $flag) = ($1, $2); 1464 $flag = tr_flag $flag; 1465 $user_flags{lc $handle}{$flag} = undef; 1466 } else { 1467 print CLIENTERROR "Syntax error in $config: $_"; 1468 } 1469 } 1470 update_all_masks; 1471 all_changed; 1472} 1473 1474Irssi::signal_add 'setup reread', \&load_config; 1475 1476######## MANAGE THE USER LIST ######## 1477 1478sub find_nick($) { 1479 my ($nick) = @_; 1480 foreach my $chan (Irssi::channels) { 1481 my $who = $chan->nick_find($nick) or next; 1482 my $address = $who->{host}; 1483 return $address if $address ne ''; 1484 } 1485 return undef; 1486} 1487 1488sub find_server_nick($$) { 1489 my ($server, $nick) = @_; 1490 foreach my $chan ($server->channels) { 1491 my $who = $chan->nick_find($nick) or next; 1492 my $address = $who->{host}; 1493 return $address if $address ne ''; 1494 } 1495 return undef; 1496} 1497 1498sub guess_mask($) { 1499 my ($nick) = @_; 1500 my $address = find_nick $nick; 1501 return defined $address ? (improve_mask $address) : (); 1502} 1503 1504sub cmd_user_add($$) { 1505 my ($context, $args) = @_; 1506 must_be_master $context or return; 1507 unless ($args =~ /^ *$handle_re$opt_masks_re *$/o) { 1508 $context->{usage}("user add <handle> <mask>..."); 1509 return; 1510 } 1511 my ($handle, $masks) = ($1, $2); 1512 my $hdl = lc $handle; 1513 if (defined $handles{$hdl}) { 1514 $context->{error}("User \cc04$handles{$hdl}\co already exists"); 1515 return; 1516 } 1517 my @masks = split(' ', $masks); 1518 @masks = guess_mask $handle unless @masks; 1519 @masks = unique_masks(@masks); 1520 $handles{$hdl} = $handle; 1521 $user_masks{$hdl} = [@masks]; 1522 $user_flags{$hdl}{l} = '' 1523 unless $context->{owner} || defined $context->{globals}{m}; 1524 if (@masks) { 1525 my $plural = @masks == 1 ? "" : "s"; 1526 $context->{notice}("Added user \cc04$handle\co with address mask$plural \cc10@masks\co"); 1527 } else { 1528 $context->{notice}("Added user \cc04$handle\co with no address masks."); 1529 } 1530 update_all_masks; 1531 user_changed $hdl; 1532 autosave_config; 1533} 1534 1535sub cmd_user_remove($$) { 1536 my ($context, $args) = @_; 1537 must_be_master $context or return; 1538 unless ($args =~ /^ *$handle_re *$/o) { 1539 $context->{usage}("user remove <handle>"); 1540 return; 1541 } 1542 my $handle = $1; 1543 handle_exists $context, $handle or return; 1544 my $hdl = lc $handle; 1545 may_manage $context, $hdl or return; 1546 $context->{notice}("Removed user \cc04$handles{$hdl}\co."); 1547 delete $user_flags{$hdl}; 1548 delete $user_channel_flags{$hdl}; 1549 user_changed $hdl; 1550 delete $handles{$hdl}; 1551 delete $user_masks{$hdl}; 1552 update_all_masks; 1553 autosave_config; 1554}; 1555 1556sub cmd_mask_add($$) { 1557 my ($context, $args) = @_; 1558 must_be_master $context or return; 1559 unless ($args =~ /^ *$handle_re +$masks_re *$/o) { 1560 $context->{usage}("mask add <handle> <mask>..."); 1561 return; 1562 } 1563 my ($handle, $masks) = ($1, $2); 1564 handle_exists $context, $handle or return; 1565 my $hdl = lc $handle; 1566 may_manage $context, $hdl or return; 1567 my %masks = map {$_ => 1} @{$user_masks{$hdl}}; 1568 foreach my $mask (unique_masks(split(' ', $masks))) { 1569 $masks{$mask} = 1; 1570 } 1571 $user_masks{$hdl} = [sort keys %masks]; 1572 show_handle $context, $hdl; 1573 update_all_masks; 1574 user_changed $hdl; 1575 autosave_config; 1576} 1577 1578sub cmd_mask_remove($$) { 1579 my ($context, $args) = @_; 1580 must_be_master $context or return; 1581 unless ($args =~ /^ *$handle_re +$masks_re *$/o) { 1582 $context->{usage}("mask remove <handle> <mask>..."); 1583 return; 1584 } 1585 my ($handle, $masks) = ($1, $2); 1586 handle_exists $context, $handle or return; 1587 my $hdl = lc $handle; 1588 may_manage $context, $hdl or return; 1589 my %masks = map {$_ => 1} @{$user_masks{$hdl}}; 1590 foreach my $mask (unique_masks(split(' ', $masks))) { 1591 delete $masks{$mask}; 1592 } 1593 $user_masks{$hdl} = [sort keys %masks]; 1594 show_handle $context, $hdl; 1595 update_all_masks; 1596 user_changed $hdl; 1597 autosave_config; 1598} 1599 1600sub cmd_user_rename($$) { 1601 my ($context, $args) = @_; 1602 must_be_master $context or return; 1603 unless ($args =~ /^ *$handle_re +$handle_re *$/o) { 1604 $context->{usage}("user rename <handle> <new-handle>"); 1605 return; 1606 } 1607 my ($old_handle, $new_handle) = ($1, $2); 1608 handle_exists $context, $old_handle or return; 1609 my $old_hdl = lc $old_handle; 1610 my $new_hdl = lc $new_handle; 1611 may_manage $context, $old_hdl or return; 1612 if ($new_hdl ne $old_hdl && defined $handles{$new_hdl}) { 1613 $context->{error}("User \cc04$handles{$new_hdl}\co already exists."); 1614 return; 1615 } 1616 $handles{$new_hdl} = $new_handle; 1617 if ($new_hdl ne $old_hdl) { 1618 delete $handles{$old_hdl}; 1619 $user_masks{$new_hdl} = $user_masks{$old_hdl}; 1620 delete $user_masks{$old_hdl}; 1621 if ($user_flags{$old_hdl}) { 1622 $user_flags{$new_hdl} = $user_flags{$old_hdl}; 1623 delete $user_flags{$old_hdl}; 1624 } 1625 if ($user_channel_flags{$old_hdl}) { 1626 $user_channel_flags{$new_hdl} = $user_channel_flags{$old_hdl}; 1627 delete $user_channel_flags{$old_hdl}; 1628 } 1629 } 1630 $context->{notice}("Renamed user \cc04$old_handle\co to \cc04$new_handle\co."); 1631 autosave_config; 1632} 1633 1634######## MANAGE FLAGS ######## 1635 1636sub flag_usage($) { 1637 my ($context) = @_; 1638 $context->{usage} ("flag <handle>"); 1639 $context->{usage_next}("flag [<chatnet>/]<#channels>"); 1640 $context->{usage_next}("flag <handle> <flags>"); 1641 $context->{usage_next}("flag [<chatnet>/]<#channels> <flags>"); 1642 $context->{usage_next}("flag <handle> [<chatnet>/]<#channels> <flags>"); 1643 $context->{error}("<flags> is (+<letter>...|-<letter>...)..."); 1644 $context->{error}("The last +<letter> may be followed by space and <argument>"); 1645} 1646 1647sub parse_flags($) { 1648 my ($flags) = @_; 1649 return map { 1650 my ($dir, $force) = /^\+/ ? ('', 0) : /^-/ ? (undef, 0) : (undef, 1); 1651 map {[$_, $dir, $force]} (/[a-zA-Z]/g) 1652 } ($flags =~ /[+\-!][a-zA-Z]+/g); 1653} 1654 1655sub cmd_flag($$) { 1656 my ($context, $args) = @_; 1657 must_be_master $context or return; 1658 if ($args =~ /^ *(?:$chatnet_re\/)?$channels_re *$/o) { 1659 my ($chatnet, $channels) = ($1, lc $2); 1660 $chatnet = default_chatnet $context unless defined $chatnet; 1661 $chatnet = lc $chatnet; 1662 foreach my $channel (split /,/, $channels) { 1663 show_channel $context, $chatnet, $channel, 1; 1664 } 1665 return; 1666 } 1667 if ($args =~ /^ *$handle_re *$/o) { 1668 my ($hdl) = lc $1; 1669 show_handle $context, $hdl; 1670 return; 1671 } 1672 unless ($args =~ /^ *(?:$handle_re +)??(?:(?:$chatnet_re\/)?$channels_re +)?$flags_re$arg_re$/o) { 1673 flag_usage $context; return; 1674 } 1675 my ($handle, $chatnet, $channels, $flags, $arg) = ($1, $2, $3, $4, $5); 1676 unless (defined $handle || defined $channels) { 1677 flag_usage $context; return; 1678 } 1679 $arg = '' unless defined $arg; 1680 if (defined $handle) { 1681 handle_exists $context, $handle or return; 1682 } 1683 my $hdl = lc $handle; 1684 my @channels = (); 1685 if (defined $channels) { 1686 $chatnet = default_chatnet $context unless defined $chatnet; 1687 $chatnet = lc $chatnet; 1688 @channels = map {[$chatnet, lc $_]} split /,/, $channels; 1689 } 1690 my @changes = parse_flags $flags; 1691 if ($arg ne '') { 1692 unless (defined $changes[$#changes][1]) { 1693 flag_usage $context; return; 1694 } 1695 $changes[$#changes][1] = $arg; 1696 } 1697 foreach my $change (@changes) { 1698 my ($flag, $arg, $force) = @$change; 1699 my $new_flag = tr_flag $flag; 1700 if ($new_flag ne $flag) { 1701 $context->{error}("Please use \cc9+$new_flag\co instead of \cc9+$flag\co."); 1702 $flag = $new_flag; 1703 $change->[0] = $flag; 1704 } 1705 unless ($context->{set_flags}{$flag}) { 1706 if ($context->{owner}) { 1707 $context->{error}("Warning, only flags \cc9$context->{set_flags_str}\co are meaningful."); 1708 } else { 1709 $context->{error}("Sorry, you can only set flags \cc9$context->{set_flags_str}\co."); 1710 return; 1711 } 1712 } 1713 } 1714 unless ($context->{owner} || defined $context->{globals}{m}) { 1715 if (@channels) { 1716 foreach my $chatnet_channel (@channels) { 1717 my ($chatnet, $channel) = @$chatnet_channel; 1718 unless (defined $context->{locals}{$chatnet}{$channel}{m}) { 1719 $context->{error}("Sorry, you don't have master privileges in \cb$channel\cb."); 1720 return; 1721 } 1722 } 1723 } else { 1724 my $chatnets = $context->{locals}; 1725 foreach my $chatnet (keys %$chatnets) { 1726 my $channels = $chatnets->{$chatnet}; 1727 foreach my $channel (keys %$channels) { 1728 my $flags = $channels->{$channel}; 1729 push @channels, [$chatnet, $channel] if defined $flags->{m}; 1730 } 1731 } 1732 } 1733 } 1734 if (defined $handle) { 1735 if (@channels) { 1736 foreach my $chatnet_channel (@channels) { 1737 my ($chatnet, $channel) = @$chatnet_channel; 1738 my $flags = \%{$user_channel_flags{$hdl}{$chatnet}{$channel}}; 1739 foreach my $change (@changes) { 1740 my ($flag, $arg, $force) = @$change; 1741 my $global = 1742 exists $channel_flags{$chatnet}{$channel}{$flag} ? 1743 $channel_flags{$chatnet}{$channel}{$flag} : 1744 $user_flags{$hdl}{$flag}; 1745 if ($force || 1746 defined $arg != defined $global || 1747 defined $arg && defined $global && 1748 $arg ne $global && $arg ne '') { 1749 $flags->{$flag} = $arg; 1750 } else { 1751 delete $flags->{$flag}; 1752 } 1753 } 1754 } 1755 show_handle $context, $hdl; 1756 foreach my $chatnet_channel (@channels) { 1757 my ($chatnet, $channel) = @$chatnet_channel; 1758 user_channel_changed $hdl, $chatnet, $channel; 1759 } 1760 } else { 1761 my $flags = \%{$user_flags{$hdl}}; 1762 foreach my $change (@changes) { 1763 my ($flag, $arg, $force) = @$change; 1764 if ($force || defined $arg) { 1765 $flags->{$flag} = $arg; 1766 } else { 1767 delete $flags->{$flag}; 1768 } 1769 } 1770 show_handle $context, $hdl; 1771 user_changed $hdl; 1772 } 1773 } else { 1774 foreach my $chatnet_channel (@channels) { 1775 my ($chatnet, $channel) = @$chatnet_channel; 1776 my $flags = \%{$channel_flags{$chatnet}{$channel}}; 1777 foreach my $change (@changes) { 1778 my ($flag, $arg, $force) = @$change; 1779 if ($force || defined $arg) { 1780 $flags->{$flag} = $arg; 1781 } else { 1782 delete $flags->{$flag}; 1783 } 1784 } 1785 show_channel $context, $chatnet, $channel, 1; 1786 channel_changed $chatnet, $channel; 1787 } 1788 } 1789 autosave_config; 1790} 1791 1792######## FIND USERS ######## 1793 1794sub cmd_find($$) { 1795 my ($context, $args) = @_; 1796 if ($args =~ /^ *(?:$chatnet_re\/)?$channel_re *$/o) { 1797 my ($chatnet, $channel) = ($1, lc $2); 1798 must_be_master $context or return; 1799 $chatnet = default_chatnet $context unless defined $chatnet; 1800 $chatnet = lc $chatnet; 1801 my $server = Irssi::server_find_chatnet $chatnet; 1802 unless ($server) { 1803 $context->{error}("Sorry, I'm not connected to $chatnet."); 1804 return; 1805 } 1806 my $chan = $server->channel_find($channel); 1807 unless ($chan) { 1808 $context->{error}("Sorry, I'm not on $channel."); 1809 } 1810 my @people = (); 1811 foreach my $who ($chan->nicks()) { 1812 my $nick = $who->{nick}; 1813 next if $nick eq $server->{nick}; 1814 my $address = $who->{host}; 1815 my ($hdl, $mask) = find_best_user undef, $nick, $address; 1816 next unless defined $hdl; 1817 push @people, [$hdl, $nick, $address]; 1818 } 1819 unless (@people) { 1820 $context->{crap}("I don't recognize any people from \cb$channel\cb."); 1821 return; 1822 } 1823 $context->{crap}("Recognized people on \cb$channel\cb:"); 1824 foreach my $person (sort {$a->[0] cmp $b->[0]} @people) { 1825 my ($hdl, $nick, $address) = @$person; 1826 $context->{crap}(show_who $hdl, $nick, $address); 1827 } 1828 } elsif ($args =~ /^ *$mask_re *$/o) { 1829 my $mask = $1; 1830 must_be_master $context or return; 1831 my ($nick, $address); 1832 if ($mask =~ /^(.*)!(.*)$/) { 1833 ($nick, $address) = ($1, $2); 1834 } elsif ($mask =~ /\@/) { 1835 ($nick, $address) = ('*', $mask); 1836 } else { 1837 $nick = $mask; 1838 $address = find_nick $nick; 1839 unless (defined $address) { 1840 $context->{error}("I don't see \cc11$nick\co on my channels."); 1841 return; 1842 } 1843 } 1844 my @users = find_users undef, $nick, $address; 1845 unless (@users) { 1846 $context->{error}("I don't know who \cc11$nick\co \cc14[\cc10$address\cc14]\co is."); 1847 return; 1848 } 1849 foreach my $user (@users) { 1850 my ($hdl, $mask) = @$user; 1851 my $who = show_who $hdl, $nick, $address; 1852 $context->{crap}("$who \cc14(\cc10$mask\cc14)\co"); 1853 } 1854 } elsif ($context->{owner} && $args =~ /^ *$/) { 1855 my %people = (); 1856 my %channels = (); 1857 foreach my $server (Irssi::servers) { 1858 my $chatnet = lc $server->{chatnet}; 1859 foreach my $chan ($server->channels()) { 1860 my $channel = lc $chan->{name}; 1861 foreach my $who ($chan->nicks()) { 1862 my $nick = $who->{nick}; 1863 next if $nick eq $server->{nick}; 1864 my $address = $who->{host}; 1865 my ($hdl, $mask) = find_best_user undef, $nick, $address; 1866 next unless defined $hdl; 1867 $people{$chatnet}{$nick} = [$address, $hdl]; 1868 push @{$channels{$chatnet}{$nick}}, $channel; 1869 } 1870 } 1871 } 1872 my @people = (); 1873 foreach my $chatnet (keys %people) { 1874 my $nicks = $people{$chatnet}; 1875 foreach my $nick (keys %$nicks) { 1876 my ($address, $hdl) = @{$nicks->{$nick}}; 1877 my $channels = $channels{$chatnet}{$nick}; 1878 push @people, [$hdl, $chatnet, $nick, $address, $channels]; 1879 } 1880 } 1881 foreach my $person (sort {$a->[0] cmp $b->[0]} @people) { 1882 my ($hdl, $chatnet, $nick, $address, $channels) = @$person; 1883 my $who = show_who $hdl, $nick, $address; 1884 my $channels_txt = join(", ", sort @$channels); 1885 $context->{crap}("\cc14[\co$chatnet\cc14]\co $who is on \cb$channels_txt\cb"); 1886 } 1887 } else { 1888 if ($context->{owner}) { 1889 $context->{usage} ("find"); 1890 $context->{usage_next}("find <#channel>"); 1891 } else { 1892 $context->{usage} ("find <#channel>"); 1893 } 1894 $context->{usage_next}("find <mask>"); 1895 $context->{usage_next}("find <nick>"); 1896 } 1897}; 1898 1899######## OPERATOR COMMANDS ######## 1900 1901sub find_channel($$$) { 1902 my ($context, $channel, $need_op) = @_; 1903 my $chan = $context->{server}->channel_find($channel); 1904 if ($chan) { 1905 if ($need_op && !$chan->{chanop}) { 1906 $context->{error}("Sorry, I'm not an operator on \cb$channel\cb."); 1907 return undef; 1908 } 1909 return $chan; 1910 } else { 1911 $context->{error}("Sorry, I'm not on \cb$channel\cb."); 1912 return undef; 1913 } 1914} 1915 1916sub must_be_channel_operator($$$) { 1917 my ($context, $chatnet, $channel) = @_; 1918 return 1 if has_local_flag($context, $chatnet, $channel, 'o') || 1919 has_local_flag($context, $chatnet, $channel, 'm'); 1920 $context->{error}("Sorry, you don't have operator privileges on \cb$channel\cb."); 1921 return 0; 1922} 1923 1924sub cmd_trust($$) { 1925 my ($context, $args) = @_; 1926 must_be_master $context or return; 1927 my @nicks = map { lc } split /\s+/, $args; 1928 my $chatnet = lc default_chatnet $context; 1929 my $server = Irssi::server_find_chatnet $chatnet; 1930 foreach my $nick (@nicks) { 1931 my $address = find_server_nick $server, $nick; 1932 unless (defined $address) { 1933 $context->{error}("I don't see \cc11$nick\co in \cb$chatnet\cb."); 1934 next; 1935 } 1936 my @users = find_users undef, $nick, $address; 1937 unless (@users) { 1938 $context->{error}("I don't recognize \cc11$nick\co."); 1939 } 1940 foreach my $user (@users) { 1941 my ($hdl, $mask) = @$user; 1942 unless (defined $user_flags{$hdl}{p}) { 1943 $context->{error}("\cc04$hdl\co doesn't need a password."); 1944 next; 1945 } 1946 $context->{notice}("Trusting \cc11$nick\co to be \cc04$hdl\co " . 1947 "on \cb$chatnet\cb."); 1948 $authenticated{$chatnet}{$address}{$hdl} = 1; 1949 maybe_disappears $chatnet, $server, undef, $nick, $address; 1950 foreach my $chan ($server->channels()) { 1951 next unless $chan->{wholist}; 1952 next unless $chan->{chanop}; 1953 my $channel = lc $chan->{name}; 1954 # nick_find_mask() only returns one nick. 1955 foreach my $who (grep { $_->{host} eq $address } $chan->nicks()) { 1956 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address; 1957 next if defined $flags->{x}; 1958 if (defined $flags->{r} || defined $flags->{o}) { 1959 queue_action $chatnet, '+o', $channel, $who->{nick}; 1960 } 1961 if (defined $flags->{v}) { 1962 queue_action $chatnet, '+v', $channel, $who->{nick}; 1963 } 1964 # FIXME: flag +e? 1965 } 1966 } 1967 } 1968 } 1969} 1970 1971sub cmd_op($$) { 1972 my ($context, $args) = @_; 1973 must_be_operator $context or return; 1974 unless ($args =~ /^ *$channel_re(?: +$nicks_re)? *$/o) { 1975 $context->{usage}("op <#channel> [<nick>]..."); 1976 return; 1977 } 1978 my ($channel, $nicks) = (lc $1, $2); 1979 my @nicks = defined $nicks ? split ' ', $nicks : ($context->{nick}); 1980 my $server = $context->{server}; 1981 my $chatnet = lc $server->{chatnet}; 1982 must_be_channel_operator $context, $chatnet, $channel or return; 1983 my $chan = find_channel $context, $channel, 1 or return; 1984 my @good = (); 1985 foreach my $nick (@nicks) { 1986 my $who = $chan->nick_find($nick); 1987 unless ($who) { 1988 $context->{error}("\cb$nick\cb is not on \cb$channel\cb."); 1989 next; 1990 } 1991 next if $who->{op}; 1992 unless (has_local_flag($context, $chatnet, $channel, 'm')) { 1993 my $address = $who->{host}; 1994 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address; 1995 if (!defined $flags->{o} && defined $flags->{d}) { 1996 $context->{error}("I refuse to op \cb$nick\cb on \cb$channel\cb - has \cc9+d\co flag."); 1997 next; 1998 } 1999 } 2000 push @good, $nick; 2001 } 2002 if (@good) { 2003 my $cmd = "+" . "o" x @good . " @good"; 2004 channel_notice $server, $channel, "mode/$channel [$cmd] by $context->{nick}"; 2005 $server->command("mode $channel $cmd"); 2006 } 2007} 2008 2009sub cmd_deop($$) { 2010 my ($context, $args) = @_; 2011 must_be_operator $context or return; 2012 unless ($args =~ /^ *$channel_re(?: +$nicks_re)? *$/o) { 2013 $context->{usage}("deop <#channel> [<nick>]..."); 2014 return; 2015 } 2016 my ($channel, $nicks) = (lc $1, $2); 2017 my @nicks = defined $nicks ? split ' ', $nicks : ($context->{nick}); 2018 my $server = $context->{server}; 2019 my $chatnet = lc $server->{chatnet}; 2020 must_be_channel_operator $context, $chatnet, $channel or return; 2021 my $chan = find_channel $context, $channel, 1 or return; 2022 my @good = (); 2023 foreach my $nick (@nicks) { 2024 my $who = $chan->nick_find($nick); 2025 unless ($who) { 2026 $context->{error}("\cb$nick\cb is not on \cb$channel\cb."); 2027 next; 2028 } 2029 next unless $who->{op}; 2030 unless (has_local_flag($context, $chatnet, $channel, 'm')) { 2031 if ($nick eq $server->{nick}) { 2032 $context->{error}("I refuse to deop myself on \cb$channel\cb."); 2033 next; 2034 } 2035 my $address = $who->{host}; 2036 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address; 2037 if (defined $flags->{r} && $nick ne $context->{nick}) { 2038 $context->{error}("I refuse to deop \cb$nick\cb on \cb$channel\cb - has \cc9+r\co flag."); 2039 next; 2040 } 2041 } 2042 push @good, $nick; 2043 } 2044 if (@good) { 2045 my $cmd = "-" . "o" x @good . " @good"; 2046 channel_notice $server, $channel, "mode/$channel [$cmd] by $context->{nick}"; 2047 $server->command("mode $channel $cmd"); 2048 } 2049} 2050 2051sub cmd_voice($$) { 2052 my ($context, $args) = @_; 2053 must_be_operator $context or return; 2054 unless ($args =~ /^ *$channel_re(?: +$nicks_re)? *$/o) { 2055 $context->{usage}("voice <#channel> [<nick>]..."); 2056 return; 2057 } 2058 my ($channel, $nicks) = (lc $1, $2); 2059 my @nicks = defined $nicks ? split ' ', $nicks : ($context->{nick}); 2060 my $server = $context->{server}; 2061 my $chatnet = lc $server->{chatnet}; 2062 must_be_channel_operator $context, $chatnet, $channel or return; 2063 my $chan = find_channel $context, $channel, 1 or return; 2064 my @good = (); 2065 foreach my $nick (@nicks) { 2066 my $who = $chan->nick_find($nick); 2067 unless ($who) { 2068 $context->{error}("\cb$nick\cb is not on \cb$channel\cb."); 2069 next; 2070 } 2071 next if $who->{voice}; 2072 unless (has_local_flag($context, $chatnet, $channel, 'm')) { 2073 my $address = $who->{host}; 2074 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address; 2075 if (!defined $flags->{v} && defined $flags->{q}) { 2076 $context->{error}("I refuse to voice \cb$nick\cb on \cb$channel\cb - has \cc9+q\co flag."); 2077 next; 2078 } 2079 } 2080 push @good, $nick; 2081 } 2082 if (@good) { 2083 my $cmd = "+" . "v" x @good . " @good"; 2084 channel_notice $server, $channel, "mode/$channel [$cmd] by $context->{nick}"; 2085 $server->command("mode $channel $cmd"); 2086 } 2087} 2088 2089sub cmd_devoice($$) { 2090 my ($context, $args) = @_; 2091 must_be_operator $context or return; 2092 unless ($args =~ /^ *$channel_re(?: +$nicks_re)? *$/o) { 2093 $context->{usage}("devoice <#channel> [<nick>]..."); 2094 return; 2095 } 2096 my ($channel, $nicks) = (lc $1, $2); 2097 my @nicks = defined $nicks ? split ' ', $nicks : ($context->{nick}); 2098 my $server = $context->{server}; 2099 my $chatnet = lc $server->{chatnet}; 2100 must_be_channel_operator $context, $chatnet, $channel or return; 2101 my $chan = find_channel $context, $channel, 1 or return; 2102 my @good = (); 2103 foreach my $nick (@nicks) { 2104 my $who = $chan->nick_find($nick); 2105 unless ($who) { 2106 $context->{error}("\cb$nick\cb is not on \cb$channel\cb."); 2107 next; 2108 } 2109 next unless $who->{voice}; 2110 push @good, $nick; 2111 } 2112 if (@good) { 2113 my $cmd = "-" . "v" x @good . " @good"; 2114 channel_notice $server, $channel, "mode/$channel [$cmd] by $context->{nick}"; 2115 $server->command("mode $channel $cmd"); 2116 } 2117} 2118 2119sub cmd_kick($$) { 2120 my ($context, $args) = @_; 2121 must_be_operator $context or return; 2122 unless ($args =~ /^ *$channel_re +$nicks_commas_re(| .*)$/o) { 2123 $context->{usage}("kick <#channel> <nicks> [<reason>]"); 2124 return; 2125 } 2126 my ($channel, $nicks, $reason) = (lc $1, $2, $3); 2127 my @nicks = split /,/, $nicks; 2128 my $server = $context->{server}; 2129 my $chatnet = lc $server->{chatnet}; 2130 must_be_channel_operator $context, $chatnet, $channel or return; 2131 my $chan = find_channel $context, $channel, 1 or return; 2132 $reason = " $context->{nick}" if $reason =~ /^ ?$/; 2133 $reason =~ s/^ //; 2134 foreach my $nick (@nicks) { 2135 my $who = $chan->nick_find($nick); 2136 unless ($who) { 2137 $context->{error}("\cb$nick\cb is not on \cb$channel\cb."); 2138 next; 2139 } 2140 unless (has_local_flag($context, $chatnet, $channel, 'm')) { 2141 if ($nick eq $server->{nick}) { 2142 $context->{error}("I refuse to kick myself from \cb$channel\cb."); 2143 next; 2144 } 2145 } 2146 channel_notice $server, $channel, "$nick was kicked from $channel by $context->{nick} [$reason]"; 2147 $server->command("kick $channel $nick $reason"); 2148 } 2149} 2150 2151sub cmd_ban($$) { 2152 my ($context, $args) = @_; 2153 must_be_operator $context or return; 2154 unless ($args =~ /^ *$channel_re +$masks_re *$/o) { 2155 $context->{usage}("ban <#channel> <mask/nick>..."); 2156 return; 2157 } 2158 my ($channel, $masks) = (lc $1, $2); 2159 my @masks = split ' ', $masks; 2160 my $server = $context->{server}; 2161 my $chatnet = lc $server->{chatnet}; 2162 must_be_channel_operator $context, $chatnet, $channel or return; 2163 my $chan = find_channel $context, $channel, 1 or return; 2164 my @good = (); 2165 foreach my $mask (@masks) { 2166 if ($mask !~ /!/) { 2167 if ($mask =~ /\@/) { 2168 $mask = "*!$mask"; 2169 } else { 2170 my $who = $chan->nick_find($mask); 2171 unless ($who) { 2172 $context->{error}("\cb$mask\cb is not on \cb$channel\cb."); 2173 next; 2174 } 2175 my $address = $who->{host}; 2176 if ($address eq '') { 2177 $context->{error}("Sorry, I don't know \cb$mask\cb's address yet."); 2178 next; 2179 } 2180 $mask = "*!" . improve_mask $address; 2181 } 2182 } 2183 push @good, $mask; 2184 } 2185 if (@good) { 2186 my $cmd = "+" . "b" x @good . " @good"; 2187 channel_notice $server, $channel, "mode/$channel [$cmd] by $context->{nick}"; 2188 $server->command("mode $channel $cmd"); 2189 } 2190} 2191 2192sub cmd_unban($$) { 2193 my ($context, $args) = @_; 2194 must_be_operator $context or return; 2195 unless ($args =~ /^ *$channel_re(?: +$masks_re)? *$/o) { 2196 $context->{usage}("unban <#channel> [<masks>]"); 2197 return; 2198 } 2199 my ($channel, $masks) = (lc $1, $2); 2200 my $server = $context->{server}; 2201 my $chatnet = lc $server->{chatnet}; 2202 must_be_channel_operator $context, $chatnet, $channel or return; 2203 my $chan = find_channel $context, $channel, 1 or return; 2204 my @masks = (); 2205 if (defined $masks) { 2206 @masks = split ' ', $masks; 2207 } else { 2208 my $nick = $context->{nick}; 2209 my $address = $context->{address}; 2210 foreach my $ban ($chan->bans()) { 2211 push @masks, $ban->{ban} 2212 if Irssi::mask_match_address($ban->{ban}, $nick, $address); 2213 } 2214 unless (@masks) { 2215 $context->{notice}("There are no bans against you on \cb$channel\cb."); 2216 return; 2217 } 2218 } 2219 my $cmd = "-" . "b" x @masks . " @masks"; 2220 channel_notice $server, $channel, "mode/$channel [$cmd] by $context->{nick}"; 2221 $server->command("mode $channel $cmd"); 2222 unless (defined $masks) { 2223 $context->{notice}("Any bans against you on \cb$channel\cb have been cleared."); 2224 } 2225} 2226 2227sub cmd_kickban($$) { 2228 my ($context, $args) = @_; 2229 must_be_operator $context or return; 2230 unless ($args =~ /^ *$channel_re +$nicks_commas_re(| .*)$/o) { 2231 $context->{usage}("kickban <#channel> <nicks> [<reason>]"); 2232 return; 2233 } 2234 my ($channel, $nicks, $reason) = (lc $1, $2, $3); 2235 my @nicks = split /,/, $nicks; 2236 my $server = $context->{server}; 2237 my $chatnet = lc $server->{chatnet}; 2238 must_be_channel_operator $context, $chatnet, $channel or return; 2239 my $chan = find_channel $context, $channel, 1 or return; 2240 $reason = " $context->{nick}" if $reason =~ /^ ?$/; 2241 $reason =~ s/^ //; 2242 foreach my $nick (@nicks) { 2243 my $who = $chan->nick_find($nick); 2244 unless ($who) { 2245 $context->{error}("\cb$nick\cb is not on \cb$channel\cb."); 2246 next; 2247 } 2248 unless (has_local_flag($context, $chatnet, $channel, 'm')) { 2249 if ($nick eq $server->{nick}) { 2250 $context->{error}("I refuse to kick myself from \cb$channel\cb."); 2251 next; 2252 } 2253 } 2254 my $address = $who->{host}; 2255 if ($address eq '') { 2256 $context->{error}("Sorry, I don't know \cb$nick\cb's address yet."); 2257 } else { 2258 ban $server, $channel, $nick, $address, $$who->{op}, {}; 2259 } 2260 channel_notice $server, $channel, "$nick was kicked from $channel by $context->{nick} [$reason]"; 2261 $server->command("kick $channel $nick $reason"); 2262 } 2263} 2264 2265sub cmd_invite($$) { 2266 my ($context, $args) = @_; 2267 must_be_operator $context or return; 2268 my ($channel, $nick); 2269 if ($args =~ /^ *$channel_re(?: +$nick_re)? *$/o) { 2270 ($channel, $nick) = (lc $1, $2); 2271 } elsif ($args =~ /^ *$nick_re +$channel_re *$/o) { 2272 ($nick, $channel) = ($1, lc $2); 2273 } else { 2274 $context->{usage}("invite <#channel> [<nick>]"); 2275 return; 2276 } 2277 $nick = $context->{nick} unless defined $nick; 2278 my $server = $context->{server}; 2279 my $chatnet = lc $server->{chatnet}; 2280 must_be_channel_operator $context, $chatnet, $channel or return; 2281 my $chan = find_channel $context, $channel, 1 or return; 2282 if ($chan->nick_find($nick)) { 2283 $context->{error}("\cb$nick\cb is already on \cb$channel\cb"); 2284 return; 2285 } 2286 channel_notice $server, "$nick,$channel", "$context->{nick} invited $nick into $channel"; 2287 $server->command("invite $nick $channel"); 2288} 2289 2290######## AUTHENTICATION ######## 2291 2292sub must_have_crypt($) { 2293 my ($context) = @_; 2294 $context->{error}("Sorry, passwords don't work here - Crypt::PasswdMD5 module not found.") 2295 unless $has_crypt; 2296 return $has_crypt; 2297} 2298 2299our @salt_chars = ('.', '/', '0'..'9', 'A'..'Z', 'a'..'z'); 2300 2301sub crypt_new_password($) { 2302 my ($password) = @_; 2303 my $salt = join('', map {$salt_chars[rand @salt_chars]} (1..8)); 2304 return unix_md5_crypt($password, $salt); 2305} 2306 2307sub check_password($$) { 2308 my ($password, $required) = @_; 2309 return $required eq unix_md5_crypt($password, $required); 2310} 2311 2312sub cmd_pass($$) { 2313 my ($context, $args) = @_; 2314 unless ($args =~ /^ *([^ ]+)(?: +([^ ]+))? *$/) { 2315 $context->{usage} ("pass <password> - authenticate or set password for the first time"); 2316 $context->{usage_next}("pass <password> <new-password> - change password"); 2317 return; 2318 } 2319 my ($password, $new_password) = ($1, $2); 2320 my $server = $context->{server}; 2321 my $chatnet = lc $server->{chatnet}; 2322 my $nick = $context->{nick}; 2323 my $address = $context->{address}; 2324 my $password_set = 0; 2325 my $right_password = 0; 2326 my $wrong_password = 0; 2327 foreach my $user (find_users undef, $nick, $address) { 2328 my ($hdl, $mask) = @$user; 2329 my $required = $user_flags{$hdl}{p}; 2330 next unless defined $required; 2331 must_have_crypt $context or return; 2332 my $who_nick = "\cc11$nick\co \cc14[\cc10$address\cc14]\co"; 2333 my $who_hdl = "\cc04$handles{$hdl}\co"; 2334 if ($required ne '' && !check_password($password, $required)) { 2335 print CLIENTNOTICE "$who_nick gave \cbwrong\cb password for $who_hdl."; 2336 $wrong_password = 1; 2337 next; 2338 } 2339 if ($required eq '' || defined $new_password) { 2340 $password = $new_password if defined $new_password; 2341 $user_flags{$hdl}{p} = crypt_new_password $password; 2342 print CLIENTNOTICE "$who_nick \cbset\cb the password for $who_hdl."; 2343 $password_set = 1; 2344 } else { 2345 print CLIENTNOTICE "$who_nick gave \cbright\cb password for $who_hdl."; 2346 $right_password = 1; 2347 } 2348 $authenticated{$chatnet}{$address}{$hdl} = 1; 2349 maybe_disappears $chatnet, $server, undef, $nick, $address; 2350 foreach my $chan ($server->channels()) { 2351 next unless $chan->{wholist}; 2352 next unless $chan->{chanop}; 2353 my $channel = lc $chan->{name}; 2354 # nick_find_mask() only returns one nick. 2355 foreach my $who (grep { $_->{host} eq $address } $chan->nicks()) { 2356 my ($flags, $users) = find_local_flags $chatnet, $channel, $nick, $address; 2357 next if defined $flags->{x}; 2358 if (defined $flags->{r} || defined $flags->{o}) { 2359 queue_action $chatnet, '+o', $channel, $who->{nick}; 2360 } 2361 if (defined $flags->{v}) { 2362 queue_action $chatnet, '+v', $channel, $who->{nick}; 2363 } 2364 # FIXME: flag +e? 2365 } 2366 } 2367 } 2368 if ($password_set || $right_password) { 2369 $context->{notice}("Your password has been set.") if $password_set; 2370 $context->{notice}("Right password.") if $right_password; 2371 } elsif ($wrong_password) { 2372 $context->{error}("Wrong password."); 2373 } else { 2374 $context->{error}("Sorry, I don't recognize you."); 2375 } 2376 save_config if $password_set; 2377} 2378 2379######## LOCAL COMMANDS ######## 2380 2381Irssi::command_bind 'user', sub { 2382 my ($args, $server, $target) = @_; 2383 Irssi::command_runsub 'user', $args, $server, $target; 2384}; 2385 2386Irssi::command_bind 'mask', sub { 2387 my ($args, $server, $target) = @_; 2388 Irssi::command_runsub 'mask', $args, $server, $target; 2389}; 2390 2391sub local_command($$) { 2392 my ($command, $func) = @_; 2393 Irssi::command_bind $command, sub { 2394 my ($args, $server, $target) = @_; 2395 $func->($local_context, $args); 2396 }; 2397 $local_help{$command} = 1; 2398} 2399 2400local_command 'help', \&cmd_help; 2401delete $local_help{help}; 2402local_command 'user add', \&cmd_user_add; 2403local_command 'user remove', \&cmd_user_remove; 2404local_command 'mask add', \&cmd_mask_add; 2405local_command 'mask remove', \&cmd_mask_remove; 2406local_command 'user rename', \&cmd_user_rename; 2407local_command 'user list', \&cmd_user_list; 2408local_command 'flag', \&cmd_flag; 2409local_command 'find', \&cmd_find; 2410local_command 'trust', \&cmd_trust; 2411 2412######## RESPOND TO MESSAGES ######## 2413 2414our %commands; 2415 2416sub run_subcommand($$$) { 2417 my ($command, $context, $args) = @_; 2418 if ($args =~ / *([a-zA-Z]+)(| .*)$/) { 2419 my ($subcommand, $subargs) = ($1, $2); 2420 my $func = $commands{"$command " . lc $subcommand} or return; 2421 $func->($context, $subargs); 2422 } 2423} 2424 2425%commands = ( 2426 help => \&cmd_help, 2427 user => sub {&run_subcommand('user', @_)}, 2428 mask => sub {&run_subcommand('mask', @_)}, 2429 'user add' => \&cmd_user_add, 2430 'user remove' => \&cmd_user_remove, 2431 'mask add' => \&cmd_mask_add, 2432 'mask remove' => \&cmd_mask_remove, 2433 'user rename' => \&cmd_user_rename, 2434 'user list' => \&cmd_user_list, 2435 flag => \&cmd_flag, 2436 find => \&cmd_find, 2437 trust => \&cmd_trust, 2438 op => \&cmd_op, 2439 deop => \&cmd_deop, 2440 voice => \&cmd_voice, 2441 devoice => \&cmd_devoice, 2442 kick => \&cmd_kick, 2443 ban => \&cmd_ban, 2444 unban => \&cmd_unban, 2445 kickban => \&cmd_kickban, 2446 invite => \&cmd_invite, 2447 pass => \&cmd_pass, 2448); 2449 2450sub remote_command($$$$$$) { 2451 my ($server, $msg, $nick, $address, $reply, $prefix) = @_; 2452 return 0 unless $msg =~ /^([a-zA-Z]+)(| .*)$/; 2453 my ($command, $args) = ($1, $2); 2454 my $func = $commands{lc $command} or return 0; 2455 my $chatnet = lc $server->{chatnet}; 2456 my ($globals, $locals) = find_all_flags $chatnet, $nick, $address; 2457 my $context = { 2458 crap => sub {$server->command("$reply $nick $_[0]")}, 2459 notice => sub {$server->command("$reply $nick $_[0]")}, 2460 error => sub {$server->command("$reply $nick $_[0]")}, 2461 usage => sub {$server->command("$reply $nick Usage: $prefix$_[0]")}, 2462 usage_next => sub {$server->command("$reply $nick $prefix$_[0]")}, 2463 owner => 0, 2464 globals => $globals, 2465 locals => $locals, 2466 set_flags => \%master_set_flags, 2467 set_flags_str => $master_set_flags, 2468 see_flags => \%master_see_flags, 2469 server => $server, 2470 nick => $nick, 2471 address => $address, 2472 }; 2473 $func->($context, $args); 2474 return 1; 2475} 2476 2477Irssi::signal_add_last 'message private', sub { 2478 my ($server, $msg, $nick, $address) = @_; 2479 return unless $msg =~ /^!(.*)$/; 2480 Irssi::signal_continue @_; 2481 remote_command $server, $1, $nick, $address, "notice", "!"; 2482}; 2483 2484Irssi::signal_add_last "ctcp msg", sub { 2485 my ($server, $args, $nick, $address, $target) = @_; 2486 return unless lc $target eq lc $server->{nick}; 2487 remote_command $server, $args, $nick, $address, "notice", "" 2488 and Irssi::signal_stop; 2489}; 2490 2491######## INITIALIZATION ######## 2492 2493load_config; 2494