robot9000.pl

   1 #!/usr/bin/perl -w
   2 #
   3 #  Enforced originality!  If someone repeats something that has been already
   4 #  said in channel, silence them.  Silence time increasing geometrically.
   5 #
   6 #  Copyright (C) 2007  Dan Boger - zigdon+bot@gmail.com
   7 #  Copyright (C) 2013  Jan Vales - jan@jvales.net (someone@somenet.org)
   8 #
   9 #  This program is free software; you can redistribute it and/or modify
  10 #  it under the terms of the GNU General Public License as published by
  11 #  the Free Software Foundation; either version 2 of the License, or
  12 #  (at your option) any later version.
  13 #
  14 #  This program is distributed in the hope that it will be useful,
  15 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 #  GNU General Public License for more details.
  18 #
  19 #  You should have received a copy of the GNU General Public License
  20 #  along with this program; if not, write to the Free Software Foundation,
  21 #  Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  22 #
  23 # A current copy of this code can be found at:
  24 #
  25 #   http://dev.somenet.org/?p=irc/robot9000.git;a=summary
  26 #
  27 #
  28 # By default, the next mute time never goes down.  To have it decay, set up a
  29 # cronjob such as this:
  30 #
  31 # 0 */6 * * * echo "update users set timeout_power = timeout_power - 1 where timeout_power > 0" | mysql -D databasename
  32 # 0 */6 * * * echo ".timeout 5000 \n update users set timeout_power = timeout_power - 1 where timeout_power > 0" | sqlite3 robot9000.sqlite
  33 #
  34 # This version was adapted to use sqlite instead of mysql!
  35 # It will also create its own tables - no more .sql-file imports
  36
  37 use strict;
  38 use Net::IRC;
  39 use Time::HiRes qw/usleep/;
  40 use DBI;
  41 use Date::Calc qw/Normalize_DHMS/;
  42 use Data::Dumper;
  43 use YAML qw/LoadFile/;
  44
  45 use constant {
  46     DEBUG   => 0,
  47     VERSION => 'robot9000.pl 2013-07-08 somenet'
  48 };
  49
  50 # Load config file - sample file at:
  51 # http://media.peeron.com/tmp/ROBOT9000.yml
  52 my $config_file = shift or die "Usage: $0 <config> [<log file to load>]";
  53 my $config = LoadFile($config_file);
  54
  55 # when is the next time someone should be unbanned?
  56 my $next_unban = 1;
  57
  58 # when should we run the cleanup next?
  59 my $maint_time = time + 20;
  60
  61 # when was the last time we heard *anything*
  62 my $last_public = time;
  63
  64 # some annoying globals
  65 my $topic;
  66 my %nicks;
  67 my %nicks_tmp;
  68 my $nick_re;
  69 my %nick_changes;
  70 my %common_words;
  71 my %sql;
  72 my @lookup_queue;
  73
  74 # what modes are used to deop/op?
  75 my %op_table = ( "%" => "h", "@" => "o", "~" => "q", "&" => "a" );
  76 my %rev_op_table = reverse %op_table;
  77
  78 # connect to the IRC server and the database
  79 my ( $irc, $irc_conn, $dbh ) = &setup(@ARGV ? 0 : 1);
  80
  81 if (@ARGV) {  # we're only loading an existing log file, not actually running
  82   print "Loading log files...\n";
  83   &load_log;
  84 }
  85
  86 &event_loop;
  87
  88 sub logmsg {
  89     print scalar localtime, " - @_\n";
  90     print LOG scalar localtime, " - @_\n",;
  91 }
  92
  93 sub event_loop {
  94
  95     #warn "event_loop (@_)\n";
  96
  97     while (1) {
  98         $irc->do_one_loop();
  99         usleep 50;
 100
 101         if ( $next_unban and time > $next_unban ) {
 102             &process_unbans;
 103         }
 104
 105         if ( time > $maint_time ) {
 106             logmsg "Running maint";
 107             $irc_conn->mode( $config->{irc_chan}, "+m" );
 108
 109             while (@lookup_queue) {
 110                 my @batch = splice( @lookup_queue, 0, $config->{names_request_size} || 5, () );
 111                 logmsg "Looking up hostmasks... ", join ", ", @batch;
 112                 $irc_conn->userhost(@batch);
 113                 usleep 250;
 114             }
 115
 116             foreach ( keys %nick_changes ) {
 117                 next if $nick_changes{$_}[0] + 300 > time;
 118
 119                 logmsg "Clearing nick_changes for $_";
 120                 delete $nick_changes{$_};
 121                 $irc_conn->mode( $config->{irc_chan}, "-b", "~n:$_" );
 122             }
 123
 124             $maint_time = time + 300;
 125
 126             if ( time - $last_public > $config->{fortune_time} + 300 ) {
 127                 logmsg "Seems like we're not connected. restarting";
 128                 exit;
 129             }
 130             elsif ( time - $last_public > $config->{fortune_time} ) {
 131                 $irc_conn->userhost( $config->{irc_nick} );
 132                 logmsg "Too quiet.  Ping?";
 133                 sleep 1;
 134
 135 #                if ( -x $config->{fortune_command} ) {
 136 #                    $irc_conn->privmsg( $config->{irc_chan}, $_ )
 137 #                      foreach ( "It's too quiet:",
 138 #                        split /\n/, `$config->{fortune_command}` );
 139 #                }
 140             }
 141         }
 142     }
 143 }
 144
 145 sub process_unbans {
 146     $sql{get_unbans}->execute(time);
 147     while ( my ( $nick, $userhost, $id, $bantype ) = $sql{get_unbans}->fetchrow_array )
 148     {
 149         next if $nick eq $config->{irc_nick};
 150         logmsg "Restoring $userhost";
 151
 152         if ( $bantype eq 'v' ) {
 153             $irc_conn->mode( $config->{irc_chan}, "+v", $nick );
 154             $nicks{$nick} = "+" unless $nicks{$nick};
 155         }
 156         else {
 157             $irc_conn->mode( $config->{irc_chan}, "+v$op_table{$bantype}",
 158                 $nick, $nick );
 159             $nicks{$nick} = $bantype;
 160         }
 161         $sql{clear_ban}->execute($id);
 162         $sql{clear_ban}->finish;
 163
 164       #$irc_conn->privmsg( $nick, "you may now speak in $config->{irc_chan}." );
 165     }
 166
 167     $sql{next_unban}->execute;
 168     ($next_unban) = $sql{next_unban}->fetchrow_array;
 169     $sql{next_unban}->finish;
 170     $sql{get_unbans}->finish;
 171 }
 172
 173 sub setup {
 174     my $connect = shift;
 175
 176     #warn "setup (@_)\n";
 177     # open our log file
 178     open LOG, ">>", $config->{logfile}
 179       or die "Can't write to $config->{logfile}: $!";
 180     logmsg "Starting up, version", VERSION;
 181     sleep 5;
 182
 183     # connect to the database
 184     logmsg "Connecting to $config->{db_conn_str} User: $config->{db_user}";
 185     my $dbh = DBI->connect( $config->{db_conn_str}, $config->{db_user}, $config->{db_pass}, {RaiseError => 1, AutoCommit => 1} )
 186       or die "Can't connect to the database!";
 187
 188     logmsg "Creating tables, if needed";
 189     $sql{create_table_lines} = $dbh->prepare("CREATE TABLE IF NOT EXISTS lines ( id integer primary key autoincrement, msg text NOT NULL );");
 190     $sql{create_table_lines}->execute;
 191     $sql{create_table_lines}->finish;
 192
 193     $sql{create_table_users} = $dbh->prepare("CREATE TABLE IF NOT EXISTS users (
 194   id integer primary key autoincrement,
 195   mask varchar(255) default NULL,
 196   nick varchar(64) NOT NULL default '',
 197   timeout_power int(10)  NOT NULL default '0',
 198   banned_until int(10)  NOT NULL default '0',
 199   ban_type char(1) NOT NULL default 'v',
 200   lines_talked int(10)  NOT NULL default '0',
 201   total_bans int(10)  NOT NULL default '0',
 202   word_count int(10)  NOT NULL default '0',
 203   last_talk timestamp NOT NULL default CURRENT_TIMESTAMP,
 204   user_status int(3)  NOT NULL default '0'
 205 );");
 206     $sql{create_table_users}->execute;
 207     $sql{create_table_users}->finish;
 208
 209     $sql{create_idx_lines_msg} = $dbh->prepare("CREATE INDEX IF NOT EXISTS idx_lines_msg on lines ( msg );");
 210     $sql{create_idx_lines_msg}->execute;
 211     $sql{create_idx_lines_msg}->finish;
 212
 213     $sql{create_idx_users_mask} = $dbh->prepare("CREATE INDEX IF NOT EXISTS idx_users_mask on users ( mask );");
 214     $sql{create_idx_users_mask}->execute;
 215     $sql{create_idx_users_mask}->finish;
 216
 217
 218     logmsg "Preparing SQL statements";
 219     $sql{lookup_line} = $dbh->prepare(
 220         "select id from lines
 221           where msg = ?
 222           limit 1;"
 223     );
 224     $sql{add_line} = $dbh->prepare(
 225         "insert into lines (msg)
 226          values (?)"
 227     );
 228     $sql{lookup_user} = $dbh->prepare(
 229         "select timeout_power, banned_until from users
 230           where mask = ?
 231           limit 1;"
 232     );
 233     $sql{lookup_mask} = $dbh->prepare(
 234         "select mask
 235            from users
 236           where nick = ?
 237           order by last_talk desc
 238           limit 1"
 239     );
 240     $sql{update_user} = $dbh->prepare(
 241         "update users
 242             set timeout_power = timeout_power + 2,
 243                 banned_until = ?,
 244                 nick = ?,
 245                 total_bans = total_bans + 1,
 246                 ban_type = ?
 247           where mask = ?"
 248 #          limit 1"
 249     );
 250     $sql{update_nick} = $dbh->prepare(
 251         "update users
 252             set nick = ?
 253           where mask = ?"
 254 #          limit 1"
 255     );
 256     $sql{add_user} = $dbh->prepare(
 257         "insert into users (banned_until, nick, mask, timeout_power,
 258                             lines_talked, total_bans, ban_type)
 259          values (?, ?, ?, ?, 0, 0, ?)"
 260     );
 261     $sql{user_talk} = $dbh->prepare(
 262         "update users
 263             set lines_talked = lines_talked + 1,
 264                 word_count   = word_count + ? + 1,
 265                 last_talk    = CURRENT_TIMESTAMP
 266           where mask = ?"
 267 #          limit 1"
 268     );
 269     $sql{next_unban} = $dbh->prepare(
 270         "select min(banned_until)
 271            from users
 272           where banned_until > 0"
 273     );
 274     $sql{get_unbans} = $dbh->prepare(
 275         "select nick, mask, id, ban_type
 276            from users
 277           where banned_until > 0
 278             and banned_until <= ?"
 279     );
 280     $sql{clear_ban} = $dbh->prepare(
 281         "update users
 282             set banned_until = 0
 283           where id = ?"
 284     );
 285     $sql{high_score} = $dbh->prepare(
 286         "select nick, lines_talked/word_count * lines_talked/(total_bans + 1) as score
 287          from users
 288          order by lines_talked/word_count * lines_talked/(total_bans + 1) desc, lines_talked desc
 289          limit 1"
 290     );
 291
 292     return ( $irc, $irc_conn, $dbh ) unless $connect;
 293
 294     # log into IRC
 295     logmsg "Connecting irc://$config->{irc_nick}\@$config->{irc_server}";
 296     $irc = new Net::IRC;
 297     my $irc_conn = $irc->newconn(
 298         Nick     => $config->{irc_nick},
 299         Server   => $config->{irc_server},
 300         Ircname  => $config->{irc_name},
 301         Username => $config->{irc_username} || "ROBOT9000",
 302     );
 303
 304     if (DEBUG) {
 305         open DEBUG_FH, ">>$config->{logfile}.debug"
 306           or die "Can't write to $config->{logfile}.debug: $!";
 307         $irc_conn->add_default_handler( \&dump_event );
 308     }
 309
 310     # talk events
 311     $irc_conn->add_handler( public  => \&irc_on_public );
 312     $irc_conn->add_handler( caction => \&irc_on_public );
 313     $irc_conn->add_handler( notice  => \&irc_on_notice );
 314     $irc_conn->add_handler( msg     => \&irc_on_msg );
 315
 316     # user events
 317     $irc_conn->add_handler( nick => \&irc_on_nick );
 318     $irc_conn->add_handler( join => \&irc_on_joinpart );
 319     $irc_conn->add_handler( part => \&irc_on_joinpart );
 320     $irc_conn->add_handler( quit => \&irc_on_joinpart );
 321
 322     # server events
 323     $irc_conn->add_handler( endofmotd  => \&irc_on_connect );
 324     $irc_conn->add_handler( nomotd     => \&irc_on_connect );
 325     $irc_conn->add_handler( topic      => \&irc_on_topic );
 326     $irc_conn->add_handler( namreply   => \&irc_on_names );
 327     $irc_conn->add_handler( endofnames => \&irc_on_endnames );
 328     $irc_conn->add_handler( mode       => \&irc_on_mode );
 329     $irc_conn->add_handler( userhost   => \&irc_on_userhost );
 330     $irc_conn->add_handler(
 331         chanoprivsneeded => sub {
 332             logmsg "Reauthing to nickserv";
 333             $irc_conn->privmsg( "nickserv", "identify $config->{irc_pass}" );
 334         }
 335     );
 336
 337     logmsg "Setup complete";
 338
 339     logmsg "Loading common words...";
 340     open( WORDS, $config->{common_file} )
 341       or die "Can't read $config->{common_file}: $!";
 342     while (<WORDS>) {
 343         chomp;
 344         $common_words{ lc $_ } = 1;
 345     }
 346     close WORDS;
 347     logmsg "Loaded ", scalar keys %common_words, " words";
 348
 349     return ( $irc, $irc_conn, $dbh );
 350 }
 351
 352 # event handlers
 353 sub irc_on_connect {
 354
 355     #warn "irc_on_connect (@_)\n";
 356     my ( $self, $event ) = @_;
 357
 358     logmsg "Connected to IRC, joining $config->{irc_chan}";
 359     $self->join( $config->{irc_chan} );
 360
 361     logmsg "Authenticating";
 362     $self->privmsg( "nickserv", "identify $config->{irc_pass}" );
 363
 364     sleep 2;
 365     $irc_conn->names;
 366 }
 367
 368 sub irc_on_notice {
 369     my ( $self, $event ) = @_;
 370     my ( $nick, $msg ) = ( $event->nick, $event->args );
 371
 372     logmsg "Notice from $nick to " . @{ $event->to }[0] . ": $msg";
 373     return if ${ $event->to }[0] ne $config->{irc_chan};
 374
 375     &fail( $self, $nick, $event->userhost,
 376         "Failed for sending notices to channel" );
 377 }
 378
 379 sub irc_on_msg {
 380
 381     #warn "irc_on_msg (@_)\n";
 382     my ( $self, $event ) = @_;
 383     my ( $nick, $msg ) = ( $event->nick, $event->args );
 384     my @args;
 385     ( $msg, @args ) = split ' ', $msg;
 386
 387     return if $nick eq $config->{irc_nick};
 388
 389     logmsg "PRIVMSG $nick($nicks{$nick}): $msg @args";
 390     if ( lc $msg eq 'version' ) {
 391         $self->privmsg( $nick, VERSION );
 392     }
 393     elsif ( lc $msg eq 'timeout' ) {
 394         my ( $timeout, $banned_until );
 395         if ( $args[0] ) {
 396             if ( $sql{lookup_mask}->execute( $args[0] ) > 0 ) {
 397                 my ($mask) = $sql{lookup_mask}->fetchrow_array;
 398                 $sql{lookup_mask}->finish;
 399                 ( $timeout, $banned_until ) = &get_timeout($mask);
 400             }
 401         }
 402         else {
 403             ( $timeout, $banned_until ) = &get_timeout( $event->userhost );
 404         }
 405
 406         if ($timeout) {
 407             $timeout = &timeout_to_text( 2**( $timeout + 2 ) );
 408
 409             $self->privmsg( $nick, "Next timeout will be $timeout" );
 410
 411             if ($banned_until) {
 412                 $self->privmsg( $nick,
 413                     "Currently muted, can speak again in "
 414                       . &timeout_to_text( $banned_until - time ) );
 415             }
 416         }
 417         else {
 418             $self->privmsg( $nick, "No timeout found" );
 419         }
 420     }
 421     elsif (
 422         (
 423             exists $config->{auth}{ lc $nick }
 424             and $event->userhost =~ /$config->{auth}{ lc $nick }/
 425         )
 426         or $nicks{$nick} =~ /[~@&%]/
 427       )
 428     {
 429         logmsg "AUTH $nick: $msg ($nicks{$nick})";
 430         if ( $msg eq 'quit' ) {
 431             $self->privmsg( $nick, "Quitting" );
 432             exit;
 433         }
 434         elsif ( $msg eq 'msg' and exists $config->{auth}{ lc $nick } ) {
 435             $self->privmsg( $nick, "Ok - sending $args[0]: @args[1..$#args]" );
 436             $self->privmsg( $args[0], join " ", @args[ 1 .. $#args ] );
 437             logmsg "Sending MSG to $args[0]: @args[1..$#args]";
 438         }
 439         elsif ( $msg eq 'unban' ) {
 440             logmsg "Unbanning $args[0] by command";
 441             $self->mode( $config->{irc_chan}, "-b", $args[0] );
 442         }
 443         elsif ( $msg eq 'mode' ) {
 444             logmsg "Setting mode @args by command";
 445             $self->mode( $config->{irc_chan}, @args );
 446         }
 447         elsif ( $msg eq 'kick' ) {
 448             logmsg "Kicking $args[0] by command";
 449             $self->kick(
 450                 $config->{irc_chan}, $args[0],
 451                 $args[1]
 452                 ? join " ",
 453                 $args[ 1 .. $#args ]
 454                 : "Kick"
 455             );
 456         }
 457         elsif ( $msg eq 'fail' and $args[0] =~ /([^!]+)!(\S+)/ ) {
 458             logmsg "Failing $1!$2 by command";
 459             &fail(
 460                 $self, $1, $2,
 461                 "Failed by a live moderator",
 462                 "$nick failed $args[0]: @args[1..$#args]"
 463             );
 464         }
 465         elsif ( $msg eq 'nick_re' ) {
 466             logmsg "Current nick re: $nick_re";
 467             $self->privmsg( $nick, "Ok, logged" );
 468         }
 469         elsif ( $msg eq 'names' ) {
 470             logmsg "Current names: ", join ", ",
 471               map { "$_($nicks{$_})" } sort keys %nicks;
 472             $self->privmsg( $nick, "Current names: ",
 473                 join ", ", map { "$_($nicks{$_})" } sort keys %nicks );
 474         }
 475         elsif ( $msg eq 'fail' ) {
 476             if ( $sql{lookup_mask}->execute( $args[0] ) > 0 ) {
 477                 my ($mask) = $sql{lookup_mask}->fetchrow_array;
 478                 $sql{lookup_mask}->finish;
 479                 logmsg "Failing $args[0]!$mask by command";
 480                 &fail(
 481                     $self, $args[0], $mask,
 482                     "Failed by a live moderator",
 483                     "$nick failed $args[0]: @args[1..$#args]"
 484                 );
 485             }
 486             else {
 487                 logmsg "Couldn't find mask for -${args[0]}-";
 488             }
 489         }
 490         elsif ( $msg eq 'check' ) {
 491             logmsg "Checking for pending mutes to restore";
 492             $self->privmsg( $nick, "Ok, processing mutes to restore" );
 493             &process_unbans;
 494         }
 495         else {
 496             foreach (
 497                 "Commands: timeout - query if you're banned, and what your next ban will be",
 498                 "          timeout <nick> - same, for someone else",
 499                 "          unban   - unban given nickmask",
 500                 "          check   - check if there are any pending unmutes",
 501                 "          kick <nick> <msg> - kick someone",
 502                 "          names - list the currently known privs of users in channel",
 503                 "          fail <nick> <msg> - have the moderator manually silence <nick>",
 504                 "          version        - report current version",
 505               )
 506             {
 507                 $self->privmsg( $nick, $_ );
 508             }
 509         }
 510     }
 511     else {
 512         foreach (
 513 "Commands: timeout <nick> - query if you're banned, and what your next ban will be",
 514             "          version        - report current version",
 515           )
 516         {
 517             $self->privmsg( $nick, $_ );
 518         }
 519         logmsg "Ignoring PRIVMSG from $nick ", $event->userhost;
 520     }
 521
 522 }
 523
 524 # public msg - someone talking in chat
 525 sub irc_on_public {
 526
 527     #warn "irc_on_public (@_)\n";
 528     my ( $self, $event ) = @_;
 529     my ( $nick, $userhost ) = ( $event->nick, $event->userhost );
 530     my ($msg) = ( $event->args );
 531
 532     $last_public = time;
 533     if ( $nick eq $config->{irc_nick} ) {
 534         logmsg "*** Still connected, it seems";
 535         return;
 536     }
 537
 538     logmsg "$nick: $msg";
 539     my $length = length $msg;
 540
 541     # process the message so that we strip them down
 542     $msg = &strip($msg);
 543
 544     if (   $length == 0
 545         or $length > 10 and length($msg) / $length < $config->{signal_ratio} )
 546     {
 547         &fail(
 548             $self, $nick, $userhost,
 549             "Not enough content",
 550             "Not enough content: " . length($msg) . " vs $length"
 551         );
 552         return;
 553     }
 554
 555     # check if the line was already in the DB
 556         my $lineID;
 557     my $res = $sql{lookup_line}->execute($msg);
 558     ($lineID) = $sql{lookup_line}->fetchrow_array;
 559     $sql{lookup_line}->finish;
 560
 561     if ( defined $lineID ) {
 562         # kick!
 563         &fail( $self, $nick, $userhost );
 564     }
 565     else {
 566         # add it as a new line
 567         $sql{add_line}->execute($msg);
 568         $sql{add_line}->finish;
 569
 570         my $words = ( $msg =~ tr/ / / );
 571         if ( $sql{user_talk}->execute( $words, $userhost ) == 0 ) {
 572             $sql{add_user}->execute( 0, $nick, $userhost, 0, "v" );
 573             $sql{add_user}->finish;
 574             $sql{user_talk}->execute( $words, $userhost );
 575             $sql{user_talk}->finish;
 576         }
 577         $sql{user_talk}->finish;
 578     }
 579 }
 580
 581 sub strip {
 582     my $msg = shift;
 583
 584     # remove case
 585     $msg = lc $msg;
 586
 587     # remove addressing nicks:
 588     $msg =~ s/^\S+: ?//;
 589
 590     # remove any nicks referred to
 591     $msg =~ s/(?:^|\b)(?:$nick_re)(?:\b|$)/ /g if $nick_re;
 592
 593     # remove control chars
 594     $msg =~ s/[[:cntrl:]]//g;
 595
 596     # remove smilies
 597     $msg =~
 598 s/(?:^|\s)(?:[[:punct:]]+\w|[[:punct:]]+\w|[[:punct:]]+\w[[:punct:]]+)(?:\s|$)/ /g;
 599
 600     # remove punct
 601     $msg =~ s/([a-zA-Z])'([a-zA-Z])/$1$2/g;
 602     $msg =~ s/[^a-zA-Z\d -]+/ /g;
 603
 604     # remove lone '-'
 605     $msg =~ s/(?<!\w)-+|-+(?!\w)/ /g;
 606
 607     # repeating chars
 608     $msg =~ s/(.)\1{2,}/$1$1/g;
 609     $msg =~ s/(..)\1{2,}/$1$1/g;
 610
 611     # removing leading/trailing/multiple spaces
 612     $msg =~ s/^\s+|\s+$//g;
 613     $msg =~ s/\s\s+/ /g;
 614
 615     return $msg;
 616 }
 617
 618 sub get_timeout {
 619     my $mask = shift;
 620
 621     $sql{lookup_user}->execute($mask);
 622     my ( $timeout, $banned_until ) = $sql{lookup_user}->fetchrow_array;
 623     $sql{lookup_user}->finish;
 624
 625     return ( $timeout, $banned_until );
 626 }
 627
 628 sub timeout_to_text {
 629     my $timeout = shift;
 630
 631     my ( $dd, $dh, $dm, $ds ) = Normalize_DHMS( 0, 0, 0, $timeout );
 632     my $delta_text;
 633     $delta_text .= "$dd day" .    ( $dd == 1 ? " " : "s " ) if $dd;
 634     $delta_text .= "$dh hour" .   ( $dh == 1 ? " " : "s " ) if $dh;
 635     $delta_text .= "$dm minute" . ( $dm == 1 ? " " : "s " ) if $dm;
 636     $delta_text .= "$ds second" . ( $ds == 1 ? " " : "s " ) if $ds;
 637     $delta_text =~ s/ $//;
 638
 639     return $delta_text;
 640 }
 641
 642 # fail - silence for 2**2n
 643 sub fail {
 644     my ( $self, $nick, $userhost, $msg, $opmsg ) = @_;
 645
 646     logmsg "Failing $nick ($userhost)";
 647     logmsg "msg: $msg"     if $msg;
 648     logmsg "opmsg: $opmsg" if $opmsg;
 649
 650     # look up the last timeout value for this userhost, default is 1
 651     my ( $timeout, $banned_until ) = &get_timeout($userhost);
 652
 653     $timeout += 2;
 654
 655     # someone abusing the system in some way
 656     if ( 2**$timeout > $config->{timeout_limit} ) {
 657         logmsg "Kickbanning $nick ($userhost)";
 658         $self->notice( $config->{irc_chan}, "$nick, thanks for playing!" );
 659         $self->mode( $config->{irc_chan}, "+b", $userhost );
 660         $self->kick( $config->{irc_chan}, $nick, "Go away" );
 661         return;
 662     }
 663
 664     my $delta_text = &timeout_to_text( 2**$timeout );
 665
 666     if ($msg) {
 667         $self->notice( $config->{irc_chan},
 668             "$nick, you have been muted for $delta_text: $msg" );
 669         $self->notice( "\@$config->{irc_chan}", $opmsg ) if $opmsg;
 670     }
 671     elsif ( not $banned_until or $banned_until <= 1 ) {
 672         $self->notice( $config->{irc_chan},
 673             "$nick, you have been muted for $delta_text." );
 674         $self->notice( "\@$config->{irc_chan}", $opmsg ) if $opmsg;
 675     }
 676
 677     my $bantype = "v";
 678     if ( not $nicks{$nick} or $nicks{$nick} eq '+' or $nicks{$nick} eq '1' ) {
 679         $self->mode( $config->{irc_chan}, "-v", $nick );
 680     }
 681     else {
 682         if ( exists $op_table{ $nicks{$nick} } ) {
 683             logmsg "$nick is an operator ($nicks{$nick}) - deopping first (-$op_table{$nicks{$nick}})";
 684             $self->mode( $config->{irc_chan}, "-v$op_table{$nicks{$nick}}",
 685                 $nick, $nick );
 686         }
 687         else {
 688             logmsg "$nick is an operator ($nicks{$nick}) - can't deop";
 689             $self->mode( $config->{irc_chan}, "-v", $nick );
 690         }
 691         $bantype = $nicks{$nick};
 692     }
 693
 694     my $target = time + 2**$timeout;
 695
 696     if ($sql{update_user}->execute( $target, $nick, $bantype, $userhost ) == 0 )
 697     {
 698         $sql{add_user}->execute( $target, $nick, $userhost, 2, $bantype );
 699         $sql{add_user}->finish;
 700     }
 701     $sql{update_user}->finish;
 702     logmsg "Silenced for " . ( 2**$timeout ) . " seconds";
 703
 704     if ( not $next_unban or $target < $next_unban ) {
 705         $next_unban = $target;
 706     }
 707
 708     # if someone gets failed while already muted, just punt them
 709     if ( $banned_until and $banned_until > 1 and
 710          (not defined $msg or $msg ne 'Failed by a live moderator') ) {
 711         $self->kick( $config->{irc_chan}, $nick, "Come back later" );
 712         logmsg "Kicking $nick for getting muted while muted";
 713     }
 714 }
 715
 716 sub kick {
 717
 718     #warn "kick (@_)\n";
 719     my ( $self, $nick, $userhost, $msg ) = @_;
 720
 721     &fail( $self, $nick, $userhost, $msg );
 722
 723     $msg ||= "Go away";
 724
 725     logmsg "Kicking $nick ($userhost): $msg";
 726
 727     $self->kick( $config->{irc_chan}, $nick, $msg );
 728 }
 729
 730 sub load_log {
 731     while (<>) {
 732
 733         # http://isomerica.net/~xkcd/#xkcd.log
 734         # 20:50 <@zigdon> oh, right, he can't actually kick you
 735         # 20:56  * zigdon tests
 736         #
 737
 738         next unless s/.*?[>*] //;
 739         chomp;
 740
 741         my $msg = &strip($_);
 742
 743             my $lineID;
 744         my $res = $sql{lookup_line}->execute($msg);
 745         ($lineID) = $sql{lookup_line}->fetchrow_array;
 746         $sql{lookup_line}->finish;
 747
 748         next if defined $lineID;
 749         print "$msg\n";
 750         $sql{add_line}->execute($msg);
 751         $sql{add_line}->finish;
 752     }
 753     exit;
 754 }
 755
 756 sub update_nick_re {
 757     $nick_re = $config->{irc_nick};
 758     $nick_re .= "|\Q$_\E"
 759       foreach grep { not exists $common_words{$_} } keys %nicks;
 760     $nick_re = qr/$nick_re/i;
 761
 762     #logmsg "Nick_re = $nick_re";
 763 }
 764
 765 sub irc_on_nick {
 766     my ( $self, $event ) = @_;
 767     my ( $oldnick, $newnick, $userhost ) =
 768       ( lc $event->nick, $event->args, $event->userhost );
 769     $newnick = lc $newnick;
 770
 771     $last_public = time;
 772
 773     $nicks{$newnick} = $nicks{$oldnick};
 774     delete $nicks{$oldnick};
 775
 776     # if they're banned, we need to update the table with their new nick
 777     if ( $sql{update_nick}->execute( $newnick, $userhost ) > 0 ) {
 778         logmsg "Nick updated in database";
 779     }
 780     $sql{update_nick}->finish;
 781
 782 # if someone changes nicks too often (more than 3 times in a maint period), that's a fail
 783     if ( exists $nick_changes{$userhost} ) {
 784         $nick_changes{$userhost}[0] = time;
 785
 786         if ( $nick_changes{$userhost}[1]++ > 1 ) {
 787             my ( $timeout, $banned_until );
 788             if ( ( $timeout, $banned_until ) = &get_timeout($userhost)
 789                 and $banned_until )
 790             {
 791                 $self->mode( $config->{irc_chan}, "+b", "~n:$userhost" );
 792                 &fail( $self, $newnick, $userhost,
 793                     "Failed for changing nicks too often" );
 794             }
 795         }
 796         elsif ( $nick_changes{$userhost}[1] > 5 ) {
 797             &kick( $self, $newnick );
 798         }
 799     }
 800     else {
 801         $nick_changes{$userhost} = [ time, 1 ];
 802     }
 803
 804     logmsg
 805       "$oldnick is now known as $newnick ($nick_changes{$userhost}[1] since ",
 806       scalar localtime $nick_changes{$userhost}[0], ")";
 807     &update_nick_re;
 808 }
 809
 810 sub irc_on_joinpart {
 811     my ( $self, $event ) = @_;
 812     my ($nick) = lc $event->nick;
 813
 814     $last_public = time;
 815
 816     my $action;
 817     if ( $event->{type} eq 'join' ) {
 818         $nicks{$nick} = 1;
 819         $action = "joined";
 820
 821         # make sure the DB has the correct nick for this user
 822         $sql{update_nick}->execute( $nick, $event->userhost );
 823         $sql{update_nick}->finish;
 824
 825         # if this is a new user, give them voice after a minute (disabled)
 826         # if it's an existing user, and they're not currently banned, give them
 827         # voice immediately
 828         if ( $sql{lookup_user}->execute( $event->userhost ) > 0
 829             or not $config->{welcome_msg} )
 830         {
 831             my ( $power, $ban ) = $sql{lookup_user}->fetchrow_array;
 832             $sql{lookup_user}->finish;
 833             unless ($ban) {
 834                         if (not $nick eq $config->{irc_nick})
 835                                 {
 836                     $irc_conn->mode( $config->{irc_chan}, "+v", $nick );
 837                     $nicks{$nick} = "+" unless $nicks{$nick};
 838                             }
 839             }
 840         }
 841         else {
 842             $sql{add_user}->execute( time + $config->{welcome_time},
 843                 $nick, $event->userhost, 0, "v" );
 844             $sql{add_user}->finish;
 845             if ( not $next_unban
 846                 or time + $config->{welcome_time} < $next_unban )
 847             {
 848                 $next_unban = time + $config->{welcome_time};
 849             }
 850             $irc_conn->privmsg( $nick, $config->{welcome_msg} );
 851         }
 852     }
 853     else {
 854         delete $nicks{$nick};
 855         $action = "left";
 856     }
 857     logmsg "$nick has $action the channel";
 858     &update_nick_re;
 859 }
 860
 861 sub irc_on_names {
 862     my ( $self, $event ) = @_;
 863     my ( $nick, $mynick ) = ( $event->nick, $self->nick );
 864     my ($names) = ( $event->args )[3];
 865
 866     print "Event: $_[1]->{type}\n";
 867     print DEBUG_FH Dumper [ @_[ 1 .. $#_ ] ] if DEBUG;
 868
 869     %nicks_tmp =
 870       ( %nicks_tmp, map { s/^(\W)//; ( $_ => $1 ? $1 : 1 ) } split ' ',
 871         $names );
 872     logmsg "Got more names - current total: ", scalar keys %nicks_tmp;
 873 }
 874
 875 sub irc_on_endnames {
 876     my ( $self, $event ) = @_;
 877
 878     print "Event: $_[1]->{type}\n";
 879     print DEBUG_FH Dumper [ @_[ 1 .. $#_ ] ] if DEBUG;
 880
 881     if ( keys %nicks_tmp ) {
 882         %nicks     = (%nicks_tmp);
 883         %nicks_tmp = ();
 884         &update_nick_re;
 885
 886         # look up everyone without a voice, see if they should be +v'ed
 887         foreach my $nick ( keys %nicks ) {
 888             next if $nicks{$nick} ne '1' or $nick eq $config->{irc_nick};
 889             push @lookup_queue, $nick;
 890         }
 891     }
 892
 893     logmsg "Names done - in channel: ", join ", ",
 894       map { "$_($nicks{$_})" } sort keys %nicks;
 895 }
 896
 897 # we asked the userhost of a nick - this means we want to know if they should
 898 # be +v'ed.
 899 sub irc_on_userhost {
 900     my ( $self, $event ) = @_;
 901     my @users = split ' ', ( $event->args )[1];
 902
 903     $last_public = time;
 904 #    logmsg "userhost reply for: ", join ", ", @users;
 905
 906     foreach my $user (@users) {
 907         my ( $nick, $mask ) = split /=\+/, $user;
 908                 next if $nick eq $config->{irc_nick};
 909
 910         logmsg "looking up $nick for possible +v";
 911         $sql{lookup_user}->execute($mask);
 912         my ( $timeout, $banned_until ) = $sql{lookup_user}->fetchrow_array;
 913         $sql{lookup_user}->finish;
 914
 915         next if $banned_until and $banned_until > time;
 916         $self->mode( $config->{irc_chan}, "+v", $nick );
 917         $nicks{$nick} = "+" unless $nicks{$nick};
 918         logmsg "restoring ${nick}'s +v";
 919     }
 920 }
 921
 922 sub irc_on_topic {
 923     my ( $self, $event ) = @_;
 924
 925     $topic = ( $event->args )[2];
 926     logmsg "Topic updated to '$topic'";
 927 }
 928
 929 sub irc_on_mode {
 930     my ( $self, $event ) = @_;
 931
 932     $last_public = time;
 933     logmsg "Mode from", $event->nick, ":", $event->args;
 934
 935     return if $event->nick eq $config->{irc_nick};
 936
 937     my ( $mode, @nicks ) = ( $event->args );
 938     while ( ( $event->nick eq 'ChanServ' or
 939             ( $nicks{ $event->nick } and $nicks{ $event->nick } =~ /[@&~]/ ) )
 940         and $mode =~ s/([-+])([hoqa])/$1/
 941         and my $nick = shift @nicks )
 942     {
 943         if ( $1 eq '+' ) {
 944             if ( exists $rev_op_table{$2} ) {
 945                 logmsg "Marking $nick as an op ($2 - $rev_op_table{$2})";
 946                 $nicks{$nick} = $rev_op_table{$2};
 947             }
 948             else {
 949                 logmsg "Marking $nick as an op ($2 - unknown ~)";
 950                 $nicks{$nick} = "~";
 951             }
 952         }
 953         else {
 954             logmsg "Unmarking $nick as an op ($2 - $rev_op_table{$2})";
 955             $nicks{$nick} = "+";
 956         }
 957     }
 958 }
 959
 960 sub dump_event {
 961     logmsg "Event: $_[1]->{type} from ", $_[1]->nick, " (",
 962       join( ", ", $_[1]->args ), ")\n";
 963     print DEBUG_FH Dumper [ @_[ 1 .. $#_ ] ] if DEBUG;
 964 }
 965