3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-06 03:59:31 +01:00

compiler_vm: various host improvements

* VM scripts can now be configured via environment variables:

  PBOTVM_DOMAIN, PBOTVM_TIMEOUT, PBOTVM_SERVER, PBOTVM_SERIAL,
  PBOTVM_HEART, PBOTVM_NOREVERT
This commit is contained in:
Pragmatic Software 2022-02-06 20:01:56 -08:00
parent 6b93005808
commit 7916930816
4 changed files with 113 additions and 120 deletions

View File

@ -18,11 +18,15 @@ use warnings;
use strict;
use IO::Socket;
use JSON;
use JSON::XS;
use constant {
SERVER_PORT => $ENV{PBOTVM_SERVER} // 9000,
};
my $sock = IO::Socket::INET->new(
PeerAddr => '127.0.0.1',
PeerPort => 9000,
PeerPort => SERVER_PORT,
Proto => 'tcp'
);

View File

@ -21,7 +21,7 @@ use FindBin qw($RealBin);
use lib "$RealBin/../lib";
use constant {
SERIAL_PORT => 5555,
SERIAL_PORT => $ENV{PBOTVM_SERIAL} // 4445,
};
my $json = join ' ', @ARGV;
@ -45,7 +45,7 @@ if (not exists $args->{code}) {
$args->{nick} //= 'vm';
$args->{channel} //= 'vm';
$args->{lang} //= 'c11';
$args->{'vm-port'} //= $ENV{PBOT_VM_PORT} // SERIAL_PORT;
$args->{'vm-port'} //= SERIAL_PORT;
my $language = lc $args->{lang};

View File

@ -9,9 +9,14 @@
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
use 5.020;
use warnings;
use strict;
use feature qw(signatures);
no warnings qw(experimental::signatures);
use IO::Socket;
use Net::hostent;
use IPC::Shareable;
@ -19,88 +24,68 @@ use Time::HiRes qw/gettimeofday/;
use Encode;
use constant {
SERVER_PORT => 9000,
SERIAL_PORT => 5555,
HEARTBEAT_PORT => 5556,
DOMAIN_NAME => 'pbot-vm',
COMPILE_TIMEOUT => 10,
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,
};
sub vm_stop {
system('virsh shutdown ' . DOMAIN_NAME);
sub vm_revert() {
return if $ENV{PBOTVM_NOREVERT};
print "Reverting vm...\n";
system('time virsh snapshot-revert '.DOMAIN_NAME.' 1');
print "Reverted.\n";
}
sub vm_start {
system('virsh start ' . DOMAIN_NAME);
}
sub vm_reset {
return if $ENV{NORESET};
system('virsh snapshot-revert '.DOMAIN_NAME.' 1');
print "Reset vm\n";
}
sub execute {
my ($cmdline) = @_;
print "execute($cmdline)\n";
sub execute($cmdline) {
print "execute ($cmdline)\n";
my @list = split / /, $cmdline;
my ($ret, $result);
my $pid = open(my $fh, '-|', @list);
my $child = fork;
if (not defined $pid) {
print "Couldn't fork: $!\n";
return (-13, "[Fatal error]");
}
if($child == 0) {
($ret, $result) = eval {
my $result = '';
my ($ret, $result) = (0, '');
my $pid = open(my $fh, '-|', @list);
($ret, $result) = eval {
local $SIG{ALRM} = sub { kill 9, $pid; die "Timed-out: $result\n"; };
alarm(COMPILE_TIMEOUT);
if (not defined $pid) {
print "Couldn't fork: $!\n";
return (-13, "[Fatal error]");
}
while (my $line = <$fh>) {
$result .= $line;
}
local $SIG{ALRM} = sub { kill 9, $pid; die "Timed-out: $result\n"; };
alarm(COMPILE_TIMEOUT);
my $ret = $? >> 8;
print "result ($ret, $result)\n";
return ($ret, $result);
};
print "Reading result...\n";
while (my $line = <$fh>) {
print "read result [$line]\n";
$result .= $line;
}
close $fh;
alarm 0;
close $fh;
print "Done reading result.\n";
if (my $exception = $@) {
print "Got exception [$exception]\n";
my $ret = $? >> 8;
print "[$ret, $result]\n";
return ($ret, $result);
};
alarm 0;
if ($@ =~ /Timed-out: (.*)/) {
if ($exception =~ /Timed-out: (.*)/) {
return (-13, "[Timed-out] $1");
}
return ($ret, $result);
} else {
waitpid($child, 0);
print "?: $?\n";
my $result = $? >> 8;
print "child exited, parent continuing [result = $result]\n";
return (undef, $result);
die $exception;
}
return ($ret, $result);
}
sub connect_to_heartbeat {
sub connect_to_heartbeat() {
my $heartbeat;
my $attempts = 15;
while (!$heartbeat && $attempts > 0) {
print "Connecting to heartbeat ... ";
print "Connecting to heartbeat on port ".HEARTBEAT_PORT." ... ";
$heartbeat = IO::Socket::INET->new (
PeerAddr => '127.0.0.1',
@ -122,8 +107,7 @@ sub connect_to_heartbeat {
return $heartbeat;
}
sub server_listen {
my $port = shift @_;
sub server_listen($port) {
my $server = IO::Socket::INET->new (
Proto => 'tcp',
LocalPort => $port,
@ -136,25 +120,17 @@ sub server_listen {
return $server;
}
sub vm_server {
my ($server, $heartbeat_pid, $heartbeat_monitor);
sub main() {
my $heartbeat;
my $running;
tie $heartbeat, 'IPC::Shareable', 'dat1', { create => 1 };
tie $running, 'IPC::Shareable', 'dat2', { create => 1 };
my $last_wait = 0;
$running = 1;
$heartbeat = 0;
vm_reset;
print "vm started\n";
$heartbeat_pid = fork;
die "Fork failed: $!" if not defined $heartbeat_pid;
my $heartbeat_pid = fork // die "Heartbeat fork failed: $!";
if ($heartbeat_pid == 0) {
# heartbeat
@ -162,33 +138,29 @@ sub vm_server {
tie $heartbeat, 'IPC::Shareable', 'dat1', { create => 1 };
tie $running, 'IPC::Shareable', 'dat2', { create => 1 };
if (!($heartbeat_monitor = connect_to_heartbeat)) {
die "Could not start heartbeat.\n";
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 "child: running: $running\n";
while($running and <$heartbeat_monitor>) {
$heartbeat = 1;
#print "child: got heartbeat\n";
}
$heartbeat = -1;
print "child no longer running\n";
print "Stopping heartbeat...\n";
$heartbeat = 0;
exit;
} else {
# server
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";
print "Starting compiler server on port " . SERVER_PORT . "\n";
my $server = eval { server_listen(SERVER_PORT) };
if ($@) {
print STDERR $@;
$running = 0;
}
print "parent: running: $running\n";
print "server: running: $running\n";
while ($running and my $client = $server->accept) {
$client->autoflush(1);
@ -197,26 +169,31 @@ sub vm_server {
print '-' x 20, "\n";
printf "[Connect from %s at %s]\n", $client->peerhost, scalar localtime;
my ($timed_out, $killed);
my ($timed_out, $killed) = (0, 0);
eval {
local $SIG{ALRM} = sub { die 'Timed-out'; };
# give client 5 seconds to send a line
local $SIG{ALRM} = sub { die 'client I/O timed-out'; };
alarm 5;
while (my $line = <$client>) {
$line =~ s/[\r\n]+$//;
next if $line =~ m/^\s*$/;
# give client 5 more seconds
alarm 5;
print "got: [$line]\n";
if($heartbeat <= 0) {
print "No heartbeat yet, ignoring compile attempt.\n";
print $client "Recovering from previous snippet, please wait.\n" if gettimeofday - $last_wait > 60;
$last_wait = gettimeofday;
if (time - $heartbeat > 5) {
print "Lost heartbeat, ignoring compile attempt.\n";
print $client "Recovering from previous snippet, try again soon.\n";
last;
}
print "Attempting compile...\n";
# disable client time-out
alarm 0;
my ($ret, $result) = execute("perl vm-exec $line");
@ -238,39 +215,32 @@ sub vm_server {
}
print $client $result . "\n";
close $client;
$ret = -14 if $killed;
# child exit
print "child exit\n";
exit $ret;
last;
}
alarm 0;
};
alarm 0;
close $client;
if (my $exception = $@) {
print "Got exception: $@\n";
}
print "timed out: $timed_out; killed: $killed\n";
next unless ($timed_out or $killed);
next unless $timed_out || $killed;
vm_reset;
next;
print "stopping vm\n";
#vm_stop;
$running = 0;
last;
vm_revert();
}
print "Compiler server no longer running, restarting...\n";
print "Shutting down server.\n";
}
print "waiting on heartbeat pid\n";
waitpid($heartbeat_pid, 0);
}
vm_server;
main();

View File

@ -127,6 +127,10 @@ virtual machine and to read back output. `ttyS2/5556` is simply a newline sent e
5 seconds, representing a heartbeat, used to ensure that the PBot communication
channel is healthy.
If you want to change the serial ports or the TCP ports, execute the command
`virsh edit pbot-vm` on the host. This will open the `pbot-vm` XML configuration
in your default system editor. Find the `<serial>` tags and edit their attributes.
Now we need to restart the virtual machine itself so it loads the new serial device configuration.
Switch back to the virtual machine window. Once the virtual machine has rebooted, log in as `root`
and shut the virtual machine down with:
@ -211,9 +215,9 @@ by changing the `-lang=` option. I recommend testing and verifying that all of y
modules are configured before going on to the next step.
If you have multiple PBot VM Guests, or if you used a different TCP port, you can specify the
`PBOT_VM_PORT` environment variable when executing the `vm-exec` command:
`PBOTVM_SERIAL` environment variable when executing the `vm-exec` command:
host$ PBOT_VM_PORT=6666 vm-exec -lang=sh echo test
host$ PBOTVM_SERIAL=7777 vm-exec -lang=sh echo test
#### Save initial state
Switch back to an available terminal on the physical host machine. Enter the following command
@ -225,9 +229,8 @@ to save a snapshot of the virtual machine waiting for incoming commands.
host$ virsh snapshot-create-as pbot-vm 1
This will create a snapshot file `vm.1` next to the `vm.qcow2` disk file. If the virtual machine
ever times-out or its heartbeat stops responding, PBot will reset the virtual machine to this
saved snapshot.
If the virtual machine ever times-out or its heartbeat stops responding, PBot
will revert the virtual machine to this saved snapshot.
### Initial virtual machine set-up complete
This concludes the initial one-time set-up. You can close the `virt-viewer` window. The
@ -241,7 +244,23 @@ To start the PBot VM Host server, execute the `vm-server` script in the
host$ vm-server
This will start a TCP server on port `9000`. It will listen for incoming commands and
pass them along to the virtual machine's TCP serial port.
pass them along to the virtual machine's TCP serial port `5555`. It will also monitor
the heartbeat port `5556` to ensure the PBot VM Guest is alive.
You may override any of the defaults by setting environment variables.
Environment variable | Default value | Description
--- | ---
PBOTVM_DOMAIN | `pbot-vm` | The libvirt domain identifier
PBOTVM_SERVER | `9000` | `vm-server` port for incoming `vm-client` commands
PBOTVM_SERIAL | `5555` | TCP port for serial communication
PBOTVM_HEART | `5556` | TCP port for heartbeats
PBOTVM_TIMEOUT | `10` | Duration before command times out (in seconds)
PBOTVM_NOREVERT | not set | If set then the VM will not revert to previous snapshot
For example, to use `other-vm` with a longer `30` second timeout, on different serial and heartbeat ports:
host$ PBOTVM_DOMAIN="other-vm" PBOTVM_SERVER=9001 PBOTVM_SERIAL=7777 PBOTVM_HEART=7778 PBOTVM_TIMEOUT=30 ./vm-server
### Test PBot
All done. Everything is set up now.