mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-29 23:39:24 +01:00
modules: added compiler virtual machine scripts; use to set up your own environment for !cc/compiler_client.pl
This commit is contained in:
Pragmatic Software
parent
b2a1dec56c
commit
93658e0f6f
@ -13,7 +13,7 @@ use warnings;
|
||||
# These are set automatically by the build/commit script
|
||||
use constant {
|
||||
BUILD_NAME => "PBot",
|
||||
BUILD_REVISION => 255,
|
||||
BUILD_REVISION => 258,
|
||||
BUILD_DATE => "2011-01-25",
|
||||
};
|
||||
|
||||
|
||||
57
modules/compiler_vm/README
Normal file
57
modules/compiler_vm/README
Normal file
@ -0,0 +1,57 @@
|
||||
Installation:
|
||||
|
||||
You will need to download qemu and set up a virtual machine containing a compiler.
|
||||
|
||||
Then you will need to edit some of the following files and replace IP addresses
|
||||
and paths where appropriate (some locations may not yet be documented).
|
||||
|
||||
Once the files have been configured and copied to the appropriate locations,
|
||||
you will need to first start up the compiler_vm_server.pl script, and then
|
||||
connect to qemu's monitor and issue the 'savevm 1' command to save the virtual
|
||||
machine in this state. Between compiles, this state will be loaded via
|
||||
'loadvm 1' in order to reset everything within the machine for a clean and working
|
||||
environment for subsequent compiles.
|
||||
|
||||
Files:
|
||||
|
||||
(Read within each file for configuration instructions.)
|
||||
|
||||
- compiler_client.pl: Main entry point for compiling snippets. Sends over TCP to
|
||||
compiler_server.pl. This file can be run be run from the
|
||||
client machine or anywhere.
|
||||
|
||||
- compiler_server.pl: Responsible for setting up a TCP server to listen for
|
||||
incoming compile requests; and launching and resetting
|
||||
the virtual machine. Sends to compiler_vm_client.pl.
|
||||
Run this file on the server hosting the virtual machine.
|
||||
|
||||
- compiler_vm_client.pl: Responsible for sending snippets to the virtual
|
||||
machine. Also expands/translates and formats
|
||||
snippets into compilable code (with main function and
|
||||
headers), and handles "interactive-editing".
|
||||
Sends over TCP to qemu serial port, waits for result,
|
||||
then sends result back caller (compiler_server.pl).
|
||||
Run this file on the server hosting the virtual machine.
|
||||
|
||||
- compiler_vm_server.pl: Runs on the system inside the virtual machine.
|
||||
This script listens for incoming code snippets over
|
||||
the virtual machine's serial port.
|
||||
Calls compiler_watchdog.pl to monitor its exit signal
|
||||
or exit status, then returns result back over serial
|
||||
port (to compiler_vm_client.pl).
|
||||
|
||||
- compiler_watchdog.pl: Runs a program and watches its exit signals/status.
|
||||
|
||||
*** The following files are just auxiliary tools to start/connect to qemu, provided
|
||||
for convenience only. Perhaps they will be useful during installation/testing:
|
||||
|
||||
- monitor: Connects to qemu monitor (internal console) over TCP.
|
||||
|
||||
- serial: Connects to qemu serial port over TCP.
|
||||
|
||||
- runqemu: Launches qemu with a visible window, but without networking support.
|
||||
|
||||
- runeqmu.net: Launches qemu with a visible window, and with networking support.
|
||||
You may load a state previously saved with runqemu and reboot it
|
||||
or otherwise reload its networking configuration to gain networking.
|
||||
|
||||
25
modules/compiler_vm/compiler_client.pl
Executable file
25
modules/compiler_vm/compiler_client.pl
Executable file
@ -0,0 +1,25 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use IO::Socket;
|
||||
|
||||
my $sock = IO::Socket::INET->new(
|
||||
PeerAddr => '71.93.78.61',
|
||||
PeerPort => 9000,
|
||||
Proto => 'tcp') || die "Cannot create socket: $!";
|
||||
|
||||
my $nick = shift @ARGV;
|
||||
my $lang = shift @ARGV;
|
||||
my $code = join ' ', @ARGV;
|
||||
|
||||
print $sock "compile:$nick:$lang\n";
|
||||
print $sock "$code\n";
|
||||
print $sock "compile:end\n";
|
||||
|
||||
while(my $line = <$sock>) {
|
||||
print "$line";
|
||||
}
|
||||
|
||||
close $sock;
|
||||
165
modules/compiler_vm/compiler_server.pl
Executable file
165
modules/compiler_vm/compiler_server.pl
Executable file
@ -0,0 +1,165 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use IO::Socket;
|
||||
use Net::hostent;
|
||||
|
||||
my $PORT = 9000;
|
||||
|
||||
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 {
|
||||
my $pid = shift @_;
|
||||
return if not defined $pid;
|
||||
kill 'TERM', $pid;
|
||||
}
|
||||
|
||||
sub vm_start {
|
||||
my $pid = fork;
|
||||
|
||||
if(not defined $pid) {
|
||||
die "fork failed: $!";
|
||||
}
|
||||
|
||||
if($pid == 0) {
|
||||
exec('"/cygdrive/c/Program Files (x86)\QemuManager\qemu\qemu-system-x86_64.exe" -L "C:\Program Files (x86)\QemuManager\qemu" -M "pc" -m 512 -cpu "qemu64" -vga cirrus -drive "file=C:\Program Files (x86)\QemuManager\images\Test.qcow2,index=0,media=disk" -enable-kqemu -kernel-kqemu -net none -localtime -serial "tcp:127.0.0.1:4444,server,nowait" -monitor "tcp:127.0.0.1:4445,server,nowait" -kernel-kqemu -loadvm 1 -nographic');
|
||||
} else {
|
||||
return $pid;
|
||||
}
|
||||
}
|
||||
|
||||
sub execute {
|
||||
my ($cmdline) = @_;
|
||||
|
||||
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 'TERM', $pid; die "Timed-out\n"; };
|
||||
alarm(6);
|
||||
|
||||
while(my $line = <$fh>) {
|
||||
$result .= $line;
|
||||
}
|
||||
|
||||
close $fh;
|
||||
|
||||
my $ret = $? >> 8;
|
||||
alarm 0;
|
||||
return ($ret, $result);
|
||||
};
|
||||
|
||||
alarm 0;
|
||||
if($@ =~ /Timed-out/) {
|
||||
#kill 'TERM', $child;
|
||||
return (-13, '[Timed-out]');
|
||||
}
|
||||
|
||||
print "[$ret, $result]\n";
|
||||
|
||||
return ($ret, $result);
|
||||
} else {
|
||||
waitpid($child, 0);
|
||||
#print "child exited, parent continuing\n";
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
sub compiler_server {
|
||||
my $vm_pid = vm_start;
|
||||
print "vm started pid: $vm_pid\n";
|
||||
|
||||
my $server = server_listen($PORT);
|
||||
|
||||
while (my $client = $server->accept()) {
|
||||
$client->autoflush(1);
|
||||
my $hostinfo = gethostbyaddr($client->peeraddr);
|
||||
printf "[Connect from %s]\n", $hostinfo->name || $client->peerhost;
|
||||
eval {
|
||||
my $lang;
|
||||
my $nick;
|
||||
my $code = "";
|
||||
|
||||
local $SIG{ALRM} = sub { die 'Timed-out'; };
|
||||
alarm 1;
|
||||
|
||||
while (my $line = <$client>) {
|
||||
$line =~ s/[\r\n]+$//;
|
||||
next if $line =~ m/^\s*$/;
|
||||
alarm 1;
|
||||
print "got: [$line]\n";
|
||||
|
||||
if($line =~ /compile:end/) {
|
||||
$code = quotemeta($code);
|
||||
print "Attemping compile...\n";
|
||||
alarm 0;
|
||||
my $tnick = quotemeta($nick);
|
||||
my $tlang = quotemeta($lang);
|
||||
|
||||
my ($ret, $result) = execute("./compiler_vm_client.pl $tnick -lang=$tlang $code");
|
||||
|
||||
if(not defined $ret) {
|
||||
#print "parent continued\n";
|
||||
last;
|
||||
}
|
||||
|
||||
print "Ret: $ret; result: [$result]\n";
|
||||
|
||||
if($ret == -13) {
|
||||
print $client "$nick: ";
|
||||
}
|
||||
|
||||
print $client $result . "\n";
|
||||
close $client;
|
||||
# child exit
|
||||
exit;
|
||||
}
|
||||
|
||||
if($line =~ /compile:([^:]+):(.*)$/) {
|
||||
$nick = $1;
|
||||
$lang = $2;
|
||||
$code = "";
|
||||
next;
|
||||
}
|
||||
|
||||
$code .= $line . "\n";
|
||||
|
||||
}
|
||||
|
||||
alarm 0;
|
||||
};
|
||||
|
||||
alarm 0;
|
||||
|
||||
close $client;
|
||||
|
||||
print "stopping vm $vm_pid\n";
|
||||
vm_stop $vm_pid;
|
||||
$vm_pid = vm_start;
|
||||
print "new vm pid: $vm_pid\n";
|
||||
}
|
||||
}
|
||||
|
||||
compiler_server;
|
||||
667
modules/compiler_vm/compiler_vm_client.pl
Executable file
667
modules/compiler_vm/compiler_vm_client.pl
Executable file
@ -0,0 +1,667 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
# use warnings;
|
||||
use strict;
|
||||
use feature qw(switch);
|
||||
|
||||
use IPC::Open2;
|
||||
use Text::Balanced qw(extract_codeblock extract_delimited);
|
||||
use IO::Socket;
|
||||
use LWP::UserAgent;
|
||||
|
||||
my $MAX_UNDO_HISTORY = 100;
|
||||
|
||||
my $output = "";
|
||||
my $nooutput = 'No output.';
|
||||
|
||||
my %languages = (
|
||||
'C99' => "std=C99 with pedantic warnings",
|
||||
'C' => "std=gnu89",
|
||||
'CLANG' => "std=gnu89 clang/llvm",
|
||||
'CLANG99' => "std=c99 clang/llvm with pedantic warnings",
|
||||
# 'C++' => 1,
|
||||
);
|
||||
|
||||
my %preludes = (
|
||||
'C99' => "#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\n",
|
||||
'C' => "#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\n",
|
||||
'C++' => "#include <iostream>\n#include <cstdio>\n\nusing namespace std;\n\n",
|
||||
);
|
||||
|
||||
sub reset_vm {
|
||||
my $sock = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => '4445', Proto => 'tcp', Type => 'SOCK_STREAM');
|
||||
die "Could not create socket: $!" unless $sock;
|
||||
|
||||
$sock->autoflush();
|
||||
print $sock "loadvm 2\r\n";
|
||||
while(my $line = <$sock>) {
|
||||
last if $line =~ /loadvm 2/;
|
||||
}
|
||||
sleep 2;
|
||||
$sock->shutdown(1);
|
||||
}
|
||||
|
||||
sub pretty {
|
||||
my $code = join '', @_;
|
||||
my $result;
|
||||
|
||||
my $pid = open2(\*IN, \*OUT, 'astyle -Upf');
|
||||
print OUT "$code\n";
|
||||
close OUT;
|
||||
while(my $line = <IN>) {
|
||||
$result .= $line;
|
||||
}
|
||||
close IN;
|
||||
waitpid($pid, 0);
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub paste_codepad {
|
||||
my $text = join(' ', @_);
|
||||
|
||||
$text =~ s/(.{120})\s/$1\n/g;
|
||||
|
||||
my $ua = LWP::UserAgent->new();
|
||||
$ua->agent("Mozilla/5.0");
|
||||
push @{ $ua->requests_redirectable }, 'POST';
|
||||
|
||||
my %post = ( 'lang' => 'C', 'code' => $text, 'private' => 'True', 'submit' => 'Submit' );
|
||||
my $response = $ua->post("http://codepad.org", \%post);
|
||||
|
||||
if(not $response->is_success) {
|
||||
return $response->status_line;
|
||||
}
|
||||
|
||||
return $response->request->uri;
|
||||
}
|
||||
|
||||
sub compile {
|
||||
my ($lang, $code, $args, $input) = @_;
|
||||
|
||||
my $sock = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => '4444', Proto => 'tcp', Type => 'SOCK_STREAM');
|
||||
|
||||
die "Could not create socket: $!" unless $sock;
|
||||
|
||||
print $sock "compile:$lang:$args:$input\n";
|
||||
print $sock "$code\n";
|
||||
print $sock "compile:end\n";
|
||||
|
||||
my $result = "";
|
||||
my $got_result = 0;
|
||||
|
||||
while(my $line = <$sock>) {
|
||||
$line =~ s/[\r\n]+$//;
|
||||
|
||||
last if $line =~ /^result:end/;
|
||||
|
||||
if($line =~ /^result:/) {
|
||||
$line =~ s/^result://;
|
||||
$result .= $line;
|
||||
$got_result = 1;
|
||||
next;
|
||||
}
|
||||
|
||||
if($got_result) {
|
||||
$result .= $line . "\n";
|
||||
}
|
||||
}
|
||||
|
||||
close $sock;
|
||||
return $result;
|
||||
}
|
||||
|
||||
if($#ARGV < 1) {
|
||||
print "Usage: cc [-compiler -options] <code> [-stdin=input]\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
my $nick = shift @ARGV;
|
||||
my $code = join ' ', @ARGV;
|
||||
my @last_code;
|
||||
|
||||
my $lang = "C99";
|
||||
$lang = $1 if $code =~ s/-lang=([^\b\s]+)//i;
|
||||
$lang = "C" if $code =~ s/-nowarn[ings]*//i;
|
||||
|
||||
my $input = "";
|
||||
$input = $1 if $code =~ s/-input=(.*)$//i;
|
||||
|
||||
my $args = "";
|
||||
$args .= "$1 " while $code =~ s/^\s*(-[^ ]+)\s*//;
|
||||
$args =~ s/\s+$//;
|
||||
|
||||
if(open FILE, "< last_code.txt") {
|
||||
while(my $line = <FILE>) {
|
||||
chomp $line;
|
||||
push @last_code, $line;
|
||||
}
|
||||
close FILE;
|
||||
}
|
||||
|
||||
if($code =~ m/^\s*show\s*$/i) {
|
||||
if(defined $last_code[0]) {
|
||||
print "$nick: $last_code[0]\n";
|
||||
} else {
|
||||
print "$nick: No recent code to show.\n"
|
||||
}
|
||||
exit 0;
|
||||
}
|
||||
|
||||
my $got_run = undef;
|
||||
|
||||
if($code =~ m/^\s*(run|paste)\s*$/i) {
|
||||
$got_run = lc $1;
|
||||
if(defined $last_code[0]) {
|
||||
$code = $last_code[0];
|
||||
} else {
|
||||
print "$nick: No recent code to $got_run.\n";
|
||||
exit 0;
|
||||
}
|
||||
} else {
|
||||
my $subcode = $code;
|
||||
my $got_undo = 0;
|
||||
my $got_sub = 0;
|
||||
|
||||
while($subcode =~ s/^\s*(and)?\s*undo//) {
|
||||
splice @last_code, 0, 1;
|
||||
if(not defined $last_code[0]) {
|
||||
print "$nick: No more undos remaining.\n";
|
||||
exit 0;
|
||||
} else {
|
||||
$code = $last_code[0];
|
||||
$got_undo = 1;
|
||||
}
|
||||
}
|
||||
|
||||
my @replacements;
|
||||
my $prevchange = $last_code[0];
|
||||
my $got_changes = 0;
|
||||
|
||||
while(1) {
|
||||
$got_sub = 0;
|
||||
$got_changes = 0;
|
||||
|
||||
if($subcode =~ m/^\s*(and)?\s*remove \s*([^']+)?\s*'/) {
|
||||
my $modifier = 'first';
|
||||
|
||||
$subcode =~ s/^\s*(and)?\s*//;
|
||||
$subcode =~ s/remove\s*([^']+)?\s*//i;
|
||||
$modifier = $1 if defined $1;
|
||||
$modifier =~ s/\s+$//;
|
||||
|
||||
my ($e, $r) = extract_delimited($subcode, "'");
|
||||
|
||||
my $text;
|
||||
|
||||
if(defined $e) {
|
||||
$text = $e;
|
||||
$text =~ s/^'//;
|
||||
$text =~ s/'$//;
|
||||
$subcode = "replace $modifier '$text' with ''$r";
|
||||
} else {
|
||||
print "$nick: Unbalanced single quotes. Usage: !cc remove [all, first, .., tenth, last] 'text' [and ...]\n";
|
||||
exit 0;
|
||||
}
|
||||
next;
|
||||
}
|
||||
|
||||
if($subcode =~ s/^\s*(and)?\s*prepend '//) {
|
||||
$subcode = "'$subcode";
|
||||
|
||||
my ($e, $r) = extract_delimited($subcode, "'");
|
||||
|
||||
my $text;
|
||||
|
||||
if(defined $e) {
|
||||
$text = $e;
|
||||
$text =~ s/^'//;
|
||||
$text =~ s/'$//;
|
||||
$subcode = $r;
|
||||
|
||||
$got_sub = 1;
|
||||
$got_changes = 1;
|
||||
|
||||
if(not defined $prevchange) {
|
||||
print "$nick: No recent code to prepend to.\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
$code = $prevchange;
|
||||
$code =~ s/^/$text /;
|
||||
$prevchange = $code;
|
||||
} else {
|
||||
print "$nick: Unbalanced single quotes. Usage: !cc prepend 'text' [and ...]\n";
|
||||
exit 0;
|
||||
}
|
||||
next;
|
||||
}
|
||||
|
||||
if($subcode =~ s/^\s*(and)?\s*append '//) {
|
||||
$subcode = "'$subcode";
|
||||
|
||||
my ($e, $r) = extract_delimited($subcode, "'");
|
||||
|
||||
my $text;
|
||||
|
||||
if(defined $e) {
|
||||
$text = $e;
|
||||
$text =~ s/^'//;
|
||||
$text =~ s/'$//;
|
||||
$subcode = $r;
|
||||
|
||||
$got_sub = 1;
|
||||
$got_changes = 1;
|
||||
|
||||
if(not defined $prevchange) {
|
||||
print "$nick: No recent code to append to.\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
$code = $prevchange;
|
||||
$code =~ s/$/ $text/;
|
||||
$prevchange = $code;
|
||||
} else {
|
||||
print "$nick: Unbalanced single quotes. Usage: !cc append 'text' [and ...]\n";
|
||||
exit 0;
|
||||
}
|
||||
next;
|
||||
}
|
||||
|
||||
if($subcode =~ m/^\s*(and)?\s*replace\s*([^']+)?\s*'.*'\s*with\s*'.*'/i) {
|
||||
$got_sub = 1;
|
||||
my $modifier = 'first';
|
||||
|
||||
$subcode =~ s/^\s*(and)?\s*//;
|
||||
$subcode =~ s/replace\s*([^']+)?\s*//i;
|
||||
$modifier = $1 if defined $1;
|
||||
$modifier =~ s/\s+$//;
|
||||
|
||||
my ($from, $to);
|
||||
my ($e, $r) = extract_delimited($subcode, "'");
|
||||
|
||||
if(defined $e) {
|
||||
$from = $e;
|
||||
$from =~ s/^'//;
|
||||
$from =~ s/'$//;
|
||||
$from = quotemeta $from;
|
||||
$subcode = $r;
|
||||
$subcode =~ s/\s*with\s*//i;
|
||||
} else {
|
||||
print "$nick: Unbalanced single quotes. Usage: !cc replace 'from' with 'to' [and ...]\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
($e, $r) = extract_delimited($subcode, "'");
|
||||
|
||||
if(defined $e) {
|
||||
$to = $e;
|
||||
$to =~ s/^'//;
|
||||
$to =~ s/'$//;
|
||||
$subcode = $r;
|
||||
} else {
|
||||
print "$nick: Unbalanced single quotes. Usage: !cc replace 'from' with 'to' [and replace ... with ... [and ...]]\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
given($modifier) {
|
||||
when($_ eq 'all' ) {}
|
||||
when($_ eq 'last' ) {}
|
||||
when($_ eq 'first' ) { $modifier = 1; }
|
||||
when($_ eq 'second' ) { $modifier = 2; }
|
||||
when($_ eq 'third' ) { $modifier = 3; }
|
||||
when($_ eq 'fourth' ) { $modifier = 4; }
|
||||
when($_ eq 'fifth' ) { $modifier = 5; }
|
||||
when($_ eq 'sixth' ) { $modifier = 6; }
|
||||
when($_ eq 'seventh') { $modifier = 7; }
|
||||
when($_ eq 'eighth' ) { $modifier = 8; }
|
||||
when($_ eq 'nineth' ) { $modifier = 9; }
|
||||
when($_ eq 'tenth' ) { $modifier = 10; }
|
||||
default { print "$nick: Bad replacement modifier '$modifier'; valid modifiers are 'all', 'first', 'second', ..., 'tenth', 'last'\n"; exit 0; }
|
||||
}
|
||||
|
||||
my $replacement = {};
|
||||
$replacement->{'from'} = $from;
|
||||
$replacement->{'to'} = $to;
|
||||
$replacement->{'modifier'} = $modifier;
|
||||
|
||||
push @replacements, $replacement;
|
||||
next;
|
||||
}
|
||||
|
||||
if($subcode =~ m/^\s*(and)?\s*s\/.*\//) {
|
||||
$got_sub = 1;
|
||||
$subcode =~ s/^\s*(and)?\s*s//;
|
||||
|
||||
my ($regex, $to);
|
||||
my ($e, $r) = extract_delimited($subcode, '/');
|
||||
|
||||
if(defined $e) {
|
||||
$regex = $e;
|
||||
$regex =~ s/^\///;
|
||||
$regex =~ s/\/$//;
|
||||
$subcode = "/$r";
|
||||
} else {
|
||||
print "$nick: Unbalanced slashes. Usage: !cc s/regex/substitution/[gi] [and s/.../.../ [and ...]]\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
($e, $r) = extract_delimited($subcode, '/');
|
||||
|
||||
if(defined $e) {
|
||||
$to = $e;
|
||||
$to =~ s/^\///;
|
||||
$to =~ s/\/$//;
|
||||
$subcode = $r;
|
||||
} else {
|
||||
print "$nick: Unbalanced slashes. Usage: !cc s/regex/substitution/[gi] [and s/.../.../ [and ...]]\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
my $suffix;
|
||||
$suffix = $1 if $subcode =~ s/^([^ ]+)//;
|
||||
|
||||
if(length $suffix and $suffix =~ m/[^gi]/) {
|
||||
print "$nick: Bad regex modifier '$suffix'. Only 'i' and 'g' are allowed.\n";
|
||||
exit 0;
|
||||
}
|
||||
if(defined $prevchange) {
|
||||
$code = $prevchange;
|
||||
} else {
|
||||
print "$nick: No recent code to change.\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
my $ret = eval {
|
||||
my ($ret, $a, $b, $c, $d, $e, $f, $g, $h, $i, $before, $after);
|
||||
|
||||
if(not length $suffix) {
|
||||
$ret = $code =~ s|$regex|$to|;
|
||||
($a, $b, $c, $d, $e, $f, $g, $h, $i) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
|
||||
$before = $`;
|
||||
$after = $';
|
||||
} elsif($suffix =~ /^i$/) {
|
||||
$ret = $code =~ s|$regex|$to|i;
|
||||
($a, $b, $c, $d, $e, $f, $g, $h, $i) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
|
||||
$before = $`;
|
||||
$after = $';
|
||||
} elsif($suffix =~ /^g$/) {
|
||||
$ret = $code =~ s|$regex|$to|g;
|
||||
($a, $b, $c, $d, $e, $f, $g, $h, $i) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
|
||||
$before = $`;
|
||||
$after = $';
|
||||
} elsif($suffix =~ /^ig$/ or $suffix =~ /^gi$/) {
|
||||
$ret = $code =~ s|$regex|$to|gi;
|
||||
($a, $b, $c, $d, $e, $f, $g, $h, $i) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
|
||||
$before = $`;
|
||||
$after = $';
|
||||
}
|
||||
|
||||
if($ret) {
|
||||
$code =~ s/\$1/$a/g;
|
||||
$code =~ s/\$2/$b/g;
|
||||
$code =~ s/\$3/$c/g;
|
||||
$code =~ s/\$4/$d/g;
|
||||
$code =~ s/\$5/$e/g;
|
||||
$code =~ s/\$6/$f/g;
|
||||
$code =~ s/\$7/$g/g;
|
||||
$code =~ s/\$8/$h/g;
|
||||
$code =~ s/\$9/$i/g;
|
||||
$code =~ s/\$`/$before/g;
|
||||
$code =~ s/\$'/$after/g;
|
||||
}
|
||||
|
||||
return $ret;
|
||||
};
|
||||
|
||||
if($@) {
|
||||
print "$nick: $@\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if($ret) {
|
||||
$got_changes = 1;
|
||||
}
|
||||
|
||||
$prevchange = $code;
|
||||
}
|
||||
|
||||
if($got_sub and not $got_changes) {
|
||||
print "$nick: No substitutions made.\n";
|
||||
exit 0;
|
||||
} elsif($got_sub and $got_changes) {
|
||||
next;
|
||||
}
|
||||
|
||||
last;
|
||||
}
|
||||
|
||||
if($#replacements > -1) {
|
||||
@replacements = sort { $a->{'from'} cmp $b->{'from'} or $a->{'modifier'} <=> $b->{'modifier'} } @replacements;
|
||||
|
||||
my ($previous_from, $previous_modifier);
|
||||
|
||||
foreach my $replacement (@replacements) {
|
||||
my $from = $replacement->{'from'};
|
||||
my $to = $replacement->{'to'};
|
||||
my $modifier = $replacement->{'modifier'};
|
||||
|
||||
if(defined $previous_from) {
|
||||
if($previous_from eq $from and $previous_modifier =~ /^\d+$/) {
|
||||
$modifier -= $modifier - $previous_modifier;
|
||||
}
|
||||
}
|
||||
|
||||
if(defined $prevchange) {
|
||||
$code = $prevchange;
|
||||
} else {
|
||||
print "$nick: No recent code to change.\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
my $ret = eval {
|
||||
my $got_change;
|
||||
|
||||
my ($first_char, $last_char, $first_bound, $last_bound);
|
||||
$first_char = $1 if $from =~ m/^(.)/;
|
||||
$last_char = $1 if $from =~ m/(.)$/;
|
||||
|
||||
if($first_char =~ /\W/) {
|
||||
$first_bound = '.';
|
||||
} else {
|
||||
$first_bound = '\b';
|
||||
}
|
||||
|
||||
if($last_char =~ /\W/) {
|
||||
$last_bound = '\B';
|
||||
} else {
|
||||
$last_bound = '\b';
|
||||
}
|
||||
|
||||
if($modifier eq 'all') {
|
||||
while($code =~ s/($first_bound)$from($last_bound)/$1$to$2/) {
|
||||
$got_change = 1;
|
||||
}
|
||||
} elsif($modifier eq 'last') {
|
||||
if($code =~ s/(.*)($first_bound)$from($last_bound)/$1$2$to$3/) {
|
||||
$got_change = 1;
|
||||
}
|
||||
} else {
|
||||
my $count = 0;
|
||||
my $unescaped = $from;
|
||||
$unescaped =~ s/\\//g;
|
||||
if($code =~ s/($first_bound)$from($last_bound)/if(++$count == $modifier) { "$1$to$2"; } else { "$1$unescaped$2"; }/gex) {
|
||||
$got_change = 1;
|
||||
}
|
||||
}
|
||||
return $got_change;
|
||||
};
|
||||
|
||||
if($@) {
|
||||
print "$nick: $@\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if($ret) {
|
||||
$got_sub = 1;
|
||||
$got_changes = 1;
|
||||
}
|
||||
|
||||
$prevchange = $code;
|
||||
$previous_from = $from;
|
||||
$previous_modifier = $modifier;
|
||||
}
|
||||
|
||||
if($got_sub and not $got_changes) {
|
||||
print "$nick: No replacements made.\n";
|
||||
exit 0;
|
||||
}
|
||||
}
|
||||
|
||||
open FILE, "> last_code.txt";
|
||||
|
||||
unless ($got_undo and not $got_sub) {
|
||||
unshift @last_code, $code;
|
||||
}
|
||||
|
||||
my $i = 0;
|
||||
foreach my $line (@last_code) {
|
||||
last if(++$i > $MAX_UNDO_HISTORY);
|
||||
print FILE "$line\n";
|
||||
}
|
||||
close FILE;
|
||||
|
||||
if($got_undo and not $got_sub) {
|
||||
print "$nick: $code\n";
|
||||
exit 0;
|
||||
}
|
||||
}
|
||||
|
||||
# check to see if -flags were added by replacements
|
||||
$lang = $1 if $code =~ s/-lang=([^\b\s]+)//i;
|
||||
$lang = "C" if $code =~ s/-nowarn[ings]*//i;
|
||||
$input = $1 if $code =~ s/-input=(.*)$//i;
|
||||
$args .= "$1 " while $code =~ s/^\s*(-[^ ]+)\s*//;
|
||||
$args =~ s/\s+$//;
|
||||
|
||||
unless($got_run) {
|
||||
open FILE, ">> log.txt";
|
||||
print FILE localtime() . "\n";
|
||||
print FILE "$nick: $code\n";
|
||||
}
|
||||
|
||||
my $found = 0;
|
||||
my @langs;
|
||||
foreach my $l (sort { uc $a cmp uc $b } keys %languages) {
|
||||
push @langs, sprintf(" %-30s => %s", $l, $languages{$l});
|
||||
if(uc $lang eq uc $l) {
|
||||
$lang = $l;
|
||||
$found = 1;
|
||||
}
|
||||
}
|
||||
|
||||
if(not $found) {
|
||||
print "$nick: Invalid language '$lang'. Supported languages are:\n", (join ",\n", @langs), "\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
$code =~ s/#include <([^>]+)>/#include <$1>\n/g;
|
||||
$code =~ s/#([^ ]+) (.*?)\\n/#$1 $2\n/g;
|
||||
$code =~ s/#([\w\d_]+)\\n/#$1\n/g;
|
||||
|
||||
my $precode = $preludes{$lang} . $code;
|
||||
$code = '';
|
||||
|
||||
if($lang eq 'C' or $lang eq 'C99' or $lang eq 'C++') {
|
||||
my $has_main = 0;
|
||||
|
||||
my $prelude = '';
|
||||
$prelude = "$1$2" if $precode =~ s/^\s*(#.*)(#.*?[>\n])//s;
|
||||
|
||||
my $preprecode = $precode;
|
||||
|
||||
while($preprecode =~ s/([ a-zA-Z0-9\_\*\[\]]+)\s+([a-zA-Z0-9_*]+)\s*\((.*?)\)\s*({.*)//) {
|
||||
my ($ret, $ident, $params, $potential_body) = ($1, $2, $3, $4);
|
||||
|
||||
$ret =~ s/^\s+//;
|
||||
$ret =~ s/\s+$//;
|
||||
|
||||
if($ret eq "else" or $ret eq "while") {
|
||||
$precode .= "$ret $ident ($params) $potential_body";
|
||||
next;
|
||||
} else {
|
||||
$precode =~ s/([ a-zA-Z0-9\_\*\[\]]+)\s+([a-zA-Z0-9_*]+)\s*\((.*?)\)\s*({.*)//;
|
||||
}
|
||||
|
||||
my @extract = extract_codeblock($potential_body, '{}');
|
||||
my $body;
|
||||
if(not defined $extract[0]) {
|
||||
$output .= "error: unmatched brackets for function '$ident';\n";
|
||||
$body = $extract[1];
|
||||
} else {
|
||||
$body = $extract[0];
|
||||
$preprecode .= $extract[1];
|
||||
$precode .= $extract[1];
|
||||
}
|
||||
#print "[$ret][$ident][$params][$body]\n";
|
||||
$code .= "$ret $ident($params) $body\n\n";
|
||||
$has_main = 1 if $ident eq 'main';
|
||||
}
|
||||
|
||||
$precode =~ s/^\s+//;
|
||||
$precode =~ s/\s+$//;
|
||||
|
||||
if(not $has_main) {
|
||||
$code = "$prelude\n\n$code\n\nint main(int argc, char **argv) {\n$precode\n;\nreturn 0;\n}\n";
|
||||
$nooutput = "Success [no output].";
|
||||
} else {
|
||||
$code = "$prelude\n\n$precode\n\n$code\n";
|
||||
$nooutput = "No output.";
|
||||
}
|
||||
} else {
|
||||
$code = $precode;
|
||||
}
|
||||
|
||||
$code =~ s/\|n/\n/g;
|
||||
$code =~ s/^\s+//;
|
||||
$code =~ s/\s+$//;
|
||||
$code =~ s/;\n;\n/;\n/g;
|
||||
$code =~ s/(\n\n)+/\n\n/g;
|
||||
|
||||
if(defined $got_run and $got_run eq "paste") {
|
||||
my $uri = paste_codepad(pretty($code));
|
||||
print "$nick: $uri\n";
|
||||
exit 0;
|
||||
}
|
||||
|
||||
print FILE "$nick: [lang:$lang][args:$args][input:$input]\n$code\n";
|
||||
|
||||
$output = compile($lang, $code, $args, $input);
|
||||
|
||||
$output =~ s/cc1: warnings being treated as errors//;
|
||||
$output =~ s/ Line \d+ ://g;
|
||||
$output =~ s/ \(first use in this function\)//g;
|
||||
$output =~ s/error: \(Each undeclared identifier is reported only once.*?\)//msg;
|
||||
$output =~ s/prog\.c:[:\d]*//g;
|
||||
$output =~ s/ld: warning: cannot find entry symbol _start; defaulting to [^ ]+//;
|
||||
$output =~ s/error: (.*?) error/error: $1; error/msg;
|
||||
$output =~ s/\/tmp\/.*\.o://g;
|
||||
$output =~ s/collect2: ld returned \d+ exit status//g;
|
||||
$output =~ s/\(\.text\+[^)]+\)://g;
|
||||
$output =~ s/\[ In/[In/;
|
||||
|
||||
my $left_quote = chr(226) . chr(128) . chr(152);
|
||||
my $right_quote = chr(226) . chr(128) . chr(153);
|
||||
$output =~ s/$left_quote/'/g;
|
||||
$output =~ s/$right_quote/'/g;
|
||||
|
||||
$output = $nooutput if $output =~ m/^\s+$/;
|
||||
|
||||
unless($got_run) {
|
||||
print FILE localtime() . "\n";
|
||||
print FILE "$nick: $output\n\n";
|
||||
close FILE;
|
||||
}
|
||||
|
||||
print "$nick: $output\n";
|
||||
|
||||
#reset_vm;
|
||||
176
modules/compiler_vm/compiler_vm_server.pl
Executable file
176
modules/compiler_vm/compiler_vm_server.pl
Executable file
@ -0,0 +1,176 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
my %languages = (
|
||||
'C' => {
|
||||
'cmdline' => 'gcc $args $file -o prog',
|
||||
'args' => '-Wextra -Wall -Wno-unused -std=gnu89',
|
||||
'file' => 'prog.c',
|
||||
},
|
||||
'C++' => {
|
||||
'cmdline' => 'g++ $args $file -o prog',
|
||||
'args' => '',
|
||||
'file' => 'prog.cpp',
|
||||
},
|
||||
'C99' => {
|
||||
'cmdline' => 'gcc $args $file -o prog',
|
||||
'args' => '-Wextra -Wall -Wno-unused -pedantic -std=c99',
|
||||
'file' => 'prog.c',
|
||||
},
|
||||
);
|
||||
|
||||
sub runserver {
|
||||
open(my $input, '<', "/dev/ttyS0") or die $!;
|
||||
open(my $output, '>', "/dev/ttyS0") or die $!;
|
||||
|
||||
my $lang;
|
||||
my $code;
|
||||
my $user_args;
|
||||
my $user_input;
|
||||
|
||||
print "Waiting for input...\n";
|
||||
|
||||
while(my $line = <$input>) {
|
||||
chomp $line;
|
||||
next unless length $line;
|
||||
|
||||
print "Got [$line]\n";
|
||||
|
||||
if($line =~ m/^compile:\s*end/) {
|
||||
next if not defined $lang or not defined $code;
|
||||
|
||||
print "Attempting compile [$lang] ...\n";
|
||||
|
||||
my $result = interpret($lang, $code, $user_args, $user_input);
|
||||
|
||||
print "Done compiling; result: [$result]\n";
|
||||
print $output "result:$result\n";
|
||||
print $output "result:end\n";
|
||||
|
||||
print "input: ";
|
||||
next;
|
||||
}
|
||||
|
||||
if($line =~ m/^compile:\s*(.*)/) {
|
||||
my $options = $1;
|
||||
$user_args = undef;
|
||||
$user_input = undef;
|
||||
$lang = undef;
|
||||
|
||||
($lang, $user_args, $user_input) = split /:/, $options;
|
||||
|
||||
$code = "";
|
||||
$lang = "C99" if not defined $lang;
|
||||
$user_args = "" if not defined $user_args;
|
||||
$user_input = "" if not defined $user_input;
|
||||
|
||||
print "Setting lang [$lang]; [$user_args]; [$user_input]\n";
|
||||
next;
|
||||
}
|
||||
|
||||
$code .= $line . "\n";
|
||||
}
|
||||
|
||||
close $input;
|
||||
close $output;
|
||||
}
|
||||
|
||||
sub interpret {
|
||||
my ($lang, $code, $user_args, $user_input) = @_;
|
||||
|
||||
print "lang: [$lang], code: [$code], user_args: [$user_args], input: [$user_input]\n";
|
||||
|
||||
$lang = uc $lang;
|
||||
|
||||
if(not exists $languages{$lang}) {
|
||||
return "No support for language '$lang' at this time.\n";
|
||||
}
|
||||
|
||||
open(my $fh, '>', $languages{$lang}{'file'}) or die $!;
|
||||
print $fh $code . "\n";
|
||||
close $fh;
|
||||
|
||||
my $cmdline = $languages{$lang}{'cmdline'};
|
||||
|
||||
if(length $user_args) {
|
||||
print "Replacing args with $user_args\n";
|
||||
$user_args = quotemeta($user_args);
|
||||
$user_args =~ s/\\ / /g;
|
||||
$cmdline =~ s/\$args/$user_args/;
|
||||
} else {
|
||||
$cmdline =~ s/\$args/$languages{$lang}{'args'}/;
|
||||
}
|
||||
|
||||
$cmdline =~ s/\$file/$languages{$lang}{'file'}/;
|
||||
|
||||
print "Executing [$cmdline]\n";
|
||||
my ($ret, $result) = execute(60, $cmdline);
|
||||
print "Got result: ($ret) [$result]\n";
|
||||
|
||||
if($ret != 0) {
|
||||
return $result;
|
||||
}
|
||||
|
||||
my $output = "";
|
||||
|
||||
if(length $result) {
|
||||
$result =~ s/^\s+//;
|
||||
$result =~ s/\s+$//;
|
||||
$output = "[$result]\n";
|
||||
}
|
||||
|
||||
($ret, $result) = execute(5, "./compiler_watchdog.pl");
|
||||
|
||||
print "Executed prog; got result: ($ret) [$result]\n";
|
||||
|
||||
$result =~ s/^\s+//;
|
||||
$result =~ s/\s+$//;
|
||||
|
||||
if(not length $result) {
|
||||
$result = "Success (no output).\n" if $ret == 0;
|
||||
$result = "Success (exit code $ret).\n" if $ret != 0;
|
||||
}
|
||||
|
||||
return $output . "\n" . $result;
|
||||
}
|
||||
|
||||
sub execute {
|
||||
my $timeout = shift @_;
|
||||
my ($cmdline) = @_;
|
||||
|
||||
my ($ret, $result);
|
||||
|
||||
($ret, $result) = eval {
|
||||
print "eval\n";
|
||||
|
||||
my $result = '';
|
||||
|
||||
my $pid = open(my $fh, '-|', "$cmdline 2>&1");
|
||||
|
||||
local $SIG{ALRM} = sub { print "Time out\n"; kill 'TERM', $pid; die "$result [Timed-out]\n"; };
|
||||
alarm($timeout);
|
||||
|
||||
while(my $line = <$fh>) {
|
||||
$result .= $line;
|
||||
}
|
||||
|
||||
close $fh;
|
||||
my $ret = $? >> 8;
|
||||
alarm 0;
|
||||
return ($ret, $result);
|
||||
};
|
||||
|
||||
print "done eval\n";
|
||||
alarm 0;
|
||||
|
||||
if($@ =~ /Timed-out/) {
|
||||
return (-1, $@);
|
||||
}
|
||||
|
||||
print "[$ret, $result]\n";
|
||||
return ($ret, $result);
|
||||
}
|
||||
|
||||
runserver;
|
||||
138
modules/compiler_vm/compiler_watchdog.pl
Executable file
138
modules/compiler_vm/compiler_watchdog.pl
Executable file
@ -0,0 +1,138 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use POSIX ":sys_wait_h";
|
||||
|
||||
my @signame;
|
||||
$signame[0] = 'SIGZERO';
|
||||
$signame[1] = 'SIGHUP';
|
||||
$signame[2] = 'SIGINT';
|
||||
$signame[3] = 'SIGQUIT';
|
||||
$signame[4] = 'SIGILL';
|
||||
$signame[5] = 'SIGTRAP';
|
||||
$signame[6] = 'SIGABRT';
|
||||
$signame[7] = 'SIGBUS';
|
||||
$signame[8] = 'SIGFPE';
|
||||
$signame[9] = 'SIGKILL';
|
||||
$signame[10] = 'SIGUSR1';
|
||||
$signame[11] = 'SIGSEGV';
|
||||
$signame[12] = 'SIGUSR2';
|
||||
$signame[13] = 'SIGPIPE';
|
||||
$signame[14] = 'SIGALRM';
|
||||
$signame[15] = 'SIGTERM';
|
||||
$signame[16] = 'SIGSTKFLT';
|
||||
$signame[17] = 'SIGCHLD';
|
||||
$signame[18] = 'SIGCONT';
|
||||
$signame[19] = 'SIGSTOP';
|
||||
$signame[20] = 'SIGTSTP';
|
||||
$signame[21] = 'SIGTTIN';
|
||||
$signame[22] = 'SIGTTOU';
|
||||
$signame[23] = 'SIGURG';
|
||||
$signame[24] = 'SIGXCPU';
|
||||
$signame[25] = 'SIGXFSZ';
|
||||
$signame[26] = 'SIGVTALRM';
|
||||
$signame[27] = 'SIGPROF';
|
||||
$signame[28] = 'SIGWINCH';
|
||||
$signame[29] = 'SIGIO';
|
||||
$signame[30] = 'SIGPWR';
|
||||
$signame[31] = 'SIGSYS';
|
||||
$signame[32] = 'SIGNUM32';
|
||||
$signame[33] = 'SIGNUM33';
|
||||
$signame[34] = 'SIGRTMIN';
|
||||
$signame[35] = 'SIGNUM35';
|
||||
$signame[36] = 'SIGNUM36';
|
||||
$signame[37] = 'SIGNUM37';
|
||||
$signame[38] = 'SIGNUM38';
|
||||
$signame[39] = 'SIGNUM39';
|
||||
$signame[40] = 'SIGNUM40';
|
||||
$signame[41] = 'SIGNUM41';
|
||||
$signame[42] = 'SIGNUM42';
|
||||
$signame[43] = 'SIGNUM43';
|
||||
$signame[44] = 'SIGNUM44';
|
||||
$signame[45] = 'SIGNUM45';
|
||||
$signame[46] = 'SIGNUM46';
|
||||
$signame[47] = 'SIGNUM47';
|
||||
$signame[48] = 'SIGNUM48';
|
||||
$signame[49] = 'SIGNUM49';
|
||||
$signame[50] = 'SIGNUM50';
|
||||
$signame[51] = 'SIGNUM51';
|
||||
$signame[52] = 'SIGNUM52';
|
||||
$signame[53] = 'SIGNUM53';
|
||||
$signame[54] = 'SIGNUM54';
|
||||
$signame[55] = 'SIGNUM55';
|
||||
$signame[56] = 'SIGNUM56';
|
||||
$signame[57] = 'SIGNUM57';
|
||||
$signame[58] = 'SIGNUM58';
|
||||
$signame[59] = 'SIGNUM59';
|
||||
$signame[60] = 'SIGNUM60';
|
||||
$signame[61] = 'SIGNUM61';
|
||||
$signame[62] = 'SIGNUM62';
|
||||
$signame[63] = 'SIGNUM63';
|
||||
$signame[64] = 'SIGRTMAX';
|
||||
$signame[65] = 'SIGIOT';
|
||||
$signame[66] = 'SIGCLD';
|
||||
$signame[67] = 'SIGPOLL';
|
||||
$signame[68] = 'SIGUNUSED';
|
||||
|
||||
sub reaper {
|
||||
my $child;
|
||||
while (($child=waitpid(-1,WNOHANG))>0) {
|
||||
|
||||
# See waitpid(2) and POSIX(3perl)
|
||||
my $status = $?;
|
||||
my $exitcode = $status >> 8;
|
||||
my $wifexited = WIFEXITED($status);
|
||||
my $wexitstatus = $wifexited ? WEXITSTATUS($status) : undef;
|
||||
my $wifsignaled = WIFSIGNALED($status);
|
||||
my $wtermsig = $wifsignaled ? WTERMSIG($status) : undef;
|
||||
my $wifstopped = WIFSTOPPED($status);
|
||||
my $wstopsig = $wifstopped ? WSTOPSIG($status) : undef;
|
||||
|
||||
if($wifsignaled == 1) {
|
||||
print "\nProgram received signal $wtermsig ($signame[$wtermsig])\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
if(($wifexited == 1) && ($exitcode != 0)) {
|
||||
print "\nExit: $exitcode\n";
|
||||
exit;
|
||||
} elsif(($wifexited ==1) && ($exitcode == 0)) {
|
||||
exit;
|
||||
}
|
||||
else {
|
||||
|
||||
print ""
|
||||
." status=$status exitcode=$exitcode"
|
||||
." wifexited=$wifexited"
|
||||
." wexitstatus=".(defined($wexitstatus) ? $wexitstatus : "
|
||||
+undef")
|
||||
." wifsignaled=$wifsignaled"
|
||||
." wtermsig=".(defined($wtermsig) ? $wtermsig : "undef")
|
||||
." wifstopped=$wifstopped"
|
||||
." wstopsig=".(defined($wstopsig) ? $wstopsig : "undef")
|
||||
."\n";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub execute {
|
||||
my ($cmdline) = @_;
|
||||
my ($ret, $result);
|
||||
|
||||
local $SIG{CHLD} = \&reaper;
|
||||
|
||||
my $child = fork;
|
||||
|
||||
local $SIG{TERM} = sub { kill 'TERM', $child; };
|
||||
|
||||
if($child == 0) {
|
||||
exec("$cmdline 2>&1");
|
||||
} else {
|
||||
while(1) { sleep 10; }
|
||||
}
|
||||
}
|
||||
|
||||
execute("./prog");
|
||||
1
modules/compiler_vm/monitor
Executable file
1
modules/compiler_vm/monitor
Executable file
@ -0,0 +1 @@
|
||||
telnet localhost 4445
|
||||
1
modules/compiler_vm/runqemu
Executable file
1
modules/compiler_vm/runqemu
Executable file
@ -0,0 +1 @@
|
||||
"/cygdrive/c/Program Files (x86)\QemuManager\qemu\qemu-system-x86_64.exe" -L "C:\Program Files (x86)\QemuManager\qemu" -M "pc" -m 512 -cpu "qemu64" -vga cirrus -drive "file=C:\Program Files (x86)\QemuManager\images\Test.qcow2,index=0,media=disk" -enable-kqemu -kernel-kqemu -net none -localtime -serial "tcp:127.0.0.1:4444,server,nowait" -monitor "tcp:127.0.0.1:4445,server,nowait" -kernel-kqemu -loadvm 1
|
||||
1
modules/compiler_vm/runqemu.net
Executable file
1
modules/compiler_vm/runqemu.net
Executable file
@ -0,0 +1 @@
|
||||
"/cygdrive/c/Program Files (x86)\QemuManager\qemu\qemu-system-x86_64.exe" -L "C:\Program Files (x86)\QemuManager\qemu" -M "pc" -m 512 -cpu "qemu64" -vga cirrus -drive "file=C:\Program Files (x86)\QemuManager\images\Test.qcow2,index=0,media=disk" -enable-kqemu -net nic,vlan=0,macaddr=52-54-00-F0-EC-8D,model=rtl8139 -net user,vlan=0 -localtime -serial "tcp:127.0.0.1:4444,server,nowait" -monitor "tcp:127.0.0.1:4445,server,nowait" -loadvm 1
|
||||
1
modules/compiler_vm/serial
Executable file
1
modules/compiler_vm/serial
Executable file
@ -0,0 +1 @@
|
||||
telnet localhost 4444
|
||||
Loading…
Reference in New Issue
Block a user