#!/usr/bin/perl
+#
###########################################################
# #
# PostgreSQL IRC Info Bot #
# #
-# Copyright 2005-2006 by: #
+# Copyright 2005-2012 by: #
# Petr Jelinek, Devdas Bhagat, Steve Atkins, David Fetter #
# Andreas Scherbaum, Greg Sabino Mullane #
# #
# #
###########################################################
-###########
-# #
-# Modules #
-# #
-###########
+######################################################################
+# load modules
+######################################################################
+
+require("./config.pm");
+require("./db.pm");
+
+package main;
use strict;
use warnings;
-use DBI;
use POE;
+use POE qw(Component::IRC Component::IRC::Plugin::Connector);
use POE::Component::IRC;
use Getopt::Mixed "nextOption";
use FileHandle;
-require("./config.pm");
-
-
-###############
-# #
-# Global Vars #
-# #
-###############
-my $irc_nick = "pg_docbot_test";
-my $irc_server = "invalid.freenode.net:6667";
-my $irc_name = "PostgreSQL IRC infobot";
-my $irc_pass = "";
-my @irc_channels = qw(
- #postgresql
- #pg_docbot
- #postgresql-es
- #pgfoundry
- #postgresql-de
- #postgresql-br
- #foss.in
- #dbi-link
- #plparrot
- #postgresql-eu
- #arpug
- ##NoEnd
- #postgresql-pe
- #slony
- #skytools
- #sfpug
- #jdcon
- #writeable_cte
- #postgresqlfr
- #pgtestfest
- #pg_charlie_foxtrot
-);
-
-
-
-my @mute_nicks = qw(rtfm_please pg_docbot_ads);
-
-my $db_host = "";
-my $db_name = "";
-my $db_user = "";
-my $db_pass = "";
-my $db_port = 5432;
-my $db_schema = "";
-my $admin_commands = {
- '?learn' => \&do_learn,
- '?forget' => \&do_forget,
- '?config' => \&do_config
-};
-my $messagefile = "messages.txt";
-my $query_prefix = '??';
-my $url_pattern = '(http|ftp|news|bt|https)://';
-
-use vars qw($dbh $SQL $sth %sth $count);
-
-my $pg_docbot = qw(pg_docbot);
-my $shutdown = 0;
-
-use constant DEBUG => 3;
-use constant ERROR => 2;
-use constant WARN => 1;
-use constant INFO => 0;
-
-## Maximum items found before we wrap our responses
-my $MAXWRAP = 3;
-
-## Allow "LIKE" searches via ???
-my $LIKESEARCH = 0;
-
-## Are searches case-sensitive?
-my $CASESEARCH = 0;
-
-## Can everyone perform all actions (if running on a private network)
-my $EVERYONE_AUTHORIZED = 0;
-
-## Lock the database (only needed if running more than one bot on the same database)
-my $LOCK_DATABASE = 1;
-
-my $loglevel = DEBUG;
-
-my %loglevels = (
+use Data::Dumper;
+use POSIX ":sys_wait_h";
+use Scalar::Util 'refaddr';
+use YAML::XS qw (/./);
+import docbot::config;
+import docbot::db;
+
+
+######################################################################
+# initialize global variables
+######################################################################
+
+use constant DEBUG2 => 4;
+use constant DEBUG => 3;
+use constant ERROR => 2;
+use constant WARN => 1;
+use constant INFO => 0;
+
+%main::loglevels = (
+ 4 => 'DEBUG2',
3 => 'DEBUG',
2 => 'ERROR',
1 => 'WARN',
0 => 'INFO',
);
+$main::loglevel = DEBUG;
+
+
-# stores the last question possible to answer if the main bot does not know
-%main::last_question = ();
-%main::last_question_ts = ();
-%main::last_question_nick = ();
+# list of joined irc channels
+%main::irc_channels = ();
+# list of sessions
+%main::sessions = ();
+# logfile name
+$main::logfile = 'docbot.log';
-# store messages printed for keywords
-%main::messages = ();
-###############################
+######################################################################
# handle command line arguments
-###############################
-my $args_init_string = "help h d debug c=s config=s";
+######################################################################
+my $args_init_string = "help h d debug D c=s config=s l=s logfile=s";
Getopt::Mixed::init($args_init_string);
-my $help = 0;
-my $debug = 0;
-my $config_file = "";
+$main::help = 0;
+$main::debug = 0;
+$main::debug_traffic = 0;
+$main::config_file = "";
# parse options
my ($argv_option, $argv_value, $argv_pretty);
while (($argv_option, $argv_value, $argv_pretty) = nextOption()) {
if ($argv_option eq "h" or $argv_option eq "help") {
- $help = 1;
+ $main::help = 1;
}
if ($argv_option eq "d" or $argv_option eq "debug") {
- $debug = 1;
+ $main::debug = 1;
+ }
+ if ($argv_option eq "D") {
+ $main::debug_traffic = 1;
}
if ($argv_option eq "c" or $argv_option eq "config") {
- $config_file = $argv_value;
+ $main::config_file = $argv_value;
+ }
+ if ($argv_option eq "l" or $argv_option eq "logfile") {
+ $main::logfile = $argv_value;
}
}
Getopt::Mixed::cleanup();
-#############
-# Config file
-#############
-my %cfg_directives = (
- 'IRCNick', \$irc_nick,
- 'IRCServer', \$irc_server,
- 'IRCName', \$irc_name,
- 'IRCPass', \$irc_pass,
- 'IRCChannels', \@irc_channels,
- 'IRCMuteNicks', \@mute_nicks,
- 'DBHost', \$db_host,
- 'DBName', \$db_name,
- 'DBUsername', \$db_user,
- 'DBPassword', \$db_pass,
- 'DBPort', \$db_port,
- 'DBSchema', \$db_schema,
- 'MessageFile', \$messagefile
-);
-if (length($config_file) > 0) {
- read_config($config_file);
-}
+# FIXME: remove $pg_docbot
+#my $pg_docbot = 'pg_docbot';
+my $shutdown = 0;
-# for later use - we will need to know whats configured nick
-# and whats our real nick
-my $my_nick = $irc_nick;
-# remove my own nick from mute_nicks
-my @mute_nicks_tmp = ();
-foreach (@mute_nicks) {
- if (lc($_) ne lc($irc_nick)) {
- push(@mute_nicks_tmp, $_);
- }
-}
-@mute_nicks = @mute_nicks_tmp;
-## Make sure the database is up, might as well know now
-is_db_ok();
-################
-# Signal handlers
-################
-$SIG{INT} = \&death;
-$SIG{TERM} = \&death;
-$SIG{KILL} = \&death;
-$SIG{HUP} = \&reread_config;
-################
-# Logging
-################
-my $logfile = 'docbot.log';
-# Fork and log to a file unless the debug command line argument is given, in
-# which case log to STDOUT and don't fork.
-close (STDIN);
-if ($debug == 0) {
- if (!open (STDOUT, ">>$logfile")) {
- death ("Can't open logfile $logfile: $!\n");
- }
- if (!open (STDERR, ">>$logfile")) {
- death ("Can't open the logfile $logfile for STDERR: $!\n");
- }
- autoflush STDOUT 1;
- if (fork ()) {
- exit(0);
- }
+
+######################################################################
+# Main
+######################################################################
+
+
+
+init_terminal();
+
+init_config();
+if (length($main::config_file) > 0) {
+ read_config($main::config_file);
+} else {
+ print_msg("No configfile!", ERROR);
+ exit();
}
-################
-# Functions
-################
+init_sessions();
+
+
+
+print_msg("Creating new IRC bot");
+
+# create a set of POE sessions
+foreach my $session (keys(%main::sessions)) {
+ my $name = config_get_key2('irc', 'name');
+ my $server = config_get_key2('irc', 'server');
+ my $port = config_get_key2('irc', 'port');
+ $port = (length($port) > 0 and $port =~ /^\d+$/) ? $port : '6667';
+ my $irc = POE::Component::IRC->spawn(
+ Nick => $main::sessions{$session}{'nickname'},
+ Ircname => $name,
+ Server => $server,
+ Port => $port
+ );
+ if (!$irc) {
+ print_msg("Could not spawn POE session: $!", ERROR);
+ death();
+ }
+ $main::sessions{$session}{'session'} = $irc;
+
+ # create a new POE session for each session
+ POE::Session->create(
+ inline_states => {
+ _start => \&on_start,
+ _default => \&_default,
+ irc_001 => \&on_connect,
+ irc_public => \&on_message,
+ irc_376 => \&on_end_motd,
+ irc_433 => \&on_nickused,
+ irc_ping => \&on_ping,
+ autoping => \&do_autoping,
+ irc_error => \&on_error,
+ },
+ heap => { irc => $irc },
+ );
-########
-# read_config ( config_file )
-####
-# read config & set variables accordingly
-#
-sub read_config {
- my $config_file = shift;
- $main::config = docbot::config->new($config_file);
- $main::config->set_autosave("off");
- while (my ($key, $var) = each (%cfg_directives)) {
- my $val = $main::config->get_key($key);
- if (defined($val))
- {
- if (ref($var) eq 'ARRAY') {
- @$var = split /;/, $val;
- } else {
- $$var = $val;
- }
- }
- }
+# inline_states => {
+# irc_353 => \&on_names,
+# irc_join => \&on_join,
+# irc_part => \&on_part,
+# irc_quit => \&on_quit,
+# irc_nick => \&on_nick,
+# irc_330 => \&on_whois_identified,
+# irc_318 => \&on_whois_end,
+# irc_public => \&on_message,
+# irc_msg => \&on_message,
+# irc_cap => \&on_irc_cap,
+# irc_isupport => \&on_irc_isupport,
+# irc_notice => \&on_irc_notice,
+# irc_ctcp => \&on_irc_ctcp,
+# irc_372 => \&on_motd,
+# nickserv
- read_messages($messagefile);
}
-########
-# reread_config ( )
-####
-# reread config and apply changes at runtime
-# currently handles only changes in DB settings, irc channels and message files
-#
-sub reread_config {
- print_msg('Rereading config');
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "reread config");
-
- my @old_irc_channels = @irc_channels;
- read_config($config_file);
+# this POE session will be the watchdog
+# ticked every 10 seconds
+POE::Session->create(
+ inline_states => {
+ _start => sub {
+ # start the next tick
+ $_[HEAP]->{next_alarm_time} = int(time()) + 10;
+ $_[KERNEL]->alarm(tick => $_[HEAP]->{next_alarm_time});
+ $_[KERNEL]->sig( INT => 'got_sig_int' );
+ $_[KERNEL]->sig( TERM => 'got_sig_term' );
+ $_[KERNEL]->sig( KILL => 'got_sig_kill' );
+ $_[KERNEL]->sig( HUP => 'got_sig_hup' );
+ },
+
+ # a tick every 10 seconds
+ tick => sub {
+ # make sure the next tick is initialized
+ $_[HEAP]->{next_alarm_time} = $_[HEAP]->{next_alarm_time} + 10;
+ $_[KERNEL]->alarm(tick => $_[HEAP]->{next_alarm_time});
+
+ # call the real watchdog function
+ watchdog();
+ },
+ got_sig_int => \&interrupt_handler_quit,
+ got_sig_term => \&interrupt_handler_quit,
+ got_sig_kill => \&interrupt_handler_quit,
+ got_sig_hup => \&interrupt_handler_quit,
+ execute_shutdown => \&execute_shutdown,
+ },
+);
- foreach my $channel (@irc_channels) {
- @old_irc_channels = grep { lc($channel) ne lc($_) } @old_irc_channels;
- $poe_kernel->post(pg_docbot => 'join', $channel);
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "join new channel: $channel");
- }
- if (scalar(@old_irc_channels)>0) {
- $poe_kernel->post(pg_docbot => 'part', @old_irc_channels);
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "part old channel: @old_irc_channels");
- }
- if ($my_nick ne $irc_nick) {
- $my_nick = $irc_nick;
- $poe_kernel->post( $pg_docbot => nick => $my_nick);
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "change nick to: $my_nick");
- }
- # remove my own nick from mute_nicks
- my @mute_nicks_tmp = ();
- foreach (@mute_nicks) {
- if (lc($_) ne lc($irc_nick)) {
- push(@mute_nicks_tmp, $_);
- }
- }
- @mute_nicks = @mute_nicks_tmp;
- read_messages($messagefile);
-}
+# run the bot until it is done.
+$poe_kernel->run();
+exit 0;
-########
-# print_msg ( message, [ detail_level ] )
-####
-# message handler
-#
-sub print_msg {
- my $msg = shift;
- my $level = shift || $loglevel;
- return if $level > $loglevel;
- my $timestamp = localtime;
- $msg =~ s/\n//g;
- print "$timestamp ";
- printf "%-8s", "[" . $loglevels{$level} . "]";
- print "- $msg\n";
- return 1;
-}
-sub word_wrap {
- my ($sep, $len, @text) = @_;
- $len -= length($sep);
- my @ret;
- my $line = '';
-
- foreach my $word (@text) {
- if (length($line.$word) > 250) {
- push (@ret, $line);
- $line = '';
- }
- $line .= (length($line) ? $sep : '').$word;
- }
- push (@ret, $line);
+######################################################################
+# regular functions used by the bot
+######################################################################
+
+
+
+# init_config()
+#
+# init config
+#
+# parameter:
+# none
+# return:
+# none
+sub init_config {
- return @ret;
+ $main::config = docbot::config->new();
+ $main::config->set_autosave("off");
}
-########
-# is_db_ok ( )
-####
-# handles db (re)connection, should be called before any sql commands
+# read_config()
#
-sub is_db_ok {
- my $DSN = "dbi:Pg:dbname=$db_name";
- if ($db_host) {
- $DSN .= ";host=$db_host";
- }
- if ($db_port) {
- $DSN .= ";port=$db_port";
- }
+# read config & set variables accordingly
+#
+# parameter:
+# - config file name
+# return:
+# none
+sub read_config {
+ my $config_file = shift;
- $dbh = DBI->connect_cached(
- $DSN,
- $db_user,
- $db_pass,
- {
- "RaiseError" => 0,
- "PrintError" => 0,
- "AutoCommit" => 0
- }
- );
+ $main::config->read_config($config_file);
- unless ($dbh) {
- print_msg("Can't connect to database - $DBI::errstr\n", ERROR);
- return 0;
- }
+ validate_config();
+}
- $dbh->{RaiseError} = 1;
- if ($db_schema) {
- $dbh->do("SET search_path = '$db_schema'");
- $dbh->commit();
- }
+# config_get_key1()
+#
+# read config value
+#
+# parameter:
+# - config key 1
+# return:
+# - config value
+sub config_get_key1 {
+ my $key1 = shift;
+
+ return $main::config->config_get_key($key1);
+}
- return 1;
+
+# config_get_key2()
+#
+# read config value
+#
+# parameter:
+# - config key 1
+# - config key 2
+# return:
+# - config value
+sub config_get_key2 {
+ my $key1 = shift;
+ my $key2 = shift;
+
+ return $main::config->config_get_key2($key1, $key2);
}
-########
-# get_answer ( query )
-####
-# search database for keywords
+# config_get_key3()
+#
+# read config value
#
-sub get_answer {
- my ($query,$like) = @_;
+# parameter:
+# - config key 1
+# - config key 2
+# - config key 3
+# return:
+# - config value
+sub config_get_key3 {
+ my $key1 = shift;
+ my $key2 = shift;
+ my $key3 = shift;
+
+ return $main::config->config_get_key3($key1, $key2, $key3);
+}
- $CASESEARCH or $query = lc $query;
- my @keys = split(/\s+/, $query);
- my $num = @keys;
+# config_get_keys1()
+#
+# read config keys
+#
+# parameter:
+# - config key 1
+# return:
+# - array with 2nd config keys
+sub config_get_keys1 {
+ my $key1 = shift;
+
+ return $main::config->config_get_keys1($key1);
+}
- unless (is_db_ok()) {
- return \["Database error"];
+
+# validate_config()
+#
+# read config & validate important settings
+#
+# parameter:
+# none
+# return:
+# none
+sub validate_config {
+ if (!config_get_key2('bot', 'commandchannel')) {
+ die("Please set config value 'bot:commandchannel'\n");
+ }
+ if (!config_get_key2('database', 'host')) {
+ die("Please set config value 'database:host'\n");
+ }
+ if (!config_get_key2('database', 'name')) {
+ die("Please set config value 'database:name'\n");
+ }
+ if (!config_get_key2('database', 'username')) {
+ die("Please set config value 'database:username'\n");
+ }
+ if (!config_get_key2('irc', 'name')) {
+ die("Please set config value 'irc:name'\n");
+ }
+ if (!config_get_key2('irc', 'server')) {
+ die("Please set config value 'irc:server'\n");
}
- my $searchnum = "search$num";
- $like and $searchnum .= "like";
-
- if (!exists $sth{$searchnum}) {
- my $INNERSEARCH = "SELECT kurl FROM docbot_key WHERE lower(key) = ?";
- $CASESEARCH and $INNERSEARCH =~ s/lower//;
- $LIKESEARCH and $like and $INNERSEARCH =~ y/=/~/;
- $SQL = "SELECT url FROM docbot_url WHERE id IN (\n";
- $SQL .= join "\n INTERSECT\n" => map {"$INNERSEARCH\n"} @keys;
- $SQL .= ")";
- print_msg("Preparing $SQL\n", 9);
- $sth{$searchnum} = $dbh->prepare($SQL);
+ my @sessions = config_get_keys1('sessions');
+ my %seen_nicknames = ();
+ my %seen_sessions = ();
+ foreach my $session (@sessions) {
+ if ($session !~ /^\d+$/) {
+ die("Session name ($session) must be numeric!\n");
+ }
+ my $nickname = config_get_key3('sessions', $session, 'nickname');
+ if (defined($seen_nicknames{$nickname}) and $seen_nicknames{$nickname} == 1) {
+ die("Please use different nicknames for each session!\n");
+ }
+ if ($nickname !~ /^[a-zA-Z0-9_\-]+/) {
+ die("Please use a different nickname: $nickname\n");
+ }
+ $seen_nicknames{$nickname} = 1;
+ $seen_sessions{$session} = 1;
}
- $sth{$searchnum}->execute(@keys);
- my $ret = $dbh->selectcol_arrayref($sth{$searchnum}, {Columns => [1]});
- return $ret;
+
+# FIXME: check nick for each session
+# FIXME: check if sessions per channel really exist in session definition
+# FIXME: check maximum number of channels
+
+
}
-########
-# authorized ( {action, nick } )
-####
-# Check if a particular user is authorized to perform an action
+# reread_config()
#
-sub authorized {
+# reread config & execute changes
+#
+# parameter:
+# none
+# return:
+# none
+sub reread_config {
+die("FIXME: implement me! reread_config()\n");
+ print_msg('Rereading config');
+ if (length(config_get_key('IRCBotCommandChannel')) > 0) {
+ write_to_channel(config_get_key('IRCBotCommandChannel'), "reread config");
+ }
+
+ # remember old channel list
+ my $irc_channels = config_get_key('IRCChannels');
+ print_msg("Old channel list: $irc_channels", DEBUG);
+ my @old_irc_channels = split(/,[\s\t]*/, $irc_channels);
- my $arg = shift;
- if (ref $arg ne 'HASH') {
- die qq{Subroutine "authorized" must be passed a hashref\n};
- }
+ # remember old nickname list
+ my $nick_names = config_get_key('IRCNick');
+ print_msg("Old nickname list: $nick_names", DEBUG);
+ my @old_nicknames = split(/,[\s\t]*/, $nick_names);
- ## Check for required arguments
- for my $req (qw(action nick)) {
- exists $arg->{$req} and length $arg->{$req}
- or die qq{Subroutine "authorized" required argument "$req" not found\n};
- }
- return "ok" if $EVERYONE_AUTHORIZED;
+ my $old_max_channels = config_get_key('IRCMaxChannels');
+ my $old_max_sessions = config_get_key('IRCMaxSessions');
+ my $old_bot_command_channel = config_get_key('IRCBotCommandChannel');
+ my $old_irc_server = config_get_key('IRCServer');
+ my $old_irc_name = config_get_key('IRCName');
+ my $old_irc_pass = config_get_key('IRCPass');
- $SQL = "SELECT 1 FROM docbot_user WHERE LOWER(u_nick) = ?";
- $sth = $dbh->prepare_cached($SQL);
- $count = $sth->execute(lc $arg->{nick});
- $sth->finish();
- return $count == 1 ? 1 : 0;
-} ## end of authorized
+ # drop old configuration and reread config
+ $main::config->empty_config();
+ read_config($main::config->config_file());
-########
-# do_learn ( nick, query )
-####
-# auth user nick and save keyword(s) to database
-#
-sub do_learn {
- my ($kernel, $nick, $channel, $query) = @_;
+ # read new channel list
+ $irc_channels = config_get_key('IRCChannels');
+ print_msg("New channel list: $irc_channels", DEBUG);
+ my @new_irc_channels = split(/,[\s\t]*/, $irc_channels);
- unless (is_db_ok()) {
- return "Database error";
- }
+ # read new nickname list
+ $nick_names = config_get_key('IRCNick');
+ print_msg("New nickname list: $nick_names", DEBUG);
+ my @new_nicknames = split(/,[\s\t]*/, $nick_names);
- ## Make sure the user is authorized to perform this action
- if (! &authorized({action => 'learn', nick => $nick, channel => $channel})) {
- print_msg("Unauthorized ?learn from $nick\n", WARN);
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "user $nick not authorized to do a 'learn' in channel: $channel");
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "learn query was: $query");
- return "You are not authorized";
- }
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "learn ($nick/$channel): $query");
- my ($url, @keywords);
- my @keys = split(/\s+/, $query);
-
- # parse query
- foreach my $keyword (@keys) {
- if ($keyword =~ /^$url_pattern/) {
- $url = $keyword;
- # rewrite to current
- if ($url =~ /^(http:\/\/.*?postgresql\.org\/docs\/)[0-9\.]+(\/.*)$/i) {
- $url = $1 . "current" . $2;
- }
- # rewrite to static
- if ($url =~ /^(http:\/\/\/\/.*?postgresql\.org\/docs\/current\/)interactive(\/.*)$/i) {
- $url = $1 . "static" . $2;
- }
- last;
- }
+ # pre-checks
+ my $new_max_channels = config_get_key('IRCMaxChannels');
+ my $new_max_sessions = config_get_key('IRCMaxSessions');
+ my $new_bot_command_channel = config_get_key('IRCBotCommandChannel');
+ my $new_irc_server = config_get_key('IRCServer');
+ my $new_irc_name = config_get_key('IRCName');
+ my $new_irc_pass = config_get_key('IRCPass');
- push(@keywords, lc($keyword));
+ if ($old_max_channels != $new_max_channels) {
+ print_msg("'IRCMaxChannels' can't be changed during reload, restart is required", ERROR);
+ if ($old_max_channels > $new_max_channels) {
+ death();
+ }
}
-
- if (@keywords == 0 || !defined($url)) {
- return "Bad parameters";
+ if ($old_max_sessions != $new_max_sessions) {
+ print_msg("'IRCMaxSessions' can't be changed during reload, restart is required", ERROR);
+ if ($old_max_sessions > $new_max_sessions) {
+ death();
+ }
}
-
- # start transaction
- $dbh->commit;
-# if (!$dbh->begin_work) {
-# print_msg("Database error: could not start transaction - $DBI::errstr\n", ERROR);
-# return "Database error: could not start transaction";
-# }
-
- # lock tables to avoid double inserts from two running bots
- if ($LOCK_DATABASE) {
- if (!$dbh->do("LOCK TABLE docbot_url, docbot_key IN ACCESS EXCLUSIVE MODE")) {
- print_msg("Database error: could not lock tables - $DBI::errstr\n", ERROR);
- $dbh->rollback;
- return "Database error: could not lock tables";
- }
+ if ($old_bot_command_channel ne $new_bot_command_channel) {
+ print_msg("'IRCBotCommandChannel' can't be changed during reload, restart is required", ERROR);
+ death();
}
-
- # insert keywords
- $sth = $dbh->prepare("SELECT id FROM docbot_url WHERE url = ?");
- unless ($sth->execute($url)) {
- print_msg("Error inserting url - $DBI::errstr\n", ERROR);
- $dbh->rollback;
- return "Error inserting url";
+ if ($old_irc_server ne $new_irc_server) {
+ print_msg("'IRCServer' can't be changed during reload, restart is required", ERROR);
+ }
+ if ($old_irc_name ne $new_irc_name) {
+ print_msg("'IRCName' can't be changed during reload, restart is required", ERROR);
+ }
+ if ($old_irc_pass ne $new_irc_pass) {
+ print_msg("'IRCPass' can't be changed during reload, restart is required", ERROR);
}
- my $kurl;
-
- if (($kurl) = $sth->fetchrow()) {
- $sth = $dbh->prepare("SELECT has_key (?, ?)");
+ if (($#new_irc_channels + 1) > (config_get_key('IRCMaxSessions') * config_get_key('IRCMaxChannels'))) {
+ print_msg("Too many configured channels (channels > sessions * number channels per session)", ERROR);
+ death();
+ }
+ if (($#new_nicknames + 1) != config_get_key('IRCMaxSessions')) {
+ print_msg("You must provide a nick name for each possible session!", ERROR);
+ death();
+ }
- my $has_key;
- foreach my $keyword (@keywords) {
- unless ($sth->execute($kurl, $keyword) && (($has_key) = $sth->fetchrow())) {
- print_msg("Error inserting key - $DBI::errstr\n", ERROR);
- $dbh->rollback;
- return "Error while inserting key";
- }
- if ($has_key eq 't') {
- @keywords = grep( !/^$keyword$/i, @keywords );
- }
- }
- unless (@keywords) {
- $dbh->rollback;
- return "All keywords already exist in database";
- }
- } else {
- $sth = $dbh->prepare("INSERT INTO docbot_url (url) VALUES (?)");
- if (!$sth->execute($url)) {
- print_msg("Error inserting url - $DBI::errstr\n", ERROR);
- $dbh->rollback;
- return "Error while inserting url";
+ # find new channels
+ foreach my $channel (@new_irc_channels) {
+ if (!grep {lc($_) eq lc($channel)} @old_irc_channels) {
+ print_msg("join new channel: $channel", INFO);
+ channel_join($channel);
}
+ }
- $sth = $dbh->prepare("SELECT currval(pg_get_serial_sequence('docbot_url', 'id'))");
- if (!$sth->execute()) {
- print_msg("Error while selecting currval after inserting url - $DBI::errstr\n", ERROR);
- $dbh->rollback;
- return "Error inserting key";
+ # part old channels
+ foreach my $channel (@old_irc_channels) {
+ if (!grep {lc($_) eq lc($channel)} @new_irc_channels) {
+ print_msg("part old channel: $channel", INFO);
+ channel_part($channel);
}
- ($kurl) = $sth->fetchrow();
}
- $sth = $dbh->prepare("INSERT INTO docbot_key (key, kurl) VALUES (?, ?)");
- foreach my $keyword (@keywords) {
- if (!$sth->execute($keyword, $kurl)) {
- print_msg("Error inserting key - $DBI::errstr\n", ERROR);
- $dbh->rollback;
- return "Error while inserting key";
+ # verify nicknames per session
+ for (my $i = 1; $i <= config_get_key('IRCMaxSessions'); $i++) {
+ if ($new_nicknames[$i - 1] ne $main::sessions{$i}{'nick_name'}) {
+ print_msg("session $i changes nick from '" . $main::sessions{$i}{'nick_name'} . "' to '" . $new_nicknames[$i - 1] . "'", INFO);
+ nick_change($i, $new_nicknames[$i - 1]);
}
}
- $dbh->commit;
- return "Successfully added "
- . scalar @keywords
- . ' keyword'
- . ((scalar(@keywords)==1)?'':'s')
- ;
+
+
+ # FIXME: reopen database connection?
+
}
-########
-# do_forget ( nick, query )
-####
-# auth user nick and remove keyword from database
+# print_msg()
#
-sub do_forget {
- my ($kernel, $nick, $channel, $query) = @_;
+# print out a message on stderr
+#
+# parameter:
+# - message
+# - loglevel (optional)
+# return:
+# none
+sub print_msg {
+ my $msg = shift;
+ my $level = shift || $main::loglevel;
- unless (is_db_ok()) {
- return "Database error";
+ if ($level > $main::loglevel) {
+ return;
}
- ## Make sure the user is authorized to perform this action
- if (! &authorized({action => 'forget', nick => $nick, channel => $channel})) {
- print_msg("Unauthorized ?forget from $nick\n", WARN);
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "user $nick not authorized to do a 'forget' in channel: $channel");
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "forget query was: $query");
- return "You are not authorized";
- }
+ my $timestamp = localtime;
+ $msg =~ s/\n//g;
+ print "$timestamp ";
+ printf "%-8s", "[" . $main::loglevels{$level} . "]";
+ print "- $msg\n";
+ return 1;
+}
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "forget ($nick/$channel): $query");
- my ($url, @keywords);
- my @keys = split(/\s+/, $query);
- if (($keys[0] !~ /$url_pattern/i) && ($keys[1] =~ /$url_pattern/i) && ($#keys >= 2)) {
- return "Usage: ?forget key url OR ?forget key key key OR ?forget URL URL URL";
- print_msg("Unauthorized ?forget from $nick\n", WARN);
- return qq{You are not authorized to run "?forget"};
- }
+# authorized()
+#
+# check if a particular user is authorized to perform an action
+#
+# parameter:
+# - action
+# - nick
+# return:
+# - 0/1 (1 is authorized)
+sub authorized {
- my $rows = 0;
+## FIXME
+#die("FIXME: authorized()\n");
+# my $arg = shift;
+# if (ref $arg ne 'HASH') {
+# die "Subroutine 'authorized' must be passed a hashref\n";
+# }
+#
+# ## Check for required arguments
+# for my $req (qw(action nick)) {
+# exists $arg->{$req} and length $arg->{$req}
+# or die qq{Subroutine "authorized" required argument "$req" not found\n};
+# }
+#
+# $SQL = "SELECT 1 FROM docbot_user WHERE LOWER(u_nick) = ?";
+# $sth = $dbh->prepare_cached($SQL);
+# $count = $sth->execute(lc $arg->{nick});
+# $sth->finish();
+#
+# return $count == 1 ? 1 : 0;
- if ($#keys == 1 && $keys[1] =~ /$url_pattern/) { # key url
- $sth = $dbh->prepare("DELETE FROM docbot_key WHERE key = ? AND kurl IN (SELECT id FROM docbot_url WHERE url = ?)");
- if ($sth->execute(@keys)) {
- $dbh->commit;
- return "Successfully deleted " . $sth->rows . " key" . (($sth->rows > 1) ? "s" : "") if ($sth->rows);
- }
- else {
- print_msg("Error deleting key(s) - $DBI::errstr\n", ERROR);
- return "Error while deleting key(s)";
- }
- }
- elsif ($keys[0] =~ /$url_pattern/) { # one or more urls
- $sth = $dbh->prepare("DELETE FROM docbot_url WHERE url = ?");
- foreach my $keyword (@keys) {
- if ($keyword =~ /^$url_pattern/) {
- if ($sth->execute($keyword)) {
- $rows += $sth->rows;
- } else {
- $dbh->rollback;
- print_msg("Error deleting url - $DBI::errstr\n", ERROR);
- return "Error while deleting url";
- }
+}
+
+
+# init_terminal()
+#
+# initialise the terminal, logfiles and fork the bot into the background
+#
+# parameters:
+# none
+# return:
+# none
+# notes:
+# - will exit after fork()
+sub init_terminal {
+
+ # Fork and log to a file unless the debug command line argument is given, in
+ # which case log to STDOUT and don't fork.
+
+ close(STDIN);
+
+ if ($main::debug == 0) {
+ close(STDOUT);
+ close(STDERR);
+ if (!open (STDOUT, ">>$main::logfile")) {
+ death("Can't open logfile $main::logfile: $!\n");
+ exit(1);
}
- }
- $dbh->commit;
- return "Successfully deleted " . $rows . " url" . (($rows > 1) ? "s" : "") if ($rows);
- return "Url(s) not found";
- }
- else { # one or more keys, TODO delete urls with no keys left
- $sth = $dbh->prepare("DELETE FROM docbot_key WHERE key = ?");
- foreach my $keyword (@keys) {
- if ($sth->execute($keyword)) {
- $rows += $sth->rows;
+ if (!open (STDERR, ">>$main::logfile")) {
+ death("Can't open the logfile $main::logfile for STDERR: $!\n");
+ exit(1);
}
- else {
- $dbh->rollback;
- print_msg("Error deleting key - $DBI::errstr\n", ERROR);
- return "Error while deleting key";
+ autoflush STDOUT 1;
+ if (fork ()) {
+ exit(0);
}
- }
- $dbh->commit;
- return "Successfully deleted " . $rows . " key" . (($rows > 1) ? "s" : "") if ($rows);
- return "Key(s) not found";
}
+
}
-########
-# do_config ( nick, query )
-####
-# config manipulation from IRC
+
+# init_sessions()
#
-sub do_config {
- my ($kernel, $nick, $channel, $query) = @_;
+# initialise all session variables (not the sessions itself)
+#
+# parameter:
+# none
+# return:
+# none
+sub init_sessions {
- print_msg('In do_config');
-
- unless (is_db_ok()) {
- return "Database error";
- }
+ my @sessions = config_get_keys1('sessions');
+
+ # validate_config() already made sure, that the session names are integers
- ## Make sure the user is authorized to perform this action
- if (! &authorized({action => 'config', nick => $nick, channel => $channel})) {
- print_msg("Unauthorized ?config from $nick\n", WARN);
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "user $nick not authorized to do a 'config' in channel: $channel");
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "config query was: $query");
- return "You are not authorized";
+ foreach my $session (@sessions) {
+ $main::sessions{$session} = ();
+ my $nickname = config_get_key3('sessions', $session, 'nickname');
+ my $password = config_get_key3('sessions', $session, 'password');
+ $main::sessions{$session}{'nickname'} = $nickname;
+ $main::sessions{$session}{'password'} = $password;
+ $main::sessions{$session}{'irc_channels'} = [];
+ # for the watchdog
+ stop_session_activity($session);
+ $main::sessions{$session}{'last_nick_change_attempt'} = time();
}
- return "Configuration not supported on this bot" unless (defined($main::config));
+ sort_irc_channels_into_sessions();
+}
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "config ($nick/$channel): $query");
- my ($cmd, $var, $val) = split(/\s+/, $query);
- $cmd = lc($cmd);
-
- if (!defined($var) ||
- ($cmd ne "set" && $cmd ne "get") ||
- ($cmd eq "set" && !defined($val))) {
- return "Bad parameters";
- }
-
- return "Unknown variable '$var'" unless defined($cfg_directives{$var});
- if ($cmd eq "get") {
- if (ref($cfg_directives{$var}) eq 'ARRAY') {
- return $var." = ".join(';', @{$cfg_directives{$var}});
- }
- else {
- return $var." = ".${$cfg_directives{$var}};
- }
- }
- else {
- $main::config->set_key($var, $val);
- $main::config->save_config();
- reread_config();
- return "Successfully set config variable '$var'";
+
+sub sort_irc_channels_into_sessions {
+ my @channels = config_get_keys1('channels');
+
+ foreach my $channel (@channels) {
+ # FIXME: find out if this channel is already joined
+ # FIXME: if session changes, reassign the channel
+ my $session = config_get_key3('channels', $channel, 'session');
+ push(@{$main::sessions{$session}{'irc_channels'}}, $channel);
+ print_msg("assign irc channel '$channel' to session '$session'", DEBUG);
}
}
-########
-# on_reconnect ( )
-####
-#
-sub on_reconnect {
- $poe_kernel->delay( autoping => undef );
- $poe_kernel->delay( connect => 60 );
+
+sub write_to_channel {
+
}
-########
-# on_connect ( )
-####
-# called when conencted to irc, joins to selected channels
-#
-sub on_connect {
- my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
+sub channel_join {
+ my $channel = shift;
- print_msg("Connected ok, joining channels\n", 4);
+ print_msg("join channel: $channel", DEBUG);
+}
+
+
+sub channel_part {
+ my $channel = shift;
+
+ print_msg("part channel: $channel", DEBUG);
+}
- my %chan_data;
- foreach my $channel (@irc_channels) {
- $chan_data{$channel} = {};
- $kernel->post( $pg_docbot => join => $channel );
- }
- $heap->{chan_data} = \%chan_data;
- $heap->{seen_traffic} = 1;
- $kernel->delay( autoping => 300 );
+sub nick_change {
+
}
-########
-# on_message ( )
-####
-# called when some message was sent to channel or to bot
+# find_irc_session()
#
-sub on_message {
- my ( $kernel, $heap, $who, $where, $msg ) = @_[ KERNEL, HEAP, ARG0, ARG1, ARG2 ];
- my $nick = ( split /!/, $who )[0];
- my $channel = $where->[0];
- my $keep_silent = 0;
- my $do_it_anyway = 0;
- my $replyto = $channel;
- my $full_msg = $msg;
- my $like = 0;
-
- foreach my $do_channel (keys(%main::last_question)) {
- if (length($main::last_question{$do_channel}) > 0 && ($main::last_question_ts{$do_channel} + 20) < time()) {
- # delete any old stored question which is older than 20 seconds
- print_msg("deleting old question ($main::last_question{$do_channel})", DEBUG);
- $main::last_question{$do_channel} = "";
+# find an IRC session in the internal state
+#
+# parameter:
+# - irc session
+# return:
+# - session number
+sub find_irc_session {
+ my $irc = shift;
+
+ my $session = undef;
+ foreach $session (keys(%main::sessions)) {
+ if (refaddr($irc) == refaddr($main::sessions{$session}{'session'})) {
+ return $session;
}
}
- # was this a reply from one of the bots and we have the question?
- if ($msg =~ /^nothing found/ && length($main::last_question{$channel}) > 0) {
- foreach my $mute_nick (@mute_nicks) {
- #look if one of the mute nicks told us that he does not know
- if (lc($mute_nick) eq lc($nick)) {
- # yes, push pack your question
- $nick = $main::last_question_nick{$channel};
- $msg = $main::last_question{$channel};
- print_msg("pushing back old question ($main::last_question{$channel})", DEBUG);
- $main::last_question{$channel} = "";
- $do_it_anyway = 1;
+ # do error handling here, it's worthless to add this in every caller
+ print_msg("Could not find IRC session (irc: $irc)!", ERROR);
+ death();
+
+ return undef;
+}
+
+
+# watchdog()
+#
+# verify connections
+#
+# parameter:
+# none
+# return:
+# none
+sub watchdog {
+
+ foreach my $session (keys(%main::sessions)) {
+ if (defined(read_session_activity($session))) {
+ if (read_session_activity($session) < (time() - 180) and read_session_activity($session) < (time() > 240)) {
+ print_msg("Session $session timed out", INFO);
+ # FIXME: what to do?
+ # automatic reconnects should be done by a plugin
+ } else {
+ my $irc = $main::sessions{$session}{'session'};
+
+ # validate nickname
+ my $logged_in = $irc->logged_in();
+ my $nick_name = $irc->nick_name();
+ if ($logged_in and $main::sessions{$session}{'past_motd'} == 1) {
+ if ($nick_name ne $main::sessions{$session}{'nickname'}) {
+ if ($main::sessions{$session}{'last_nick_change_attempt'} < (time() - 35)) {
+ # the bot is not using the desired nickname, try changing this
+ print_msg("nickname is: $nick_name, desired nickname is: " . $main::sessions{$session}{'nickname'} . ", issuing nick change", INFO);
+ $irc->yield( nick => $main::sessions{$session}{'nickname'} );
+ $main::sessions{$session}{'last_nick_change_attempt'} = time();
+ }
+ }
+ }
}
}
}
+}
- if ($msg =~ /^\s*(\?(?:learn|forget|config))\s+(.+)/i) {
- my ($com,$string) = ($1,$2);
- my $answer;
- if (!index($channel,'#') and $my_nick ne $irc_nick) {
- if (grep( /^$channel$/i, find_nick( $heap, $irc_nick ) )) {
- print_msg("Not processing admin command, master bot is on channel", DEBUG);
- return;
- }
- }
+# send_to_commandchannel()
+#
+# send a message to the command channel
+#
+# parameter:
+# - message
+# return:
+# none
+sub send_to_commandchannel {
- if (!defined($heap->{whois_callback}->{$nick}->{authed})) {
- $heap->{whois_callback}->{$nick} = {event => (lc($channel) eq lc($my_nick)) ? 'irc_msg' : 'irc_public', authed => 0};
- @{$heap->{whois_callback}->{$nick}->{args}} = ($who, $where, $msg);
+# FIXME: check if channel is joined
- $kernel->post( pg_docbot => whois => $nick );
- return;
- }
- elsif ($heap->{whois_callback}->{$nick}->{authed} != 1 and ! $EVERYONE_AUTHORIZED) {
- $answer = "You are not authorized";
- }
- else {
- # execute desired command
- $answer = $admin_commands->{$com}($kernel, $nick, $channel, $string);
- }
- undef ($heap->{whois_callback}->{$nick});
- if (length($answer)) {
- # if command was called in channel print answer to channel, if it was PM print it as PM
- if (lc($channel) eq lc($my_nick)) {
- $kernel->post(pg_docbot => privmsg => $nick, $answer);
- }
- else {
- $kernel->post(pg_docbot => privmsg => $channel, $answer);
- }
- return;
- }
- }
- elsif ($msg =~ /^\s*\?\?(\?*)(.+)/i) {
- $like = ($1 and $LIKESEARCH) ? 1 : 0;
- $msg = $2;
- $msg =~ s/^\s+//;
-
- if (substr($channel, 0, 1) eq '#')
- {
- if ($my_nick ne $irc_nick) {
- if (grep( /^$channel$/i, find_nick( $heap, $irc_nick ) )) {
- print_msg("Not processing query command, master bot is on channel", DEBUG);
- return;
- }
- }
+# http://search.cpan.org/dist/POE-Component-IRC/lib/POE/Component/IRC.pm#connected
- if ($do_it_anyway == 0) {
- foreach my $mnick (@mute_nicks) {
- if (grep( /^$channel$/i, find_nick( $heap, $mnick ) )) {
- print_msg("Not processing query command, bot with nickname $mnick is on channel", DEBUG);
- #return;
- # do not return, instead just continue and dont output anything
- $keep_silent = 1;
- }
- }
- }
- }
+}
- if ($msg =~ /^(.+)\s+>\s+(\w+)/i) {
- return unless (grep( /^$channel$/i, find_nick( $heap, $2 ) ));
- $replyto = $2;
- $msg = $1;
- } elsif (lc($channel) eq lc($my_nick)) {
- $replyto = $nick;
- } else {
- $replyto = $channel;
- }
+
+# death()
+#
+# general shutdown procedure after all kind of errors
+#
+# parameters:
+# none
+# return:
+# none
+sub death {
+ print_msg("death()\n", DEBUG);
+ my $text = '';
+ if (defined($_[0])) {
+ $text = shift;
}
- elsif ($msg =~ /^\s*$my_nick\W+tell\s+(\w+)\s+about\s+(.+)/i) {
- if ($1 eq "me") {
- $replyto = $nick;
- } elsif ($1 eq "us") {
- $replyto = $channel;
- } else {
- $replyto = $1;
- return unless (grep( /^$channel$/i, find_nick( $heap, $replyto ) ));
- }
- $msg = $2;
+ if (length($text) > 0) {
+ $text = "Error: $text - shutting down";
} else {
- return;
- }
- # now decide if to keep silent
- if ($keep_silent == 1) {
- # yes, just store the question and a timestamp
- $main::last_question{$channel} = $full_msg;
- $main::last_question_ts{$channel} = time();
- $main::last_question_nick{$channel} = $nick;
- print_msg("storing old question ($main::last_question{$channel})", DEBUG);
- # now return
- return;
+ $text = "Error: shutting down";
}
- # get data from db
- my $answers = get_answer($msg, $like);
- my $message_to_say = get_message($msg);
- my $numanswers = @$answers;
-
- # print each answer as one line, except when there are more than $MAXWRAP
- if ($numanswers) {
- $kernel->post(pg_docbot => privmsg => $replyto, "For information about '$msg' see:\n");
- if ($numanswers <= $MAXWRAP) {
- for my $answer (@$answers) {
- $kernel->post(pg_docbot => privmsg => $replyto, $answer)
- }
- }
- else {
- for my $answer (word_wrap(' :: ', 250, @$answers)) {
- $kernel->post(pg_docbot => privmsg => $replyto, $answer);
- }
- }
- }
- else { # "nothing found," it always sends to the caller, not to the receiver
- # if command was called in channel print, answer to channel, if it was PM print it as PM
- if ($do_it_anyway == 0) {
- if (lc($channel) eq lc($my_nick)) {
- $kernel->post(pg_docbot => privmsg => $nick, "Nothing found");
- } else {
- $kernel->post(pg_docbot => privmsg => $channel, "Nothing found");
- }
+ # loop through all sessions and send a QUIT to the irc server
+ foreach my $session (keys(%main::sessions)) {
+ my $irc = $main::sessions{$session}{'session'};
+ if ($irc->connected) {
+ # this forces the current session to quit from irc, resulting in an "on_error" event
+ $irc->yield( quit => $text );
}
}
+
+ # have to shutdown here, else Component::IRC Component::IRC::Plugin::Connector will reconnect
+ $poe_kernel->delay_add( execute_shutdown => 10 );
+ $shutdown = 1;
+
+ return;
}
-########
-# on_kick ( )
-####
-# called when somebody was kicked from channel
+# interrupt_handler_quit()
#
-sub on_kick {
- my ( $kernel, $heap, $channel, $who ) = @_[ KERNEL, HEAP, ARG1, ARG2 ];
+# handles all interrupts which should lead to a quit
+#
+# parameters:
+# none
+# return:
+# none
+sub interrupt_handler_quit {
+ my ($kernel, $text) = @_[KERNEL, ARG0];
+ print_msg("interrupt_handler()\n", DEBUG);
- my $nick = ( split /!/, $who )[0];
- # if we was kicked, we should rejoin
- if ( lc($nick) eq lc($my_nick) ) {
- remove_channel($heap, $channel);
- print_msg("I was kicked from channel ".$channel.", rejoining\n", 4);
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "I was kicked from channel " . $channel . ", rejoining");
- $kernel->post( $pg_docbot => join => $channel );
+ if ($text =~ m/^(INT|TERM|KILL|HUP)$/) {
+ $text = "Signal received: $text - shutting down";
+ } elsif (length($text) > 0) {
+ $text = "Error: $text - shutting down";
+ } else {
+ $text = "Error: shutting down";
}
- else {
- remove_nick( $heap, $nick, $channel );
+
+ # loop through all sessions and send a QUIT to the irc server
+ foreach my $session (keys(%main::sessions)) {
+ my $irc = $main::sessions{$session}{'session'};
+ if ($irc->connected) {
+ # this forces the current session to quit from irc, resulting in an "on_error" event
+ $irc->yield( quit => $text );
+ }
}
-}
+ # have to shutdown here, else Component::IRC Component::IRC::Plugin::Connector will reconnect
+ $poe_kernel->delay_add( execute_shutdown => 10 );
+ $shutdown = 1;
-sub on_join {
- my ( $kernel, $heap, $who, $channel ) = @_[ KERNEL, HEAP, ARG0, ARG1 ];
- my $nick = ( split /!/, $who )[0];
+ $kernel->sig_handled();
- add_nick( $heap, $nick, $channel );
+ return;
}
-sub on_quit {
- my ( $kernel, $heap, $who ) = @_[ KERNEL, HEAP, ARG0, ARG1 ];
- my $nick = ( split /!/, $who )[0];
- remove_nick( $heap, $nick );
+# execute_shutdown()
+#
+# really quits the bot
+#
+# parameters:
+# none
+# return:
+# none
+sub execute_shutdown {
+ # this is called by delay_add()
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ # just to be sure
+ $poe_kernel->yield( unregister => 'all' );
+ $poe_kernel->yield( 'shutdown' );
+
+ exit();
}
-sub on_part {
- my ( $kernel, $heap, $who, $channel ) = @_[ KERNEL, HEAP, ARG0, ARG1 ];
- $channel =~ s/^(.*?) :.*$/$1/;
- my $nick = ( split /!/, $who )[0];
- if (lc($nick) eq lc($my_nick)) {
- print_msg("Leaving $channel");
- remove_channel($heap, $channel);
- } else {
- remove_nick( $heap, $nick, $channel );
- }
+# set_session_activity()
+#
+# set last activity for a session
+#
+# parameter:
+# - session id
+# return:
+# none
+sub set_session_activity {
+ my $session = shift;
+
+ $main::sessions{$session}{'last_activity'} = time();
}
-sub on_nick {
- my ( $kernel, $heap, $who, $new ) = @_[ KERNEL, HEAP, ARG0, ARG1 ];
- my $nick = ( split /!/, $who )[0];
-
- my @channels = find_nick( $heap, $nick );
- foreach my $channel (@channels) {
- remove_nick( $heap, $nick, $channel );
- add_nick( $heap, $new, $channel );
- }
+# stop_session_activity()
+#
+# set last activity for a session
+#
+# parameter:
+# - session id
+# return:
+# none
+sub stop_session_activity {
+ my $session = shift;
+
+ $main::sessions{$session}{'last_activity'} = undef;
}
-sub on_names {
- my ( $kernel, $heap, $server, $detail ) = @_[KERNEL, HEAP, ARG0, ARG1];
- my ( $channel, $nicknames ) = $detail =~ /^. (.*?) :(.*)$/;
- if ( !defined( $nicknames )) {
- print_msg ("Parse failed in on_names for $detail");
- return;
- }
- my @nicknames = split( /\s+/, $nicknames );
- for my $nick ( @nicknames ) {
- $nick =~ s/^@//;
- add_nick( $heap, $nick, $channel );
- }
+# set_session_activity()
+#
+# set last activity for a session
+#
+# parameter:
+# - session id
+# return:
+# - timestamp with last activity
+sub read_session_activity {
+ my $session = shift;
+
+ return $main::sessions{$session}{'last_activity'};
}
-########
-# on_start ( )
-####
-# start bot
+
+
+######################################################################
+# IRC functions
+######################################################################
+
+
+# on_start()
+#
+# start the session
#
sub on_start {
- $poe_kernel->post( pg_docbot => register => "all" );
-
- my ($server, $port) = split(":", $irc_server);
- $poe_kernel->post( pg_docbot => connect =>
- {
- Debug => $debug,
- Nick => $my_nick,
- Username => $irc_nick,
- Password => $irc_pass,
- Ircname => $irc_name,
- Server => $server,
- Port => $port
- }
- );
-}
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ my $irc = $heap->{irc};
+ my $session = find_irc_session($irc);
+ print_msg("on_start(session: $session)\n", DEBUG);
-sub on_nickused {
- $my_nick .= '_';
- $poe_kernel->post( $pg_docbot => nick => $my_nick);
-}
-sub on_whois_identified {
- my ( $kernel, $heap, $detail ) = @_[KERNEL, HEAP, ARG1];
- my $nick = ( split / /, $detail )[0];
+ $irc->yield( register => 'all' );
- if (defined($heap->{whois_callback}->{$nick})) {
- $heap->{whois_callback}->{$nick}->{authed} = 1;
- }
-}
+ # 300 seconds is the default delay
+ # the bot uses 60 seconds to response faster after timeouts
+ # usually the old nick is still online, because the irc server has not yet recognized the timeout
+ # means: usually a temporary nick has to be used
+ $heap->{connector} = POE::Component::IRC::Plugin::Connector->new(delay => 60);
+ $irc->plugin_add( 'Connector' => $heap->{connector} );
-sub on_whois_end {
- my ( $kernel, $heap, $detail ) = @_[KERNEL, HEAP, ARG1];
- my $nick = ( split / /, $detail )[0];
+ $irc->yield( connect => { Debug => $main::debug_traffic } );
- if (defined($heap->{whois_callback}->{$nick}->{event})) {
- $kernel->yield($heap->{whois_callback}->{$nick}->{event}, @{$heap->{whois_callback}->{$nick}->{args}});
- }
+ return;
}
-sub add_nick {
- my ( $heap, $who, $channel ) = @_;
- my %channels = %{$heap->{chan_data}};
- my @nicknames;
- @nicknames = @{$channels{$channel}->{names}}
- if (defined($channels{$channel}->{names}));
-####################################################################
-# #
-# The following avoids dealing with clever nicknames like ]X[X]X[ #
-# #
-####################################################################
- return if grep{ lc($who) eq lc($_) } @nicknames;
+# irc_001
+# on_connect()
+#
+# connected to irc server
+#
+sub on_connect {
+ my $sender = $_[SENDER];
- push(@nicknames, $who);
- $channels{$channel}->{names} = \@nicknames;
+ # Since this is an irc_* event, we can get the component's object by
+ # accessing the heap of the sender. Then we register and connect to the
+ # specified server.
+ my $irc = $sender->get_heap();
+ my $session = find_irc_session($irc);
- $heap->{chan_data} = \%channels;
-}
+ $main::sessions{$session}{'past_motd'} = 0;
+ $main::sessions{$session}{'last_nick_change_attempt'} = time();
-sub remove_nick {
- my ( $heap, $who, $channel ) = @_;
- my %channels = %{$heap->{chan_data}};
+ # get all channels for this session
+ my @irc_channels = @{$main::sessions{$session}{'irc_channels'}};
+ print_msg("Channel list for session $session: " . join(", ", @irc_channels), DEBUG);
- if (defined($channel)) {
- if (defined($channels{$channel}->{names})) {
- my @nicknames;
- foreach my $nickname ( @{$channels{$channel}->{names}} ) {
- next if lc($who) eq lc($nickname);
- push @nicknames, $nickname;
- }
- $channels{$channel}->{names} = \@nicknames;
- $heap->{chan_data} = \%channels;
- }
- } else {
- foreach $channel ( keys %channels ) {
- if (defined($channels{$channel}->{names})) {
- my @nicknames;
- foreach my $nickname ( @{$channels{$channel}->{names}} ) {
- next if lc($who) eq lc($nickname);
- push @nicknames, $nickname;
- }
- $channels{$channel}->{names} = \@nicknames;
- }
- }
- $heap->{chan_data} = \%channels;
- }
- if ($who eq $irc_nick)
- {
- unless (find_nick($heap, $who)) {
- $my_nick = $irc_nick;
- $poe_kernel->post( $pg_docbot => nick => $my_nick);
- }
+ print "Session $session connected to " . $irc->server_name() . "\n";
+
+ set_session_activity($session);
+
+ # join all channels
+ foreach my $channel (@irc_channels) {
+ $irc->yield( join => $channel );
}
+
+ return;
}
-sub remove_channel {
- my ( $heap, $channel ) = @_;
- my %channels = %{$heap->{chan_data}};
- if (defined($channels{$channel})) {
- undef($channels{$channel});
- $heap->{chan_data} = \%channels;
+# irc_public
+sub on_message {
+ my ($sender, $who, $where, $what) = @_[SENDER, ARG0 .. ARG2];
+ my $nick = ( split /!/, $who )[0];
+ my $channel = $where->[0];
+
+ my $irc = $sender->get_heap();
+ my $session = find_irc_session($irc);
+ #print "\n\nsession: $session\n\n";
+ set_session_activity($session);
+
+
+ if ( my ($rot13) = $what =~ /^rot13 (.+)/ ) {
+ $rot13 =~ tr[a-zA-Z][n-za-mN-ZA-M];
+ $irc->yield( privmsg => $channel => "$nick: $rot13" );
}
+ return;
}
-sub find_nick {
- my ( $heap, $who ) = @_;
- my %channels = %{$heap->{chan_data}};
- my @channels;
- foreach my $channel ( keys %channels ) {
- if ( defined( $channels{$channel}->{names}) ) {
- if ( grep {lc($who) eq lc($_)} @{$channels{$channel}->{names}} ) {
- push (@channels, $channel);
- }
- }
- }
+# on_ping()
+#
+# catch the ping and update activity
+#
+sub on_ping {
+ my ($kernel, $heap, $sender ) = @_[ KERNEL, HEAP, SENDER ];
- return @channels;
+ my $irc = $sender->get_heap();
+ my $session = find_irc_session($irc);
+ print_msg("on_ping(session: $session)\n", DEBUG);
+
+ set_session_activity($session);
}
-sub on_disconnected {
- if ($shutdown == 1) {
- $poe_kernel->post ( $pg_docbot => unregister => "all" );
- $poe_kernel->post ( $pg_docbot => 'shutdown');
- print_msg ("Shutting down in on_disconnected");
- exit;
- } else {
- &on_reconnect;
+
+# do_autoping()
+#
+# Ping ourselves, but only if we haven't seen any traffic since the
+# last ping. This prevents us from pinging ourselves more than
+# necessary (which tends to get noticed by server operators).
+#
+sub do_autoping {
+ my ($sender, $kernel, $heap) = @_[SENDER, KERNEL, HEAP];
+
+ my $irc = $sender->get_heap();
+ my $session = find_irc_session($irc);
+ print_msg("do_autoping(session: $session)\n", DEBUG);
+
+
+ set_session_activity($session);
+
+ if (!$heap->{seen_traffic}) {
+ # send ping to myself
+ $irc->yield( ping => $irc->nick_name() );
}
+ $heap->{seen_traffic} = 0;
+ $kernel->delay(autoping => 300);
}
-sub on_error {
- if ($shutdown == 1) {
- $poe_kernel->post ( $pg_docbot => unregister => "all" );
- $poe_kernel->post ( $pg_docbot => 'shutdown');
- print_msg ("Shutting down in on_error");
- exit;
- } else {
- &on_reconnect;
- }
+
+
+
+## http://poe.perl.org/?POE_Cookbook/IRC_Bot_Debugging
+## http://poe.perl.org/?POE_Cookbook/IRC_Bot_Disconnecting
+## http://poe.perl.org/?POE_Cookbook/IRC_Bot_Reconnecting
+## http://poe.perl.org/?POE_Cookbook
+## http://poe.perl.org/?Tutorials
+## http://poe.perl.org/?POE_Support_Resources
+## http://www.mirc.net/raws/
+
+# we registered for all events, this will produce some debug info.
+sub _default {
+
+#foreach my $tmp (@_) {
+# print "_default: $tmp\n";
+#}
+#exit();
+
+ my ($sender, $event, $args) = @_[SENDER, ARG0 .. $#_];
+ my @output = ( "$event: " );
+
+##print "sender:\n" . Dumper($sender) . "\n";
+#print "class: " . $sender . "\n";
+#print "event: " . $event . "\n";
+#exit();
+
+if (substr($event, 0, 1) eq '_') {
+ return;
}
-sub death {
- my ($where) = $_[ ARG1 ];
- my $channel = $where->[0];
- my $text = shift;
- if ($text =~ m/^(INT|TERM|KILL|HUP)$/) {
- $text = "Signal received: $text - shutting down";
- } else {
- $text = "Error: $text - shutting down";
+ my $irc = $sender->get_heap();
+ my $session = find_irc_session($irc);
+
+ set_session_activity($session);
+
+
+ for my $arg (@$args) {
+ if ( ref($arg) eq 'ARRAY' ) {
+ push( @output, '[' . join(', ', @$arg ) . ']' );
+ } elsif ( ref($arg) eq 'HASH' ) {
+ push( @output, '[' . '(hash)' . ']' );
+ } else {
+ push ( @output, "'$arg'" );
+ }
}
- $shutdown = 1;
- $poe_kernel->post ( $pg_docbot => quit => $text );
- print_msg ("Sending quit message: $text");
-}
+ my $output = join(' ', @output);
-# http://poe.perl.org/?POE_Cookbook/IRC_Bot_Debugging
-# http://poe.perl.org/?POE_Cookbook/IRC_Bot_Disconnecting
-# http://poe.perl.org/?POE_Cookbook/IRC_Bot_Reconnecting
-# http://poe.perl.org/?POE_Cookbook
-# http://poe.perl.org/?Tutorials
-# http://poe.perl.org/?POE_Support_Resources
-sub _default {
- my ( $event, $args ) = @_[ ARG0 .. $#_ ];
- open(UNHANDLED, ">>", "unhandled.log") || return 0;
- print UNHANDLED "unhandled $event\n";
my $print_it = 1;
if ($event eq "autoping") {
if ($event =~ /^irc_\d+/) {
$print_it = 0;
}
+ $print_it = 1;
+
+
+
+ if ($main::debug_traffic == 1) {
+ print $output . "\n";
+ }
if ($print_it == 1) {
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "unhandled event: $event");
+ print_msg($output, DEBUG);
}
- my $arg_number = 0;
- foreach (@$args) {
- print UNHANDLED " ARG$arg_number = ";
- if ( ref($_) eq 'ARRAY' ) {
- print UNHANDLED "$_ = [", join ( ", ", @$_ ), "]\n";
- my $my_nick_quoted = quotemeta($my_nick);
- if ($print_it == 1 and @$_[0] !~ /$my_nick_quoted/i) {
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', " $_ = [" . join ( ", ", @$_ ) . "]");
- }
- }
- else {
- print UNHANDLED "'$_'\n";
- if ($print_it == 1 and length($_) > 0) {
- $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', " '$_'");
- }
- }
- $arg_number++;
- }
- close(UNHANDLED);
- return 0; # Don't handle signals.
+ send_to_commandchannel($output);
+
+
+ # don't handle signals
+ return 0;
}
-sub read_messages {
- my $file = shift;
- # reset messages
- %main::messages = ();
+# on_nickused()
+#
+# called if the desired nick is already in use
+#
+# note:
+# - called on connect, if the requested nick is in use
+# - called on nickchange, if the requested nick is in use
+#
+sub on_nickused {
+ my ($kernel, $heap, $nick_name) = @_[KERNEL, HEAP, ARG1];
- # check if the file exist
- if (length($file) < 1) {
- return;
- }
- if (!-f $file) {
- return;
- }
-
- # open file
- my $fh = new FileHandle;
- if (!open($fh, "<", $file)) {
- die("could not open existing message file ($file): $!\n");
- }
- my @file = <$fh>;
- close($fh);
-
- # now go through every line of the file and get messages
- foreach my $line (@file) {
- $line =~ s/[\r\n]//gs;
- if ($line =~ /^[\s]*\#/) {
- # skip comments
- next;
- }
- # validate if this is a key:value line
- if ($line =~ /^([^\s\:]+):[\s]*(.+)$/) {
- my $key = $1;
- my $value = $2;
- # do we already have an array for this key?
- if (!defined($main::messages{$key})) {
- $main::messages{$key} = [];
- }
- push(@{$main::messages{$key}}, $value);
- }
- }
+ my $irc = $heap->{irc};
+ my $session = find_irc_session($irc);
+ print_msg("on_nickused(session: $session)\n", DEBUG);
+
+
+ # extract the nickname from the error message
+ $nick_name =~ s/^(.+?) :Nickname is already in use./$1/;
+ print_msg("nickname ($nick_name) not available", INFO);
+
+ # only try to change the nickname, if the session is not logged in
+ # this happens if the desired nick is in use during reconnect
+ if (!$irc->logged_in()) {
+ # try another nickname
+ $nick_name .= '_';
+ if ($nick_name =~ /^(.+?)(_+)$/) {
+ if (length($2) > 2) {
+ # too many '_' in the nick, let's start over again
+ $nick_name = $1;
+ }
+ }
+ print_msg("sending new nickname: $nick_name", INFO);
+ $irc->yield( nick => $nick_name );
+ }
}
-sub get_message {
- my $msg = shift;
- if (!defined($msg)) {
- return '';
- }
+# on_end_motd()
+#
+# catch the end of the MOTD
+#
+# note:
+# - used to find out when the session is finally logged in
+#
+sub on_end_motd {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
- # key not found in message file
- if (!defined($main::messages{$msg})) {
- return '';
- }
+ my $irc = $heap->{irc};
+ my $session = find_irc_session($irc);
+ print_msg("on_end_motd(session: $session)\n", DEBUG);
- return '';
+ $main::sessions{$session}{'past_motd'} = 1;
}
-################
-# Main
-################
-print_msg("Creating new IRC bot\n");
+# on_error()
+#
+# catch any error during communication with irc
+#
+sub on_error {
+ my ($sender, $kernel, $heap, $text) = @_[SENDER, KERNEL, HEAP, ARG0];
+
+ my $irc = $sender->get_heap();
+ my $session = find_irc_session($irc);
-POE::Component::IRC->new($pg_docbot) or die "Failed to create pg_docbot $!";
+ print_msg("on_error(session: $session, error: \"" . $text . "\")\n", DEBUG);
-print_msg("Starting IRC session\n");
+ if ($shutdown == 1) {
+ print_msg("Shutting down in on_error(session: $session)", INFO);
+ # the real shutdown will take place in execute_shutdown()
+ # the call is triggered in death() or interrupt_handler_quit()
+ } else {
+ print_msg("Reconnect session: $session", INFO);
+ # reconnect will be handled by Component::IRC Component::IRC::Plugin::Connector
+ }
+}
-POE::Session->create(
- inline_states => {
- _start => \&on_start,
- _default => \&_default,
- irc_error => \&on_error,
- irc_disconnected => \&on_disconnected,
- irc_socketerr => \&on_reconnect,
- irc_001 => \&on_connect,
- irc_433 => \&on_nickused,
- irc_353 => \&on_names,
- irc_join => \&on_join,
- irc_part => \&on_part,
- irc_quit => \&on_quit,
- irc_nick => \&on_nick,
- irc_330 => \&on_whois_identified,
- irc_318 => \&on_whois_end,
- irc_public => \&on_message,
- irc_msg => \&on_message,
- },
-);
-# Run the bot until it is done.
-#POE::Kernel->run;
-$poe_kernel->run;
-exit 0;
-# vi: ts=4
+#
+## vi: ts=4
projects / docbot.git / commitdiff