Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
2720 lines (2382 sloc) 84.8 KB
#!/usr/bin/perl -w
#
# This script may not work with irssi older than 0.8.5!
#
# Historical author of this script is Erkki Seppala <flux@inside.org>
# Now it's maintained by me, so i'm listed as an author.
#
# $Id: friends.pl,v 1.3 2003/11/09 21:11:45 shasta Exp $
use strict;
use vars qw($VERSION %IRSSI);
$VERSION = "2.4.9";
%IRSSI = (
authors => 'Jakub Jankowski',
contact => 'shasta@toxcorp.com',
name => 'Friends',
description => 'Maintains list of people you know.',
license => 'GNU GPLv2 or later',
url => 'http://toxcorp.com/irc/irssi/friends/',
changed => 'Sun Oct 9 22:12:43 2003'
);
use Irssi 20011201.0100 ();
use Irssi::Irc;
# friends.pl
my $friends_version = $VERSION . " (20031109)";
# release note, if any
my $release_note = "Please read http://toxcorp.com/irc/irssi/friends/current/README\n";
##############################################
# These variables are adjustable with /set
# but here are some 'safe' defaults:
# do you want to process CTCP queries?
my $default_friends_use_ctcp = 1;
# space-separated list of allowed (implemented ;) CTCP commands
my $default_friends_ctcp_commands = "OP VOICE LIMIT KEY INVITE PASS IDENT UNBAN";
# do you want to learn new users?
my $default_friends_learn = 1;
# do you want to autovoice already opped nicks?
my $default_friends_voice_opped = 0;
# do you want to show additional info with /whois?
my $default_friends_show_whois_extra = 1;
# which flags do you want to add automatically with /addfriend? (case *sensitive*)
my $default_friends_default_flags = "";
# default path to friendlist
my $default_friends_file = Irssi::get_irssi_dir() . "/friends";
# do you want to save friendlist every time irssi's setup is saved
my $default_friends_autosave = 0;
# do you want to backup your friendlist upon a save
my $default_friends_backup_friendlist = 1;
# backup suffix to use (unixtime if empty)
my $default_friends_backup_suffix = ".backup";
# do you want to show friend's flags while he joins a channel?
my $default_friends_show_flags_on_join = 1;
# do you want to revenge?
my $default_friends_revenge = 1;
# revenge mode:
# 0 Deop the user.
# 1 Deop the user and give them the +D flag for the channel.
# 2 Deop the user, give them the +D flag for the channel, and kick them.
# 3 Deop the user, give them the +D flag for the channel, kick, and ban them.
my $default_friends_revenge_mode = 0;
# do you want /findfriends to print info in separate windows for separate chans?
my $default_friends_findfriends_to_windows = 0;
# maximum size of operationQueue
my $default_friends_max_queue_size = 20;
# min delaytime
my $default_delay_min = 10;
# max delaytime
my $default_delay_max = 60;
###############################################################
# registering themes
Irssi::theme_register([
'friends_empty', 'Your friendlist is empty. Add items with /ADDFRIEND',
'friends_notenoughargs', 'Not enough arguments. Usage: $0',
'friends_badargs', 'Bad arguments. Usage: $0',
'friends_nosuch', 'No such friend %R$0%n',
'friends_notonchan', 'Not on channel {hilight $0}',
'friends_endof', 'End of $0 $1',
'friends_badhandle', 'Wrong handle: %R$0%n. $1',
'friends_notuniqhandle', 'Handle %R$0%n already exists, choose another one',
'friends_version', 'friends.pl\'s version: {hilight $0} [$1]',
'friends_file_written', 'friendlist written on: {hilight $0}',
'friends_file_version', 'friendlist written with: {hilight $0} [$1]',
'friends_filetooold', 'Friendfile too old, loading aborted',
'friends_loaded', 'Loaded {hilight $0} friends from $1',
'friends_saved', 'Saved {hilight $0} friends to $1',
'friends_duplicate', 'Skipping %R$0%n [duplicate?]',
'friends_checking', 'Checking {hilight $0} took {hilight $1} secs [on $2]',
'friends_line_head', '[$[!-3]0] Handle: %R$1%n, flags: %C$2%n [password: $3]',
'friends_line_hosts', '$[-6]9 Hosts: $0',
'friends_line_chan', '$[-6]9 Channel {hilight $0}: Flags: %c$1%n, Delay: $2',
'friends_line_comment', '$[-6]9 Comment: $0',
'friends_line_currentnick', '$[-6]9 [$1] Current nick: {nick $0}',
'friends_line_channelson', '$[-6]9 [$1] Currently sharing with you: $0',
'friends_joined', '{nick $0} is a friend, handle: %R$1%n, global flags: %C$2%n, flags for {hilight $3}: %C$4%n',
'friends_whois', '{whois friend handle: {hilight $0}, global flags: $1}',
'friends_queue_empty', 'Operation queue is empty',
'friends_queue_line1', '[$[!-2]0] Operation: %R$1%n secs left before {hilight $2}',
'friends_queue_line2', ' (Server: {hilight $0}, Channel: {hilight $1}, Nicklist: $2)',
'friends_queue_nosuch', 'No such entry in operation queue ($0)',
'friends_queue_removed', '$0 queues: {hilight $1} [$2]',
'friends_friendlist', '{hilight Friendlist} [$0]:',
'friends_friendlist_count', 'Listed {hilight $0} friend$1',
'friends_findfriends', 'Looking for %R$2%n on channel {hilight $0} [on $1]:',
'friends_already_added', 'Nick {hilight $0} matches one of %R$1%n\'s hosts',
'friends_added', 'Added %R$0%n to friendlist',
'friends_removed', 'Removed %R$0%n from friendlist',
'friends_comment_added', 'Added comment line to %R$0%n ($1)',
'friends_comment_removed', 'Removed comment line from %R$0%n',
'friends_host_added', 'Added {hilight $1} to %R$0%n',
'friends_host_removed', 'Removed {hilight $1} from %R$0%n',
'friends_host_exists', 'Hostmask {hilight $1} overlaps with one of the already added to %R$0%n',
'friends_host_notexists', '%R$0%n does not have {hilight $1} in hostlist',
'friends_chanrec_removed', 'Removed {hilight $1} record from %R$0%n',
'friends_chanrec_notexists', '%R$0%n does not have {hilight $1} record',
'friends_changed_handle', 'Changed {hilight $0} to %R$1%n',
'friends_changed_delay', 'Changed %R$0%n\'s delay value on {hilight $1} to %c$2%n',
'friends_chflagexec', 'Executing %c$0%n for %R$1%n ($2)',
'friends_currentflags', 'Current {channel $2} flags for %R$1%n are: %c$0%n',
'friends_chpassexec', 'Altered password for %R$0%n',
'friends_ctcprequest', '%R$0%n asks for {hilight $1} on {hilight $2}',
'friends_ctcppass', 'Password for %R$0%n altered by $1',
'friends_ctcpident', 'CTCP IDENT for %R$0%n from {hilight $1} succeeded',
'friends_ctcpfail', 'Failed CTCP {hilight $0} from %R$1%n. $2',
'friends_optree_header', 'Opping tree:',
'friends_optree_line1', '%R$0%n has opped these:',
'friends_optree_line2', '{hilight $[!-4]0} times: $1',
'friends_general', '$0',
'friends_notice', '[%RN%n] $0'
]);
my @friends = ();
my $all_regexp_hosts = {};
my $all_hosts = {};
my $all_handles = {};
my @operationQueue = ();
my $timerHandle = undef;
my $friends_file_version;
my $friends_file_written;
my $friends_PLAIN_HOSTS = 0;
my $friends_REGEXP_HOSTS = 1;
# Idea of moving userhost to a regexp and
# the subroutine userhost_to_regexp were adapted from people.pl,
# an userlist script made by Marcin 'Qrczak' Kowalczyk.
# You can get that script from http://qrnik.knm.org.pl/~qrczak/irssi/people.pl
# or from http://scripts.irssi.org/
# HostToRegexp
my %htr = ();
# fill the hash
foreach my $i (0..255) {
my $ch = chr($i);
$htr{$ch} = "\Q$ch\E";
}
# wildcards to regexp
$htr{'?'} = '.';
$htr{'*'} = '.*';
# str userhost_to_regexp($userhost)
# translates userhost to a regexp
# lowercases host-part
sub userhost_to_regexp($) {
my ($mask) = @_;
$mask = lowercase_hostpart($mask);
$mask =~ s/(.)/$htr{$1}/g;
return $mask;
}
# str lowercase_hostpart($userhost)
# returns userhost with host-part loweracased
sub lowercase_hostpart($) {
my ($host) = @_;
$host =~ s/(.+)\@(.+)/sprintf("%s@%s", $1, lc($2));/eg;
return $host;
}
# void print_version($what)
# print's version of script/userlist
sub print_version($) {
my ($what) = @_;
$what = lc($what);
if ($what eq "filever") {
if ($friends_file_version) {
my ($verbal, $numeric) = $friends_file_version =~ /^(.+)\ \(([0-9]+)\)$/;
Irssi::printformat(MSGLEVEL_CRAP, 'friends_file_version', $verbal, $numeric);
} else {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_empty');
}
} elsif ($what eq "filewritten" && $friends_file_written) {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($friends_file_written);
my $written = sprintf("%4d%02d%02d %02d:%02d:%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec);
Irssi::printformat(MSGLEVEL_CRAP, 'friends_file_written', $written);
} else {
my ($verbal, $numerical) = $friends_version =~ /^(.+)\ \(([0-9]+)\)$/;
Irssi::printformat(MSGLEVEL_CRAP, 'friends_version', $verbal, $numerical);
}
}
# void print_releasenote()
# suprisingly, prints a release note ;^)
sub print_releasenote {
foreach my $line (split(/\n/, $release_note)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notice', $line);
}
}
# str friends_crypt($plain)
# returns crypt()ed $plain, using random salt;
# or "" if $plain is empty
sub friends_crypt {
return if ($_[0] eq "");
return crypt("$_[0]", (join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]));
}
# bool friend_passwdok($idx, $pwd)
# returns 1 if password is ok, 0 if isn't
sub friends_passwdok {
my ($idx, $pwd) = @_;
return 1 if (crypt("$pwd", $friends[$idx]->{password}) eq $friends[$idx]->{password});
return 0;
}
# arr get_friends_channels($idx)
# returns list of $friends[$idx] channels
sub get_friends_channels {
return keys(%{$friends[$_[0]]->{channels}});
}
# arr get_friends_hosts($idx, $type)
# returns list of $friends[$idx] regexp-hostmask if $type=$friends_REGEXP_HOSTS
# returns list of plain-hostmasks if $type=$friends_PLAIN_HOSTS
sub get_friends_hosts($$) {
if ($_[1] == $friends_REGEXP_HOSTS) {
return keys(%{$friends[$_[0]]->{regexp_hosts}});
} elsif ($_[1] == $friends_PLAIN_HOSTS) {
return keys(%{$friends[$_[0]]->{hosts}});
}
return undef;
}
# str get_friends_flags($idx[, $chan])
# returns list of $chan flags for $idx
# $chan can be also 'global' or undef
# case insensitive about the $chan
sub get_friends_flags {
my ($idx, $chan) = @_;
$chan = lc($chan);
if ($chan eq "" || $chan eq "global") {
return $friends[$idx]->{globflags};
} else {
foreach my $friendschan (get_friends_channels($idx)) {
if ($chan eq lc($friendschan)) {
return $friends[$idx]->{channels}->{$friendschan}->{flags};
}
}
}
return;
}
# str get_friends_delay($idx[, $chan])
# returns $chan delay for $idx
# returns "" if $chan is 'global' or undef
# case insensitive about the $chan
sub get_friends_delay {
my ($idx, $chan) = @_;
$chan = lc($chan);
if ($chan && $chan ne "global") {
foreach my $friendschan (get_friends_channels($idx)) {
if ($chan eq lc($friendschan)) {
return undef if ($friends[$idx]->{channels}->{$friendschan}->{delay} eq '');
return $friends[$idx]->{channels}->{$friendschan}->{delay};
}
}
}
return;
}
# struct friend new_friend($handle, $hoststr, $globflags, $chanflagstr, $password, $comment)
# hoststr is: *!foo@host1 *!bar@host2 *!?baz@host3
# chanstr is: #chan1,flags,delay #chan2,flags,delay
sub new_friend {
my $friend = {};
my $idx = scalar(@friends);
$friend->{handle} = $_[0];
$all_handles->{lc($_[0])} = $idx;
$friend->{globflags} = $_[2];
$friend->{password} = $_[4];
$friend->{comment} = $_[5];
$friend->{friends} = [];
foreach my $host (split(/ +/, $_[1])) {
my $regexp_host = userhost_to_regexp($host);
my ($firstalpha) = $host =~ /\@(.)/;
$firstalpha = lc($firstalpha);
$friend->{hosts}->{$host} = $regexp_host;
$friend->{regexp_hosts}->{$regexp_host} = $host;
$all_regexp_hosts->{allhosts}->{$regexp_host} = lc($_[0]);
$all_regexp_hosts->{$firstalpha}->{$regexp_host} = lc($_[0]);
$all_hosts->{$host} = lc($_[0]);
}
foreach my $cfd (split(/ +/, $_[3])) {
# $cfd format: #foobar,oikl,15 (channelname,flags,delay)
my ($channel, $flags, $delay) = split(",", $cfd, 3);
$friend->{channels}->{$channel}->{exist} = 1;
$friend->{channels}->{$channel}->{flags} = $flags;
$friend->{channels}->{$channel}->{delay} = $delay;
}
return $friend;
}
# get_regexp_hosts_by_letter($letter)
# returns those regexp masks whose host part begins with $letter, '?' or '*'
sub get_regexp_hosts_by_letter($) {
my $l = lc(substr($_[0], 0, 1));
my @tmphosts = ();
push(@tmphosts, keys(%{$all_regexp_hosts->{$l}}));
push(@tmphosts, keys(%{$all_regexp_hosts->{'?'}}));
push(@tmphosts, keys(%{$all_regexp_hosts->{'*'}}));
return @tmphosts;
}
# bool is_allowed_flag($flag)
# will be obsolete, soon.
sub is_allowed_flag { return 1; }
# bool is_ctcp_command($command)
# check if $command is one of the implemented ctcp commands
sub is_ctcp_command {
my ($command) = @_;
$command = uc($command);
foreach my $allowed (split(/[,\ \|]+/, uc(Irssi::settings_get_str('friends_ctcp_commands')))) {
return 1 if ($command eq $allowed);
}
return 0;
}
# int get_idx($nick, $userhost)
# returns idx of the friend or -1 if not a friend
# The New Approach (TM) :)
sub get_idx($$) {
my ($nick, $userhost) = @_;
$userhost = lowercase_hostpart($nick.'!'.$userhost);
my ($letter) = $userhost =~ /\@(.)/;
my $idx = -1;
foreach my $regexp_host (get_regexp_hosts_by_letter($letter)) {
if ($userhost =~ /^$regexp_host$/) {
return get_idxbyhand($all_regexp_hosts->{allhosts}->{$regexp_host});
}
}
return -1;
}
# int get_idxbyhand($handle)
# returns $idx of friend with $handle or -1 if no such handle
# case insensitive
sub get_idxbyhand($) {
my $handle = lc($_[0]);
if (exists $all_handles->{$handle}) {
return $all_handles->{$handle};
}
return -1;
}
# int get_handbyidx($idx)
# returns $handle of friend with $idx or undef if no such $idx
# case sensitive
sub get_handbyidx($) {
my ($idx) = @_;
return undef unless ($idx > -1 && $idx < scalar(@friends));
return $friends[$idx]->{handle};
}
# bool friend_has_host($idx, $host)
# checks wheter $host matches any of $friend[$idx]'s hostmasks
# The New Approach (TM)
sub friend_has_host($$) {
my ($idx, $host) = @_;
$host = lowercase_hostpart($host);
foreach my $regexp_host (keys (%{$friends[$idx]->{regexp_hosts}})) {
return 1 if ($host =~ /^$regexp_host$/);
}
return 0;
}
# void add_host($idx, $host)
# adds $host wherever it's needed
# $friends[$idx]->{handle} is A MUST for add_host() to work properly.
sub add_host($$) {
my ($idx, $host) = @_;
my $regexp_host = userhost_to_regexp($host);
my ($firstalpha) = $host =~ /\@(.)/;
$firstalpha = lc($firstalpha);
$friends[$idx]->{hosts}->{$host} = $regexp_host;
$friends[$idx]->{regexp_hosts}->{$regexp_host} = $host;
$all_regexp_hosts->{allhosts}->{$regexp_host} = lc($friends[$idx]->{handle});
$all_regexp_hosts->{$firstalpha}->{$regexp_host} = lc($friends[$idx]->{handle});
$all_hosts->{$host} = lc($friends[$idx]->{handle});
}
# int del_host($idx, $host)
# deletes $host from wherever it is
# if given $host arg is '*', removes all hosts of this friend
sub del_host($$) {
my ($idx, $host) = @_;
my $deleted = 0;
foreach my $regexp_host (keys (%{$friends[$idx]->{regexp_hosts}})) {
if ($host eq '*' || $host =~ /^$regexp_host$/) {
my $plain_host = $friends[$idx]->{regexp_hosts}->{$regexp_host};
my ($l) = $plain_host =~ /\@(.)/;
delete $friends[$idx]->{hosts}->{$plain_host};
delete $friends[$idx]->{regexp_hosts}->{$regexp_host};
delete $all_regexp_hosts->{allhosts}->{$regexp_host};
delete $all_regexp_hosts->{$l}->{$regexp_host};
delete $all_hosts->{$plain_host};
$deleted++;
}
}
return $deleted;
}
# bool friend_has_chanrec($idx, $chan)
# checks wheter $friend[$idx] has a $chan record
# case insensitive
sub friend_has_chanrec {
my ($idx, $chan) = @_;
$chan = lc($chan);
foreach my $friendschan (get_friends_channels($idx)) {
return 1 if ($chan eq lc($friendschan));
}
return 0;
}
# bool add_chanrec($idx, $chan)
# adds an empty $chan record to $friends[$idx]
# case sensitive
sub add_chanrec {
my ($idx, $chan) = @_;
return 0 unless ($idx > -1 && $idx < scalar(@friends));
$friends[$idx]->{channels}->{$chan}->{exist} = 1;
return 1;
}
# bool del_chanrec($idx, $chan)
# deletes $chan record from $friends[$idx]
# case *in*sensitive
sub del_chanrec {
my ($idx, $chan) = @_;
my $deleted = 0;
foreach my $friendschan (get_friends_channels($idx)) {
if (lc($chan) eq lc($friendschan)) {
delete $friends[$idx]->{channels}->{$friendschan};
$deleted = 1;
}
}
return $deleted;
}
# arr del_friend($idxs)
# removes friends
# removes all hosts corresponding to this friend
# returns array of removed friends
sub del_friend($) {
my ($idxlist) = @_;
my @idxs = split(/ /, $idxlist);
return -1 unless (scalar(@idxs) > 0);
my @tmp = ();
my @result = ();
my @todelete = ();
foreach my $idx (@idxs) {
my $handle = get_handbyidx($idx);
if (!(!defined $handle || grep(/^\Q$handle\E$/i, @todelete))) {
push(@todelete, $handle);
del_host($idx, '*');
}
}
for (my $idx = 0; $idx < @friends; $idx++) {
if (grep(/^\Q$friends[$idx]->{handle}\E$/i, @todelete)) {
push(@result, $friends[$idx]);
} else {
push(@tmp, $friends[$idx]);
}
}
@friends = @tmp;
update_allhandles();
return @result;
}
# void update_all_handles()
# updates $all_handles
sub update_allhandles {
$all_handles = {};
for (my $idx = 0; $idx < @friends; $idx++) {
$all_handles->{lc($friends[$idx]->{handle})} = $idx
}
}
# bool is_unique_handle($handle)
# checks if the $handle is unique for the whole friendlist
# returns 1 if there's no such $handle
# returns 0 if there is one.
sub is_unique_handle($) {
return !exists $all_handles->{lc($_[0])};
}
# str choose_handle($proposed)
# tries to choose a handle, closest to the $proposed one
sub choose_handle {
my ($proposed) = @_;
my $counter = 0;
my $handle = $proposed;
# do this until we have an unique handle
while (!is_unique_handle($handle)) {
if (($handle !~ /([0-9]+)$/) && !$counter) {
# first, if handle doesn't end with a digit, append '2'
# (but only in first step)
$handle .= "2";
} elsif ($counter < 85) {
# later, increase the trailing number by one
# do that 84 times
my ($number) = $handle =~ /([0-9]+)$/;
++$number;
$handle =~ s/([0-9]+)$/$number/;
} elsif ($counter == 85) {
# then, if it didn't helped, make $handle = $proposed."_"
$handle = $proposed . "_";
} elsif ($counter < 90) {
# if still unsuccessful, append "_" to the handle
# do that 4 times
$handle .= "_";
} else {
# if THAT didn't help -- make some silly handle
# and exit the loop
$handle = $proposed.'_'.(join '', (0..9, 'a'..'z')[rand 36, rand 36, rand 36, rand 36]);
last;
}
++$counter;
}
# return our glorious handle ;-)
return $handle;
}
# bool friend_has_flag($idx, $flag[, $chan])
# returns true if $friends[$idx] has $flag for $chan
# (checks global flags, if $chan is 'global' or undef)
# returns false if hasn't
# case sensitive about the FLAG
# case insensitive about the chan.
sub friend_has_flag {
my ($idx, $flag, $chan) = @_;
$chan = "global" unless ($chan ne '');
return 1 if (get_friends_flags($idx, $chan) =~ /\Q$flag\E/);
return 0;
}
# bool friend_is_wrapper($idx, $chan, $goodflag, $badflag)
# something to replace friend_is_* subs
# true on: ($channel +$goodflag OR global +$goodflag) AND ($badflag == "" OR NOT $channel +$badflag))
sub friend_is_wrapper($$$$) {
my ($idx, $chan, $goodflag, $badflag) = @_;
return 0 unless ($idx > -1);
if ((friend_has_flag($idx, $goodflag, $chan) ||
friend_has_flag($idx, $goodflag, undef)) &&
($badflag eq "" || !friend_has_flag($idx, $badflag, $chan))) {
return 1;
}
return 0;
}
# bool add_flag($idx, $flag[, $chan])
# adds $flag to $idx's $chan flags
# $chan can be 'global' or undef
# case insensitive about the $chan -- chooses the proper case.
# returns 1 on success
sub add_flag {
my ($idx, $flag, $chan) = @_;
$chan = lc($chan);
if ($chan eq "" || $chan eq "global") {
$friends[$idx]->{globflags} .= $flag;
return 1;
} else {
foreach my $friendschan (get_friends_channels($idx)) {
if ($chan eq lc($friendschan)) {
$friends[$idx]->{channels}->{$friendschan}->{flags} .= $flag;
return 1;
}
}
}
return 0;
}
# bool del_flag($idx, $flag[, $chan])
# removes $flag from $idx's $chan flags
# $chan can be 'global' or undef
# case insensitive about the $chan -- chooses the proper case.
sub del_flag {
my ($idx, $flag, $chan) = @_;
$chan = lc($chan);
if ($chan eq "" || $chan eq "global") {
$friends[$idx]->{globflags} =~ s/\Q$flag\E//g;
return 1;
} else {
foreach my $friendschan (get_friends_channels($idx)) {
if ($chan eq lc($friendschan)) {
$friends[$idx]->{channels}->{$friendschan}->{flags} =~ s/\Q$flag\E//i;
return 1;
}
}
}
return 0;
}
# bool change_delay($idx, $delay, $chan)
# alters $idx's delay time for $chan
# fails if $chan is 'global' or undef
sub change_delay {
my ($idx, $delay, $chan) = @_;
$chan = lc($chan);
if ($chan && $chan ne "global") {
foreach my $friendschan (get_friends_channels($idx)) {
if ($chan eq lc($friendschan)) {
$friends[$idx]->{channels}->{$friendschan}->{delay} = $delay;
return 1;
}
}
}
return 0;
}
# void list_friend($window, $who, @data)
# prints an info line about certain friend.
# $who may be handle or idx
# if you want to improve the look of the script, you should
# change /format friends_*, probably.
sub list_friend {
my ($win, $who, @data) = @_;
my $idx = $who;
$idx = get_idxbyhand($who) unless ($who =~ /^[0-9]+$/);
return unless ($idx > -1 && $idx < scalar(@friends));
my $globflags = get_friends_flags($idx, undef);
$win = Irssi::active_win() unless ($win);
$win->printformat(MSGLEVEL_CRAP, 'friends_line_head',
$idx,
get_handbyidx($idx),
(($globflags) ? "$globflags" : "[none]"),
(($friends[$idx]->{password}) ? "yes" : "no"));
$win->printformat(MSGLEVEL_CRAP, 'friends_line_hosts',
join(", ", get_friends_hosts($idx, $friends_PLAIN_HOSTS)) );
foreach my $chan (get_friends_channels($idx)) {
my $flags = get_friends_flags($idx, $chan);
my $delay = get_friends_delay($idx, $chan);
$win->printformat(MSGLEVEL_CRAP, 'friends_line_chan',
$chan,
(($flags) ? "$flags" : "[none]"),
(defined($delay) ? "$delay" : "random"));
}
if ($friends[$idx]->{comment}) {
$win->printformat(MSGLEVEL_CRAP, 'friends_line_comment', $friends[$idx]->{comment});
}
for my $item (@data) {
my ($ircnet, $nick, $chanstr) = split(" ", $item);
next unless (defined $ircnet);
$win->printformat(MSGLEVEL_CRAP, 'friends_line_currentnick', $nick, $ircnet) if ($nick ne '');;
$win->printformat(MSGLEVEL_CRAP, 'friends_line_channelson', join(", ", split(/,/, $chanstr)), $ircnet) if ($chanstr ne '');
}
}
# void add_operation($server, "#channel", "op|voice|deop|devoice|kick|kickban", timeout, "nick1", "nick2", ...)
# adds a delayed (or not) operation
sub add_operation {
my ($server, $channel, $operation, $timeout, @nicks) = @_;
# my dear queue, don't grow too big, mmkay? ;^)
my $maxsize = Irssi::settings_get_int('friends_max_queue_size');
$maxsize = $default_friends_max_queue_size unless ($maxsize > 0);
return if (@operationQueue >= $maxsize);
push(@operationQueue,
{
server=>$server, # server object
left=>$timeout, # seconds left
nicks=>[ @nicks ], # array of nicks
channel=>$channel, # channel name
operation=>$operation # operation ("op", "voice" and so on)
});
$timerHandle = Irssi::timeout_add(1000, 'timer_handler', 0) unless (defined $timerHandle);
}
# void timer_handler()
# handles delay timer
sub timer_handler {
my @ops = ();
# splice out expired timeouts. if they are expired, move them to
# local ops-queue. this allows creating new operations to the queue
# in the operation. (we're not (yet) doing that)
for (my $c = 0; $c < @operationQueue;) {
if ($operationQueue[$c]->{left} <= 0) {
push(@ops, splice(@operationQueue, $c, 1));
} else {
++$c;
}
}
for (my $c = 0; $c < @ops; ++$c) {
my $op = $ops[$c];
my $channel = $op->{server}->channel_find($op->{channel});
# check if $channel is still active (you might've parted)
if ($channel) {
my @operationNicks = ();
foreach my $nickStr (@{$op->{nicks}}) {
my $nick = $channel->nick_find($nickStr);
# check if there's still such nick (it might've quit/parted)
if ($nick) {
if ($op->{operation} eq "op" && !$nick->{op}) {
push(@operationNicks, $nick->{nick});
}
if ($op->{operation} eq "voice" && !$nick->{voice} &&
(!$nick->{op} || Irssi::settings_get_bool('friends_voice_opped'))) {
push(@operationNicks, $nick->{nick});
}
if ($op->{operation} eq "deop" && $nick->{op}) {
push(@operationNicks, $nick->{nick});
}
if ($op->{operation} eq "devoice" && $nick->{voice}) {
push(@operationNicks, $nick->{nick});
}
if ($op->{operation} eq "kick") {
push(@operationNicks, $nick->{nick});
}
if ($op->{operation} eq "kickban") {
push(@operationNicks, $nick->{nick});
}
}
}
# final stage: issue desired command if we're a chanop
$channel->command($op->{operation}." ".join(" ", @operationNicks)) if ($channel->{chanop});
}
}
# decrement timeouts.
for (my $c = 0; $c < @operationQueue; ++$c) {
--$operationQueue[$c]->{left};
}
# if operation queue is empty, remove timer.
if (!@operationQueue && $timerHandle) {
Irssi::timeout_remove($timerHandle);
$timerHandle = undef;
}
}
# str replace_home($string)
# replaces '~' with current $ENV{HOME}
sub replace_home($) {
my ($string) = @_;
my $home = $ENV{HOME};
return undef unless ($string);
$string =~ s/^\~/$home/;
return $string;
}
# void load_friends($inputfile)
# loads friends from file. uses $inputfile if supplied.
# if not, uses friends_file setting. if this setting is empty,
# uses default -- $friends_file
sub load_friends {
my ($inputfile) = @_;
my $friendfile = undef;
if (defined($inputfile)) {
$friendfile = replace_home($inputfile);
} else {
$friendfile = replace_home(Irssi::settings_get_str('friends_file'));
}
$friendfile = $default_friends_file unless (defined $friendfile);
if (-e $friendfile && -r $friendfile) {
@friends = ();
$all_hosts = {};
$all_regexp_hosts = {};
$all_handles = {};
local *F;
open(F, "<", $friendfile) or return -1;
local $/ = "\n";
while (<F>) {
my ($handle, $hosts, $globflags, $chanstr, $password, $comment);
chop;
# dealing with empty lines
next if (/^[\w]*$/);
# dealing with comments
if (/^\#/) {
# script version
if (/^\# version = (.+)/) { $friends_file_version = $1; }
# timestamp
if (/^\# written = ([0-9]+)/) { $friends_file_written = $1; }
next;
}
# split by '%'
my @fields = split("%", $_);
foreach my $field (@fields) {
if ($field =~ /^handle=(.*)$/) { $handle = $1; }
elsif ($field =~ /^hosts=(.*)$/) { $hosts = $1; }
elsif ($field =~ /^globflags=(.*)$/) { $globflags = $1; }
elsif ($field =~ /^chanflags=(.*)$/) { $chanstr = $1; }
elsif ($field =~ /^password=(.*)$/) { $password = $1; }
elsif ($field =~ /^comment=(.*)$/) { $comment = $1; }
}
# handle cannot start with a digit
# skip friend if it does
next if ($handle =~ /^[0-9]/);
# if all fields were processed, and $handle is unique,
# make a friend and add it to $friends
if (is_unique_handle($handle)) {
push(@friends, new_friend($handle, $hosts, $globflags, $chanstr, $password, $comment));
} else {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_duplicate', $handle);
}
}
close(F);
# if everything's ok -- print a message
Irssi::printformat(MSGLEVEL_CRAP, 'friends_loaded', scalar(@friends), $friendfile);
} else {
# whoops, bail out, but do not clear the friendlist.
Irssi::print("Cannot load $friendfile");
}
}
# void cmd_loadfriends($data, $server, $channel)
# handles /loadfriends [file]
sub cmd_loadfriends {
my ($file) = split(/ +/, $_[0]);
load_friends($file);
}
# void save_friends($auto)
# saving friends to file
sub save_friends {
my ($auto, $inputfile) = @_;
local *F;
my $friendfile = undef;
my $backup_suffix = Irssi::settings_get_str('friends_backup_suffix');
$backup_suffix = "." . time if ($backup_suffix eq '');
if (defined $inputfile) {
$friendfile = replace_home($inputfile);
} else {
$friendfile = replace_home(Irssi::settings_get_str('friends_file'));
}
$friendfile = $default_friends_file unless (defined $friendfile);
my $backupfile = $friendfile . $backup_suffix;
my $tmpfile = $friendfile . ".tmp" . time;
# be sane
my $old_umask = umask(077);
if (!defined open(F, ">", $tmpfile)) {
Irssi::print("Couldn't open $tmpfile for writing");
return 0;
}
# write script's version and update corresponding variable
$friends_file_version = $friends_version;
print(F "# version = $friends_file_version\n");
# write current unixtime and update corresponding variable
$friends_file_written = time;
print(F "# written = $friends_file_written\n");
# go through all entries
for (my $idx = 0; $idx < @friends; ++$idx) {
# get friend's channels, corresponding flags and delay values
# then put them as c,f,d fields into @chanstr
my @chanstr = ();
foreach my $chan (get_friends_channels($idx)) {
$chan =~ s/\%//g;
push(@chanstr, $chan.",".(get_friends_flags($idx, $chan)).",".
(get_friends_delay($idx, $chan)));
}
# write the actual line
print(F join("%",
"handle=".get_handbyidx($idx),
"hosts=".(join(" ", get_friends_hosts($idx, $friends_PLAIN_HOSTS))),
"globflags=".(get_friends_flags($idx, undef)),
"chanflags=".(join(" ", @chanstr)),
"password=".$friends[$idx]->{password},
"comment=".$friends[$idx]->{comment},
"\n"));
}
# done.
close(F);
rename($friendfile, $backupfile) if (Irssi::settings_get_bool('friends_backup_friendlist'));
rename($tmpfile, $friendfile);
Irssi::printformat(MSGLEVEL_CRAP, 'friends_saved', scalar(@friends), $friendfile) unless ($auto);
# restore umask
umask($old_umask);
}
# void cmd_savefriends($data, $server, $channel)
# handles /savefriends [filename]
sub cmd_savefriends {
my ($file) = split(/ +/, $_[0]);
eval {
save_friends(0, $file);
};
Irssi::print("Saving friendlist failed: $?") if ($?);
}
# void event_setup_saved($config, $auto)
# calls save_friends to save friendslist while saving irssi's setup
# (if friends_autosave is turned on)
sub event_setup_saved {
my ($config, $auto) = @_;
return unless (Irssi::settings_get_bool('friends_autosave'));
eval {
save_friends($auto);
};
Irssi::print("Saving friendlist failed: $?") if ($?);
}
# void event_setup_reread($config)
# calls load_friends() while setup is re-readed
# (if friends_autosave is turned on)
sub event_setup_reread {
load_friends() if (Irssi::settings_get_bool('friends_autosave'));
}
# int calculate_delay($idx, $chan)
# calculates delay
sub calculate_delay {
my ($idx, $chan) = @_;
my $delay = get_friends_delay($idx, $chan);
my $min = Irssi::settings_get_int('friends_delay_min');
my $max = Irssi::settings_get_int('friends_delay_max');
# lazy man's sanity checks :-P
$min = $default_delay_min if $min < 0;
$max = $default_delay_max if $min > $max;
$max = $max + $min if $min > $max;
# make a random delay unless we've got a fixed delay time already
$delay = int(rand ($max - $min)) + $min unless ($delay =~ /^[0-9]+$/);
return $delay;
}
# void check_friends($server, $channelstr, $options, @nickstocheck)
# checks the given nicklist, channelname and server against the friendlist
sub check_friends {
my ($server, $channelName, $options, @nicks) = @_;
my $channel = $server->channel_find($channelName);
my $delay = 30;
my %opList = ();
my %voiceList = ();
# server and channel -- a must.
return unless ($server && $channelName);
# proper !channels support, hopefully
my $noPrefix = $channelName;
$noPrefix = '!' . substr($channelName, 6) if ($channelName =~ /^\!/);
# get settings
my $voice_opped = Irssi::settings_get_bool('friends_voice_opped');
# for each nick from the given list
foreach my $nick (@nicks) {
# check if $nick is a friend
if ((my $idx = get_idx($nick->{nick}, $nick->{host})) > -1) {
# notify about the join if "showjoins" is set
if ($options =~ /showjoins/) {
my $globflags = get_friends_flags($idx, undef);
my $chanflags = get_friends_flags($idx, $noPrefix);
my $win = $server->window_item_find($channelName);
$win = Irssi::active_win() unless ($win);
$win->printformat(MSGLEVEL_CRAP, 'friends_joined',
$nick->{nick},
get_handbyidx($idx),
($globflags) ? $globflags : "[none]",
$noPrefix,
($chanflags) ? $chanflags : "[none]");
}
# notice1: password doesn't matter in this loop
# notice2: channel flags take precedence over the global ones
# handle auto-(op|voice)
if (friend_is_wrapper($idx, $noPrefix, "a", undef)) {
# add $nick to opList{delay} if he is a valid op
# and isn't opped already
# 'valid op' means: (chanflag +o OR globflag +o) AND NOT chanflag +d
if (friend_is_wrapper($idx, $noPrefix, "o", "d") && !$nick->{op}) {
# calculate delay, add to $opList{$delay}
$delay = calculate_delay($idx, $noPrefix);
$opList{$delay}->{$nick->{nick}} = 1;
}
# add $nick to voiceList{delay} if he is a valid voice
# and isn't voiced already
if (friend_is_wrapper($idx, $noPrefix, "v", undef) && !$nick->{voice} &&
(!$nick->{op} || $voice_opped)) {
# calculate delay, add to $voiceList{$delay}
$delay = calculate_delay($idx, $noPrefix);
$voiceList{$delay}->{$nick->{nick}} = 1;
}
}
}
}
# opping
foreach my $delay (keys %opList) {
add_operation($server, $channelName, "op", $delay, keys %{$opList{$delay}});
}
# voicing
foreach my $delay (keys %voiceList) {
add_operation($server, $channelName, "voice", $delay, keys %{$voiceList{$delay}});
}
timer_handler();
}
# void event_kick($server, $data, $nick)
# handles kicks (for revenging)
sub event_kick {
my ($server, $data, $kicker) = @_;
my ($channel, $kicked, $reason) = $data =~ /^([^ ]+) ([^ ]+) :(.*)$/;
my $channelInfo = $server->channel_find($channel);
my $myNick = $server->{nick};
my $victimInfo = undef;
my $kickerInfo = undef;
my $victimIdx = -1;
my $kickerIdx = -1;
my $noPrefix = $channel;
$noPrefix = '!' . substr($channel, 6) if ($channel =~ /^\!/);
return unless ($channelInfo);
# don't bother checking our own kicks, or self-kicks
return if ($kicker eq $myNick || $kicker eq $kicked);
$victimInfo = $channelInfo->nick_find($kicked);
$kickerInfo = $channelInfo->nick_find($kicker);
# we'll need both
return unless ($victimInfo && $kickerInfo);
$victimIdx = get_idx($victimInfo->{nick}, $victimInfo->{host});
$kickerIdx = get_idx($kickerInfo->{nick}, $kickerInfo->{host});
# check if we know the victim, and it wasn't a master who deopped
if ($victimIdx > -1 && !friend_is_wrapper($kickerIdx, $noPrefix, "m", undef)) {
# RRRRREVENGE!
my $revengemode = Irssi::settings_get_int('friends_revenge_mode');
if (Irssi::settings_get_bool('friends_revenge') && ($revengemode > -1 && $revengemode < 4) &&
friend_is_wrapper($victimIdx, $noPrefix, "p", undef)) {
# 0 Deop the user.
add_operation($server, $channel, "deop", 1, $kicker);
if ($revengemode > 0) {
# 1 Deop the user and give them the +D flag for the channel.
if ($kickerIdx < 0) {
push(@friends, new_friend(
choose_handle("bad1"), # handle
"*!".$kickerInfo->{host}, # hostmask
undef, # globflags
$noPrefix.",D,", # channel,chanflags,chandelay
undef, # password
"Kicked ".get_handbyidx($victimIdx)." off $noPrefix on $server->{tag}"));
} else {
friends_chflags($kickerIdx, "+D", $noPrefix);
}
if ($revengemode > 1 && $channelInfo->{chanop}) {
# 2 Deop the user, give them the +D flag for the channel, and kick them.
$channelInfo->command("KICK ". $channel . " ".$kicker. " Don't mess with my friends[.pl]");
if ($revengemode > 2) {
# 3 Deop the user, give them the +D flag for the channel, kick, and ban them.
$channelInfo->command("MODE ". $channel ." +b *!".$kickerInfo->{host});
}
}
}
}
}
}
# void event_modechange($server, $data, $nick)
# handles modechanges and learning
sub event_modechange {
my ($server, $data, $nick) = @_;
my ($channel, $modeStr, $nickStr) = $data =~ /^([^ ]+) ([^ ]+) (.*)$/;
my @modeargs = split(" ", $nickStr);
my $ptr = 0;
my $mode = undef;
my $gotOpped = 0;
my $learnFriends = Irssi::settings_get_bool('friends_learn');
my $opperInfo = undef;
my $opperIdx = -1;
my $learnFromOpper = 0;
my $channelInfo = $server->channel_find($channel);
my $myNick = $server->{nick};
# !channels support :)
my $noPrefix = $channel;
$noPrefix = '!' . substr($channel, 6) if ($channel =~ /^\!/);
# don't bother checking our own modes
return if ($nick eq $myNick);
# we need $channelInfo to do almost every other things;
return unless (defined $channelInfo);
$opperInfo = $channelInfo->nick_find($nick);
$opperIdx = get_idx($opperInfo->{nick}, $opperInfo->{host}) if ($opperInfo);
# learn if learning is enabled,
# we know the opper, and we're allowed to learn from him
if ($learnFriends && $opperIdx > -1 &&
(friend_is_wrapper($opperIdx, $noPrefix, "F", undef))) {
$learnFromOpper = 1;
}
# process the mode string
foreach my $char (split(//, $modeStr)) {
if ($char eq "+") { $mode = "+";
} elsif ($char eq "-") { $mode = "-";
# op/deop, it wasn't a self-op/deop
} elsif (lc($char) eq "o" && ($nick ne $modeargs[$ptr])) {
my $victim = $channelInfo->nick_find($modeargs[$ptr]);
my $victimIdx = -1;
$victimIdx = get_idx($victim->{nick}, $victim->{host}) if ($victim);
# someone +o foobar
if ($mode eq "+") {
# hooray, i got opped!
if ($modeargs[$ptr] eq $myNick) {
$gotOpped = 1;
# should learn?
} elsif ($learnFromOpper && $victim) {
# handle the learning stuff.
my $friend;
if ($victimIdx == -1) {
# we got someone not known before
# choose a handle for him and add him to our friendlist with +L $noPrefix
$friend = new_friend(
choose_handle($modeargs[$ptr]), # handle
"*!".$victim->{host}, # hostmask
undef, # globflags
$noPrefix.",L,", # channel,chanflags,chandelay
undef, # password
"Learnt (opped by $friends[$opperIdx]->{handle} on $noPrefix\@$server->{tag})" # comment
);
push(@friends, $friend);
} else {
# we know him already
$friend = $friends[$victimIdx];
}
if ($victimIdx == -1 || get_friends_flags($victimIdx, $noPrefix) eq "L") {
# add him to the opper's friendlist
# ($opperIdx != -1, we've checked that with $learnFromOpper earlier)
push(@{$friends[$opperIdx]->{friends}}, $friend);
}
} elsif (friend_is_wrapper($victimIdx, $noPrefix, "D", undef) && !friend_is_wrapper($opperIdx, $noPrefix, "m", undef)) {
add_operation($server, $channel, "deop", 1, $modeargs[$ptr]);
}
# deop
} elsif ($mode eq "-") {
if ($victim) {
# check if we know the victim, and it wasn't a master who deopped
if ($victimIdx > -1 && !friend_is_wrapper($opperIdx, $noPrefix, "m", undef)) {
# RRRRREVENGE!
my $revengemode = Irssi::settings_get_int('friends_revenge_mode');
if (Irssi::settings_get_bool('friends_revenge') && ($revengemode > -1 && $revengemode < 4) &&
friend_is_wrapper($victimIdx, $noPrefix, "p", undef)) {
# 0 Deop the user.
add_operation($server, $channel, "deop", 1, $nick);
if ($revengemode > 0 && $opperInfo) {
# 1 Deop the user and give them the +D flag for the channel.
if ($opperIdx < 0) {
push(@friends, new_friend(
choose_handle("bad1"), # handle
"*!".$opperInfo->{host}, # hostmask
undef, # globflags
$noPrefix.",D,", # channel,chanflags,chandelay
undef, # password
"Deopped ".get_handbyidx($victimIdx)." on $noPrefix\@$server->{tag}"));
} else {
friends_chflags($opperIdx, "+D", $noPrefix);
}
if ($revengemode > 1 && $channelInfo->{chanop}) {
# 2 Deop the user, give them the +D flag for the channel, and kick them.
$channelInfo->command("KICK ". $channel . " ".$opperInfo->{nick}. " Don't mess with my friends[.pl]");
if ($revengemode > 2) {
# 3 Deop the user, give them the +D flag for the channel, kick, and ban them.
$channelInfo->command("MODE ". $channel ." +b *!".$opperInfo->{host});
}
}
}
}
# if a +r'ed person was deopped, perform a reop
if (friend_is_wrapper($victimIdx, $noPrefix, "r", "d")) {
add_operation($server, $channel, "op", calculate_delay($victimIdx, $channel), $modeargs[$ptr])
}
}
}
}
# increase pointer, 'o' mode has argument, *always*
$ptr++;
} elsif ($char =~ /[beIqdhvk]/ || ($char eq "l" && $mode eq "+")) {
# increase pointer, these modes have arguments as well
$ptr++;
}
}
if ($gotOpped) {
# calling check_friends with !BLARHchannel, since removing BLARH is done there
check_friends($server, $channel, undef, $channelInfo->nicks());
}
}
# void event_massjoin($channel, $nicklist)
# handles join event
sub event_massjoin {
my ($channel, $nicksList) = @_;
my @nicks = @{$nicksList};
my $server = $channel->{'server'};
my $channelName = $channel->{name};
my $options;
$options = "showjoins|" if Irssi::settings_get_bool("friends_show_flags_on_join");
my $begin = time;
check_friends($server, $channelName, $options, @nicks);
if ((my $duration = time - $begin) >= 1) {
# if checking took more than 1 second -- print a message about it
Irssi::printformat(MSGLEVEL_CRAP, 'friends_checking', $channelName, $duration, $server->{address});
}
}
# void event_nicklist_changed($channel, $nick, $oldnick)
# some kind of nick-tracking
# alters operationQueue if someone from there has changed nick
sub event_nicklist_changed {
my ($channel, $nick, $oldnick) = @_;
# nicknames are case insensitive
return if (lc($oldnick) eq lc($nick->{nick}));
# cycle through all operation queues
for (my $c = 0; $c < @operationQueue; ++$c) {
# temporary array
my @nickarr = ();
# is there any nick in this queue that needs altering?
my $found = 0;
# skip if tags don't match
next unless ($operationQueue[$c]->{server}->{tag} eq $channel->{server}->{tag});
# cycle through all nicks in single operation queue
foreach my $opnick (@{$operationQueue[$c]->{nicks}}) {
# if $oldnick was in the queue
if (lc($oldnick) eq lc($opnick)) {
# ... replace it with the new one
push(@nickarr, $nick->{nick});
$found = 1;
} else {
# ... else -- keep the old one
push(@nickarr, $opnick);
}
}
# replace $opQ[$c]->{nicks} with our new nicklist if any nick needed updating
$operationQueue[$c]->{nicks} = [ @nickarr ] if ($found);
}
}
# void event_server_disconnected($server, $anything)
# removes all queues related to $server from @operationQueue
sub event_server_disconnected {
my ($server, $anything) = @_;
my @removed = ();
# cycle through all operation queues
for (my $c = 0; $c < @operationQueue;) {
if ($operationQueue[$c]->{server}->{tag} eq $server->{tag}) {
push(@removed, splice(@operationQueue, $c, 1));
} else {
++$c;
}
}
# if operation queue is empty, remove the timer.
if (scalar(@removed) && !@operationQueue && $timerHandle) {
Irssi::timeout_remove($timerHandle);
$timerHandle = undef;
}
}
# void cmd_opfriends($data, $server, $channel)
# handles /opfriends #channel
sub cmd_opfriends {
my ($data, $server, $channel) = @_;
my ($chan) = split(/ +/, $data);
my $usage = "/OPFRIENDS [channel]";
my @chanstocheck = ();
if (!$server) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No server item in current window");
return;
}
# no argument given
if ($chan eq "") {
if (!$channel) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No usable channel item in current window");
return;
} elsif ($channel->{type} ne "CHANNEL") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "Current window item is not a channel");
return;
} else {
push(@chanstocheck, $channel->{name});
}
# all channels on current server
} elsif ($chan eq "*") {
foreach my $c ($server->channels()) {
push(@chanstocheck, $c->{name});
}
# specified channel on current server
} else {
push(@chanstocheck, $chan);
}
foreach my $channelName (@chanstocheck) {
my $chanInfo = $server->channel_find($channelName);
if (!$chanInfo) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notonchan', $channelName);
next;
}
# !channels support
my $noPrefix = $chanInfo->{name};
$noPrefix = '!' . substr($chanInfo->{name}, 6) if ($chanInfo->{name} =~ /^\!/);
my @opnicks = ();
foreach my $nick ($chanInfo->nicks()) {
# skip already opped nicks
next if ($nick->{op});
# check for friends
my $idx = get_idx($nick->{nick}, $nick->{host});
# skip not-friends
next unless ($idx > -1);
# add $nick's nick to oplist if enough flags for this channel
push(@opnicks, $nick->{nick}) if (friend_is_wrapper($idx, $noPrefix, "o", "d"));
}
# add stuff to the operation queue
add_operation($server, $noPrefix, "op", "0", @opnicks);
}
timer_handler();
}
# void cmd_queue($data, $server, $channel)
# expands to queue show|purge|flush
sub cmd_queue($$$) {
my ($data, $server, $channel) = @_;
Irssi::command_runsub("queue", $data, $server, $channel);
}
# bool queue_flush_expand(%what)
# "... and few lines of The Magic Code. Now. Your poison is ready."
sub queue_flush_expand {
my ($flush) = @_;
my $result = 0;
foreach my $s (keys(%{$flush})) {
# is this server active?
my $server = Irssi::server_find_tag($s);
next unless (defined $server);
foreach my $c (keys(%{$flush->{$s}})) {
# is this channel active?
my $channel = $server->channel_find($c);
next unless (defined $channel);
# for each pending operation
foreach my $o (sort keys(%{$flush->{$s}->{$c}})) {
my @nicklist = ();
foreach my $nickStr (sort keys(%{$flush->{$s}->{$c}->{$o}})) {
# is this nick still here?
if (my $nick = $channel->nick_find($nickStr)) {
push(@nicklist, $nick->{nick});
}
}
if (my $nickstr = join(" ", @nicklist)) {
$channel->command($o." ".$nickstr);
$result = 1;
}
}
}
}
return $result;
}
# void queue_show($data, $server, $channel)
# handles /QUEUE SHOW
# prints @operationQueue's contents
sub cmd_queue_show {
if (!@operationQueue) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_empty');
return;
}
# cycle through all operation queues
for (my $c = 0; $c < @operationQueue; ++$c) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_line1',
$c,
$operationQueue[$c]->{left},
$operationQueue[$c]->{operation}
);
Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_line2',
$operationQueue[$c]->{server}->{address},
$operationQueue[$c]->{channel},
join(", ", @{$operationQueue[$c]->{nicks}})
);
}
}
# void cmd_queue_flush($data, $server, $channel)
# handles /QUEUE FLUSH <number|all>
# flushes given/all queue(s)
sub cmd_queue_flush {
my ($data) = split(/ +/, $_[0]);
my $usage = "/QUEUE FLUSH <number|all>";
my @flushqueue = ();
my $flushdata = {};
my @removed = ();
if (!@operationQueue) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_empty');
return;
}
if ($data eq "") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
return;
}
if ($data =~ /^all/i) {
@flushqueue = @operationQueue;
@operationQueue = ();
push(@removed, $data);
} elsif ($data =~ /^[0-9,]+$/) {
my $numstr = join(" ", split(/,/, $data));
for (my $num = 0; $num < @operationQueue;) {
if ($numstr =~ /\b$num\b/) {
push(@flushqueue, splice(@operationQueue, $num, 1));
push(@removed, $num);
} else {
$num++
}
}
} else {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage);
return;
}
if (@flushqueue) {
# don't ask... ;^)
foreach my $q (@flushqueue) {
my $s = $q->{server}->{tag};
my $c = $q->{channel};
my $o = $q->{operation};
foreach my $n (@{$q->{nicks}}) {
$flushdata->{$s}->{$c}->{$o}->{$n} = 1 unless ($o eq "voice" &&
exists $flushdata->{$s}->{$c}->{op}->{$n} &&
!Irssi::settings_get_bool('friends_voice_opped'));
}
}
my $result = ((queue_flush_expand($flushdata)) ? "seems ok" : "looks like nothing done");
Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_removed', "Flushed", join(", ", @removed), $result);
}
if (!@operationQueue && $timerHandle) {
Irssi::timeout_remove($timerHandle);
$timerHandle = undef;
}
}
# void cmd_queue_purge($data, $server, $channel)
# handles /QUEUE PURGE <number|all>
# removes given/all queue(s)
sub cmd_queue_purge {
my ($data) = split(/ +/, $_[0]);
my $usage = "/QUEUE PURGE <number|all>";
my $result;
my @removed;
if (!@operationQueue) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_empty');
return;
}
if ($data eq "") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
return;
}
if ($data =~ /^all/i) {
@operationQueue = ();
$result = "OK";
push(@removed, $data);
} elsif ($data =~ /^[0-9,]+$/) {
my $numstr = join(" ", split(/,/, $data));
for (my $num = 0; $num < @operationQueue;) {
if ($numstr =~ /\b$num\b/) {
splice(@operationQueue, $num, 1);
push(@removed, $num);
$result = "OK";
} else {
$num++
}
}
} else {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage);
return;
}
Irssi::printformat(MSGLEVEL_CRAP, 'friends_queue_removed', "Purged", join(", ", @removed), $result) if (defined $result);
if (!@operationQueue && $timerHandle) {
Irssi::timeout_remove($timerHandle);
$timerHandle = undef;
}
}
# void friends_chflags($idx, $string[, $chan])
# parses the $string and calls add_flag() or del_flag()
sub friends_chflags {
my ($idx, $string, $chan) = @_;
my $mode = undef;
my $char;
$chan = "global" if ($chan eq "" || lc($chan) eq "global");
foreach my $char (split(//, $string)) {
if ($char eq "+") { $mode = "+";
} elsif ($char eq "-") { $mode = "-";
} elsif ($mode) {
if ($mode eq "+") {
# ADDING flags
# add chan record, if needed
add_chanrec($idx, $chan) if ($chan ne "global" && !friend_has_chanrec($idx, $chan));
if (!friend_has_flag($idx, $char, $chan)) {
# add this flag if he doesn't have it yet
add_flag($idx, $char, $chan);
}
} elsif ($mode eq "-") {
# REMOVING flags
if ($chan eq "global" || friend_has_chanrec($idx, $chan)) {
del_flag($idx, $char, $chan);
}
}
}
}
}
# void cmd_chflags($data, $server, $channel)
# handles /chflags <handle> <+-flags> [#channel]
sub cmd_chflags {
my ($handle, $flags, @chans) = split(/ +/, $_[0]);
my $usage = "/CHFLAGS <handle> <+/-flags> [#channel1] [#channel2] ...";
# strip %'s
$handle =~ s/\%//g;
# not enough args
if ($handle eq "" || $flags eq "") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
return;
}
# bad args
# if the 'flags' part doesn't start with + or -
if ($flags !~ /^[\+\-]/) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage);
return;
}
# get idx, yell and return if it isn't valid
my $idx = get_idxbyhand($handle);
if ($idx == -1) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
return;
}
# if #channel wasn't specified -- we'll deal with global flags
push(@chans, "global") unless (@chans);
# go through all channels specified
foreach my $chan (@chans) {
# strip %'s
$chan =~ s/\%//g;
# 'executing +foo-bar for someone (where)'
Irssi::printformat(MSGLEVEL_CRAP, 'friends_chflagexec', $flags, get_handbyidx($idx), $chan);
# make changes
friends_chflags($idx, $flags, $chan);
my $flagstr = get_friends_flags($idx, $chan);
# 'current $chan flags for someone are: +blah/[none]'
Irssi::printformat(MSGLEVEL_CRAP, 'friends_currentflags', (($flagstr) ? $flagstr : "[none]"), get_handbyidx($idx), $chan);
}
}
# void cmd_chhandle($data, $server, $channel)
# handles /chhandle <oldhandle> <newhandle>
sub cmd_chhandle {
my ($oldhandle, $newhandle) = split(/ +/, $_[0]);
my $usage = "/CHHANDLE <oldhandle> <newhandle>";
# strip %'s
$newhandle =~ s/\%//g;
# not enough args
if ($oldhandle eq "" || $newhandle eq "") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
return;
}
# get idx, yell and return if it's not valid
my $idx = get_idxbyhand($oldhandle);
if ($idx == -1) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $oldhandle);
return;
}
# proper case for later printformat
$oldhandle = get_handbyidx($idx);
# handle cannot start with a digit
if ($newhandle =~ /^[0-9]/) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_badhandle', $newhandle,
"Handle may not start with a digit");
return;
}
if (lc($newhandle) eq lc($oldhandle)) {
# funny case, only changes case of letters, omit the whole change_handle()
$friends[$idx]->{handle} = $newhandle;
} else {
# check if $newhandle is unique
# if not, print appropriate message and return
if (!is_unique_handle($newhandle)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notuniqhandle', $newhandle);
return;
}
# ok, everything seems fine now, let's change the handle.
change_handle($oldhandle, $newhandle);
}
# ... and print a message
Irssi::printformat(MSGLEVEL_CRAP, 'friends_changed_handle', $oldhandle, $newhandle);
}
# void change_handle($oldhandle, $newhandle)
# changes handle in appropriate structures
sub change_handle($$) {
my ($old, $new) = @_;
my $idx = get_idxbyhand($old);
my $lc_new = lc($new);
foreach my $host (get_friends_hosts($idx, $friends_PLAIN_HOSTS)) {
my ($l) = $host =~ /\@(.)/;
my $regexp_host = userhost_to_regexp($host);
$all_regexp_hosts->{allhosts}->{$regexp_host} = $lc_new;
$all_regexp_hosts->{lc($l)}->{$regexp_host} = $lc_new;
$all_hosts->{$host} = $lc_new;
delete $all_handles->{lc($old)};
$all_handles->{$lc_new} = $idx;
$friends[$idx]->{handle} = $new;
}
}
# void cmd_chpass($data, $server, $channel)
# handles /chpass <handle> [pass]
# if pass is empty, removes password
# otherwise, crypts it and sets as current one
sub cmd_chpass {
my ($handle, $pass) = split(/ +/, $_[0]);
my $usage = "/CHPASS <handle> [newpassword]";
# not enough args
if ($handle eq "") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
return;
}
# get idx, yell and return if it's not valid
my $idx = get_idxbyhand($handle);
if ($idx == -1) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
return;
}
# crypt and set password. then print a message
$friends[$idx]->{password} = friends_crypt("$pass");
Irssi::printformat(MSGLEVEL_CRAP, 'friends_chpassexec', get_handbyidx($idx));
}
# void cmd_chdelay($data, $server, $channel)
# handles /chdelay <handle> <delay> <#channel>
# use delay=0 to get instant opping
# use delay>0 to get fixed opping delay
# use delay='random' or delay='none' or delay = 'remove'
# to remove fixed delay (make it random)
sub cmd_chdelay {
my ($handle, $delay, $chan) = split(/ +/, $_[0]);
my $usage = "/CHDELAY <handle> <delay> <#channel>";
my $value = undef;
# strip %'s
$chan =~ s/\%//g;
# not enough args
if ($handle eq "" || $delay eq "" || $chan eq "") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
return;
}
# if $chan doesn't start with one of the [!&#+]
if ($chan !~ /^[\!\&\#\+]/) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage);
return;
}
# check validness of $delay
if ($delay =~ /^[0-9]+$/) {
# numeric value
$value = $delay;
} elsif ($delay =~ /^(remove|random|none)$/i) {
# 'remove', 'random' or 'none'
$value = undef;
} else {
# badargs, return
Irssi::printformat(MSGLEVEL_CRAP, 'friends_badargs', $usage);
return;
}
# get idx, yell and return if it's not valid
my $idx = get_idxbyhand($handle);
if ($idx == -1) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
return;
}
# check if $idx has got $chan record.
# add one if needed
add_chanrec($idx, $chan) unless (friend_has_chanrec($idx, $chan));
# finally, set it, and print a message
change_delay($idx, $value, $chan);
Irssi::printformat(MSGLEVEL_CRAP, 'friends_changed_delay', get_handbyidx($idx),
$chan, (defined($value) ? $value : "[random]"));
}
# void cmd_comment($data, $server, $channel)
# handles /comment <handle> [comment]
# if comment is empty, removes it
# otherwise, sets it as the current one
sub cmd_comment {
my ($handle, $comment) = split(" ", $_[0], 2);
my $usage = "/COMMENT <handle> [comment]";
# not enough args
if ($handle eq "") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
return;
}
# get idx, yell and return if it's not valid
my $idx = get_idxbyhand($handle);
if ($idx == -1) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
return;
}
# remove %'s and trailing spaces (just-in-case ;)
$comment =~ s/\%//g;
$comment =~ s/[\ ]+$//;
# finally, set it, and print a message
$friends[$idx]->{comment} = $comment;
if ($comment ne '') {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_comment_added', get_handbyidx($idx), $comment);
} else {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_comment_removed', get_handbyidx($idx));
}
}
# void cmd_listfriend($data, $server, $chanel)
# handles /listfriends [what]
# 'what' can be either handle, channel name, 1,2,5,15-style, host mask or empty.
sub cmd_listfriends {
if (@friends == 0) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_empty');
} else {
my ($data) = @_;
my $counter = 0;
# remove whitespaces
$data =~ s/[\t\ ]+//g;
my $win = Irssi::active_win();
if ($data =~ /^[\!\&\#\+]/) {
# deal with channel
Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', "channel " . $data);
for (my $idx = 0; $idx < @friends; ++$idx) {
if (friend_has_chanrec($idx, $data)) {
list_friend($win, $idx, undef);
$counter++;
}
}
} elsif ($data =~ /^[0-9,]+$/) {
# deal with 1,2,5,15 style
Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', $data);
foreach my $idx (split(/,/, $data)) {
if ($idx < @friends) {
list_friend($win, $idx, undef);
$counter++;
}
}
} elsif ($data =~ /^.*\!.*\@.*$/) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', "matching " . $data);
# /* FIXME */
my $regexp_data = userhost_to_regexp($data);
for (my $idx = 0; $idx < @friends; ++$idx) {
foreach my $regexp_host (get_friends_hosts($idx, $friends_REGEXP_HOSTS)) {
if ($data =~ /^$regexp_host$/ || $friends[$idx]->{regexp_hosts}->{$regexp_host} =~ /^$regexp_data$/) {
list_friend($win, $idx, undef);
$counter++;
last;
}
}
}
} elsif ($data ne "") {
if ((my $idx = get_idxbyhand($data)) > -1) {
# deal with handle
Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', $data);
list_friend($win, $idx, undef);
$counter++;
} else {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $data);
}
} else {
# deal with every entry
Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist', "all");
for (my $idx = 0; $idx < @friends; ++$idx) {
list_friend($win, $idx, undef);
$counter++;
}
}
if ($counter) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_friendlist_count', $counter, (($counter > 1) ? "s" : ""));
}
}
}
# void cmd_addfriend($data, $server, $channel)
# handles /addfriend <handle> <hostmask> [flags]
# if 'flags' is empty, uses friends_default_flags instead
sub cmd_addfriend {
my ($handle, $host, $flags) = split(/ +/, $_[0]);
my $server = $_[1];
my $usage = "/ADDFRIEND <handle|nick> [<hostmask> [flags]]";
# strip %'s
$handle =~ s/\%//g;
$host =~ s/\%//g;
# not enough args
if ($handle eq "") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
return;
}
# handle cannot start with a digit
if ($handle =~ /^[0-9]/) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_badhandle', $handle, "Handle may not start with a digit");
return;
}
# assume we want /addfriend somenick
if ($host eq "") {
# no server item in current window
if (!$server) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No server item in current window");
return;
}
# redirect userhost reply to event_isfriend_userhost()
# caution: This works only with Irssi 0.7.98.CVS (20011117) and newer
$server->redirect_event("userhost", 1, $handle, 0, undef, {
"event 302" => "redir userhost_addfriend"});
# send our query
$server->send_raw("USERHOST :$handle");
return;
}
# check must be unique
if (!is_unique_handle($handle)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notuniqhandle', $handle);
return;
}
# add friend.
push(@friends, new_friend($handle, $host, undef, undef, undef, undef));
Irssi::printformat(MSGLEVEL_CRAP, 'friends_added', $handle);
# check 'flags' parameter, add default flags if empty.
$flags = Irssi::settings_get_str('friends_default_flags') unless ($flags);
# add flags and print them if needed
if ($flags) {
# check if $flags start with a '+'. if not, prepend one.
$flags = "+".$flags unless ($flags =~ /^\+/);
# our new friend should have $idx=(scalar(@friends)-1) now, so we'll use it.
my $idx = scalar(@friends) - 1;
friends_chflags($idx, $flags, "global");
$flags = get_friends_flags($idx, undef);
Irssi::printformat(MSGLEVEL_CRAP, 'friends_currentflags', $flags, $handle, "global") if ($flags);
}
}
# void event_addfriend_userhost($server, $reply, $servername)
# handles redirected USERHOST replies
# (part of /addfriend)
sub event_addfriend_userhost {
my ($mynick, $reply) = split(/ +/, $_[1]);
my $server = $_[0];
my ($nick, $user, $host) = $reply =~ /^:?([^\*=]*)\*?=.(.*)@(.*)/;
my $string = $nick . '!' . $user . '@' . $host;
my $friend_matched = 0;
# try matching ONLY if the response is positive
if (defined $nick && defined $user && defined $host) {
if ((my $idx = get_idx($nick, $user.'@'.$host)) > -1) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_already_added', $nick, get_handbyidx($idx));
return;
}
# handle
my $handle = choose_handle($nick);
# *~^=-ident
$user =~ s/^[\~\+\-\^\=]+/\*/;
# add friend.
push(@friends, new_friend($handle, '*!'.$user.'@'.$host, undef, undef, undef, undef));
Irssi::printformat(MSGLEVEL_CRAP, 'friends_added', $handle);
return;
}
# failed
Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No such nick");
}
# void cmd_delfriend($data, $server, $channel)
# handles /delfriend <handle|number>
# supports /delfriend 2-5,foohand,1,4,10,11-22
sub cmd_delfriend {
my ($who) = split(/ +/, $_[0]);
my $usage = "/DELFRIEND <handle|number>";
# strip %'s
$who =~ s/\%//g;
# not enough args
if ($who eq "") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
return;
}
my @todelete = ();
foreach my $what (split(/[\ ,]/, $who)) {
if ($what =~ /^[0-9]+$/) {
# /delfriend 15
next unless ($what > -1 && $what < scalar(@friends));
push(@todelete, $what) unless (grep(/^$what$/, @todelete));
} elsif ($what =~ /^([0-9]+)\-([0-9]+)$/) {
# /delfriend 2-10
my ($start, $end) = $what =~ /([0-9]+)\-([0-9]+)/;
next if ($start > $end);
for my $i ($start .. $end) {
next unless ($i > -1 && $i < scalar(@friends));
push(@todelete, $i) unless (grep(/^$i$/, @todelete));
}
} else {
# /delfriend foobar
my $delidx = get_idxbyhand($what);
push(@todelete, $delidx) unless ($delidx < 0 || grep(/^$delidx$/, @todelete));
}
}
@todelete = sort {$a <=> $b} @todelete;
return unless (@todelete);
my @result = del_friend(join(" ", @todelete));
foreach my $deleted (@result) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_removed', $deleted->{handle});
}
}
# void cmd_addhost($data, $server, $channel)
# handles /addhost <handle> <hostmask1> [hostmask2] ...
# hostmask may not overlap with any of the current ones
sub cmd_addhost {
my ($handle, @hosts) = split(/ +/, $_[0]);
my $usage = "/ADDHOST <handle> <hostmask1> [hostmask2] [hostmask3] ...";
# not enough args
if ($handle eq "" || !@hosts) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
return;
}
# get idx, yell and return if it's not valid
my $idx = get_idxbyhand($handle);
if ($idx == -1) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
return;
}
for (my $i = 0; $i < scalar(@hosts); $i++) {
my $data = $hosts[$i];
$data =~ s/\%//g;
my $regexp_data = userhost_to_regexp($data);
my $found = 0;
my $who = "";
# /* FIXME */
foreach my $plain_host (keys %{$all_hosts}) {
if (!$found && $plain_host =~ /^$regexp_data$/) {
$found = 1;
$who = get_handbyidx(get_idxbyhand($all_hosts->{$plain_host}));
last;
}
}
# /* FIXME again */
foreach my $regexp_host (get_friends_hosts($idx, $friends_REGEXP_HOSTS)) {
last if ($found);
if ($data =~ /^$regexp_host$/ || $friends[$idx]->{regexp_hosts}->{$regexp_host} =~ /^$regexp_data$/) {
$found = 1;
$who = get_handbyidx($idx);
last;
}
}
if (!$found) {
add_host($idx, $data);
Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_added', get_handbyidx($idx), $data);
} else {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_exists', $who, $data);
}
}
}
# void cmd_delhost($data, $server, $channel)
# handles /delhost <handle> <hostmask>
# hostmask should be EXACTLY the same as one in $friends[$idx]->{hosts}
sub cmd_delhost {
my ($handle, $host) = split(/ +/, $_[0]);
my $usage = "/DELHOST <handle> <hostmask>";
# strip %'s
$host =~ s/\%//g;
# not enough args
if ($handle eq "" || $host eq "") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
return;
}
# get idx, yell and return if it's not valid
my $idx = get_idxbyhand($handle);
if ($idx == -1) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
return;
}
# delete host, print appropriate message
if (del_host($idx, $host)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_removed', get_handbyidx($idx), $host);
} else {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_notexists', get_handbyidx($idx), $host);
}
}
# void cmd_delchanrec($data, $server, $channel)
# handles /delchanrec <handle> <#channel>
sub cmd_delchanrec {
my ($handle, $chan) = split(/ +/, $_[0]);
my $usage = "/DELCHANREC <handle> <#channel>";
# strip %'s
$chan =~ s/\%//g;
# not enough args
if ($handle eq "" || $chan eq "") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
return;
}
# get idx, yell and return if it's not valid
my $idx = get_idxbyhand($handle);
if ($idx == -1) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $handle);
return;
}
# delete chanrec, print appropriate message
if (del_chanrec($idx, $chan)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_chanrec_removed', get_handbyidx($idx), $chan);
} else {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_chanrec_notexists', get_handbyidx($idx), $chan);
}
}
# void cmd_findfriends($data, $server, $channel)
# handles /findfriends [handle]
# prints online friends
sub cmd_findfriends {
my ($data) = split(/ +/, $_[0]);
my $f2w = Irssi::settings_get_str('friends_findfriends_to_windows');
my $win = undef;
my $lc_data = lc($data);
$win = Irssi::active_win() unless ($f2w || $data eq '');
# gathering info
my $by_hand = {};
foreach my $channel (Irssi::channels()) {
my $myNick = $channel->{server}->{nick};
my $tag = lc($channel->{server}->{tag});
foreach my $nick ($channel->nicks()) {
# don't count myself
next if ($nick->{nick} eq $myNick);
if ((my $idx = get_idx($nick->{nick}, $nick->{host})) > -1) {
$by_hand->{lc($friends[$idx]->{handle})}->{$tag}->{$channel->{name}} = $nick->{nick};
}
}
}
# looking for a specified handle
if ($data ne '') {
my $handle = undef;
foreach my $h (keys %{$by_hand}) {
next if ($lc_data ne $h);
$handle = $h;
last;
}
return unless (defined $handle);
# tricky part.
my @data = ();
foreach my $ircnet (keys %{$by_hand->{$handle}}) {
my ($nick, $chan);
foreach $chan (keys %{$by_hand->{$handle}->{$ircnet}}) {
$nick = $by_hand->{$handle}->{$ircnet}->{$chan};
last;
}
my $chanstr = join(",", sort keys %{$by_hand->{$handle}->{$ircnet}});
push(@data, join(" ", $ircnet, $nick, $chanstr));
}
# list them.
list_friend(Irssi::active_win(), $handle, @data);
# looking for anyone
} else {
foreach my $handle (keys %{$by_hand}) {
foreach my $ircnet (keys %{$by_hand->{$handle}}) {
my $server = Irssi::server_find_tag($ircnet);
next unless (defined $server);
foreach my $chan (sort keys %{$by_hand->{$handle}->{$ircnet}}) {
my @data = ();
my $nick = $by_hand->{$handle}->{$ircnet}->{$chan};
$win = $server->window_item_find($chan);
$win = Irssi::active_win() unless (defined $win && $f2w);
my $chanstr = join(",", sort keys %{$by_hand->{$handle}->{$ircnet}});
push(@data, join(" ", $ircnet, $nick, $chanstr));
list_friend($win, $handle, @data);
}
}
}
}
}
# void cmd_isfriend($data, $server, $channel)
# handles /isfriend <nick>
sub cmd_isfriend {
my ($data, $server, $channel) = @_;
my $usage = "/ISFRIEND <nick>";
# remove trailing spaces
$data =~ s/[\t\ ]+$//;
# not enough args
if ($data eq "") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_notenoughargs', $usage);
return;
}
# no server item in current window
if (!$server) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "No server item in current window");
return;
}
# redirect userhost reply to event_isfriend_userhost()
# caution: This works only with Irssi 0.7.98.CVS (20011117) and newer
$server->redirect_event("userhost", 1, $data, 0, undef, {
"event 302" => "redir userhost_friends"});
# send our query
$server->send_raw("USERHOST :$data");
}
# void event_isfriend_userhost($server, $reply, $servername)
# handles redirected USERHOST replies
# (part of /isfriend)
sub event_isfriend_userhost {
my ($mynick, $reply) = split(/ +/, $_[1]);
my $server = $_[0];
my ($nick, $user, $host) = $reply =~ /^:?([^\*=]*)\*?=.(.*)@(.*)/;
my $string = $nick . '!' . $user . '@' . $host;
my $friend_matched = 0;
# try matching ONLY if the response is positive
if (defined $nick && defined $user && defined $host) {
if ((my $idx = get_idx($nick, $user.'@'.$host)) > -1) {
my @chans = ();
foreach my $channel ($server->channels()) {
push(@chans, $channel->{name}) if ($channel->nick_find($nick));
}
my $chanstr = join(",", @chans);
list_friend(Irssi::active_win(), $idx, join(" ", $server->{tag}, $nick, $chanstr));
$friend_matched++;
}
}
# print message
if ($friend_matched) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_endof', "/isfriend", $nick);
} else {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_nosuch', $nick);
}
}
# void event_whois($server, $text, $servername)
# handles additional whois data
sub event_whois {
my ($server, $text, $servername) = @_;
return unless (Irssi::settings_get_bool('friends_show_whois_extra'));
my ($on, $nick, $user, $host, $as, $rn) = split(/[\ ]:?/, $text, 6);
my $idx = get_idx($nick, $user.'@'.$host);
return unless ($idx > -1);
$server->printformat($nick, MSGLEVEL_CRAP, 'friends_whois', get_handbyidx($idx), ($friends[$idx]->{globflags} ? $friends[$idx]->{globflags} : "none"));
}
# void cmd_flushlearnt($data, $server, $channel)
# cycles through all users and removes every chanrec with flag L
# then, if no other stuff left (specific delay, other chanrecs,
# global flags, password maybe) -- deletes user.
# clears the opping tree too
sub cmd_flushlearnt {
my @todelete = ();
# cycle through the whole friendlist
for (my $idx = 0; $idx < @friends; ++$idx) {
my $was_learnt = 0;
# foreach friend, clear his opping tree
$friends[$idx]->{friends} = [];
# now go through all friend's channel entries
foreach my $chan (get_friends_channels($idx)) {
# if 'L' is the only flag for this chan
if (get_friends_flags($idx, $chan) eq "L") {
# remove channel record and print a message
$was_learnt = del_chanrec($idx, $chan);
Irssi::printformat(MSGLEVEL_CRAP, 'friends_chanrec_removed', get_handbyidx($idx), $chan);
}
}
# delete friend, if he has exactly 1 host, no global flags,
# neither password, nor chanrecs, and he was learnt.
if ($was_learnt && scalar(get_friends_hosts($idx, $friends_REGEXP_HOSTS)) == 1 && !get_friends_flags($idx, undef) &&
!get_friends_channels($idx) && !$friends[$idx]->{password}) {
push(@todelete, $idx) unless (grep(/^$idx$/, @todelete));
}
}
return unless @todelete;
@todelete = sort {$a <=> $b} @todelete;
my @result = del_friend(join(" ", @todelete));
foreach my $deleted (@result) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_removed', $deleted->{handle});
}
}
# void cmd_opping_tree($data, $server, $channel)
# prints the Opping Tree
sub cmd_oppingtree {
my $found = 0;
# cycle through the whole friendlist
for (my $idx = 0; $idx < @friends; ++$idx) {
# get friend's friends
my @friendFriends = @{$friends[$idx]->{friends}};
if (@friendFriends) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "Opping tree:") unless ($found);
$found = 1;
# print info about our friend
Irssi::printformat(MSGLEVEL_CRAP, 'friends_optree_line1', get_handbyidx($idx));
my %masks;
# get all masks opped by him
foreach my $friend (@friendFriends) {
foreach my $host (keys(%{$friend->{hosts}})) {
$masks{$host}++;
last;
}
}
# print them, along with the opcount
foreach my $friend (sort keys %masks) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_optree_line2', $masks{$friend}, $friend);
}
}
}
Irssi::printformat(MSGLEVEL_CRAP, 'friends_general', "Opping tree is empty.") unless ($found);
}
# void event_ctcpmsg($server, $args, $sender, $senderhsot, $target)
# handles ctcp requests
sub event_ctcpmsg {
my ($server, $args, $sender, $userhost, $target) = @_;
# return, if ctcp is not for us
my $myNick = $server->{nick};
return if (lc($target) ne lc($myNick));
# return, if we don't process ctcp requests
return unless (Irssi::settings_get_bool('friends_use_ctcp'));
# return in case of strange things
return unless (defined $sender && defined $userhost);
my @cmdargs = split(/ +/, $args);
# prepare arguments:
# get 1st arg, uppercase it
my $command = uc($cmdargs[0]);
# get 2nd arg
my $channelName = $cmdargs[1];
# get 3rd arg
my $password = $cmdargs[2];
# check if $command is one of friends_ctcp_commands. return if it isn't
return unless (is_ctcp_command($command));
# this is supposed to be processed BEFORE any other ctcp commands
# /ctcp nick IDENT handle password
if ($command eq "IDENT") {
my $idxguess = get_idxbyhand($channelName);
# looks like a valid friend, password already set, provided password looks fine
if ($idxguess > -1 && $friends[$idxguess]->{password} ne "" && friends_passwdok($idxguess, $password)) {
# do the IDENT stuff here.
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpident', $channelName, $sender.'!'.$userhost);
add_host($idxguess, "*!$userhost");
Irssi::printformat(MSGLEVEL_CRAP, 'friends_host_added', $channelName, '*!'.$userhost);
$server->command("/^NOTICE $sender Identified as " . get_handbyidx($idxguess));
} else {
my $reason = "No reason ;)";
if ($idxguess < 0) {
$reason = "No such handle: $channelName";
} elsif ($friends[$idxguess]->{password} eq "") {
$reason = "Can't IDENT $channelName without password set";
} elsif (!friends_passwdok($idxguess, $password)) {
$reason = "Bad password for $channelName";
}
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $sender.'!'.$userhost, $reason);
}
goto SIGSTOP;
}
my $idx = get_idx($sender, $userhost);
# if get_idx* failed, return.
if ($idx == -1) {
my $reason = "Not a friend" . (($command ne "PASS") ? " for $channelName" : "");
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $sender.'!'.$userhost, $reason);
goto SIGSTOP;
}
# we'll use handle instead of $sender!$userhost in messages
my $handle = get_handbyidx($idx);
# check if $channelName was supplied.
# (first argument, should be always given)
if ($channelName eq "") {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough arguments");
goto SIGSTOP;
}
# /ctcp nick PASS pass [newpass]
if ($command eq "PASS") {
# if someone has password already set - we can only *change* it
if ($friends[$idx]->{password}) {
# if cmdargs[1] ($channelName, that is) is a valid password (current)
if (!friends_passwdok($idx, $channelName)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
goto SIGSTOP;
}
# and $cmdargs[2] ($password, that is) contains something ...
if (defined $password) {
# ... process allowed password change.
# in this case, old password is in $channelName
# and new password is in $password
$friends[$idx]->{password} = friends_crypt("$password");
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcppass', $handle, $sender."!".$userhost);
# send a quiet notice to sender
$server->command("/^NOTICE $sender Password changed to: $password");
} else {
# in this case, notify sender about his current password quietly
$server->command("/^NOTICE $sender You already have a password set");
}
# if $idx doesn't have a password, we will *set* it
} else {
# in this case, new password is in $channelName
# and $password is unused
$friends[$idx]->{password} = friends_crypt("$channelName");
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcppass', $handle, $sender.'!'.$userhost);
# send a quiet notice to sender
$server->command("/^NOTICE $sender Password set to: $channelName");
}
goto SIGSTOP;
}
# get channel object. if not found -- yell, stop the signal, and return
my $channel = $server->channel_find($channelName);
if (!$channel) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not on channel $channelName");
goto SIGSTOP;
}
my $sender_rec = $channel->nick_find($sender);
# /ctcp nick OP #channel password
if ($command eq "OP") {
if (!friend_is_wrapper($idx, $channelName, "o", "d")) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags");
goto SIGSTOP;
}
if (!friends_passwdok($idx, $password)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
goto SIGSTOP;
}
# process allowed opping
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName);
$channel->command("op $sender") if ($sender_rec && !$sender_rec->{op});
goto SIGSTOP;
# /ctcp nick VOICE #channel password
} elsif ($command eq "VOICE") {
if (!friend_is_wrapper($idx, $channelName, "v", undef)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags");
goto SIGSTOP;
}
if (!friends_passwdok($idx, $password)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
goto SIGSTOP;
}
# process allowed voicing
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName);
$channel->command("voice $sender") if ($sender_rec && !$sender_rec->{voice});
goto SIGSTOP;
# /ctcp nick INVITE #channel password
} elsif ($command eq "INVITE") {
if (!friend_is_wrapper($idx, $channelName, "i", undef)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags");
goto SIGSTOP;
}
if (!friends_passwdok($idx, $password)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
goto SIGSTOP;
}
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName);
if (!$channel->{chanop} && !$sender_rec) {
# friend is outside channel, but we're not opped
$server->command("/^NOTICE $sender I'm not opped on $channelName");
} elsif (!$sender_rec) {
# process allowed invite
$channel->command("invite $sender");
}
goto SIGSTOP;
# /ctcp nick KEY #channel password
} elsif ($command eq "KEY") {
if (!friend_is_wrapper($idx, $channelName, "k", undef)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags");
goto SIGSTOP;
}
if (!friends_passwdok($idx, $password)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
goto SIGSTOP;
}
# process allowed key giving
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName);
if ($channel->{key} && !$sender_rec) {
# give a key if channel is +k'ed and $sender is not on $channelName
$server->command("/^NOTICE $sender Key for $channelName is: $channel->{key}");
}
goto SIGSTOP;
# /ctcp nick UNBAN #channel password
} elsif ($command eq "UNBAN") {
if (!friend_is_wrapper($idx, $channelName, "u", undef)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags");
goto SIGSTOP;
}
if (!friends_passwdok($idx, $password)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
goto SIGSTOP;
}
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName);
if (!$channel->{chanop}) {
# notify him that we're not opped, unless he's here and he can see that ;^)
$server->command("/^NOTICE $sender I'm not opped on $channelName") if (!$sender_rec);
} else {
# process allowed unban
foreach my $ban ($channel->bans()) {
if ($server->mask_match_address($ban->{ban}, $sender, $userhost)) {
$server->command("MODE $channelName -b $ban->{ban}");
}
}
}
goto SIGSTOP;
# /ctcp nick LIMIT #channel password
} elsif ($command eq "LIMIT") {
if (!friend_is_wrapper($idx, $channelName, "l", undef)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Not enough flags");
goto SIGSTOP;
}
if (!friends_passwdok($idx, $password)) {
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcpfail', $command, $handle, "Bad password");
goto SIGSTOP;
}
# process allowed limit raising
Irssi::printformat(MSGLEVEL_CRAP, 'friends_ctcprequest', $handle, $command, $channelName);
if (!$channel->{chanop}) {
# notify him that we're not opped, unless he's here and he can see that ;^)
$server->command("/^NOTICE $sender I'm not opped on $channelName") if (!$sender_rec);
} else {
my @nicks = $channel->nicks();
if ($channel->{limit} && $channel->{limit} <= scalar(@nicks)) {
# raise the limit if it's needed
$server->command("MODE $channelName +l " . (scalar(@nicks) + 1));
}
}
goto SIGSTOP;
}
# stop the signal if we processed the request
SIGSTOP:
Irssi::signal_stop();
}
# void cmd_friendsversion($data, $server, $channel)
# handles /friendsversion
# prints script's and friendlist's version
sub cmd_friendsversion() {
print_version("script");
print_version("filever");
print_version("filewritten");
}
# settings
Irssi::settings_add_int('misc', 'friends_delay_min', $default_delay_min);
Irssi::settings_add_int('misc', 'friends_delay_max', $default_delay_max);
Irssi::settings_add_int('misc', 'friends_max_queue_size', $default_friends_max_queue_size);
Irssi::settings_add_int('misc', 'friends_revenge_mode', $default_friends_revenge_mode);
Irssi::settings_add_bool('misc', 'friends_revenge', $default_friends_revenge);
Irssi::settings_add_bool('misc', 'friends_learn', $default_friends_learn);
Irssi::settings_add_bool('misc', 'friends_voice_opped', $default_friends_voice_opped);
Irssi::settings_add_bool('misc', 'friends_use_ctcp', $default_friends_use_ctcp);
Irssi::settings_add_bool('misc', 'friends_autosave', $default_friends_autosave);
Irssi::settings_add_bool('misc', 'friends_backup_friendlist', $default_friends_backup_friendlist);
Irssi::settings_add_bool('misc', 'friends_show_flags_on_join', $default_friends_show_flags_on_join);
Irssi::settings_add_bool('misc', 'friends_findfriends_to_windows', $default_friends_findfriends_to_windows);
Irssi::settings_add_bool('misc', 'friends_show_whois_extra', $default_friends_show_whois_extra);
Irssi::settings_add_str('misc', 'friends_ctcp_commands', $default_friends_ctcp_commands);
Irssi::settings_add_str('misc', 'friends_default_flags', $default_friends_default_flags);
Irssi::settings_add_str('misc', 'friends_file', $default_friends_file);
Irssi::settings_add_str('misc', 'friends_backup_suffix', $default_friends_backup_suffix);
# commands
Irssi::command_bind('addfriend', 'cmd_addfriend');
Irssi::command_bind('delfriend', 'cmd_delfriend');
Irssi::command_bind('addhost', 'cmd_addhost');
Irssi::command_bind('delhost', 'cmd_delhost');
Irssi::command_bind('delchanrec', 'cmd_delchanrec');
Irssi::command_bind('chhandle', 'cmd_chhandle');
Irssi::command_bind('chdelay', 'cmd_chdelay');
Irssi::command_bind('loadfriends', 'cmd_loadfriends');
Irssi::command_bind('savefriends', 'cmd_savefriends');
Irssi::command_bind('listfriends', 'cmd_listfriends');
Irssi::command_bind('findfriends', 'cmd_findfriends');
Irssi::command_bind('isfriend', 'cmd_isfriend');
Irssi::command_bind('chflags', 'cmd_chflags');
Irssi::command_bind('chpass', 'cmd_chpass');
Irssi::command_bind('comment', 'cmd_comment');
Irssi::command_bind('oppingtree', 'cmd_oppingtree');
Irssi::command_bind('opfriends', 'cmd_opfriends');
Irssi::command_bind('queue', 'cmd_queue');
Irssi::command_bind('queue show', 'cmd_queue_show');
Irssi::command_bind('queue flush', 'cmd_queue_flush');
Irssi::command_bind('queue purge', 'cmd_queue_purge');
Irssi::command_bind('flushlearnt', 'cmd_flushlearnt');
Irssi::command_bind('friendsversion', 'cmd_friendsversion');
# events
Irssi::signal_add_last('massjoin', 'event_massjoin');
Irssi::signal_add_last('event mode', 'event_modechange');
Irssi::signal_add_last('event 311', 'event_whois');
Irssi::signal_add('default ctcp msg', 'event_ctcpmsg');
Irssi::signal_add('redir userhost_friends', 'event_isfriend_userhost');
Irssi::signal_add('redir userhost_addfriend', 'event_addfriend_userhost');
Irssi::signal_add('setup saved', 'event_setup_saved');
Irssi::signal_add('setup reread', 'event_setup_reread');
Irssi::signal_add('nicklist changed', 'event_nicklist_changed');
Irssi::signal_add('server disconnected', 'event_server_disconnected');
Irssi::signal_add('server connect failed', 'event_server_disconnected');
Irssi::signal_add_first('event kick', 'event_kick');
print_releasenote() if (defined($release_note));
load_friends();