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

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

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*)?(?<!\\)\$([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);
       }

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 $json = join ' ', @ARGV;
-my $channel = shift @ARGV;
+my $h = decode_json $json;
-my $code = join ' ', @ARGV;
+my $lang = $h->{lang} // "c11";
 
-my $lang = "c11";
+if ($h->{code} =~ s/-lang=([^ ]+)//) {
-
-if($code =~ s/-lang=([^ ]+)//) {
   $lang = lc $1;
 }
 
-print $sock "compile:$nick:$channel:$lang\n";
+$h->{lang} = $lang;
-print $sock "$code\n";
+$json = encode_json $h;
-print $sock "compile:end\n";
+
+print $sock "$json\n";
 
 while(my $line = <$sock>) {
   print "$line";

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) {
-              if($heartbeat <= 0) {
+              print "No heartbeat yet, ignoring compile attempt.\n";
-                print "No heartbeat yet, ignoring compile attempt.\n";
+              print $client "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_wait = gettimeofday;
+              last;
-                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($line =~ /compile:([^:]+):([^:]+):(.*)$/) {
+            print "Attempting compile...\n";
-              $nick = $1;
+            alarm 0;
-              $channel = $2;
+
-              $lang = $3;
+            my ($ret, $result) = execute("perl compiler_vm_client.pl $line");
-              $code = "";
+
-              next;
+            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;

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';
+my $json = join ' ', @ARGV;
-$language = lc $language;
+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);
+if (not length $h->{code}) {
-my $channel = shift @ARGV // (print "Missing channel argument.\n" and die);
+  if (exists $h->{usage}) {
-my $code    = join(' ', @ARGV);
+    print "$h->{usage}\n";
-
+  } else {
-if (not length $code) {
+    print "Usage: cc [-paste] [-lang=<language>] [-info] [language options] <code> [-input=<stdin input>]\n";
-  print "$nick: 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};
 

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

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

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;