Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
502 lines (382 sloc) 13.1 KB
#!/usr/bin/perl
# Copyright (c) 2011, Mitchell Cooper
# this module adds commands for D-Lines and K-Lines.
# it requires DBD::SQLite.
# the datbase location is defined by netban:db.
# it is relative to the juno directory.
# the DLINE and KLINE commands provide the dline and kline oper flags.
# users with these flags can also use UNDLINE and UNKLINE.
# this module also provides the LISTKLINES and LISTDLINES commands.
# they display a list of bans that is easier to read than STATS.
# these commands require the kline and dline flags as well.
# this module requires juno 1.0.6 and above.
package module::netban;
use warnings;
use strict;
use feature qw[say switch];
use DBI;
use API::Module;
use API::Command;
use API::Event;
use API::Loop;
use utils qw[conf snotice col time2seconds add_commas hostmatch];
my $dbh;
# register to API::Module
register_module('netban', 0.1, 'Command interface to D-Line and K-Line.', \&init, sub { return 1 });
sub init {
# connect to SQLite
if (!&connect_db) {
snotice('could not connect to SQLite');
say 'could not connect to SQLite';
return
}
# create the table if it does not exist.
if (!&create_db) {
snotice('could not create netban database.');
say 'could not create netban database.';
return
}
# reload the bans each time the configuration is rehashed (as it usually clears them)
register_event('rehash_done', \&load_bans);
# register the loop that removes expired bans
register_loop('expirecheck', \&expire_bans) or return;
# load the stored bans
load_bans();
# register the commands
register_command('kline', 'Ban a user by their user@host mask.', \&handle_kline, {
params => 3,
flag => 'kline'
}) or return;
register_command('dline', 'Ban an IP or IP range.', \&handle_dline, {
params => 3,
flag => 'dline'
}) or return;
register_command('unkline', 'Remove a user@host ban.', \&handle_unkline, {
params => 1,
flag => 'kline'
}) or return;
register_command('undline', 'Unban an IP or IP range.', \&handle_undline, {
params => 1,
flag => 'dline'
}) or return;
register_command('listklines', 'A K-Line list that is easier to read than STATS.', \&handle_listklines, {
flag => 'kline'
}) or return;
register_command('listdlines', 'A D-Line list that is easier to read than STATS.', \&handle_listdlines, {
flag => 'dline'
}) or return;
# success
return 1
}
# handle KLINE command
sub handle_kline {
my ($user, @args) = (shift, (split /\s+/, shift));
shift @args;
my ($mask, $gtime) = (lc shift @args, lc shift @args);
# strip possible :
my $reason = col(join ' ', @args);
# make sure it doesn't exist already.
if (!exists $main::kline{$mask}) {
# validate the mask
if ($mask !~ m/(.+)\@(.+)/) {
$user->snt('kline', "\2$mask\2 is not a valid mask.");
return
}
my $time = 0;
# see if the time is valid
if ($gtime) {
$time = time2seconds($gtime);
if (!defined $time) {
$user->snt('kline', "invalid ban time: $gtime");
return
}
}
# otherwise it's a permanent ban.
if (add_kline($mask, $user->fullhost, $time, time, $reason)) {
$user->snt('kline', 'k-line added successfully.');
snotice("$$user{nick} added a k-line for \2$mask\2 to expire in \2$gtime\2 (".add_commas($time)." seconds) [$reason]");
}
else {
$user->snt('kline', 'could not write k-line to database.');
return
}
}
# it exists already
else {
$user->snt('kline', 'there is already a kline of that mask.');
return
}
# check users for kline
return &kline_check
}
# handle DLINE command
sub handle_dline {
my ($user, @args) = (shift, (split /\s+/, shift));
shift @args;
my ($ip, $gtime) = (lc shift @args, lc shift @args);
# strip possible :
my $reason = col(join ' ', @args);
# make sure it doesn't exist already.
if (!exists $main::dline{$ip}) {
# validate the ip
# the regex for this is ridiculous. I give up.
if ($ip !~ m/(\.|:)/) {
$user->snt('dline', "\2$ip\2 is not a valid IP address.");
return
}
my $time = 0;
# see if the time is valid
if ($gtime) {
$time = time2seconds($gtime);
if (!defined $time) {
$user->snt('dline', "invalid ban time: $gtime");
return
}
}
# otherwise it's a permanent ban.
if (add_dline($ip, $user->fullhost, $time, time, $reason)) {
$user->snt('dline', 'k-line added successfully.');
snotice("$$user{nick} added a d-line for \2$ip\2 to expire in \2$gtime\2 (".add_commas($time)." seconds) [$reason]");
}
else {
$user->snt('dline', 'could not write d-line to database.');
return
}
}
# it exists already
else {
$user->snt('dline', 'there is already a dline of that IP.');
return
}
# check users for dline
return &dline_check
}
# handle UNDLINE command
sub handle_undline {
my ($user, $ip) = (shift, (split /\s+/, shift)[1]);
# make sure it exists
if (exists $main::dline{$ip}) {
$user->snt('undline', 'd-line removed.');
snotice("$$user{nick} removed d-line on \2$ip\2 [$main::dline{$ip}{reason}]");
return delete_dline($ip)
}
# no such kline
else {
$user->snt('undline', "\2$ip\2 is not a banned IP. (they're case-sensitive.)");
return
}
}
# handle UNKLINE command
sub handle_unkline {
my ($user, $mask) = (shift, (split /\s+/, shift)[1]);
# make sure it exists
if (exists $main::kline{$mask}) {
$user->snt('unkline', 'k-line removed.');
snotice("$$user{nick} removed k-line on \2$mask\2 [$main::kline{$mask}{reason}]");
return delete_kline($mask)
}
# no such kline
else {
$user->snt('unkline', "\2$mask\2 is not a banned mask. (they're case-sensitive.)");
return
}
}
# handle LISTKLINES command
sub handle_listklines {
my $user = shift;
my ($m, $t, $s, $e) = (4, 9, 8, 9);
$user->servernotice('*** K-Line list');
# fetch the width of the sections
while (my ($mask, $kl) = each %main::kline) {
$m = length $mask if length $mask > $m;
next unless $kl->{time};
my $time = length POSIX::strftime('%m/%d/%Y %H:%M:%S', localtime $kl->{time});
$t = $time if $time > $t;
$s = length((split '!', $kl->{setby})[0]) if length((split '!', $kl->{setby})[0]) > $s;
my $etime = length POSIX::strftime('%m/%d/%Y %H:%M:%S', localtime $kl->{expiretime});
$e = $etime if $etime > $e;
}
# extra space to make it easier to read
$m++; $t++; $s++; $e++;
# section bar
$user->servernotice(sprintf "%-${m}s %-${t}s %-${s}s %-${e}s %s", 'mask', 'time set', 'set by', 'expires', 'reason');
$user->servernotice(sprintf "%-${m}s %-${t}s %-${s}s %-${e}s %s", qw[---- -------- ------ ------- ------]);
# send the klines
while (my ($mask, $kl) = each %main::kline) {
$user->servernotice(sprintf "\2%-${m}s\2 %-${t}s %-${s}s %-${e}s %s",
$mask,
$kl->{time} ? POSIX::strftime('%m/%d/%Y %H:%M:%S', localtime $kl->{time}) : 'permanent',
$kl->{setby} ? (split '!', $kl->{setby})[0] : '<config>',
$kl->{expiretime} ? POSIX::strftime('%m/%d/%Y %H:%M:%S', localtime $kl->{expiretime}) : 'permanent',
$kl->{reason}
);
}
$user->servernotice('*** End of K-Line list.');
return 1
}
# handle LISTDLINES command
sub handle_listdlines {
my $user = shift;
my ($m, $t, $s, $e) = (2, 9, 8, 9);
$user->servernotice('*** D-Line list');
# fetch the width of the sections
while (my ($ip, $dl) = each %main::dline) {
$m = length $ip if length $ip > $m;
next unless $dl->{time};
my $time = length POSIX::strftime('%m/%d/%Y %H:%M:%S', localtime $dl->{time});
$t = $time if $time > $t;
$s = length((split '!', $dl->{setby})[0]) if length((split '!', $dl->{setby})[0]) > $s;
my $etime = length POSIX::strftime('%m/%d/%Y %H:%M:%S', localtime $dl->{expiretime});
$e = $etime if $etime > $e;
}
# extra space to make it easier to read
$m++; $t++; $s++; $e++;
# section bar
$user->servernotice(sprintf "%-${m}s %-${t}s %-${s}s %-${e}s %s", 'IP', 'time set', 'set by', 'expires', 'reason');
$user->servernotice(sprintf "%-${m}s %-${t}s %-${s}s %-${e}s %s", qw[-- -------- ------ ------- ------]);
# send the dlines
while (my ($ip, $dl) = each %main::dline) {
$user->servernotice(sprintf "\2%-${m}s\2 %-${t}s %-${s}s %-${e}s %s",
$ip,
$dl->{time} ? POSIX::strftime('%m/%d/%Y %H:%M:%S', localtime $dl->{time}) : 'permanent',
$dl->{setby} ? (split '!', $dl->{setby})[0] : '<config>',
$dl->{expiretime} ? POSIX::strftime('%m/%d/%Y %H:%M:%S', localtime $dl->{expiretime}) : 'permanent',
$dl->{reason}
);
}
$user->servernotice('*** End of D-Line list.');
return 1
}
# create the tables
sub create_db {
$dbh->do('CREATE TABLE IF NOT EXISTS kline (mask TEXT, setby TEXT, time INT, expiretime INT, reason TEXT)') or return;
$dbh->do('CREATE TABLE IF NOT EXISTS dline (ip TEXT, setby TEXT, time INT, expiretime INT, reason TEXT)') or return;
return 1
}
# connect to SQLite
sub connect_db {
my $dbfile = conf qw/netban db/;
return unless $dbfile;
$dbfile = $main::DIR.q[/].$dbfile;
$dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", q.., q..) or return;
return 1
}
# load the stored klines
sub load_bans {
# klines
my $sth = $dbh->prepare('SELECT * FROM kline');
$sth->execute;
while (my $ref = $sth->fetchrow_hashref) {
$main::kline{delete $ref->{mask}} = $ref
}
my $sth2 = $dbh->prepare('SELECT * FROM dline');
$sth2->execute;
while (my $ref = $sth2->fetchrow_hashref) {
$main::dline{delete $ref->{ip}} = $ref
}
# check each user for a ban
kline_check();
dline_check();
return 1
}
# add a K-Line
sub add_kline {
my ($mask, $setby, $seconds, $currenttime, $reason) = @_;
my $expiretime = $currenttime + $seconds;
# insert into db
$dbh->do('INSERT INTO kline VALUES (?, ?, ?, ?, ?)', undef, $mask, $setby, $currenttime, $expiretime, $reason) or return;
# add to kline list
$main::kline{$mask} = {
setby => $setby,
expiretime => $expiretime,
reason => $reason,
time => $currenttime
};
# success
return 1
}
# add a D-Line
sub add_dline {
my ($ip, $setby, $seconds, $currenttime, $reason) = @_;
my $expiretime = $currenttime + $seconds;
# insert into db
$dbh->do('INSERT INTO dline VALUES (?, ?, ?, ?, ?)', undef, $ip, $setby, $currenttime, $expiretime, $reason) or return;
# add to kline list
$main::dline{$ip} = {
setby => $setby,
expiretime => $expiretime,
reason => $reason,
time => $currenttime
};
# success
return 1
}
# delete a KLINE by mask
sub delete_kline {
my $mask = shift;
if (exists $main::kline{$mask}) {
$dbh->do('DELETE FROM kline WHERE mask = ?', undef, $mask) or return;
return delete $main::kline{$mask}
}
# no such kline
else {
return
}
return 1
}
# delete a DLINE by IP
sub delete_dline {
my $ip = shift;
if (exists $main::dline{$ip}) {
$dbh->do('DELETE FROM dline WHERE ip = ?', undef, $ip) or return;
return delete $main::dline{$ip}
}
# no such dline
else {
return
}
return 1
}
# check all users for a K-Line
sub kline_check {
$_->checkkline foreach values %user::connection;
return 1
}
# check all users for a D-Line
sub dline_check {
foreach my $user (values %user::connection) {
foreach (keys %main::dline) {
# found a match!
$user->quit('D-Lined: '.$main::dline{$_}{'reason'},
undef,
'D-Lined'.((conf qw/main showdline/) ? q(: ).$main::dline{$_}{'reason'} : q..)
) if (hostmatch($user->{'ip'}, $_))
}
}
return 1
}
# remove expired bans
sub expire_bans {
# check k-lines
while (my ($mask, $kl) = each %main::kline) {
# either a config kline or a permanent kline
next unless $kl->{expiretime};
# check if the time is up
if ($kl->{expiretime} - time <= 0) {
delete_kline($mask);
snotice("expired kline: \2$mask\2 [$$kl{reason}]")
}
}
# check d-lines
while (my ($ip, $dl) = each %main::dline) {
# either a config kline or a permanent dline
next unless $dl->{expiretime};
# check if the time is up
if ($dl->{expiretime} - time <= 0) {
delete_dline($ip);
snotice("expired dline: \2$ip\2 [$$dl{reason}]")
}
}
return 1
}
1