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