branches/0.4.3/modules/securitybot.pm

   1 #!/usr/bin/perl
   2 #
   3 #  Copyright saturn@surrealchat.net
   4 #  multiple feature-adds and code changes tabris@tabris.net
   5 #
   6 #  Licensed under the GNU Public License
   7 #  http://www.gnu.org/licenses/gpl.txt
   8 #
   9
  10 package securitybot;
  11
  12 use strict;
  13 no strict "refs";
  14 use Time::HiRes qw(gettimeofday);
  15
  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);
  20 use SrSv::Time;
  21 use SrSv::Agent;
  22 use SrSv::HostMask qw( parse_hostmask );
  23 use SrSv::Conf2Consts qw(main sql);
  24 use SrSv::SimpleHash qw(readHash writeHash);
  25
  26 use SrSv::Log;
  27
  28 use SrSv::User qw( get_user_nick );
  29 use SrSv::User::Notice;
  30 use SrSv::Help qw( sendhelp );
  31
  32 use SrSv::MySQL '$dbh';
  33 use SrSv::MySQL::Glob;
  34
  35 use SrSv::Shared qw(%conf %torip %unwhois);
  36
  37 use SrSv::Process::InParent qw(list_conf loadconf saveconf update_tor_list);
  38
  39 use SrSv::TOR;
  40
  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';
  47
  48 our (
  49         $add_spamfilter, $del_spamfilter, $add_tklban, $del_tklban,
  50         $del_expired_tklban, $get_expired_tklban,
  51
  52         $get_tklban, $get_spamfilter,
  53         $get_all_tklban, $get_all_spamfilter,
  54
  55         $check_opm,
  56 );
  57
  58 loadconf(0);
  59 our $enabletor = $conf{'EnableTor'};
  60 register();
  61
  62 addhandler('SEOS', undef, undef, "securitybot::start_timers");
  63 addhandler('TKL', undef, undef, "securitybot::handle_tkl");
  64
  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");
  70
  71 if($conf{'EnableTor'} or $conf{'CTCPonConnect'} or $conf{'EnableOPM'}) {
  72         addhandler('NICKCONN', undef, undef, 'securitybot::nickconn');
  73         addhandler('USERIP', undef, undef, 'securitybot::userip');
  74 }
  75
  76 proc_init {
  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=?");
  83
  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");
  87
  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=?");
  91
  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");
  96
  97         $check_opm = $dbh->prepare_cached("SELECT 1 FROM opm WHERE ipaddr=?");
  98 };
  99
 100 sub init {
 101         return if main::COMPILE_ONLY();
 102         my $tmpdbh = DBI->connect(
 103                 "DBI:mysql:".sql_conf_mysql_db,
 104                 sql_conf_mysql_user,
 105                 sql_conf_mysql_pass,
 106                 {
 107                         AutoCommit => 1,
 108                         RaiseError => 1
 109                 }
 110         );
 111         $tmpdbh->do("TRUNCATE TABLE tklban");
 112         $tmpdbh->do("TRUNCATE TABLE spamfilter");
 113         $tmpdbh->disconnect();
 114 }
 115
 116 =cut
 117 my %snomasks = (
 118         e => 'Eyes Notice',
 119         v => 'VHost Notice',
 120         # They're prefixed already.
 121         #S => 'Spamfilter',
 122         o => 'Oper-up Notice',
 123 );
 124 =cut
 125
 126 sub snotice($$$) {
 127         my ($server, $type, $msg) = @_;
 128 #       $type = $snomasks{$type};
 129 #       diagmsg( ($type ? "[$type] " : '').$msg);
 130         diagmsg( $msg);
 131 }
 132
 133 sub globops($$) {
 134         my ($src, $msg) = @_;
 135         diagmsg("Global -- from $src: $msg");
 136 }
 137
 138 sub register {
 139         agent_connect($sbnick, $ident, undef, $umodes, $gecos);
 140         ircd::sqline($sbnick, 'Reserved for Services');
 141
 142         agent_join($sbnick, main_conf_diag);
 143         ircd::setmode($sbnick, main_conf_diag, '+o', $sbnick);
 144 }
 145
 146 sub start_timers {
 147         add_timer('', 5, __PACKAGE__, 'securitybot::start_timers2');
 148         expire_tkl_timed();
 149 }
 150
 151 sub start_timers2 {
 152         update_tor_list_timed(3540) if $conf{'EnableTor'};
 153         #securitybot::ss2tkl::update_ss_timed(3300) if $conf{'EnableSS'};
 154 };
 155
 156 sub nickconn {
 157         my ($rnick, $time, $ident, $host, $vhost, $server, $modes, $gecos, $ip, $svsstamp) = @_[0,2..4,8,5,7,9,10,6];
 158
 159         goto OUT if ($svsstamp or $unwhois{lc $rnick});
 160
 161         if((initial_synced and $enabletor) or $conf{'EnableOPM'} or $conf{'BanCountry'} ) {
 162                 if ($ip) {
 163                         check_blacklists($rnick, $ip) or return;
 164                 }
 165                 else {
 166                         ircd::userip($rnick) unless module::is_loaded('services');
 167                 }
 168         }
 169
 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);
 176                         } else {
 177                                 ircd::ctcp($sbnick, $rnick, uc($ctcp_msg));
 178                         }
 179                 }
 180         }
 181         OUT:
 182         $unwhois{lc $rnick} = 1 unless ($svsstamp or $ip);
 183 }
 184
 185 sub userip {
 186         my($src, $rnick, $ip) = @_;
 187
 188         return unless($unwhois{lc $rnick});
 189         return unless($ip =~ /^\d{1,3}(\.\d{1,3}){3}$/);
 190
 191         check_blacklists($rnick, $ip) or return;
 192
 193         delete $unwhois{lc $rnick};
 194 }
 195
 196 sub check_opm($) {
 197         my ($ip) = @_;
 198         $check_opm->execute($ip);
 199         my ($ret) = $check_opm->fetchrow_array();
 200         $check_opm->finish();
 201         return $ret;
 202 }
 203
 204 sub check_country($) {
 205         my ($ip) = @_;
 206         my $ccode;
 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);
 211         }
 212         foreach my $country (split(/[, ]+/, $conf{'BanCountry'})) {
 213                 if (lc $ccode eq lc $country) {
 214                         return country::get_country_long($country);
 215                 }
 216         }
 217         return undef;
 218 }
 219
 220 sub mk_banreason($$) {
 221         my ($reason, $ip) = @_;
 222         $reason =~ s/\$/$ip/g;
 223         return $reason;
 224 }
 225
 226 sub check_blacklists($$) {
 227         my ($rnick, $ip) = @_;
 228
 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');
 232                 } else {
 233                         ircd::zline($sbnick, $ip, $conf{'ProxyZlineTime'}, $conf{'TorZlineReason'});
 234                 }
 235                 return 0;
 236         }
 237
 238         if($conf{'EnableOPM'} && check_opm($ip)) {
 239                 ircd::zline($sbnick, $ip, $conf{'ProxyZlineTime'}, mk_banreason($conf{'OPMZlineReason'}, $ip));
 240                 return 0;
 241         }
 242
 243 sub hasGeoCountry() {
 244         return module::is_loaded('country') || module::is_loaded('geoip');
 245 }
 246
 247         if($conf{'BanCountry'} && hasGeoCountry() && (my $country = check_country($ip))) {
 248                 ircd::zline($sbnick, $ip, $conf{'ProxyZlineTime'}, mk_banreason($conf{'CountryZlineReason'}, $country));
 249                 return 0;
 250         }
 251
 252         return 1;
 253 }
 254
 255 sub update_tor_list_timed($) {
 256         my $time = shift;
 257         $time = 3600 unless $time;
 258
 259         add_timer('', $time, __PACKAGE__, 'securitybot::update_tor_list_timed');
 260
 261         update_tor_list();
 262 }
 263
 264 sub update_tor_list() {
 265         return unless (defined($conf{'TorServer'}) && length($conf{'TorServer'}));
 266         diagmsg( " -- Loading Tor server list.");
 267
 268         # path may be a local one if you run a tor-client.
 269         # most configs are /var/lib/tor/cached-directory
 270         my %newtorip;
 271         foreach my $torIP (getTorRouters($conf{'TorServer'})) {
 272                 $newtorip{$torIP} = 1;
 273         }
 274
 275         my $torcount = scalar(keys(%newtorip));
 276
 277         if($torcount > 0) {
 278                 %torip = %newtorip;
 279                 diagmsg( " -- Finished loading Tor server list - $torcount servers found.");
 280         } else {
 281                 diagmsg( " -- Failed to load Tor server list, CHECK YOUR TorServer SETTING.");
 282         }
 283 }
 284
 285 sub msghandle {
 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');
 291                         return;
 292                 }
 293
 294                 if($msg =~ /^help/i) {
 295                         my (undef, @args) = split(/ /, $msg); #discards first token 'help'
 296                         sendhelp($user, 'securitybot', @args);
 297                 }
 298
 299                 elsif($msg =~ /^notice (\S*) (.*)/i) {
 300                         ircd::notice($sbnick, $1, $2);
 301                 }
 302
 303                 elsif($msg =~ /^msg (\S*) (.*)/i) {
 304                         ircd::privmsg($sbnick, $1, $2);
 305                 }
 306
 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');
 310                                 return;
 311                         }
 312                         ircd::ircsend($1);
 313                 }
 314
 315                 elsif($msg =~ /^kill (\S*) (.*)/i) {
 316                         ircd::irckill($sbnick, $1, $2);
 317                 }
 318
 319                 elsif($msg =~ /^conf/i) {
 320                         notice($user, "Configuration:", list_conf);
 321                 }
 322
 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');
 326                                 return;
 327                         }
 328
 329                         my @p = ($1, $2);
 330                         chomp $p[1];
 331
 332                         if(update_conf($p[0], $p[1])) {
 333                                 notice($user, "Configuration: ".$p[0]." = ".$p[1]);
 334                         } else {
 335                                 notice($user, "That value is read-only.");
 336                         }
 337                 }
 338
 339                 elsif($msg =~ /^save/i) {
 340                         notice($user, "Saving configuration.");
 341
 342                         saveconf();
 343                 }
 344
 345                 elsif($msg =~ /^rehash/i) {
 346                         notice($user, "Loading configuration.");
 347
 348                         loadconf(1);
 349                 }
 350
 351                 elsif($msg =~ /^tssync/i) {
 352                         ircd::tssync();
 353                 }
 354
 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');
 358                                 return;
 359                         }
 360                         ircd::svsnick($sbnick, $1, $2);
 361                 }
 362
 363                 elsif($msg =~ /^tor-update/i) {
 364                         notice($user, "Updating Tor server list.");
 365                         update_tor_list();
 366                 }
 367 =cut
 368                 elsif($msg =~ /^ss-update/i) {
 369                         notice($user, "Updating SS definitions.");
 370                         securitybot::ss2tkl::update_ss();
 371                 }
 372 =cut
 373                 elsif($msg =~ /^tkl/i) {
 374                         sb_tkl($user, $msg);
 375                 }
 376 }
 377
 378 sub list_conf() {
 379         my @k = keys(%conf);
 380         my @v = values(%conf);
 381         my @reply;
 382
 383         for(my $i=0; $i<@k; $i++) {
 384                 push @reply, $k[$i]." = ".$v[$i];
 385         }
 386         return @reply;
 387 }
 388
 389 sub noticehandle {
 390         my ($rnick, $dst, $msg) = @_;
 391
 392         if($msg =~ /^\x01(\S+)\s?(.*?)\x01?$/) {
 393                 diagmsg( "Got $1 reply from $rnick: $2");
 394         }
 395 }
 396
 397 sub sb_tkl($$) {
 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'
 402         my $cmd;
 403         (undef, $cmd, $msg) = split(/ /, $msg, 3);
 404         if(lc($cmd) eq 'list') {
 405                 if($msg) {
 406                         sb_tkl_glob($user, $msg);
 407                 }
 408                 else {
 409                         sb_tkl_list($user);
 410                 }
 411         }
 412         elsif(lc($cmd) eq 'del') {
 413                 unless($msg) {
 414                         notice($user, "You have to specify at least one parameter");
 415                 }
 416                 sb_tkl_glob_delete($user, $msg);
 417         }
 418 }
 419
 420 sub sb_tkl_list($) {
 421         my ($user) = @_;
 422         my @reply;
 423         $get_all_tklban->execute();
 424         while(my ($type, $ident, $host, $setter, $expire, $time, $reason) = $get_all_tklban->fetchrow_array()) {
 425                 if($type eq 'Q') {
 426                         #push @reply, "$type $host $setter";
 427                         next;
 428                 }
 429                 else {
 430                         push @reply, "$type $ident\@$host $setter";
 431                 }
 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";
 435         }
 436         $get_all_tklban->finish();
 437         push @reply, "No results" unless @reply;
 438
 439         notice($user, @reply);
 440 }
 441
 442 sub sb_tkl_glob($$) {
 443         my ($user, $cmdline) = @_;
 444
 445         my $sql_expr = "SELECT type, ident, host, setter, expire, time, reason FROM tklban ";
 446
 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 -");
 451                 return;
 452         }
 453         my @args = misc::parse_quoted($parms);
 454
 455         my ($success, $expr) = make_tkl_query(\@filters, \@args);
 456         unless ($success) {
 457                 notice($user, "Error: $expr");
 458                 return;
 459         }
 460         $sql_expr .= $expr;
 461
 462         my @reply;
 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()) {
 466                 if($type eq 'Q') {
 467                         #push @reply, "$type $host $setter";
 468                         next;
 469                 }
 470                 else {
 471                         push @reply, "$type $ident\@$host $setter";
 472                 }
 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";
 476         }
 477         $get_glob_tklban->finish();
 478
 479         push @reply, "No results" unless @reply;
 480         notice($user, @reply);
 481 }
 482
 483 sub sb_tkl_glob_delete($$) {
 484         my ($user, $cmdline) = @_;
 485
 486         my $sql_expr = "SELECT type, ident, host FROM tklban ";
 487
 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 -");
 492                 return;
 493         }
 494         my @args = misc::parse_quoted($parms);
 495
 496         my ($success, $expr) = make_tkl_query(\@filters, \@args);
 497         unless ($success) {
 498                 notice($user, "Error: $expr");
 499                 return;
 500         }
 501
 502         $sql_expr .= $expr;
 503
 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()) {
 508                 if($type eq 'G') {
 509                         ircd::unkline($src, $ident, $host);
 510                 }
 511                 elsif($type eq 'Z') {
 512                         ircd::unzline($src, $host);
 513                 }
 514         }
 515         $get_glob_tklban->finish();
 516
 517 }
 518
 519 sub make_tkl_query($$) {
 520         my ($parm1, $parm2) = @_;
 521         my @filters = @$parm1; my @args = @$parm2;
 522
 523         my ($sign, $sql_expr, $sortby, $where, $and);
 524         while(my $filter = shift @filters) {
 525                 my $condition;
 526                 if ($filter eq '+') {
 527                         $sign = +1;
 528                         next;
 529                 }
 530                 elsif($filter eq '-') {
 531                         $sign = 0;
 532                         next;
 533                 }
 534
 535                 my $parm = shift @args;
 536                 unless (defined($parm)) {
 537                         return (0, "Not enough arguments for filters.");
 538                 }
 539                 if($filter eq 'm') {
 540                         my ($mident, $mhost) = parse_hostmask($parm);
 541                         $mident = glob2sql($dbh->quote($mident)) if $mident;
 542                         $mhost = glob2sql($dbh->quote($mhost)) if $mhost;
 543
 544                         $condition = ($mident ? ($sign ? '' : '!').
 545                                 "(ident LIKE $mident) " : '').
 546                                 ($mhost ? ($sign ? '' : '!').
 547                                 "(host LIKE $mhost) " : '');
 548                 }
 549                 elsif($filter eq 'r') {
 550                         my $reason = $dbh->quote($parm);
 551                         $reason = glob2sql($reason);
 552                         $condition = ($sign ? '' : '!')."(reason LIKE $reason) ";
 553
 554                 }
 555                 elsif($filter eq 's') {
 556                         my $setter = $dbh->quote($parm);
 557                         $setter = glob2sql($setter);
 558                         $condition = ($sign ? '' : '!')."(setter LIKE $setter) ";
 559
 560                 }
 561                 if($filter eq 'M') {
 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) " : '');
 569                 }
 570                 elsif($filter eq 'R') {
 571                         my $reason = $dbh->quote($parm);
 572                         $condition = ($sign ? '' : '!')."(reason REGEXP $reason) ";
 573
 574                 }
 575                 elsif($filter eq 'S') {
 576                         my $setter = $dbh->quote($parm);
 577                         $condition = ($sign ? '' : '!')."(setter REGEXP $setter) ";
 578
 579                 }
 580                 elsif(lc $filter eq 'o') {
 581                         $parm = lc $parm;
 582                         next unless ($parm =~ /(type|ident|host|setter|expire|reason|time)/);
 583                         if ($sortby) {
 584                                 $sortby .= ', ';
 585                         } else {
 586                                 $sortby = 'ORDER BY ';
 587                         }
 588                         $sortby .= $parm.($sign ? ' ASC' : ' DESC');
 589                         next;
 590                 }
 591                 if (!$where) {
 592                         $sql_expr .= 'WHERE ';
 593                         $where = 1;
 594                 }
 595                 if ($and) {
 596                         $sql_expr .= 'AND ';
 597                 } else {
 598                         $and = 1;
 599                 }
 600                 $sql_expr .= $condition if $condition;
 601         }
 602         if (scalar(@args)) {
 603                 return (0, "Too many arguments for filters.");
 604         }
 605         return (1, $sql_expr.((defined $sortby and $sortby ne '') ? $sortby : 'ORDER BY type, time, host'));
 606 }
 607
 608 sub get_tkl_type_name($) {
 609         my %tkltype = (
 610                 G => 'G:line',
 611                 Z => 'GZ:line',
 612                 s => 'Shun',
 613                 Q => 'Q:line',
 614         );
 615         return $tkltype{$_[0]};
 616 };
 617
 618 sub get_filter_action_name($) {
 619         my %filteraction = (
 620                 Z => 'GZ:line',
 621                 S => 'tempshun',
 622                 s => 'shun',
 623                 g => 'G:line',
 624                 z => 'Z:line',
 625                 k => 'K:line',
 626                 K => 'Kill',
 627                 b => 'Block',
 628                 d => 'DCC Block',
 629                 v => 'Virus Chan',
 630                 w => 'Warn',
 631                 #t => 'Test', # Should never show up, and not implemented in 3.2.4 yet.
 632         );
 633         return $filteraction{$_[0]};
 634 };
 635
 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') {
 640                 if ($sign == +1) {
 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';
 648                 }
 649                 elsif($sign == -1) {
 650                         my ($ident, $host, $setter) = @parms;
 651
 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();
 656
 657                                 diagmsg( "$setter removed ".get_tkl_type_name($type)." $ident\@$host ".
 658                                         "set at ".gmtime2($time)." - reason: $reason");
 659                         }
 660
 661                         $del_tklban->execute($type, $ident, $host);
 662                         $del_tklban->finish();
 663                 }
 664         }
 665         elsif($type eq 'F') {
 666                 if($sign == +1) {
 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)")
 672                                         if initial_synced();
 673                 }
 674                 elsif($sign == -1) {
 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();
 681                                 $reason =~ tr/_/ /;
 682                                 diagmsg( "$setter removed Spamfilter (action: ".get_filter_action_name($action).
 683                                         ", targets: $target) (reason: $reason) '$mask' set at: ".gmtime2($time));
 684                         }
 685                         $del_spamfilter->execute($target, $action, $mask);
 686                         $del_spamfilter->finish();
 687                 }
 688         }
 689 }
 690
 691 sub saveconf() {
 692         writeHash(\%conf, "config/securitybot/sb.conf");
 693 }
 694
 695 sub loadconf($) {
 696         my ($update) = @_;
 697
 698         %conf = readHash("config/securitybot/sb.conf");
 699 }
 700
 701 sub update_conf($$) {
 702         my ($k, $v) = @_;
 703
 704         return 0 if($k eq 'EnableTor');
 705
 706         $conf{$k} = $v;
 707         return 1;
 708 }
 709
 710 sub expire_tkl() {
 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();
 718                         }
 719         }
 720         $get_expired_tklban->finish();
 721
 722         $del_expired_tklban->execute();
 723         $del_expired_tklban->finish();
 724 }
 725
 726 sub expire_tkl_timed {
 727         my ($time) = @_;
 728         $time = 10 unless $time;
 729
 730         add_timer('10', $time, __PACKAGE__, "securitybot::expire_tkl_timed");
 731
 732         expire_tkl();
 733 }
 734
 735 sub diagmsg(@) {
 736         ircd::privmsg($sbnick, main_conf_diag, @_);
 737         write_log('diag', '<'.main_conf_local.'>', @_);
 738 }
 739
 740 sub end { }
 741 sub unload { saveconf(); }
 742
 743 1;