From 62e11d0b5da23bfe52d3768de1fc7a72964a2cbd Mon Sep 17 00:00:00 2001
From: Pragmatic Software <pragma78@gmail.com>
Date: Sat, 31 May 2014 01:20:31 +0000
Subject: [PATCH] compiler_vm: add Win32 VirtualBox server; misc improvements

---
 PBot/VERSION.pm                               |   2 +-
 modules/compiler_vm/Diff.pm                   |  40 +++
 .../compiler_vm/compiler_server_vbox_win32.pl | 270 ++++++++++++++++++
 modules/compiler_vm/compiler_vm_client.pl     |  17 +-
 4 files changed, 324 insertions(+), 5 deletions(-)
 create mode 100644 modules/compiler_vm/Diff.pm
 create mode 100755 modules/compiler_vm/compiler_server_vbox_win32.pl

diff --git a/PBot/VERSION.pm b/PBot/VERSION.pm
index 8c08756b..30d7a5ab 100644
--- a/PBot/VERSION.pm
+++ b/PBot/VERSION.pm
@@ -13,7 +13,7 @@ use warnings;
 # These are set automatically by the build/commit script
 use constant {
   BUILD_NAME     => "PBot",
-  BUILD_REVISION => 608,
+  BUILD_REVISION => 609,
   BUILD_DATE     => "2014-05-30",
 };
 
