GitHub/pbot
3
0
Fork 0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-22 20:09:43 +01:00
Code Issues Projects Releases Wiki Activity

code-factoids now support native variables (currently only C-family and Perl are implemented)

Browse Source
This commit is contained in:
Pragmatic Software 2017-09-12 05:50:49 -07:00
parent a03c1c1d0d
commit 4389d01b54
8 changed files with 135 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
PBot/FactoidModuleLauncher.pm
View File

@ -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;
}

25
PBot/Factoids.pm
View File

@ -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);
}

18
modules/compiler_client.pl
View File

@ -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";

81
modules/compiler_vm/compiler_server_virsh.pl
View File

@ -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;

23
modules/compiler_vm/compiler_vm_client.pl
View File

@ -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};

30
modules/compiler_vm/languages/_c_base.pm
View File

@ -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;
}

1
modules/compiler_vm/languages/_default.pm
View File

@ -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!';

33
modules/compiler_vm/languages/perl.pm
View File

@ -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;