]>
jfr.im git - irc/SurrealServices/srsv.git/blob - branches/0.4.3/modules/securitybot.pm
9bdb5592ebff1037106d6a81b8115f10df9a1b5f
3 # Copyright saturn@surrealchat.net
4 # multiple feature-adds and code changes tabris@tabris.net
6 # Licensed under the GNU Public License
7 # http://www.gnu.org/licenses/gpl.txt
14 use Time
::HiRes
qw(gettimeofday);
16 use SrSv
::Process
::Init
;
17 use SrSv
::IRCd
::Event
'addhandler';
18 use SrSv
::IRCd
::State
'initial_synced';
19 use SrSv
::Timer
qw(add_timer);
22 use SrSv
::HostMask
qw( parse_hostmask );
23 use SrSv
::Conf2Consts
qw(main sql);
24 use SrSv
::SimpleHash
qw(readHash writeHash);
28 use SrSv
::User
qw( get_user_nick );
29 use SrSv
::User
::Notice
;
30 use SrSv
::Help
qw( sendhelp );
32 use SrSv
::MySQL
'$dbh';
33 use SrSv
::MySQL
::Glob
;
35 use SrSv
::Shared
qw(%conf %torip %unwhois);
37 use SrSv
::Process
::InParent
qw(list_conf loadconf saveconf);
41 #this stuff needs to be put into files
42 our $sbnick = "SecurityBot";
43 our $ident = 'Security';
44 our $gecos = 'Security Monitor (you are being monitored)';
45 our $umodes = '+BHSdopqz';
46 our $vhost = 'services.SC.bot';
49 $add_spamfilter, $del_spamfilter, $add_tklban, $del_tklban,
50 $del_expired_tklban, $get_expired_tklban,
52 $get_tklban, $get_spamfilter,
53 $get_all_tklban, $get_all_spamfilter,
59 our $enabletor = $conf{'EnableTor'};
62 addhandler
('SEOS', undef, undef, "securitybot::start_timers");
63 addhandler
('TKL', undef, undef, "securitybot::handle_tkl");
65 addhandler
('PRIVMSG', undef, $sbnick, "securitybot::msghandle");
66 addhandler
('NOTICE', undef, $sbnick, "securitybot::noticehandle");
67 addhandler
('SENDSNO', undef, undef, "securitybot::snotice");
68 addhandler
('GLOBOPS', undef, undef, "securitybot::globops");
69 addhandler
('SMO', undef, undef, "securitybot::snotice");
71 if($conf{'EnableTor'} or $conf{'CTCPonConnect'} or $conf{'EnableOPM'}) {
72 addhandler
('NICKCONN', undef, undef, 'securitybot::nickconn');
73 addhandler
('USERIP', undef, undef, 'securitybot::userip');
77 $add_tklban = $dbh->prepare_cached("REPLACE INTO tklban
78 SET type=?, ident=?, host=?, setter=?, expire=?, time=?, reason=?");
79 $del_tklban = $dbh->prepare_cached("DELETE FROM tklban WHERE type=? AND ident=? AND host=?");
80 $add_spamfilter = $dbh->prepare_cached("REPLACE INTO spamfilter
81 SET target=?, action=?, setter=?, expire=?, time=?, bantime=?, reason=?, mask=?");
82 $del_spamfilter = $dbh->prepare_cached("DELETE FROM spamfilter WHERE target=? AND action=? AND mask=?");
84 $del_expired_tklban = $dbh->prepare_cached("DELETE FROM tklban WHERE expire <= UNIX_TIMESTAMP() AND expire!=0");
85 $get_expired_tklban = $dbh->prepare_cached("SELECT type, ident, host, setter, expire, time, reason
86 FROM tklban WHERE expire <= UNIX_TIMESTAMP() AND expire!=0");
88 $get_tklban = $dbh->prepare_cached("SELECT setter, expire, time, reason FROM tklban WHERE
89 type=? AND ident=? AND host=?");
90 $get_spamfilter = $dbh->prepare_cached("SELECT time, reason FROM spamfilter WHERE target=? AND action=? AND mask=?");
92 $get_all_tklban = $dbh->prepare_cached("SELECT type, ident, host, setter, expire, time, reason
93 FROM tklban ORDER BY type, time, host");
94 $get_all_spamfilter = $dbh->prepare_cached("SELECT target, action, setter, expire, time, bantime, reason, mask, managed
95 FROM spamfilter ORDER BY time, mask");
97 $check_opm = $dbh->prepare_cached("SELECT 1 FROM opm WHERE ipaddr=?");
101 return if main
::COMPILE_ONLY
();
102 my $tmpdbh = DBI-
>connect(
103 "DBI:mysql:".sql_conf_mysql_db
,
111 $tmpdbh->do("TRUNCATE TABLE tklban");
112 $tmpdbh->do("TRUNCATE TABLE spamfilter");
113 $tmpdbh->disconnect();
120 # They're prefixed already.
122 o
=> 'Oper-up Notice',
127 my ($server, $type, $msg) = @_;
128 # $type = $snomasks{$type};
129 # diagmsg( ($type ? "[$type] " : '').$msg);
134 my ($src, $msg) = @_;
135 diagmsg
("Global -- from $src: $msg");
139 agent_connect
($sbnick, $ident, undef, $umodes, $gecos);
140 ircd
::sqline
($sbnick, 'Reserved for Services');
142 agent_join
($sbnick, main_conf_diag
);
143 ircd
::setmode
($sbnick, main_conf_diag
, '+o', $sbnick);
147 add_timer
('', 5, __PACKAGE__
, 'securitybot::start_timers2');
152 update_tor_list_timed
(3540) if $conf{'EnableTor'};
153 #securitybot::ss2tkl::update_ss_timed(3300) if $conf{'EnableSS'};
157 my ($rnick, $time, $ident, $host, $vhost, $server, $modes, $gecos, $ip, $svsstamp) = @_[0,2..4,8,5,7,9,10,6];
159 goto OUT
if ($svsstamp or $unwhois{lc $rnick});
161 if((initial_synced
and $enabletor) or $conf{'EnableOPM'} or $conf{'BanCountry'} ) {
163 check_blacklists
($rnick, $ip) or return;
166 ircd
::userip
($rnick) unless module
::is_loaded
('services');
170 if($conf{'CTCPonConnect'}) {
171 my @ctcplist = split(/ /, $conf{'CTCPonConnect'});
172 foreach my $ctcp_msg (@ctcplist) {
173 if(uc($ctcp_msg) eq 'PING') {
174 my ($sec, $usec) = gettimeofday
();
175 ircd
::ctcp
($sbnick, $rnick, 'PING', $sec, $usec);
177 ircd
::ctcp
($sbnick, $rnick, uc($ctcp_msg));
182 $unwhois{lc $rnick} = 1 unless ($svsstamp or $ip);
186 my($src, $rnick, $ip) = @_;
188 return unless($unwhois{lc $rnick});
189 return unless($ip =~ /^\d{1,3}(\.\d{1,3}){3}$/);
191 check_blacklists
($rnick, $ip) or return;
193 delete $unwhois{lc $rnick};
198 $check_opm->execute($ip);
199 my ($ret) = $check_opm->fetchrow_array();
200 $check_opm->finish();
204 sub check_country
($) {
207 if(module
::is_loaded
('geoip')) {
208 $ccode = geoip
::get_ip_location
($ip);
209 } elsif(module
::is_loaded
('country')) {
210 $ccode = country
::get_ip_country_aton
($ip);
212 foreach my $country (split(/[, ]+/, $conf{'BanCountry'})) {
213 if (lc $ccode eq lc $country) {
214 return country
::get_country_long
($country);
220 sub mk_banreason
($$) {
221 my ($reason, $ip) = @_;
222 $reason =~ s/\$/$ip/g;
226 sub check_blacklists
($$) {
227 my ($rnick, $ip) = @_;
229 if(initial_synced
and $enabletor && $torip{$ip}) {
230 if (lc $enabletor eq lc 'vhost') {
231 ircd
::chghost
($sbnick, $rnick, misc
::gen_uuid
(1, 20).'.session.tor');
233 ircd
::zline
($sbnick, $ip, $conf{'ProxyZlineTime'}, $conf{'TorZlineReason'});
238 if($conf{'EnableOPM'} && check_opm
($ip)) {
239 ircd
::zline
($sbnick, $ip, $conf{'ProxyZlineTime'}, mk_banreason
($conf{'OPMZlineReason'}, $ip));
243 sub hasGeoCountry
() {
244 return module
::is_loaded
('country') || module
::is_loaded
('geoip');
247 if($conf{'BanCountry'} && hasGeoCountry
() && (my $country = check_country
($ip))) {
248 ircd
::zline
($sbnick, $ip, $conf{'ProxyZlineTime'}, mk_banreason
($conf{'CountryZlineReason'}, $country));
255 sub update_tor_list_timed
($) {
257 $time = 3600 unless $time;
259 add_timer
('', $time, __PACKAGE__
, 'securitybot::update_tor_list_timed');
264 sub update_tor_list
() {
265 return unless (defined($conf{'TorServer'}) && length($conf{'TorServer'}));
266 diagmsg
( " -- Loading Tor server list.");
268 # path may be a local one if you run a tor-client.
269 # most configs are /var/lib/tor/cached-directory
271 foreach my $torIP (getTorRouters
($conf{'TorServer'})) {
272 $newtorip{$torIP} = 1;
275 my $torcount = scalar(keys(%newtorip));
279 diagmsg
( " -- Finished loading Tor server list - $torcount servers found.");
281 diagmsg
( " -- Failed to load Tor server list, CHECK YOUR TorServer SETTING.");
286 my ($rnick, $dst, $msg) = @_;
287 print join("\n", @_);
288 my $user = { NICK
=> $rnick, AGENT
=> $sbnick };
289 unless (adminserv
::is_ircop
($user)) {
290 notice
($user, 'Permission Denied');
294 if($msg =~ /^help/i) {
295 my (undef, @args) = split(/ /, $msg); #discards first token 'help'
296 sendhelp
($user, 'securitybot', @args);
299 elsif($msg =~ /^notice (\S*) (.*)/i) {
300 ircd
::notice
($sbnick, $1, $2);
303 elsif($msg =~ /^msg (\S*) (.*)/i) {
304 ircd
::privmsg
($sbnick, $1, $2);
307 elsif($msg =~ /^raw (.*)/i) {
308 if(!adminserv
::is_svsop
($user, adminserv
::S_ROOT
() )) {
309 notice
($user, 'You do not have sufficient rank for this command');
315 elsif($msg =~ /^kill (\S*) (.*)/i) {
316 ircd
::irckill
($sbnick, $1, $2);
319 elsif($msg =~ /^conf/i) {
320 notice
($user, "Configuration:", list_conf
);
323 elsif($msg =~ /^set (\S+) (.*)/i) {
324 if(!adminserv
::is_svsop
($user, adminserv
::S_ROOT
() )) {
325 notice
($user, 'You do not have sufficient rank for this command');
332 if(update_conf
($p[0], $p[1])) {
333 notice
($user, "Configuration: ".$p[0]." = ".$p[1]);
335 notice
($user, "That value is read-only.");
339 elsif($msg =~ /^save/i) {
340 notice
($user, "Saving configuration.");
345 elsif($msg =~ /^rehash/i) {
346 notice
($user, "Loading configuration.");
351 elsif($msg =~ /^tssync/i) {
355 elsif($msg =~ /^svsnick (\S+) (\S+)/i) {
356 if(!adminserv
::is_svsop
($user, adminserv
::S_ROOT
() )) {
357 notice
($user, 'You do not have sufficient rank for this command');
360 ircd
::svsnick
($sbnick, $1, $2);
363 elsif($msg =~ /^tor-update/i) {
364 notice
($user, "Updating Tor server list.");
368 elsif($msg =~ /^ss-update/i) {
369 notice
($user, "Updating SS definitions.");
370 securitybot
::ss2tkl
::update_ss
();
373 elsif($msg =~ /^tkl/i) {
380 my @v = values(%conf);
383 for(my $i=0; $i<@k; $i++) {
384 push @reply, $k[$i]." = ".$v[$i];
390 my ($rnick, $dst, $msg) = @_;
392 if($msg =~ /^\x01(\S+)\s?(.*?)\x01?$/) {
393 diagmsg
( "Got $1 reply from $rnick: $2");
398 # This function is a hack to fit better our normal services coding style.
399 # Better fix is to rewrite msghandle in another cleanup patch.
400 my ($user, $msg) = @_;
401 # We discard first token 'tkl'
403 (undef, $cmd, $msg) = split(/ /, $msg, 3);
404 if(lc($cmd) eq 'list') {
406 sb_tkl_glob
($user, $msg);
412 elsif(lc($cmd) eq 'del') {
414 notice
($user, "You have to specify at least one parameter");
416 sb_tkl_glob_delete
($user, $msg);
423 $get_all_tklban->execute();
424 while(my ($type, $ident, $host, $setter, $expire, $time, $reason) = $get_all_tklban->fetchrow_array()) {
426 #push @reply, "$type $host $setter";
430 push @reply, "$type $ident\@$host $setter";
432 $time = gmtime2
($time); $expire = time_rel
($expire - time()) if $expire;
433 push @reply, " set: $time; ".($expire ? "expires in: $expire" : "Will not expire");
434 push @reply, " reason: $reason";
436 $get_all_tklban->finish();
437 push @reply, "No results" unless @reply;
439 notice
($user, @reply);
442 sub sb_tkl_glob
($$) {
443 my ($user, $cmdline) = @_;
445 my $sql_expr = "SELECT type, ident, host, setter, expire, time, reason FROM tklban ";
447 my ($filters, $parms) = split(/ /, $cmdline, 2);
448 my @filters = split(//, $filters);
449 unless($filters[0] eq '+' or $filters[0] eq '-') {
450 notice
($user, "Invalid Syntax: First parameter must be a set of filters preceded by a + or -");
453 my @args = misc
::parse_quoted
($parms);
455 my ($success, $expr) = make_tkl_query
(\
@filters, \
@args);
457 notice
($user, "Error: $expr");
463 my $get_glob_tklban = $dbh->prepare($sql_expr);
464 $get_glob_tklban->execute();
465 while(my ($type, $ident, $host, $setter, $expire, $time, $reason) = $get_glob_tklban->fetchrow_array()) {
467 #push @reply, "$type $host $setter";
471 push @reply, "$type $ident\@$host $setter";
473 $time = gmtime2
($time); $expire = time_rel
($expire - time()) if $expire;
474 push @reply, " set: $time; ".($expire ? "expires in: $expire" : "Will not expire");
475 push @reply, " reason: $reason";
477 $get_glob_tklban->finish();
479 push @reply, "No results" unless @reply;
480 notice
($user, @reply);
483 sub sb_tkl_glob_delete
($$) {
484 my ($user, $cmdline) = @_;
486 my $sql_expr = "SELECT type, ident, host FROM tklban ";
488 my ($filters, $parms) = split(/ /, $cmdline, 2);
489 my @filters = split(//, $filters);
490 unless($filters[0] eq '+' or $filters[0] eq '-') {
491 notice
($user, "Invalid Syntax: First parameter must be a set of filters preceded by a + or -");
494 my @args = misc
::parse_quoted
($parms);
496 my ($success, $expr) = make_tkl_query
(\
@filters, \
@args);
498 notice
($user, "Error: $expr");
504 my $src = get_user_nick
($user);
505 my $get_glob_tklban = $dbh->prepare($sql_expr);
506 $get_glob_tklban->execute();
507 while(my ($type, $ident, $host) = $get_glob_tklban->fetchrow_array()) {
509 ircd
::unkline
($src, $ident, $host);
511 elsif($type eq 'Z') {
512 ircd
::unzline
($src, $host);
515 $get_glob_tklban->finish();
519 sub make_tkl_query
($$) {
520 my ($parm1, $parm2) = @_;
521 my @filters = @$parm1; my @args = @$parm2;
523 my ($sign, $sql_expr, $sortby, $where, $and);
524 while(my $filter = shift @filters) {
526 if ($filter eq '+') {
530 elsif($filter eq '-') {
535 my $parm = shift @args;
536 unless (defined($parm)) {
537 return (0, "Not enough arguments for filters.");
540 my ($mident, $mhost) = parse_hostmask
($parm);
541 $mident = glob2sql
($dbh->quote($mident)) if $mident;
542 $mhost = glob2sql
($dbh->quote($mhost)) if $mhost;
544 $condition = ($mident ? ($sign ? '' : '!').
545 "(ident LIKE $mident) " : '').
546 ($mhost ? ($sign ? '' : '!').
547 "(host LIKE $mhost) " : '');
549 elsif($filter eq 'r') {
550 my $reason = $dbh->quote($parm);
551 $reason = glob2sql
($reason);
552 $condition = ($sign ? '' : '!')."(reason LIKE $reason) ";
555 elsif($filter eq 's') {
556 my $setter = $dbh->quote($parm);
557 $setter = glob2sql
($setter);
558 $condition = ($sign ? '' : '!')."(setter LIKE $setter) ";
562 my ($mident, $mhost) = parse_hostmask
($parm);
563 $mident = $dbh->quote($mident) if $mident;
564 $mhost = $dbh->quote($mhost) if $mhost;
565 $condition = ($mident ? ($sign ? '' : '!').
566 "(ident REGEXP $mident) " : '').
567 ($mhost ? ($sign ? '' : '!').
568 "(host REGEXP $mhost) " : '');
570 elsif($filter eq 'R') {
571 my $reason = $dbh->quote($parm);
572 $condition = ($sign ? '' : '!')."(reason REGEXP $reason) ";
575 elsif($filter eq 'S') {
576 my $setter = $dbh->quote($parm);
577 $condition = ($sign ? '' : '!')."(setter REGEXP $setter) ";
580 elsif(lc $filter eq 'o') {
582 next unless ($parm =~ /(type|ident|host|setter|expire|reason|time)/);
586 $sortby = 'ORDER BY ';
588 $sortby .= $parm.($sign ? ' ASC' : ' DESC');
592 $sql_expr .= 'WHERE ';
600 $sql_expr .= $condition if $condition;
603 return (0, "Too many arguments for filters.");
605 return (1, $sql_expr.((defined $sortby and $sortby ne '') ? $sortby : 'ORDER BY type, time, host'));
608 sub get_tkl_type_name
($) {
615 return $tkltype{$_[0]};
618 sub get_filter_action_name
($) {
631 #t => 'Test', # Should never show up, and not implemented in 3.2.4 yet.
633 return $filteraction{$_[0]};
636 sub handle_tkl
($$@) {
637 my ($type, $sign, @parms) = @_;
638 return unless defined ($dbh);
639 if ($type eq 'G' or $type eq 'Z' or $type eq 's' or $type eq 'Q') {
641 my ($ident, $host, $setter, $expire, $time, $reason) = @parms;
642 $add_tklban->execute($type, $ident, $host, $setter, $expire, $time, $reason);
643 $add_tklban->finish();
644 diagmsg
( get_tkl_type_name
($type)." added for $ident\@$host ".
645 "from ($setter on ".gmtime2
($time).
646 ($expire ? ' to expire at '.gmtime2
($expire) : ' does not expire').": $reason)")
647 if initial_synced
() and $type ne 'Q';
650 my ($ident, $host, $setter) = @parms;
652 if ($type ne 'Q' and initial_synced
()) {
653 $get_tklban->execute($type, $ident, $host);
654 my (undef, $expire, $time, $reason) = $get_tklban->fetchrow_array;
655 $get_tklban->finish();
657 diagmsg
( "$setter removed ".get_tkl_type_name
($type)." $ident\@$host ".
658 "set at ".gmtime2
($time)." - reason: $reason");
661 $del_tklban->execute($type, $ident, $host);
662 $del_tklban->finish();
665 elsif($type eq 'F') {
667 my ($target, $action, $setter, $expire, $time, $bantime, $reason, $mask) = @parms;
668 $add_spamfilter->execute($target, $action, $setter, $expire, $time, $bantime, $reason, $mask);
669 $add_spamfilter->finish();
670 diagmsg
( "Spamfilter added: '$mask' [target: $target] [action: ".
671 get_filter_action_name
($action)."] [reason: $reason] on ".gmtime2
($time)."from ($setter)")
675 # TKL - F u Z tabris!northman@tabris.netadmin.SCnet.ops 0 0 :do_not!use@mask
676 my ($target, $action, $setter, $mask) = @parms;
677 if(initial_synced
()) {
678 $get_spamfilter->execute($target, $action, $mask);
679 my ($time, $reason) = $get_spamfilter->fetchrow_array;
680 $get_spamfilter->finish();
682 diagmsg
( "$setter removed Spamfilter (action: ".get_filter_action_name
($action).
683 ", targets: $target) (reason: $reason) '$mask' set at: ".gmtime2
($time));
685 $del_spamfilter->execute($target, $action, $mask);
686 $del_spamfilter->finish();
692 writeHash
(\
%conf, "config/securitybot/sb.conf");
698 %conf = readHash
("config/securitybot/sb.conf");
701 sub update_conf
($$) {
704 return 0 if($k eq 'EnableTor');
711 $get_expired_tklban->execute();
712 while (my ($type, $ident, $host, $setter, $expire, $time, $reason) = $get_expired_tklban->fetchrow_array()) {
713 if ($type eq 'G' or $type eq 'Z' or $type eq 's') {
714 diagmsg
( "Expiring ".get_tkl_type_name
($type)." $ident\@$host ".
715 "set by $setter at ".gmtime2
($time)." - reason: $reason");
716 #$del_tklban->execute($type, $ident, $host);
717 #$del_tklban->finish();
720 $get_expired_tklban->finish();
722 $del_expired_tklban->execute();
723 $del_expired_tklban->finish();
726 sub expire_tkl_timed
{
728 $time = 10 unless $time;
730 add_timer
('10', $time, __PACKAGE__
, "securitybot::expire_tkl_timed");
736 ircd
::privmsg
($sbnick, main_conf_diag
, @_);
737 write_log
('diag', '<'.main_conf_local
.'>', @_);
741 sub unload
{ saveconf
(); }