1#!/usr/local/bin/perl -w 2# 3# This script may not work with irssi older than 0.8.5! 4# 5# Historical author of this script is Erkki Seppala <flux@inside.org> 6# Now it's maintained by me, so i'm listed as an author. 7# 8# $Id: friends.pl,v 1.3 2003/11/09 21:11:45 shasta Exp $ 9 10use strict; 11use vars qw($VERSION %IRSSI); 12 13$VERSION = "2.4.9"; 14%IRSSI = ( 15 authors => 'Jakub Jankowski', 16 contact => 'shasta@toxcorp.com', 17 name => 'Friends', 18 description => 'Maintains list of people you know.', 19 license => 'GNU GPLv2 or later', 20 url => 'http://toxcorp.com/irc/irssi/friends/', 21 changed => 'Sun Oct 9 22:12:43 2003' 22); 23 24use Irssi 20011201.0100 (); 25use Irssi::Irc; 26 27# friends.pl 28my $friends_version = $VERSION . " (20031109)"; 29 30# release note, if any 31my $release_note = "Please read http://toxcorp.com/irc/irssi/friends/current/README\n"; 32 33############################################## 34# These variables are adjustable with /set 35# but here are some 'safe' defaults: 36 37# do you want to process CTCP queries? 38my $default_friends_use_ctcp = 1; 39 40# space-separated list of allowed (implemented ;) CTCP commands 41my $default_friends_ctcp_commands = "OP VOICE LIMIT KEY INVITE PASS IDENT UNBAN"; 42 43# do you want to learn new users? 44my $default_friends_learn = 1; 45 46# do you want to autovoice already opped nicks? 47my $default_friends_voice_opped = 0; 48 49# do you want to show additional info with /whois? 50my $default_friends_show_whois_extra = 1; 51 52# which flags do you want to add automatically with /addfriend? (case *sensitive*) 53my $default_friends_default_flags = ""; 54 55# default path to friendlist 56my $default_friends_file = Irssi::get_irssi_dir() . "/friends"; 57 58# do you want to save friendlist every time irssi's setup is saved 59my $default_friends_autosave = 0; 60 61# do you want to backup your friendlist upon a save 62my $default_friends_backup_friendlist = 1; 63 64# backup suffix to use (unixtime if empty) 65my $default_friends_backup_suffix = ".backup"; 66 67# do you want to show friend's flags while he joins a channel? 68my $default_friends_show_flags_on_join = 1; 69 70# do you want to revenge? 71my $default_friends_revenge = 1; 72 73# revenge mode: 74# 0 Deop the user. 75# 1 Deop the user and give them the +D flag for the channel. 76# 2 Deop the user, give them the +D flag for the channel, and kick them. 77# 3 Deop the user, give them the +D flag for the channel, kick, and ban them. 78my $default_friends_revenge_mode = 0; 79 80# do you want /findfriends to print info in separate windows for separate chans? 81my $default_friends_findfriends_to_windows = 0; 82 83# maximum size of operationQueue 84my $default_friends_max_queue_size = 20; 85 86# min delaytime 87my $default_delay_min = 10; 88 89# max delaytime 90my $default_delay_max = 60; 91 92############################################################### 93 94# registering themes 95Irssi::theme_register([ 96 'friends_empty', 'Your friendlist is empty. Add items with /ADDFRIEND', 97 'friends_notenoughargs', 'Not enough arguments. Usage: $0', 98 'friends_badargs', 'Bad arguments. Usage: $0', 99 'friends_nosuch', 'No such friend %R$0%n', 100 'friends_notonchan', 'Not on channel {hilight $0}', 101 'friends_endof', 'End of $0 $1', 102 'friends_badhandle', 'Wrong handle: %R$0%n. $1', 103 'friends_notuniqhandle', 'Handle %R$0%n already exists, choose another one', 104 'friends_version', 'friends.pl\'s version: {hilight $0} [$1]', 105 'friends_file_written', 'friendlist written on: {hilight $0}', 106 'friends_file_version', 'friendlist written with: {hilight $0} [$1]', 107 'friends_filetooold', 'Friendfile too old, loading aborted', 108 'friends_loaded', 'Loaded {hilight $0} friends from $1', 109 'friends_saved', 'Saved {hilight $0} friends to $1', 110 'friends_duplicate', 'Skipping %R$0%n [duplicate?]', 111 'friends_checking', 'Checking {hilight $0} took {hilight $1} secs [on $2]', 112 'friends_line_head', '[$[!-3]0] Handle: %R$1%n, flags: %C$2%n [password: $3]', 113 'friends_line_hosts', '$[-6]9 Hosts: $0', 114 'friends_line_chan', '$[-6]9 Channel {hilight $0}: Flags: %c$1%n, Delay: $2', 115 'friends_line_comment', '$[-6]9 Comment: $0', 116 'friends_line_currentnick', '$[-6]9 [$1] Current nick: {nick $0}', 117 'friends_line_channelson', '$[-6]9 [$1] Currently sharing with you: $0', 118 'friends_joined', '{nick $0} is a friend, handle: %R$1%n, global flags: %C$2%n, flags for {hilight $3}: %C$4%n', 119 'friends_whois', '{whois friend handle: {hilight $0}, global flags: $1}', 120 'friends_queue_empty', 'Operation queue is empty', 121 'friends_queue_line1', '[$[!-2]0] Operation: %R$1%n secs left before {hilight $2}', 122 'friends_queue_line2', ' (Server: {hilight $0}, Channel: {hilight $1}, Nicklist: $2)', 123 'friends_queue_nosuch', 'No such entry in operation queue ($0)', 124 'friends_queue_removed', '$0 queues: {hilight $1} [$2]', 125 'friends_friendlist', '{hilight Friendlist} [$0]:', 126 'friends_friendlist_count', 'Listed {hilight $0} friend$1', 127 'friends_findfriends', 'Looking for %R$2%n on channel {hilight $0} [on $1]:', 128 'friends_already_added', 'Nick {hilight $0} matches one of %R$1%n\'s hosts', 129 'friends_added', 'Added %R$0%n to friendlist', 130 'friends_removed', 'Removed %R$0%n from friendlist', 131 'friends_comment_added', 'Added comment line to %R$0%n ($1)', 132 'friends_comment_removed', 'Removed comment line from %R$0%n', 133 'friends_host_added', 'Added {hilight $1} to %R$0%n', 134 'friends_host_removed', 'Removed {hilight $1} from %R$0%n', 135 'friends_host_exists', 'Hostmask {hilight $1} overlaps with one of the already added to %R$0%n', 136 'friends_host_notexists', '%R$0%n does not have {hilight $1} in hostlist', 137 'friends_chanrec_removed', 'Removed {hilight $1} record from %R$0%n', 138 'friends_chanrec_notexists', '%R$0%n does not have {hilight $1} record', 139 'friends_changed_handle', 'Changed {hilight $0} to %R$1%n', 140 'friends_changed_delay', 'Changed %R$0%n\'s delay value on {hilight $1} to %c$2%n', 141 'friends_chflagexec', 'Executing %c$0%n for %R$1%n ($2)', 142 'friends_currentflags', 'Current {channel $2} flags for %R$1%n are: %c$0%n', 143 'friends_chpassexec', 'Altered password for %R$0%n', 144 'friends_ctcprequest', '%R$0%n asks for {hilight $1} on {hilight $2}', 145 'friends_ctcppass', 'Password for %R$0%n altered by $1', 146 'friends_ctcpident', 'CTCP IDENT for %R$0%n from {hilight $1} succeeded', 147 'friends_ctcpfail', 'Failed CTCP {hilight $0} from %R$1%n. $2', 148 'friends_optree_header', 'Opping tree:', 149 'friends_optree_line1', '%R$0%n has opped these:', 150 'friends_optree_line2', '{hilight $[!-4]0} times: $1', 151 'friends_general', '$0', 152 'friends_notice', '[%RN%n] $0' 153]); 154 155my @friends = (); 156my $all_regexp_hosts = {}; 157my $all_hosts = {}; 158my $all_handles = {}; 159my @operationQueue = (); 160my $timerHandle = undef; 161my $friends_file_version; 162my $friends_file_written; 163 164my $friends_PLAIN_HOSTS = 0; 165my $friends_REGEXP_HOSTS = 1; 166 167# Idea of moving userhost to a regexp and 168# the subroutine userhost_to_regexp were adapted from people.pl, 169# an userlist script made by Marcin 'Qrczak' Kowalczyk. 170# You can get that script from http://qrnik.knm.org.pl/~qrczak/irssi/people.pl 171# or from http://scripts.irssi.org/ 172 173# HostToRegexp 174my %htr = (); 175# fill the hash 176foreach my $i (0..255) { 177 my $ch = chr($i); 178 $htr{$ch} = "\Q$ch\E"; 179} 180# wildcards to regexp 181$htr{'?'} = '.'; 182$htr{'*'} = '.*'; 183 184# str userhost_to_regexp($userhost) 185# translates userhost to a regexp 186# lowercases host-part 187sub userhost_to_regexp($) { 188 my ($mask) = @_; 189 $mask = lowercase_hostpart($mask); 190 $mask =~ s/(.)/$htr{$1}/g; 191 return $mask; 192} 193 194# str lowercase_hostpart($userhost) 195# returns userhost with host-part loweracased 196sub lowercase_hostpart($) { 197 my ($host) = @_; 198 $host =~ s/(.+)\@(.+)/sprintf("%s@%s", $1, lc($2));/eg; 199 return $host; 200} 201 202# void print_version($what) 203# print's version of script/userlist 204sub print_version($) { 205 my ($what) = @_; 206 $what = lc($what); 207 208 if ($what eq "filever") { 209 if ($friends_file_version) { 210 my ($verbal, $numeric) = $friends_file_version =~ /^(.+)\ \(([0-9]+)\)$/; 211 Irssi::printformat(MSGLEVEL_CRAP, 'friends_file_version', $verbal, $numeric); 212 } else { 213 Irssi::printformat(MSGLEVEL_CRAP, 'friends_empty'); 214 } 215 } elsif ($what eq "filewritten" && $friends_file_written) { 216 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($friends_file_written); 217 my $written = sprintf("%4d%02d%02d %02d:%02d:%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec); 218 Irssi::printformat(MSGLEVEL_CRAP, 'friends_file_written', $written); 219 } else { 220 my ($verbal, $numerical) = $friends_version =~ /^(.+)\ \(([0-9]+)\)$/; 221 Irssi::printformat(MSGLEVEL_CRAP, 'friends_version', $verbal, $numerical); 222 } 223} 224 225# void print_releasenote() 226# suprisingly, prints a release note ;^) 227sub print_releasenote { 228 foreach my $line (split(/\n/, $release_note)) { 229 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notice', $line); 230 } 231} 232 233# str friends_crypt($plain) 234# returns crypt()ed $plain, using random salt; 235# or "" if $plain is empty 236sub friends_crypt { 237 return if ($_[0] eq ""); 238 return crypt("$_[0]", (join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64])); 239} 240 241# bool friend_passwdok($idx, $pwd) 242# returns 1 if password is ok, 0 if isn't 243sub friends_passwdok { 244 my ($idx, $pwd) = @_; 245 return 1 if (crypt("$pwd", $friends[$idx]->{password}) eq $friends[$idx]->{password}); 246 return 0; 247} 248 249# arr get_friends_channels($idx) 250# returns list of $friends[$idx] channels 251sub get_friends_channels { 252 return keys(%{$friends[$_[0]]->{channels}}); 253} 254 255# arr get_friends_hosts($idx, $type) 256# returns list of $friends[$idx] regexp-hostmask if $type=$friends_REGEXP_HOSTS 257# returns list of plain-hostmasks if $type=$friends_PLAIN_HOSTS 258sub get_friends_hosts($$) { 259 if ($_[1] == $friends_REGEXP_HOSTS) { 260 return keys(%{$friends[$_[0]]->{regexp_hosts}}); 261 } elsif ($_[1] == $friends_PLAIN_HOSTS) { 262 return keys(%{$friends[$_[0]]->{hosts}}); 263 } 264 return undef; 265} 266 267# str get_friends_flags($idx[, $chan]) 268# returns list of $chan flags for $idx 269# $chan can be also 'global' or undef 270# case insensitive about the $chan 271sub get_friends_flags { 272 my ($idx, $chan) = @_; 273 $chan = lc($chan); 274 if ($chan eq "" || $chan eq "global") { 275 return $friends[$idx]->{globflags}; 276 } else { 277 foreach my $friendschan (get_friends_channels($idx)) { 278 if ($chan eq lc($friendschan)) { 279 return $friends[$idx]->{channels}->{$friendschan}->{flags}; 280 } 281 } 282 } 283 return; 284} 285 286# str get_friends_delay($idx[, $chan]) 287# returns $chan delay for $idx 288# returns "" if $chan is 'global' or undef 289# case insensitive about the $chan 290sub get_friends_delay { 291 my ($idx, $chan) = @_; 292 $chan = lc($chan); 293 if ($chan && $chan ne "global") { 294 foreach my $friendschan (get_friends_channels($idx)) { 295 if ($chan eq lc($friendschan)) { 296 return undef if ($friends[$idx]->{channels}->{$friendschan}->{delay} eq ''); 297 return $friends[$idx]->{channels}->{$friendschan}->{delay}; 298 } 299 } 300 } 301 return; 302} 303 304# struct friend new_friend($handle, $hoststr, $globflags, $chanflagstr, $password, $comment) 305# hoststr is: *!foo@host1 *!bar@host2 *!?baz@host3 306# chanstr is: #chan1,flags,delay #chan2,flags,delay 307sub new_friend { 308 my $friend = {}; 309 my $idx = scalar(@friends); 310 $friend->{handle} = $_[0]; 311 $all_handles->{lc($_[0])} = $idx; 312 $friend->{globflags} = $_[2]; 313 $friend->{password} = $_[4]; 314 $friend->{comment} = $_[5]; 315 $friend->{friends} = []; 316 317 foreach my $host (split(/ +/, $_[1])) { 318 my $regexp_host = userhost_to_regexp($host); 319 my ($firstalpha) = $host =~ /\@(.)/; 320 $firstalpha = lc($firstalpha); 321 322 $friend->{hosts}->{$host} = $regexp_host; 323 $friend->{regexp_hosts}->{$regexp_host} = $host; 324 $all_regexp_hosts->{allhosts}->{$regexp_host} = lc($_[0]); 325 $all_regexp_hosts->{$firstalpha}->{$regexp_host} = lc($_[0]); 326 $all_hosts->{$host} = lc($_[0]); 327 } 328 329 foreach my $cfd (split(/ +/, $_[3])) { 330 # $cfd format: #foobar,oikl,15 (channelname,flags,delay) 331 my ($channel, $flags, $delay) = split(",", $cfd, 3); 332 $friend->{channels}->{$channel}->{exist} = 1; 333 $friend->{channels}->{$channel}->{flags} = $flags; 334 $friend->{channels}->{$channel}->{delay} = $delay; 335 } 336 337 return $friend; 338} 339 340# get_regexp_hosts_by_letter($letter) 341# returns those regexp masks whose host part begins with $letter, '?' or '*' 342sub get_regexp_hosts_by_letter($) { 343 my $l = lc(substr($_[0], 0, 1)); 344 my @tmphosts = (); 345 push(@tmphosts, keys(%{$all_regexp_hosts->{$l}})); 346 push(@tmphosts, keys(%{$all_regexp_hosts->{'?'}})); 347 push(@tmphosts, keys(%{$all_regexp_hosts->{'*'}})); 348 return @tmphosts; 349} 350 351# bool is_allowed_flag($flag) 352# will be obsolete, soon. 353sub is_allowed_flag { return 1; } 354 355# bool is_ctcp_command($command) 356# check if $command is one of the implemented ctcp commands 357sub is_ctcp_command { 358 my ($command) = @_; 359 $command = uc($command); 360 foreach my $allowed (split(/[,\ \|]+/, uc(Irssi::settings_get_str('friends_ctcp_commands')))) { 361 return 1 if ($command eq $allowed); 362 } 363 return 0; 364} 365 366# int get_idx($nick, $userhost) 367# returns idx of the friend or -1 if not a friend 368# The New Approach (TM) :) 369sub get_idx($$) { 370 my ($nick, $userhost) = @_; 371 $userhost = lowercase_hostpart($nick.'!'.$userhost); 372 my ($letter) = $userhost =~ /\@(.)/; 373 my $idx = -1; 374 375 foreach my $regexp_host (get_regexp_hosts_by_letter($letter)) { 376 if ($userhost =~ /^$regexp_host$/) { 377 return get_idxbyhand($all_regexp_hosts->{allhosts}->{$regexp_host}); 378 } 379 } 380 381 return -1; 382} 383 384# int get_idxbyhand($handle) 385# returns $idx of friend with $handle or -1 if no such handle 386# case insensitive 387sub get_idxbyhand($) { 388 my $handle = lc($_[0]); 389 if (exists $all_handles->{$handle}) { 390 return $all_handles->{$handle}; 391 } 392 return -1; 393} 394 395# int get_handbyidx($idx) 396# returns $handle of friend with $idx or undef if no such $idx 397# case sensitive 398sub get_handbyidx($) { 399 my ($idx) = @_; 400 return undef unless ($idx > -1 && $idx < scalar(@friends)); 401 return $friends[$idx]->{handle}; 402} 403 404# bool friend_has_host($idx, $host) 405# checks wheter $host matches any of $friend[$idx]'s hostmasks 406# The New Approach (TM) 407sub friend_has_host($$) { 408 my ($idx, $host) = @_; 409 $host = lowercase_hostpart($host); 410 foreach my $regexp_host (keys (%{$friends[$idx]->{regexp_hosts}})) { 411 return 1 if ($host =~ /^$regexp_host$/); 412 } 413 return 0; 414} 415 416# void add_host($idx, $host) 417# adds $host wherever it's needed 418# $friends[$idx]->{handle} is A MUST for add_host() to work properly. 419sub add_host($$) { 420 my ($idx, $host) = @_; 421 my $regexp_host = userhost_to_regexp($host); 422 my ($firstalpha) = $host =~ /\@(.)/; 423 $firstalpha = lc($firstalpha); 424 425 $friends[$idx]->{hosts}->{$host} = $regexp_host; 426 $friends[$idx]->{regexp_hosts}->{$regexp_host} = $host; 427 $all_regexp_hosts->{allhosts}->{$regexp_host} = lc($friends[$idx]->{handle}); 428 $all_regexp_hosts->{$firstalpha}->{$regexp_host} = lc($friends[$idx]->{handle}); 429 $all_hosts->{$host} = lc($friends[$idx]->{handle}); 430} 431 432# int del_host($idx, $host) 433# deletes $host from wherever it is 434# if given $host arg is '*', removes all hosts of this friend 435sub del_host($$) { 436 my ($idx, $host) = @_; 437 my $deleted = 0; 438 439 foreach my $regexp_host (keys (%{$friends[$idx]->{regexp_hosts}})) { 440 if ($host eq '*' || $host =~ /^$regexp_host$/) { 441 my $plain_host = $friends[$idx]->{regexp_hosts}->{$regexp_host}; 442 my ($l) = $plain_host =~ /\@(.)/; 443 444 delete $friends[$idx]->{hosts}->{$plain_host}; 445 delete $friends[$idx]->{regexp_hosts}->{$regexp_host}; 446 delete $all_regexp_hosts->{allhosts}->{$regexp_host}; 447 delete $all_regexp_hosts->{$l}->{$regexp_host}; 448 delete $all_hosts->{$plain_host}; 449 $deleted++; 450 } 451 } 452 return $deleted; 453} 454 455# bool friend_has_chanrec($idx, $chan) 456# checks wheter $friend[$idx] has a $chan record 457# case insensitive 458sub friend_has_chanrec { 459 my ($idx, $chan) = @_; 460 $chan = lc($chan); 461 foreach my $friendschan (get_friends_channels($idx)) { 462 return 1 if ($chan eq lc($friendschan)); 463 } 464 return 0; 465} 466 467# bool add_chanrec($idx, $chan) 468# adds an empty $chan record to $friends[$idx] 469# case sensitive 470sub add_chanrec { 471 my ($idx, $chan) = @_; 472 return 0 unless ($idx > -1 && $idx < scalar(@friends)); 473 $friends[$idx]->{channels}->{$chan}->{exist} = 1; 474 return 1; 475} 476 477# bool del_chanrec($idx, $chan) 478# deletes $chan record from $friends[$idx] 479# case *in*sensitive 480sub del_chanrec { 481 my ($idx, $chan) = @_; 482 my $deleted = 0; 483 foreach my $friendschan (get_friends_channels($idx)) { 484 if (lc($chan) eq lc($friendschan)) { 485 delete $friends[$idx]->{channels}->{$friendschan}; 486 $deleted = 1; 487 } 488 } 489 return $deleted; 490} 491 492# arr del_friend($idxs) 493# removes friends 494# removes all hosts corresponding to this friend 495# returns array of removed friends 496sub del_friend($) { 497 my ($idxlist) = @_; 498 my @idxs = split(/ /, $idxlist); 499 return -1 unless (scalar(@idxs) > 0); 500 my @tmp = (); 501 my @result = (); 502 my @todelete = (); 503 504 foreach my $idx (@idxs) { 505 my $handle = get_handbyidx($idx); 506 if (!(!defined $handle || grep(/^\Q$handle\E$/i, @todelete))) { 507 push(@todelete, $handle); 508 del_host($idx, '*'); 509 } 510 } 511 for (my $idx = 0; $idx < @friends; $idx++) { 512 if (grep(/^\Q$friends[$idx]->{handle}\E$/i, @todelete)) { 513 push(@result, $friends[$idx]); 514 } else { 515 push(@tmp, $friends[$idx]); 516 } 517 } 518 @friends = @tmp; 519 update_allhandles(); 520 return @result; 521} 522 523# void update_all_handles() 524# updates $all_handles 525sub update_allhandles { 526 $all_handles = {}; 527 for (my $idx = 0; $idx < @friends; $idx++) { 528 $all_handles->{lc($friends[$idx]->{handle})} = $idx 529 } 530} 531 532# bool is_unique_handle($handle) 533# checks if the $handle is unique for the whole friendlist 534# returns 1 if there's no such $handle 535# returns 0 if there is one. 536sub is_unique_handle($) { 537 return !exists $all_handles->{lc($_[0])}; 538} 539 540# str choose_handle($proposed) 541# tries to choose a handle, closest to the $proposed one 542sub choose_handle { 543 my ($proposed) = @_; 544 my $counter = 0; 545 my $handle = $proposed; 546 547 # do this until we have an unique handle 548 while (!is_unique_handle($handle)) { 549 if (($handle !~ /([0-9]+)$/) && !$counter) { 550 # first, if handle doesn't end with a digit, append '2' 551 # (but only in first step) 552 $handle .= "2"; 553 } elsif ($counter < 85) { 554 # later, increase the trailing number by one 555 # do that 84 times 556 my ($number) = $handle =~ /([0-9]+)$/; 557 ++$number; 558 $handle =~ s/([0-9]+)$/$number/; 559 } elsif ($counter == 85) { 560 # then, if it didn't helped, make $handle = $proposed."_" 561 $handle = $proposed . "_"; 562 } elsif ($counter < 90) { 563 # if still unsuccessful, append "_" to the handle 564 # do that 4 times 565 $handle .= "_"; 566 } else { 567 # if THAT didn't help -- make some silly handle 568 # and exit the loop 569 $handle = $proposed.'_'.(join '', (0..9, 'a'..'z')[rand 36, rand 36, rand 36, rand 36]); 570 last; 571 } 572 ++$counter; 573 } 574 575 # return our glorious handle ;-) 576 return $handle; 577} 578 579# bool friend_has_flag($idx, $flag[, $chan]) 580# returns true if $friends[$idx] has $flag for $chan 581# (checks global flags, if $chan is 'global' or undef) 582# returns false if hasn't 583# case sensitive about the FLAG 584# case insensitive about the chan. 585sub friend_has_flag { 586 my ($idx, $flag, $chan) = @_; 587 $chan = "global" unless ($chan ne ''); 588 589 return 1 if (get_friends_flags($idx, $chan) =~ /\Q$flag\E/); 590 return 0; 591} 592 593# bool friend_is_wrapper($idx, $chan, $goodflag, $badflag) 594# something to replace friend_is_* subs 595# true on: ($channel +$goodflag OR global +$goodflag) AND ($badflag == "" OR NOT $channel +$badflag)) 596sub friend_is_wrapper($$$$) { 597 my ($idx, $chan, $goodflag, $badflag) = @_; 598 return 0 unless ($idx > -1); 599 if ((friend_has_flag($idx, $goodflag, $chan) || 600 friend_has_flag($idx, $goodflag, undef)) && 601 ($badflag eq "" || !friend_has_flag($idx, $badflag, $chan))) { 602 return 1; 603 } 604 return 0; 605} 606 607# bool add_flag($idx, $flag[, $chan]) 608# adds $flag to $idx's $chan flags 609# $chan can be 'global' or undef 610# case insensitive about the $chan -- chooses the proper case. 611# returns 1 on success 612sub add_flag { 613 my ($idx, $flag, $chan) = @_; 614 $chan = lc($chan); 615 if ($chan eq "" || $chan eq "global") { 616 $friends[$idx]->{globflags} .= $flag; 617 return 1; 618 } else { 619 foreach my $friendschan (get_friends_channels($idx)) { 620 if ($chan eq lc($friendschan)) { 621 $friends[$idx]->{channels}->{$friendschan}->{flags} .= $flag; 622 return 1; 623 } 624 } 625 } 626 return 0; 627} 628 629# bool del_flag($idx, $flag[, $chan]) 630# removes $flag from $idx's $chan flags 631# $chan can be 'global' or undef 632# case insensitive about the $chan -- chooses the proper case. 633sub del_flag { 634 my ($idx, $flag, $chan) = @_; 635 $chan = lc($chan); 636 if ($chan eq "" || $chan eq "global") { 637 $friends[$idx]->{globflags} =~ s/\Q$flag\E//g; 638 return 1; 639 } else { 640 foreach my $friendschan (get_friends_channels($idx)) { 641 if ($chan eq lc($friendschan)) { 642 $friends[$idx]->{channels}->{$friendschan}->{flags} =~ s/\Q$flag\E//i; 643 return 1; 644 } 645 } 646 } 647 return 0; 648} 649 650# bool change_delay($idx, $delay, $chan) 651# alters $idx's delay time for $chan 652# fails if $chan is 'global' or undef 653sub change_delay { 654 my ($idx, $delay, $chan) = @_; 655 $chan = lc($chan); 656 if ($chan && $chan ne "global") { 657 foreach my $friendschan (get_friends_channels($idx)) { 658 if ($chan eq lc($friendschan)) { 659 $friends[$idx]->{channels}->{$friendschan}->{delay} = $delay; 660 return 1; 661 } 662 } 663 } 664 return 0; 665} 666 667# void list_friend($window, $who, @data) 668# prints an info line about certain friend. 669# $who may be handle or idx 670# if you want to improve the look of the script, you should 671# change /format friends_*, probably. 672sub list_friend { 673 my ($win, $who, @data) = @_; 674 my $idx = $who; 675 676 $idx = get_idxbyhand($who) unless ($who =~ /^[0-9]+$/); 677 678 return unless ($idx > -1 && $idx < scalar(@friends)); 679 680 my $globflags = get_friends_flags($idx, undef); 681 682 $win = Irssi::active_win() unless ($win); 683 684 $win->printformat(MSGLEVEL_CRAP, 'friends_line_head', 685 $idx, 686 get_handbyidx($idx), 687 (($globflags) ? "$globflags" : "[none]"), 688 (($friends[$idx]->{password}) ? "yes" : "no")); 689 690 $win->printformat(MSGLEVEL_CRAP, 'friends_line_hosts', 691 join(", ", get_friends_hosts($idx, $friends_PLAIN_HOSTS)) ); 692 693 foreach my $chan (get_friends_channels($idx)) { 694 my $flags = get_friends_flags($idx, $chan); 695 my $delay = get_friends_delay($idx, $chan); 696 $win->printformat(MSGLEVEL_CRAP, 'friends_line_chan', 697 $chan, 698 (($flags) ? "$flags" : "[none]"), 699 (defined($delay) ? "$delay" : "random")); 700 } 701 702 if ($friends[$idx]->{comment}) { 703 $win->printformat(MSGLEVEL_CRAP, 'friends_line_comment', $friends[$idx]->{comment}); 704 } 705 706 for my $item (@data) { 707 my ($ircnet, $nick, $chanstr) = split(" ", $item); 708 next unless (defined $ircnet); 709 $win->printformat(MSGLEVEL_CRAP, 'friends_line_currentnick', $nick, $ircnet) if ($nick ne '');; 710 $win->printformat(MSGLEVEL_CRAP, 'friends_line_channelson', join(", ", split(/,/, $chanstr)), $ircnet) if ($chanstr ne ''); 711 } 712} 713 714# void add_operation($server, "#channel", "op|voice|deop|devoice|kick|kickban", timeout, "nick1", "nick2", ...) 715# adds a delayed (or not) operation 716sub add_operation { 717 my ($server, $channel, $operation, $timeout, @nicks) = @_; 718 719 # my dear queue, don't grow too big, mmkay? ;^) 720 my $maxsize = Irssi::settings_get_int('friends_max_queue_size'); 721 $maxsize = $default_friends_max_queue_size unless ($maxsize > 0); 722 return if (@operationQueue >= $maxsize); 723 724 push(@operationQueue, 725 { 726 server=>$server, # server object 727 left=>$timeout, # seconds left 728 nicks=>[ @nicks ], # array of nicks 729 channel=>$channel, # channel name 730 operation=>$operation # operation ("op", "voice" and so on) 731 }); 732 733 $timerHandle = Irssi::timeout_add(1000, 'timer_handler', 0) unless (defined $timerHandle); 734} 735 736# void timer_handler() 737# handles delay timer 738sub timer_handler { 739 my @ops = (); 740 741 # splice out expired timeouts. if they are expired, move them to 742 # local ops-queue. this allows creating new operations to the queue 743 # in the operation. (we're not (yet) doing that) 744 745 for (my $c = 0; $c < @operationQueue;) { 746 if ($operationQueue[$c]->{left} <= 0) { 747 push(@ops, splice(@operationQueue, $c, 1)); 748 } else { 749 ++$c; 750 } 751 } 752 753 for (my $c = 0; $c < @ops; ++$c) { 754 my $op = $ops[$c]; 755 my $channel = $op->{server}->channel_find($op->{channel}); 756 757 # check if $channel is still active (you might've parted) 758 if ($channel) { 759 my @operationNicks = (); 760 foreach my $nickStr (@{$op->{nicks}}) { 761 my $nick = $channel->nick_find($nickStr); 762 # check if there's still such nick (it might've quit/parted) 763 if ($nick) { 764 if ($op->{operation} eq "op" && !$nick->{op}) { 765 push(@operationNicks, $nick->{nick}); 766 } 767 if ($op->{operation} eq "voice" && !$nick->{voice} && 768 (!$nick->{op} || Irssi::settings_get_bool('friends_voice_opped'))) { 769 push(@operationNicks, $nick->{nick}); 770 } 771 if ($op->{operation} eq "deop" && $nick->{op}) { 772 push(@operationNicks, $nick->{nick}); 773 } 774 if ($op->{operation} eq "devoice" && $nick->{voice}) { 775 push(@operationNicks, $nick->{nick}); 776 } 777 if ($op->{operation} eq "kick") { 778 push(@operationNicks, $nick->{nick}); 779 } 780 if ($op->{operation} eq "kickban") { 781 push(@operationNicks, $nick->{nick}); 782 } 783 } 784 } 785 # final stage: issue desired command if we're a chanop 786 $channel->command($op->{operation}." ".join(" ", @operationNicks)) if ($channel->{chanop}); 787 } 788 } 789 790 # decrement timeouts. 791 for (my $c = 0; $c < @operationQueue; ++$c) { 792 --$operationQueue[$c]->{left}; 793 } 794 795 # if operation queue is empty, remove timer. 796 if (!@operationQueue && $timerHandle) { 797 Irssi::timeout_remove($timerHandle); 798 $timerHandle = undef; 799 } 800} 801 802# str replace_home($string) 803# replaces '~' with current $ENV{HOME} 804sub replace_home($) { 805 my ($string) = @_; 806 my $home = $ENV{HOME}; 807 return undef unless ($string); 808 $string =~ s/^\~/$home/; 809 return $string; 810} 811 812# void load_friends($inputfile) 813# loads friends from file. uses $inputfile if supplied. 814# if not, uses friends_file setting. if this setting is empty, 815# uses default -- $friends_file 816sub load_friends { 817 my ($inputfile) = @_; 818 my $friendfile = undef; 819 820 if (defined($inputfile)) { 821 $friendfile = replace_home($inputfile); 822 } else { 823 $friendfile = replace_home(Irssi::settings_get_str('friends_file')); 824 } 825 826 $friendfile = $default_friends_file unless (defined $friendfile); 827 828 if (-e $friendfile && -r $friendfile) { 829 @friends = (); 830 $all_hosts = {}; 831 $all_regexp_hosts = {}; 832 $all_handles = {}; 833 834 local *F; 835 open(F, "<", $friendfile) or return -1; 836 local $/ = "\n"; 837 while (<F>) { 838 my ($handle, $hosts, $globflags, $chanstr, $password, $comment); 839 chop; 840 841 # dealing with empty lines 842 next if (/^[\w]*$/); 843 844 # dealing with comments 845 if (/^\#/) { 846 # script version 847 if (/^\# version = (.+)/) { $friends_file_version = $1; } 848 # timestamp 849 if (/^\# written = ([0-9]+)/) { $friends_file_written = $1; } 850 next; 851 } 852 853 # split by '%' 854 my @fields = split("%", $_); 855 foreach my $field (@fields) { 856 if ($field =~ /^handle=(.*)$/) { $handle = $1; } 857 elsif ($field =~ /^hosts=(.*)$/) { $hosts = $1; } 858 elsif ($field =~ /^globflags=(.*)$/) { $globflags = $1; } 859 elsif ($field =~ /^chanflags=(.*)$/) { $chanstr = $1; } 860 elsif ($field =~ /^password=(.*)$/) { $password = $1; } 861 elsif ($field =~ /^comment=(.*)$/) { $comment = $1; } 862 } 863 864 # handle cannot start with a digit 865 # skip friend if it does 866 next if ($handle =~ /^[0-9]/); 867 868 # if all fields were processed, and $handle is unique, 869 # make a friend and add it to $friends 870 if (is_unique_handle($handle)) { 871 push(@friends, new_friend($handle, $hosts, $globflags, $chanstr, $password, $comment)); 872 } else { 873 Irssi::printformat(MSGLEVEL_CRAP, 'friends_duplicate', $handle); 874 } 875 } 876 877 close(F); 878 879 # if everything's ok -- print a message 880 Irssi::printformat(MSGLEVEL_CRAP, 'friends_loaded', scalar(@friends), $friendfile); 881 } else { 882 # whoops, bail out, but do not clear the friendlist. 883 Irssi::print("Cannot load $friendfile"); 884 } 885} 886 887# void cmd_loadfriends($data, $server, $channel) 888# handles /loadfriends [file] 889sub cmd_loadfriends { 890 my ($file) = split(/ +/, $_[0]); 891 load_friends($file); 892} 893 894# void save_friends($auto) 895# saving friends to file 896sub save_friends { 897 my ($auto, $inputfile) = @_; 898 local *F; 899 my $friendfile = undef; 900 my $backup_suffix = Irssi::settings_get_str('friends_backup_suffix'); 901 $backup_suffix = "." . time if ($backup_suffix eq ''); 902 903 if (defined $inputfile) { 904 $friendfile = replace_home($inputfile); 905 } else { 906 $friendfile = replace_home(Irssi::settings_get_str('friends_file')); 907 } 908 $friendfile = $default_friends_file unless (defined $friendfile); 909 910 my $backupfile = $friendfile . $backup_suffix; 911 my $tmpfile = $friendfile . ".tmp" . time; 912 913 # be sane 914 my $old_umask = umask(077); 915 916 if (!defined open(F, ">", $tmpfile)) { 917 Irssi::print("Couldn't open $tmpfile for writing"); 918 return 0; 919 } 920 921 # write script's version and update corresponding variable 922 $friends_file_version = $friends_version; 923 print(F "# version = $friends_file_version\n"); 924 # write current unixtime and update corresponding variable 925 $friends_file_written = time; 926 print(F "# written = $friends_file_written\n"); 927 928 # go through all entries 929 for (my $idx = 0; $idx < @friends; ++$idx) { 930 # get friend's channels, corresponding flags and delay values 931 # then put them as c,f,d fields into @chanstr 932 my @chanstr = (); 933 foreach my $chan (get_friends_channels($idx)) { 934 $chan =~ s/\%//g; 935 push(@chanstr, $chan.",".(get_friends_flags($idx, $chan)).",". 936 (get_friends_delay($idx, $chan))); 937 } 938 939 # write the actual line 940 print(F join("%", 941 "handle=".get_handbyidx($idx), 942 "hosts=".(join(" ", get_friends_hosts($idx, $friends_PLAIN_HOSTS))), 943 "globflags=".(get_friends_flags($idx, undef)), 944 "chanflags=".(join(" ", @chanstr)), 945 "password=".$friends[$idx]->{password}, 946 "comment=".$friends[$idx]->{comment}, 947 "\n")); 948 } 949 # done. 950 951 close(F); 952 953 rename($friendfile, $backupfile) if (Irssi::settings_get_bool('friends_backup_friendlist')); 954 rename($tmpfile, $friendfile); 955 956 Irssi::printformat(MSGLEVEL_CRAP, 'friends_saved', scalar(@friends), $friendfile) unless ($auto); 957 958 # restore umask 959 umask($old_umask); 960} 961 962# void cmd_savefriends($data, $server, $channel) 963# handles /savefriends [filename] 964sub cmd_savefriends { 965 my ($file) = split(/ +/, $_[0]); 966 eval { 967 save_friends(0, $file); 968 }; 969 Irssi::print("Saving friendlist failed: $?") if ($?); 970} 971 972# void event_setup_saved($config, $auto) 973# calls save_friends to save friendslist while saving irssi's setup 974# (if friends_autosave is turned on) 975sub event_setup_saved { 976 my ($config, $auto) = @_; 977 return unless (Irssi::settings_get_bool('friends_autosave')); 978 eval { 979 save_friends($auto); 980 }; 981 Irssi::print("Saving friendlist failed: $?") if ($?); 982} 983 984# void event_setup_reread($config) 985# calls load_friends() while setup is re-readed 986# (if friends_autosave is turned on) 987sub event_setup_reread { 988 load_friends() if (Irssi::settings_get_bool('friends_autosave')); 989} 990 991# int calculate_delay($idx, $chan) 992# calculates delay 993sub calculate_delay { 994 my ($idx, $chan) = @_; 995 my $delay = get_friends_delay($idx, $chan); 996 my $min = Irssi::settings_get_int('friends_delay_min'); 997 my $max = Irssi::settings_get_int('friends_delay_max'); 998 999 # lazy man's sanity checks :-P 1000 $min = $default_delay_min if $min < 0; 1001 $max = $default_delay_max if $min > $max; 1002 $max = $max + $min if $min > $max; 1003 1004 # make a random delay unless we've got a fixed delay time already 1005 $delay = int(rand ($max - $min)) + $min unless ($delay =~ /^[0-9]+$/); 1006 1007 return $delay; 1008} 1009 1010# void check_friends($server, $channelstr, $options, @nickstocheck) 1011# checks the given nicklist, channelname and server against the friendlist 1012sub check_friends { 1013 my ($server, $channelName, $options, @nicks) = @_; 1014 my $channel = $server->channel_find($channelName); 1015 my $delay = 30; 1016 my %opList = (); 1017 my %voiceList = (); 1018 1019 # server and channel -- a must. 1020 return unless ($server && $channelName); 1021 1022 # proper !channels support, hopefully 1023 my $noPrefix = $channelName; 1024 $noPrefix = '!' . substr($channelName, 6) if ($channelName =~ /^\!/); 1025 1026 # get settings 1027 my $voice_opped = Irssi::settings_get_bool('friends_voice_opped'); 1028 1029 # for each nick from the given list 1030 foreach my $nick (@nicks) { 1031 # check if $nick is a friend 1032 if ((my $idx = get_idx($nick->{nick}, $nick->{host})) > -1) { 1033 1034 # notify about the join if "showjoins" is set 1035 if ($options =~ /showjoins/) { 1036 my $globflags = get_friends_flags($idx, undef); 1037 my $chanflags = get_friends_flags($idx, $noPrefix); 1038 1039 my $win = $server->window_item_find($channelName); 1040 $win = Irssi::active_win() unless ($win); 1041 $win->printformat(MSGLEVEL_CRAP, 'friends_joined', 1042 $nick->{nick}, 1043 get_handbyidx($idx), 1044 ($globflags) ? $globflags : "[none]", 1045 $noPrefix, 1046 ($chanflags) ? $chanflags : "[none]"); 1047 } 1048 1049 # notice1: password doesn't matter in this loop 1050 # notice2: channel flags take precedence over the global ones 1051 1052 # handle auto-(op|voice) 1053 if (friend_is_wrapper($idx, $noPrefix, "a", undef)) { 1054 # add $nick to opList{delay} if he is a valid op 1055 # and isn't opped already 1056 # 'valid op' means: (chanflag +o OR globflag +o) AND NOT chanflag +d 1057 if (friend_is_wrapper($idx, $noPrefix, "o", "d") && !$nick->{op}) { 1058 # calculate delay, add to $opList{$delay} 1059 $delay = calculate_delay($idx, $noPrefix); 1060 $opList{$delay}->{$nick->{nick}} = 1; 1061 } 1062 # add $nick to voiceList{delay} if he is a valid voice 1063 # and isn't voiced already 1064 if (friend_is_wrapper($idx, $noPrefix, "v", undef) && !$nick->{voice} && 1065 (!$nick->{op} || $voice_opped)) { 1066 # calculate delay, add to $voiceList{$delay} 1067 $delay = calculate_delay($idx, $noPrefix); 1068 $voiceList{$delay}->{$nick->{nick}} = 1; 1069 } 1070 } 1071 } 1072 } 1073 1074 # opping 1075 foreach my $delay (keys %opList) { 1076 add_operation($server, $channelName, "op", $delay, keys %{$opList{$delay}}); 1077 } 1078 # voicing 1079 foreach my $delay (keys %voiceList) { 1080 add_operation($server, $channelName, "voice", $delay, keys %{$voiceList{$delay}}); 1081 } 1082 1083 timer_handler(); 1084} 1085 1086# void event_kick($server, $data, $nick) 1087# handles kicks (for revenging) 1088sub event_kick { 1089 my ($server, $data, $kicker) = @_; 1090 my ($channel, $kicked, $reason) = $data =~ /^([^ ]+) ([^ ]+) :(.*)$/; 1091 my $channelInfo = $server->channel_find($channel); 1092 my $myNick = $server->{nick}; 1093 my $victimInfo = undef; 1094 my $kickerInfo = undef; 1095 my $victimIdx = -1; 1096 my $kickerIdx = -1; 1097 my $noPrefix = $channel; 1098 $noPrefix = '!' . substr($channel, 6) if ($channel =~ /^\!/); 1099 1100 return unless ($channelInfo); 1101 1102 # don't bother checking our own kicks, or self-kicks 1103 return if ($kicker eq $myNick || $kicker eq $kicked); 1104 1105 $victimInfo = $channelInfo->nick_find($kicked); 1106 $kickerInfo = $channelInfo->nick_find($kicker); 1107 # we'll need both 1108 return unless ($victimInfo && $kickerInfo); 1109 1110 $victimIdx = get_idx($victimInfo->{nick}, $victimInfo->{host}); 1111 $kickerIdx = get_idx($kickerInfo->{nick}, $kickerInfo->{host}); 1112 1113 # check if we know the victim, and it wasn't a master who deopped 1114 if ($victimIdx > -1 && !friend_is_wrapper($kickerIdx, $noPrefix, "m", undef)) { 1115 # RRRRREVENGE! 1116 my $revengemode = Irssi::settings_get_int('friends_revenge_mode'); 1117 if (Irssi::settings_get_bool('friends_revenge') && ($revengemode > -1 && $revengemode < 4) && 1118 friend_is_wrapper($victimIdx, $noPrefix, "p", undef)) { 1119 # 0 Deop the user. 1120 add_operation($server, $channel, "deop", 1, $kicker); 1121 if ($revengemode > 0) { 1122 # 1 Deop the user and give them the +D flag for the channel. 1123 if ($kickerIdx < 0) { 1124 push(@friends, new_friend( 1125 choose_handle("bad1"), # handle 1126 "*!".$kickerInfo->{host}, # hostmask 1127 undef, # globflags 1128 $noPrefix.",D,", # channel,chanflags,chandelay 1129 undef, # password 1130 "Kicked ".get_handbyidx($victimIdx)." off $noPrefix on $server->{tag}")); 1131 } else { 1132 friends_chflags($kickerIdx, "+D", $noPrefix); 1133 } 1134 if ($revengemode > 1 && $channelInfo->{chanop}) { 1135 # 2 Deop the user, give them the +D flag for the channel, and kick them. 1136 $channelInfo->command("KICK ". $channel . " ".$kicker. " Don't mess with my friends[.pl]"); 1137 if ($revengemode > 2) { 1138 # 3 Deop the user, give them the +D flag for the channel, kick, and ban them. 1139 $channelInfo->command("MODE ". $channel ." +b *!".$kickerInfo->{host}); 1140 } 1141 } 1142 } 1143 } 1144 } 1145} 1146 1147# void event_modechange($server, $data, $nick) 1148# handles modechanges and learning 1149sub event_modechange { 1150 my ($server, $data, $nick) = @_; 1151 my ($channel, $modeStr, $nickStr) = $data =~ /^([^ ]+) ([^ ]+) (.*)$/; 1152 my @modeargs = split(" ", $nickStr); 1153 my $ptr = 0; 1154 my $mode = undef; 1155 my $gotOpped = 0; 1156 my $learnFriends = Irssi::settings_get_bool('friends_learn'); 1157 my $opperInfo = undef; 1158 my $opperIdx = -1; 1159 my $learnFromOpper = 0; 1160 my $channelInfo = $server->channel_find($channel); 1161 my $myNick = $server->{nick}; 1162 # !channels support :) 1163 my $noPrefix = $channel; 1164 $noPrefix = '!' . substr($channel, 6) if ($channel =~ /^\!/); 1165 1166 # don't bother checking our own modes 1167 return if ($nick eq $myNick); 1168 1169 # we need $channelInfo to do almost every other things; 1170 return unless (defined $channelInfo); 1171 1172 $opperInfo = $channelInfo->nick_find($nick); 1173 $opperIdx = get_idx($opperInfo->{nick}, $opperInfo->{host}) if ($opperInfo); 1174 1175 # learn if learning is enabled, 1176 # we know the opper, and we're allowed to learn from him 1177 if ($learnFriends && $opperIdx > -1 && 1178 (friend_is_wrapper($opperIdx, $noPrefix, "F", undef))) { 1179 $learnFromOpper = 1; 1180 } 1181 1182 # process the mode string 1183 foreach my $char (split(//, $modeStr)) { 1184 1185 if ($char eq "+") { $mode = "+"; 1186 } elsif ($char eq "-") { $mode = "-"; 1187 1188 # op/deop, it wasn't a self-op/deop 1189 } elsif (lc($char) eq "o" && ($nick ne $modeargs[$ptr])) { 1190 my $victim = $channelInfo->nick_find($modeargs[$ptr]); 1191 my $victimIdx = -1; 1192 $victimIdx = get_idx($victim->{nick}, $victim->{host}) if ($victim); 1193 1194 # someone +o foobar 1195 if ($mode eq "+") { 1196 # hooray, i got opped! 1197 if ($modeargs[$ptr] eq $myNick) { 1198 $gotOpped = 1; 1199 # should learn? 1200 } elsif ($learnFromOpper && $victim) { 1201 # handle the learning stuff. 1202 my $friend; 1203 1204 if ($victimIdx == -1) { 1205 # we got someone not known before 1206 # choose a handle for him and add him to our friendlist with +L $noPrefix 1207 $friend = new_friend( 1208 choose_handle($modeargs[$ptr]), # handle 1209 "*!".$victim->{host}, # hostmask 1210 undef, # globflags 1211 $noPrefix.",L,", # channel,chanflags,chandelay 1212 undef, # password 1213 "Learnt (opped by $friends[$opperIdx]->{handle} on $noPrefix\@$server->{tag})" # comment 1214 ); 1215 push(@friends, $friend); 1216 } else { 1217 # we know him already 1218 $friend = $friends[$victimIdx]; 1219 } 1220 1221 if ($victimIdx == -1 || get_friends_flags($victimIdx, $noPrefix) eq "L") { 1222 # add him to the opper's friendlist 1223 # ($opperIdx != -1, we've checked that with $learnFromOpper earlier) 1224 push(@{$friends[$opperIdx]->{friends}}, $friend); 1225 } 1226 1227 } elsif (friend_is_wrapper($victimIdx, $noPrefix, "D", undef) && !friend_is_wrapper($opperIdx, $noPrefix, "m", undef)) { 1228 add_operation($server, $channel, "deop", 1, $modeargs[$ptr]); 1229 } 1230 1231 # deop 1232 } elsif ($mode eq "-") { 1233 if ($victim) { 1234 # check if we know the victim, and it wasn't a master who deopped 1235 if ($victimIdx > -1 && !friend_is_wrapper($opperIdx, $noPrefix, "m", undef)) { 1236 # RRRRREVENGE! 1237 my $revengemode = Irssi::settings_get_int('friends_revenge_mode'); 1238 if (Irssi::settings_get_bool('friends_revenge') && ($revengemode > -1 && $revengemode < 4) && 1239 friend_is_wrapper($victimIdx, $noPrefix, "p", undef)) { 1240 # 0 Deop the user. 1241 add_operation($server, $channel, "deop", 1, $nick); 1242 if ($revengemode > 0 && $opperInfo) { 1243 # 1 Deop the user and give them the +D flag for the channel. 1244 if ($opperIdx < 0) { 1245 push(@friends, new_friend( 1246 choose_handle("bad1"), # handle 1247 "*!".$opperInfo->{host}, # hostmask 1248 undef, # globflags 1249 $noPrefix.",D,", # channel,chanflags,chandelay 1250 undef, # password 1251 "Deopped ".get_handbyidx($victimIdx)." on $noPrefix\@$server->{tag}")); 1252 } else { 1253 friends_chflags($opperIdx, "+D", $noPrefix); 1254 } 1255 1256 if ($revengemode > 1 && $channelInfo->{chanop}) { 1257 # 2 Deop the user, give them the +D flag for the channel, and kick them. 1258 $channelInfo->command("KICK ". $channel . " ".$opperInfo->{nick}. " Don't mess with my friends[.pl]"); 1259 if ($revengemode > 2) { 1260 # 3 Deop the user, give them the +D flag for the channel, kick, and ban them. 1261 $channelInfo->command("MODE ". $channel ." +b *!".$opperInfo->{host}); 1262 } 1263 } 1264 } 1265 } 1266 # if a +r'ed person was deopped, perform a reop 1267 if (friend_is_wrapper($victimIdx, $noPrefix, "r", "d")) { 1268 add_operation($server, $channel, "op", calculate_delay($victimIdx, $channel), $modeargs[$ptr]) 1269 } 1270 } 1271 } 1272 } 1273 # increase pointer, 'o' mode has argument, *always* 1274 $ptr++; 1275 } elsif ($char =~ /[beIqdhvk]/ || ($char eq "l" && $mode eq "+")) { 1276 # increase pointer, these modes have arguments as well 1277 $ptr++; 1278 } 1279 } 1280 1281 if ($gotOpped) { 1282 # calling check_friends with !BLARHchannel, since removing BLARH is done there 1283 check_friends($server, $channel, undef, $channelInfo->nicks()); 1284 } 1285} 1286 1287# void event_massjoin($channel, $nicklist) 1288# handles join event 1289sub event_massjoin { 1290 my ($channel, $nicksList) = @_; 1291 my @nicks = @{$nicksList}; 1292 my $server = $channel->{'server'}; 1293 my $channelName = $channel->{name}; 1294 my $options; 1295 $options = "showjoins|" if Irssi::settings_get_bool("friends_show_flags_on_join"); 1296 1297 my $begin = time; 1298 1299 check_friends($server, $channelName, $options, @nicks); 1300 1301 if ((my $duration = time - $begin) >= 1) { 1302 # if checking took more than 1 second -- print a message about it 1303 Irssi::printformat(MSGLEVEL_CRAP, 'friends_checking', $channelName, $duration, $server->{address}); 1304 } 1305} 1306 1307# void event_nicklist_changed($channel, $nick, $oldnick) 1308# some kind of nick-tracking 1309# alters operationQueue if someone from there has changed nick 1310sub event_nicklist_changed { 1311 my ($channel, $nick, $oldnick) = @_; 1312 1313 # nicknames are case insensitive 1314 return if (lc($oldnick) eq lc($nick->{nick})); 1315 1316 # cycle through all operation queues 1317 for (my $c = 0; $c < @operationQueue; ++$c) { 1318 # temporary array 1319 my @nickarr = (); 1320 # is there any nick in this queue that needs altering? 1321 my $found = 0; 1322 1323 # skip if tags don't match 1324 next unless ($operationQueue[$c]->{server}->{tag} eq $channel->{server}->{tag}); 1325 1326 # cycle through all nicks in single operation queue 1327 foreach my $opnick (@{$operationQueue[$c]->{nicks}}) { 1328 # if $oldnick was in the queue 1329 if (lc($oldnick) eq lc($opnick)) { 1330 # ... replace it with the new one 1331 push(@nickarr, $nick->{nick}); 1332 $found = 1; 1333 } else { 1334 # ... else -- keep the old one 1335 push(@nickarr, $opnick); 1336 } 1337 } 1338 1339 # replace $opQ[$c]->{nicks} with our new nicklist if any nick needed updating 1340 $operationQueue[$c]->{nicks} = [ @nickarr ] if ($found); 1341 } 1342} 1343 1344# void event_server_disconnected($server, $anything) 1345# removes all queues related to $server from @operationQueue 1346sub event_server_disconnected { 1347 my ($server, $anything) = @_; 1348 my @removed = (); 1349 1350 # cycle through all operation queues 1351 for (my $c = 0; $c < @operationQueue;) { 1352 if ($operationQueue[$c]->{server}->{tag} eq $server->{tag}) { 1353 push(@removed, splice(@operationQueue, $c, 1)); 1354 } else { 1355 ++$c; 1356 } 1357 } 1358 1359 # if operation queue is empty, remove the timer. 1360 if (scalar(@removed) && !@operationQueue && $timerHandle) { 1361 Irssi::timeout_remove($timerHandle); 1362 $timerHandle = undef; 1363 } 1364} 1365 1366# void cmd_opfriends($data, $server, $channel) 1367# handles /opfriends #channel 1368sub cmd_opfriends { 1369 my ($data, $server, $channel) = @_; 1370 my ($chan) = split(/ +/, $data); 1371 my $usage = "/OPFRIENDS [channel]"; 1372 my @chanstocheck = (); 1373 1374 if (!$server) { 1375 Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No server item in current window"); 1376 return; 1377 } 1378 1379 # no argument given 1380 if ($chan eq "") { 1381 if (!$channel) { 1382 Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No usable channel item in current window"); 1383 return; 1384 } elsif ($channel->{type} ne "CHANNEL") { 1385 Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "Current window item is not a channel"); 1386 return; 1387 } else { 1388 push(@chanstocheck, $channel->{name}); 1389 } 1390 # all channels on current server 1391 } elsif ($chan eq "*") { 1392 foreach my $c ($server->channels()) { 1393 push(@chanstocheck, $c->{name}); 1394 } 1395 # specified channel on current server 1396 } else { 1397 push(@chanstocheck, $chan); 1398 } 1399 1400 foreach my $channelName (@chanstocheck) { 1401 my $chanInfo = $server->channel_find($channelName); 1402 if (!$chanInfo) { 1403 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notonchan', $channelName); 1404 next; 1405 } 1406 1407 # !channels support 1408 my $noPrefix = $chanInfo->{name}; 1409 $noPrefix = '!' . substr($chanInfo->{name}, 6) if ($chanInfo->{name} =~ /^\!/); 1410 1411 my @opnicks = (); 1412 foreach my $nick ($chanInfo->nicks()) { 1413 # skip already opped nicks 1414 next if ($nick->{op}); 1415 # check for friends 1416 my $idx = get_idx($nick->{nick}, $nick->{host}); 1417 # skip not-friends 1418 next unless ($idx > -1); 1419 # add $nick's nick to oplist if enough flags for this channel 1420 push(@opnicks, $nick->{nick}) if (friend_is_wrapper($idx, $noPrefix, "o", "d")); 1421 } 1422 1423 # add stuff to the operation queue 1424 add_operation($server, $noPrefix, "op", "0", @opnicks); 1425 } 1426 1427 timer_handler(); 1428} 1429 1430# void cmd_queue($data, $server, $channel) 1431# expands to queue show|purge|flush 1432sub cmd_queue($$$) { 1433 my ($data, $server, $channel) = @_; 1434 Irssi::command_runsub("queue", $data, $server, $channel); 1435} 1436 1437# bool queue_flush_expand(%what) 1438# "... and few lines of The Magic Code. Now. Your poison is ready." 1439sub queue_flush_expand { 1440 my ($flush) = @_; 1441 my $result = 0; 1442 1443 foreach my $s (keys(%{$flush})) { 1444 # is this server active? 1445 my $server = Irssi::server_find_tag($s); 1446 next unless (defined $server); 1447 1448 foreach my $c (keys(%{$flush->{$s}})) { 1449 # is this channel active? 1450 my $channel = $server->channel_find($c); 1451 next unless (defined $channel); 1452 1453 # for each pending operation 1454 foreach my $o (sort keys(%{$flush->{$s}->{$c}})) { 1455 my @nicklist = (); 1456 foreach my $nickStr (sort keys(%{$flush->{$s}->{$c}->{$o}})) { 1457 # is this nick still here? 1458 if (my $nick = $channel->nick_find($nickStr)) { 1459 push(@nicklist, $nick->{nick}); 1460 } 1461 } 1462 1463 if (my $nickstr = join(" ", @nicklist)) { 1464 $channel->command($o." ".$nickstr); 1465 $result = 1; 1466 } 1467 } 1468 } 1469 } 1470 return $result; 1471} 1472 1473# void queue_show($data, $server, $channel) 1474# handles /QUEUE SHOW 1475# prints @operationQueue's contents 1476sub cmd_queue_show { 1477 if (!@operationQueue) { 1478 Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_empty'); 1479 return; 1480 } 1481 1482 # cycle through all operation queues 1483 for (my $c = 0; $c < @operationQueue; ++$c) { 1484 Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_line1', 1485 $c, 1486 $operationQueue[$c]->{left}, 1487 $operationQueue[$c]->{operation} 1488 ); 1489 Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_line2', 1490 $operationQueue[$c]->{server}->{address}, 1491 $operationQueue[$c]->{channel}, 1492 join(", ", @{$operationQueue[$c]->{nicks}}) 1493 ); 1494 } 1495} 1496 1497# void cmd_queue_flush($data, $server, $channel) 1498# handles /QUEUE FLUSH <number|all> 1499# flushes given/all queue(s) 1500sub cmd_queue_flush { 1501 my ($data) = split(/ +/, $_[0]); 1502 my $usage = "/QUEUE FLUSH <number|all>"; 1503 my @flushqueue = (); 1504 my $flushdata = {}; 1505 my @removed = (); 1506 1507 if (!@operationQueue) { 1508 Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_empty'); 1509 return; 1510 } 1511 1512 if ($data eq "") { 1513 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage); 1514 return; 1515 } 1516 1517 if ($data =~ /^all/i) { 1518 @flushqueue = @operationQueue; 1519 @operationQueue = (); 1520 push(@removed, $data); 1521 } elsif ($data =~ /^[0-9,]+$/) { 1522 my $numstr = join(" ", split(/,/, $data)); 1523 for (my $num = 0; $num < @operationQueue;) { 1524 if ($numstr =~ /\b$num\b/) { 1525 push(@flushqueue, splice(@operationQueue, $num, 1)); 1526 push(@removed, $num); 1527 } else { 1528 $num++ 1529 } 1530 } 1531 } else { 1532 Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage); 1533 return; 1534 } 1535 1536 if (@flushqueue) { 1537 # don't ask... ;^) 1538 foreach my $q (@flushqueue) { 1539 my $s = $q->{server}->{tag}; 1540 my $c = $q->{channel}; 1541 my $o = $q->{operation}; 1542 foreach my $n (@{$q->{nicks}}) { 1543 $flushdata->{$s}->{$c}->{$o}->{$n} = 1 unless ($o eq "voice" && 1544 exists $flushdata->{$s}->{$c}->{op}->{$n} && 1545 !Irssi::settings_get_bool('friends_voice_opped')); 1546 } 1547 } 1548 my $result = ((queue_flush_expand($flushdata)) ? "seems ok" : "looks like nothing done"); 1549 Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_removed', "Flushed", join(", ", @removed), $result); 1550 } 1551 1552 if (!@operationQueue && $timerHandle) { 1553 Irssi::timeout_remove($timerHandle); 1554 $timerHandle = undef; 1555 } 1556} 1557 1558# void cmd_queue_purge($data, $server, $channel) 1559# handles /QUEUE PURGE <number|all> 1560# removes given/all queue(s) 1561sub cmd_queue_purge { 1562 my ($data) = split(/ +/, $_[0]); 1563 my $usage = "/QUEUE PURGE <number|all>"; 1564 my $result; 1565 my @removed; 1566 1567 if (!@operationQueue) { 1568 Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_empty'); 1569 return; 1570 } 1571 1572 if ($data eq "") { 1573 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage); 1574 return; 1575 } 1576 1577 if ($data =~ /^all/i) { 1578 @operationQueue = (); 1579 $result = "OK"; 1580 push(@removed, $data); 1581 } elsif ($data =~ /^[0-9,]+$/) { 1582 my $numstr = join(" ", split(/,/, $data)); 1583 for (my $num = 0; $num < @operationQueue;) { 1584 if ($numstr =~ /\b$num\b/) { 1585 splice(@operationQueue, $num, 1); 1586 push(@removed, $num); 1587 $result = "OK"; 1588 } else { 1589 $num++ 1590 } 1591 } 1592 } else { 1593 Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage); 1594 return; 1595 } 1596 1597 Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_removed', "Purged", join(", ", @removed), $result) if (defined $result); 1598 1599 if (!@operationQueue && $timerHandle) { 1600 Irssi::timeout_remove($timerHandle); 1601 $timerHandle = undef; 1602 } 1603} 1604 1605# void friends_chflags($idx, $string[, $chan]) 1606# parses the $string and calls add_flag() or del_flag() 1607sub friends_chflags { 1608 my ($idx, $string, $chan) = @_; 1609 my $mode = undef; 1610 my $char; 1611 1612 $chan = "global" if ($chan eq "" || lc($chan) eq "global"); 1613 1614 foreach my $char (split(//, $string)) { 1615 if ($char eq "+") { $mode = "+"; 1616 } elsif ($char eq "-") { $mode = "-"; 1617 } elsif ($mode) { 1618 if ($mode eq "+") { 1619 # ADDING flags 1620 # add chan record, if needed 1621 add_chanrec($idx, $chan) if ($chan ne "global" && !friend_has_chanrec($idx, $chan)); 1622 if (!friend_has_flag($idx, $char, $chan)) { 1623 # add this flag if he doesn't have it yet 1624 add_flag($idx, $char, $chan); 1625 } 1626 } elsif ($mode eq "-") { 1627 # REMOVING flags 1628 if ($chan eq "global" || friend_has_chanrec($idx, $chan)) { 1629 del_flag($idx, $char, $chan); 1630 } 1631 } 1632 } 1633 } 1634} 1635 1636# void cmd_chflags($data, $server, $channel) 1637# handles /chflags <handle> <+-flags> [#channel] 1638sub cmd_chflags { 1639 my ($handle, $flags, @chans) = split(/ +/, $_[0]); 1640 my $usage = "/CHFLAGS <handle> <+/-flags> [#channel1] [#channel2] ..."; 1641 1642 # strip %'s 1643 $handle =~ s/\%//g; 1644 1645 # not enough args 1646 if ($handle eq "" || $flags eq "") { 1647 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage); 1648 return; 1649 } 1650 1651 # bad args 1652 # if the 'flags' part doesn't start with + or - 1653 if ($flags !~ /^[\+\-]/) { 1654 Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage); 1655 return; 1656 } 1657 1658 # get idx, yell and return if it isn't valid 1659 my $idx = get_idxbyhand($handle); 1660 if ($idx == -1) { 1661 Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle); 1662 return; 1663 } 1664 1665 # if #channel wasn't specified -- we'll deal with global flags 1666 push(@chans, "global") unless (@chans); 1667 1668 # go through all channels specified 1669 foreach my $chan (@chans) { 1670 # strip %'s 1671 $chan =~ s/\%//g; 1672 1673 # 'executing +foo-bar for someone (where)' 1674 Irssi::printformat(MSGLEVEL_CRAP, 'friends_chflagexec', $flags, get_handbyidx($idx), $chan); 1675 # make changes 1676 friends_chflags($idx, $flags, $chan); 1677 1678 my $flagstr = get_friends_flags($idx, $chan); 1679 # 'current $chan flags for someone are: +blah/[none]' 1680 Irssi::printformat(MSGLEVEL_CRAP, 'friends_currentflags', (($flagstr) ? $flagstr : "[none]"), get_handbyidx($idx), $chan); 1681 } 1682} 1683 1684# void cmd_chhandle($data, $server, $channel) 1685# handles /chhandle <oldhandle> <newhandle> 1686sub cmd_chhandle { 1687 my ($oldhandle, $newhandle) = split(/ +/, $_[0]); 1688 my $usage = "/CHHANDLE <oldhandle> <newhandle>"; 1689 1690 # strip %'s 1691 $newhandle =~ s/\%//g; 1692 1693 # not enough args 1694 if ($oldhandle eq "" || $newhandle eq "") { 1695 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage); 1696 return; 1697 } 1698 1699 # get idx, yell and return if it's not valid 1700 my $idx = get_idxbyhand($oldhandle); 1701 if ($idx == -1) { 1702 Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $oldhandle); 1703 return; 1704 } 1705 1706 # proper case for later printformat 1707 $oldhandle = get_handbyidx($idx); 1708 1709 # handle cannot start with a digit 1710 if ($newhandle =~ /^[0-9]/) { 1711 Irssi::printformat(MSGLEVEL_CRAP, 'friends_badhandle', $newhandle, 1712 "Handle may not start with a digit"); 1713 return; 1714 } 1715 1716 if (lc($newhandle) eq lc($oldhandle)) { 1717 # funny case, only changes case of letters, omit the whole change_handle() 1718 $friends[$idx]->{handle} = $newhandle; 1719 } else { 1720 # check if $newhandle is unique 1721 # if not, print appropriate message and return 1722 if (!is_unique_handle($newhandle)) { 1723 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notuniqhandle', $newhandle); 1724 return; 1725 } 1726 # ok, everything seems fine now, let's change the handle. 1727 change_handle($oldhandle, $newhandle); 1728 } 1729 1730 # ... and print a message 1731 Irssi::printformat(MSGLEVEL_CRAP, 'friends_changed_handle', $oldhandle, $newhandle); 1732} 1733 1734# void change_handle($oldhandle, $newhandle) 1735# changes handle in appropriate structures 1736sub change_handle($$) { 1737 my ($old, $new) = @_; 1738 my $idx = get_idxbyhand($old); 1739 my $lc_new = lc($new); 1740 foreach my $host (get_friends_hosts($idx, $friends_PLAIN_HOSTS)) { 1741 my ($l) = $host =~ /\@(.)/; 1742 my $regexp_host = userhost_to_regexp($host); 1743 $all_regexp_hosts->{allhosts}->{$regexp_host} = $lc_new; 1744 $all_regexp_hosts->{lc($l)}->{$regexp_host} = $lc_new; 1745 $all_hosts->{$host} = $lc_new; 1746 delete $all_handles->{lc($old)}; 1747 $all_handles->{$lc_new} = $idx; 1748 $friends[$idx]->{handle} = $new; 1749 } 1750} 1751 1752# void cmd_chpass($data, $server, $channel) 1753# handles /chpass <handle> [pass] 1754# if pass is empty, removes password 1755# otherwise, crypts it and sets as current one 1756sub cmd_chpass { 1757 my ($handle, $pass) = split(/ +/, $_[0]); 1758 my $usage = "/CHPASS <handle> [newpassword]"; 1759 1760 # not enough args 1761 if ($handle eq "") { 1762 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage); 1763 return; 1764 } 1765 1766 # get idx, yell and return if it's not valid 1767 my $idx = get_idxbyhand($handle); 1768 if ($idx == -1) { 1769 Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle); 1770 return; 1771 } 1772 1773 # crypt and set password. then print a message 1774 $friends[$idx]->{password} = friends_crypt("$pass"); 1775 Irssi::printformat(MSGLEVEL_CRAP, 'friends_chpassexec', get_handbyidx($idx)); 1776} 1777 1778# void cmd_chdelay($data, $server, $channel) 1779# handles /chdelay <handle> <delay> <#channel> 1780# use delay=0 to get instant opping 1781# use delay>0 to get fixed opping delay 1782# use delay='random' or delay='none' or delay = 'remove' 1783# to remove fixed delay (make it random) 1784sub cmd_chdelay { 1785 my ($handle, $delay, $chan) = split(/ +/, $_[0]); 1786 my $usage = "/CHDELAY <handle> <delay> <#channel>"; 1787 my $value = undef; 1788 1789 # strip %'s 1790 $chan =~ s/\%//g; 1791 1792 # not enough args 1793 if ($handle eq "" || $delay eq "" || $chan eq "") { 1794 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage); 1795 return; 1796 } 1797 1798 # if $chan doesn't start with one of the [!&#+] 1799 if ($chan !~ /^[\!\&\#\+]/) { 1800 Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage); 1801 return; 1802 } 1803 1804 # check validness of $delay 1805 if ($delay =~ /^[0-9]+$/) { 1806 # numeric value 1807 $value = $delay; 1808 } elsif ($delay =~ /^(remove|random|none)$/i) { 1809 # 'remove', 'random' or 'none' 1810 $value = undef; 1811 } else { 1812 # badargs, return 1813 Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage); 1814 return; 1815 } 1816 1817 # get idx, yell and return if it's not valid 1818 my $idx = get_idxbyhand($handle); 1819 if ($idx == -1) { 1820 Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle); 1821 return; 1822 } 1823 1824 # check if $idx has got $chan record. 1825 # add one if needed 1826 add_chanrec($idx, $chan) unless (friend_has_chanrec($idx, $chan)); 1827 1828 # finally, set it, and print a message 1829 change_delay($idx, $value, $chan); 1830 Irssi::printformat(MSGLEVEL_CRAP, 'friends_changed_delay', get_handbyidx($idx), 1831 $chan, (defined($value) ? $value : "[random]")); 1832} 1833 1834# void cmd_comment($data, $server, $channel) 1835# handles /comment <handle> [comment] 1836# if comment is empty, removes it 1837# otherwise, sets it as the current one 1838sub cmd_comment { 1839 my ($handle, $comment) = split(" ", $_[0], 2); 1840 my $usage = "/COMMENT <handle> [comment]"; 1841 1842 # not enough args 1843 if ($handle eq "") { 1844 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage); 1845 return; 1846 } 1847 1848 # get idx, yell and return if it's not valid 1849 my $idx = get_idxbyhand($handle); 1850 if ($idx == -1) { 1851 Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle); 1852 return; 1853 } 1854 1855 # remove %'s and trailing spaces (just-in-case ;) 1856 $comment =~ s/\%//g; 1857 $comment =~ s/[\ ]+$//; 1858 1859 # finally, set it, and print a message 1860 $friends[$idx]->{comment} = $comment; 1861 1862 if ($comment ne '') { 1863 Irssi::printformat(MSGLEVEL_CRAP, 'friends_comment_added', get_handbyidx($idx), $comment); 1864 } else { 1865 Irssi::printformat(MSGLEVEL_CRAP, 'friends_comment_removed', get_handbyidx($idx)); 1866 } 1867} 1868 1869# void cmd_listfriend($data, $server, $chanel) 1870# handles /listfriends [what] 1871# 'what' can be either handle, channel name, 1,2,5,15-style, host mask or empty. 1872sub cmd_listfriends { 1873 if (@friends == 0) { 1874 Irssi::printformat(MSGLEVEL_CRAP, 'friends_empty'); 1875 } else { 1876 my ($data) = @_; 1877 my $counter = 0; 1878 # remove whitespaces 1879 $data =~ s/[\t\ ]+//g; 1880 my $win = Irssi::active_win(); 1881 1882 if ($data =~ /^[\!\&\#\+]/) { 1883 # deal with channel 1884 Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', "channel " . $data); 1885 for (my $idx = 0; $idx < @friends; ++$idx) { 1886 if (friend_has_chanrec($idx, $data)) { 1887 list_friend($win, $idx, undef); 1888 $counter++; 1889 } 1890 } 1891 } elsif ($data =~ /^[0-9,]+$/) { 1892 # deal with 1,2,5,15 style 1893 Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', $data); 1894 foreach my $idx (split(/,/, $data)) { 1895 if ($idx < @friends) { 1896 list_friend($win, $idx, undef); 1897 $counter++; 1898 } 1899 } 1900 } elsif ($data =~ /^.*\!.*\@.*$/) { 1901 Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', "matching " . $data); 1902 # /* FIXME */ 1903 my $regexp_data = userhost_to_regexp($data); 1904 for (my $idx = 0; $idx < @friends; ++$idx) { 1905 foreach my $regexp_host (get_friends_hosts($idx, $friends_REGEXP_HOSTS)) { 1906 if ($data =~ /^$regexp_host$/ || $friends[$idx]->{regexp_hosts}->{$regexp_host} =~ /^$regexp_data$/) { 1907 list_friend($win, $idx, undef); 1908 $counter++; 1909 last; 1910 } 1911 } 1912 } 1913 } elsif ($data ne "") { 1914 if ((my $idx = get_idxbyhand($data)) > -1) { 1915 # deal with handle 1916 Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', $data); 1917 list_friend($win, $idx, undef); 1918 $counter++; 1919 } else { 1920 Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $data); 1921 } 1922 } else { 1923 # deal with every entry 1924 Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', "all"); 1925 for (my $idx = 0; $idx < @friends; ++$idx) { 1926 list_friend($win, $idx, undef); 1927 $counter++; 1928 } 1929 } 1930 if ($counter) { 1931 Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist_count', $counter, (($counter > 1) ? "s" : "")); 1932 } 1933 } 1934} 1935 1936# void cmd_addfriend($data, $server, $channel) 1937# handles /addfriend <handle> <hostmask> [flags] 1938# if 'flags' is empty, uses friends_default_flags instead 1939sub cmd_addfriend { 1940 my ($handle, $host, $flags) = split(/ +/, $_[0]); 1941 my $server = $_[1]; 1942 my $usage = "/ADDFRIEND <handle|nick> [<hostmask> [flags]]"; 1943 1944 # strip %'s 1945 $handle =~ s/\%//g; 1946 $host =~ s/\%//g; 1947 1948 # not enough args 1949 if ($handle eq "") { 1950 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage); 1951 return; 1952 } 1953 1954 # handle cannot start with a digit 1955 if ($handle =~ /^[0-9]/) { 1956 Irssi::printformat(MSGLEVEL_CRAP, 'friends_badhandle', $handle, "Handle may not start with a digit"); 1957 return; 1958 } 1959 1960 # assume we want /addfriend somenick 1961 if ($host eq "") { 1962 # no server item in current window 1963 if (!$server) { 1964 Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No server item in current window"); 1965 return; 1966 } 1967 1968 # redirect userhost reply to event_isfriend_userhost() 1969 # caution: This works only with Irssi 0.7.98.CVS (20011117) and newer 1970 $server->redirect_event("userhost", 1, $handle, 0, undef, { 1971 "event 302" => "redir userhost_addfriend"}); 1972 # send our query 1973 $server->send_raw("USERHOST :$handle"); 1974 return; 1975 } 1976 1977 # check must be unique 1978 if (!is_unique_handle($handle)) { 1979 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notuniqhandle', $handle); 1980 return; 1981 } 1982 1983 # add friend. 1984 push(@friends, new_friend($handle, $host, undef, undef, undef, undef)); 1985 Irssi::printformat(MSGLEVEL_CRAP, 'friends_added', $handle); 1986 1987 # check 'flags' parameter, add default flags if empty. 1988 $flags = Irssi::settings_get_str('friends_default_flags') unless ($flags); 1989 1990 # add flags and print them if needed 1991 if ($flags) { 1992 # check if $flags start with a '+'. if not, prepend one. 1993 $flags = "+".$flags unless ($flags =~ /^\+/); 1994 1995 # our new friend should have $idx=(scalar(@friends)-1) now, so we'll use it. 1996 my $idx = scalar(@friends) - 1; 1997 1998 friends_chflags($idx, $flags, "global"); 1999 $flags = get_friends_flags($idx, undef); 2000 Irssi::printformat(MSGLEVEL_CRAP, 'friends_currentflags', $flags, $handle, "global") if ($flags); 2001 } 2002} 2003 2004# void event_addfriend_userhost($server, $reply, $servername) 2005# handles redirected USERHOST replies 2006# (part of /addfriend) 2007sub event_addfriend_userhost { 2008 my ($mynick, $reply) = split(/ +/, $_[1]); 2009 my $server = $_[0]; 2010 my ($nick, $user, $host) = $reply =~ /^:?([^\*=]*)\*?=.(.*)@(.*)/; 2011 my $string = $nick . '!' . $user . '@' . $host; 2012 my $friend_matched = 0; 2013 2014 # try matching ONLY if the response is positive 2015 if (defined $nick && defined $user && defined $host) { 2016 if ((my $idx = get_idx($nick, $user.'@'.$host)) > -1) { 2017 Irssi::printformat(MSGLEVEL_CRAP, 'friends_already_added', $nick, get_handbyidx($idx)); 2018 return; 2019 } 2020 # handle 2021 my $handle = choose_handle($nick); 2022 # *~^=-ident 2023 $user =~ s/^[\~\+\-\^\=]+/\*/; 2024 2025 # add friend. 2026 push(@friends, new_friend($handle, '*!'.$user.'@'.$host, undef, undef, undef, undef)); 2027 Irssi::printformat(MSGLEVEL_CRAP, 'friends_added', $handle); 2028 return; 2029 } 2030 2031 # failed 2032 Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No such nick"); 2033} 2034 2035# void cmd_delfriend($data, $server, $channel) 2036# handles /delfriend <handle|number> 2037# supports /delfriend 2-5,foohand,1,4,10,11-22 2038sub cmd_delfriend { 2039 my ($who) = split(/ +/, $_[0]); 2040 my $usage = "/DELFRIEND <handle|number>"; 2041 2042 # strip %'s 2043 $who =~ s/\%//g; 2044 2045 # not enough args 2046 if ($who eq "") { 2047 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage); 2048 return; 2049 } 2050 2051 my @todelete = (); 2052 foreach my $what (split(/[\ ,]/, $who)) { 2053 if ($what =~ /^[0-9]+$/) { 2054 # /delfriend 15 2055 next unless ($what > -1 && $what < scalar(@friends)); 2056 push(@todelete, $what) unless (grep(/^$what$/, @todelete)); 2057 } elsif ($what =~ /^([0-9]+)\-([0-9]+)$/) { 2058 # /delfriend 2-10 2059 my ($start, $end) = $what =~ /([0-9]+)\-([0-9]+)/; 2060 next if ($start > $end); 2061 for my $i ($start .. $end) { 2062 next unless ($i > -1 && $i < scalar(@friends)); 2063 push(@todelete, $i) unless (grep(/^$i$/, @todelete)); 2064 } 2065 } else { 2066 # /delfriend foobar 2067 my $delidx = get_idxbyhand($what); 2068 push(@todelete, $delidx) unless ($delidx < 0 || grep(/^$delidx$/, @todelete)); 2069 } 2070 } 2071 @todelete = sort {$a <=> $b} @todelete; 2072 2073 return unless (@todelete); 2074 2075 my @result = del_friend(join(" ", @todelete)); 2076 foreach my $deleted (@result) { 2077 Irssi::printformat(MSGLEVEL_CRAP, 'friends_removed', $deleted->{handle}); 2078 } 2079} 2080 2081# void cmd_addhost($data, $server, $channel) 2082# handles /addhost <handle> <hostmask1> [hostmask2] ... 2083# hostmask may not overlap with any of the current ones 2084sub cmd_addhost { 2085 my ($handle, @hosts) = split(/ +/, $_[0]); 2086 my $usage = "/ADDHOST <handle> <hostmask1> [hostmask2] [hostmask3] ..."; 2087 2088 # not enough args 2089 if ($handle eq "" || !@hosts) { 2090 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage); 2091 return; 2092 } 2093 2094 # get idx, yell and return if it's not valid 2095 my $idx = get_idxbyhand($handle); 2096 if ($idx == -1) { 2097 Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle); 2098 return; 2099 } 2100 2101 for (my $i = 0; $i < scalar(@hosts); $i++) { 2102 my $data = $hosts[$i]; 2103 $data =~ s/\%//g; 2104 my $regexp_data = userhost_to_regexp($data); 2105 my $found = 0; 2106 my $who = ""; 2107 2108 # /* FIXME */ 2109 foreach my $plain_host (keys %{$all_hosts}) { 2110 if (!$found && $plain_host =~ /^$regexp_data$/) { 2111 $found = 1; 2112 $who = get_handbyidx(get_idxbyhand($all_hosts->{$plain_host})); 2113 last; 2114 } 2115 } 2116 2117 # /* FIXME again */ 2118 foreach my $regexp_host (get_friends_hosts($idx, $friends_REGEXP_HOSTS)) { 2119 last if ($found); 2120 if ($data =~ /^$regexp_host$/ || $friends[$idx]->{regexp_hosts}->{$regexp_host} =~ /^$regexp_data$/) { 2121 $found = 1; 2122 $who = get_handbyidx($idx); 2123 last; 2124 } 2125 } 2126 2127 if (!$found) { 2128 add_host($idx, $data); 2129 Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_added', get_handbyidx($idx), $data); 2130 } else { 2131 Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_exists', $who, $data); 2132 } 2133 } 2134} 2135 2136# void cmd_delhost($data, $server, $channel) 2137# handles /delhost <handle> <hostmask> 2138# hostmask should be EXACTLY the same as one in $friends[$idx]->{hosts} 2139sub cmd_delhost { 2140 my ($handle, $host) = split(/ +/, $_[0]); 2141 my $usage = "/DELHOST <handle> <hostmask>"; 2142 2143 # strip %'s 2144 $host =~ s/\%//g; 2145 2146 # not enough args 2147 if ($handle eq "" || $host eq "") { 2148 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage); 2149 return; 2150 } 2151 2152 # get idx, yell and return if it's not valid 2153 my $idx = get_idxbyhand($handle); 2154 if ($idx == -1) { 2155 Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle); 2156 return; 2157 } 2158 2159 # delete host, print appropriate message 2160 if (del_host($idx, $host)) { 2161 Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_removed', get_handbyidx($idx), $host); 2162 } else { 2163 Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_notexists', get_handbyidx($idx), $host); 2164 } 2165} 2166 2167# void cmd_delchanrec($data, $server, $channel) 2168# handles /delchanrec <handle> <#channel> 2169sub cmd_delchanrec { 2170 my ($handle, $chan) = split(/ +/, $_[0]); 2171 my $usage = "/DELCHANREC <handle> <#channel>"; 2172 2173 # strip %'s 2174 $chan =~ s/\%//g; 2175 2176 # not enough args 2177 if ($handle eq "" || $chan eq "") { 2178 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage); 2179 return; 2180 } 2181 2182 # get idx, yell and return if it's not valid 2183 my $idx = get_idxbyhand($handle); 2184 if ($idx == -1) { 2185 Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle); 2186 return; 2187 } 2188 2189 # delete chanrec, print appropriate message 2190 if (del_chanrec($idx, $chan)) { 2191 Irssi::printformat(MSGLEVEL_CRAP, 'friends_chanrec_removed', get_handbyidx($idx), $chan); 2192 } else { 2193 Irssi::printformat(MSGLEVEL_CRAP, 'friends_chanrec_notexists', get_handbyidx($idx), $chan); 2194 } 2195} 2196 2197# void cmd_findfriends($data, $server, $channel) 2198# handles /findfriends [handle] 2199# prints online friends 2200sub cmd_findfriends { 2201 my ($data) = split(/ +/, $_[0]); 2202 my $f2w = Irssi::settings_get_str('friends_findfriends_to_windows'); 2203 my $win = undef; 2204 my $lc_data = lc($data); 2205 $win = Irssi::active_win() unless ($f2w || $data eq ''); 2206 2207 # gathering info 2208 my $by_hand = {}; 2209 foreach my $channel (Irssi::channels()) { 2210 my $myNick = $channel->{server}->{nick}; 2211 my $tag = lc($channel->{server}->{tag}); 2212 foreach my $nick ($channel->nicks()) { 2213 # don't count myself 2214 next if ($nick->{nick} eq $myNick); 2215 if ((my $idx = get_idx($nick->{nick}, $nick->{host})) > -1) { 2216 $by_hand->{lc($friends[$idx]->{handle})}->{$tag}->{$channel->{name}} = $nick->{nick}; 2217 } 2218 } 2219 } 2220 2221 # looking for a specified handle 2222 if ($data ne '') { 2223 my $handle = undef; 2224 foreach my $h (keys %{$by_hand}) { 2225 next if ($lc_data ne $h); 2226 $handle = $h; 2227 last; 2228 } 2229 return unless (defined $handle); 2230 2231 # tricky part. 2232 my @data = (); 2233 foreach my $ircnet (keys %{$by_hand->{$handle}}) { 2234 my ($nick, $chan); 2235 foreach $chan (keys %{$by_hand->{$handle}->{$ircnet}}) { 2236 $nick = $by_hand->{$handle}->{$ircnet}->{$chan}; 2237 last; 2238 } 2239 my $chanstr = join(",", sort keys %{$by_hand->{$handle}->{$ircnet}}); 2240 push(@data, join(" ", $ircnet, $nick, $chanstr)); 2241 } 2242 # list them. 2243 list_friend(Irssi::active_win(), $handle, @data); 2244 2245 # looking for anyone 2246 } else { 2247 foreach my $handle (keys %{$by_hand}) { 2248 foreach my $ircnet (keys %{$by_hand->{$handle}}) { 2249 my $server = Irssi::server_find_tag($ircnet); 2250 next unless (defined $server); 2251 foreach my $chan (sort keys %{$by_hand->{$handle}->{$ircnet}}) { 2252 my @data = (); 2253 my $nick = $by_hand->{$handle}->{$ircnet}->{$chan}; 2254 $win = $server->window_item_find($chan); 2255 $win = Irssi::active_win() unless (defined $win && $f2w); 2256 my $chanstr = join(",", sort keys %{$by_hand->{$handle}->{$ircnet}}); 2257 push(@data, join(" ", $ircnet, $nick, $chanstr)); 2258 list_friend($win, $handle, @data); 2259 } 2260 } 2261 } 2262 } 2263} 2264 2265# void cmd_isfriend($data, $server, $channel) 2266# handles /isfriend <nick> 2267sub cmd_isfriend { 2268 my ($data, $server, $channel) = @_; 2269 my $usage = "/ISFRIEND <nick>"; 2270 2271 # remove trailing spaces 2272 $data =~ s/[\t\ ]+$//; 2273 2274 # not enough args 2275 if ($data eq "") { 2276 Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage); 2277 return; 2278 } 2279 2280 # no server item in current window 2281 if (!$server) { 2282 Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No server item in current window"); 2283 return; 2284 } 2285 2286 # redirect userhost reply to event_isfriend_userhost() 2287 # caution: This works only with Irssi 0.7.98.CVS (20011117) and newer 2288 $server->redirect_event("userhost", 1, $data, 0, undef, { 2289 "event 302" => "redir userhost_friends"}); 2290 # send our query 2291 $server->send_raw("USERHOST :$data"); 2292} 2293 2294# void event_isfriend_userhost($server, $reply, $servername) 2295# handles redirected USERHOST replies 2296# (part of /isfriend) 2297sub event_isfriend_userhost { 2298 my ($mynick, $reply) = split(/ +/, $_[1]); 2299 my $server = $_[0]; 2300 my ($nick, $user, $host) = $reply =~ /^:?([^\*=]*)\*?=.(.*)@(.*)/; 2301 my $string = $nick . '!' . $user . '@' . $host; 2302 my $friend_matched = 0; 2303 2304 # try matching ONLY if the response is positive 2305 if (defined $nick && defined $user && defined $host) { 2306 if ((my $idx = get_idx($nick, $user.'@'.$host)) > -1) { 2307 my @chans = (); 2308 foreach my $channel ($server->channels()) { 2309 push(@chans, $channel->{name}) if ($channel->nick_find($nick)); 2310 } 2311 my $chanstr = join(",", @chans); 2312 list_friend(Irssi::active_win(), $idx, join(" ", $server->{tag}, $nick, $chanstr)); 2313 $friend_matched++; 2314 } 2315 } 2316 2317 # print message 2318 if ($friend_matched) { 2319 Irssi::printformat(MSGLEVEL_CRAP, 'friends_endof', "/isfriend", $nick); 2320 } else { 2321 Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $nick); 2322 } 2323} 2324 2325# void event_whois($server, $text, $servername) 2326# handles additional whois data 2327sub event_whois { 2328 my ($server, $text, $servername) = @_; 2329 return unless (Irssi::settings_get_bool('friends_show_whois_extra')); 2330 2331 my ($on, $nick, $user, $host, $as, $rn) = split(/[\ ]:?/, $text, 6); 2332 my $idx = get_idx($nick, $user.'@'.$host); 2333 return unless ($idx > -1); 2334 2335 $server->printformat($nick, MSGLEVEL_CRAP, 'friends_whois', get_handbyidx($idx), ($friends[$idx]->{globflags} ? $friends[$idx]->{globflags} : "none")); 2336} 2337 2338# void cmd_flushlearnt($data, $server, $channel) 2339# cycles through all users and removes every chanrec with flag L 2340# then, if no other stuff left (specific delay, other chanrecs, 2341# global flags, password maybe) -- deletes user. 2342# clears the opping tree too 2343sub cmd_flushlearnt { 2344 my @todelete = (); 2345 # cycle through the whole friendlist 2346 for (my $idx = 0; $idx < @friends; ++$idx) { 2347 my $was_learnt = 0; 2348 2349 # foreach friend, clear his opping tree 2350 $friends[$idx]->{friends} = []; 2351 2352 # now go through all friend's channel entries 2353 foreach my $chan (get_friends_channels($idx)) { 2354 # if 'L' is the only flag for this chan 2355 if (get_friends_flags($idx, $chan) eq "L") { 2356 # remove channel record and print a message 2357 $was_learnt = del_chanrec($idx, $chan); 2358 Irssi::printformat(MSGLEVEL_CRAP, 'friends_chanrec_removed', get_handbyidx($idx), $chan); 2359 } 2360 } 2361 2362 # delete friend, if he has exactly 1 host, no global flags, 2363 # neither password, nor chanrecs, and he was learnt. 2364 if ($was_learnt && scalar(get_friends_hosts($idx, $friends_REGEXP_HOSTS)) == 1 && !get_friends_flags($idx, undef) && 2365 !get_friends_channels($idx) && !$friends[$idx]->{password}) { 2366 push(@todelete, $idx) unless (grep(/^$idx$/, @todelete)); 2367 } 2368 } 2369 return unless @todelete; 2370 2371 @todelete = sort {$a <=> $b} @todelete; 2372 my @result = del_friend(join(" ", @todelete)); 2373 foreach my $deleted (@result) { 2374 Irssi::printformat(MSGLEVEL_CRAP, 'friends_removed', $deleted->{handle}); 2375 } 2376} 2377 2378# void cmd_opping_tree($data, $server, $channel) 2379# prints the Opping Tree 2380sub cmd_oppingtree { 2381 my $found = 0; 2382 # cycle through the whole friendlist 2383 for (my $idx = 0; $idx < @friends; ++$idx) { 2384 # get friend's friends 2385 my @friendFriends = @{$friends[$idx]->{friends}}; 2386 if (@friendFriends) { 2387 Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "Opping tree:") unless ($found); 2388 $found = 1; 2389 # print info about our friend 2390 Irssi::printformat(MSGLEVEL_CRAP, 'friends_optree_line1', get_handbyidx($idx)); 2391 my %masks; 2392 # get all masks opped by him 2393 foreach my $friend (@friendFriends) { 2394 foreach my $host (keys(%{$friend->{hosts}})) { 2395 $masks{$host}++; 2396 last; 2397 } 2398 } 2399 # print them, along with the opcount 2400 foreach my $friend (sort keys %masks) { 2401 Irssi::printformat(MSGLEVEL_CRAP, 'friends_optree_line2', $masks{$friend}, $friend); 2402 } 2403 } 2404 } 2405 Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "Opping tree is empty.") unless ($found); 2406} 2407 2408# void event_ctcpmsg($server, $args, $sender, $senderhsot, $target) 2409# handles ctcp requests 2410sub event_ctcpmsg { 2411 my ($server, $args, $sender, $userhost, $target) = @_; 2412 2413 # return, if ctcp is not for us 2414 my $myNick = $server->{nick}; 2415 return if (lc($target) ne lc($myNick)); 2416 2417 # return, if we don't process ctcp requests 2418 return unless (Irssi::settings_get_bool('friends_use_ctcp')); 2419 2420 # return in case of strange things 2421 return unless (defined $sender && defined $userhost); 2422 2423 my @cmdargs = split(/ +/, $args); 2424 2425 # prepare arguments: 2426 # get 1st arg, uppercase it 2427 my $command = uc($cmdargs[0]); 2428 # get 2nd arg 2429 my $channelName = $cmdargs[1]; 2430 # get 3rd arg 2431 my $password = $cmdargs[2]; 2432 2433 # check if $command is one of friends_ctcp_commands. return if it isn't 2434 return unless (is_ctcp_command($command)); 2435 2436 # this is supposed to be processed BEFORE any other ctcp commands 2437 # /ctcp nick IDENT handle password 2438 if ($command eq "IDENT") { 2439 my $idxguess = get_idxbyhand($channelName); 2440 # looks like a valid friend, password already set, provided password looks fine 2441 if ($idxguess > -1 && $friends[$idxguess]->{password} ne "" && friends_passwdok($idxguess, $password)) { 2442 # do the IDENT stuff here. 2443 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpident', $channelName, $sender.'!'.$userhost); 2444 add_host($idxguess, "*!$userhost"); 2445 Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_added', $channelName, '*!'.$userhost); 2446 $server->command("/^NOTICE $sender Identified as " . get_handbyidx($idxguess)); 2447 } else { 2448 my $reason = "No reason ;)"; 2449 if ($idxguess < 0) { 2450 $reason = "No such handle: $channelName"; 2451 } elsif ($friends[$idxguess]->{password} eq "") { 2452 $reason = "Can't IDENT $channelName without password set"; 2453 } elsif (!friends_passwdok($idxguess, $password)) { 2454 $reason = "Bad password for $channelName"; 2455 } 2456 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $sender.'!'.$userhost, $reason); 2457 } 2458 goto SIGSTOP; 2459 } 2460 2461 my $idx = get_idx($sender, $userhost); 2462 2463 # if get_idx* failed, return. 2464 if ($idx == -1) { 2465 my $reason = "Not a friend" . (($command ne "PASS") ? " for $channelName" : ""); 2466 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $sender.'!'.$userhost, $reason); 2467 goto SIGSTOP; 2468 } 2469 2470 # we'll use handle instead of $sender!$userhost in messages 2471 my $handle = get_handbyidx($idx); 2472 2473 # check if $channelName was supplied. 2474 # (first argument, should be always given) 2475 if ($channelName eq "") { 2476 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough arguments"); 2477 goto SIGSTOP; 2478 } 2479 2480 # /ctcp nick PASS pass [newpass] 2481 if ($command eq "PASS") { 2482 # if someone has password already set - we can only *change* it 2483 if ($friends[$idx]->{password}) { 2484 # if cmdargs[1] ($channelName, that is) is a valid password (current) 2485 if (!friends_passwdok($idx, $channelName)) { 2486 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password"); 2487 goto SIGSTOP; 2488 } 2489 # and $cmdargs[2] ($password, that is) contains something ... 2490 if (defined $password) { 2491 # ... process allowed password change. 2492 # in this case, old password is in $channelName 2493 # and new password is in $password 2494 $friends[$idx]->{password} = friends_crypt("$password"); 2495 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcppass', $handle, $sender."!".$userhost); 2496 # send a quiet notice to sender 2497 $server->command("/^NOTICE $sender Password changed to: $password"); 2498 } else { 2499 # in this case, notify sender about his current password quietly 2500 $server->command("/^NOTICE $sender You already have a password set"); 2501 } 2502 # if $idx doesn't have a password, we will *set* it 2503 } else { 2504 # in this case, new password is in $channelName 2505 # and $password is unused 2506 $friends[$idx]->{password} = friends_crypt("$channelName"); 2507 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcppass', $handle, $sender.'!'.$userhost); 2508 # send a quiet notice to sender 2509 $server->command("/^NOTICE $sender Password set to: $channelName"); 2510 } 2511 goto SIGSTOP; 2512 } 2513 2514 # get channel object. if not found -- yell, stop the signal, and return 2515 my $channel = $server->channel_find($channelName); 2516 if (!$channel) { 2517 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not on channel $channelName"); 2518 goto SIGSTOP; 2519 } 2520 2521 my $sender_rec = $channel->nick_find($sender); 2522 2523 # /ctcp nick OP #channel password 2524 if ($command eq "OP") { 2525 if (!friend_is_wrapper($idx, $channelName, "o", "d")) { 2526 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags"); 2527 goto SIGSTOP; 2528 } 2529 if (!friends_passwdok($idx, $password)) { 2530 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password"); 2531 goto SIGSTOP; 2532 } 2533 2534 # process allowed opping 2535 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName); 2536 $channel->command("op $sender") if ($sender_rec && !$sender_rec->{op}); 2537 goto SIGSTOP; 2538 2539 # /ctcp nick VOICE #channel password 2540 } elsif ($command eq "VOICE") { 2541 if (!friend_is_wrapper($idx, $channelName, "v", undef)) { 2542 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags"); 2543 goto SIGSTOP; 2544 } 2545 if (!friends_passwdok($idx, $password)) { 2546 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password"); 2547 goto SIGSTOP; 2548 } 2549 2550 # process allowed voicing 2551 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName); 2552 $channel->command("voice $sender") if ($sender_rec && !$sender_rec->{voice}); 2553 goto SIGSTOP; 2554 2555 # /ctcp nick INVITE #channel password 2556 } elsif ($command eq "INVITE") { 2557 if (!friend_is_wrapper($idx, $channelName, "i", undef)) { 2558 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags"); 2559 goto SIGSTOP; 2560 } 2561 if (!friends_passwdok($idx, $password)) { 2562 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password"); 2563 goto SIGSTOP; 2564 } 2565 2566 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName); 2567 if (!$channel->{chanop} && !$sender_rec) { 2568 # friend is outside channel, but we're not opped 2569 $server->command("/^NOTICE $sender I'm not opped on $channelName"); 2570 } elsif (!$sender_rec) { 2571 # process allowed invite 2572 $channel->command("invite $sender"); 2573 } 2574 goto SIGSTOP; 2575 2576 # /ctcp nick KEY #channel password 2577 } elsif ($command eq "KEY") { 2578 if (!friend_is_wrapper($idx, $channelName, "k", undef)) { 2579 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags"); 2580 goto SIGSTOP; 2581 } 2582 if (!friends_passwdok($idx, $password)) { 2583 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password"); 2584 goto SIGSTOP; 2585 } 2586 2587 # process allowed key giving 2588 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName); 2589 if ($channel->{key} && !$sender_rec) { 2590 # give a key if channel is +k'ed and $sender is not on $channelName 2591 $server->command("/^NOTICE $sender Key for $channelName is: $channel->{key}"); 2592 } 2593 goto SIGSTOP; 2594 2595 # /ctcp nick UNBAN #channel password 2596 } elsif ($command eq "UNBAN") { 2597 if (!friend_is_wrapper($idx, $channelName, "u", undef)) { 2598 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags"); 2599 goto SIGSTOP; 2600 } 2601 if (!friends_passwdok($idx, $password)) { 2602 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password"); 2603 goto SIGSTOP; 2604 } 2605 2606 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName); 2607 if (!$channel->{chanop}) { 2608 # notify him that we're not opped, unless he's here and he can see that ;^) 2609 $server->command("/^NOTICE $sender I'm not opped on $channelName") if (!$sender_rec); 2610 } else { 2611 # process allowed unban 2612 foreach my $ban ($channel->bans()) { 2613 if ($server->mask_match_address($ban->{ban}, $sender, $userhost)) { 2614 $server->command("MODE $channelName -b $ban->{ban}"); 2615 } 2616 } 2617 } 2618 goto SIGSTOP; 2619 2620 # /ctcp nick LIMIT #channel password 2621 } elsif ($command eq "LIMIT") { 2622 if (!friend_is_wrapper($idx, $channelName, "l", undef)) { 2623 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags"); 2624 goto SIGSTOP; 2625 } 2626 if (!friends_passwdok($idx, $password)) { 2627 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password"); 2628 goto SIGSTOP; 2629 } 2630 2631 # process allowed limit raising 2632 Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName); 2633 if (!$channel->{chanop}) { 2634 # notify him that we're not opped, unless he's here and he can see that ;^) 2635 $server->command("/^NOTICE $sender I'm not opped on $channelName") if (!$sender_rec); 2636 } else { 2637 my @nicks = $channel->nicks(); 2638 if ($channel->{limit} && $channel->{limit} <= scalar(@nicks)) { 2639 # raise the limit if it's needed 2640 $server->command("MODE $channelName +l " . (scalar(@nicks) + 1)); 2641 } 2642 } 2643 goto SIGSTOP; 2644 } 2645 2646 # stop the signal if we processed the request 2647SIGSTOP: 2648 Irssi::signal_stop(); 2649} 2650 2651# void cmd_friendsversion($data, $server, $channel) 2652# handles /friendsversion 2653# prints script's and friendlist's version 2654sub cmd_friendsversion() { 2655 print_version("script"); 2656 print_version("filever"); 2657 print_version("filewritten"); 2658} 2659 2660# settings 2661Irssi::settings_add_int('misc', 'friends_delay_min', $default_delay_min); 2662Irssi::settings_add_int('misc', 'friends_delay_max', $default_delay_max); 2663Irssi::settings_add_int('misc', 'friends_max_queue_size', $default_friends_max_queue_size); 2664Irssi::settings_add_int('misc', 'friends_revenge_mode', $default_friends_revenge_mode); 2665Irssi::settings_add_bool('misc', 'friends_revenge', $default_friends_revenge); 2666Irssi::settings_add_bool('misc', 'friends_learn', $default_friends_learn); 2667Irssi::settings_add_bool('misc', 'friends_voice_opped', $default_friends_voice_opped); 2668Irssi::settings_add_bool('misc', 'friends_use_ctcp', $default_friends_use_ctcp); 2669Irssi::settings_add_bool('misc', 'friends_autosave', $default_friends_autosave); 2670Irssi::settings_add_bool('misc', 'friends_backup_friendlist', $default_friends_backup_friendlist); 2671Irssi::settings_add_bool('misc', 'friends_show_flags_on_join', $default_friends_show_flags_on_join); 2672Irssi::settings_add_bool('misc', 'friends_findfriends_to_windows', $default_friends_findfriends_to_windows); 2673Irssi::settings_add_bool('misc', 'friends_show_whois_extra', $default_friends_show_whois_extra); 2674Irssi::settings_add_str('misc', 'friends_ctcp_commands', $default_friends_ctcp_commands); 2675Irssi::settings_add_str('misc', 'friends_default_flags', $default_friends_default_flags); 2676Irssi::settings_add_str('misc', 'friends_file', $default_friends_file); 2677Irssi::settings_add_str('misc', 'friends_backup_suffix', $default_friends_backup_suffix); 2678 2679# commands 2680Irssi::command_bind('addfriend', 'cmd_addfriend'); 2681Irssi::command_bind('delfriend', 'cmd_delfriend'); 2682Irssi::command_bind('addhost', 'cmd_addhost'); 2683Irssi::command_bind('delhost', 'cmd_delhost'); 2684Irssi::command_bind('delchanrec', 'cmd_delchanrec'); 2685Irssi::command_bind('chhandle', 'cmd_chhandle'); 2686Irssi::command_bind('chdelay', 'cmd_chdelay'); 2687Irssi::command_bind('loadfriends', 'cmd_loadfriends'); 2688Irssi::command_bind('savefriends', 'cmd_savefriends'); 2689Irssi::command_bind('listfriends', 'cmd_listfriends'); 2690Irssi::command_bind('findfriends', 'cmd_findfriends'); 2691Irssi::command_bind('isfriend', 'cmd_isfriend'); 2692Irssi::command_bind('chflags', 'cmd_chflags'); 2693Irssi::command_bind('chpass', 'cmd_chpass'); 2694Irssi::command_bind('comment', 'cmd_comment'); 2695Irssi::command_bind('oppingtree', 'cmd_oppingtree'); 2696Irssi::command_bind('opfriends', 'cmd_opfriends'); 2697Irssi::command_bind('queue', 'cmd_queue'); 2698Irssi::command_bind('queue show', 'cmd_queue_show'); 2699Irssi::command_bind('queue flush', 'cmd_queue_flush'); 2700Irssi::command_bind('queue purge', 'cmd_queue_purge'); 2701Irssi::command_bind('flushlearnt', 'cmd_flushlearnt'); 2702Irssi::command_bind('friendsversion', 'cmd_friendsversion'); 2703 2704# events 2705Irssi::signal_add_last('massjoin', 'event_massjoin'); 2706Irssi::signal_add_last('event mode', 'event_modechange'); 2707Irssi::signal_add_last('event 311', 'event_whois'); 2708Irssi::signal_add('default ctcp msg', 'event_ctcpmsg'); 2709Irssi::signal_add('redir userhost_friends', 'event_isfriend_userhost'); 2710Irssi::signal_add('redir userhost_addfriend', 'event_addfriend_userhost'); 2711Irssi::signal_add('setup saved', 'event_setup_saved'); 2712Irssi::signal_add('setup reread', 'event_setup_reread'); 2713Irssi::signal_add('nicklist changed', 'event_nicklist_changed'); 2714Irssi::signal_add('server disconnected', 'event_server_disconnected'); 2715Irssi::signal_add('server connect failed', 'event_server_disconnected'); 2716Irssi::signal_add_first('event kick', 'event_kick'); 2717 2718print_releasenote() if (defined($release_note)); 2719load_friends(); 2720