Code / Perl / 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. #  
  8. #  This program is free software; you can redistribute it and/or modify
  9. #  it under the terms of the GNU General Public License as published by
  10. #  the Free Software Foundation; either version 2 of the License, or
  11. #  (at your option) any later version.
  12. #  
  13. #  This program is distributed in the hope that it will be useful,
  14. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. #  GNU General Public License for more details.
  17. #  
  18. #  You should have received a copy of the GNU General Public License
  19. #  along with this program; if not, write to the Free Software Foundation,
  20. #  Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21. #
  22.  
  23. use strict;
  24. use Net::IRC;
  25. use Time::HiRes qw/usleep/;
  26. use DBI;
  27. use Date::Calc qw/Normalize_DHMS/;
  28. use Data::Dumper;
  29.  
  30. my">my $DEBUG = 0;
  31.  
  32. # IRC info
  33. my">my $irc_server       = "irc.example.com";
  34. my">my $irc_chan         = "#xkcd-signal";
  35. my">my $irc_nick         = "botname";
  36. my">my $irc_pass         = "botpass";
  37. my">my $irc_name         = "I AM MODERATOR";
  38. my">my $irc_nick_default = $irc_nick;
  39.  
  40. # Database info
  41. my">my $db_name          = "schema_name";
  42. my">my $db_user          = "database_user";
  43. my">my $db_pass          = "sekret";
  44.  
  45. # Other settings
  46. my">my $logfile = "/path/to/logfile";
  47. my">my $next_unban = 1;
  48. my">my $maint_time = time + 20;
  49.  
  50. # Authorized users
  51. my">my %auth = (
  52.     zigdon => 'user@hostmask.example.com',
  53.     xkcd   => 'other@hostmask2.example.com',
  54. );
  55.  
  56. my">my $topic;
  57. my">my %sql;
  58. my">my %nicks;
  59. my">my $nick_re;
  60. my">my %nick_changes;
  61. my">my ( $irc, $irc_conn, $dbh ) = &setup;
  62.  
  63. $irc_conn->names;
  64. &event_loop;
  65.  
  66. sub logmsg {
  67.     print scalar localtime, " - @_n";
  68.     print LOG scalar localtime, " - @_n",;
  69. }
  70.  
  71. sub event_loop {
  72.  
  73.     #warn "event_loop (@_)n";
  74.     while (1) {
  75.         $irc->do_one_loop();
  76.         usleep 50;
  77.  
  78.         if ( $next_unban and">and time > $next_unban ) {
  79.             &process_unbans;
  80.         }
  81.  
  82.         if ( time > $maint_time ) {
  83.             logmsg "Running maint";
  84.  
  85.             foreach ( keys %nick_changes ) {
  86.                 next">next if $nick_changes{$_}[0] + 300 > time;
  87.  
  88.                 logmsg "Clearing nick_changes for $_";
  89.                 delete $nick_changes{$_};
  90.             }
  91.  
  92.             if (0) {
  93.  
  94.                 #$irc_conn->debug(1);
  95.                 $irc_conn->privmsg( 'nickserv', "status " . join " ",
  96.                     keys %nicks );
  97.  
  98.                 $sql{high_score}->execute;
  99.                 my">my ( $hi_nick, $hi_score ) = $sql{high_score}->fetchrow_array;
  100.                 $sql{high_score}->finish;
  101.                 logmsg "High score: $hi_nick, $hi_score";
  102.  
  103.                 my">my $oldtopic = $topic;
  104.                 $topic =~ s/High score:(?: S+ S+)? |/High score: $hi_nick $hi_score |/;
  105.                 if ( $topic ne $oldtopic ) {
  106.                     logmsg "Setting topic to $topic";
  107.                     $irc_conn->topic( $irc_chan, $topic );
  108.                 }
  109.             }
  110.  
  111.             $maint_time = time + 300;
  112.         }
  113.     }
  114. }
  115.  
  116. sub process_unbans {
  117.     $sql{get_unbans}->execute(time);
  118.     while ( my">my ( $nick, $userhost, $id ) = $sql{get_unbans}->fetchrow_array ) {
  119.         logmsg "Restoring $userhost";
  120.         $irc_conn->mode( $irc_chan, "+v", $nick );
  121.         $sql{clear_ban}->execute($id);
  122.  
  123.         #$irc_conn->privmsg( $nick, "you may now speak in $irc_chan." );
  124.     }
  125.  
  126.     $sql{next_unban}->execute;
  127.     ($next_unban) = $sql{next_unban}->fetchrow_array;
  128.     $sql{next_unban}->finish;
  129. }
  130.  
  131. sub setup {
  132.  
  133.     #warn "setup (@_)n";
  134.     # open our log file
  135.     open LOG, ">>$logfile" or die "Can't write to $logfile: $!";
  136.     logmsg "Starting up";
  137.     sleep 5;
  138.  
  139.     # log into IRC
  140.     logmsg "Connecting irc://$irc_nick";
  141.     $irc = new Net::IRC;
  142.     my">my $irc_conn = $irc->newconn(
  143.         Nick     => $irc_nick,
  144.         Server   => $irc_server,
  145.         Ircname  => $irc_name,
  146.     );
  147.  
  148.     if ($DEBUG) {
  149.         open DEBUG, ">>$logfile.debug"
  150.           or die "Can't write to $logfile.debug: $!";
  151.         $irc_conn->add_default_handler( &dump_event );
  152.     }
  153.  
  154.     # talk events
  155.     $irc_conn->add_handler( public  => &irc_on_public );
  156.     $irc_conn->add_handler( caction => &irc_on_public );
  157.     $irc_conn->add_handler( notice  => &irc_on_notice );
  158.     $irc_conn->add_handler( msg     => &irc_on_msg );
  159.  
  160.     # user events
  161.     $irc_conn->add_handler( nick => &irc_on_nick );
  162.     $irc_conn->add_handler( join => &irc_on_joinpart );
  163.     $irc_conn->add_handler( part => &irc_on_joinpart );
  164.     $irc_conn->add_handler( quit => &irc_on_joinpart );
  165.  
  166.     # server events
  167.     $irc_conn->add_handler( 376      => &irc_on_connect );    # end of MOTD
  168.     $irc_conn->add_handler( topic    => &irc_on_topic );
  169.     $irc_conn->add_handler( namreply => &irc_on_names );
  170.     $irc_conn->add_handler(
  171.         chanoprivsneeded => sub {
  172.             logmsg "Reauthing to nickserv";
  173.             $irc_conn->privmsg( "nickserv", "identify $irc_pass" );
  174.         }
  175.     );
  176.  
  177.     # connect to the database
  178.     logmsg "Connecting dbi://$db_user@$db_name";
  179.     my">my $dbh = DBI->connect( "DBI:mysql:database=$db_name", $db_user, $db_pass )
  180.       or die "Can't connect to the database!";
  181.  
  182.     logmsg "Preparing SQL statements";
  183.     $sql{lookup_line} = $dbh->prepare(
  184.         "select id from `lines`
  185.                    where msg = ?
  186.                    limit 1"
  187.     );
  188.     $sql{add_line} = $dbh->prepare(
  189.         "insert into `lines` (msg)
  190.                  values (?)"
  191.     );
  192.     $sql{lookup_user} = $dbh->prepare(
  193.         "select timeout_power, banned_until from users
  194.                    where mask = ?
  195.                    limit 1"
  196.     );
  197.     $sql{lookup_mask} = $dbh->prepare(
  198.         "select mask
  199.                      from users
  200.                    where nick = ?
  201.                    order by last_talk desc
  202.                    limit 1"
  203.     );
  204.     $sql{update_user} = $dbh->prepare(
  205.         "update users
  206.                        set timeout_power = timeout_power + 2,
  207.                                banned_until = ?,
  208.                                nick = ?,
  209.                                total_bans = total_bans + 1
  210.                    where mask = ?
  211.                    limit 1"
  212.     );
  213.     $sql{add_user} = $dbh->prepare(
  214. "insert into users (banned_until, nick, mask, timeout_power, lines_talked, total_bans)
  215.                  values (?, ?, ?, ?, 0, 0)"
  216.     );
  217.     $sql{user_talk} = $dbh->prepare(
  218.         "update users
  219.                        set lines_talked = lines_talked + 1,
  220.                                word_count   = word_count + ? + 1,
  221.                                last_talk    = null
  222.                    where mask = ?
  223.                    limit 1"
  224.     );
  225.     $sql{next_unban} = $dbh->prepare(
  226.         "select min(banned_until)
  227.                      from users
  228.                    where banned_until > 0"
  229.     );
  230.     $sql{get_unbans} = $dbh->prepare(
  231.         "select nick, mask, id
  232.                      from users
  233.                    where banned_until > 0
  234.                        and banned_until <= ?"
  235.     );
  236.     $sql{clear_ban} = $dbh->prepare(
  237.         "update users
  238.                        set banned_until = 0
  239.                    where id = ?"
  240.     );
  241.     $sql{high_score} = $dbh->prepare(
  242. "select nick, lines_talked/word_count * lines_talked/(total_bans + 1) as score
  243.                  from users
  244.                  order by lines_talked/word_count * lines_talked/(total_bans + 1) desc, lines_talked desc
  245.                  limit 1"
  246.     );
  247.  
  248.     logmsg "Setup complete";
  249.  
  250.     return ( $irc, $irc_conn, $dbh );
  251. }
  252.  
  253. # event handlers
  254. sub irc_on_connect {
  255.  
  256.     #warn "irc_on_connect (@_)n";
  257.     my">my ( $self, $event ) = @_;
  258.  
  259.     logmsg "Connected to IRC, joining $irc_chan";
  260.     $self->join($irc_chan);
  261.  
  262.     logmsg "Authenticating";
  263.     $self->privmsg( "nickserv", "identify $irc_pass" );
  264. }
  265.  
  266. sub irc_on_notice {
  267.     my">my ( $self, $event ) = @_;
  268.     my">my ( $nick, $msg ) = ( $event->nick, $event->args );
  269.  
  270.     logmsg "Notice from $nick to " . @{ $event->to }[0];
  271.     return if ${ $event->to }[0] ne $irc_chan;
  272.  
  273.     &fail( $self, $nick, $event->userhost );
  274. }
  275.  
  276. sub irc_on_msg {
  277.  
  278.     #warn "irc_on_msg (@_)n";
  279.     my">my ( $self, $event ) = @_;
  280.     my">my ( $nick, $msg ) = ( $event->nick, $event->args );
  281.     my">my @args;
  282.     ( $msg, @args ) = split ' ', $msg;
  283.  
  284.     logmsg "PRIVMSG $nick: $msg @args";
  285.     if ( lc $msg eq 'timeout' ) {
  286.         my">my $timeout;
  287.         if ( $args[0] ) {
  288.             if ( $sql{lookup_mask}->execute( $args[0] ) > 0 ) {
  289.                 my">my ($mask) = $sql{lookup_mask}->fetchrow_array;
  290.                 $sql{lookup_mask}->finish;
  291.                 $timeout = &get_timeout($mask);
  292.             }
  293.         }
  294.         else {
  295.             $timeout = &get_timeout( $event->userhost );
  296.         }
  297.  
  298.         if ($timeout) {
  299.             $timeout = &timeout_to_text( 2**( $timeout + 2 ) );
  300.  
  301.             $self->privmsg( $nick, "Next timeout will be $timeout" );
  302.         }
  303.         else {
  304.             $self->privmsg( $nick, "No timeout found" );
  305.         }
  306.     }
  307.     elsif ( exists $auth{ lc $nick } and">and $event->userhost eq $auth{ lc $nick } )
  308.     {
  309.         logmsg "AUTH $nick: $msg";
  310.         if ( $msg eq 'quit' ) {
  311.             $self->privmsg( $nick, "Quitting" );
  312.             exit;
  313.         }
  314.         elsif ( $msg =~ /^unban (S+)/ ) {
  315.             logmsg "Unbanning $1 by command";
  316.             $self->mode( $irc_chan, "-b", $1 );
  317.         }
  318.         elsif ( $msg =~ /^kick (S+)( .*)?/ ) {
  319.             logmsg "Kicking $1 by command";
  320.             $self->kick( $irc_chan, $1, $2 ? $2 : "Kick" );
  321.         }
  322.         elsif ( $msg =~ /^fail ([^!]+)!(S+)/ ) {
  323.             logmsg "Failing $1!$2 by command";
  324.             &fail( $self, $1, $2 );
  325.         }
  326.         elsif ( $msg =~ /^fail (S+)/ ) {
  327.             if ( $sql{lookup_mask}->execute($1) > 0 ) {
  328.                 my">my ($mask) = $sql{lookup_mask}->fetchrow_array;
  329.                 $sql{lookup_mask}->finish;
  330.                 logmsg "Failing $1!$mask by command";
  331.                 &fail( $self, $1, $mask );
  332.             }
  333.             else {
  334.                 logmsg "Couldn't find mask for $1";
  335.             }
  336.         }
  337.         else {
  338.             $self->privmsg( $nick, "Huh?" );
  339.         }
  340.     }
  341.  
  342. }
  343.  
  344. # public msg - someone talking in chat
  345. sub irc_on_public {
  346.  
  347.     #warn "irc_on_public (@_)n";
  348.     my">my ( $self, $event ) = @_;
  349.     my">my ( $nick, $userhost ) = ( $event->nick, $event->userhost );
  350.     my">my ($msg) = ( $event->args );
  351.  
  352.     logmsg "$nick: $msg";
  353.  
  354.     # process the message so that we strip them down
  355.  
  356.     # remove case
  357.     $msg = lc $msg;
  358.  
  359.     # remove addressing nicks:
  360.     $msg =~ s/^S+: ?//;
  361.  
  362.     # remove any nicks referred to
  363.     $msg =~ s/$nick_re/ /g;
  364.  
  365.     # remove punct
  366.     $msg =~ s/[^p{L}d -]+//g;
  367.  
  368.     # removing leading/trailing/multiple spaces
  369.     $msg =~ s/^s+|s+$//g;
  370.     $msg =~ s/ss+/ /g;
  371.  
  372.     # check if the line was already in the DB
  373.     my">my $res = $sql{lookup_line}->execute($msg);
  374.  
  375.     if ( $res > 0 ) {
  376.  
  377.         # kick!
  378.         &fail( $self, $nick, $userhost );
  379.     }
  380.     else {
  381.  
  382.         # add it as a new line
  383.         $sql{add_line}->execute($msg);
  384.  
  385.         my">my $words = ( $msg =~ tr/ / / );
  386.         if ( $sql{user_talk}->execute( $words, $userhost ) == 0 ) {
  387.             $sql{add_user}->execute( 0, $nick, $userhost, 1 );
  388.             $sql{user_talk}->execute( $words, $userhost );
  389.         }
  390.     }
  391.  
  392.     $sql{lookup_line}->finish;
  393. }
  394.  
  395. sub get_timeout {
  396.     my">my $mask = shift;
  397.  
  398.     $sql{lookup_user}->execute($mask);
  399.     my">my ($timeout) = $sql{lookup_user}->fetchrow_array;
  400.     $sql{lookup_user}->finish;
  401.  
  402.     return $timeout;
  403. }
  404.  
  405. sub timeout_to_text {
  406.     my">my $timeout = shift;
  407.  
  408.     my">my ( $dd, $dh, $dm, $ds ) = Normalize_DHMS( 0, 0, 0, $timeout );
  409.     my">my $delta_text;
  410.     $delta_text .= "$dd day" .    ( $dd == 1 ? " " : "s " ) if $dd;
  411.     $delta_text .= "$dh hour" .   ( $dh == 1 ? " " : "s " ) if $dh;
  412.     $delta_text .= "$dm minute" . ( $dm == 1 ? " " : "s " ) if $dm;
  413.     $delta_text .= "$ds second" . ( $ds == 1 ? " " : "s " ) if $ds;
  414.     $delta_text =~ s/ $//;
  415.  
  416.     return $delta_text;
  417. }
  418.  
  419. # fail - silence for 2**2n
  420. sub fail {
  421.  
  422.     my">my ( $self, $nick, $userhost ) = @_;
  423.  
  424.     logmsg "Failing $nick ($userhost)";
  425.  
  426.     # look up the last timeout value for this userhost, default is 1
  427.     my">my $timeout = &get_timeout($userhost);
  428.  
  429.     $timeout += 2;
  430.  
  431.     my">my $delta_text = &timeout_to_text( 2**$timeout );
  432.  
  433.     $self->notice( $irc_chan, "$nick, you have been muted for $delta_text." );
  434.     $self->mode( $irc_chan, "-v", $nick );
  435.  
  436.     my">my $target = time + 2**$timeout;
  437.  
  438.     if ( $sql{update_user}->execute( $target, $nick, $userhost ) == 0 ) {
  439.         $sql{add_user}->execute( $target, $nick, $userhost, 2 );
  440.     }
  441.     logmsg "Silenced for " . ( 2**$timeout ) . " seconds";
  442.  
  443.     if ( not $next_unban or $target < $next_unban ) {
  444.         $next_unban = $target;
  445.     }
  446. }
  447.  
  448. sub kick {
  449.  
  450.     #warn "kick (@_)n";
  451.     my">my ( $self, $nick, $userhost, $msg ) = @_;
  452.  
  453.     &fail( $self, $nick, $userhost );
  454.  
  455.     $msg ||= "Go away";
  456.  
  457.     logmsg "Kicking $nick ($userhost): $msg";
  458.  
  459.     $self->kick( $irc_chan, $nick, $msg );
  460. }
  461.  
  462. sub load_log {
  463.     while (<>) {
  464.  
  465.         # http://isomerica.net/~xkcd/#xkcd.log
  466.         # 20:50 <@zigdon> oh, right, he can't actually kick you
  467.         # 20:56  * zigdon tests
  468.         #
  469.  
  470.         next">next unless /[>*]/;
  471.         chomp;
  472.         s/^[^>]+> //
  473.           or s/^[^*]+* S+ //;
  474.  
  475.         s/^s+|s+$//g;
  476.         s/ss+/ /g;
  477.  
  478.         # remove addressing nicks:
  479.         s/^S+: ?//;
  480.  
  481.         # remove punct
  482.         s/[^p{L} -]+//g;
  483.  
  484.         # remove case
  485.         my">my $msg = lc $_;
  486.  
  487.         my">my $res = $sql{lookup_line}->execute($msg);
  488.         next">next if $res > 0;
  489.         print "$msgn";
  490.         $sql{add_line}->execute($msg);
  491.     }
  492.     exit;
  493. }
  494.  
  495. sub update_nick_re {
  496.     $nick_re = "moderator";
  497.     $nick_re = qr/Q$_E|$nick_re/ foreach keys %nicks;
  498.     $nick_re = qr/s*(?:$nick_re)s*/;
  499.  
  500.     # logmsg "Nick_re = $nick_re";
  501. }
  502.  
  503. sub irc_on_nick {
  504.     my">my ( $self, $event ) = @_;
  505.     my">my ( $oldnick, $newnick, $userhost ) =
  506.       ( lc $event->nick, $event->args, $event->userhost );
  507.     $newnick = lc $newnick;
  508.  
  509.     $nicks{$newnick} = $nicks{$oldnick};
  510.     delete $nicks{$oldnick};
  511.  
  512. # if someone changes nicks too often (more than 3 times in a maint period), that's a fail
  513.     if ( exists $nick_changes{$userhost} ) {
  514.         if ( $nick_changes{$userhost}[1]++ > 2 ) {
  515.             &fail( $self, $newnick, $userhost );
  516.         }
  517.         elsif ( $nick_changes{$userhost}[1] > 5 ) {
  518.             &kick( $self, $newnick );
  519.         }
  520.     }
  521.     else {
  522.         $nick_changes{$userhost} = [ time, 1 ];
  523.     }
  524.  
  525.     logmsg
  526.       "$oldnick is now known as $newnick ($nick_changes{$userhost}[1] since ",
  527.       scalar localtime $nick_changes{$userhost}[0], ")";
  528.     &update_nick_re;
  529. }
  530.  
  531. sub irc_on_joinpart {
  532.     my">my ( $self, $event ) = @_;
  533.     my">my ($nick) = lc $event->nick;
  534.  
  535.     my">my $action;
  536.     if ( $event->{type} eq 'join' ) {
  537.         $nicks{$nick} = 1;
  538.         $action = "joined";
  539.  
  540.         # if this is a new user, give them voice after a minute (disabled)
  541.         # if it's an existing user, and they're not currently banned, give them
  542.         # voice immediately
  543.         if ( $sql{lookup_user}->execute( $event->userhost ) > 0 or 1 ) {
  544.             my">my ( $power, $ban ) = $sql{lookup_user}->fetchrow_array;
  545.             $sql{lookup_user}->finish;
  546.             unless ($ban) {
  547.                 $irc_conn->mode( $irc_chan, "+v", $nick );
  548.             }
  549.         }
  550.         else {
  551.             $sql{add_user}->execute( time + 60, $nick, $event->userhost, 1 );
  552.             if ( not $next_unban or time + 60 < $next_unban ) {
  553.                 $next_unban = time + 60;
  554.             }
  555.             $irc_conn->privmsg( $nick,
  556. "Welcome to #xkcd-signal.  Give me a minute, and I'll set you up with a voice.  In the meantime, you might want to read the FAQ: http://www.xkcdb.com/signalfaq"
  557.             );
  558.         }
  559.     }
  560.     else {
  561.         delete $nicks{$nick};
  562.         $action = "left";
  563.     }
  564.     logmsg "$nick has $action the channel";
  565.     &update_nick_re;
  566. }
  567.  
  568. sub irc_on_names {
  569.     my">my ( $self, $event ) = @_;
  570.     my">my ( $nick, $mynick ) = ( $event->nick, $self->nick );
  571.     my">my ($names) = ( $event->args )[3];
  572.  
  573.     print "Event: $_[1]->{type}n";
  574.     print DEBUG Dumper [ @_[ 1 .. $#_ ] ];
  575.  
  576.     %nicks =
  577.       ( %nicks, map { s/^(W)//; ( $_ => $1 ? $1 : 1 ) } split ' ', $names );
  578.     logmsg "In channel: " .