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:
parent
6b93005808
commit
7916930816
@ -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'
|
||||||
);
|
);
|
||||||
|
|
||||||
|
@ -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};
|
||||||
|
|
||||||
|
@ -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();
|
||||||
|
@ -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.
|
||||||
|
Loading…
Reference in New Issue
Block a user