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: various host improvements

Browse Source 
* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
applets/compiler_vm/host/bin/vm-client
View File

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

4
applets/compiler_vm/host/bin/vm-exec
View File

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

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

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

31
doc/VirtualMachine.md
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 5 seconds, representing a heartbeat, used to ensure that the PBot communication
channel is healthy. 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. 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` Switch back to the virtual machine window. Once the virtual machine has rebooted, log in as `root`
and shut the virtual machine down with: 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. 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 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 #### Save initial state
Switch back to an available terminal on the physical host machine. Enter the following command 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 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 If the virtual machine ever times-out or its heartbeat stops responding, PBot
ever times-out or its heartbeat stops responding, PBot will reset the virtual machine to this will revert the virtual machine to this saved snapshot.
saved snapshot.
### Initial virtual machine set-up complete ### Initial virtual machine set-up complete
This concludes the initial one-time set-up. You can close the `virt-viewer` window. The 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 host$ vm-server
This will start a TCP server on port `9000`. It will listen for incoming commands and 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 ### Test PBot
All done. Everything is set up now. All done. Everything is set up now.