compiler_vm updates

- make compiler_output_merger.pl more resistant to being killed
  - support gcc 4.9.0's -fdiagnostics-show-caret 
    (disable in channel, enable in paste)
  - force a newline to be added to program output to prevent output
    from being buffered by output merger

PBot/VERSION.pm

@@ -13,8 +13,8 @@ use warnings;
 # These are set automatically by the build/commit script
 use constant {
   BUILD_NAME     => "PBot",
-  BUILD_REVISION => 489,
+  BUILD_REVISION => 490,
-  BUILD_DATE     => "2014-02-25",
+  BUILD_DATE     => "2014-02-27",
 };
 
 1;

modules/compiler_vm/compiler_output_merger.pl

@@ -5,6 +5,8 @@ use strict;
 
 use IPC::Open2;
 use Fcntl qw/:flock/;
+use POSIX ":sys_wait_h";
+use Linux::Pid qw/getppid/;
 
 my $outfile = '.output';
 
@@ -20,31 +22,72 @@ sub write_output {
   close $fh;
 }
 
-sub merge {
+sub merge_file {
-  my ($file) = @_;
+  my ($file, $pid) = @_;
 
   # create empty file
   open my $fh, '>', $file;
   close $fh;
 
   my ($out, $in);
-  open2 $out, $in, "tail -f $file";
+  open2 $out, $in, "tail -q -F $file --pid=$pid";
   print "merging $file to $outfile\n";
   while(my $line = <$out>) {
     chomp $line;
+    if(getppid == 1) {
+      print "$file: Parent died, exiting\n";
+      exit;
+    }
     print "$file: got [$line]\n";
     write_output $line;
   }
 }
 
-my $pid = fork();
+sub merge {
-die "fork failed: $!" if not defined $pid;
+  my ($file) = @_;
 
-if($pid == 0) {
+  my $pid = fork;
-  merge '.gdb_output';
+  die "fork failed: $!" if not defined $pid;
-  exit;
+
-} else {
+  if($pid == 0) {
-  merge '.prog_output';
+    print "$file pid: $$\n";
+    while(1) {
+      merge_file $file, $$;
+      print "merge $file killed, restarting...\n";
+    }
+    exit;
+  } else {
+    return $pid;
+  }
 }
 
-waitpid $pid, 0;
+my ($gdb_pid, $prog_pid);
+
+sub merge_outputs {
+  $gdb_pid  = merge '.gdb_output';
+  $prog_pid = merge '.prog_output';
+
+  print "merge_outputs: gdb_pid: $gdb_pid; prog_pid: $prog_pid\n";
+
+  while(1) {
+    sleep 1;
+  }
+}
+
+$SIG{CHLD} = \&REAPER;
+sub REAPER {
+  my $stiff;
+  while (($stiff = waitpid(-1, &WNOHANG)) > 0) {
+    print "child died: $stiff\n";
+    print "reaper: gdb_pid: $gdb_pid; prog_pid: $prog_pid\n";
+
+    if($stiff == $gdb_pid) {
+      $gdb_pid = merge '.gdb_output';
+    } elsif($stiff == $prog_pid) {
+      $prog_pid = merge '.prog_output';
+    }
+  }
+  $SIG{CHLD} = \&REAPER;
+}
+
+merge_outputs;

modules/compiler_vm/compiler_server.pl

@@ -13,7 +13,7 @@ my $SERIAL_PORT    = 3333;
 my $HEARTBEAT_PORT = 3336;
 
 my $COMPILE_TIMEOUT = 7;
-my $NOGRAPHIC       = 0;
+my $NOGRAPHIC       = 1;
 
 sub server_listen {
   my $port = shift @_;
@@ -46,7 +46,7 @@ sub vm_start {
   }
 
   if($pid == 0) {
-    my $command = "nice -n -20 qemu-system-x86_64 -M pc -net none -hda /home/compiler/compiler/compiler-savedvm.qcow2 -m 128 -monitor tcp:127.0.0.1:$MONITOR_PORT,server,nowait -serial tcp:127.0.0.1:$SERIAL_PORT,server,nowait -serial tcp:127.0.0.1:$HEARTBEAT_PORT,server -boot c -loadvm 1 -enable-kvm -no-kvm-irqchip" . ($NOGRAPHIC ? "" : " -nographic");
+    my $command = "nice -n -20 qemu-system-x86_64 -M pc -net none -hda /home/compiler/compiler/compiler-savedvm.qcow2 -m 128 -monitor tcp:127.0.0.1:$MONITOR_PORT,server,nowait -serial tcp:127.0.0.1:$SERIAL_PORT,server,nowait -serial tcp:127.0.0.1:$HEARTBEAT_PORT,server -boot c -loadvm 1 -enable-kvm -no-kvm-irqchip" . ($NOGRAPHIC ? " -nographic" : "");
     my @command_list = split / /, $command;
     exec(@command_list); 
   } else {

modules/compiler_vm/compiler_vm_client.pl

@@ -911,7 +911,7 @@ $code =~ s/(?:\n\n)+/\n\n/g;
 
 print "final code: [$code]\n" if $debug;
 
-$input = `fortune -u` if not length $input;
+$input = `fortune -u -s` if not length $input;
 $input =~ s/[\n\r\t]/ /msg;
 $input =~ s/:/ - /g;
 $input =~ s/\s+/ /g;
@@ -920,7 +920,9 @@ print FILE "$nick: [lang:$lang][args:$args][input:$input]\n", pretty($code), "\n
 
 my $pretty_code = pretty $code;
 
+$args .= ' -paste' if defined $got_paste or $got_run eq "paste";
 $output = compile($lang, $pretty_code, $args, $input, $USE_LOCAL);
+$args =~ s/ -paste$// if defined $got_paste or $got_run eq "paste";
 
 if($output =~ m/^\s*$/) {
   $output = $nooutput 

modules/compiler_vm/compiler_vm_server.pl

@@ -3,6 +3,8 @@
 use warnings;
 use strict;
 
+use Proc::ProcessTable;
+
 my $USE_LOCAL = defined $ENV{'CC_LOCAL'}; 
 
 my %languages = (
@@ -28,6 +30,8 @@ my %languages = (
   },
 );
 
+my $merger_pid;
+
 sub runserver {
   my ($input, $output, $heartbeat);
 
@@ -128,13 +132,20 @@ sub interpret {
 
   my $cmdline = $languages{$lang}{'cmdline'};
 
+  my $diagnostics_caret;
+  if($user_args =~ s/\s+-paste//) {
+    $diagnostics_caret = '-fdiagnostics-show-caret';
+  } else {
+    $diagnostics_caret = '-fno-diagnostics-show-caret';
+  }
+
   if(length $user_args) {
     print "Replacing args with $user_args\n";
     my $user_args_quoted = quotemeta($user_args);
     $user_args_quoted =~ s/\\ / /g;
-    $cmdline =~ s/\$args/$user_args_quoted/;
+    $cmdline =~ s/\$args/$user_args_quoted $diagnostics_caret/;
   } else {
-    $cmdline =~ s/\$args/$languages{$lang}{'args'}/;
+    $cmdline =~ s/\$args/$languages{$lang}{'args'} $diagnostics_caret/;
   }
 
   $cmdline =~ s/\$file/$languages{$lang}{'file'}/;
@@ -164,7 +175,19 @@ sub interpret {
   }
 
   print "Executing gdb\n";
-  unlink '.output';
+
+  open my $truncate_output, '>', '.output';
+  close $truncate_output;
+  unlink '.gdb_output', '.prog_output';
+
+  if(not defined $merger_pid or not find_pid($merger_pid)) {
+    waitpid $merger_pid, 0 if defined $merger_pid;
+    print "compiler_vm_server: starting merger\n";
+    $merger_pid = start_merger;
+    sleep 1;
+    print "merger started; pid: $merger_pid\n";
+  }
+
   my $user_input_quoted = quotemeta $user_input;
   $user_input_quoted =~ s/\\"/"'\\"'"/g;
   ($ret, $result) = execute(60, "bash -c \"date -s \@$date; ulimit -t 1; compiler_watchdog.pl $user_input_quoted\"");
@@ -227,4 +250,27 @@ sub execute {
   return ($ret, $result);
 }
 
+sub start_merger {
+  my $merger_pid = fork;
+  die "merger fork failed: $!" if not defined $merger_pid;
+
+  if($merger_pid == 0) {
+    exec('compiler_output_merger.pl');
+    die "merger exec failed: $!";
+  } else {
+    print "compiler_vm_server: merger startered; pid: $merger_pid\n";
+    return $merger_pid;
+  }
+}
+
+sub find_pid {
+  my ($pid) = @_;
+  return 0 if not defined $pid;
+  my $t = new Proc::ProcessTable('enable_ttys' => 0);
+  foreach my $p (@{ $t->table }) {
+    return 1 if $p->pid == $pid;
+  }
+  return 0;
+}
+
 runserver;

modules/compiler_vm/compiler_watchdog.pl

@@ -17,6 +17,7 @@ my $got_output = 0;
 my $local_vars = "";
 
 sub flushall;
+sub writenewline;
 sub gdb;
 
 use IO::Handle;
@@ -95,7 +96,8 @@ sub execute {
             my $line = <$out>;
             print "== got: $line\n" if $debug >= 5;
             if($line =~ m/^\d+\s+return.*?;\s*$/ or $line =~ m/^\d+\s+}\s*$/) {
-                if($got_output == 0 and -s '.output' == 0) {
+                writenewline $in, $out;
+                if($got_output == 0 and -s '.output' <= 1) {
                     print "no output, checking locals\n" if $debug >= 5;
                     gdb $in, "print \"Go.\"\ninfo locals\nprint \"Ok.\"\n";
 
@@ -477,6 +479,18 @@ sub gdb {
     print $in "$command\n";
 }
 
+sub writenewline {
+    my ($in, $out) = @_;
+
+    gdb $in, "call puts(\"\")\nprint \"Ok.\"\n";
+    while(my $line = <$out>) {
+        chomp $line;
+        $line =~ s/^\(gdb\)\s*//;
+        $line =~ s/\$\d+ = 0$//;
+        last if $line =~ m/\$\d+ = "Ok."/;
+    }
+}
+
 sub flushall {
     my ($in, $out) = @_;