html/friends_shasta.pl
1 #!/usr/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
10 use strict;
11 use 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
24 use Irssi 20011201.0100 ();
25 use Irssi::Irc;
26
27 # friends.pl
28 my $friends_version = $VERSION . " (20031109)";
29
30 # release note, if any
31 my $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?
38 my $default_friends_use_ctcp = 1;
39
40 # space-separated list of allowed (implemented ;) CTCP commands
41 my $default_friends_ctcp_commands = "OP VOICE LIMIT KEY INVITE PASS IDENT UNBAN";
42
43 # do you want to learn new users?
44 my $default_friends_learn = 1;
45
46 # do you want to autovoice already opped nicks?
47 my $default_friends_voice_opped = 0;
48
49 # do you want to show additional info with /whois?
50 my $default_friends_show_whois_extra = 1;
51
52 # which flags do you want to add automatically with /addfriend? (case *sensitive*)
53 my $default_friends_default_flags = "";
54
55 # default path to friendlist
56 my $default_friends_file = Irssi::get_irssi_dir() . "/friends";
57
58 # do you want to save friendlist every time irssi's setup is saved
59 my $default_friends_autosave = 0;
60
61 # do you want to backup your friendlist upon a save
62 my $default_friends_backup_friendlist = 1;
63
64 # backup suffix to use (unixtime if empty)
65 my $default_friends_backup_suffix = ".backup";
66
67 # do you want to show friend's flags while he joins a channel?
68 my $default_friends_show_flags_on_join = 1;
69
70 # do you want to revenge?
71 my $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.
78 my $default_friends_revenge_mode = 0;
79
80 # do you want /findfriends to print info in separate windows for separate chans?
81 my $default_friends_findfriends_to_windows = 0;
82
83 # maximum size of operationQueue
84 my $default_friends_max_queue_size = 20;
85
86 # min delaytime
87 my $default_delay_min = 10;
88
89 # max delaytime
90 my $default_delay_max = 60;
91
92 ###############################################################
93
94 # registering themes
95 Irssi::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
155 my @friends = ();
156 my $all_regexp_hosts = {};
157 my $all_hosts = {};
158 my $all_handles = {};
159 my @operationQueue = ();
160 my $timerHandle = undef;
161 my $friends_file_version;
162 my $friends_file_written;
163
164 my $friends_PLAIN_HOSTS = 0;
165 my $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
174 my %htr = ();
175 # fill the hash
176 foreach 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
187 sub 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
196 sub 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
204 sub 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 ;^)
227 sub 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
236 sub 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
243 sub 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
251 sub 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
258 sub 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
271 sub 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
290 sub 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
307 sub 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 '*'
342 sub 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.
353 sub is_allowed_flag { return 1; }
354
355 # bool is_ctcp_command($command)
356 # check if $command is one of the implemented ctcp commands
357 sub 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) :)
369 sub 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
387 sub 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
398 sub 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)
407 sub 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.
419 sub 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
435 sub 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
458 sub 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
470 sub 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
480 sub 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
496 sub 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
525 sub 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.
536 sub 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
542 sub 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.
585 sub 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))
596 sub 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
612 sub 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.
633 sub 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
653 sub 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.
672 sub 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
716 sub 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
738 sub 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}
804 sub 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
816 sub 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]
889 sub cmd_loadfriends {
890 my ($file) = split(/ +/, $_[0]);
891 load_friends($file);
892 }
893
894 # void save_friends($auto)
895 # saving friends to file
896 sub 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]
964 sub 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)
975 sub 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)
987 sub event_setup_reread {
988 load_friends() if (Irssi::settings_get_bool('friends_autosave'));
989 }
990
991 # int calculate_delay($idx, $chan)
992 # calculates delay
993 sub 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
1012 sub 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)
1088 sub 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
1149 sub 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
1289 sub 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
1310 sub 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
1346 sub 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
1368 sub 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
1432 sub 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."
1439 sub 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
1476 sub 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)
1500 sub 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)
1561 sub 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()
1607 sub 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]
1638 sub 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>
1686 sub 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
1736 sub 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
1756 sub 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)
1784 sub 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
1838 sub 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.
1872 sub 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
1939 sub 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)
2007 sub 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
2038 sub 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
2084 sub 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}
2139 sub 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>
2169 sub 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
2200 sub 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>
2267 sub 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)
2297 sub 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
2327 sub 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
2343 sub 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
2380 sub 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
2410 sub 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
2647 SIGSTOP:
2648 Irssi::signal_stop();
2649 }
2650
2651 # void cmd_friendsversion($data, $server, $channel)
2652 # handles /friendsversion
2653 # prints script's and friendlist's version
2654 sub cmd_friendsversion() {
2655 print_version("script");
2656 print_version("filever");
2657 print_version("filewritten");
2658 }
2659
2660 # settings
2661 Irssi::settings_add_int('misc', 'friends_delay_min', $default_delay_min);
2662 Irssi::settings_add_int('misc', 'friends_delay_max', $default_delay_max);
2663 Irssi::settings_add_int('misc', 'friends_max_queue_size', $default_friends_max_queue_size);
2664 Irssi::settings_add_int('misc', 'friends_revenge_mode', $default_friends_revenge_mode);
2665 Irssi::settings_add_bool('misc', 'friends_revenge', $default_friends_revenge);
2666 Irssi::settings_add_bool('misc', 'friends_learn', $default_friends_learn);
2667 Irssi::settings_add_bool('misc', 'friends_voice_opped', $default_friends_voice_opped);
2668 Irssi::settings_add_bool('misc', 'friends_use_ctcp', $default_friends_use_ctcp);
2669 Irssi::settings_add_bool('misc', 'friends_autosave', $default_friends_autosave);
2670 Irssi::settings_add_bool('misc', 'friends_backup_friendlist', $default_friends_backup_friendlist);
2671 Irssi::settings_add_bool('misc', 'friends_show_flags_on_join', $default_friends_show_flags_on_join);
2672 Irssi::settings_add_bool('misc', 'friends_findfriends_to_windows', $default_friends_findfriends_to_windows);
2673 Irssi::settings_add_bool('misc', 'friends_show_whois_extra', $default_friends_show_whois_extra);
2674 Irssi::settings_add_str('misc', 'friends_ctcp_commands', $default_friends_ctcp_commands);
2675 Irssi::settings_add_str('misc', 'friends_default_flags', $default_friends_default_flags);
2676 Irssi::settings_add_str('misc', 'friends_file', $default_friends_file);
2677 Irssi::settings_add_str('misc', 'friends_backup_suffix', $default_friends_backup_suffix);
2678
2679 # commands
2680 Irssi::command_bind('addfriend', 'cmd_addfriend');
2681 Irssi::command_bind('delfriend', 'cmd_delfriend');
2682 Irssi::command_bind('addhost', 'cmd_addhost');
2683 Irssi::command_bind('delhost', 'cmd_delhost');
2684 Irssi::command_bind('delchanrec', 'cmd_delchanrec');
2685 Irssi::command_bind('chhandle', 'cmd_chhandle');
2686 Irssi::command_bind('chdelay', 'cmd_chdelay');
2687 Irssi::command_bind('loadfriends', 'cmd_loadfriends');
2688 Irssi::command_bind('savefriends', 'cmd_savefriends');
2689 Irssi::command_bind('listfriends', 'cmd_listfriends');
2690 Irssi::command_bind('findfriends', 'cmd_findfriends');
2691 Irssi::command_bind('isfriend', 'cmd_isfriend');
2692 Irssi::command_bind('chflags', 'cmd_chflags');
2693 Irssi::command_bind('chpass', 'cmd_chpass');
2694 Irssi::command_bind('comment', 'cmd_comment');
2695 Irssi::command_bind('oppingtree', 'cmd_oppingtree');
2696 Irssi::command_bind('opfriends', 'cmd_opfriends');
2697 Irssi::command_bind('queue', 'cmd_queue');
2698 Irssi::command_bind('queue show', 'cmd_queue_show');
2699 Irssi::command_bind('queue flush', 'cmd_queue_flush');
2700 Irssi::command_bind('queue purge', 'cmd_queue_purge');
2701 Irssi::command_bind('flushlearnt', 'cmd_flushlearnt');
2702 Irssi::command_bind('friendsversion', 'cmd_friendsversion');
2703
2704 # events
2705 Irssi::signal_add_last('massjoin', 'event_massjoin');
2706 Irssi::signal_add_last('event mode', 'event_modechange');
2707 Irssi::signal_add_last('event 311', 'event_whois');
2708 Irssi::signal_add('default ctcp msg', 'event_ctcpmsg');
2709 Irssi::signal_add('redir userhost_friends', 'event_isfriend_userhost');
2710 Irssi::signal_add('redir userhost_addfriend', 'event_addfriend_userhost');
2711 Irssi::signal_add('setup saved', 'event_setup_saved');
2712 Irssi::signal_add('setup reread', 'event_setup_reread');
2713 Irssi::signal_add('nicklist changed', 'event_nicklist_changed');
2714 Irssi::signal_add('server disconnected', 'event_server_disconnected');
2715 Irssi::signal_add('server connect failed', 'event_server_disconnected');
2716 Irssi::signal_add_first('event kick', 'event_kick');
2717
2718 print_releasenote() if (defined($release_note));
2719 load_friends();