mirror of
https://github.com/pragma-/pbot.git
synced 2024-12-24 11:42:35 +01:00
compiler_vm: add Win32 VirtualBox server; misc improvements
This commit is contained in:
parent
0b728c9d37
commit
62e11d0b5d
@ -13,7 +13,7 @@ use warnings;
|
|||||||
# These are set automatically by the build/commit script
|
# These are set automatically by the build/commit script
|
||||||
use constant {
|
use constant {
|
||||||
BUILD_NAME => "PBot",
|
BUILD_NAME => "PBot",
|
||||||
BUILD_REVISION => 608,
|
BUILD_REVISION => 609,
|
||||||
BUILD_DATE => "2014-05-30",
|
BUILD_DATE => "2014-05-30",
|
||||||
};
|
};
|
||||||
|
|
||||||
|
40
modules/compiler_vm/Diff.pm
Normal file
40
modules/compiler_vm/Diff.pm
Normal file
@ -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;
|
270
modules/compiler_vm/compiler_server_vbox_win32.pl
Executable file
270
modules/compiler_vm/compiler_server_vbox_win32.pl
Executable file
@ -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;
|
@ -12,6 +12,14 @@ use Time::HiRes qw/gettimeofday/;
|
|||||||
|
|
||||||
my $debug = 0;
|
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 $USE_LOCAL = defined $ENV{'CC_LOCAL'};
|
||||||
my $MAX_UNDO_HISTORY = 1000000;
|
my $MAX_UNDO_HISTORY = 1000000;
|
||||||
|
|
||||||
@ -31,7 +39,7 @@ my %languages = (
|
|||||||
|
|
||||||
my %preludes = (
|
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",
|
'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",
|
'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);
|
$compiler = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => '3333', Proto => 'tcp', Type => SOCK_STREAM);
|
||||||
die "Could not create socket: $!" unless $compiler;
|
die "Could not create socket: $!" unless $compiler;
|
||||||
$compiler_output = $compiler;
|
$compiler_output = $compiler;
|
||||||
|
$compiler_client = $compiler;
|
||||||
}
|
}
|
||||||
|
|
||||||
my $date = time;
|
my $date = time;
|
||||||
@ -141,7 +150,7 @@ sub compile {
|
|||||||
}
|
}
|
||||||
|
|
||||||
if($#ARGV < 2) {
|
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]
|
# usage for shell: cc <nick> <channel> [-compiler -options] <code> [-stdin=input]
|
||||||
exit 0;
|
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"
|
print "$nick: Not enough recent code to diff.\n"
|
||||||
} else {
|
} else {
|
||||||
use Text::WordDiff;
|
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>)/) {
|
if($diff !~ /(?:<del>|<ins>)/) {
|
||||||
$diff = "No difference.";
|
$diff = "No difference.";
|
||||||
} else {
|
} 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*)* \(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*)*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*)*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*)*\/tmp\/.*\.o://g;
|
||||||
$output =~ s/(\d+:\d+:\s*)*collect2: ld returned \d+ exit status//g;
|
$output =~ s/(\d+:\d+:\s*)*collect2: ld returned \d+ exit status//g;
|
||||||
$output =~ s/\(\.text\+[^)]+\)://g;
|
$output =~ s/\(\.text\+[^)]+\)://g;
|
||||||
|
Loading…
Reference in New Issue
Block a user