GitHub/pbot
3
0
Fork 0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-22 11:59:43 +01:00
Code Issues Projects Releases Wiki Activity

compiler_vm: refactor vm_server

Browse Source
This commit is contained in:
Pragmatic Software 2022-02-07 20:33:24 -08:00
parent c488b912d2
commit 85b9aaddf8
1 changed files with 112 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

155
applets/compiler_vm/host/bin/vm-server
View File

@ -37,12 +37,10 @@ sub vm_revert() {
print "Reverted.\n";
}
sub execute($cmdline) {
print "execute ($cmdline)\n";
sub execute($command) {
print "execute ($command)\n";
my @list = split / /, $cmdline;
my $pid = open(my $fh, '-|', @list);
my $pid = open(my $fh, '-|', split / /, $command);
if (not defined $pid) {
print "Couldn't fork: $!\n";
@ -60,7 +58,6 @@ sub execute($cmdline) {
}
my $ret = $? >> 8;
print "result ($ret, $result)\n";
return ($ret, $result);
};
@ -68,12 +65,12 @@ sub execute($cmdline) {
alarm 0;
if (my $exception = $@) {
print "Got exception [$exception]\n";
# handle time-out exception
if ($exception =~ /Timed-out: (.*)/) {
return (-13, "[Timed-out] $1");
}
# propagate unhandled exception
die $exception;
}
@ -116,64 +113,16 @@ sub server_listen($port) {
Reuse => 1,
);
die "Can't setup server: $!" unless $server;
print "[Server $0 accepting clients at :$port]\n";
print "Server $0 accepting clients at :$port\n";
return $server;
}
sub main() {
my $heartbeat;
my $running;
tie $heartbeat, 'IPC::Shareable', 'dat1', { create => 1 };
tie $running, 'IPC::Shareable', 'dat2', { create => 1 };
$running = 1;
$heartbeat = 0;
my $heartbeat_pid = fork // die "Heartbeat fork failed: $!";
if ($heartbeat_pid == 0) {
# heartbeat
tie $heartbeat, 'IPC::Shareable', 'dat1', { create => 1 };
tie $running, 'IPC::Shareable', 'dat2', { create => 1 };
my $heartbeat_monitor = connect_to_heartbeat() || die "Could not start heartbeat.\n";
print "heartbeat: running: $running\n";
while ($running and <$heartbeat_monitor>) {
$heartbeat = time;
}
print "Stopping heartbeat...\n";
$heartbeat = 0;
exit;
} else {
# server
print "Starting compiler server on port " . SERVER_PORT . "\n";
my $server = eval { server_listen(SERVER_PORT) };
if ($@) {
print STDERR $@;
$running = 0;
}
print "server: running: $running\n";
while ($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;
sub handle_client($client, $heartbeat) {
my ($timed_out, $killed) = (0, 0);
eval {
# give client 5 seconds to send a line
local $SIG{ALRM} = sub { die 'client I/O timed-out'; };
local $SIG{ALRM} = sub { die "Client I/O timed-out\n"; };
alarm 5;
while (my $line = <$client>) {
@ -183,7 +132,7 @@ sub main() {
# give client 5 more seconds
alarm 5;
print "got: [$line]\n";
print "Read [$line]\n";
if (time - $heartbeat > 5) {
print "Lost heartbeat, ignoring compile attempt.\n";
@ -191,56 +140,100 @@ sub main() {
last;
}
print "Attempting compile...\n";
# disable client time-out
alarm 0;
my ($ret, $result) = execute("perl vm-exec $line");
if(not defined $ret) {
#print "parent continued\n";
print "parent continued [$result]\n";
$timed_out = 1 if $result == 243 or $result == -13; # -13 == 243
$killed = 1 if $result == 242 or $result == -14; # -14 = 242
last;
}
$result =~ s/\s+$//;
print "Ret: $ret; result: [$result]\n";
if($result =~ m/\[Killed\]$/) {
print "Process was killed\n";
if ($result =~ m/\[Killed\]$/) {
$killed = 1;
$ret = -14;
}
if ($ret == -13 && $result =~ m/\[Timed-out\]/) {
$timed_out = 1;
}
print $client $result . "\n";
$ret = -14 if $killed;
last;
}
alarm 0;
};
# print client time-out exception
print "$@" if $@;
alarm 0;
close $client;
if (my $exception = $@) {
print "Got exception: $@\n";
print "timed out: $timed_out; killed: $killed\n";
return $timed_out || $killed;
}
use constant SUCCESS => 0;
sub do_heartbeat() {
tie my $heartbeat, 'IPC::Shareable', { key => 'heartbeat' };
tie my $running, 'IPC::Shareable', { key => 'running' };
my $heartbeat_monitor = connect_to_heartbeat() || die "No heartbeat.\n";
while ($running and <$heartbeat_monitor>) {
$heartbeat = time;
}
print "timed out: $timed_out; killed: $killed\n";
next unless $timed_out || $killed;
$heartbeat = 0;
exit;
}
sub do_server() {
tie my $heartbeat, 'IPC::Shareable', { key => 'heartbeat' };
tie my $running, 'IPC::Shareable', { key => 'running' };
print "Starting PBot VM Server on port " . SERVER_PORT . "\n";
my $server = eval { server_listen(SERVER_PORT) };
if ($@) {
print STDERR $@;
$running = 0;
return;
}
while ($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;
if (handle_client($client, $heartbeat) != SUCCESS) {
vm_revert();
}
}
print "Shutting down server.\n";
}
sub main() {
tie my $heartbeat, 'IPC::Shareable', { key => 'heartbeat', create => 1, destroy => 1 };
tie my $running, 'IPC::Shareable', { key => 'running', create => 1, destroy => 1 };
$running = 1;
$heartbeat = 0;
my $heartbeat_pid = fork // die "Heartbeat fork failed: $!";
if ($heartbeat_pid == 0) {
do_heartbeat();
} else {
do_server();
}
print "Waiting for heart to stop...\n";
waitpid($heartbeat_pid, 0);
print "Heart stopped.\n";
}
main();