diff --git a/modules/compiler_vm/Diff.pm b/modules/compiler_vm/Diff.pm
new file mode 100644
index 00000000..540cb17d
--- /dev/null
+++ b/modules/compiler_vm/Diff.pm
@@ -0,0 +1,40 @@
+package Diff;
+
+use strict;
+use HTML::Entities qw(encode_entities);
+use vars qw($VERSION @ISA);
+
+$VERSION = '0.08';
+@ISA = qw(Text::WordDiff::Base);
+
+sub new {
+  my ($class, %conf) = @_;
+  return bless \%conf, $class;
+}
+
+sub file_header {
+  my $header = shift->SUPER::file_header(@_);
+  return '' unless $header;
+  return $header;
+}
+
+sub hunk_header { return '' }
+sub hunk_footer { return '' }
+sub file_footer { return '' }
+
+sub same_items {
+  shift;
+  return join '', @_;
+}
+
+sub delete_items {
+  shift;
+  return '<del>' . (join'', @_ ) . '</del>';
+}
+
+sub insert_items {
+  shift;
+  return '<ins>' . ( join'', @_ ) . '</ins>';
+}
+
+1;
diff --git a/modules/compiler_vm/compiler_server_vbox_win32.pl b/modules/compiler_vm/compiler_server_vbox_win32.pl
new file mode 100755
index 00000000..1bff4c24
--- /dev/null
+++ b/modules/compiler_vm/compiler_server_vbox_win32.pl
@@ -0,0 +1,270 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use IO::Select;
+use IO::Socket;
+use Net::hostent;
+use Win32::MMF;
+
+my $fh = select STDOUT;
+$| = 1;
+select $fh;
+
+my $VBOX           = '/cygdrive/e/VirtualBox/VBoxManage';
+my $SERVER_PORT    = 9000;
+my $SERIAL_PORT    = 3333;
+my $HEARTBEAT_PORT = 3336;
+
+my $COMPILE_TIMEOUT = 5;
+my $NOGRAPHIC       = 0;
+
+$SIG{INT} = sub { vm_stop(); exit 1; };
+
+sub server_listen {
+  my $port = shift @_;
+
+  my $server = IO::Socket::INET->new( 
+    Proto     => 'tcp',
+    LocalPort => $port,
+    Listen    => SOMAXCONN,
+    Reuse     => 1);
+
+  die "can't setup server: $!" unless $server;
+
+  print "[Server $0 accepting clients]\n";
+
+  return $server;
+}
+
+sub vm_stop {
+  system("$VBOX controlvm compiler poweroff");
+  sleep 2;
+}
+
+sub vm_start {
+  print "\nStarting vbox\n";
+  system("$VBOX snapshot compiler restore compiler");
+  sleep 2;
+  system("$VBOX startvm compiler" . ($NOGRAPHIC ? " --type headless" : ""));
+}
+
+sub execute {
+  my ($cmdline) = @_;
+
+  print "execute($cmdline)\n";
+
+  my ($ret, $result);
+
+  my $child = fork;
+
+  if($child == 0) {
+    ($ret, $result) = eval {
+      my $result = '';
+
+      my $pid = open(my $fh, '-|', "$cmdline 2>&1");
+
+      local $SIG{ALRM} = sub { print "Time out\n"; kill 'INT', $pid; die "Timed-out: $result\n"; };
+      alarm($COMPILE_TIMEOUT);
+
+      while(my $line = <$fh>) {
+        $result .= $line;
+      }
+
+      close $fh;
+
+      my $ret = $? >> 8;
+      alarm 0;
+      return ($ret, $result);
+    };
+
+    alarm 0;
+    if($@ =~ /Timed-out: (.*)/) {
+      return (-13, "[Timed-out] $1");
+    }
+
+    return ($ret, $result);
+  } else {
+    waitpid($child, 0);
+    my $result = $? >> 8;
+    print "child exited, parent continuing [result = $result]\n";
+    return (undef, $result);
+  }
+}
+
+sub compiler_server {
+  my ($server, $heartbeat_pid, $heartbeat_monitor);
+
+  while(1) {
+    vm_start;
+    print "vm started\n";
+
+    $heartbeat_pid = fork;
+    die "Fork failed: $!" if not defined $heartbeat_pid;
+
+    if($heartbeat_pid == 0) {
+      my $ns = Win32::MMF->new();
+
+      while(not $ns->findvar('running')) {
+        print "Child waiting for running status\n";
+        sleep 1;
+      }
+
+      $heartbeat_monitor = undef;
+      while(not $heartbeat_monitor) {
+        print "Connecting to heartbeat ...";
+        $heartbeat_monitor = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $HEARTBEAT_PORT, Proto => 'tcp', Type => SOCK_STREAM);
+        if(not $heartbeat_monitor) {
+          print " failed.\n";
+          sleep 2;
+        } else {
+          print " success!\n";
+        }
+      }
+
+      my $select = IO::Select->new();
+      $select->add($heartbeat_monitor);
+
+      while($ns->getvar('running')) {
+        my @ready = $select->can_read(1);
+        foreach my $fh (@ready) {
+          my $ret = sysread($fh, my $buf, 32);
+
+          if(not defined $ret) {
+            print "Heartbeat read error: $!\n";
+            $ns->setvar('running', 0);
+          }
+
+          if($ret == 0) {
+            print "Heartbeat disconnected.\n";
+            $ns->setvar('running', 0);
+          }
+
+          $ns->setvar('heartbeat', 1);
+          print ".";
+        }
+      }
+
+      $heartbeat_monitor->shutdown(3);
+      $ns->deletevar('heartbeat');
+      $ns->deletevar('running');
+      print "child no longer running\n";
+      exit;
+    } else {
+      print "Heartbeat pid: $heartbeat_pid\n";
+
+      if(not defined $server) {
+        print "Starting compiler server on port $SERVER_PORT\n";
+        $server = server_listen($SERVER_PORT);
+      } else {
+        print "Compiler server already listening on port $SERVER_PORT\n";
+      }
+
+      my $ns = Win32::MMF->new();
+
+      $ns->setvar('running', 1);
+      $ns->setvar('heartbeat', 0);
+
+      while ($ns->getvar('running') and my $client = $server->accept()) {
+        $client->autoflush(1);
+        my $hostinfo = gethostbyaddr($client->peeraddr);
+        print '-' x 20, "\n";
+        printf "[Connect from %s at %s]\n", $client->peerhost, scalar localtime;
+        my $timed_out = 0;
+        my $killed = 0;
+
+        eval {
+          my $lang;
+          my $nick;
+          my $channel;
+          my $code = "";
+
+          local $SIG{ALRM} = sub { die 'Timed-out'; };
+          alarm 5;
+
+          while (my $line = <$client>) {
+            $line =~ s/[\r\n]+$//;
+            next if $line =~ m/^\s*$/;
+            alarm 5;
+            print "got: [$line]\n";
+
+            if($line =~ m/^compile:end$/) {
+              if(not $ns->getvar('heartbeat')) {
+                print "No heartbeat yet, ignoring compile attempt.\n";
+                print $client "$nick: Recovering from previous snippet, please wait.\n";
+                last;
+              }
+
+              print "Attempting compile...\n";
+              alarm 0;
+
+              my ($ret, $result) = execute("./compiler_vm_client.pl \Q$nick\E \Q$channel\E -lang=\Q$lang\E \Q$code\E");
+
+              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
+                $client->shutdown(3);
+                last;
+              }
+
+              $result =~ s/\s+$//;
+              print "Ret: $ret; result: [$result]\n";
+
+              if($result =~ m/\[Killed\]$/) {
+                print "Process was killed\n";
+                $killed = 1;
+              }
+
+              if($ret == -13) {
+                print $client "$nick: ";
+              }
+
+              print $client $result . "\n";
+              $client->shutdown(3);
+
+              $ret = -14 if $killed;
+
+              # child exit
+              print "child exit\n";
+              exit $ret;
+            }
+
+            if($line =~ /compile:([^:]+):([^:]+):(.*)$/) {
+              $nick = $1;
+              $channel = $2;
+              $lang = $3;
+              $code = "";
+              next;
+            }
+
+            $code .= $line . "\n";
+          }
+
+          alarm 0;
+        };
+
+        alarm 0;
+
+        $client->shutdown(3);
+
+        next unless ($timed_out);
+
+        $server->shutdown(3);
+        undef $server;
+        print "stopping vm\n";
+        $ns->setvar('running', 0);
+        vm_stop;
+        last;
+      } 
+      print "Compiler server no longer running, restarting...\n";
+    }
+    print "Waiting for heartbeat $heartbeat_pid to die\n";
+    waitpid($heartbeat_pid, 0);
+    print "Heartbeat dead.\n";
+  }
+}
+
+compiler_server;
diff --git a/modules/compiler_vm/compiler_vm_client.pl b/modules/compiler_vm/compiler_vm_client.pl
index c6be7c91..636a2869 100755
--- a/modules/compiler_vm/compiler_vm_client.pl
+++ b/modules/compiler_vm/compiler_vm_client.pl
@@ -12,6 +12,14 @@ use Time::HiRes qw/gettimeofday/;
 
 my $debug = 0;
 
