From 0302fdd31ad24ea7fe1dd766dfcf6feba2969404 Mon Sep 17 00:00:00 2001
From: Jan Vales <jan@jvales.net>
Date: Mon, 8 Jul 2013 04:03:53 +0200
Subject: [PATCH] Robot 9000 changed to work with sqlite.
---
robot9000.pl | 965 ++++++++++++++++++++++++++++++++++++++++++
robot9000.words | 1 +
robot9000.yml.example | 17 +
3 files changed, 983 insertions(+)
create mode 100755 robot9000.pl
create mode 100644 robot9000.words
create mode 100644 robot9000.yml.example
diff --git a/robot9000.pl b/robot9000.pl
new file mode 100755
index 0000000..7e79814
--- /dev/null
+++ b/robot9000.pl
@@ -0,0 +1,965 @@
+#!/usr/bin/perl -w
+#
+# Enforced originality! If someone repeats something that has been already
+# said in channel, silence them. Silence time increasing geometrically.
+#
+# Copyright (C) 2007 Dan Boger - zigdon+bot@gmail.com
+# Copyright (C) 2013 Jan Vales - jan@jvales.net (someone@somenet.org)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+# A current copy of this code can be found at:
+#
+# http://dev.somenet.org/?p=irc/robot9000.git;a=summary
+#
+#
+# By default, the next mute time never goes down. To have it decay, set up a
+# cronjob such as this:
+#
+# 0 */6 * * * echo "update users set timeout_power = timeout_power - 1 where timeout_power > 0" | mysql -D databasename
+# 0 */6 * * * echo ".timeout 5000 \n update users set timeout_power = timeout_power - 1 where timeout_power > 0" | sqlite3 robot9000.sqlite
+#
+# This version was adapted to use sqlite instead of mysql!
+# It will also create its own tables - no more .sql-file imports
+
+use strict;
+use Net::IRC;
+use Time::HiRes qw/usleep/;
+use DBI;
+use Date::Calc qw/Normalize_DHMS/;
+use Data::Dumper;
+use YAML qw/LoadFile/;
+
+use constant {
+ DEBUG => 0,
+ VERSION => 'robot9000.pl 2013-07-08 somenet'
+};
+
+# Load config file - sample file at:
+# http://media.peeron.com/tmp/ROBOT9000.yml
+my $config_file = shift or die "Usage: $0 <config> [<log file to load>]";
+my $config = LoadFile($config_file);
+
+# when is the next time someone should be unbanned?
+my $next_unban = 1;
+
+# when should we run the cleanup next?
+my $maint_time = time + 20;
+
+# when was the last time we heard *anything*
+my $last_public = time;
+
+# some annoying globals
+my $topic;
+my %nicks;
+my %nicks_tmp;
+my $nick_re;
+my %nick_changes;
+my %common_words;
+my %sql;
+my @lookup_queue;
+
+# what modes are used to deop/op?
+my %op_table = ( "%" => "h", "@" => "o", "~" => "q", "&" => "a" );
+my %rev_op_table = reverse %op_table;
+
+# connect to the IRC server and the database
+my ( $irc, $irc_conn, $dbh ) = &setup(@ARGV ? 0 : 1);
+
+if (@ARGV) { # we're only loading an existing log file, not actually running
+ print "Loading log files...\n";
+ &load_log;
+}
+
+&event_loop;
+
+sub logmsg {
+ print scalar localtime, " - @_\n";
+ print LOG scalar localtime, " - @_\n",;
+}
+
+sub event_loop {
+
+ #warn "event_loop (@_)\n";
+
+ while (1) {
+ $irc->do_one_loop();
+ usleep 50;
+
+ if ( $next_unban and time > $next_unban ) {
+ &process_unbans;
+ }
+
+ if ( time > $maint_time ) {
+ logmsg "Running maint";
+ $irc_conn->mode( $config->{irc_chan}, "+m" );
+
+ while (@lookup_queue) {
+ my @batch = splice( @lookup_queue, 0, $config->{names_request_size} || 5, () );
+ logmsg "Looking up hostmasks... ", join ", ", @batch;
+ $irc_conn->userhost(@batch);
+ usleep 250;
+ }
+
+ foreach ( keys %nick_changes ) {
+ next if $nick_changes{$_}[0] + 300 > time;
+
+ logmsg "Clearing nick_changes for $_";
+ delete $nick_changes{$_};
+ $irc_conn->mode( $config->{irc_chan}, "-b", "~n:$_" );
+ }
+
+ $maint_time = time + 300;
+
+ if ( time - $last_public > $config->{fortune_time} + 300 ) {
+ logmsg "Seems like we're not connected. restarting";
+ exit;
+ }
+ elsif ( time - $last_public > $config->{fortune_time} ) {
+ $irc_conn->userhost( $config->{irc_nick} );
+ logmsg "Too quiet. Ping?";
+ sleep 1;
+
+# if ( -x $config->{fortune_command} ) {
+# $irc_conn->privmsg( $config->{irc_chan}, $_ )
+# foreach ( "It's too quiet:",
+# split /\n/, `$config->{fortune_command}` );
+# }
+ }
+ }
+ }
+}
+
+sub process_unbans {
+ $sql{get_unbans}->execute(time);
+ while ( my ( $nick, $userhost, $id, $bantype ) = $sql{get_unbans}->fetchrow_array )
+ {
+ next if $nick eq $config->{irc_nick};
+ logmsg "Restoring $userhost";
+
+ if ( $bantype eq 'v' ) {
+ $irc_conn->mode( $config->{irc_chan}, "+v", $nick );
+ $nicks{$nick} = "+" unless $nicks{$nick};
+ }
+ else {
+ $irc_conn->mode( $config->{irc_chan}, "+v$op_table{$bantype}",
+ $nick, $nick );
+ $nicks{$nick} = $bantype;
+ }
+ $sql{clear_ban}->execute($id);
+ $sql{clear_ban}->finish;
+
+ #$irc_conn->privmsg( $nick, "you may now speak in $config->{irc_chan}." );
+ }
+
+ $sql{next_unban}->execute;
+ ($next_unban) = $sql{next_unban}->fetchrow_array;
+ $sql{next_unban}->finish;
+ $sql{get_unbans}->finish;
+}
+
+sub setup {
+ my $connect = shift;
+
+ #warn "setup (@_)\n";
+ # open our log file
+ open LOG, ">>", $config->{logfile}
+ or die "Can't write to $config->{logfile}: $!";
+ logmsg "Starting up, version", VERSION;
+ sleep 5;
+
+ # connect to the database
+ logmsg "Connecting to $config->{db_conn_str} User: $config->{db_user}";
+ my $dbh = DBI->connect( $config->{db_conn_str}, $config->{db_user}, $config->{db_pass}, {RaiseError => 1, AutoCommit => 1} )
+ or die "Can't connect to the database!";
+
+ logmsg "Creating tables, if needed";
+ $sql{create_table_lines} = $dbh->prepare("CREATE TABLE IF NOT EXISTS lines ( id integer primary key autoincrement, msg text NOT NULL );");
+ $sql{create_table_lines}->execute;
+ $sql{create_table_lines}->finish;
+
+ $sql{create_table_users} = $dbh->prepare("CREATE TABLE IF NOT EXISTS users (
+ id integer primary key autoincrement,
+ mask varchar(255) default NULL,
+ nick varchar(64) NOT NULL default '',
+ timeout_power int(10) NOT NULL default '0',
+ banned_until int(10) NOT NULL default '0',
+ ban_type char(1) NOT NULL default 'v',
+ lines_talked int(10) NOT NULL default '0',
+ total_bans int(10) NOT NULL default '0',
+ word_count int(10) NOT NULL default '0',
+ last_talk timestamp NOT NULL default CURRENT_TIMESTAMP,
+ user_status int(3) NOT NULL default '0'
+);");
+ $sql{create_table_users}->execute;
+ $sql{create_table_users}->finish;
+
+ $sql{create_idx_lines_msg} = $dbh->prepare("CREATE INDEX IF NOT EXISTS idx_lines_msg on lines ( msg );");
+ $sql{create_idx_lines_msg}->execute;
+ $sql{create_idx_lines_msg}->finish;
+
+ $sql{create_idx_users_mask} = $dbh->prepare("CREATE INDEX IF NOT EXISTS idx_users_mask on users ( mask );");
+ $sql{create_idx_users_mask}->execute;
+ $sql{create_idx_users_mask}->finish;
+
+
+ logmsg "Preparing SQL statements";
+ $sql{lookup_line} = $dbh->prepare(
+ "select id from lines
+ where msg = ?
+ limit 1;"
+ );
+ $sql{add_line} = $dbh->prepare(
+ "insert into lines (msg)
+ values (?)"
+ );
+ $sql{lookup_user} = $dbh->prepare(
+ "select timeout_power, banned_until from users
+ where mask = ?
+ limit 1;"
+ );
+ $sql{lookup_mask} = $dbh->prepare(
+ "select mask
+ from users
+ where nick = ?
+ order by last_talk desc
+ limit 1"
+ );
+ $sql{update_user} = $dbh->prepare(
+ "update users
+ set timeout_power = timeout_power + 2,
+ banned_until = ?,
+ nick = ?,
+ total_bans = total_bans + 1,
+ ban_type = ?
+ where mask = ?"
+# limit 1"
+ );
+ $sql{update_nick} = $dbh->prepare(
+ "update users
+ set nick = ?
+ where mask = ?"
+# limit 1"
+ );
+ $sql{add_user} = $dbh->prepare(
+ "insert into users (banned_until, nick, mask, timeout_power,
+ lines_talked, total_bans, ban_type)
+ values (?, ?, ?, ?, 0, 0, ?)"
+ );
+ $sql{user_talk} = $dbh->prepare(
+ "update users
+ set lines_talked = lines_talked + 1,
+ word_count = word_count + ? + 1,
+ last_talk = CURRENT_TIMESTAMP
+ where mask = ?"
+# limit 1"
+ );
+ $sql{next_unban} = $dbh->prepare(
+ "select min(banned_until)
+ from users
+ where banned_until > 0"
+ );
+ $sql{get_unbans} = $dbh->prepare(
+ "select nick, mask, id, ban_type
+ from users
+ where banned_until > 0
+ and banned_until <= ?"
+ );
+ $sql{clear_ban} = $dbh->prepare(
+ "update users
+ set banned_until = 0
+ where id = ?"
+ );
+ $sql{high_score} = $dbh->prepare(
+ "select nick, lines_talked/word_count * lines_talked/(total_bans + 1) as score
+ from users
+ order by lines_talked/word_count * lines_talked/(total_bans + 1) desc, lines_talked desc
+ limit 1"
+ );
+
+ return ( $irc, $irc_conn, $dbh ) unless $connect;
+
+ # log into IRC
+ logmsg "Connecting irc://$config->{irc_nick}\@$config->{irc_server}";
+ $irc = new Net::IRC;
+ my $irc_conn = $irc->newconn(
+ Nick => $config->{irc_nick},
+ Server => $config->{irc_server},
+ Ircname => $config->{irc_name},
+ Username => $config->{irc_username} || "ROBOT9000",
+ );
+
+ if (DEBUG) {
+ open DEBUG_FH, ">>$config->{logfile}.debug"
+ or die "Can't write to $config->{logfile}.debug: $!";
+ $irc_conn->add_default_handler( \&dump_event );
+ }
+
+ # talk events
+ $irc_conn->add_handler( public => \&irc_on_public );
+ $irc_conn->add_handler( caction => \&irc_on_public );
+ $irc_conn->add_handler( notice => \&irc_on_notice );
+ $irc_conn->add_handler( msg => \&irc_on_msg );
+
+ # user events
+ $irc_conn->add_handler( nick => \&irc_on_nick );
+ $irc_conn->add_handler( join => \&irc_on_joinpart );
+ $irc_conn->add_handler( part => \&irc_on_joinpart );
+ $irc_conn->add_handler( quit => \&irc_on_joinpart );
+
+ # server events
+ $irc_conn->add_handler( endofmotd => \&irc_on_connect );
+ $irc_conn->add_handler( nomotd => \&irc_on_connect );
+ $irc_conn->add_handler( topic => \&irc_on_topic );
+ $irc_conn->add_handler( namreply => \&irc_on_names );
+ $irc_conn->add_handler( endofnames => \&irc_on_endnames );
+ $irc_conn->add_handler( mode => \&irc_on_mode );
+ $irc_conn->add_handler( userhost => \&irc_on_userhost );
+ $irc_conn->add_handler(
+ chanoprivsneeded => sub {
+ logmsg "Reauthing to nickserv";
+ $irc_conn->privmsg( "nickserv", "identify $config->{irc_pass}" );
+ }
+ );
+
+ logmsg "Setup complete";
+
+ logmsg "Loading common words...";
+ open( WORDS, $config->{common_file} )
+ or die "Can't read $config->{common_file}: $!";
+ while (<WORDS>) {
+ chomp;
+ $common_words{ lc $_ } = 1;
+ }
+ close WORDS;
+ logmsg "Loaded ", scalar keys %common_words, " words";
+
+ return ( $irc, $irc_conn, $dbh );
+}
+
+# event handlers
+sub irc_on_connect {
+
+ #warn "irc_on_connect (@_)\n";
+ my ( $self, $event ) = @_;
+
+ logmsg "Connected to IRC, joining $config->{irc_chan}";
+ $self->join( $config->{irc_chan} );
+
+ logmsg "Authenticating";
+ $self->privmsg( "nickserv", "identify $config->{irc_pass}" );
+
+ sleep 2;
+ $irc_conn->names;
+}
+
+sub irc_on_notice {
+ my ( $self, $event ) = @_;
+ my ( $nick, $msg ) = ( $event->nick, $event->args );
+
+ logmsg "Notice from $nick to " . @{ $event->to }[0] . ": $msg";
+ return if ${ $event->to }[0] ne $config->{irc_chan};
+
+ &fail( $self, $nick, $event->userhost,
+ "Failed for sending notices to channel" );
+}
+
+sub irc_on_msg {
+
+ #warn "irc_on_msg (@_)\n";
+ my ( $self, $event ) = @_;
+ my ( $nick, $msg ) = ( $event->nick, $event->args );
+ my @args;
+ ( $msg, @args ) = split ' ', $msg;
+
+ return if $nick eq $config->{irc_nick};
+
+ logmsg "PRIVMSG $nick($nicks{$nick}): $msg @args";
+ if ( lc $msg eq 'version' ) {
+ $self->privmsg( $nick, VERSION );
+ }
+ elsif ( lc $msg eq 'timeout' ) {
+ my ( $timeout, $banned_until );
+ if ( $args[0] ) {
+ if ( $sql{lookup_mask}->execute( $args[0] ) > 0 ) {
+ my ($mask) = $sql{lookup_mask}->fetchrow_array;
+ $sql{lookup_mask}->finish;
+ ( $timeout, $banned_until ) = &get_timeout($mask);
+ }
+ }
+ else {
+ ( $timeout, $banned_until ) = &get_timeout( $event->userhost );
+ }
+
+ if ($timeout) {
+ $timeout = &timeout_to_text( 2**( $timeout + 2 ) );
+
+ $self->privmsg( $nick, "Next timeout will be $timeout" );
+
+ if ($banned_until) {
+ $self->privmsg( $nick,
+ "Currently muted, can speak again in "
+ . &timeout_to_text( $banned_until - time ) );
+ }
+ }
+ else {
+ $self->privmsg( $nick, "No timeout found" );
+ }
+ }
+ elsif (
+ (
+ exists $config->{auth}{ lc $nick }
+ and $event->userhost =~ /$config->{auth}{ lc $nick }/
+ )
+ or $nicks{$nick} =~ /[~@&%]/
+ )
+ {
+ logmsg "AUTH $nick: $msg ($nicks{$nick})";
+ if ( $msg eq 'quit' ) {
+ $self->privmsg( $nick, "Quitting" );
+ exit;
+ }
+ elsif ( $msg eq 'msg' and exists $config->{auth}{ lc $nick } ) {
+ $self->privmsg( $nick, "Ok - sending $args[0]: @args[1..$#args]" );
+ $self->privmsg( $args[0], join " ", @args[ 1 .. $#args ] );
+ logmsg "Sending MSG to $args[0]: @args[1..$#args]";
+ }
+ elsif ( $msg eq 'unban' ) {
+ logmsg "Unbanning $args[0] by command";
+ $self->mode( $config->{irc_chan}, "-b", $args[0] );
+ }
+ elsif ( $msg eq 'mode' ) {
+ logmsg "Setting mode @args by command";
+ $self->mode( $config->{irc_chan}, @args );
+ }
+ elsif ( $msg eq 'kick' ) {
+ logmsg "Kicking $args[0] by command";
+ $self->kick(
+ $config->{irc_chan}, $args[0],
+ $args[1]
+ ? join " ",
+ $args[ 1 .. $#args ]
+ : "Kick"
+ );
+ }
+ elsif ( $msg eq 'fail' and $args[0] =~ /([^!]+)!(\S+)/ ) {
+ logmsg "Failing $1!$2 by command";
+ &fail(
+ $self, $1, $2,
+ "Failed by a live moderator",
+ "$nick failed $args[0]: @args[1..$#args]"
+ );
+ }
+ elsif ( $msg eq 'nick_re' ) {
+ logmsg "Current nick re: $nick_re";
+ $self->privmsg( $nick, "Ok, logged" );
+ }
+ elsif ( $msg eq 'names' ) {
+ logmsg "Current names: ", join ", ",
+ map { "$_($nicks{$_})" } sort keys %nicks;
+ $self->privmsg( $nick, "Current names: ",
+ join ", ", map { "$_($nicks{$_})" } sort keys %nicks );
+ }
+ elsif ( $msg eq 'fail' ) {
+ if ( $sql{lookup_mask}->execute( $args[0] ) > 0 ) {
+ my ($mask) = $sql{lookup_mask}->fetchrow_array;
+ $sql{lookup_mask}->finish;
+ logmsg "Failing $args[0]!$mask by command";
+ &fail(
+ $self, $args[0], $mask,
+ "Failed by a live moderator",
+ "$nick failed $args[0]: @args[1..$#args]"
+ );
+ }
+ else {
+ logmsg "Couldn't find mask for -${args[0]}-";
+ }
+ }
+ elsif ( $msg eq 'check' ) {
+ logmsg "Checking for pending mutes to restore";
+ $self->privmsg( $nick, "Ok, processing mutes to restore" );
+ &process_unbans;
+ }
+ else {
+ foreach (
+ "Commands: timeout - query if you're banned, and what your next ban will be",
+ " timeout <nick> - same, for someone else",
+ " unban - unban given nickmask",
+ " check - check if there are any pending unmutes",
+ " kick <nick> <msg> - kick someone",
+ " names - list the currently known privs of users in channel",
+ " fail <nick> <msg> - have the moderator manually silence <nick>",
+ " version - report current version",
+ )
+ {
+ $self->privmsg( $nick, $_ );
+ }
+ }
+ }
+ else {
+ foreach (
+"Commands: timeout <nick> - query if you're banned, and what your next ban will be",
+ " version - report current version",
+ )
+ {
+ $self->privmsg( $nick, $_ );
+ }
+ logmsg "Ignoring PRIVMSG from $nick ", $event->userhost;
+ }
+
+}
+
+# public msg - someone talking in chat
+sub irc_on_public {
+
+ #warn "irc_on_public (@_)\n";
+ my ( $self, $event ) = @_;
+ my ( $nick, $userhost ) = ( $event->nick, $event->userhost );
+ my ($msg) = ( $event->args );
+
+ $last_public = time;
+ if ( $nick eq $config->{irc_nick} ) {
+ logmsg "*** Still connected, it seems";
+ return;
+ }
+
+ logmsg "$nick: $msg";
+ my $length = length $msg;
+
+ # process the message so that we strip them down
+ $msg = &strip($msg);
+
+ if ( $length == 0
+ or $length > 10 and length($msg) / $length < $config->{signal_ratio} )
+ {
+ &fail(
+ $self, $nick, $userhost,
+ "Not enough content",
+ "Not enough content: " . length($msg) . " vs $length"
+ );
+ return;
+ }
+
+ # check if the line was already in the DB
+ my $lineID;
+ my $res = $sql{lookup_line}->execute($msg);
+ ($lineID) = $sql{lookup_line}->fetchrow_array;
+ $sql{lookup_line}->finish;
+
+ if ( defined $lineID ) {
+ # kick!
+ &fail( $self, $nick, $userhost );
+ }
+ else {
+ # add it as a new line
+ $sql{add_line}->execute($msg);
+ $sql{add_line}->finish;
+
+ my $words = ( $msg =~ tr/ / / );
+ if ( $sql{user_talk}->execute( $words, $userhost ) == 0 ) {
+ $sql{add_user}->execute( 0, $nick, $userhost, 0, "v" );
+ $sql{add_user}->finish;
+ $sql{user_talk}->execute( $words, $userhost );
+ $sql{user_talk}->finish;
+ }
+ $sql{user_talk}->finish;
+ }
+}
+
+sub strip {
+ my $msg = shift;
+
+ # remove case
+ $msg = lc $msg;
+
+ # remove addressing nicks:
+ $msg =~ s/^\S+: ?//;
+
+ # remove any nicks referred to
+ $msg =~ s/(?:^|\b)(?:$nick_re)(?:\b|$)/ /g if $nick_re;
+
+ # remove control chars
+ $msg =~ s/[[:cntrl:]]//g;
+
+ # remove smilies
+ $msg =~
+s/(?:^|\s)(?:[[:punct:]]+\w|[[:punct:]]+\w|[[:punct:]]+\w[[:punct:]]+)(?:\s|$)/ /g;
+
+ # remove punct
+ $msg =~ s/([a-zA-Z])'([a-zA-Z])/$1$2/g;
+ $msg =~ s/[^a-zA-Z\d -]+/ /g;
+
+ # remove lone '-'
+ $msg =~ s/(?<!\w)-+|-+(?!\w)/ /g;
+
+ # repeating chars
+ $msg =~ s/(.)\1{2,}/$1$1/g;
+ $msg =~ s/(..)\1{2,}/$1$1/g;
+
+ # removing leading/trailing/multiple spaces
+ $msg =~ s/^\s+|\s+$//g;
+ $msg =~ s/\s\s+/ /g;
+
+ return $msg;
+}
+
+sub get_timeout {
+ my $mask = shift;
+
+ $sql{lookup_user}->execute($mask);
+ my ( $timeout, $banned_until ) = $sql{lookup_user}->fetchrow_array;
+ $sql{lookup_user}->finish;
+
+ return ( $timeout, $banned_until );
+}
+
+sub timeout_to_text {
+ my $timeout = shift;
+
+ my ( $dd, $dh, $dm, $ds ) = Normalize_DHMS( 0, 0, 0, $timeout );
+ my $delta_text;
+ $delta_text .= "$dd day" . ( $dd == 1 ? " " : "s " ) if $dd;
+ $delta_text .= "$dh hour" . ( $dh == 1 ? " " : "s " ) if $dh;
+ $delta_text .= "$dm minute" . ( $dm == 1 ? " " : "s " ) if $dm;
+ $delta_text .= "$ds second" . ( $ds == 1 ? " " : "s " ) if $ds;
+ $delta_text =~ s/ $//;
+
+ return $delta_text;
+}
+
+# fail - silence for 2**2n
+sub fail {
+ my ( $self, $nick, $userhost, $msg, $opmsg ) = @_;
+
+ logmsg "Failing $nick ($userhost)";
+ logmsg "msg: $msg" if $msg;
+ logmsg "opmsg: $opmsg" if $opmsg;
+
+ # look up the last timeout value for this userhost, default is 1
+ my ( $timeout, $banned_until ) = &get_timeout($userhost);
+
+ $timeout += 2;
+
+ # someone abusing the system in some way
+ if ( 2**$timeout > $config->{timeout_limit} ) {
+ logmsg "Kickbanning $nick ($userhost)";
+ $self->notice( $config->{irc_chan}, "$nick, thanks for playing!" );
+ $self->mode( $config->{irc_chan}, "+b", $userhost );
+ $self->kick( $config->{irc_chan}, $nick, "Go away" );
+ return;
+ }
+
+ my $delta_text = &timeout_to_text( 2**$timeout );
+
+ if ($msg) {
+ $self->notice( $config->{irc_chan},
+ "$nick, you have been muted for $delta_text: $msg" );
+ $self->notice( "\@$config->{irc_chan}", $opmsg ) if $opmsg;
+ }
+ elsif ( not $banned_until or $banned_until <= 1 ) {
+ $self->notice( $config->{irc_chan},
+ "$nick, you have been muted for $delta_text." );
+ $self->notice( "\@$config->{irc_chan}", $opmsg ) if $opmsg;
+ }
+
+ my $bantype = "v";
+ if ( not $nicks{$nick} or $nicks{$nick} eq '+' or $nicks{$nick} eq '1' ) {
+ $self->mode( $config->{irc_chan}, "-v", $nick );
+ }
+ else {
+ if ( exists $op_table{ $nicks{$nick} } ) {
+ logmsg "$nick is an operator ($nicks{$nick}) - deopping first (-$op_table{$nicks{$nick}})";
+ $self->mode( $config->{irc_chan}, "-v$op_table{$nicks{$nick}}",
+ $nick, $nick );
+ }
+ else {
+ logmsg "$nick is an operator ($nicks{$nick}) - can't deop";
+ $self->mode( $config->{irc_chan}, "-v", $nick );
+ }
+ $bantype = $nicks{$nick};
+ }
+
+ my $target = time + 2**$timeout;
+
+ if ($sql{update_user}->execute( $target, $nick, $bantype, $userhost ) == 0 )
+ {
+ $sql{add_user}->execute( $target, $nick, $userhost, 2, $bantype );
+ $sql{add_user}->finish;
+ }
+ $sql{update_user}->finish;
+ logmsg "Silenced for " . ( 2**$timeout ) . " seconds";
+
+ if ( not $next_unban or $target < $next_unban ) {
+ $next_unban = $target;
+ }
+
+ # if someone gets failed while already muted, just punt them
+ if ( $banned_until and $banned_until > 1 and
+ (not defined $msg or $msg ne 'Failed by a live moderator') ) {
+ $self->kick( $config->{irc_chan}, $nick, "Come back later" );
+ logmsg "Kicking $nick for getting muted while muted";
+ }
+}
+
+sub kick {
+
+ #warn "kick (@_)\n";
+ my ( $self, $nick, $userhost, $msg ) = @_;
+
+ &fail( $self, $nick, $userhost, $msg );
+
+ $msg ||= "Go away";
+
+ logmsg "Kicking $nick ($userhost): $msg";
+
+ $self->kick( $config->{irc_chan}, $nick, $msg );
+}
+
+sub load_log {
+ while (<>) {
+
+ # http://isomerica.net/~xkcd/#xkcd.log
+ # 20:50 <@zigdon> oh, right, he can't actually kick you
+ # 20:56 * zigdon tests
+ #
+
+ next unless s/.*?[>*] //;
+ chomp;
+
+ my $msg = &strip($_);
+
+ my $lineID;
+ my $res = $sql{lookup_line}->execute($msg);
+ ($lineID) = $sql{lookup_line}->fetchrow_array;
+ $sql{lookup_line}->finish;
+
+ next if defined $lineID;
+ print "$msg\n";
+ $sql{add_line}->execute($msg);
+ $sql{add_line}->finish;
+ }
+ exit;
+}
+
+sub update_nick_re {
+ $nick_re = $config->{irc_nick};
+ $nick_re .= "|\Q$_\E"
+ foreach grep { not exists $common_words{$_} } keys %nicks;
+ $nick_re = qr/$nick_re/i;
+
+ #logmsg "Nick_re = $nick_re";
+}
+
+sub irc_on_nick {
+ my ( $self, $event ) = @_;
+ my ( $oldnick, $newnick, $userhost ) =
+ ( lc $event->nick, $event->args, $event->userhost );
+ $newnick = lc $newnick;
+
+ $last_public = time;
+
+ $nicks{$newnick} = $nicks{$oldnick};
+ delete $nicks{$oldnick};
+
+ # if they're banned, we need to update the table with their new nick
+ if ( $sql{update_nick}->execute( $newnick, $userhost ) > 0 ) {
+ logmsg "Nick updated in database";
+ }
+ $sql{update_nick}->finish;
+
+# if someone changes nicks too often (more than 3 times in a maint period), that's a fail
+ if ( exists $nick_changes{$userhost} ) {
+ $nick_changes{$userhost}[0] = time;
+
+ if ( $nick_changes{$userhost}[1]++ > 1 ) {
+ my ( $timeout, $banned_until );
+ if ( ( $timeout, $banned_until ) = &get_timeout($userhost)
+ and $banned_until )
+ {
+ $self->mode( $config->{irc_chan}, "+b", "~n:$userhost" );
+ &fail( $self, $newnick, $userhost,
+ "Failed for changing nicks too often" );
+ }
+ }
+ elsif ( $nick_changes{$userhost}[1] > 5 ) {
+ &kick( $self, $newnick );
+ }
+ }
+ else {
+ $nick_changes{$userhost} = [ time, 1 ];
+ }
+
+ logmsg
+ "$oldnick is now known as $newnick ($nick_changes{$userhost}[1] since ",
+ scalar localtime $nick_changes{$userhost}[0], ")";
+ &update_nick_re;
+}
+
+sub irc_on_joinpart {
+ my ( $self, $event ) = @_;
+ my ($nick) = lc $event->nick;
+
+ $last_public = time;
+
+ my $action;
+ if ( $event->{type} eq 'join' ) {
+ $nicks{$nick} = 1;
+ $action = "joined";
+
+ # make sure the DB has the correct nick for this user
+ $sql{update_nick}->execute( $nick, $event->userhost );
+ $sql{update_nick}->finish;
+
+ # if this is a new user, give them voice after a minute (disabled)
+ # if it's an existing user, and they're not currently banned, give them
+ # voice immediately
+ if ( $sql{lookup_user}->execute( $event->userhost ) > 0
+ or not $config->{welcome_msg} )
+ {
+ my ( $power, $ban ) = $sql{lookup_user}->fetchrow_array;
+ $sql{lookup_user}->finish;
+ unless ($ban) {
+ if (not $nick eq $config->{irc_nick})
+ {
+ $irc_conn->mode( $config->{irc_chan}, "+v", $nick );
+ $nicks{$nick} = "+" unless $nicks{$nick};
+ }
+ }
+ }
+ else {
+ $sql{add_user}->execute( time + $config->{welcome_time},
+ $nick, $event->userhost, 0, "v" );
+ $sql{add_user}->finish;
+ if ( not $next_unban
+ or time + $config->{welcome_time} < $next_unban )
+ {
+ $next_unban = time + $config->{welcome_time};
+ }
+ $irc_conn->privmsg( $nick, $config->{welcome_msg} );
+ }
+ }
+ else {
+ delete $nicks{$nick};
+ $action = "left";
+ }
+ logmsg "$nick has $action the channel";
+ &update_nick_re;
+}
+
+sub irc_on_names {
+ my ( $self, $event ) = @_;
+ my ( $nick, $mynick ) = ( $event->nick, $self->nick );
+ my ($names) = ( $event->args )[3];
+
+ print "Event: $_[1]->{type}\n";
+ print DEBUG_FH Dumper [ @_[ 1 .. $#_ ] ] if DEBUG;
+
+ %nicks_tmp =
+ ( %nicks_tmp, map { s/^(\W)//; ( $_ => $1 ? $1 : 1 ) } split ' ',
+ $names );
+ logmsg "Got more names - current total: ", scalar keys %nicks_tmp;
+}
+
+sub irc_on_endnames {
+ my ( $self, $event ) = @_;
+
+ print "Event: $_[1]->{type}\n";
+ print DEBUG_FH Dumper [ @_[ 1 .. $#_ ] ] if DEBUG;
+
+ if ( keys %nicks_tmp ) {
+ %nicks = (%nicks_tmp);
+ %nicks_tmp = ();
+ &update_nick_re;
+
+ # look up everyone without a voice, see if they should be +v'ed
+ foreach my $nick ( keys %nicks ) {
+ next if $nicks{$nick} ne '1' or $nick eq $config->{irc_nick};
+ push @lookup_queue, $nick;
+ }
+ }
+
+ logmsg "Names done - in channel: ", join ", ",
+ map { "$_($nicks{$_})" } sort keys %nicks;
+}
+
+# we asked the userhost of a nick - this means we want to know if they should
+# be +v'ed.
+sub irc_on_userhost {
+ my ( $self, $event ) = @_;
+ my @users = split ' ', ( $event->args )[1];
+
+ $last_public = time;
+# logmsg "userhost reply for: ", join ", ", @users;
+
+ foreach my $user (@users) {
+ my ( $nick, $mask ) = split /=\+/, $user;
+ next if $nick eq $config->{irc_nick};
+
+ logmsg "looking up $nick for possible +v";
+ $sql{lookup_user}->execute($mask);
+ my ( $timeout, $banned_until ) = $sql{lookup_user}->fetchrow_array;
+ $sql{lookup_user}->finish;
+
+ next if $banned_until and $banned_until > time;
+ $self->mode( $config->{irc_chan}, "+v", $nick );
+ $nicks{$nick} = "+" unless $nicks{$nick};
+ logmsg "restoring ${nick}'s +v";
+ }
+}
+
+sub irc_on_topic {
+ my ( $self, $event ) = @_;
+
+ $topic = ( $event->args )[2];
+ logmsg "Topic updated to '$topic'";
+}
+
+sub irc_on_mode {
+ my ( $self, $event ) = @_;
+
+ $last_public = time;
+ logmsg "Mode from", $event->nick, ":", $event->args;
+
+ return if $event->nick eq $config->{irc_nick};
+
+ my ( $mode, @nicks ) = ( $event->args );
+ while ( ( $event->nick eq 'ChanServ' or
+ ( $nicks{ $event->nick } and $nicks{ $event->nick } =~ /[@&~]/ ) )
+ and $mode =~ s/([-+])([hoqa])/$1/
+ and my $nick = shift @nicks )
+ {
+ if ( $1 eq '+' ) {
+ if ( exists $rev_op_table{$2} ) {
+ logmsg "Marking $nick as an op ($2 - $rev_op_table{$2})";
+ $nicks{$nick} = $rev_op_table{$2};
+ }
+ else {
+ logmsg "Marking $nick as an op ($2 - unknown ~)";
+ $nicks{$nick} = "~";
+ }
+ }
+ else {
+ logmsg "Unmarking $nick as an op ($2 - $rev_op_table{$2})";
+ $nicks{$nick} = "+";
+ }
+ }
+}
+
+sub dump_event {
+ logmsg "Event: $_[1]->{type} from ", $_[1]->nick, " (",
+ join( ", ", $_[1]->args ), ")\n";
+ print DEBUG_FH Dumper [ @_[ 1 .. $#_ ] ] if DEBUG;
+}
+
diff --git a/robot9000.words b/robot9000.words
new file mode 100644
index 0000000..3302010
--- /dev/null
+++ b/robot9000.words
@@ -0,0 +1 @@
+IHaveNoIdeaWhatThisFileIsFor
diff --git a/robot9000.yml.example b/robot9000.yml.example
new file mode 100644
index 0000000..2f37cd0
--- /dev/null
+++ b/robot9000.yml.example
@@ -0,0 +1,17 @@
+common_file: ./robot9000.words
+db_conn_str: 'dbi:SQLite:dbname=robot9000.sqlite'
+db_pass: ''
+db_user: ''
+home: .
+irc_chan: '#r9k'
+irc_name: I AM MODERATOR
+irc_nick: robot9000
+irc_pass: CHANGEME
+irc_server: irc.somenet.org
+irc_username: robot9000
+logfile: ./robot9000.log
+signal_ratio: 0.1
+timeout_limit: 31536000
+fortune_time: 60
+auth:
+ someone: 'someone@insert.some.awesome.hostname.here'
--
2.43.0