weechat-opal/scripts/kloeri.pl
2018-03-22 15:55:21 +00:00

1367 lines
41 KiB
Perl

# Released into the Public Domain
use strict;
use warnings;
use DBI;
use feature 'switch';
no strict 'subs'; # `perl -c` bitches about weechat::WEECHAT_RC_OK
no warnings 'experimental::smartmatch';
my $SCRIPT_NAME = 'kloeri';
my $SCRIPT_AUTHOR = 'The Krusty Krab <wowaname@volatile.ch>';
my $SCRIPT_VERSION = '1.0';
my $SCRIPT_LICENCE = 'Public domain';
my $SCRIPT_DESC = "HERE'S YOUR BADGE KID, GO BE AN ASSHOLE.";
my %OPTIONS = (
debug => ['Enable debugging output. Can be VERY verbose', '0'],
timeout => ['Time to wait for IRCd responses (e.g. VERSION or WHOIS '.
'queries) before giving up, in seconds', '60'],
banmask => ['Default ban mask flags (any of n{uUi}{hHp}, see '.
'/help kloeri)', 'uh'],
opmask => ['Default automode mask flags (any of n{uUi}{hHp}, see '.
'/help kloeri)', 'uH'],
killmask => ['Default akill/tkline mask flags (any of n{uUi}{hHpr}, see '.
'/help kloeri)', 'p'],
cidr4 => ['Default CIDR value for IPv4 bans', '32'],
cidr6 => ['Default CIDR value for IPv6 bans', '64'],
kickonban => ['Whether to kick users who match bans (override '.
'per-channel with /kloeri set)', '0'],
banafter => ['Whether to ban after kick', '0'],
deop => ['Whether to deop before kick', '0'],
services => ['Use services if detected (0 - never, 1 - fallback if not '.
'opped, 2 - always', '0'],
threshold => ['Threshold for wide-matching kick/kill masks; to override '.
'use * flag in commands. 0 - no threshold', '1'],
knockout => ['Default time for knockout bans, in minutes', '5'],
tkline => ['Default time for akills/tklines, in minutes', '10080'],
limit => ['Limit joins to users:seconds (override per-channel with '.
'/kloeri set). Will use +j or +f on supported networks, otherwise '.
'resorts to +l and +i. Omit :seconds and +j/f/i will not be used.',
'10:60'],
limit_delta => ['On servers without a +j style mode, set +l when there '.
'are this many more/fewer users in channel. Recommended to set half '.
'of the "users" value in the limit option', '5'],
limit_on => ['Whether autolimit is enabled for all channels by default',
'0'],
);
my %COMMANDS = (
AKILL => [\&cmd_akill, '[-(switches)(length)(banmask)(cidr)] <mask> [reason]',
qr&^(-[^ /]*|)(/?[0-9]{0,3}:?[0-9]{0,3}) *([^ ]+) *(.*)&, q&
autokill users. consider enabling appropriate snomasks on your server in order
to catch users before they enter a channel
switches may be any of 'd*':
d - dry run. print matching nicks and placed bans first
* - override sanity checks. kick matching users regardless of
threshold config
additional banmask options (see KICKBAN for the rest):
r - match gecos / realname (this has to be used by itself)
&],
ALIAS => [\&cmd_alias, '[-(switches)]', qr&^(-[^ ]*|)&, q&
set aliases for all available commands in this script. PLEASE NOTE this will
override builtin commands as well as aliases you already have mapped using the
same names. consider backing up config files or renaming aliases if need be.
you may always manually add, remove, and rename any aliases you'd like
switches:
d - dry run. print new aliases as well as whether they will override or
replace old commands
l - long aliases only (AUTOOP, KICKBAN, ...)
s - short aliases only (AOP, KB, ...)
&],
AUTOOP => [\&cmd_autoop, '[-(switches)(mask)] [mode string]',
qr&^(-[^ ]*|) *(.*)$&, q&
add or remove people from the channel's automode list. for example,
"/aop +ov-o friend chatter luser" will add "friend" to op and "chatter" to
voice, and remove "luser" from auto-op. you may also manually specify the op
mask such as "/aop +v *@trusted.example.org". to remove all listings for a
mask, specify -* as the mode, such as "/aop -* luser"
if mode string isn't given, lists current autoop list
switches:
a - apply ops to matching people immediately
* - override sanity checks (only useful with -a). op matching users
regardless of threshold config
mask may be any of 'n{uUi}{hHp}' or 'v'. by default it is -uH. see KICKBAN
help for details on mask format
&],
DEBUG => [\&cmd_debug, '<command>', qr&([^ ]*)&, q&
various debugging crap. see the source for available crap, as this crap may
change at any time and you should already have read the source if you're in
need of the crap
&],
DNS => [\&cmd_dns, '<mask>', qr&([^ ]+)&, q&
perform dns lookups on users matching mask. also performs resolution on
webchat users whose IP addresses are encoded in the ident field
&],
DOWN => [\&cmd_down, '[mask]', qr&(.*)&, q&
deop/devoice users, masks separated by space or comma
&],
HELP => [\&cmd_help, '[command]', qr&([^ ]*)&, q&
show script help, or show extended command help
&],
KEY => [\&cmd_key, '', qr&&, q&
add random key to channel
&],
KICK => [\&cmd_kick, '[-(switches)] <mask> [reason]',
qr&^(-[^ ]*|) *([^ ]+) *(.*)&, q&
kick users
switches may be any of 'd*':
d - dry run. print matching nicks first
* - override sanity checks. kick matching users regardless of
threshold config
&],
KICKBAN => [\&cmd_kickban, '[-(switches)(banmask)(cidr)] <mask> [reason]',
qr&^(-[^ /:]*|)((?:/[0-9]{0,3})?(?::[0-9]{0,3})?) *([^ ]+) *(.*)&, q&
kick and permanently ban users. if mask is nickmask, banmask flags will be
used to place bans; if it is a full hostmask, only that hostmask ban will
be placed
cidr examples:
/32 - IPv4 = 32 bits, IPv6 from config
:128 - IPv4 from config, IPv6 = 128 bits
/24:64 - IPv4 = 24 bits, IPv6 = 64 bits
switches may be any of 'd*':
d - dry run. print matching nicks and placed bans first
* - override sanity checks. kick matching users regardless of
threshold config
banmask may be any of 'n{uUi}{hHp}' or 'v'. by default it is -uH:
n - nickname
u - username (given ~luser@host, bans *luser@*. given luser@host,
bans luser@*)
U - full username (bans verbatim)
i - ident (given ~luser@host, bans *@*. given luser@host, bans luser@*)
h - partial hostname (given luser@example.org, bans *@example.org. given
luser@1-2-3-4.dsl.example.net, bans *@*.dsl.example.net. given
luser@1.2.3.4, bans *@1.2.3.*, etc.)
H - full hostname
p - resolved IP address. on cloaked or unresolvable IPs, the hostname will
be used
v - verbatim mask. must be used alone
&],
KILL => [\&cmd_kill, '[-(switches)] <mask> [reason]',
qr&^(-[^ ]*|) *([^ ]+) *(.*)&, q&
kill users
switches may be any of 'd*':
d - dry run. print matching nicks and placed bans first
* - override sanity checks. kick matching users regardless of
threshold config
&],
KLINE => [\&cmd_kline, '[-(switches)(banmask)(cidr)] <mask> [reason]',
qr&^(-[^ /]*|)(/?[0-9]{0,3}:?[0-9]{0,3}) *([^ ]+) *(.*)&, q&
deny users from server. see KICKBAN help for banmask format
KLINE tries to decide whether to use a kline, resv/qline, xline/gecos,
or dline/zline depending on the banmask specified
switches may be any of 'gd*':
g - try to set a network-wide ban (gline or similar)
d - dry run. print matching nicks and placed bans first
* - override sanity checks. kick matching users regardless of
threshold config
additional banmask options (see KICKBAN for the rest):
r - match gecos / realname (this has to be used by itself)
&],
KNOCKOUT => [\&cmd_kickban,
'[-(length)(switches)(banmask)(cidr)] <mask> [reason]',
qr&^(-[^ /]*|)((?:/[0-9]{0,3})?(?::[0-9]{0,3})?) *([^ ]+) *(.*)&, q&
kick and temporarily ban users. same as KICKBAN except with optional length
option. length is specified in minutes; if unspecified, it will use the
"knockout" setting
&],
QUIET => [\&cmd_quiet, '[-(length)(switches)(banmask)(cidr)] <mask>',
qr&^(-[^ /]*|)(/?[0-9]{0,3}:?[0-9]{0,3}) *([^ ]*)&, q&
quiet users with appropriate mode depending on ircd
&],
TKLINE => [\&cmd_tkline, '[-(switches)(length)(banmask)(cidr)] <mask> [reason]',
qr&^(-[^ /]*|)(/?[0-9]{0,3}:?[0-9]{0,3}) *([^ ]+) *(.*)&, q&
temporarily deny users from server. see KICKBAN help for banmask format
TKLINE tries to decide whether to use a kline, resv/qline, xline/gecos,
or dline/zline depending on the banmask specified
switches may be any of 'gd*':
g - try to set a network-wide ban (gline or similar)
d - dry run. print matching nicks and placed bans first
* - override sanity checks. kick matching users regardless of
threshold config
additional banmask options (see KICKBAN for the rest):
r - match gecos / realname (this has to be used by itself)
&],
REASON => [\&cmd_reason, '[shorthand [expansion]]', qr&^([^ ]*) *(.*)$&, q&
manage reason expansions, useful for kick/kill messages you see yourself using
often. without shorthand, display current mappings. specify shorthand without
expansion to remove that shorthand. specify both shorthand and expansion to
map that value.
to use, simply replace the kick/kill/ban reason with the shorthand, and it
will be expanded
&],
SET => [\&cmd_set, '[option [value]]', qr&^([^ ]*) *(.*)$&, q&
without option, display current channel/server settings. specifying an option
without a value displays the value for that option. specifying both an option
and a value sets that option
Channel settings:
kickonban - whether to kick users who match bans, overrides kickonban
global option
limit - limit joins to users:seconds, overrides limit global option
limit_on - whether autolimit is enabled, overrides limit_on global option
&],
);
my $SCRIPT_PREFIX;
my $HELP = <<'HELP';
,-------------------------------------------------------------.
/))))))))) | kloeri.pl provides a multitude of commands, aliases, and |
//) __ __\ | functions that aid in channel and network management. it |
C==/_o|^|o_\ | also provides useful information on users even if you do |
| _\ ) | not operate a channel or server. most commands take an |
\ .--- / < optional target argument, specified by the @ prefix and |
_/`-. __.'_ | formatted @channel or @server.channel (for commands such as |
/` \`'-,._./|\ | kickban) or @server (for commands such as kline). |
/ \ /`\_/\/ \ `-------------------------------------------------------------'
Commands:
HELP
$HELP .= "\n$_ ${COMMANDS{$_}[1]}" for (sort keys %COMMANDS);
# database globals
our ($dbh, %aops, %settings);
# globals shared across functions
our ($buffer, $target, @parameters);
# caches and running operations
our (%ircds, %cbs, %joins_aop, %joins_lim);
# -- general functions -- #
sub bracket
{
return join '' =>
weechat::color('chat_delimiters'), '[',
weechat::color('reset'), join(' ', @_),
weechat::color('chat_delimiters'), ']',
weechat::color('reset');
}
sub error
{
my ($msg, $buf) = (pop, pop // $buffer);
weechat::print($buf, weechat::prefix('error')."$SCRIPT_NAME: ".$msg);
return weechat::WEECHAT_RC_ERROR;
}
sub info
{
my ($msg, $buf) = (pop, pop // $buffer);
weechat::print($buf, "$SCRIPT_PREFIX\t".$msg);
}
sub list
{
my ($msg, $buf) = (pop, pop // $buffer);
my ($server, $channel) = servchan($buffer);
weechat::print(
$buf, weechat::prefix('network').
bracket(weechat::color('chat_channel').
($channel // $server // $SCRIPT_NAME))." $msg");
}
sub debug
{
return if weechat::config_get_plugin('debug') eq '0';
my ($msg, $buf) = (pop, pop // $buffer // '');
weechat::print($buf, "$SCRIPT_PREFIX\t(debug) ".$msg);
}
# get currently-set limit for channel
sub chanlimit
{
my ($servname, $channame) = servchan($buffer);
my ($hserv, $hchan) = (weechat::hdata_get('irc_server'),
weechat::hdata_get('irc_channel'));
my $servptr = weechat::hdata_search($hserv,
weechat::hdata_get_list($hserv, 'irc_servers'),
"\${irc_server.name} == $servname", 1);
my $chanptr = weechat::hdata_search($hchan,
weechat::hdata_pointer($hserv, $servptr, 'channels'),
"\${irc_channel.name} == $channame", 1);
weechat::hdata_integer($hchan, $chanptr, 'limit');
}
# normalise cidr format string from flags
sub cidr
{
my ($cidr4, $cidr6) = shift =~ m&/?([^:]*):?(.*)&;
$cidr4 = weechat::config_get_plugin('cidr4') unless $cidr4;
$cidr6 = weechat::config_get_plugin('cidr6') unless $cidr6;
return ($cidr4, $cidr6);
}
# compile list of masks and return list of regexes
sub compile
{
# may replace with map function
my @rtn;
for my $pattern (split ',', shift) {
for ($pattern) {
/!.*@/ and last;
/!/ and do { $pattern .= '@*'; last };
/@/ and do { $pattern = '*!'.$pattern; last };
m&[.:/]& and do { $pattern = '*!*@'.$pattern; last };
$pattern .= '!*@*'; last;
}
$pattern = ($pattern =~ /^!re/
? $pattern =~ s/^!re//r
: quotemeta $pattern);
debug("&compile: received /$pattern/");
$pattern =~ s/\\\?/./g;
$pattern =~ s/\\\*/.*/g;
debug("&compile: compiling /^$pattern\$/i");
push @rtn, qr/^$pattern$/i;
}
return @rtn;
}
sub deop
{
my $nicks = shift;
my (%modes, @targets);
my ($letters, $prefixes) = opmodes(weechat::buffer_get_string($buffer,
'localvar_server'));
debug("&deop(nicks => @$nicks); letters => $letters, prefixes => $prefixes");
for my $nick (@$nicks) {
my $iptr = weechat::infolist_get('irc_nick', '',
weechat::buffer_get_string($buffer, 'localvar_server').','.
weechat::buffer_get_string($buffer, 'localvar_channel').','.
$nick);
next unless $iptr;
$modes{$nick} = weechat::infolist_string($iptr, 'prefixes')
if weechat::infolist_next($iptr);
eval "\$modes{\$nick} =~ y/$prefixes/$letters/" if defined $modes{$nick}
or warn $@;
$modes{$nick} =~ s/ //g;
if ($modes{$nick}) {
push(@targets, $nick) for (1 .. length $modes{$nick});
}
weechat::infolist_free($iptr);
}
modes('-', join('', values %modes), 0, @targets);
}
# return shortest list of banmasks given flags and list of users
sub get_bans
{
my ($flags, $hosts, $cidr) = @_;
debug("&get_bans(flags => $flags, hosts => ..., cidr => $cidr)");
my %rtn;
for (@$hosts) {
my $mask;
if ($flags =~ /r/) {
$rtn{"!re$_"} = 1;
}
my ($nick, $user, $host) = /^([^!]*)!([^@]*)@(.*)/;
$mask = ($flags =~ /n/ ? $nick : '*') . '!';
for ($flags) {
/u/ and ($mask .= ($user =~ /^~/ ? '*'.substr($user, 1) : $user)),
last;
/U/ and ($mask .= $user), last;
/i/ and ($mask .= ($user =~ /^~/ ? '*' : $user)), last;
($mask .= '*'), last;
}
$mask .= '@';
for ($flags) {
/h/ and ($mask .= hostpart($host)), last;
/H/ and ($mask .= $host), last;
/p/ and ($mask .= lookup($host, $cidr)), last;
($mask .= '*'), last;
}
$rtn{$mask} = 1;
}
return keys %rtn;
}
# return people who match mask
sub get_nicks
{
my $masks = shift;
my (@nicks, @hosts, $iptr);
my ($server, $channel) = servchan($buffer);
if ($masks =~ m&[*?!@.:/]&) {
# looks like a mask? fetch entire nicklist and iter through it ourselves
$iptr = weechat::infolist_get('irc_nick', '', "$server,$channel");
return (\@nicks, \@hosts) unless $iptr;
my @maskre = compile($masks);
while (weechat::infolist_next($iptr)) {
my $nick = weechat::infolist_string($iptr, 'name');
next if $nick eq weechat::info_get('irc_nick', $server);
my $hostmask = $nick.'!'.weechat::infolist_string($iptr, 'host');
next unless match($hostmask, @maskre);
push @nicks, $nick;
push @hosts, $hostmask;
}
weechat::infolist_free($iptr);
} else {
# looks like nicks? let weechat pick what we want
for my $nick (split ',', $masks) {
$iptr = weechat::infolist_get('irc_nick', '',
"$server,$channel,$nick");
next unless $iptr;
if (weechat::infolist_next($iptr)
and lc weechat::infolist_string($iptr, 'name') eq lc $nick) {
push @nicks, $nick;
push @hosts, "$nick!".weechat::infolist_string($iptr, 'host');
};
weechat::infolist_free($iptr);
}
}
return (\@nicks, \@hosts);
}
# mask hostname or IP to significant sections
sub hostpart
{
my $host = shift;
# need to fumble with ipv6 as well
if ($host =~ /^([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.)[0-9]{1,3}$/) {
return $1.'*';
} elsif ($host =~ /^[^.]+(\.[0-9a-z-]+\.[.0-9a-z-]+)$/i) {
return '*'.$1;
} elsif ($host =~ /^[^:]+([:0-9A-F]+:IP)$/) { # unrealircd ipv6 cloaks
return '*'.$1;
} else {
return $host;
}
}
# case insensitive search for irc buffer (takes one or two args)
sub ircbuf { weechat::buffer_search('irc', "(?i)".(join '.', @_)) }
# return ircd info. if currently unavailable, requests VERSION from server,
# hooks a callback to the calling function, and returns false
sub ircd
{
my ($fnname, $cb, $args) = @_;
my $server = lc weechat::buffer_get_string($buffer, 'localvar_server');
return $ircds{$server} if exists $ircds{$server};
return '' if (exists $cbs{"irc_351_${server}"}
or exists $cbs{"irc_351_${server}_timeout"});
info("$fnname is fetching ircd version; command may be delayed");
weechat::command($buffer, '/quote version');
# next time &irc_004_351 is called, it'll see this in %cb
$cbs{"irc_351_${server}"} = [$cb, $args];
$cbs{"irc_351_${server}_timeout"} = [
weechat::hook_timer(weechat::config_get_plugin('timeout') * 1000,
0, 1, 'irc_351_timeout', $buffer),
$cb, $args];
return '';
}
# kick list of nicks, stacking if possible
sub kick
{
my ($nicks, $reason) = @_;
my ($stack) = (weechat::info_get('irc_server_isupport_value',
weechat::buffer_get_string($buffer, 'localvar_server').',TARGMAX')
=~ /KICK:([0-9]+)/);
$stack //= 1;
debug("&kick(nicks => @$nicks, reason => $reason); stack => $stack");
for (my $i = 0; $i < @$nicks; $i += $stack) {
weechat::command($buffer, "/command irc kick ".join(',',
@$nicks[$i .. $i + $stack - 1]).($reason ? " $reason" : ""));
}
}
# do DNS lookup on host and return IP address, or return host if failed
# (for now this only returns host unless host is IP, in which it formats
# the IP address to appropriate CIDR notation)
sub lookup
{
my ($host, $cidr) = @_;
my ($cidr4, $cidr6) = cidr($cidr);
debug("&lookup(host => $host, cidr => $cidr); /$cidr4:$cidr6");
# lazy checking, maybe improve this in the future
if ($host =~ /^([0-9.]{7,15})$/) { return "$1/$cidr4";
} elsif ($host =~ /^([0-9a-f:]{2,71}).?$/i) { return "$1/$cidr6";
} else { return $host;
}
}
# match user host against list of regexes and return if found
sub match
{
my ($hostmask, @patterns) = @_;
return (lc $hostmask) ~~ @patterns;
}
# stack modes and parameters and send to ircd
sub modes
{
my ($pre, $mode, $length, @args) = @_;
$mode x= @args if length $mode == 1 and @args;
my $modelen = length $mode;
my $stack = weechat::info_get('irc_server_isupport_value',
weechat::buffer_get_string($buffer, 'localvar_server').',MODES')
|| 3; # safe default
debug("&modes(pre => $pre, mode => $mode, length => $length, args => @args)");
for (my $i = 0; $i < $modelen; $i += $stack) {
my $n = 0;
unless ($i > @args) {
$n = ($i + $stack > @args) ? @args % $stack : $stack;
}
my $modestr = substr($mode, $i, $stack).
($n ? ' '.join(' ', @args[$i .. $i + $n - 1]) : '');
#debug("&modes: i => $i, modestr => $pre$modestr");
weechat::command($buffer, "/mode $pre$modestr");
weechat::command($buffer, "/wait ${length}m /mode ".
($pre eq '+' ? '-' : '+')."$modestr") if $length;
}
}
# return op modes/prefixes for server
sub opmodes
{
my $server = shift;
my @prefix = weechat::info_get('irc_server_isupport_value',
"$server,PREFIX") =~ /^\(([^)]*)\)(.*)$/;
if (@prefix) {
return @prefix;
} else {
return qw(ov @+);
}
}
sub servchan
{
my $buf = shift;
return (lc weechat::buffer_get_string($buf, 'localvar_server'),
weechat::buffer_get_string($buf, 'localvar_type') ne 'server' &&
lc weechat::buffer_get_string($buf, 'localvar_channel'));
}
# send banlist to ircd
sub set_bans
{
my ($bans, $length) = @_;
debug("&set_bans(bans => @$bans, length => $length)");
modes('+', 'b', $length, @$bans);
}
# send quietlist to ircd
sub set_quiets
{
my $ircd = ircd('set_quiets', \&set_quiets, \@_);
return unless $ircd;
my ($bans, $length) = @_;
debug("&set_quiets(bans => @$bans, length => $length); ircd => $ircd");
my $server = weechat::buffer_get_string($buffer, 'localvar_server');
given ($ircd) {
when (['bahamut', 'hybrid', 'ircd', 'ircu', 'ngircd', 'plexus', 'ratbox']) {
modes('+', 'b', $length, @$bans);
} when (['charybdis', 'seven']) {
modes('+', 'q', $length, @$bans);
} when ('inspircd') {
@$bans = map { "m:$_" } @$bans if
weechat::info_get('irc_server_isupport_value', "$server,EXTBAN")
=~ /^,.*m/;
modes('+', 'b', $length, @$bans);
} when ('unreal') {
@$bans = map { "~q:$_" } @$bans if
weechat::info_get('irc_server_isupport_value', "$server,EXTBAN")
=~ /^~,.*q/;
modes('+', 'b', $length, @$bans);
} when ('other') {
# do some guessing if we don't know the ircd
my $extban = weechat::info_get('irc_server_isupport_value',
"$server,EXTBAN");
if ($extban =~ /^~,.*q/) {
# unreal-like
modes('+', 'b', $length, map { "~q:$_" } @$bans);
} elsif ($extban =~ /^,.*m/) {
# insp-like
modes('+', 'b', $length, map { "m:$_" } @$bans);
} elsif (weechat::info_get('irc_server_isupport_value',
"$server,CHANMODES") =~ /[^,]*q.*,/) {
# chary-like
debug("&set_quiets: ".weechat::info_get('irc_server_isupport_value',
"$server,CHANMODES"));
modes('+', 'q', $length, @$bans);
} else {
# let's hope they're at least rfc1459!
modes('+', 'b', $length, @$bans);
}
}
}
}
# -- callbacks -- #
sub ccmd_kloeri
{
$buffer = $_[1];
my ($command, $target, $paramstring) =
$_[2] =~ /([^ ]+)(?: +@([^ ]+))? *(.*)/;
return error('Missing command') unless defined $command;
$command = uc $command;
if (defined $target) {
my $server = weechat::buffer_get_string($buffer, 'localvar_server');
$buffer = ircbuf($server, $target)
|| ircbuf($server)
|| ircbuf($target);
} else {
$target = '';
}
chomp $paramstring;
debug("&cmd_kloeri(command => $command, target => $target, ".
"paramstring => $paramstring)");
if (exists $COMMANDS{$command}) {
unless (@parameters = $paramstring =~ $COMMANDS{$command}[2]) {
debug("\$paramstring must be /${COMMANDS{$command}[2]}/");
return error("Command $command requires parameters in format ".
weechat::color('underline').$COMMANDS{$command}[1].
weechat::color('-underline')."; see ".
weechat::color('underline')."/kloeri help $command".
weechat::color('-underline')." for more information");
}
debug("&cmd_kloeri: stepping into $command");
$COMMANDS{$command}[0]->($command);
debug("&cmd_kloeri: stepping out of $command");
} else {
return error("$command is not a known command");
}
return weechat::WEECHAT_RC_OK;
}
sub cmd_akill
{
# TODO
}
sub cmd_alias
{
my ($flags) = @parameters;
my @aliases = (
'akill kloeri akill',
'chankey kloeri key',
'dns kloeri dns',
'down kloeri down',
'kill kloeri kill',
'kline kloeri kline',
'reason kloeri reason',
'kset kloeri set',
'quiet kloeri quiet',
'tkline kloeri tkline',
);
if ($flags !~ /s/) {
@aliases = (@aliases,
'autoop kloeri autoop',
'kick kloeri kick',
'kickban kloeri kickban',
'knockout kloeri knockout',
);
}
if ($flags !~ /l/) {
@aliases = (@aliases,
'aop kloeri autoop',
'k kloeri kick',
'kb kloeri kickban',
'ko kloeri knockout',
);
}
($flags =~ /d/) and info('', 'I would add the following aliases:');
for my $alias (@aliases) {
($flags =~ /d/) and info('', ' - '.($alias =~ s/ / => /r)), next;
weechat::command('', "/alias add $alias");
}
($flags !~ /d/) and info('', "Don't forget to /save!");
}
sub cmd_autoop
{
my ($flags, $args) = @parameters;
my ($server, $channel) = servchan($buffer);
my ($letters, $prefixes) = opmodes(weechat::buffer_get_string($buffer,
'localvar_server'));
# just print current aop list
unless ($args) {
my %prefixcols;
my $stmt = $dbh->prepare('SELECT mode, mask FROM automodes
WHERE server=? AND channel=?');
$stmt->execute($server, $channel);
for ( split ';', weechat::config_string(
weechat::config_get('irc.color.nick_prefixes')) ) {
if (/(.):(.+)/) { $prefixcols{$1} = $2; }
}
while (my $row = $stmt->fetchrow_arrayref()) {
my $prefix = eval "\$row->[0] =~ y/$letters/$prefixes/r" or warn;
my ($nicks, undef) = get_nicks($row->[1]);
list(weechat::color($prefixcols{$row->[0]} // $prefixcols{'*'}).
$prefix.weechat::color('reset').
(@$nicks ? bracket(weechat::color('chat_nick').
join(' ',@$nicks)) : "")." $row->[1]");
}
list('End of automode list');
return;
}
# count '/aop -o nick' as mode string rather than use 'o' as flag
if ($flags and $args !~ /^[+-]/) {
$args = "$flags $args";
$flags = '';
}
my ($modes, $maskstr, @masks);
($modes, $maskstr) = $args =~ /([-+*$letters]+) +([^,]*)/
or return error("Mode string for AUTOOP must only contain +, -, *, ".
"and $letters, and masks may not contain commas");
@masks = split ' ', $maskstr;
$modes x= @masks if length $modes == 1;
my ($addstmt, $delstmt, $selstmt, $selallstmt) = (
$dbh->prepare('INSERT INTO automodes
(server, channel, mask, mode) VALUES (?, ?, ?, ?)'),
$dbh->prepare('DELETE FROM automodes WHERE rowid=?'),
$dbh->prepare('SELECT rowid FROM automodes WHERE
server=? AND channel=? AND mask=? AND mode=?'),
$dbh->prepare('SELECT rowid FROM automodes WHERE
server=? AND channel=? AND mask=?')
);
my $add = 1;
my $opmask = ($flags =~ /[nuUihHpr]/) ?
$flags : weechat::config_get_plugin('opmask');
for my $mode (split '', $modes) {
$mode =~ /[+-]/ and $add = $mode eq '+', next;
(my $mask = shift @masks) or last;
my $host;
unless ($flags =~ /v/ or $mask =~ m&[*?!@.:/]&) {
(undef, $host) = get_nicks($mask);
next unless @$host;
}
($mask) = get_bans($opmask, [@$host[0]], '') if defined $host;
$selstmt->execute($server, $channel, $mask, $mode);
my $selrtn = $selstmt->fetchrow_arrayref();
if ($add) {
next if $selrtn;
$addstmt->execute($server, $channel, $mask, $mode);
} elsif (!$add and $mode eq '*') {
$selallstmt->execute($server, $channel, $mask);
$delstmt->execute($_->[0]) for ($selallstmt->fetchrow_arrayref())
} else {
$delstmt->execute($selrtn->[0]) if $selrtn;
}
my ($nicks, undef) = get_nicks($mask);
# TODO: add threshold
modes('+', $mode, 0, @$nicks) if $flags =~ /a/ and @$nicks;
}
weechat::print($buffer,
weechat::prefix('network').'Automode '.weechat::color('chat_channel').
$channel.' '.bracket(($args =~ /^[+-]/ ? "" : "+").$args));
# sync cache
my $stmt = $dbh->prepare('SELECT server, channel, mask, mode
FROM automodes');
$stmt->execute();
# cache results for channels we're in
%aops = ();
while (my $row = $stmt->fetchrow_arrayref()) {
#next unless ircbuf($row->[0], $row->[1]);
$aops{$row->[0]}{$row->[1]}{$row->[2]} = $row->[3];
}
}
sub cmd_debug
{
my ($crap) = lc $parameters[0];
if ($crap eq 'who') {
my (undef, $hosts) = get_nicks('*');
list("$_") for (@$hosts);
list('End of who list');
} elsif ($crap eq 'ircd') {
list("$_ => ${ircds{$_}}") for (keys %ircds);
list('End of ircd version list');
} elsif ($crap eq 'cb') {
list("$_ => ${cbs{$_}}") for (keys %cbs);
list('End of callbacks list');
} elsif ($crap eq 'aop') {
for my $server (keys %aops) {
list ("$server.$_") for (keys %{ $aops{$server} });
}
} elsif ($crap eq 'limit') {
info('Invoking limit hook');
irc_delay_limit($buffer);
}
}
sub cmd_dns
{
# TODO
}
sub cmd_down
{
my ($mask) = (shift @parameters) =~ s/ /,/gr;
debug("&cmd_down(mask => $mask)");
my ($nicks, undef) = get_nicks( $mask || weechat::info_get('irc_nick',
weechat::buffer_get_string($buffer, 'localvar_server')) );
deop($nicks);
}
sub cmd_help
{
my $topic = uc $parameters[0];
if (!$topic) {
weechat::command('', '/help kloeri');
} elsif (exists $COMMANDS{$topic}) {
info('', "$topic ${COMMANDS{$topic}[1]}");
debug('', "(param regex: /${COMMANDS{$topic}[2]}/)");
info('', "${COMMANDS{$topic}[3]}");
} else {
return error('', "No help on $topic");
}
}
# TODO maybe?
sub cmd_key
{
my @chars = ('a' .. 'z', '0' .. '9');
my $string;
$string .= $chars[rand @chars] for (1 .. 8);
weechat::command('', "/mode +k $string");
}
sub cmd_kick
{
my ($flags, $mask, $reason) = @parameters;
my ($nicks, undef) = get_nicks($mask);
if ($flags =~ /d/) {
info( "I would kick ".bracket(weechat::color('chat_nick').
join(' ', @$nicks)) );
} else {
deop($nicks) if weechat::config_get_plugin('deop');
if (@$nicks > (weechat::config_get_plugin('threshold') || @$nicks)
and $flags !~ /\*/) {
return error("Too many targets; not kicking without -* flag");
} else {
kick($nicks, $reason);
}
}
}
sub cmd_kickban
{
my ($command, $flags, $cidr, $mask, $reason) = (shift, @parameters);
my ($nicks, $hosts) = get_nicks($mask);
my $banmask = ($flags =~ /[nuUihHpr]/) ?
$flags : weechat::config_get_plugin('banmask');
my @bans = ($flags =~ /v/) ? split ',', $mask :
get_bans($banmask, $hosts, $cidr // '');
my $len;
if ($command eq 'KICKBAN') {
$len = 0;
} else {
($len) = ($flags =~ /([0-9]+)/);
$len //= weechat::config_get_plugin('knockout');
}
if ($flags =~ /d/) {
info("I would kick ".bracket(weechat::color('chat_nick').
join(' ', @$nicks))." and ban ".
bracket(@bans).($len ? " for $len minutes" : ""));
} else {
deop($nicks) if weechat::config_get_plugin('deop');
set_bans(\@bans, $len) unless weechat::config_get_plugin('banafter');
if (@$nicks > (weechat::config_get_plugin('threshold') || @$nicks)
and $flags !~ /\*/) {
return error("Too many targets; not kicking without -* flag");
} else {
kick($nicks, $reason);
}
set_bans(\@bans, $len) if weechat::config_get_plugin('banafter');
}
}
sub cmd_kill
{
# TODO
}
sub cmd_kline
{
# TODO
}
sub cmd_quiet
{
my ($flags, $cidr, $mask) = @parameters;
return weechat::command($buffer, '/command irc quiet') unless $mask;
my ($nicks, $hosts) = get_nicks($mask);
my $banmask = ($flags =~ /[nuUihHpr]/) ?
$flags : weechat::config_get_plugin('banmask');
my @bans = ($flags =~ /v/) ? $mask :
get_bans($banmask, $hosts, $cidr // '');
my ($len) = ($flags =~ /([0-9]+)/);
$len //= weechat::config_get_plugin('knockout');
if ($flags =~ /d/) {
info("I would quiet ".bracket(@bans).($len ? " for $len minutes" : ""));
} else {
deop($nicks);
set_quiets(\@bans, $len);
}
}
sub cmd_reason
{
# TODO
}
sub cmd_set
{
my ($key, $value) = @parameters;
my ($server, $channel) = servchan($buffer);
# nothing to do if we're not on a server
return error('SET only works on servers and channels!')
unless defined $server;
# just recall settings or remove setting
# TODO: reflect %settings cache if possible
if ($value eq '') {
my $stmt;
if ($key && $key =~ /^-/) {
$key =~ s/^-//;
$stmt = $dbh->prepare('DELETE FROM settings
WHERE server=? AND channel=? AND key=?');
$stmt->execute($server, $channel // '', $key);
delete $settings{$server}{$channel}{$key};
info("Removed setting $key");
return weechat::WEECHAT_RC_OK;
}
if ($key) {
$stmt = $dbh->prepare('SELECT key, value FROM settings
WHERE server=? AND channel=? AND key=?');
$stmt->execute($server, $channel // '', $key);
} else {
$stmt = $dbh->prepare('SELECT key, value FROM settings
WHERE server=? AND channel=?');
$stmt->execute($server, $channel // '');
}
while (my $row = $stmt->fetchrow_arrayref()) {
list("$row->[0] => $row->[1]");
}
list('End of '.($channel ? 'channel' : 'server').
' settings');
return weechat::WEECHAT_RC_OK;
}
if (defined $channel) {
return error("Option $key doesn't exist for channels")
unless ($key =~ /kickonban|limit|limit_delta|limit_on/);
my $stmt = $dbh->prepare('DELETE FROM settings
WHERE server=? AND channel=? AND key=?');
$stmt->execute($server, $channel, $key);
$stmt = $dbh->prepare('INSERT INTO settings
(server, channel, key, value) VALUES (?, ?, ?, ?)');
$stmt->execute($server, $channel, $key, $value);
$settings{$server}{$channel}{$key} = $value;
info("Setting $key changed to $value");
}
return weechat::WEECHAT_RC_OK;
}
sub cmd_tkline
{
# TODO
}
sub cb_shutdown
{
$dbh->disconnect() if $dbh;
return weechat::WEECHAT_RC_OK;
}
sub irc_004_351
{
my (undef, $server, $numeric, $message) = (shift,
shift =~ /(.+),irc_raw_in_(...)/, shift);
$server = lc $server;
$ircds{$server} = 'other';
debug("&irc_004_351(server => $server, numeric = $numeric, ".
"message => $message)");
my $version;
for ($message =~ /^:[^ ]* (...)/) {
($1 eq '004') and
($version) = $message =~ /^:[^ ]* 004 [^ ]+ [^ ]+ ([^ ]+)/;
($1 eq '351') and
($version) = $message =~ /^:[^ ]* 351 [^ ]+ (.*)/;
}
return weechat::WEECHAT_RC_OK unless defined $version;
for ($version) {
/^bahamut-/ and ($ircds{$server} = 'bahamut'), last;
/^charybdis-/ and ($ircds{$server} = 'charybdis'), last;
/^:?InspIRCd-/ and ($ircds{$server} = 'inspircd'), last;
/^[0-9]\./ and ($ircds{$server} = 'ircd'), last;
/^u[0-9]+\./ and ($ircds{$server} = 'ircu'), last;
/^ngircd-/i and ($ircds{$server} = 'ngircd'), last;
/^hybrid-/ and ($ircds{$server} = 'hybrid'), last;
/^hybrid-.*\+plexus/ and ($ircds{$server} = 'plexus'), last;
/^ircd-ratbox-/ and ($ircds{$server} = 'ratbox'), last;
/^ircd-seven-/ and ($ircds{$server} = 'seven'), last;
/^Unreal/ and ($ircds{$server} = 'unreal'), last;
}
return weechat::WEECHAT_RC_OK unless exists $cbs{"irc_351_${server}"};
$cbs{"irc_351_${server}"}[0]->(@{ $cbs{"irc_351_${server}"}[1] });
weechat::unhook($cbs{"irc_351_${server}_timeout"}[0])
if exists $cbs{"irc_351_${server}_timeout"}[0];
delete $cbs{"irc_351_${server}"};
delete $cbs{"irc_351_${server}_timeout"};
return weechat::WEECHAT_RC_OK;
}
sub irc_351_timeout
{
$buffer = shift;
my $server = lc weechat::buffer_get_string($buffer, 'localvar_server');
$ircds{$server} = 'other';
info("timeout for command reached; I'll just guess the ircd version");
$cbs{"irc_351_${server}_timeout"}[1]->
(@{ $cbs{"irc_351_${server}_timeout"}[2] });
weechat::unhook($cbs{"irc_351_${server}_timeout"}[0])
if exists $cbs{"irc_351_${server}_timeout"}[0];
delete $cbs{"irc_351_${server}"};
delete $cbs{"irc_351_${server}_timeout"};
return weechat::WEECHAT_RC_OK;
}
sub irc_join
{
my (undef, $server, $nick, $host, $channel) = (shift,
shift =~ /(.+),irc_raw_in_join/i,
shift =~ /:([^!]*)(![^ ]*|) join :?([^ ]*)/i);
$buffer = ircbuf($server, $channel);
($server, $channel) = (lc $server, lc $channel);
debug("&irc_join(server => $server, nick => $nick, host => $host, ".
"channel => $channel)");
return weechat::WEECHAT_RC_OK unless exists $aops{$server}{$channel};
$cbs{"irc_join_${server}$;${channel}_delay"} =
weechat::hook_timer(5000, 0, 1, 'irc_join_delay', $buffer)
unless exists $cbs{"irc_join_${server}$;${channel}_delay"};
push @{ $joins_aop{$server}{$channel} }, [$nick, $host];
return hook_limit($server, $channel, 1);
}
sub irc_part_kick
{
my (undef, $server, $channel) = (shift,
shift =~ /(.+),irc_raw_in_(?:part|kick)/i,
shift =~ /:[^ ]* (?:part|kick) ([^ ]*)/i);
$buffer = ircbuf($server, $channel);
($server, $channel) = (lc $server, lc $channel);
return hook_limit($server, $channel);
}
sub irc_quit
{
my (undef, $server) = (shift, shift =~ /(.+),irc_raw_in_quit/i);
$server = lc $server;
# we'll be lazy as fuck and just check all limited chans on server
hook_limit($server, lc $_) for keys %{ $settings{$server} };
return weechat::WEECHAT_RC_OK;
}
sub hook_limit
{
my ($server, $channel, $is_join) = @_;
$is_join //= 0;
if ($settings{$server}{$channel}{limit_on}
// weechat::config_get_plugin('limit_on')) {
my $buf = ircbuf($server, $channel);
my ($limit, $delta, $nicks) = (
$settings{$server}{$channel}{limit}
// weechat::config_get_plugin('limit'),
$settings{$server}{$channel}{limit_delta}
// weechat::config_get_plugin('limit_delta'),
weechat::buffer_get_integer($buf, 'nicklist_nicks_count'),
);
# max joins in n // 30 seconds
my ($joins, $seconds) = ($limit =~ /^([0-9]+)/, $limit =~ /:([0-9]+)$/);
# we don't set mode +i for three reasons:
# - we could clobber an existing mode +i (& accidentally unset it later)
# - +i may be mlocked where +l isn't
# - people may be on +I list that are joinspamming
if ($is_join and $seconds and
++$joins_lim{$server}{$channel} == $joins) {
weechat::command($buf, '/mode +l 1');
weechat::unhook($cbs{"irc_limit_${server}$;${channel}"});
delete $cbs{"irc_limit_${server}$;${channel}"};
};
$cbs{"irc_limit_${server}$;${channel}"} =
weechat::hook_timer(($seconds // 30) * 1000, 0, 1,
'irc_delay_limit', $buf)
unless exists $cbs{"irc_limit_${server}$;${channel}"};
}
return weechat::WEECHAT_RC_OK;
}
sub irc_join_delay
{
$buffer = shift;
my ($server, $channel) = servchan($buffer);
my ($modes, @targets);
my ($letters, $prefixes) = opmodes($buffer);
debug("&irc_join_delay(server => $server, channel => $channel)");
if (exists $cbs{"irc_join_${server}$;${channel}_delay"}) {
weechat::unhook($cbs{"irc_join_${server}$;${channel}_delay"});
delete $cbs{"irc_join_${server}$;${channel}_delay"};
}
my @maskkeys = keys %{ $aops{$server}{$channel} };
my @maskre = compile(join ',', @maskkeys);
for (@{ $joins_aop{$server}{$channel} }) {
my ($nick, $host) = @$_;
my $iptr = weechat::infolist_get('irc_nick', '',
"$server,$channel,$nick");
next unless $iptr;
my $mode = weechat::infolist_string($iptr, 'prefixes')
if weechat::infolist_next($iptr);
weechat::infolist_free($iptr);
my $mask;
for my $i (0 .. $#maskre) {
next unless "$nick$host" =~ $maskre[$i];
$mask = $maskkeys[$i];
last;
}
next unless defined $mask;
eval "\$mode =~ y/$prefixes/$letters/" if defined $mode or warn $@;
next if $mode =~ /${aops{$server}{$channel}{$mask}}/;
debug("&irc_join_delay: $nick$host");
$modes .= $aops{$server}{$channel}{$mask};
push @targets, $nick;
}
delete $joins_aop{$server}{$channel};
modes('+', $modes, 0, @targets) if $modes and @targets;
return weechat::WEECHAT_RC_OK;
}
# XXX: for now just use cmode +l regardless of network
sub irc_delay_limit
{
$buffer = shift;
my ($server, $channel) = servchan($buffer);
my ($limit, $delta, $nicks, $curlimit) = (
($settings{$server}{$channel}{limit}
// weechat::config_get_plugin('limit')) =~ /^([0-9]+)/,
$settings{$server}{$channel}{limit_delta}
// weechat::config_get_plugin('limit_delta'),
weechat::buffer_get_integer($buffer, 'nicklist_nicks_count'),
chanlimit($buffer),
);
if (exists $cbs{"irc_limit_${server}$;${channel}"}) {
weechat::unhook($cbs{"irc_limit_${server}$;${channel}"});
delete $cbs{"irc_limit_${server}$;${channel}"};
}
delete $joins_lim{$server}{$channel};
debug("nicks=>$nicks curlimit=>$curlimit delta=>$delta");
weechat::command($buffer, '/mode +l '.($nicks + $limit))
if $nicks <= $curlimit - $limit - $delta
|| $nicks > $curlimit - $limit + $delta;
return weechat::WEECHAT_RC_OK;
}
sub irc_connect
{
my $server = pop;
my $stmt = $dbh->prepare('SELECT channel, mask, mode FROM automodes
WHERE server=?');
$server = lc $server;
$stmt->execute($server);
while (my $row = $stmt->fetchrow_arrayref()) {
next unless ircbuf($server, $row->[0]);
$aops{$server}{$row->[0]}{$row->[1]} = $row->[2];
}
return weechat::WEECHAT_RC_OK;
}
sub irc_disconnect
{
my $server = pop;
$server = lc $server;
weechat::unhook($cbs{"irc_351_${server}"}[0])
if exists $cbs{"irc_351_${server}"};
weechat::unhook($cbs{"irc_351_${server}_timeout"}[0])
if exists $cbs{"irc_351_${server}_timeout"};
delete $aops{$server};
delete $cbs{"irc_351_${server}"};
delete $cbs{"irc_351_${server}_timeout"};
delete $ircds{$server};
delete $joins_aop{$server};
delete $joins_lim{$server};
delete $settings{$server};
return weechat::WEECHAT_RC_OK;
}
if (weechat::register($SCRIPT_NAME, $SCRIPT_AUTHOR, $SCRIPT_VERSION,
$SCRIPT_LICENCE, $SCRIPT_DESC, 'cb_shutdown', '')) {
my $homedir = weechat::info_get( 'weechat_dir', '');
$dbh = DBI->connect("dbi:SQLite:dbname=$homedir/kloeri.sqlite", '', '', {
RaiseError => 1 }) or warn "SQLite error: $@";
$dbh->do('CREATE TABLE IF NOT EXISTS automodes
(server TEXT NOT NULL,
channel TEXT NOT NULL,
mask TEXT NOT NULL,
mode TEXT NOT NULL)');
$dbh->do('CREATE TABLE IF NOT EXISTS settings
(server TEXT NOT NULL,
channel TEXT,
key TEXT NOT NULL,
value TEXT)');
weechat::hook_command('kloeri', $SCRIPT_DESC,
'[command] [@[server.]channel] [parameters]',
$HELP, '', 'ccmd_kloeri', '');
# TODO: mute 351/005 numerics when we request ircd version,
# using hook_hsignal
weechat::hook_signal('*,irc_raw_in_004', 'irc_004_351', '');
weechat::hook_signal('*,irc_raw_in_351', 'irc_004_351', '');
weechat::hook_signal('*,irc_raw_in_join', 'irc_join', '');
weechat::hook_signal('*,irc_raw_in_part', 'irc_part_kick', '');
weechat::hook_signal('*,irc_raw_in_kick', 'irc_part_kick', '');
#weechat::hook_signal('*,irc_raw_in_quit', 'irc_quit', '');
weechat::hook_signal('irc_server_connected', 'irc_connect', '');
weechat::hook_signal('irc_server_disconnected', 'irc_disconnect', '');
$SCRIPT_PREFIX = bracket(weechat::color('chat_nick').$SCRIPT_NAME);
for my $option (keys %OPTIONS) {
weechat::config_set_plugin($option, $OPTIONS{$option}[1])
unless weechat::config_is_set_plugin($option);
weechat::config_set_desc_plugin($option, $OPTIONS{$option}[0]);
}
my $stmt = $dbh->prepare('SELECT server, channel, mask, mode
FROM automodes');
$stmt->execute();
# cache results for channels we're in
while (my $row = $stmt->fetchrow_arrayref()) {
next unless ircbuf('server', $row->[0]);
$aops{$row->[0]}{$row->[1]}{$row->[2]} = $row->[3];
}
$stmt = $dbh->prepare('SELECT server, channel, key, value FROM settings');
$stmt->execute();
# same thing but for settings
while (my $row = $stmt->fetchrow_arrayref()) {
next unless ircbuf('server', $row->[0]);
# channel ($row->[1]) is blank for server settings
$settings{$row->[0]}{$row->[1]}{$row->[2]} = $row->[3];
}
}