+$SIG{INT} = sub { cleanup(); exit 1; };
+
+my $compiler_client;
+
+sub cleanup {
+  close $compiler_client if defined $compiler_client;
+}
+
 my $USE_LOCAL        = defined $ENV{'CC_LOCAL'}; 
 my $MAX_UNDO_HISTORY = 1000000;
 
@@ -31,7 +39,7 @@ my %languages = (
 
 my %preludes = ( 
   'C99'  => "#define _XOPEN_SOURCE 9001\n#define __USE_XOPEN\n#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <complex.h>\n#include <math.h>\n#include <tgmath.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n#include <stdbool.h>\n#include <stddef.h>\n#include <stdarg.h>\n#include <ctype.h>\n#include <inttypes.h>\n#include <float.h>\n#include <errno.h>\n#include <time.h>\n#include <assert.h>\n#include <locale.h>\n#include <wchar.h>\n#include <fenv.h>\n#inclue <iso646.h>\n#include <setjmp.h>\n#include <signal.h>\n#include <prelude.h>\n\n",
-  'C11'  => "#define _XOPEN_SOURCE 9001\n#define __USE_XOPEN\n#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n#include <stdbool.h>\n#include <stddef.h>\n#include <stdarg.h>\n#include <stdatomic.h>\n#include <stdnoreturn.h>\n#include <stdalign.h>\n#include <ctype.h>\n#include <inttypes.h>\n#include <float.h>\n#include <errno.h>\n#include <time.h>\n#include <assert.h>\n#include <complex.h>\n#include <setjmp.h>\n#include <wchar.h>\n#include <wctype.h>\n#include <tgmath.h>\n#include <fenv.h>\n#include <locale.h>\n#include <iso646.h>\n#include <signal.h>\n#include <prelude.h>\n\n",
+  'C11'  => "#define _XOPEN_SOURCE 9001\n#define __USE_XOPEN\n#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n#include <stdbool.h>\n#include <stddef.h>\n#include <stdarg.h>\n#include <stdnoreturn.h>\n#include <stdalign.h>\n#include <ctype.h>\n#include <inttypes.h>\n#include <float.h>\n#include <errno.h>\n#include <time.h>\n#include <assert.h>\n#include <complex.h>\n#include <setjmp.h>\n#include <wchar.h>\n#include <wctype.h>\n#include <tgmath.h>\n#include <fenv.h>\n#include <locale.h>\n#include <iso646.h>\n#include <signal.h>\n#include <prelude.h>\n\n",
   'C89'  => "#define _XOPEN_SOURCE 9001\n#define __USE_XOPEN\n#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n#include <errno.h>\n#include <ctype.h>\n#include <assert.h>\n#include <locale.h>\n#include <setjmp.h>\n#include <signal.h>\n#include <prelude.h>\n\n",
 );
 
@@ -106,6 +114,7 @@ sub compile {
     $compiler  = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => '3333', Proto => 'tcp', Type => SOCK_STREAM);
     die "Could not create socket: $!" unless $compiler;
     $compiler_output = $compiler;
+    $compiler_client = $compiler;
   }
 
   my $date = time;
