mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-20 02:49:49 +01:00
8c16fbd3e5
E.g., <pragma-> Userbob: You can learn more about candide by reading its !help page and checking out its !source <candide> Userbob: To learn all about me, see http://www.iso-9899.info/wiki/Candide <candide> Userbob: My guts can be browsed at https://github.com/pragma-/pbot Only three triggers will be processed per message. (I should create a registry entry to customize this.) Messages that are addressed at a specific user that exists in the channel will have that user's name prepended to the factoid output. Factoid triggers that are referenced from within messages will not produce error messages if the factoid is not found. Factoids that have an $arg or $nick special variable will not be triggered as a reference. Factoids that have the `noembed` meta-data value set to a true value will not be invoked as a reference.
462 lines
17 KiB
Perl
462 lines
17 KiB
Perl
# File: Interpreter.pm
|
|
# Author: pragma_
|
|
#
|
|
# Purpose:
|
|
|
|
package PBot::Interpreter;
|
|
|
|
use warnings;
|
|
use strict;
|
|
|
|
use base 'PBot::Registerable';
|
|
|
|
use Time::HiRes qw/gettimeofday/;
|
|
use Time::Duration;
|
|
use LWP::UserAgent;
|
|
use Carp ();
|
|
|
|
sub new {
|
|
if(ref($_[1]) eq 'HASH') {
|
|
Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference");
|
|
}
|
|
|
|
my ($class, %conf) = @_;
|
|
my $self = bless {}, $class;
|
|
$self->initialize(%conf);
|
|
return $self;
|
|
}
|
|
|
|
sub initialize {
|
|
my ($self, %conf) = @_;
|
|
|
|
$self->SUPER::initialize(%conf);
|
|
|
|
$self->{pbot} = delete $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
|
|
|
|
$self->{pbot}->{registry}->add_default('text', 'general', 'show_url_titles', $conf{show_url_titles} // 1);
|
|
$self->{pbot}->{registry}->add_default('array', 'general', 'show_url_titles_channels', $conf{show_url_titles_channels} // '.*');
|
|
$self->{pbot}->{registry}->add_default('array', 'general', 'show_url_titles_ignore_channels', $conf{show_url_titles_ignore_channels} // 'none');
|
|
$self->{pbot}->{registry}->add_default('text', 'general', 'compile_blocks', $conf{compile_blocks} // 1);
|
|
$self->{pbot}->{registry}->add_default('array', 'general', 'compile_blocks_channels', $conf{compile_blocks_channels} // '.*');
|
|
$self->{pbot}->{registry}->add_default('array', 'general', 'compile_blocks_ignore_channels', $conf{compile_blocks_ignore_channels} // 'none');
|
|
$self->{pbot}->{registry}->add_default('text', 'general', 'paste_ratelimit', $conf{paste_ratelimit} // 60);
|
|
$self->{pbot}->{registry}->add_default('text', 'interpreter', 'max_recursion', 10);
|
|
|
|
$self->{output_queue} = {};
|
|
$self->{last_paste} = 0;
|
|
|
|
$self->{pbot}->{timer}->register(sub { $self->process_output_queue }, 1);
|
|
}
|
|
|
|
sub process_line {
|
|
my $self = shift;
|
|
my ($from, $nick, $user, $host, $text) = @_;
|
|
|
|
my $command;
|
|
my $has_url;
|
|
my $has_code;
|
|
my $nick_override;
|
|
my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
|
|
|
|
$from = lc $from if defined $from;
|
|
|
|
my $pbot = $self->{pbot};
|
|
|
|
my $message_account = $pbot->{messagehistory}->get_message_account($nick, $user, $host);
|
|
$pbot->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $from, $text, $pbot->{messagehistory}->{MSG_CHAT});
|
|
|
|
my $flood_threshold = $pbot->{registry}->get_value($from, 'chat_flood_threshold');
|
|
my $flood_time_threshold = $pbot->{registry}->get_value($from, 'chat_flood_time_threshold');
|
|
|
|
$flood_threshold = $pbot->{registry}->get_value('antiflood', 'chat_flood_threshold') if not defined $flood_threshold;
|
|
$flood_time_threshold = $pbot->{registry}->get_value('antiflood', 'chat_flood_time_threshold') if not defined $flood_time_threshold;
|
|
|
|
$pbot->{antiflood}->check_flood($from, $nick, $user, $host, $text,
|
|
$flood_threshold, $flood_time_threshold,
|
|
$pbot->{messagehistory}->{MSG_CHAT}) if defined $from;
|
|
|
|
$text =~ s/^\s+//;
|
|
$text =~ s/\s+$//;
|
|
my $preserve_whitespace = 0;
|
|
|
|
my $cmd_text = $text;
|
|
$cmd_text =~ s/^\/me\s+//;
|
|
|
|
# get channel-specific trigger if available
|
|
my $bot_trigger = $pbot->{registry}->get_value($from, 'trigger');
|
|
|
|
if (not defined $bot_trigger) {
|
|
$bot_trigger = $pbot->{registry}->get_value('general', 'trigger');
|
|
}
|
|
|
|
my $referenced;
|
|
my $count = 0;
|
|
while (++$count <= 3) {
|
|
$referenced = 0;
|
|
$command = undef;
|
|
$has_url = undef;
|
|
$has_code = undef;
|
|
|
|
if($cmd_text =~ s/^(?:$bot_trigger|$botnick.?)?\s*{\s*(.*)\s*}\s*$//) {
|
|
$has_code = $1 if length $1;
|
|
$preserve_whitespace = 1;
|
|
} elsif($cmd_text =~ s/^$bot_trigger(.*)$//) {
|
|
$command = $1;
|
|
} elsif($cmd_text =~ s/^.?$botnick.?\s*(.*?)$//i) {
|
|
$command = $1;
|
|
} elsif($cmd_text =~ s/^(.*?),?\s*$botnick[?!.]*$//i) {
|
|
$command = $1;
|
|
} elsif($cmd_text =~ s/https?:\/\/([^\s]+)//i) {
|
|
$has_url = $1;
|
|
} elsif($cmd_text =~ s/^\s*([^,:\(\)\+\*\/ ]+)[,:]*\s*{\s*(.*)\s*}\s*$//) {
|
|
$nick_override = $1;
|
|
$has_code = $2 if length $2 and $nick_override ne 'enum' and $nick_override ne 'struct';
|
|
$preserve_whitespace = 1;
|
|
} elsif ($cmd_text =~ s/\B$bot_trigger([^ ]+)//) {
|
|
my $cmd = $1;
|
|
$cmd =~ s/(.)[.!?;,)]$/$1/;
|
|
my ($nick) = $cmd_text =~ m/^([^ ,:;]+)/;
|
|
$nick = $self->{pbot}->{nicklist}->is_present($from, $nick);
|
|
if ($nick) {
|
|
$command = "tell $nick about $cmd";
|
|
} else {
|
|
$command = $cmd;
|
|
}
|
|
$referenced = 1;
|
|
}
|
|
|
|
last if not defined $command and not defined $has_url and not defined $has_code;
|
|
|
|
if((defined $command && $command !~ /^login/i) || defined $has_url || defined $has_code) {
|
|
if(defined $from && $pbot->{ignorelist}->check_ignore($nick, $user, $host, $from)) {
|
|
my $admin = $pbot->{admins}->loggedin($from, "$nick!$user\@$host");
|
|
if (!defined $admin || $admin->{level} < 10) {
|
|
# ignored hostmask
|
|
return;
|
|
}
|
|
}
|
|
|
|
if(defined $has_url) {
|
|
if($pbot->{registry}->get_value('general', 'show_url_titles') and not $pbot->{registry}->get_value($from, 'no_url_titles')
|
|
and not grep { $from =~ /$_/i } $pbot->{registry}->get_value('general', 'show_url_titles_ignore_channels')
|
|
and grep { $from =~ /$_/i } $pbot->{registry}->get_value('general', 'show_url_titles_channels')) {
|
|
$pbot->{factoids}->{factoidmodulelauncher}->execute_module($from, undef, $nick, $user, $host, $text, "title", "$nick http://$has_url", $preserve_whitespace);
|
|
}
|
|
} elsif(defined $has_code) {
|
|
if($pbot->{registry}->get_value('general', 'compile_blocks') and not $pbot->{registry}->get_value($from, 'no_compile_blocks')
|
|
and not grep { $from =~ /$_/i } $pbot->{registry}->get_value('general', 'compile_blocks_ignore_channels')
|
|
and grep { $from =~ /$_/i } $pbot->{registry}->get_value('general', 'compile_blocks_channels')) {
|
|
if (not defined $nick_override or (defined $nick_override and $self->{pbot}->{nicklist}->is_present($from, $nick_override))) {
|
|
$pbot->{factoids}->{factoidmodulelauncher}->execute_module($from, undef, $nick, $user, $host, $text, "compiler_block", (defined $nick_override ? $nick_override : $nick) . " $from $has_code }", $preserve_whitespace);
|
|
}
|
|
}
|
|
} else {
|
|
$self->handle_result($from, $nick, $user, $host, $text, $command, $self->interpret($from, $nick, $user, $host, 1, $command, undef, $referenced), 1, $preserve_whitespace);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub interpret {
|
|
my $self = shift;
|
|
my ($from, $nick, $user, $host, $depth, $command, $tonick, $referenced) = @_;
|
|
my ($keyword, $arguments) = ("", "");
|
|
my $text;
|
|
my $pbot = $self->{pbot};
|
|
|
|
$pbot->{logger}->log("=== Enter interpret_command: [" . (defined $from ? $from : "(undef)") . "][$nick!$user\@$host][$depth][$command]\n");
|
|
|
|
return "Too many levels of recursion, aborted." if(++$depth > $self->{pbot}->{registry}->get_value('interpreter', 'max_recursion'));
|
|
|
|
if(not defined $nick || not defined $user || not defined $host ||
|
|
not defined $command) {
|
|
$pbot->{logger}->log("Error 1, bad parameters to interpret_command\n");
|
|
return undef;
|
|
}
|
|
|
|
if($command =~ /^tell\s+(.{1,20})\s+about\s+(.*?)\s+(.*)$/i)
|
|
{
|
|
($keyword, $arguments, $tonick) = ($2, $3, $1);
|
|
} elsif($command =~ /^tell\s+(.{1,20})\s+about\s+(.*)$/i) {
|
|
($keyword, $tonick) = ($2, $1);
|
|
} elsif($command =~ /^(.*?)\s+(.*)$/) {
|
|
($keyword, $arguments) = ($1, $2);
|
|
} else {
|
|
$keyword = $command;
|
|
}
|
|
|
|
if($keyword ne "factadd"
|
|
and $keyword ne "add"
|
|
and $keyword ne "factfind"
|
|
and $keyword ne "find"
|
|
and $keyword ne "factshow"
|
|
and $keyword ne "show"
|
|
and $keyword ne "factset"
|
|
and $keyword ne "factchange"
|
|
and $keyword ne "change"
|
|
and $keyword ne "msg") {
|
|
$keyword =~ s/(\w+)([?!.]+)$/$1/;
|
|
$arguments =~ s/(?<![\w\/\-])me\b/$nick/gi if defined $arguments;
|
|
}
|
|
|
|
if(defined $arguments && $arguments =~ m/^(your|him|her|its|it|them|their)(self|selves)$/i) {
|
|
my $delay = (rand 10) + 8;
|
|
my $message = {
|
|
nick => $nick, user => $user, host => $host, command => $command, checkflood => 1,
|
|
message => "Why would I want to do that to myself?"
|
|
};
|
|
$self->add_message_to_output_queue($from, $message, $delay);
|
|
return undef;
|
|
}
|
|
|
|
if(not defined $keyword) {
|
|
$pbot->{logger}->log("Error 2, no keyword\n");
|
|
return undef;
|
|
}
|
|
|
|
return $self->SUPER::execute_all($from, $nick, $user, $host, $depth, $keyword, $arguments, $tonick, undef, $referenced);
|
|
}
|
|
|
|
sub truncate_result {
|
|
my ($self, $from, $nick, $text, $original_result, $result, $paste) = @_;
|
|
my $max_msg_len = $self->{pbot}->{registry}->get_value('irc', 'max_msg_len');
|
|
|
|
if(length $result > $max_msg_len) {
|
|
my $link;
|
|
if($paste) {
|
|
$link = $self->paste("[" . (defined $from ? $from : "stdin") . "] <$nick> $text\n\n$original_result");
|
|
} else {
|
|
$link = 'undef';
|
|
}
|
|
|
|
my $trunc = "... [truncated; ";
|
|
if ($link =~ m/^http/) {
|
|
$trunc .= "see $link for full text.]";
|
|
} else {
|
|
$trunc .= "$link]";
|
|
}
|
|
|
|
$self->{pbot}->{logger}->log("Message truncated -- pasted to $link\n") if $paste;
|
|
|
|
my $trunc_len = length $result < $max_msg_len ? length $result : $max_msg_len;
|
|
$result = substr($result, 0, $trunc_len);
|
|
substr($result, $trunc_len - length $trunc) = $trunc;
|
|
}
|
|
|
|
return $result;
|
|
}
|
|
|
|
sub handle_result {
|
|
my ($self, $from, $nick, $user, $host, $text, $command, $result, $checkflood, $preserve_whitespace) = @_;
|
|
|
|
if (not defined $result or length $result == 0) {
|
|
return;
|
|
}
|
|
|
|
my $original_result = $result;
|
|
|
|
my $use_output_queue = 0;
|
|
|
|
if (defined $command) {
|
|
my ($cmd, $args) = split / /, $command, 2;
|
|
if (not $self->{pbot}->{commands}->exists($cmd)) {
|
|
my ($chan, $trigger) = $self->{pbot}->{factoids}->find_factoid($from, $cmd, $args, 1, 0, 1);
|
|
if(defined $trigger) {
|
|
if ($preserve_whitespace == 0) {
|
|
$preserve_whitespace = $self->{pbot}->{factoids}->{factoids}->hash->{$chan}->{$trigger}->{preserve_whitespace};
|
|
$preserve_whitespace = 0 if not defined $preserve_whitespace;
|
|
}
|
|
|
|
$use_output_queue = $self->{pbot}->{factoids}->{factoids}->hash->{$chan}->{$trigger}->{use_output_queue};
|
|
$use_output_queue = 0 if not defined $use_output_queue;
|
|
}
|
|
}
|
|
}
|
|
|
|
my $preserve_newlines = $self->{pbot}->{registry}->get_value($from, 'preserve_newlines');
|
|
|
|
$result =~ s/[\n\r]/ /g unless $preserve_newlines;
|
|
$result =~ s/[ \t]+/ /g unless $preserve_whitespace;
|
|
|
|
my $max_lines = $self->{pbot}->{registry}->get_value($from, 'max_newlines');
|
|
$max_lines = 4 if not defined $max_lines;
|
|
my $lines = 0;
|
|
|
|
my $stripped_line;
|
|
foreach my $line (split /[\n\r]+/, $result) {
|
|
$stripped_line = $line;
|
|
$stripped_line =~ s/^\s+//;
|
|
$stripped_line =~ s/\s+$//;
|
|
next if not length $stripped_line;
|
|
|
|
if (++$lines >= $max_lines) {
|
|
my $link = $self->paste("[" . (defined $from ? $from : "stdin") . "] <$nick> $text\n\n$original_result");
|
|
if ($use_output_queue) {
|
|
my $message = {
|
|
nick => $nick, user => $user, host => $host, command => $command,
|
|
message => "And that's all I have to say about that. See $link for full text.",
|
|
checkflood => $checkflood
|
|
};
|
|
$self->add_message_to_output_queue($from, $message, 0);
|
|
} else {
|
|
$self->{pbot}->{conn}->privmsg($from, "And that's all I have to say about that. See $link for full text.");
|
|
}
|
|
last;
|
|
}
|
|
|
|
if ($preserve_newlines) {
|
|
$line = $self->truncate_result($from, $nick, $text, $line, $line, 1);
|
|
} else {
|
|
$line = $self->truncate_result($from, $nick, $text, $original_result, $line, 1);
|
|
}
|
|
|
|
if ($use_output_queue) {
|
|
my $delay = (rand 5) + 5; # initial delay for reading/processing user's message
|
|
$delay += (length $line) / 7; # additional delay of 7 characters per second typing speed
|
|
my $message = {
|
|
nick => $nick, user => $user, host => $host, command => $command,
|
|
message => $line, checkflood => $checkflood
|
|
};
|
|
$self->add_message_to_output_queue($from, $message, $delay);
|
|
$delay = duration($delay);
|
|
$self->{pbot}->{logger}->log("Final result ($delay delay) [$line]\n");
|
|
} else {
|
|
$self->output_result($from, $nick, $user, $host, $command, $line, $checkflood);
|
|
$self->{pbot}->{logger}->log("Final result: [$line]\n");
|
|
}
|
|
}
|
|
$self->{pbot}->{logger}->log("---------------------------------------------\n");
|
|
}
|
|
|
|
sub output_result {
|
|
my ($self, $from, $nick, $user, $host, $command, $line, $checkflood) = @_;
|
|
my ($pbot, $botnick) = ($self->{pbot}, $self->{pbot}->{registry}->get_value('irc', 'botnick'));
|
|
|
|
if($line =~ s/^\/say\s+//i) {
|
|
$pbot->{conn}->privmsg($from, $line) if defined $from && $from !~ /\Q$botnick\E/i;
|
|
$pbot->{antiflood}->check_flood($from, $botnick, $pbot->{registry}->get_value('irc', 'username'), 'localhost', $line, 0, 0, 0) if $checkflood;
|
|
} elsif($line =~ s/^\/me\s+//i) {
|
|
$pbot->{conn}->me($from, $line) if defined $from && $from !~ /\Q$botnick\E/i;
|
|
$pbot->{antiflood}->check_flood($from, $botnick, $pbot->{registry}->get_value('irc', 'username'), 'localhost', '/me ' . $line, 0, 0, 0) if $checkflood;
|
|
} elsif($line =~ s/^\/msg\s+([^\s]+)\s+//i) {
|
|
my $to = $1;
|
|
if($to =~ /,/) {
|
|
$pbot->{logger}->log("[HACK] Possible HACK ATTEMPT /msg multiple users: [$nick!$user\@$host] [$command] [$line]\n");
|
|
}
|
|
elsif($to =~ /.*serv$/i) {
|
|
$pbot->{logger}->log("[HACK] Possible HACK ATTEMPT /msg *serv: [$nick!$user\@$host] [$command] [$line]\n");
|
|
}
|
|
elsif($line =~ s/^\/me\s+//i) {
|
|
$pbot->{conn}->me($to, $line) if $to !~ /\Q$botnick\E/i;
|
|
$pbot->{antiflood}->check_flood($to, $botnick, $pbot->{registry}->get_value('irc', 'username'), 'localhost', '/me ' . $line, 0, 0, 0) if $checkflood;
|
|
} else {
|
|
$line =~ s/^\/say\s+//i;
|
|
$pbot->{conn}->privmsg($to, $line) if $to !~ /\Q$botnick\E/i;
|
|
$pbot->{antiflood}->check_flood($to, $botnick, $pbot->{registry}->get_value('irc', 'username'), 'localhost', $line, 0, 0, 0) if $checkflood;
|
|
}
|
|
} else {
|
|
$pbot->{conn}->privmsg($from, $line) if defined $from && $from !~ /\Q$botnick\E/i;
|
|
$pbot->{antiflood}->check_flood($from, $botnick, $pbot->{registry}->get_value('irc', 'username'), 'localhost', $line, 0, 0, 0) if $checkflood;
|
|
}
|
|
}
|
|
|
|
sub add_message_to_output_queue {
|
|
my ($self, $channel, $message, $delay) = @_;
|
|
|
|
if (exists $self->{output_queue}->{$channel}) {
|
|
my $last_when = $self->{output_queue}->{$channel}->[-1]->{when};
|
|
$message->{when} = $last_when + $delay;
|
|
} else {
|
|
$message->{when} = gettimeofday + $delay;
|
|
}
|
|
|
|
push @{$self->{output_queue}->{$channel}}, $message;
|
|
}
|
|
|
|
sub process_output_queue {
|
|
my $self = shift;
|
|
|
|
foreach my $channel (keys %{$self->{output_queue}}) {
|
|
for (my $i = 0; $i < @{$self->{output_queue}->{$channel}}; $i++) {
|
|
my $message = $self->{output_queue}->{$channel}->[$i];
|
|
if (gettimeofday >= $message->{when}) {
|
|
$self->output_result($channel, $message->{nick}, $message->{user}, $message->{host}, $message->{command}, $message->{message}, $message->{checkflood});
|
|
splice @{$self->{output_queue}->{$channel}}, $i--, 1;
|
|
}
|
|
}
|
|
|
|
if (not @{$self->{output_queue}->{$channel}}) {
|
|
delete $self->{output_queue}->{$channel};
|
|
}
|
|
}
|
|
}
|
|
|
|
sub paste {
|
|
my $self = shift;
|
|
|
|
my $rate_limit = $self->{pbot}->{registry}->get_value('general', 'paste_ratelimit');
|
|
my $now = gettimeofday;
|
|
|
|
if ($now - $self->{last_paste} < $rate_limit) {
|
|
return "paste rate-limited, try again in " . ($rate_limit - int($now - $self->{last_paste})) . " seconds";
|
|
}
|
|
|
|
$self->{last_paste} = $now;
|
|
|
|
my $text = join(' ', @_);
|
|
$text =~ s/(.{120})\s/$1\n/g;
|
|
|
|
my $result = $self->paste_sprunge($text);
|
|
|
|
if ($result =~ m/error pasting/) {
|
|
$result = $self->paste_codepad($text);
|
|
}
|
|
|
|
return $result;
|
|
}
|
|
|
|
sub paste_codepad {
|
|
my $self = shift;
|
|
my $text = join(' ', @_);
|
|
|
|
$text =~ s/(.{120})\s/$1\n/g;
|
|
|
|
my $ua = LWP::UserAgent->new();
|
|
$ua->agent("Mozilla/5.0");
|
|
push @{ $ua->requests_redirectable }, 'POST';
|
|
|
|
my %post = ( 'lang' => 'Plain Text', 'code' => $text, 'private' => 'True', 'submit' => 'Submit' );
|
|
my $response = $ua->post("http://codepad.org", \%post);
|
|
|
|
if(not $response->is_success) {
|
|
return "error pasting: " . $response->status_line;
|
|
}
|
|
|
|
return $response->request->uri;
|
|
}
|
|
|
|
sub paste_sprunge {
|
|
my $self = shift;
|
|
my $text = join(' ', @_);
|
|
|
|
$text =~ s/(.{120})\s/$1\n/g;
|
|
|
|
my $ua = LWP::UserAgent->new();
|
|
$ua->agent("Mozilla/5.0");
|
|
$ua->requests_redirectable([ ]);
|
|
|
|
my %post = ( 'sprunge' => $text, 'submit' => 'Submit' );
|
|
my $response = $ua->post("http://sprunge.us", \%post);
|
|
|
|
if(not $response->is_success) {
|
|
return "error pasting: " . $response->status_line;
|
|
}
|
|
|
|
my $result = $response->content;
|
|
$result =~ s/^\s+//;
|
|
$result =~ s/\s+$//;
|
|
return $result;
|
|
}
|
|
|
|
1;
|