2011-01-26 02:59:19 +01:00
|
|
|
#!/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;
|
2011-12-31 00:20:29 +01:00
|
|
|
kill 9, $pid;
|
2011-02-02 08:46:03 +01:00
|
|
|
waitpid($pid, 0);
|
2011-01-26 02:59:19 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
sub vm_start {
|
|
|
|
my $pid = fork;
|
|
|
|
|
|
|
|
if(not defined $pid) {
|
|
|
|
die "fork failed: $!";
|
|
|
|
}
|
|
|
|
|
|
|
|
if($pid == 0) {
|
2011-12-31 00:20:29 +01:00
|
|
|
#system('cp /home/compiler/compiler-saved-vm-backup /home/compiler/compiler-saved-vm');
|
2012-02-02 05:14:38 +01:00
|
|
|
my $command = 'nice -n -20 qemu-system-x86_64 -M pc -net none -hda /home/compiler/compiler-saved-vm -m 76 -monitor tcp:127.0.0.1:3335,server,nowait -serial tcp:127.0.0.1:3333,server,nowait -enable-kvm -boot c -loadvm 1 -nographic';
|
2011-02-02 08:46:03 +01:00
|
|
|
my @command_list = split / /, $command;
|
|
|
|
exec(@command_list);
|
2011-01-26 02:59:19 +01:00
|
|
|
} else {
|
|
|
|
return $pid;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2011-12-31 00:20:29 +01:00
|
|
|
sub vm_reset {
|
|
|
|
use IO::Socket;
|
|
|
|
|
2012-01-28 08:39:13 +01:00
|
|
|
print "Resetting vm\n";
|
2011-12-31 00:20:29 +01:00
|
|
|
my $sock = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => 4445, Prot => 'tcp');
|
|
|
|
if(not defined $sock) {
|
2012-01-28 08:39:13 +01:00
|
|
|
print "[vm_reset] Unable to connect to monitor: $!\n";
|
2011-12-31 00:20:29 +01:00
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
print $sock "loadvm 1\n";
|
|
|
|
close $sock;
|
2012-01-28 08:39:13 +01:00
|
|
|
print "Resetted vm\n";
|
2011-12-31 00:20:29 +01:00
|
|
|
}
|
|
|
|
|
2011-01-26 02:59:19 +01:00
|
|
|
sub execute {
|
|
|
|
my ($cmdline) = @_;
|
|
|
|
|
2011-12-31 00:20:29 +01:00
|
|
|
print "execute($cmdline)\n";
|
|
|
|
|
2011-01-26 02:59:19 +01:00
|
|
|
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"; };
|
2011-12-31 00:20:29 +01:00
|
|
|
alarm(7);
|
2011-01-26 02:59:19 +01:00
|
|
|
|
|
|
|
while(my $line = <$fh>) {
|
|
|
|
$result .= $line;
|
|
|
|
}
|
|
|
|
|
|
|
|
close $fh;
|
|
|
|
|
|
|
|
my $ret = $? >> 8;
|
|
|
|
alarm 0;
|
2011-12-31 00:20:29 +01:00
|
|
|
print "[$ret, $result]\n";
|
2011-01-26 02:59:19 +01:00
|
|
|
return ($ret, $result);
|
|
|
|
};
|
|
|
|
|
|
|
|
alarm 0;
|
|
|
|
if($@ =~ /Timed-out/) {
|
|
|
|
return (-13, '[Timed-out]');
|
|
|
|
}
|
|
|
|
|
|
|
|
return ($ret, $result);
|
|
|
|
} else {
|
|
|
|
waitpid($child, 0);
|
2011-12-31 00:20:29 +01:00
|
|
|
print "child exited, parent continuing\n";
|
2011-01-26 02:59:19 +01:00
|
|
|
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);
|
2011-12-31 00:20:29 +01:00
|
|
|
printf "[Connect from %s]\n", $client->peerhost;
|
2011-01-26 02:59:19 +01:00
|
|
|
eval {
|
|
|
|
my $lang;
|
|
|
|
my $nick;
|
|
|
|
my $code = "";
|
|
|
|
|
|
|
|
local $SIG{ALRM} = sub { die 'Timed-out'; };
|
2011-12-31 00:20:29 +01:00
|
|
|
alarm 5;
|
2011-01-26 02:59:19 +01:00
|
|
|
|
|
|
|
while (my $line = <$client>) {
|
|
|
|
$line =~ s/[\r\n]+$//;
|
|
|
|
next if $line =~ m/^\s*$/;
|
2011-12-31 00:20:29 +01:00
|
|
|
alarm 5;
|
2011-01-26 02:59:19 +01:00
|
|
|
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);
|
|
|
|
|
2012-02-02 05:14:38 +01:00
|
|
|
my ($ret, $result) = execute("./compiler_vm_client.pl $tnick -lang=$tlang $code");
|
2011-01-26 02:59:19 +01:00
|
|
|
|
|
|
|
if(not defined $ret) {
|
2011-12-31 00:20:29 +01:00
|
|
|
print "parent continued\n";
|
2011-01-26 02:59:19 +01:00
|
|
|
last;
|
|
|
|
}
|
|
|
|
|
|
|
|
print "Ret: $ret; result: [$result]\n";
|
|
|
|
|
|
|
|
if($ret == -13) {
|
|
|
|
print $client "$nick: ";
|
|
|
|
}
|
|
|
|
|
|
|
|
print $client $result . "\n";
|
|
|
|
close $client;
|
|
|
|
# child exit
|
2011-12-31 00:20:29 +01:00
|
|
|
print "child exit\n";
|
2011-01-26 02:59:19 +01:00
|
|
|
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;
|