diff --git a/PBot/Commands.pm b/PBot/Commands.pm index 51e24ade..9f27b343 100644 --- a/PBot/Commands.pm +++ b/PBot/Commands.pm @@ -123,8 +123,9 @@ sub interpreter { sub parse_arguments { my ($self, $arguments) = @_; - $arguments =~ s/(?{pbot}->{factoids}->interpreter($from, $nick, $user, $host, 1, $trigger, $args, undef, $channel); + return $self->{pbot}->{factoids}->interpreter($from, $nick, $user, $host, 1, $trigger, $args, undef, $channel, undef, $trigger); } sub log_factoid { @@ -1302,7 +1302,7 @@ sub factchange { $self->{pbot}->{logger}->log("($from) $nick!$user\@$host: failed to change '$trigger' 's$delim$tochange$delim$changeto$delim\n"); return "Change $trigger failed."; } else { - if (length $action > 400 and not defined $admininfo) { + if (length $action > 1000 and not defined $admininfo) { return "Change $trigger failed; result is too long."; } diff --git a/PBot/FactoidModuleLauncher.pm b/PBot/FactoidModuleLauncher.pm index 63dcafcc..9f613d10 100644 --- a/PBot/FactoidModuleLauncher.pm +++ b/PBot/FactoidModuleLauncher.pm @@ -43,7 +43,7 @@ sub initialize { } sub execute_module { - my ($self, $from, $tonick, $nick, $user, $host, $command, $keyword, $arguments, $preserve_whitespace, $referenced) = @_; + my ($self, $from, $tonick, $nick, $user, $host, $command, $root_channel, $root_keyword, $keyword, $arguments, $preserve_whitespace, $referenced) = @_; my $text; $arguments = "" if not defined $arguments; @@ -159,6 +159,10 @@ sub execute_module { exit 0 if $text =~ m/(?:no results)/i; } + if ($command eq 'code-factoid') { + $text = $self->{pbot}->{factoids}->handle_action($nick, $user, $host, $from, $root_channel, $root_keyword, $root_keyword, $arguments, $text, $tonick, 0, $referenced, undef, $root_keyword); + } + if(defined $tonick) { $self->{pbot}->{logger}->log("($from): $nick!$user\@$host) sent to $tonick\n"); if(defined $text && length $text > 0) { @@ -171,7 +175,7 @@ sub execute_module { } exit 0; } else { - if(exists $self->{pbot}->{factoids}->{factoids}->hash->{$channel}->{$trigger}->{add_nick} and $self->{pbot}->{factoids}->{factoids}->hash->{$channel}->{$trigger}->{add_nick} != 0) { + if($command ne 'code-factoid' and exists $self->{pbot}->{factoids}->{factoids}->hash->{$channel}->{$trigger}->{add_nick} and $self->{pbot}->{factoids}->{factoids}->hash->{$channel}->{$trigger}->{add_nick} != 0) { print $writer "$from $nick: $text"; $self->{pbot}->{interpreter}->handle_result($from, $nick, $user, $host, $command, "$keyword $arguments", "$nick: $text", 0, $preserve_whitespace); } else { diff --git a/PBot/Factoids.pm b/PBot/Factoids.pm index bfdb3fa1..ce3d7daa 100644 --- a/PBot/Factoids.pm +++ b/PBot/Factoids.pm @@ -386,7 +386,7 @@ sub expand_factoid_vars { while ($const_action =~ /(\ba\s*|\ban\s*)?(?find(sub { $_[1]->isa('PPI::Token::Symbol') }); - - use Data::Dumper; - print "got vars: ", Dumper $vars; - my @names = map { $_->symbol =~ /^[\%\@\$]+(.*)/; $1 } @$vars if $vars; my %uniq = map { $_, 1 } @names; @names = keys %uniq; @@ -595,9 +594,11 @@ sub execute_code_factoid { $self->{compartments}->{$new_compartment} = $safe if $new_compartment; } + no warnings; local our @args = $self->{pbot}->{commands}->parse_arguments($arguments); local our $nick = $nick; local our $channel = $from; + use warnings; @args = ($nick) if not @args; $arguments = ''; @@ -640,6 +641,22 @@ sub execute_code_factoid { return $action; } +sub execute_code_factoid_using_vm { + my ($self, $nick, $user, $host, $from, $chan, $root_keyword, $keyword, $arguments, $lang, $code, $tonick) = @_; + + unless (exists $self->{factoids}->hash->{$chan}->{$keyword}->{interpolate} and $self->{factoids}->hash->{$chan}->{$keyword}->{interpolate} eq '0') { + $code = $self->expand_factoid_vars($from, $nick, $root_keyword, $code); + $code = $self->expand_action_arguments($code, $arguments, $nick); + } + + $self->{pbot}->{factoids}->{factoidmodulelauncher}->execute_module($from, $tonick, $nick, $user, $host, "code-factoid", $chan, $root_keyword, "compiler", "$nick $from -lang=$lang $code", 0); + return ""; +} + +sub execute_code_factoid { + return execute_code_factoid_using_vm(@_); +} + sub interpreter { my $self = shift; my ($from, $nick, $user, $host, $depth, $keyword, $arguments, $tonick, $ref_from, $referenced, $root_keyword) = @_; @@ -755,14 +772,21 @@ sub interpreter { $action = $self->{factoids}->hash->{$channel}->{$keyword}->{action}; } - if ($action =~ m/^\{\s*(.*)\s*\}$/) { - my $code = $1; - $action = $self->execute_code_factoid($nick, $from, $channel, $root_keyword, $keyword, $arguments, $code, $tonick); + if ($action =~ m{^/code\s+([^\s]+)\s+(.+)$}i) { + my ($lang, $code) = ($1, $2); + $self->execute_code_factoid($nick, $user, $host, $from, $channel, $root_keyword, $keyword, $arguments, $lang, $code, $tonick); + return ""; } + return $self->handle_action($nick, $user, $host, $from, $channel, $root_keyword, $keyword, $arguments, $action, $tonick, $depth, $referenced, $ref_from, $original_keyword); +} + +sub handle_action { + my ($self, $nick, $user, $host, $from, $channel, $root_keyword, $keyword, $arguments, $action, $tonick, $depth, $referenced, $ref_from, $original_keyword) = @_; + return "" if not length $action; - unless ($self->{factoids}->hash->{$channel}->{$keyword}->{interpolate} eq '0') { + unless (exists $self->{factoids}->hash->{$channel}->{$keyword}->{interpolate} and $self->{factoids}->hash->{$channel}->{$keyword}->{interpolate} eq '0') { $action = $self->expand_factoid_vars($from, $nick, $root_keyword, $action); } @@ -776,15 +800,8 @@ sub interpreter { if ($self->{factoids}->hash->{$channel}->{$keyword}->{type} eq 'text') { my $target = $self->{pbot}->{nicklist}->is_present_similar($from, $arguments); - if (not $target) { - if ($arguments =~ m/\$/) { - $target = $arguments; - } elsif ($action !~ m{^/call\s}) { - #return "/me blinks at $nick."; - } - } - if ($target and $action !~ /\$nick/) { + if ($target and $action !~ /\$(?:nick|args)\b/) { if ($action !~ m/^(\/[^ ]+) /) { $action =~ s/^/\/say $target: $keyword is / unless defined $tonick; } else { @@ -807,8 +824,8 @@ sub interpreter { $command .= " $arguments"; } - $pbot->{logger}->log("[" . (defined $from ? $from : "stdin") . "] ($nick!$user\@$host) [$keyword] aliased to: [$command]\n"); - return $pbot->{interpreter}->interpret($from, $nick, $user, $host, $depth, $command, $tonick, $referenced, $root_keyword); + $self->{pbot}->{logger}->log("[" . (defined $from ? $from : "stdin") . "] ($nick!$user\@$host) [$keyword] aliased to: [$command]\n"); + return $self->{pbot}->{interpreter}->interpret($from, $nick, $user, $host, $depth, $command, $tonick, $referenced, $root_keyword); } if(defined $tonick) { # !tell foo about bar @@ -816,8 +833,8 @@ sub interpreter { my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick'); # get rid of original caller's nick - $action =~ s/^\/([^ ]+) \Q$nick\E:\s+/\/$1 /; - $action =~ s/^\Q$nick\E:\s+//; + $action =~ s/^\/([^ ]+) \Q$nick\E.\s+/\/$1 /; + $action =~ s/^\Q$nick\E.\s+//; if ($action =~ s/^\/say\s+//i || $action =~ s/^\/me\s+/* $botnick /i || $action =~ /^\/msg\s+/i) { @@ -837,7 +854,7 @@ sub interpreter { return "/msg $nick $ref_from$keyword is currently disabled."; } - unless ($self->{factoids}->hash->{$channel}->{$keyword}->{interpolate} eq '0') { + unless (exists $self->{factoids}->hash->{$channel}->{$keyword}->{interpolate} and $self->{factoids}->hash->{$channel}->{$keyword}->{interpolate} eq '0') { $action = $self->expand_factoid_vars($from, $nick, $root_keyword, $action); $action = $self->expand_action_arguments($action, $arguments, $nick); } @@ -846,7 +863,7 @@ sub interpreter { my $preserve_whitespace = $self->{factoids}->hash->{$channel}->{$keyword}->{preserve_whitespace}; $preserve_whitespace = 0 if not defined $preserve_whitespace; - return $ref_from . $self->{factoidmodulelauncher}->execute_module($from, $tonick, $nick, $user, $host, "$keyword $arguments", $keyword, $arguments, $preserve_whitespace, $referenced); + return $ref_from . $self->{factoidmodulelauncher}->execute_module($from, $tonick, $nick, $user, $host, "$keyword $arguments", $channel, $root_keyword, $keyword, $arguments, $preserve_whitespace, $referenced); } elsif($self->{factoids}->hash->{$channel}->{$keyword}->{type} eq 'text') { $self->{pbot}->{logger}->log("Found factoid\n"); @@ -882,7 +899,7 @@ sub interpreter { } } } elsif($self->{factoids}->hash->{$channel}->{$keyword}->{type} eq 'regex') { - $result = eval { + my $result = eval { my $string = "$original_keyword" . (defined $arguments ? " $arguments" : ""); my $cmd; if($string =~ m/$keyword/i) { @@ -906,8 +923,7 @@ sub interpreter { $cmd = $action; } - $result = $pbot->{interpreter}->interpret($from, $nick, $user, $host, $depth, $cmd, $tonick, $referenced, $root_keyword); - return $result; + return $self->{pbot}->{interpreter}->interpret($from, $nick, $user, $host, $depth, $cmd, $tonick, $referenced, $root_keyword); }; if($@) { diff --git a/PBot/Interpreter.pm b/PBot/Interpreter.pm index e5e9ec6a..3e6e5668 100644 --- a/PBot/Interpreter.pm +++ b/PBot/Interpreter.pm @@ -163,7 +163,7 @@ sub process_line { 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); + $pbot->{factoids}->{factoidmodulelauncher}->execute_module($from, undef, $nick, $user, $host, $text, "compiler_block", $from, '{', (defined $nick_override ? $nick_override : $nick) . " $from $has_code }", $preserve_whitespace); } } } else { @@ -269,6 +269,8 @@ sub truncate_result { sub handle_result { my ($self, $from, $nick, $user, $host, $text, $command, $result, $checkflood, $preserve_whitespace) = @_; + $preserve_whitespace = 0 if not defined $preserve_whitespace; + if (not defined $result or length $result == 0) { return 0; } diff --git a/PBot/Plugins/UrlTitles.pm b/PBot/Plugins/UrlTitles.pm index 85156129..ec425ae4 100644 --- a/PBot/Plugins/UrlTitles.pm +++ b/PBot/Plugins/UrlTitles.pm @@ -60,7 +60,7 @@ sub show_url_titles { and grep { $channel =~ /$_/i } $self->{pbot}->{registry}->get_value('general', 'show_url_titles_channels')) { while ($msg =~ s/(https?:\/\/[^\s]+)//i && ++$event->{interpreted} <= 3) { - $self->{pbot}->{factoids}->{factoidmodulelauncher}->execute_module($channel, undef, $nick, $user, $host, $msg, "title", "$nick $1"); + $self->{pbot}->{factoids}->{factoidmodulelauncher}->execute_module($channel, undef, $nick, $user, $host, $msg, $channel, "title", "title", "$nick $1"); } } diff --git a/PBot/Utils/ValidateString.pm b/PBot/Utils/ValidateString.pm index efe27294..1dc3e5ea 100644 --- a/PBot/Utils/ValidateString.pm +++ b/PBot/Utils/ValidateString.pm @@ -8,7 +8,7 @@ our @EXPORT = qw/validate_string/; sub validate_string { my ($string, $max_length) = @_; return $string if not defined $string or not length $string; - $max_length = 400 if not defined $max_length; + $max_length = 2000 if not defined $max_length; $string = substr $string, 0, $max_length unless $max_length <= 0; $string =~ s/(\P{PosixGraph})/my $ch = $1; if ($ch =~ m{[\s\x03\x02\x1d\x1f\x16\x0f]}) { $ch } else { sprintf "\\x%02X", ord $ch }/ge; $string = substr $string, 0, $max_length unless $max_length <= 0; diff --git a/modules/compiler_vm/compiler_server_virsh.pl b/modules/compiler_vm/compiler_server_virsh.pl index 78360634..a3d1764a 100755 --- a/modules/compiler_vm/compiler_server_virsh.pl +++ b/modules/compiler_vm/compiler_server_virsh.pl @@ -63,6 +63,11 @@ sub execute { my $pid = open(my $fh, '-|', @list); + if (not defined $pid) { + print "Couldn't fork: $!\n"; + return (-13, "[Fatal error]"); + } + local $SIG{ALRM} = sub { print "Time out\n"; kill 9, $pid; print "sent KILL to $pid\n"; die "Timed-out: $result\n"; }; alarm($COMPILE_TIMEOUT); @@ -202,7 +207,7 @@ sub compiler_server { if($line =~ m/^compile:end$/) { if($heartbeat <= 0) { print "No heartbeat yet, ignoring compile attempt.\n"; - print $client "$nick: Recovering from previous snippet, please wait.\n" if gettimeofday - $last_wait > 60; + print $client "Recovering from previous snippet, please wait.\n" if gettimeofday - $last_wait > 60; $last_wait = gettimeofday; last; } @@ -228,10 +233,6 @@ sub compiler_server { $killed = 1; } - if($ret == -13) { - print $client "$nick: "; - } - print $client $result . "\n"; close $client; diff --git a/modules/compiler_vm/languages/_default.pm b/modules/compiler_vm/languages/_default.pm index 97c2127c..bf81272f 100755 --- a/modules/compiler_vm/languages/_default.pm +++ b/modules/compiler_vm/languages/_default.pm @@ -58,7 +58,7 @@ sub preprocess_code { my $self = shift; if ($self->{only_show}) { - print "$self->{nick}: $self->{code}\n"; + print "$self->{code}\n"; exit; } @@ -221,7 +221,7 @@ sub show_output { $uri = $self->paste_codepad($pretty_code); } - print "$self->{nick}: $uri\n"; + print "$uri\n"; exit 0; } @@ -238,13 +238,13 @@ sub show_output { close FILE; if(defined $last_output and $last_output eq $output) { - print "$self->{nick}: Same output.\n"; + print "Same output.\n"; exit 0; } } } - print "$self->{nick}: $output\n"; + print "$output\n"; open FILE, "> history/$self->{channel}-$self->{lang}.last-output" or die "Couldn't open $self->{channel}-$self->{lang}.last-output: $!"; my $now = gettimeofday; @@ -405,7 +405,7 @@ sub add_option { $self->{options_order} = [] if not exists $self->{options_order}; $self->{options}->{$option} = $value; - push $self->{options_order}, $option; + push @{$self->{options_order}}, $option; } sub process_standard_options { @@ -422,7 +422,7 @@ sub process_standard_options { $cmdline =~ s/\$sourcefile/$self->{sourcefile}/g; $cmdline =~ s/\$execfile/$self->{execfile}/g; my $name = exists $self->{name} ? $self->{name} : $self->{lang}; - print "$self->{nick}: $name cmdline: $cmdline\n"; + print "$name cmdline: $cmdline\n"; exit; } @@ -482,7 +482,7 @@ sub process_interactive_edit { goto COPY_SUCCESS; COPY_ERROR: - print "$self->{nick}: No history for $copy.\n"; + print "No history for $copy.\n"; exit 0; COPY_SUCCESS: @@ -507,9 +507,9 @@ sub process_interactive_edit { if($subcode =~ m/^\s*(?:and\s+)?show(?:\s+\S+)?\s*$/i) { if(defined $last_code[0]) { - print "$self->{nick}: $last_code[0]\n"; + print "$last_code[0]\n"; } else { - print "$self->{nick}: No recent code to show.\n" + print "No recent code to show.\n" } exit 0; } @@ -525,7 +525,7 @@ sub process_interactive_edit { while($subcode =~ s/^\s*(and)?\s*undo//) { splice @last_code, 0, 1; if(not defined $last_code[0]) { - print "$self->{nick}: No more undos remaining.\n"; + print "No more undos remaining.\n"; exit 0; } else { $code = $last_code[0]; @@ -550,7 +550,7 @@ sub process_interactive_edit { if ($prevchange) { $code = $prevchange; } else { - print "$self->{nick}: No recent code to $self->{got_run}.\n"; + print "No recent code to $self->{got_run}.\n"; exit 0; } } @@ -574,7 +574,7 @@ sub process_interactive_edit { $text =~ s/'$//; $subcode = "replace $modifier '$text' with ''$r"; } else { - print "$self->{nick}: Unbalanced single quotes. Usage: cc remove [all, first, .., tenth, last] 'text' [and ...]\n"; + print "Unbalanced single quotes. Usage: cc remove [all, first, .., tenth, last] 'text' [and ...]\n"; exit 0; } next; @@ -598,7 +598,7 @@ sub process_interactive_edit { $got_changes = 1; if(not defined $prevchange) { - print "$self->{nick}: No recent code to prepend to.\n"; + print "No recent code to prepend to.\n"; exit 0; } @@ -606,7 +606,7 @@ sub process_interactive_edit { $code =~ s/^/$text /; $prevchange = $code; } else { - print "$self->{nick}: Unbalanced single quotes. Usage: cc prepend 'text' [and ...]\n"; + print "Unbalanced single quotes. Usage: cc prepend 'text' [and ...]\n"; exit 0; } next; @@ -630,7 +630,7 @@ sub process_interactive_edit { $got_changes = 1; if(not defined $prevchange) { - print "$self->{nick}: No recent code to append to.\n"; + print "No recent code to append to.\n"; exit 0; } @@ -638,7 +638,7 @@ sub process_interactive_edit { $code =~ s/$/ $text/; $prevchange = $code; } else { - print "$self->{nick}: Unbalanced single quotes. Usage: cc append 'text' [and ...]\n"; + print "Unbalanced single quotes. Usage: cc append 'text' [and ...]\n"; exit 0; } next; @@ -666,7 +666,7 @@ sub process_interactive_edit { $subcode = $r; $subcode =~ s/\s*with\s*//i; } else { - print "$self->{nick}: Unbalanced single quotes. Usage: cc replace 'from' with 'to' [and ...]\n"; + print "Unbalanced single quotes. Usage: cc replace 'from' with 'to' [and ...]\n"; exit 0; } @@ -678,7 +678,7 @@ sub process_interactive_edit { $to =~ s/'$//; $subcode = $r; } else { - print "$self->{nick}: Unbalanced single quotes. Usage: cc replace 'from' with 'to' [and replace ... with ... [and ...]]\n"; + print "Unbalanced single quotes. Usage: cc replace 'from' with 'to' [and replace ... with ... [and ...]]\n"; exit 0; } @@ -695,7 +695,7 @@ sub process_interactive_edit { when($_ eq 'eighth' ) { $modifier = 8; } when($_ eq 'nineth' ) { $modifier = 9; } when($_ eq 'tenth' ) { $modifier = 10; } - default { print "$self->{nick}: Bad replacement modifier '$modifier'; valid modifiers are 'all', 'first', 'second', ..., 'tenth', 'last'\n"; exit 0; } + default { print "Bad replacement modifier '$modifier'; valid modifiers are 'all', 'first', 'second', ..., 'tenth', 'last'\n"; exit 0; } } my $replacement = {}; @@ -721,7 +721,7 @@ sub process_interactive_edit { $regex =~ s/\/$//; $subcode = "/$r"; } else { - print "$self->{nick}: Unbalanced slashes. Usage: cc s/regex/substitution/[gi] [and s/.../.../ [and ...]]\n"; + print "Unbalanced slashes. Usage: cc s/regex/substitution/[gi] [and s/.../.../ [and ...]]\n"; exit 0; } @@ -733,7 +733,7 @@ sub process_interactive_edit { $to =~ s/\/$//; $subcode = $r; } else { - print "$self->{nick}: Unbalanced slashes. Usage: cc s/regex/substitution/[gi] [and s/.../.../ [and ...]]\n"; + print "Unbalanced slashes. Usage: cc s/regex/substitution/[gi] [and s/.../.../ [and ...]]\n"; exit 0; } @@ -741,13 +741,13 @@ sub process_interactive_edit { $suffix = $1 if $subcode =~ s/^([^ ]+)//; if(length $suffix and $suffix =~ m/[^gi]/) { - print "$self->{nick}: Bad regex modifier '$suffix'. Only 'i' and 'g' are allowed.\n"; + print "Bad regex modifier '$suffix'. Only 'i' and 'g' are allowed.\n"; exit 0; } if(defined $prevchange) { $code = $prevchange; } else { - print "$self->{nick}: No recent code to change.\n"; + print "No recent code to change.\n"; exit 0; } @@ -796,7 +796,7 @@ sub process_interactive_edit { if($@) { my $error = $@; $error =~ s/ at .* line \d+\.\s*$//; - print "$self->{nick}: $error\n"; + print "$error\n"; exit 0; } @@ -808,7 +808,7 @@ sub process_interactive_edit { } if ($got_sub and not $got_changes) { - print "$self->{nick}: No substitutions made.\n"; + print "No substitutions made.\n"; exit 0; } elsif ($got_sub and $got_changes) { next; @@ -837,7 +837,7 @@ sub process_interactive_edit { if(defined $prevchange) { $code = $prevchange; } else { - print "$self->{nick}: No recent code to change.\n"; + print "No recent code to change.\n"; exit 0; } @@ -882,7 +882,7 @@ sub process_interactive_edit { if($@) { my $error = $@; $error =~ s/ at .* line \d+\.\s*$//; - print "$self->{nick}: $error\n"; + print "$error\n"; exit 0; } @@ -897,7 +897,7 @@ sub process_interactive_edit { } if(not $got_changes) { - print "$self->{nick}: No replacements made.\n"; + print "No replacements made.\n"; exit 0; } } @@ -932,7 +932,7 @@ sub process_interactive_edit { if ($got_diff) { if($#last_code < 1) { - print "$self->{nick}: Not enough recent code to diff.\n" + print "Not enough recent code to diff.\n" } else { use Text::WordDiff; my $diff = word_diff(\$last_code[1], \$last_code[0], { STYLE => 'Diff' }); @@ -947,7 +947,7 @@ sub process_interactive_edit { $diff =~ s/(.*?)<\/ins>/`inserted $1`/g; } - print "$self->{nick}: $diff\n"; + print "$diff\n"; } exit 0; }