2022-01-23 16:49:23 +01:00
|
|
|
#!/usr/bin/env perl
|
|
|
|
|
2022-01-30 00:51:39 +01:00
|
|
|
# File: vm-server
|
2022-01-23 16:49:23 +01:00
|
|
|
#
|
|
|
|
# Purpose: The compiler server manages the guest virtual machine state and
|
|
|
|
# listens for incoming compile requests. This server can be run on any remote
|
|
|
|
# machine. There can be multiple servers using different ports on the same machine.
|
|
|
|
#
|
|
|
|
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
|
|
|
# SPDX-License-Identifier: MIT
|
|
|
|
|
2022-02-07 05:01:56 +01:00
|
|
|
use 5.020;
|
|
|
|
|
2022-01-23 16:49:23 +01:00
|
|
|
use warnings;
|
|
|
|
use strict;
|
|
|
|
|
2022-02-07 05:01:56 +01:00
|
|
|
use feature qw(signatures);
|
|
|
|
no warnings qw(experimental::signatures);
|
|
|
|
|
2022-01-23 16:49:23 +01:00
|
|
|
use IO::Socket;
|
|
|
|
use Net::hostent;
|
|
|
|
use IPC::Shareable;
|
|
|
|
use Time::HiRes qw/gettimeofday/;
|
|
|
|
use Encode;
|
|
|
|
|
2022-01-29 21:22:48 +01:00
|
|
|
use constant {
|
2022-02-07 05:01:56 +01:00
|
|
|
SERVER_PORT => $ENV{PBOTVM_SERVER} // 9000,
|
|
|
|
HEARTBEAT_PORT => $ENV{PBOTVM_HEART} // 5556,
|
|
|
|
DOMAIN_NAME => $ENV{PBOTVM_DOMAIN} // 'pbot-vm',
|
|
|
|
COMPILE_TIMEOUT => $ENV{PBOTVM_TIMEOUT} // 10,
|
2022-01-29 21:22:48 +01:00
|
|
|
};
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-07 05:01:56 +01:00
|
|
|
sub vm_revert() {
|
|
|
|
return if $ENV{PBOTVM_NOREVERT};
|
|
|
|
print "Reverting vm...\n";
|
|
|
|
system('time virsh snapshot-revert '.DOMAIN_NAME.' 1');
|
|
|
|
print "Reverted.\n";
|
2022-01-23 16:49:23 +01:00
|
|
|
}
|
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
sub execute($command) {
|
|
|
|
print "execute ($command)\n";
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
my $pid = open(my $fh, '-|', split / /, $command);
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-07 05:01:56 +01:00
|
|
|
if (not defined $pid) {
|
|
|
|
print "Couldn't fork: $!\n";
|
|
|
|
return (-13, "[Fatal error]");
|
|
|
|
}
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-07 05:01:56 +01:00
|
|
|
my ($ret, $result) = (0, '');
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-07 05:01:56 +01:00
|
|
|
($ret, $result) = eval {
|
|
|
|
local $SIG{ALRM} = sub { kill 9, $pid; die "Timed-out: $result\n"; };
|
|
|
|
alarm(COMPILE_TIMEOUT);
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-07 05:01:56 +01:00
|
|
|
while (my $line = <$fh>) {
|
|
|
|
$result .= $line;
|
|
|
|
}
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-07 05:01:56 +01:00
|
|
|
my $ret = $? >> 8;
|
|
|
|
return ($ret, $result);
|
|
|
|
};
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-07 05:01:56 +01:00
|
|
|
close $fh;
|
|
|
|
alarm 0;
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-07 05:01:56 +01:00
|
|
|
if (my $exception = $@) {
|
2022-02-08 05:33:24 +01:00
|
|
|
# handle time-out exception
|
2022-02-07 05:01:56 +01:00
|
|
|
if ($exception =~ /Timed-out: (.*)/) {
|
2022-01-23 16:49:23 +01:00
|
|
|
return (-13, "[Timed-out] $1");
|
|
|
|
}
|
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
# propagate unhandled exception
|
2022-02-07 05:01:56 +01:00
|
|
|
die $exception;
|
2022-01-23 16:49:23 +01:00
|
|
|
}
|
2022-02-07 05:01:56 +01:00
|
|
|
|
|
|
|
return ($ret, $result);
|
2022-01-23 16:49:23 +01:00
|
|
|
}
|
|
|
|
|
2022-02-07 05:01:56 +01:00
|
|
|
sub connect_to_heartbeat() {
|
2022-01-23 16:49:23 +01:00
|
|
|
my $heartbeat;
|
|
|
|
my $attempts = 15;
|
|
|
|
|
|
|
|
while (!$heartbeat && $attempts > 0) {
|
2022-02-07 05:01:56 +01:00
|
|
|
print "Connecting to heartbeat on port ".HEARTBEAT_PORT." ... ";
|
2022-01-23 16:49:23 +01:00
|
|
|
|
|
|
|
$heartbeat = IO::Socket::INET->new (
|
|
|
|
PeerAddr => '127.0.0.1',
|
2022-01-29 21:22:48 +01:00
|
|
|
PeerPort => HEARTBEAT_PORT,
|
2022-01-23 16:49:23 +01:00
|
|
|
Proto => 'tcp',
|
|
|
|
Type => SOCK_STREAM,
|
|
|
|
);
|
|
|
|
|
|
|
|
if (!$heartbeat) {
|
|
|
|
print "failed.\n";
|
|
|
|
--$attempts;
|
|
|
|
print "Trying again in 2 seconds ($attempts attempts remaining) ...\n" if $attempts > 0;
|
|
|
|
sleep 2;
|
|
|
|
} else {
|
|
|
|
print "success!\n";
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
return $heartbeat;
|
|
|
|
}
|
|
|
|
|
2022-02-07 05:01:56 +01:00
|
|
|
sub server_listen($port) {
|
2022-01-23 16:49:23 +01:00
|
|
|
my $server = IO::Socket::INET->new (
|
|
|
|
Proto => 'tcp',
|
|
|
|
LocalPort => $port,
|
|
|
|
Listen => SOMAXCONN,
|
|
|
|
ReuseAddr => 1,
|
|
|
|
Reuse => 1,
|
|
|
|
);
|
|
|
|
die "Can't setup server: $!" unless $server;
|
2022-02-08 05:33:24 +01:00
|
|
|
print "Server $0 accepting clients at :$port\n";
|
2022-01-23 16:49:23 +01:00
|
|
|
return $server;
|
|
|
|
}
|
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
sub handle_client($client, $heartbeat) {
|
|
|
|
my ($timed_out, $killed) = (0, 0);
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
eval {
|
|
|
|
# give client 5 seconds to send a line
|
|
|
|
local $SIG{ALRM} = sub { die "Client I/O timed-out\n"; };
|
|
|
|
alarm 5;
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
while (my $line = <$client>) {
|
|
|
|
$line =~ s/[\r\n]+$//;
|
|
|
|
next if $line =~ m/^\s*$/;
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
# give client 5 more seconds
|
|
|
|
alarm 5;
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
print "Read [$line]\n";
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
if (time - $heartbeat > 5) {
|
|
|
|
print "Lost heartbeat, ignoring compile attempt.\n";
|
|
|
|
print $client "Recovering from previous snippet, try again soon.\n";
|
|
|
|
last;
|
|
|
|
}
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
# disable client time-out
|
|
|
|
alarm 0;
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
my ($ret, $result) = execute("perl vm-exec $line");
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
$result =~ s/\s+$//;
|
|
|
|
print "Ret: $ret; result: [$result]\n";
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
if ($result =~ m/\[Killed\]$/) {
|
|
|
|
$killed = 1;
|
|
|
|
$ret = -14;
|
|
|
|
}
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
if ($ret == -13 && $result =~ m/\[Timed-out\]/) {
|
|
|
|
$timed_out = 1;
|
|
|
|
}
|
2022-02-07 05:01:56 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
print $client $result . "\n";
|
|
|
|
last;
|
2022-01-23 16:49:23 +01:00
|
|
|
}
|
2022-02-08 05:33:24 +01:00
|
|
|
};
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
# print client time-out exception
|
|
|
|
print "$@" if $@;
|
2022-02-07 05:01:56 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
alarm 0;
|
|
|
|
close $client;
|
2022-02-07 05:01:56 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
print "timed out: $timed_out; killed: $killed\n";
|
|
|
|
return $timed_out || $killed;
|
|
|
|
}
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
use constant SUCCESS => 0;
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
sub do_heartbeat() {
|
|
|
|
tie my $heartbeat, 'IPC::Shareable', { key => 'heartbeat' };
|
|
|
|
tie my $running, 'IPC::Shareable', { key => 'running' };
|
2022-02-07 05:01:56 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
my $heartbeat_monitor = connect_to_heartbeat() || die "No heartbeat.\n";
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
while ($running and <$heartbeat_monitor>) {
|
|
|
|
$heartbeat = time;
|
|
|
|
}
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
$heartbeat = 0;
|
|
|
|
exit;
|
|
|
|
}
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
sub do_server() {
|
|
|
|
tie my $heartbeat, 'IPC::Shareable', { key => 'heartbeat' };
|
|
|
|
tie my $running, 'IPC::Shareable', { key => 'running' };
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
print "Starting PBot VM Server on port " . SERVER_PORT . "\n";
|
|
|
|
my $server = eval { server_listen(SERVER_PORT) };
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
if ($@) {
|
|
|
|
print STDERR $@;
|
|
|
|
$running = 0;
|
|
|
|
return;
|
|
|
|
}
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
while ($running and my $client = $server->accept) {
|
|
|
|
$client->autoflush(1);
|
|
|
|
my $hostinfo = gethostbyaddr($client->peeraddr);
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
print '-' x 20, "\n";
|
|
|
|
printf "Connect from %s at %s\n", $client->peerhost, scalar localtime;
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
if (handle_client($client, $heartbeat) != SUCCESS) {
|
|
|
|
vm_revert();
|
|
|
|
}
|
|
|
|
}
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
print "Shutting down server.\n";
|
|
|
|
}
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
sub main() {
|
|
|
|
tie my $heartbeat, 'IPC::Shareable', { key => 'heartbeat', create => 1, destroy => 1 };
|
|
|
|
tie my $running, 'IPC::Shareable', { key => 'running', create => 1, destroy => 1 };
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
$running = 1;
|
|
|
|
$heartbeat = 0;
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
my $heartbeat_pid = fork // die "Heartbeat fork failed: $!";
|
2022-01-23 16:49:23 +01:00
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
if ($heartbeat_pid == 0) {
|
|
|
|
do_heartbeat();
|
|
|
|
} else {
|
|
|
|
do_server();
|
2022-01-23 16:49:23 +01:00
|
|
|
}
|
|
|
|
|
2022-02-08 05:33:24 +01:00
|
|
|
print "Waiting for heart to stop...\n";
|
2022-01-23 16:49:23 +01:00
|
|
|
waitpid($heartbeat_pid, 0);
|
2022-02-08 05:33:24 +01:00
|
|
|
print "Heart stopped.\n";
|
2022-01-23 16:49:23 +01:00
|
|
|
}
|
|
|
|
|
2022-02-07 05:01:56 +01:00
|
|
|
main();
|