From 79f16c3a3126906054be116951d0d808f99f975b Mon Sep 17 00:00:00 2001 From: Andreas Scherbaum Date: Sun, 15 Jan 2012 23:40:34 +0100 Subject: [PATCH] - almost complete rewrite - connect to irc works - multiple session works - configuration works --- config.pm | 447 ++++++++---- db.pm | 100 +++ docbot.conf | 62 +- docbot.pl | 1932 ++++++++++++++++++++++++--------------------------- 4 files changed, 1394 insertions(+), 1147 deletions(-) create mode 100644 db.pm diff --git a/config.pm b/config.pm index 4aa3b6c..1e47fb9 100755 --- a/config.pm +++ b/config.pm @@ -20,10 +20,10 @@ package docbot::config; # # $config = docbot::config->new(); # $config->set_autosave(); -# $var = $config->get_key(); -# $config->set_key(, ); -# $config->delete_key(); -# %var = $config->get_config_keys(); +# $var = $config->config_get_key(); +# $config->config_set_key(, ); +# $config->config_delete_key(); +# %var = $config->config_get_keys(); # $config->save_config(); # from new() will be used # $config->save_config(); @@ -32,6 +32,9 @@ package docbot::config; use strict; use POSIX; # some standards use FileHandle; # have variables for the filehandles +use Data::Dumper; +use YAML::XS qw (/./); + # new() # @@ -42,34 +45,41 @@ use FileHandle; # have variables for the filehandles # return: # - pointer to config class sub new { - my $class = shift; - # get config file - my $config_file = shift; - # test if config file exists - if (!-f $config_file) { - die "could not find config file: $config_file\n"; - } - my $self = {}; - # bless mysqlf - bless($self, $class); - # define own variables - # open config - $self->{config} = $self->open_config($config_file); - if (!defined($self->{config})) { - die "could not open/parse config file: $config_file\n"; - } - # save config file name for later use - $self->{config_file} = $config_file; - # set config to 'not changed' - $self->{changed} = 0; - # deactivate auto-save mode - $self->{autosave} = 0; - - # return reference - return $self; + my $class = shift; + + my $self = {}; + # bless mysqlf + bless($self, $class); + # define own variables + + # deactivate auto-save mode + $self->{autosave} = 0; + # config file name + $self->{config_file} = undef; + + $self->{config} = undef; + + # return reference + return $self; } -# open_config() + +# empty_config() +# +# constructor +# +# parameter: +# none +# return: +# none +sub empty_config { + my $self = shift; + + $self->{config} = undef; +} + + +# read_config() # # read in a config file # @@ -77,32 +87,50 @@ sub new { # - self # - config filename # return: -# - reference to hash with config values -sub open_config { - my $self = shift; - if (!ref($self)) { - die "do not call me from outside!\n"; - } - # should be already validated for existence in new() - my $config_file = shift; - my $fh = new FileHandle; - # define hash for config - my %config = (); - open($fh, $config_file) || die "could not open config file ($config_file): $!\n"; - # read every line - while (my $line = <$fh>) { - # remove any line ending char - $line =~ s/^(.*?)[\s\r\n]*$/$1/g; - if ($line =~ /^([a-zA-Z0-9\-_]+)[\s\t]*=[\s\t]*(.*)$/) { - $config{$1} = $2; - #print "read config line: $1 -> $2\n"; +# none +sub read_config { + my $self = shift; + my $config_file = shift; + + # test if config file exists + if (!-f $config_file) { + die "could not find config file: $config_file\n"; } - } - close($fh); - # return config - return \%config; + + my $config = LoadFile($config_file); + + # save config file name for later use + $self->{config_file} = $config_file; + # set config to 'not changed' + $self->{changed} = 0; + # store config + $self->{config} = $config; + + return; } + +# reread_config() +# +# reread an already readed configfile +# +# parameter: +# - self +# return: +# none +sub reread_config { + my $self = shift; + +die("FIXME: reread_config() not possible\n"); + + #if (!defined($self->{config_file})) { + # die "config file is not known\n"; + #} + + #$self->read_config($self->{config_file}); +} + + # set_autosave() # # set autosave mode for config @@ -113,20 +141,22 @@ sub open_config { # return: # none sub set_autosave { - my $self = shift; - my $autosave = shift; - # validate the given mode - if ($autosave eq "1" or lc($autosave) eq "yes" or lc($autosave) eq "on") { - # set to 'on' - $self->{autosave} = 1; - } elsif ($autosave eq "0" or lc($autosave) eq "no" or lc($autosave) eq "off") { - # set to 'off' - $self->{autosave} = 0; - } else { - die "could not recognize autosave mode: $autosave (please use on/off)\n"; - } + my $self = shift; + my $autosave = shift; + + # validate the autosave mode + if ($autosave eq "1" or lc($autosave) eq "yes" or lc($autosave) eq "on") { + # set to 'on' + $self->{autosave} = 1; + } elsif ($autosave eq "0" or lc($autosave) eq "no" or lc($autosave) eq "off") { + # set to 'off' + $self->{autosave} = 0; + } else { + die "could not recognize autosave mode: $autosave (please use on/off)\n"; + } } + # DESTROY() # # destructor @@ -136,85 +166,232 @@ sub set_autosave { # return: # none sub DESTROY { - my $self = shift; - # check autosave mode - if ($self->{autosave} == 1) { - # check if config is saved - if ($self->{changed} == 1) { - # save the config - $self->save_config(); + my $self = shift; + + # check autosave mode + if ($self->{autosave} == 1) { + # check if config is saved + if ($self->{changed} == 1) { + # save the config + $self->save_config(); + } + } +} + + +# config_get_key1() +# +# return a config value +# +# parameter: +# - self +# - config key name 1 +# return: +# - value of config parameter (or undef) +sub config_get_key1 { + my $self = shift; + my $key1 = shift; + + if (!defined($self->{config}->{$key1})) { + return undef; } - } + + # return value + return $self->{config}->{$key1}; } -# get_key() + +# config_get_key2() # # return a config value # # parameter: # - self -# - config key name +# - config key name 1 +# - config key name 2 # return: # - value of config parameter (or undef) -sub get_key { - my $self = shift; - my $key = shift; - # return value - return $self->{config}->{$key}; +sub config_get_key2 { + my $self = shift; + my $key1 = shift; + my $key2 = shift; + + if (!defined($self->{config}->{$key1})) { + return undef; + } + if (!defined($self->{config}->{$key1}->{$key2})) { + return undef; + } + + # return value + return $self->{config}->{$key1}->{$key2}; } -# set_key() + +# config_get_key3() +# +# return a config value +# +# parameter: +# - self +# - config key name 1 +# - config key name 2 +# - config key name 3 +# return: +# - value of config parameter (or undef) +sub config_get_key3 { + my $self = shift; + my $key1 = shift; + my $key2 = shift; + my $key3 = shift; + + if (!defined($self->{config}->{$key1})) { + return "1"; + } + if (!defined($self->{config}->{$key1}->{$key2})) { + return "2"; + } + if (!defined($self->{config}->{$key1}->{$key2}->{$key3})) { + return "3"; + } + + # return value + return $self->{config}->{$key1}->{$key2}->{$key3}; +} + + +# config_set_key() # # set a new config value # # parameter: # - self -# - config key name +# - config key name 1 +# - config key name 2 # - new value # return: # none -sub set_key { - my $self = shift; - my $key = shift; - my $new_value = shift; - # set new value - $self->{config}->{$key} = $new_value; - # mark config changed - $self->{changed} = 1; +sub config_set_key_unused { + my $self = shift; + my $key1 = shift; + my $key2 = shift; + my $new_value = shift; + + # set new value + $self->{config}->{$key1}->{$key2} = $new_value; + + # mark config changed + $self->{changed} = 1; +} + + +# config_delete_key() +# +# delete a config key +# +# parameter: +# - self +# - config key name 1 +# return: +# none +sub config_delete_key1 { + my $self = shift; + my $key1 = shift; + + # delete key + delete($self->{config}->{$key1}); + + # mark config changed + $self->{changed} = 1; +} + + +# config_delete_key2() +# +# delete a config key +# +# parameter: +# - self +# - config key name 1 +# - config key name 2 +# return: +# none +sub config_delete_key2 { + my $self = shift; + my $key1 = shift; + my $key2 = shift; + + # delete key + delete($self->{config}->{$key1}->{$key2}); + + # mark config changed + $self->{changed} = 1; } -# delete_key() + +# config_delete_key3() # # delete a config key # # parameter: # - self -# - config key name +# - config key name 1 +# - config key name 2 +# - config key name 3 # return: # none -sub delete_key { - my $self = shift; - my $key = shift; - # delete key - delete($self->{config}->{$key}); - # mark config changed - $self->{changed} = 1; +sub config_delete_key3 { + my $self = shift; + my $key1 = shift; + my $key2 = shift; + my $key3 = shift; + + # delete key + delete($self->{config}->{$key1}->{$key2}->{$key3}); + + # mark config changed + $self->{changed} = 1; } -# get_config_keys() + +# config_get_keys1() # # return hash with all defined config keys # # parameter: # - self +# - config key 1 # return: # - hash with config keys -sub get_config_keys { - my $self = shift; - # return sorted hash - return sort(keys(%{$self->{config}})); +sub config_get_keys1 { + my $self = shift; + my $key1 = shift; + + if (!defined($self->{config}->{$key1})) { + return undef; + } + + if (ref($self->{config}->{$key1}) eq '') { + # return value + return $self->{config}->{$key1}; + } + + if (ref($self->{config}->{$key1}) eq 'HASH') { + # return sorted hash + my $config = $self->{config}->{$key1}; + my %config = %$config; + # returns an array with the values + return sort(keys(%config)); + } + + if (ref($self->{config}->{$key1}) eq 'ARRAY') { + die("FIXME: not yet implemented - required?\n"); + } + + return undef; } + # save_config() # # write the config to disk @@ -227,32 +404,46 @@ sub get_config_keys { # comment: # - if no filename is given, the original config filename will be used sub save_config { - my $self = shift; - # get original config filename - my $config_file = $self->{config_file}; - if (defined($_[0])) { - # another config filename is given - $config_file = shift; - } - my $fh = new FileHandle; - # open config file for write - open($fh, ">$config_file") || die "could not open config file for write ($config_file): $!\n"; - my ($key, $value); - # get all keys - foreach $key ($self->get_config_keys()) { - # get the value for the key - $value = $self->get_key($key); - #print "write config line: $key -> $value\n"; - print $fh "$key = $value\n"; - } - # flush the filehandle to get stuff written to disk - $fh->flush; - # close filehandle - close($fh); - #mark config unchanged - $self->{changed} = 0; + my $self = shift; + # get original config filename + my $config_file = $self->{config_file}; + + if (defined($_[0])) { + # another config filename is given + $config_file = shift; + } + + my $write_config = Dump($self->{config}); + + my $fh = new FileHandle; + # open config file for write + open($fh, ">$config_file") || die "could not open config file for write ($config_file): $!\n"; + # write out the dump + print $fh $write_config; + # flush the filehandle to get stuff written to disk + $fh->flush; + # close filehandle + close($fh); + # mark config unchanged + $self->{changed} = 0; +} + + +# config_file() +# +# return the name of the config file +# +# parameter: +# none +# return: +# - config file name +sub config_file { + my $self = shift; + + return $self->{config_file}; } + # finish module 1; diff --git a/db.pm b/db.pm new file mode 100644 index 0000000..38d6a68 --- /dev/null +++ b/db.pm @@ -0,0 +1,100 @@ +#!/usr/bin/perl + + +package docbot::db; +# +# database class for docbot +# + +use strict; +use POSIX; # some standards +use DBI; +use Data::Dumper; + + +use constant DEBUG2 => 4; +use constant DEBUG => 3; +use constant ERROR => 2; +use constant WARN => 1; +use constant INFO => 0; + + +# new() +# +# constructor +# +# parameter: +# - class name +# return: +# - pointer to config class +sub new { + my $class = shift; + my $self = {}; + # bless mysqlf + bless($self, $class); + + # define own variables + # db connection + $self->{db_connection} = undef; + + # return reference + return $self; +} + + +# DESTROY() +# +# destructor +# +# parameter: +# - self +# return: +# none +sub DESTROY { + my $self = shift; + +} + + +sub open_db_connection { + my $self = shift; + + my $DSN = "dbi:Pg:dbname=$main::db_name"; + if ($main::db_host) { + $DSN .= ";host=$main::db_host"; + } + if ($main::db_port) { + $DSN .= ";port=$main::db_port"; + } + + my $dbh = DBI->connect_cached( + $DSN, + $main::db_user, + $main::db_pass, + { + "RaiseError" => 0, + "PrintError" => 0, + "AutoCommit" => 0 + } + ); + + unless ($dbh) { + print_msg("Can't connect to database - $DBI::errstr\n", ERROR); + return 0; + } + + $dbh->{RaiseError} = 1; + + if ($main::db_schema) { + $dbh->do("SET search_path = '$main::db_schema'"); + $dbh->commit(); + } + + $self->{db_connection} = $dbh; + + return 1; +} + + +# finish module +1; diff --git a/docbot.conf b/docbot.conf index 4efa081..83c66aa 100644 --- a/docbot.conf +++ b/docbot.conf @@ -1,11 +1,51 @@ -IRCNick = pg_docbot -IRCPass = micro -IRCServer = irc.linux.org:6666 -IRCName = PostgreSQL IRC infobot -DBName = docbot -DBHost = 127.0.0.1 -DBUsername = docbot -DBPassword = 9T8bYt9H -DBPort = 5432 -IRCMuteNicks = rtfm_please -DBSchema = public +--- +channels: + '#pg_docbot': + password: '' + session: 1 + language: 'en' + '#pg_docbot_test1': + password: '' + session: 2 + language: 'en' + '#pg_docbot_test2': + password: '' + session: 3 + language: 'en' + '#pg_docbot_test3': + password: '' + session: 3 + language: 'en' +database: + host: 127.0.0.1 + name: docbot + password: 9T8bYt9H + port: 5432 + schema: public + username: docbot +irc: + name: PostgreSQL IRC infobot + port: 6667 + server: irc.freenode.org +sessions: + '1': + nickname: pg_docbot_ads + password: nick1 + '2': + nickname: pg_docbot_test2 + password: nick2 + '3': + nickname: pg_docbot_test3 + password: nick3 +bot: + commandchannel: '#pg_docbot' + ircmaxchannels: 2 + ircmaxsessions: 3 + queryprefix: '??' + urlpattern: '(http|ftp|news|bt|https)://' + maxwrap: 3 + likesearch: 0 + casesearch: 0 +translations: + de: + learn: lerne diff --git a/docbot.pl b/docbot.pl index df185b4..7014c51 100755 --- a/docbot.pl +++ b/docbot.pl @@ -1,9 +1,10 @@ #!/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 # # # @@ -11,1145 +12,1080 @@ # # ########################################################### -########### -# # -# 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") { @@ -1192,126 +1128,106 @@ sub _default { 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 -- 2.39.5