--- /dev/null
+#!/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
projects / docbot.git / commitdiff