compiler_vm: make guest debugging output less verbose

applets/compiler_vm/guest/bin/start-guest

@@ -11,6 +11,7 @@ use English;
 use Encode;
 use File::Basename;
 use JSON::XS;
+use Data::Dumper;
 
 my $USERNAME = 'vm';   # variable for easier string interpolation
 
@@ -22,12 +23,12 @@ use constant {
     OUTPUT    => '/dev/stdout',
 };
 
+my $USE_LOCAL = $ENV{'CC_LOCAL'} // 0;
+
 use lib MOD_DIR;
 
 my %languages;
 
-my $USE_LOCAL = $ENV{'CC_LOCAL'};
-
 sub load_modules {
     my @files = glob MOD_DIR . "/*.pm";
     foreach my $mod (@files){
@@ -42,7 +43,7 @@ sub load_modules {
 sub run_server {
     my ($input, $output, $heartbeat);
 
-    if(not defined $USE_LOCAL or $USE_LOCAL == 0) {
+    if (not $USE_LOCAL) {
         # set serial to 115200 baud instead of 9600
         system('stty -F ' . SERIAL . ' 115200');
 
@@ -66,14 +67,13 @@ sub run_server {
     die "Fork failed: $!" if not defined $pid;
 
     if ($pid == 0) {
-        my $buffer = "";
+        my $buffer = '';
-        my $length = 4096;
         my $line;
         my $total_read = 0;
 
         while (1) {
             print "Waiting for input...\n";
-            my $ret = sysread($input, my $buf, $length);
+            my $ret = sysread($input, my $buf, 16384);
 
             if (not defined $ret) {
                 print "Error reading: $!\n";
@@ -83,7 +83,7 @@ sub run_server {
             $total_read += $ret;
 
             if ($ret == 0) {
-                print "input  ded?\n";
+                print "Input closed; exiting...\n";
                 print "got buffer [$buffer]\n";
                 exit;
             }
@@ -92,30 +92,26 @@ sub run_server {
             print "read $ret bytes [$total_read so far] [$buf]\n";
             $buffer.= $buf;
 
-            if ($buffer =~ s/\s*:end:\s*$//m) {
+            next if $buffer !~ s/\s*:end:\s*$//m;
-                $line = $buffer;
-                $buffer = "";
-                $total_read = 0;
-            } else {
-                next;
-            }
 
+            $line = $buffer;
             chomp $line;
 
+            $buffer = '';
+            $total_read = 0;
+
+            $line = encode('UTF-8', $line);
+
             print "-" x 40, "\n";
             print "Got [$line]\n";
 
-            $line = encode('UTF-8', $line);
             my $compile_in = decode_json($line);
 
+            print Dumper $compile_in;
+
             $compile_in->{arguments} //= '';
             $compile_in->{input}     //= '';
 
-            print "Attempting compile [$compile_in->{lang}] ...\n";
-
-            use Data::Dumper;
-            print Dumper $compile_in;
-
             my $pid = fork;
 
             if (not defined $pid) {
@@ -125,6 +121,7 @@ sub run_server {
 
             if ($pid == 0) {
                 my ($uid, $gid, $home) = (getpwnam $USERNAME)[2, 3, 7];
+
                 if (not $uid and not $gid) {
                     print "Could not find user $USERNAME: $!\n";
                     exit;
@@ -153,15 +150,19 @@ sub run_server {
                 $EGID = "$gid $gid";
                 $EUID = $UID = $uid;
 
+                chdir("/home/$USERNAME");
+
                 my $result = interpret(%$compile_in);
 
                 $GID = 0;
                 $UID = 0;
 
                 my $compile_out = { result => $result };
+
                 my $json = encode_json($compile_out);
 
-                print "Done compiling; result: [$result] [$json]\n";
+                print "Done compiling: $json\n";
+
                 print $output "result:$json\n";
                 print $output "result:end\n";
 
@@ -175,9 +176,12 @@ sub run_server {
                 exit;
             } else {
                 waitpid $pid, 0;
+
+                # kill any left-over processes started by $USERNAME
+                system("pkill -u $USERNAME");
             }
 
-            if(not defined $USE_LOCAL or $USE_LOCAL == 0) {
+            if (not $USE_LOCAL) {
                 print "=" x 40, "\n";
                 next;
             } else {
@@ -201,18 +205,12 @@ sub interpret {
 
     $h{lang} = '_default' if not exists $languages{$h{lang}};
 
-    chdir("/home/$USERNAME");
-
     my $mod = $h{lang}->new(%h);
 
     $mod->preprocess;
 
-    #    print "after preprocess: ", Dumper $mod, "\n";
-
     $mod->postprocess if not $mod->{error} and not $mod->{done};
 
-    # print "after postprocess: ", Dumper $mod, "\n";
-
     if (exists $mod->{no_output} or not length $mod->{output}) {
         if ($h{factoid}) {
             $mod->{output} = "";

applets/compiler_vm/guest/lib/Languages/_c_base.pm

@@ -12,10 +12,8 @@ use parent '_default';
 sub preprocess {
   my $self = shift;
 
-  my $input = $self->{input};
+  my $input = $self->{input} // '';
-  $input = "" if not defined $input;
 
-  print "writing input [$input]\n";
   open(my $fh, '>', '.input');
   print $fh "$input\n";
   close $fh;

applets/compiler_vm/guest/lib/Languages/_default.pm

@@ -9,8 +9,13 @@ use warnings;
 use strict;
 
 use IPC::Run qw/run timeout/;
+
 use Data::Dumper;
 
+$Data::Dumper::Terse    = 1;
+$Data::Dumper::Sortkeys = 1;
+$Data::Dumper::Useqq    = 1;
+
 sub new {
     my ($class, %conf) = @_;
     my $self = bless {}, $class;
@@ -42,16 +47,16 @@ sub preprocess {
     print $fh $self->{code} . "\n";
     close $fh;
 
-  print "Executing [$self->{cmdline}] with args [$self->{arguments}]\n";
-
-  my @args = $self->split_line($self->{arguments}, strip_quotes => 1, preserve_escapes => 0);
-
     my $quoted_args = '';
 
+    if (length $self->{arguments}) {
+        my @args = $self->split_line($self->{arguments}, strip_quotes => 1, preserve_escapes => 0);
+
         foreach my $arg (@args) {
             $arg =~ s/'/'"'"'/g;
             $quoted_args .= "'$arg' ";
         }
+    }
 
     $self->{input} = "ulimit -f 2000; ulimit -t 8; ulimit -u 200; $self->{cmdline} $quoted_args";
 
@@ -63,15 +68,14 @@ sub preprocess {
     $self->{error}  = $retval;
 }
 
-sub postprocess {
+sub postprocess {}
-  my $self = shift;
-}
 
 sub execute {
     my ($self, $timeout, $stdin, @cmdline) = @_;
 
     $stdin //= '';
-  print "execute($timeout) [$stdin] ", Dumper \@cmdline, "\n";
+
+    print "execute ($timeout) [$stdin] @cmdline\n";
 
     my ($exitval, $stdout, $stderr) = eval {
         my ($stdout, $stderr);
@@ -80,13 +84,15 @@ sub execute {
         return ($exitval, $stdout, $stderr);
     };
 
-  if ($@) {
+    if (my $exception = $@) {
-    my $error = $@;
+        $exception = "[Timed-out]" if $exception =~ m/timeout on timer/;
-    $error = "[Timed-out]" if $error =~ m/timeout on timer/;
+        ($exitval, $stdout, $stderr) = (-1, '', $exception);
-    ($exitval, $stdout, $stderr) = (-1, '', $error);
     }
 
-  print "exitval $exitval stdout [$stdout]\nstderr [$stderr]\n";
+    $Data::Dumper::Indent = 0;
+    print "exitval $exitval stderr [", Dumper($stderr), "] stdout [", Dumper($stdout), "]\n";
+    $Data::Dumper::Indent = 1;
+
     return ($exitval, $stdout, $stderr);
 }