@@ -141,7 +150,7 @@ sub compile {
 }
 
 if($#ARGV < 2) {
-  print "Usage: cc [-compiler -options] <code> [-stdin=input]\n";
+  print "Usage: cc [-compiler options] [-options] <code> [-stdin=input]\n";
   # usage for shell: cc <nick> <channel> [-compiler -options] <code> [-stdin=input]
   exit 0;
 }
@@ -209,7 +218,7 @@ if($subcode =~ m/^\s*(?:and\s+)?diff(?:\s+\S+)?\s*$/i) {
     print "$nick: Not enough recent code to diff.\n"
   } else {
     use Text::WordDiff;
-    my $diff = word_diff \$last_code[1], \$last_code[0], { STYLE => 'MARKUP' };
+    my $diff = word_diff(\$last_code[1], \$last_code[0], { STYLE => 'Diff' });
     if($diff !~ /(?:<del>|<ins>)/) {
       $diff = "No difference.";
     } else {
@@ -1006,7 +1015,7 @@ if($output =~ m/^\s*$/) {
   $output =~ s/(\d+:\d+:\s*)* \(first use in this function\)//g;
   $output =~ s/(\d+:\d+:\s*)*error: \(Each undeclared identifier is reported only once.*?\)//msg;
   $output =~ s/(\d+:\d+:\s*)*ld: warning: cannot find entry symbol _start; defaulting to [^ ]+//;
-  $output =~ s/(\d+:\d+:\s*)*error: (.*?) error/error: $1; error/msg;
+#  $output =~ s/(\d+:\d+:\s*)*error: (.*?) error/error: $1; error/msg;
   $output =~ s/(\d+:\d+:\s*)*\/tmp\/.*\.o://g;
   $output =~ s/(\d+:\d+:\s*)*collect2: ld returned \d+ exit status//g;
   $output =~ s/\(\.text\+[^)]+\)://g;