From: Andreas Scherbaum Date: Tue, 19 Oct 2010 21:04:06 +0000 (+0200) Subject: - initial release X-Git-Tag: v1 X-Git-Url: http://git.postgresql.org/gitweb/?a=commitdiff_plain;h=HEAD;p=docbot.git - initial release --- 718dbd973f92c3d3f520448a74b223af78eea342 diff --git a/config.pm b/config.pm new file mode 100755 index 0000000..4aa3b6c --- /dev/null +++ b/config.pm @@ -0,0 +1,258 @@ +#!/usr/bin/perl + + +package docbot::config; +# +# config class for docbot +# + +# config file schema: +# +# key = value +# key= value +# key =value +# key=value +# key= +# key = value +# ... + +# usage: +# +# $config = docbot::config->new(); +# $config->set_autosave(); +# $var = $config->get_key(); +# $config->set_key(, ); +# $config->delete_key(); +# %var = $config->get_config_keys(); +# $config->save_config(); # from new() will be used +# $config->save_config(); + + + +use strict; +use POSIX; # some standards +use FileHandle; # have variables for the filehandles + +# new() +# +# constructor +# +# parameter: +# - class name +# 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; +} + +# open_config() +# +# read in a config file +# +# parameter: +# - 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"; + } + } + close($fh); + # return config + return \%config; +} + +# set_autosave() +# +# set autosave mode for config +# +# parameter: +# - self +# - autosave mode (on/off) +# 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"; + } +} + +# DESTROY() +# +# destructor +# +# parameter: +# - self +# 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(); + } + } +} + +# get_key() +# +# return a config value +# +# parameter: +# - self +# - config key name +# return: +# - value of config parameter (or undef) +sub get_key { + my $self = shift; + my $key = shift; + # return value + return $self->{config}->{$key}; +} + +# set_key() +# +# set a new config value +# +# parameter: +# - self +# - config key name +# - 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; +} + +# delete_key() +# +# delete a config key +# +# parameter: +# - self +# - config key name +# return: +# none +sub delete_key { + my $self = shift; + my $key = shift; + # delete key + delete($self->{config}->{$key}); + # mark config changed + $self->{changed} = 1; +} + +# get_config_keys() +# +# return hash with all defined config keys +# +# parameter: +# - self +# return: +# - hash with config keys +sub get_config_keys { + my $self = shift; + # return sorted hash + return sort(keys(%{$self->{config}})); +} + +# save_config() +# +# write the config to disk +# +# parameter: +# - self +# - (optional) config filename +# return: +# none +# 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; +} + + +# finish module +1; diff --git a/docbot.conf b/docbot.conf new file mode 100644 index 0000000..4efa081 --- /dev/null +++ b/docbot.conf @@ -0,0 +1,11 @@ +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 diff --git a/docbot.pl b/docbot.pl new file mode 100755 index 0000000..df185b4 --- /dev/null +++ b/docbot.pl @@ -0,0 +1,1317 @@ +#!/usr/bin/perl +########################################################### +# # +# PostgreSQL IRC Info Bot # +# # +# Copyright 2005-2006 by: # +# Petr Jelinek, Devdas Bhagat, Steve Atkins, David Fetter # +# Andreas Scherbaum, Greg Sabino Mullane # +# # +# Released under BSD licence # +# # +########################################################### + +########### +# # +# Modules # +# # +########### + +use strict; +use warnings; +use DBI; +use POE; +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 = ( + 3 => 'DEBUG', + 2 => 'ERROR', + 1 => 'WARN', + 0 => 'INFO', +); + + +# 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 = (); + +# store messages printed for keywords +%main::messages = (); + +############################### +# handle command line arguments +############################### +my $args_init_string = "help h d debug c=s config=s"; +Getopt::Mixed::init($args_init_string); +my $help = 0; +my $debug = 0; +my $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; + } + if ($argv_option eq "d" or $argv_option eq "debug") { + $debug = 1; + } + if ($argv_option eq "c" or $argv_option eq "config") { + $config_file = $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); +} + +# 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); + } +} + +################ +# Functions +################ + + +######## +# 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; + } + } + } + + 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); + + 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); +} + + +######## +# 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); + + return @ret; +} + + +######## +# is_db_ok ( ) +#### +# handles db (re)connection, should be called before any sql commands +# +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"; + } + + $dbh = DBI->connect_cached( + $DSN, + $db_user, + $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 ($db_schema) { + $dbh->do("SET search_path = '$db_schema'"); + $dbh->commit(); + } + + return 1; +} + + +######## +# get_answer ( query ) +#### +# search database for keywords +# +sub get_answer { + my ($query,$like) = @_; + + $CASESEARCH or $query = lc $query; + + my @keys = split(/\s+/, $query); + my $num = @keys; + + unless (is_db_ok()) { + return \["Database error"]; + } + + 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); + } + $sth{$searchnum}->execute(@keys); + my $ret = $dbh->selectcol_arrayref($sth{$searchnum}, {Columns => [1]}); + return $ret; +} + + +######## +# authorized ( {action, nick } ) +#### +# Check if a particular user is authorized to perform an action +# +sub authorized { + + my $arg = shift; + if (ref $arg ne 'HASH') { + die qq{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}; + } + + return "ok" if $EVERYONE_AUTHORIZED; + + $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 + + +######## +# do_learn ( nick, query ) +#### +# auth user nick and save keyword(s) to database +# +sub do_learn { + my ($kernel, $nick, $channel, $query) = @_; + + unless (is_db_ok()) { + return "Database error"; + } + + ## 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; + } + + push(@keywords, lc($keyword)); + } + + if (@keywords == 0 || !defined($url)) { + return "Bad parameters"; + } + + # 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"; + } + } + + # 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"; + } + + my $kurl; + + if (($kurl) = $sth->fetchrow()) { + $sth = $dbh->prepare("SELECT has_key (?, ?)"); + + 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"; + } + + $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"; + } + ($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"; + } + } + + $dbh->commit; + return "Successfully added " + . scalar @keywords + . ' keyword' + . ((scalar(@keywords)==1)?'':'s') + ; +} + + +######## +# do_forget ( nick, query ) +#### +# auth user nick and remove keyword from database +# +sub do_forget { + my ($kernel, $nick, $channel, $query) = @_; + + unless (is_db_ok()) { + return "Database error"; + } + + ## 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"; + } + + $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"}; + } + + my $rows = 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"; + } + } + } + $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; + } + else { + $dbh->rollback; + print_msg("Error deleting key - $DBI::errstr\n", ERROR); + return "Error while deleting key"; + } + } + $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 +# +sub do_config { + my ($kernel, $nick, $channel, $query) = @_; + + print_msg('In do_config'); + + unless (is_db_ok()) { + return "Database error"; + } + + ## 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"; + } + + return "Configuration not supported on this bot" unless (defined($main::config)); + + $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'"; + } +} + + +######## +# on_reconnect ( ) +#### +# +sub on_reconnect { + $poe_kernel->delay( autoping => undef ); + $poe_kernel->delay( connect => 60 ); +} + + +######## +# on_connect ( ) +#### +# called when conencted to irc, joins to selected channels +# +sub on_connect { + my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; + + print_msg("Connected ok, joining channels\n", 4); + + 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 ); +} + + +######## +# on_message ( ) +#### +# called when some message was sent to channel or to bot +# +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} = ""; + } + } + + # 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; + } + } + } + + + 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; + } + } + + 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); + + $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; + } + } + + 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; + } + } + 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; + } 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; + } + + # 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"); + } + } + } +} + + +######## +# on_kick ( ) +#### +# called when somebody was kicked from channel +# +sub on_kick { + my ( $kernel, $heap, $channel, $who ) = @_[ KERNEL, HEAP, ARG1, ARG2 ]; + + 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 ); + } + else { + remove_nick( $heap, $nick, $channel ); + } +} + + +sub on_join { + my ( $kernel, $heap, $who, $channel ) = @_[ KERNEL, HEAP, ARG0, ARG1 ]; + my $nick = ( split /!/, $who )[0]; + + add_nick( $heap, $nick, $channel ); +} + +sub on_quit { + my ( $kernel, $heap, $who ) = @_[ KERNEL, HEAP, ARG0, ARG1 ]; + my $nick = ( split /!/, $who )[0]; + + remove_nick( $heap, $nick ); +} + +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 ); + } +} + +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 ); + } +} + +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 ); + } +} + +######## +# on_start ( ) +#### +# start bot +# +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 + } + ); +} + +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]; + + if (defined($heap->{whois_callback}->{$nick})) { + $heap->{whois_callback}->{$nick}->{authed} = 1; + } +} + +sub on_whois_end { + my ( $kernel, $heap, $detail ) = @_[KERNEL, HEAP, ARG1]; + my $nick = ( split / /, $detail )[0]; + + if (defined($heap->{whois_callback}->{$nick}->{event})) { + $kernel->yield($heap->{whois_callback}->{$nick}->{event}, @{$heap->{whois_callback}->{$nick}->{args}}); + } +} + +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; + + push(@nicknames, $who); + $channels{$channel}->{names} = \@nicknames; + + $heap->{chan_data} = \%channels; +} + + +sub remove_nick { + my ( $heap, $who, $channel ) = @_; + my %channels = %{$heap->{chan_data}}; + + 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); + } + } +} + +sub remove_channel { + my ( $heap, $channel ) = @_; + my %channels = %{$heap->{chan_data}}; + + if (defined($channels{$channel})) { + undef($channels{$channel}); + $heap->{chan_data} = \%channels; + } +} + +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); + } + } + } + + return @channels; +} + +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; + } +} + +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; + } +} + +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"; + } + $shutdown = 1; + $poe_kernel->post ( $pg_docbot => quit => $text ); + print_msg ("Sending quit message: $text"); +} + +# 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") { + $print_it = 0; + } + if ($event eq "irc_ping") { + $print_it = 0; + } + if ($event eq "irc_connected") { + $print_it = 0; + } + if ($event eq "irc_snotice") { + $print_it = 0; + } + if ($event eq "irc_whois") { + $print_it = 0; + } + if ($event eq "irc_mode") { + $print_it = 0; + } + if ($event eq "irc_topic") { + $print_it = 0; + } + if ($event eq "irc_ctcp_action") { + $print_it = 0; + } + if ($event eq "irc_notice") { + if (@$args[0] =~ /^NickServ/) { + $print_it = 0; + } + if (@$args[0] =~ /^ChanServ/) { + $print_it = 0; + } + } + if ($event eq "irc_ctcp_version") { + if (@$args[0] =~ /^freenode\-connect/) { + $print_it = 0; + } + } + if ($event =~ /^irc_\d+/) { + $print_it = 0; + } + if ($print_it == 1) { + $poe_kernel->post(pg_docbot => privmsg => '#pg_docbot', "unhandled event: $event"); + } + + 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. +} + +sub read_messages { + my $file = shift; + + # reset messages + %main::messages = (); + + # 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); + } + } + +} + +sub get_message { + my $msg = shift; + + if (!defined($msg)) { + return ''; + } + + # key not found in message file + if (!defined($main::messages{$msg})) { + return ''; + } + + return ''; + +} + +################ +# Main +################ + +print_msg("Creating new IRC bot\n"); + +POE::Component::IRC->new($pg_docbot) or die "Failed to create pg_docbot $!"; + +print_msg("Starting IRC session\n"); + +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