From 4389d01b545b23d24e4f057c4564e946448bb556 Mon Sep 17 00:00:00 2001 From: Pragmatic Software Date: Tue, 12 Sep 2017 05:50:49 -0700 Subject: [PATCH] code-factoids now support native variables (currently only C-family and Perl are implemented) --- PBot/FactoidModuleLauncher.pm | 2 +- PBot/Factoids.pm | 25 ++++-- modules/compiler_client.pl | 18 ++--- modules/compiler_vm/compiler_server_virsh.pl | 81 ++++++++------------ modules/compiler_vm/compiler_vm_client.pl | 23 +++--- modules/compiler_vm/languages/_c_base.pm | 30 +++++++- modules/compiler_vm/languages/_default.pm | 1 + modules/compiler_vm/languages/perl.pm | 33 +++++++- 8 files changed, 135 insertions(+), 78 deletions(-) diff --git a/PBot/FactoidModuleLauncher.pm b/PBot/FactoidModuleLauncher.pm index 9f613d10..9c0d39f0 100644 --- a/PBot/FactoidModuleLauncher.pm +++ b/PBot/FactoidModuleLauncher.pm @@ -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; } diff --git a/PBot/Factoids.pm b/PBot/Factoids.pm index ce3d7daa..60d8b9af 100644 --- a/PBot/Factoids.pm +++ b/PBot/Factoids.pm @@ -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*)?(? $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); } diff --git a/modules/compiler_client.pl b/modules/compiler_client.pl index 7000880a..e2d9d034 100755 --- a/modules/compiler_client.pl +++ b/modules/compiler_client.pl @@ -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"; diff --git a/modules/compiler_vm/compiler_server_virsh.pl b/modules/compiler_vm/compiler_server_virsh.pl index a3d1764a..37680037 100755 --- a/modules/compiler_vm/compiler_server_virsh.pl +++ b/modules/compiler_vm/compiler_server_virsh.pl @@ -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; diff --git a/modules/compiler_vm/compiler_vm_client.pl b/modules/compiler_vm/compiler_vm_client.pl index eaff94a1..bb6dab00 100755 --- a/modules/compiler_vm/compiler_vm_client.pl +++ b/modules/compiler_vm/compiler_vm_client.pl @@ -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=] [-info] [language options] [-input=]\n"; +if (not length $h->{code}) { + if (exists $h->{usage}) { + print "$h->{usage}\n"; + } else { + print "Usage: cc [-paste] [-lang=] [-info] [language options] [-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}; diff --git a/modules/compiler_vm/languages/_c_base.pm b/modules/compiler_vm/languages/_c_base.pm index c421eaff..c2322b18 100755 --- a/modules/compiler_vm/languages/_c_base.pm +++ b/modules/compiler_vm/languages/_c_base.pm @@ -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 \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+//gms; @@ -471,6 +491,8 @@ sub postprocess_output { } } + $output =~ s/preprocessor macro\s+at/preprocessor macro/g; + $self->{output} = $output; } diff --git a/modules/compiler_vm/languages/_default.pm b/modules/compiler_vm/languages/_default.pm index bf81272f..2b11cd29 100755 --- a/modules/compiler_vm/languages/_default.pm +++ b/modules/compiler_vm/languages/_default.pm @@ -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!'; diff --git a/modules/compiler_vm/languages/perl.pm b/modules/compiler_vm/languages/perl.pm index 189d6878..f846b0a0 100755 --- a/modules/compiler_vm/languages/perl.pm +++ b/modules/compiler_vm/languages/perl.pm @@ -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;