mirror of https://github.com/pragma-/pbot.git
code-factoids now support native variables (currently only C-family and Perl are implemented)
This commit is contained in:
Pragmatic Software
parent
a03c1c1d0d
commit
4389d01b54
|
|
@ -68,7 +68,7 @@ sub execute_module {
|
|||
|
||||
$arguments = quotemeta($arguments);
|
||||
|
||||
if(exists $self->{pbot}->{factoids}->{factoids}->hash->{$channel}->{$trigger}->{unquote_spaces}) {
|
||||
if($command eq 'code-factoid' or exists $self->{pbot}->{factoids}->{factoids}->hash->{$channel}->{$trigger}->{unquote_spaces}) {
|
||||
$arguments =~ s/\\ / /g;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@ use Time::Duration qw(duration);
|
|||
use Carp ();
|
||||
use POSIX qw(strftime);
|
||||
use Text::ParseWords;
|
||||
use JSON;
|
||||
|
||||
use PPI;
|
||||
use Safe;
|
||||
|
|
@ -386,7 +387,7 @@ sub expand_factoid_vars {
|
|||
while ($const_action =~ /(\ba\s*|\ban\s*)?(?<!\\)\$([a-zA-Z0-9_:\-#\[\]]+)/gi) {
|
||||
my ($a, $v) = ($1, $2);
|
||||
$v =~ s/(.):$/$1/;
|
||||
next if $v =~ m/^(nick|channel|randomnick|arglen|args|arg\[.+\]|[_0])$/i; # don't override special variables
|
||||
next if $v =~ m/^(nick|channel|randomnick|arglen|jargs|args|arg\[.+\]|[_0])$/i; # don't override special variables
|
||||
next if @exclude && grep { $v =~ m/^\Q$_\E$/i } @exclude;
|
||||
|
||||
$matches++;
|
||||
|
|
@ -471,10 +472,22 @@ sub expand_action_arguments {
|
|||
$action = validate_string($action);
|
||||
$input = validate_string($input);
|
||||
|
||||
my %h;
|
||||
if (not defined $input or $input eq '') {
|
||||
$action =~ s/\$args/$nick/g;
|
||||
%h = (args => $nick);
|
||||
} else {
|
||||
$action =~ s/\$args/$input/g;
|
||||
%h = (args => $input);
|
||||
}
|
||||
my $jsonargs = encode_json \%h;
|
||||
$jsonargs =~ s/^{".*":"//;
|
||||
$jsonargs =~ s/"}$//;
|
||||
|
||||
if (not defined $input or $input eq '') {
|
||||
$action =~ s/\$args(?![[\w])/$nick/g;
|
||||
$action =~ s/\$jargs(?![[\w])/$jsonargs/ge;
|
||||
} else {
|
||||
$action =~ s/\$args(?![[\w])/$input/g;
|
||||
$action =~ s/\$jargs(?![[\w])/$jsonargs/g;
|
||||
}
|
||||
|
||||
my $qinput = quotemeta $input;
|
||||
|
|
@ -649,7 +662,9 @@ sub execute_code_factoid_using_vm {
|
|||
$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);
|
||||
my %h = (nick => $nick, channel => $from, lang => $lang, code => $code, arguments => $arguments);
|
||||
my $json = encode_json \%h;
|
||||
$self->{pbot}->{factoids}->{factoidmodulelauncher}->execute_module($from, $tonick, $nick, $user, $host, 'code-factoid', $chan, $root_keyword, "compiler", $json, 0);
|
||||
return "";
|
||||
}
|
||||
|
||||
|
|
@ -791,7 +806,7 @@ sub handle_action {
|
|||
}
|
||||
|
||||
if (length $arguments) {
|
||||
if ($action =~ m/\$args/ or $action =~ m/\$arg\[/) {
|
||||
if ($action =~ m/\$j?args/ or $action =~ m/\$arg\[/) {
|
||||
unless ($self->{factoids}->hash->{$channel}->{$keyword}->{interpolate} eq '0') {
|
||||
$action = $self->expand_action_arguments($action, $arguments, $nick);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@ use warnings;
|
|||
use strict;
|
||||
|
||||
use IO::Socket;
|
||||
use JSON;
|
||||
|
||||
my $sock = IO::Socket::INET->new(
|
||||
PeerAddr => '192.168.0.42',
|
||||
|
|
@ -24,19 +25,18 @@ if(not defined $sock) {
|
|||
die $!;
|
||||
}
|
||||
|
||||
my $nick = shift @ARGV;
|
||||
my $channel = shift @ARGV;
|
||||
my $code = join ' ', @ARGV;
|
||||
my $json = join ' ', @ARGV;
|
||||
my $h = decode_json $json;
|
||||
my $lang = $h->{lang} // "c11";
|
||||
|
||||
my $lang = "c11";
|
||||
|
||||
if($code =~ s/-lang=([^ ]+)//) {
|
||||
if ($h->{code} =~ s/-lang=([^ ]+)//) {
|
||||
$lang = lc $1;
|
||||
}
|
||||
|
||||
print $sock "compile:$nick:$channel:$lang\n";
|
||||
print $sock "$code\n";
|
||||
print $sock "compile:end\n";
|
||||
$h->{lang} = $lang;
|
||||
$json = encode_json $h;
|
||||
|
||||
print $sock "$json\n";
|
||||
|
||||
while(my $line = <$sock>) {
|
||||
print "$line";
|
||||
|
|
|
|||
|
|
@ -190,11 +190,6 @@ sub compiler_server {
|
|||
my $killed = 0;
|
||||
|
||||
eval {
|
||||
my $lang;
|
||||
my $nick;
|
||||
my $channel;
|
||||
my $code = "";
|
||||
|
||||
local $SIG{ALRM} = sub { die 'Timed-out'; };
|
||||
alarm 5;
|
||||
|
||||
|
|
@ -204,54 +199,42 @@ sub compiler_server {
|
|||
alarm 5;
|
||||
print "got: [$line]\n";
|
||||
|
||||
if($line =~ m/^compile:end$/) {
|
||||
if($heartbeat <= 0) {
|
||||
print "No heartbeat yet, ignoring compile attempt.\n";
|
||||
print $client "Recovering from previous snippet, please wait.\n" if gettimeofday - $last_wait > 60;
|
||||
$last_wait = gettimeofday;
|
||||
last;
|
||||
}
|
||||
|
||||
print "Attempting compile...\n";
|
||||
alarm 0;
|
||||
|
||||
my ($ret, $result) = execute("perl compiler_vm_client.pl $lang $nick $channel $code");
|
||||
|
||||
if(not defined $ret) {
|
||||
#print "parent continued\n";
|
||||
print "parent continued [$result]\n";
|
||||
$timed_out = 1 if $result == 243; # -13 == 243
|
||||
$killed = 1 if $result == 242; # -14 = 242
|
||||
last;
|
||||
}
|
||||
|
||||
$result =~ s/\s+$//;
|
||||
print "Ret: $ret; result: [$result]\n";
|
||||
|
||||
if($result =~ m/\[Killed\]$/) {
|
||||
print "Process was killed\n";
|
||||
$killed = 1;
|
||||
}
|
||||
|
||||
print $client $result . "\n";
|
||||
close $client;
|
||||
|
||||
$ret = -14 if $killed;
|
||||
|
||||
# child exit
|
||||
print "child exit\n";
|
||||
exit $ret;
|
||||
if($heartbeat <= 0) {
|
||||
print "No heartbeat yet, ignoring compile attempt.\n";
|
||||
print $client "Recovering from previous snippet, please wait.\n" if gettimeofday - $last_wait > 60;
|
||||
$last_wait = gettimeofday;
|
||||
last;
|
||||
}
|
||||
|
||||
if($line =~ /compile:([^:]+):([^:]+):(.*)$/) {
|
||||
$nick = $1;
|
||||
$channel = $2;
|
||||
$lang = $3;
|
||||
$code = "";
|
||||
next;
|
||||
print "Attempting compile...\n";
|
||||
alarm 0;
|
||||
|
||||
my ($ret, $result) = execute("perl compiler_vm_client.pl $line");
|
||||
|
||||
if(not defined $ret) {
|
||||
#print "parent continued\n";
|
||||
print "parent continued [$result]\n";
|
||||
$timed_out = 1 if $result == 243; # -13 == 243
|
||||
$killed = 1 if $result == 242; # -14 = 242
|
||||
last;
|
||||
}
|
||||
|
||||
$code .= $line . "\n";
|
||||
$result =~ s/\s+$//;
|
||||
print "Ret: $ret; result: [$result]\n";
|
||||
|
||||
if($result =~ m/\[Killed\]$/) {
|
||||
print "Process was killed\n";
|
||||
$killed = 1;
|
||||
}
|
||||
|
||||
print $client $result . "\n";
|
||||
close $client;
|
||||
|
||||
$ret = -14 if $killed;
|
||||
|
||||
# child exit
|
||||
print "child exit\n";
|
||||
exit $ret;
|
||||
}
|
||||
|
||||
alarm 0;
|
||||
|
|
|
|||
|
|
@ -8,14 +8,19 @@ use warnings;
|
|||
use strict;
|
||||
|
||||
use File::Basename;
|
||||
use JSON;
|
||||
|
||||
my $language = shift @ARGV // 'c11';
|
||||
$language = lc $language;
|
||||
my $json = join ' ', @ARGV;
|
||||
my $h = decode_json $json;
|
||||
|
||||
my $language = lc $h->{lang};
|
||||
|
||||
eval {
|
||||
use lib 'languages';
|
||||
require "$language.pm";
|
||||
} or do {
|
||||
$language =~ s/^cfact_//;
|
||||
|
||||
my @modules = glob 'languages/*.pm';
|
||||
my $found = 0;
|
||||
my ($languages, $comma) = ('', '');
|
||||
|
|
@ -44,16 +49,16 @@ eval {
|
|||
}
|
||||
};
|
||||
|
||||
my $nick = shift @ARGV // (print "Missing nick argument.\n" and die);
|
||||
my $channel = shift @ARGV // (print "Missing channel argument.\n" and die);
|
||||
my $code = join(' ', @ARGV);
|
||||
|
||||
if (not length $code) {
|
||||
print "$nick: Usage: cc [-paste] [-lang=<language>] [-info] [language options] <code> [-input=<stdin input>]\n";
|
||||
if (not length $h->{code}) {
|
||||
if (exists $h->{usage}) {
|
||||
print "$h->{usage}\n";
|
||||
} else {
|
||||
print "Usage: cc [-paste] [-lang=<language>] [-info] [language options] <code> [-input=<stdin input>]\n";
|
||||
}
|
||||
exit;
|
||||
}
|
||||
|
||||
my $lang = $language->new(nick => $nick, channel => $channel, lang => $language, code => $code);
|
||||
my $lang = $language->new(%$h);
|
||||
|
||||
$lang->{local} = $ENV{CC_LOCAL};
|
||||
|
||||
|
|
|
|||
|
|
@ -14,6 +14,7 @@ package _c_base;
|
|||
use parent '_default';
|
||||
|
||||
use Text::Balanced qw/extract_bracketed/;
|
||||
use Text::ParseWords qw/shellwords/;
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -64,7 +65,6 @@ END
|
|||
|
||||
sub process_custom_options {
|
||||
my $self = shift;
|
||||
$self->{code} = $self->{code};
|
||||
|
||||
$self->add_option("-nomain") if $self->{code} =~ s/(?:^|(?<=\s))-nomain\s*//i;
|
||||
$self->add_option("-noheaders") if $self->{code} =~ s/(?:^|(?<=\s))-noheaders\s*//i;
|
||||
|
|
@ -74,8 +74,6 @@ sub process_custom_options {
|
|||
$self->{include_options} .= "#include <$1> ";
|
||||
$self->add_option("-include $1");
|
||||
}
|
||||
|
||||
$self->{code} = $self->{code};
|
||||
}
|
||||
|
||||
sub pretty_format {
|
||||
|
|
@ -213,6 +211,28 @@ sub preprocess_code {
|
|||
$prelude .= "\n#include <prelude.h>\n";
|
||||
}
|
||||
|
||||
if (defined $self->{arguments}) {
|
||||
my $qargs = quotemeta $self->{arguments};
|
||||
$qargs =~ s/\\ / /g;
|
||||
my @args = shellwords($self->{arguments});
|
||||
$prelude .= "\nint arglen = " . (scalar @args) . ";\n";
|
||||
|
||||
if (@args) {
|
||||
$prelude .= "char *args[] = { ";
|
||||
|
||||
my $comma = "";
|
||||
foreach my $arg (@args) {
|
||||
$arg =~ s/"/\\"/g;
|
||||
$prelude .= "$comma\"$arg\"";
|
||||
$comma = ", ";
|
||||
}
|
||||
|
||||
$prelude .= " };\n";
|
||||
} else {
|
||||
$prelude .= "char *args[] = {0};\n";
|
||||
}
|
||||
}
|
||||
|
||||
print "*** prelude: [$prelude]\n precode: [$precode]\n" if $self->{debug};
|
||||
|
||||
my $preprecode = $precode;
|
||||
|
|
@ -434,7 +454,7 @@ sub postprocess_output {
|
|||
$output =~ s/cc1: all warnings being treated as; errors//g;
|
||||
$output =~ s/, note: this is the location of the previous definition//g;
|
||||
$output =~ s/\s+note: previous declaration of '.*?' was here//g;
|
||||
$output =~ s/ called by gdb \(\) at statement: void gdb\(\) { __asm__\(""\); }//g;
|
||||
$output =~ s/ called by gdb \(\) at statement: void gdb\(\) \{ __asm__\(""\); \}//g;
|
||||
$output =~ s/called by \?\? \(\) //g;
|
||||
$output =~ s/\s0x[a-z0-9]+: note: pointer points here.*?\^//gms;
|
||||
$output =~ s/\s0x[a-z0-9]+: note: pointer points here\s+<memory cannot be printed>//gms;
|
||||
|
|
@ -471,6 +491,8 @@ sub postprocess_output {
|
|||
}
|
||||
}
|
||||
|
||||
$output =~ s/preprocessor macro\s+at/preprocessor macro/g;
|
||||
|
||||
$self->{output} = $output;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -30,6 +30,7 @@ sub new {
|
|||
$self->{lang} = $conf{lang};
|
||||
$self->{code} = $conf{code};
|
||||
$self->{max_history} = $conf{max_history} // 10000;
|
||||
$self->{arguments} = $conf{arguments};
|
||||
|
||||
$self->{default_options} = '';
|
||||
$self->{cmdline} = 'echo Hello, world!';
|
||||
|
|
|
|||
|
|
@ -10,15 +10,46 @@ use strict;
|
|||
package perl;
|
||||
use parent '_default';
|
||||
|
||||
use Text::ParseWords qw(shellwords);
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
$self->{sourcefile} = 'prog.pl';
|
||||
$self->{execfile} = 'prog.pl';
|
||||
$self->{default_options} = '';
|
||||
$self->{default_options} = '-w';
|
||||
$self->{cmdline} = 'perl $options $sourcefile';
|
||||
}
|
||||
|
||||
sub preprocess_code {
|
||||
my $self = shift;
|
||||
$self->SUPER::preprocess_code;
|
||||
|
||||
if (defined $self->{arguments}) {
|
||||
my $qargs = quotemeta $self->{arguments};
|
||||
$qargs =~ s/\\ / /g;
|
||||
my @args = shellwords($self->{arguments});
|
||||
my $prelude .= "\nmy \$arglen = " . (scalar @args) . ";\n";
|
||||
|
||||
if (@args) {
|
||||
$prelude .= "my \@args = (";
|
||||
|
||||
my $comma = "";
|
||||
foreach my $arg (@args) {
|
||||
$arg = quotemeta $arg;
|
||||
$prelude .= "$comma\"$arg\"";
|
||||
$comma = ", ";
|
||||
}
|
||||
|
||||
$prelude .= ");\n";
|
||||
} else {
|
||||
$prelude .= "my \@args;\n";
|
||||
}
|
||||
|
||||
$self->{code} = "$prelude\n$self->{code}";
|
||||
}
|
||||
}
|
||||
|
||||
sub postprocess_output {
|
||||
my $self = shift;
|
||||
$self->SUPER::postprocess_output;
|
||||
|
|
|
|||
Loading…
Reference in New Issue