3 # Enforced originality! If someone repeats something that has been already
4 # said in channel, silence them. Silence time increasing geometrically.
6 # Copyright (C) 2007 Dan Boger - zigdon+bot@gmail.com
7 # Copyright (C) 2013 Jan Vales - jan@jvales.net (someone@somenet.org)
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.
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.
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.
23 # A current copy of this code can be found at:
25 # http://dev.somenet.org/?p=irc/robot9000.git;a=summary
28 # By default, the next mute time never goes down. To have it decay, set up a
29 # cronjob such as this:
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
34 # This version was adapted to use sqlite instead of mysql!
35 # It will also create its own tables - no more .sql-file imports
39 use Time::HiRes qw/usleep/;
41 use Date::Calc qw/Normalize_DHMS/;
43 use YAML qw/LoadFile/;
47 VERSION => 'robot9000.pl 2013-07-08 somenet'
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);
55 # when is the next time someone should be unbanned?
58 # when should we run the cleanup next?
59 my $maint_time = time + 20;
61 # when was the last time we heard *anything*
62 my $last_public = time;
64 # some annoying globals
74 # what modes are used to deop/op?
75 my %op_table = ( "%" => "h", "@" => "o", "~" => "q", "&" => "a" );
76 my %rev_op_table = reverse %op_table;
78 # connect to the IRC server and the database
79 my ( $irc, $irc_conn, $dbh ) = &setup(@ARGV ? 0 : 1);
81 if (@ARGV) { # we're only loading an existing log file, not actually running
82 print "Loading log files...\n";
89 print scalar localtime, " - @_\n";
90 print LOG scalar localtime, " - @_\n",;
95 #warn "event_loop (@_)\n";
101 if ( $next_unban and time > $next_unban ) {
105 if ( time > $maint_time ) {
106 logmsg "Running maint";
107 $irc_conn->mode( $config->{irc_chan}, "+m" );
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);
116 foreach ( keys %nick_changes ) {
117 next if $nick_changes{$_}[0] + 300 > time;
119 logmsg "Clearing nick_changes for $_";
120 delete $nick_changes{$_};
121 $irc_conn->mode( $config->{irc_chan}, "-b", "~n:$_" );
124 $maint_time = time + 300;
126 if ( time - $last_public > $config->{fortune_time} + 300 ) {
127 logmsg "Seems like we're not connected. restarting";
130 elsif ( time - $last_public > $config->{fortune_time} ) {
131 $irc_conn->userhost( $config->{irc_nick} );
132 logmsg "Too quiet. Ping?";
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}` );
146 $sql{get_unbans}->execute(time);
147 while ( my ( $nick, $userhost, $id, $bantype ) = $sql{get_unbans}->fetchrow_array )
149 next if $nick eq $config->{irc_nick};
150 logmsg "Restoring $userhost";
152 if ( $bantype eq 'v' ) {
153 $irc_conn->mode( $config->{irc_chan}, "+v", $nick );
154 $nicks{$nick} = "+" unless $nicks{$nick};
157 $irc_conn->mode( $config->{irc_chan}, "+v$op_table{$bantype}",
159 $nicks{$nick} = $bantype;
161 $sql{clear_ban}->execute($id);
162 $sql{clear_ban}->finish;
164 #$irc_conn->privmsg( $nick, "you may now speak in $config->{irc_chan}." );
167 $sql{next_unban}->execute;
168 ($next_unban) = $sql{next_unban}->fetchrow_array;
169 $sql{next_unban}->finish;
170 $sql{get_unbans}->finish;
176 #warn "setup (@_)\n";
178 open LOG, ">>", $config->{logfile}
179 or die "Can't write to $config->{logfile}: $!";
180 logmsg "Starting up, version", VERSION;
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!";
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;
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'
206 $sql{create_table_users}->execute;
207 $sql{create_table_users}->finish;
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;
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;
218 logmsg "Preparing SQL statements";
219 $sql{lookup_line} = $dbh->prepare(
220 "select id from lines
224 $sql{add_line} = $dbh->prepare(
225 "insert into lines (msg)
228 $sql{lookup_user} = $dbh->prepare(
229 "select timeout_power, banned_until from users
233 $sql{lookup_mask} = $dbh->prepare(
237 order by last_talk desc
240 $sql{update_user} = $dbh->prepare(
242 set timeout_power = timeout_power + 2,
245 total_bans = total_bans + 1,
250 $sql{update_nick} = $dbh->prepare(
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, ?)"
261 $sql{user_talk} = $dbh->prepare(
263 set lines_talked = lines_talked + 1,
264 word_count = word_count + ? + 1,
265 last_talk = CURRENT_TIMESTAMP
269 $sql{next_unban} = $dbh->prepare(
270 "select min(banned_until)
272 where banned_until > 0"
274 $sql{get_unbans} = $dbh->prepare(
275 "select nick, mask, id, ban_type
277 where banned_until > 0
278 and banned_until <= ?"
280 $sql{clear_ban} = $dbh->prepare(
285 $sql{high_score} = $dbh->prepare(
286 "select nick, lines_talked/word_count * lines_talked/(total_bans + 1) as score
288 order by lines_talked/word_count * lines_talked/(total_bans + 1) desc, lines_talked desc
292 return ( $irc, $irc_conn, $dbh ) unless $connect;
295 logmsg "Connecting irc://$config->{irc_nick}\@$config->{irc_server}";
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",
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 );
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 );
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 );
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}" );
337 logmsg "Setup complete";
339 logmsg "Loading common words...";
340 open( WORDS, $config->{common_file} )
341 or die "Can't read $config->{common_file}: $!";
344 $common_words{ lc $_ } = 1;
347 logmsg "Loaded ", scalar keys %common_words, " words";
349 return ( $irc, $irc_conn, $dbh );
355 #warn "irc_on_connect (@_)\n";
356 my ( $self, $event ) = @_;
358 logmsg "Connected to IRC, joining $config->{irc_chan}";
359 $self->join( $config->{irc_chan} );
361 logmsg "Authenticating";
362 $self->privmsg( "nickserv", "identify $config->{irc_pass}" );
369 my ( $self, $event ) = @_;
370 my ( $nick, $msg ) = ( $event->nick, $event->args );
372 logmsg "Notice from $nick to " . @{ $event->to }[0] . ": $msg";
373 return if ${ $event->to }[0] ne $config->{irc_chan};
375 &fail( $self, $nick, $event->userhost,
376 "Failed for sending notices to channel" );
381 #warn "irc_on_msg (@_)\n";
382 my ( $self, $event ) = @_;
383 my ( $nick, $msg ) = ( $event->nick, $event->args );
385 ( $msg, @args ) = split ' ', $msg;
387 return if $nick eq $config->{irc_nick};
389 logmsg "PRIVMSG $nick($nicks{$nick}): $msg @args";
390 if ( lc $msg eq 'version' ) {
391 $self->privmsg( $nick, VERSION );
393 elsif ( lc $msg eq 'timeout' ) {
394 my ( $timeout, $banned_until );
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);
403 ( $timeout, $banned_until ) = &get_timeout( $event->userhost );
407 $timeout = &timeout_to_text( 2**( $timeout + 2 ) );
409 $self->privmsg( $nick, "Next timeout will be $timeout" );
412 $self->privmsg( $nick,
413 "Currently muted, can speak again in "
414 . &timeout_to_text( $banned_until - time ) );
418 $self->privmsg( $nick, "No timeout found" );
423 exists $config->{auth}{ lc $nick }
424 and $event->userhost =~ /$config->{auth}{ lc $nick }/
426 or $nicks{$nick} =~ /[~@&%]/
429 logmsg "AUTH $nick: $msg ($nicks{$nick})";
430 if ( $msg eq 'quit' ) {
431 $self->privmsg( $nick, "Quitting" );
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]";
439 elsif ( $msg eq 'unban' ) {
440 logmsg "Unbanning $args[0] by command";
441 $self->mode( $config->{irc_chan}, "-b", $args[0] );
443 elsif ( $msg eq 'mode' ) {
444 logmsg "Setting mode @args by command";
445 $self->mode( $config->{irc_chan}, @args );
447 elsif ( $msg eq 'kick' ) {
448 logmsg "Kicking $args[0] by command";
450 $config->{irc_chan}, $args[0],
457 elsif ( $msg eq 'fail' and $args[0] =~ /([^!]+)!(\S+)/ ) {
458 logmsg "Failing $1!$2 by command";
461 "Failed by a live moderator",
462 "$nick failed $args[0]: @args[1..$#args]"
465 elsif ( $msg eq 'nick_re' ) {
466 logmsg "Current nick re: $nick_re";
467 $self->privmsg( $nick, "Ok, logged" );
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 );
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";
481 $self, $args[0], $mask,
482 "Failed by a live moderator",
483 "$nick failed $args[0]: @args[1..$#args]"
487 logmsg "Couldn't find mask for -${args[0]}-";
490 elsif ( $msg eq 'check' ) {
491 logmsg "Checking for pending mutes to restore";
492 $self->privmsg( $nick, "Ok, processing mutes to restore" );
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",
507 $self->privmsg( $nick, $_ );
513 "Commands: timeout <nick> - query if you're banned, and what your next ban will be",
514 " version - report current version",
517 $self->privmsg( $nick, $_ );
519 logmsg "Ignoring PRIVMSG from $nick ", $event->userhost;
524 # public msg - someone talking in chat
527 #warn "irc_on_public (@_)\n";
528 my ( $self, $event ) = @_;
529 my ( $nick, $userhost ) = ( $event->nick, $event->userhost );
530 my ($msg) = ( $event->args );
533 if ( $nick eq $config->{irc_nick} ) {
534 logmsg "*** Still connected, it seems";
538 logmsg "$nick: $msg";
539 my $length = length $msg;
541 # process the message so that we strip them down
545 or $length > 10 and length($msg) / $length < $config->{signal_ratio} )
548 $self, $nick, $userhost,
549 "Not enough content",
550 "Not enough content: " . length($msg) . " vs $length"
555 # check if the line was already in the DB
557 my $res = $sql{lookup_line}->execute($msg);
558 ($lineID) = $sql{lookup_line}->fetchrow_array;
559 $sql{lookup_line}->finish;
561 if ( defined $lineID ) {
563 &fail( $self, $nick, $userhost );
566 # add it as a new line
567 $sql{add_line}->execute($msg);
568 $sql{add_line}->finish;
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;
577 $sql{user_talk}->finish;
587 # remove addressing nicks:
590 # remove any nicks referred to
591 $msg =~ s/(?:^|\b)(?:$nick_re)(?:\b|$)/ /g if $nick_re;
593 # remove control chars
594 $msg =~ s/[[:cntrl:]]//g;
598 s/(?:^|\s)(?:[[:punct:]]+\w|[[:punct:]]+\w|[[:punct:]]+\w[[:punct:]]+)(?:\s|$)/ /g;
601 $msg =~ s/([a-zA-Z])'([a-zA-Z])/$1$2/g;
602 $msg =~ s/[^a-zA-Z\d -]+/ /g;
605 $msg =~ s/(?<!\w)-+|-+(?!\w)/ /g;
608 $msg =~ s/(.)\1{2,}/$1$1/g;
609 $msg =~ s/(..)\1{2,}/$1$1/g;
611 # removing leading/trailing/multiple spaces
612 $msg =~ s/^\s+|\s+$//g;
621 $sql{lookup_user}->execute($mask);
622 my ( $timeout, $banned_until ) = $sql{lookup_user}->fetchrow_array;
623 $sql{lookup_user}->finish;
625 return ( $timeout, $banned_until );
628 sub timeout_to_text {
631 my ( $dd, $dh, $dm, $ds ) = Normalize_DHMS( 0, 0, 0, $timeout );
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/ $//;
642 # fail - silence for 2**2n
644 my ( $self, $nick, $userhost, $msg, $opmsg ) = @_;
646 logmsg "Failing $nick ($userhost)";
647 logmsg "msg: $msg" if $msg;
648 logmsg "opmsg: $opmsg" if $opmsg;
650 # look up the last timeout value for this userhost, default is 1
651 my ( $timeout, $banned_until ) = &get_timeout($userhost);
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" );
664 my $delta_text = &timeout_to_text( 2**$timeout );
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;
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;
678 if ( not $nicks{$nick} or $nicks{$nick} eq '+' or $nicks{$nick} eq '1' ) {
679 $self->mode( $config->{irc_chan}, "-v", $nick );
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}}",
688 logmsg "$nick is an operator ($nicks{$nick}) - can't deop";
689 $self->mode( $config->{irc_chan}, "-v", $nick );
691 $bantype = $nicks{$nick};
694 my $target = time + 2**$timeout;
696 if ($sql{update_user}->execute( $target, $nick, $bantype, $userhost ) == 0 )
698 $sql{add_user}->execute( $target, $nick, $userhost, 2, $bantype );
699 $sql{add_user}->finish;
701 $sql{update_user}->finish;
702 logmsg "Silenced for " . ( 2**$timeout ) . " seconds";
704 if ( not $next_unban or $target < $next_unban ) {
705 $next_unban = $target;
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";
719 my ( $self, $nick, $userhost, $msg ) = @_;
721 &fail( $self, $nick, $userhost, $msg );
725 logmsg "Kicking $nick ($userhost): $msg";
727 $self->kick( $config->{irc_chan}, $nick, $msg );
733 # http://isomerica.net/~xkcd/#xkcd.log
734 # 20:50 <@zigdon> oh, right, he can't actually kick you
735 # 20:56 * zigdon tests
738 next unless s/.*?[>*] //;
741 my $msg = &strip($_);
744 my $res = $sql{lookup_line}->execute($msg);
745 ($lineID) = $sql{lookup_line}->fetchrow_array;
746 $sql{lookup_line}->finish;
748 next if defined $lineID;
750 $sql{add_line}->execute($msg);
751 $sql{add_line}->finish;
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;
762 #logmsg "Nick_re = $nick_re";
766 my ( $self, $event ) = @_;
767 my ( $oldnick, $newnick, $userhost ) =
768 ( lc $event->nick, $event->args, $event->userhost );
769 $newnick = lc $newnick;
773 $nicks{$newnick} = $nicks{$oldnick};
774 delete $nicks{$oldnick};
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";
780 $sql{update_nick}->finish;
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;
786 if ( $nick_changes{$userhost}[1]++ > 1 ) {
787 my ( $timeout, $banned_until );
788 if ( ( $timeout, $banned_until ) = &get_timeout($userhost)
791 $self->mode( $config->{irc_chan}, "+b", "~n:$userhost" );
792 &fail( $self, $newnick, $userhost,
793 "Failed for changing nicks too often" );
796 elsif ( $nick_changes{$userhost}[1] > 5 ) {
797 &kick( $self, $newnick );
801 $nick_changes{$userhost} = [ time, 1 ];
805 "$oldnick is now known as $newnick ($nick_changes{$userhost}[1] since ",
806 scalar localtime $nick_changes{$userhost}[0], ")";
810 sub irc_on_joinpart {
811 my ( $self, $event ) = @_;
812 my ($nick) = lc $event->nick;
817 if ( $event->{type} eq 'join' ) {
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;
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
828 if ( $sql{lookup_user}->execute( $event->userhost ) > 0
829 or not $config->{welcome_msg} )
831 my ( $power, $ban ) = $sql{lookup_user}->fetchrow_array;
832 $sql{lookup_user}->finish;
834 if (not $nick eq $config->{irc_nick})
836 $irc_conn->mode( $config->{irc_chan}, "+v", $nick );
837 $nicks{$nick} = "+" unless $nicks{$nick};
842 $sql{add_user}->execute( time + $config->{welcome_time},
843 $nick, $event->userhost, 0, "v" );
844 $sql{add_user}->finish;
846 or time + $config->{welcome_time} < $next_unban )
848 $next_unban = time + $config->{welcome_time};
850 $irc_conn->privmsg( $nick, $config->{welcome_msg} );
854 delete $nicks{$nick};
857 logmsg "$nick has $action the channel";
862 my ( $self, $event ) = @_;
863 my ( $nick, $mynick ) = ( $event->nick, $self->nick );
864 my ($names) = ( $event->args )[3];
866 print "Event: $_[1]->{type}\n";
867 print DEBUG_FH Dumper [ @_[ 1 .. $#_ ] ] if DEBUG;
870 ( %nicks_tmp, map { s/^(\W)//; ( $_ => $1 ? $1 : 1 ) } split ' ',
872 logmsg "Got more names - current total: ", scalar keys %nicks_tmp;
875 sub irc_on_endnames {
876 my ( $self, $event ) = @_;
878 print "Event: $_[1]->{type}\n";
879 print DEBUG_FH Dumper [ @_[ 1 .. $#_ ] ] if DEBUG;
881 if ( keys %nicks_tmp ) {
882 %nicks = (%nicks_tmp);
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;
893 logmsg "Names done - in channel: ", join ", ",
894 map { "$_($nicks{$_})" } sort keys %nicks;
897 # we asked the userhost of a nick - this means we want to know if they should
899 sub irc_on_userhost {
900 my ( $self, $event ) = @_;
901 my @users = split ' ', ( $event->args )[1];
904 # logmsg "userhost reply for: ", join ", ", @users;
906 foreach my $user (@users) {
907 my ( $nick, $mask ) = split /=\+/, $user;
908 next if $nick eq $config->{irc_nick};
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;
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";
923 my ( $self, $event ) = @_;
925 $topic = ( $event->args )[2];
926 logmsg "Topic updated to '$topic'";
930 my ( $self, $event ) = @_;
933 logmsg "Mode from", $event->nick, ":", $event->args;
935 return if $event->nick eq $config->{irc_nick};
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 )
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};
949 logmsg "Marking $nick as an op ($2 - unknown ~)";
954 logmsg "Unmarking $nick as an op ($2 - $rev_op_table{$2})";
961 logmsg "Event: $_[1]->{type} from ", $_[1]->nick, " (",
962 join( ", ", $_[1]->args ), ")\n";
963 print DEBUG_FH Dumper [ @_[ 1 .. $#_ ] ] if DEBUG;