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

pbot-vm: massive refactor

* replace heartbeat with health-check
  * instead of steady stream of newlines every 5s, now awaits input
    and responds with `vmstat` output

* more reliably use host/config/vm-exec.json to get libvirt domain name
  for snapshot-revert, server address, serial ports, vagrant setting, etc

* use iptables/nftables to disable networking
  * added guest/bin/disable-network-[iptables,nftables]
  * added guest/bin/enable-network-[iptables,nftables]

* replace ugly ___OUTPUT___ texts in sh, bash, ksh, zsh languages

* documentation updates and tweaks
This commit is contained in:
Pragmatic Software 2024-04-10 01:21:18 -07:00
parent 5d3f188a09
commit 17b69f04ff
No known key found for this signature in database
GPG Key ID: CC916B6E3C84ECCE
24 changed files with 343 additions and 208 deletions

View File

@ -0,0 +1,9 @@
#!/bin/sh
# disables all incoming, outgoing and forwarded traffic except incoming/established SSH
iptables -F
iptables -A INPUT -m state --state ESTABLISHED,RELATED -j ACCEPT
iptables -A INPUT -p tcp --dport 22 -j ACCEPT
iptables -P INPUT DROP
iptables -P FORWARD DROP
iptables -A OUTPUT -m state --state ESTABLISHED,RELATED -j ACCEPT
iptables -P OUTPUT DROP

View File

@ -0,0 +1,8 @@
#!/bin/sh
# disables all incoming, outgoing and forwarded traffic except incoming/established SSH
nft add table ip filter
nft add chain ip filter INPUT '{ type filter hook input priority 0; policy drop; }'
nft add chain ip filter OUTPUT '{ type filter hook output priority 0; policy drop; }'
nft 'add rule ip filter INPUT ct state related,established counter accept'
nft 'add rule ip filter INPUT tcp dport 22 counter accept'
nft 'add rule ip filter OUTPUT ct state related,established counter accept'

View File

@ -0,0 +1,3 @@
#!/bin/sh
# removes all iptables rules to re-enable networking
iptables -F

View File

@ -0,0 +1,3 @@
#!/bin/sh
# deletes filter table to re-enable networking
nft delete table ip filter

View File

@ -5,7 +5,7 @@
# Purpose: PBot VM Guest server. Runs inside PBot VM Guest and processes # Purpose: PBot VM Guest server. Runs inside PBot VM Guest and processes
# incoming VM commands from vm-exec. # incoming VM commands from vm-exec.
# SPDX-FileCopyrightText: 2022 Pragmatic Software <pragma78@gmail.com> # SPDX-FileCopyrightText: 2022-2024 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT # SPDX-License-Identifier: MIT
use 5.020; use 5.020;
@ -20,7 +20,7 @@ use constant {
USERNAME => 'vm', USERNAME => 'vm',
MOD_DIR => '/usr/local/share/pbot-vm/', MOD_DIR => '/usr/local/share/pbot-vm/',
SERIAL => '/dev/ttyS2', SERIAL => '/dev/ttyS2',
HEARTBEAT => '/dev/ttyS3', HEALTH => '/dev/ttyS3',
VPORT => $ENV{PBOTVM_VPORT} // 5555, VPORT => $ENV{PBOTVM_VPORT} // 5555,
}; };
@ -30,7 +30,6 @@ use lib MOD_DIR . "Languages";
use Guest; use Guest;
use File::Basename; use File::Basename;
use IPC::Shareable;
my %languages; my %languages;
@ -68,11 +67,9 @@ sub serial_server() {
open(my $input, '<', SERIAL) or die $!; open(my $input, '<', SERIAL) or die $!;
open(my $output, '>', SERIAL) or die $!; open(my $output, '>', SERIAL) or die $!;
tie my $running, 'IPC::Shareable', { key => 'running' };
my $buffer = ''; my $buffer = '';
while ($running) { while (1) {
my $command = Guest::read_input($input, \$buffer, 'Serial'); my $command = Guest::read_input($input, \$buffer, 'Serial');
if (not defined $command) { if (not defined $command) {
@ -119,19 +116,20 @@ sub do_server() {
} }
} }
sub do_heartbeat() { sub do_healthcheck() {
open(my $heartbeat, '>', HEARTBEAT) or die $!; open(my $health_in, '<', HEALTH) or die $!;
open(my $health_out, '>', HEALTH) or die $!;
tie my $running, 'IPC::Shareable', { key => 'running' }; print "Healthcheck listening on PID $$...\n";
print "Heart beating on PID $$...\n"; while (1) {
my $input = <$health_in>;
while ($running) { my $vmstat = `vmstat`;
print $heartbeat "\n"; print $health_out "$vmstat\n";
sleep 5; print $health_out ":END\n";
} }
print "Heart beat stopped.\n"; print "Healthcheck stopped.\n";
exit; # exit child process exit; # exit child process
} }
@ -160,14 +158,10 @@ sub main() {
install_signal_handlers(); install_signal_handlers();
tie my $running, 'IPC::Shareable', { key => 'running', create => 1, destroy => 1 };
$running = 1;
my $pid = fork // die "Fork failed: $!"; my $pid = fork // die "Fork failed: $!";
if ($pid == 0) { if ($pid == 0) {
do_heartbeat(); do_healthcheck();
} else { } else {
do_server(); do_server();
} }

View File

@ -1,11 +1,11 @@
#!/bin/sh #!/bin/bash
# File: setup-guest # File: setup-guest
# #
# Purpose: Sets up PBot VM Guest. Copies necessary files to the appropriate # Purpose: Sets up PBot VM Guest. Copies necessary files to the appropriate
# location, sets up environment variables and various configuration details. # location, sets up environment variables and various configuration details.
# SPDX-FileCopyrightText: 2022 Pragmatic Software <pragma78@gmail.com> # SPDX-FileCopyrightText: 2022-2024 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT # SPDX-License-Identifier: MIT
# determine OS/distribution # determine OS/distribution
@ -56,9 +56,6 @@ cp guest/include/prelude.h /usr/include
# require root password for polkit actions # require root password for polkit actions
cp guest/polkit/* /etc/polkit-1/rules.d/ cp guest/polkit/* /etc/polkit-1/rules.d/
# disable networking
nmcli networking off
# set environment variables # set environment variables
if ! grep -qF "pbot-vm" /root/.bashrc; then if ! grep -qF "pbot-vm" /root/.bashrc; then
echo '# pbot-vm' >> /root/.bashrc echo '# pbot-vm' >> /root/.bashrc
@ -66,8 +63,12 @@ if ! grep -qF "pbot-vm" /root/.bashrc; then
echo export ASAN_OPTIONS=detect_leaks=0 >> /root/.bashrc echo export ASAN_OPTIONS=detect_leaks=0 >> /root/.bashrc
fi fi
echo PBot Guest VM is now set up. export DEBUGINFOD_URLS
export ASAN_OPTIONS=detect_leaks=0
echo PBot Guest VM is set up.
echo echo
echo !! Networking is now disabled. To re-enable networking run: nmcli networking on echo To start PBot Guest Server: guest-server
echo
echo For changes to take effect, run this command now: source /root/.bashrc # make environment variables take effect
exec /bin/bash

View File

@ -5,7 +5,7 @@
# Purpose: Collection of functions to interface with the PBot VM Guest and # Purpose: Collection of functions to interface with the PBot VM Guest and
# execute VM commands. # execute VM commands.
# SPDX-FileCopyrightText: 2022 Pragmatic Software <pragma78@gmail.com> # SPDX-FileCopyrightText: 2022-2024 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT # SPDX-License-Identifier: MIT
package Guest; package Guest;
@ -22,7 +22,6 @@ use English;
use Encode; use Encode;
use File::Basename; use File::Basename;
use JSON::XS; use JSON::XS;
use IPC::Shareable;
use Data::Dumper; use Data::Dumper;
sub read_input($input, $buffer, $tag) { sub read_input($input, $buffer, $tag) {
@ -59,7 +58,13 @@ sub read_input($input, $buffer, $tag) {
print STDERR "-" x 40, "\n"; print STDERR "-" x 40, "\n";
print STDERR "$tag got [$line]\n"; print STDERR "$tag got [$line]\n";
my $command = decode_json($line); my $command = eval { decode_json($line) };
if ($@) {
print STDERR "Failed to decode JSON: $@\n";
return undef;
}
$command->{arguments} //= ''; $command->{arguments} //= '';
$command->{input} //= ''; $command->{input} //= '';

View File

@ -16,10 +16,17 @@ apt install -y socat
# for `cc` C language support # for `cc` C language support
apt install -y libubsan1 libasan8 gdb gcc gcc-multilib clang apt install -y libubsan1 libasan8 gdb gcc gcc-multilib clang
# for pbot-vm guest-server support
apt install -y --no-install-recommends libipc-shareable-perl libipc-run-perl libjson-xs-perl
# for `cc` additional languages # for `cc` additional languages
apt install -y ksh zsh tcl lua5.4 php8.2-cli nodejs guile3.0 beef bc g++ apt install -y ksh zsh tcl lua5.4 php8.2-cli nodejs guile3.0 beef bc g++
apt install -y clisp golang-go apt install -y clisp golang-go
apt install -y --no-install-recommends default-jre default-jdk apt install -y --no-install-recommends default-jre default-jdk
# for pbot-vm guest-server support
apt install -y --no-install-recommends libipc-run-perl libjson-xs-perl
# disable networking
./guest/bin/disable-network-iptables
echo 'Networking disabled.'
echo 'To re-enable, run ./guest/bin/enable-networking-iptables'
echo 'To disable again, run ./guest/bin/disable-network-iptables'

View File

@ -14,10 +14,16 @@ zypper -n in socat
# for `cc` C language support # for `cc` C language support
zypper -n in libubsan1 libasan8 gdb gcc gcc-32bit glibc-32bit clang zypper -n in libubsan1 libasan8 gdb gcc gcc-32bit glibc-32bit clang
# for pbot-vm guest-server support
zypper -n in perl-IPC-Run perl-JSON-XS make cpanm
cpanm -n IPC::Shareable
# for `cc` additional languages # for `cc` additional languages
zypper -n in ksh zsh tcl lua php8-cli nodejs-common guile bff bc gcc-c++ zypper -n in ksh zsh tcl lua php8-cli nodejs-common guile bff bc gcc-c++
zypper -n in --no-recommends clisp gcc-go java java-devel zypper -n in --no-recommends clisp gcc-go java java-devel
# for pbot-vm guest-server support
zypper -n in perl-IPC-Run perl-JSON-XS
# disable networking
./guest/bin/disable-network-nftables
echo 'Networking disabled.'
echo 'To re-enable, run ./guest/bin/enable-networking-nftables'
echo 'To disable again, run ./guest/bin/disable-network-nftables'

View File

@ -2,15 +2,18 @@
# File: vm-exec # File: vm-exec
# #
# Purpose: Process and send commands to the PBot Guest server (guest-server) on # Purpose: Process and send commands to the PBot Guest server (guest-server)
# the default VM socket CID/port (7/5555) or the default serial TCP port (5555). # using the details from the config/vm-exec.json configuration file.
#
# Additionally, takes `-revert` and `-health` options to revert VM or check
# VM's health.
# #
# Use the PBOTVM_CID, PBOTVM_VPORT and/or PBOTVM_SERIAL environment variables to # Use the PBOTVM_CID, PBOTVM_VPORT and/or PBOTVM_SERIAL environment variables to
# override these defaults. E.g.: # override the config/vm-exec.json values. E.g.:
# #
# $ PBOTVM_CID=42 PBOTVM_SERIAL=7777 vm-exec -lang=sh echo test # $ PBOTVM_CID=42 PBOTVM_SERIAL=7777 vm-exec -lang=sh echo test
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com> # SPDX-FileCopyrightText: 2021-2024 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT # SPDX-License-Identifier: MIT
use 5.020; use 5.020;
@ -22,9 +25,13 @@ use feature qw(signatures);
no warnings qw(experimental::signatures); no warnings qw(experimental::signatures);
use constant { use constant {
DOMAIN => $ENV{PBOTVM_DOMAIN} // 'pbot-vm',
ADDR => $ENV{PBOTVM_ADDR} // '127.0.0.1',
SERIAL => $ENV{PBOTVM_SERIAL} // 5555, SERIAL => $ENV{PBOTVM_SERIAL} // 5555,
HEALTH => $ENV{PBOTVM_HEALTH} // 5556,
CID => $ENV{PBOTVM_CID} // 7, CID => $ENV{PBOTVM_CID} // 7,
VPORT => $ENV{PBOTVM_VPORT} // 5555, VPORT => $ENV{PBOTVM_VPORT} // 5555,
VAGRANT => $ENV{PBOTVM_VAGRANT} // 0,
}; };
use File::Basename; use File::Basename;
@ -64,7 +71,7 @@ sub connect_serial($context) {
print STDERR "Connecting to remote VM serial port $context->{'vm-serial'}\n"; print STDERR "Connecting to remote VM serial port $context->{'vm-serial'}\n";
my $vm = IO::Socket::INET->new( my $vm = IO::Socket::INET->new(
PeerAddr => '127.0.0.1', PeerAddr => $context->{'vm-addr'},
PeerPort => $context->{'vm-serial'}, PeerPort => $context->{'vm-serial'},
Proto => 'tcp', Proto => 'tcp',
Type => SOCK_STREAM Type => SOCK_STREAM
@ -96,6 +103,12 @@ sub connect_vm($context) {
sub make_context_from_args(@args_in) { sub make_context_from_args(@args_in) {
my $args = join ' ', @args_in; my $args = join ' ', @args_in;
# extract leading options
my %opts;
while ($args =~ s/^-(revert|health)\s+//) {
$opts{$1} = 1;
}
my $context = eval { decode_json $args }; my $context = eval { decode_json $args };
if ($@) { if ($@) {
@ -108,8 +121,14 @@ sub make_context_from_args(@args_in) {
} }
} }
# set extracted leading options
foreach my $opt (keys %opts) {
print STDERR "Setting option `$opt`.\n";
$context->{$opt} = 1;
}
# parse options specific to vm-exec # parse options specific to vm-exec
while ($context->{code} =~ s/^-(lang|vm-cid|vm-vport|vm-serial|vm)=([^ ]+)\s*//) { while ($context->{code} =~ s/^-(lang|revert|health|vm-domain|vm-health|vm-cid|vm-vport|vm-serial|vm)=([^ ]+)\s*//) {
my ($option, $value) = ($1, $2); my ($option, $value) = ($1, $2);
print STDERR "Overriding `$option` to `$value`.\n"; print STDERR "Overriding `$option` to `$value`.\n";
$context->{$option} = lc $value; $context->{$option} = lc $value;
@ -190,13 +209,17 @@ sub configure_context($context, $config) {
if (not defined $entry) { if (not defined $entry) {
my $machines = list_machines($config); my $machines = list_machines($config);
print "Unknown machine '$machine'; available machines are: $machines\n"; print "Unknown machine '$machine'; available machines are: $machines\n";
exit 1; exit 3;
} }
# override values # override values
$context->{'vm-domain'} = $machine;
$context->{'vm-addr'} = $entry->{'addr'};
$context->{'vm-health'} = $entry->{'health'};
$context->{'vm-serial'} = $entry->{'serial'}; $context->{'vm-serial'} = $entry->{'serial'};
$context->{'vm-cid'} = $entry->{'cid'}; $context->{'vm-cid'} = $entry->{'cid'};
$context->{'vm-vport'} = $entry->{'vport'}; $context->{'vm-vport'} = $entry->{'vport'};
$context->{'vm-vagrant'} = $entry->{'vagrant'};
} else { } else {
# otherwise configure any undefined values as default machine # otherwise configure any undefined values as default machine
my $machine = $config->{'default-machine'}; my $machine = $config->{'default-machine'};
@ -207,22 +230,30 @@ sub configure_context($context, $config) {
if (not defined $entry) { if (not defined $entry) {
my $machines = list_machines($config); my $machines = list_machines($config);
print "Unknown machine '$machine'; available machines are: $machines\n"; print "Unknown machine '$machine'; available machines are: $machines\n";
exit 1; exit 3;
} }
# update any undefined values, preserving any existing values # update any undefined values, preserving any existing values
$context->{'vm-domain'} //= $machine;
$context->{'vm-addr'} //= $entry->{'addr'};
$context->{'vm-health'} //= $entry->{'health'};
$context->{'vm-serial'} //= $entry->{'serial'}; $context->{'vm-serial'} //= $entry->{'serial'};
$context->{'vm-cid'} //= $entry->{'cid'}; $context->{'vm-cid'} //= $entry->{'cid'};
$context->{'vm-vport'} //= $entry->{'vport'}; $context->{'vm-vport'} //= $entry->{'vport'};
$context->{'vm-vagrant'} //= $entry->{'vagrant'};
} }
# set any undefined values to default values # set any undefined values to default values
$context->{nick} //= 'vm'; $context->{nick} //= 'vm';
$context->{channel} //= 'vm'; $context->{channel} //= 'vm';
$context->{lang} //= 'c2x'; $context->{lang} //= 'c2x';
$context->{'vm-domain'} //= DOMAIN;
$context->{'vm-addr'} //= ADDR;
$context->{'vm-health'} //= HEALTH;
$context->{'vm-serial'} //= SERIAL; $context->{'vm-serial'} //= SERIAL;
$context->{'vm-cid'} //= CID; $context->{'vm-cid'} //= CID;
$context->{'vm-vport'} //= VPORT; $context->{'vm-vport'} //= VPORT;
$context->{'vm-vagrant'} //= VAGRANT;
} }
sub main() { sub main() {
@ -232,6 +263,59 @@ sub main() {
configure_context($context, $config); configure_context($context, $config);
# instructed to revert machine
if ($context->{revert}) {
if (exists $config->{aliases}->{$context->{'vm-domain'}}) {
$context->{'vm-domain'} = $config->{aliases}->{$context->{'vm-domain'}};
}
print STDERR "REVERT $context->{'vm-domain'}\n";
if ($context->{'vm-vagrant'}) {
system("virsh -c qemu:///system snapshot-revert $context->{'vm-domain'} 1");
} else {
system("virsh snapshot-revert $context->{'vm-domain'} 1");
}
exit 0;
}
# instructed to check health
if ($context->{health}) {
my $health = IO::Socket::INET->new(
PeerAddr => $context->{'vm-addr'},
PeerPort => $context->{'vm-health'},
Proto => 'tcp',
Type => SOCK_STREAM
);
if (not defined $health) {
print STDERR "Unable to connect to health $context->{'vm-addr'} $context->{'vm-health'}\n";
exit 2;
}
print $health "\n";
eval {
alarm 2;
local $SIG{ALRM} = sub { die "Health timed-out\n"; };
while (my $output = <$health>) {
last if $output eq ":END\r\n";
print $output;
}
close $health;
};
if ($@) {
print STDERR "Failed to get health: $@\n";
exit 1;
}
exit 0;
}
# load language before checking usage in order to handle -lang=? flag # load language before checking usage in order to handle -lang=? flag
# to list languages instead of showing a usage message # to list languages instead of showing a usage message
my $lang = load_language($context); my $lang = load_language($context);

View File

@ -6,7 +6,7 @@
# listens for incoming commands from vm-client. Invokes vm-exec to send # listens for incoming commands from vm-client. Invokes vm-exec to send
# commands to the PBot Guest Server (guest-server). # commands to the PBot Guest Server (guest-server).
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com> # SPDX-FileCopyrightText: 2021-2024 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT # SPDX-License-Identifier: MIT
use 5.020; use 5.020;
@ -25,19 +25,24 @@ use Encode;
use constant { use constant {
SERVER_PORT => $ENV{PBOTVM_PORT} // 9000, SERVER_PORT => $ENV{PBOTVM_PORT} // 9000,
HEARTBEAT_PORT => $ENV{PBOTVM_HEART} // 5556,
DOMAIN_NAME => $ENV{PBOTVM_DOMAIN} // 'pbot-vm',
COMPILE_TIMEOUT => $ENV{PBOTVM_TIMEOUT} // 10, COMPILE_TIMEOUT => $ENV{PBOTVM_TIMEOUT} // 10,
}; };
sub vm_revert() { sub vm_revert($input) {
return if $ENV{PBOTVM_NOREVERT}; return if $ENV{PBOTVM_NOREVERT};
print "Reverting vm...\n"; print "Reverting vm...\n";
system('time virsh snapshot-revert '.DOMAIN_NAME.' 1'); execute("perl vm-exec -revert $input", 1000);
print "Reverted.\n"; print "Reverted.\n";
} }
sub execute($command) { sub vm_check_health($input) {
print "Checking health...\n";
my ($ret, $result) = execute("perl vm-exec -health $input", 2);
print "$result\n" if length $result;
return ($ret, $result);
}
sub execute($command, $timeout = COMPILE_TIMEOUT) {
print "execute ($command)\n"; print "execute ($command)\n";
# to get $? from pipe # to get $? from pipe
@ -53,7 +58,7 @@ sub execute($command) {
my $result = eval { my $result = eval {
my $output = ''; my $output = '';
local $SIG{ALRM} = sub { kill 9, $pid; die "Timed-out: $output\n"; }; local $SIG{ALRM} = sub { kill 9, $pid; die "Timed-out: $output\n"; };
alarm(COMPILE_TIMEOUT); alarm($timeout);
while (my $line = decode('UTF-8', <$fh>)) { while (my $line = decode('UTF-8', <$fh>)) {
$output .= $line; $output .= $line;
@ -80,47 +85,6 @@ sub execute($command) {
return ($ret, $result); return ($ret, $result);
} }
sub connect_to_heartbeat() {
my $heartbeat;
my $attempts = 15;
while (!$heartbeat && $attempts > 0) {
print "Connecting to heartbeat on port ".HEARTBEAT_PORT." ... ";
$heartbeat = IO::Socket::INET->new (
PeerAddr => '127.0.0.1',
PeerPort => HEARTBEAT_PORT,
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;
}
sub do_heartbeat() {
tie my $heartbeat, 'IPC::Shareable', { key => 'heartbeat' };
tie my $running, 'IPC::Shareable', { key => 'running' };
while ($running) {
my $heartbeat_monitor = connect_to_heartbeat();
while ($running and <$heartbeat_monitor>) {
$heartbeat = time;
}
}
exit;
}
sub server_listen($port) { sub server_listen($port) {
my $server = IO::Socket::INET->new ( my $server = IO::Socket::INET->new (
Proto => 'tcp', Proto => 'tcp',
@ -135,29 +99,25 @@ sub server_listen($port) {
} }
sub do_server() { 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"; print "Starting PBot VM Server on port " . SERVER_PORT . "\n";
my $server = eval { server_listen(SERVER_PORT) }; my $server = eval { server_listen(SERVER_PORT) };
if ($@) { if ($@) {
print STDERR $@; print STDERR $@;
$running = 0;
return; return;
} }
while ($running and my $client = $server->accept) { while (my $client = $server->accept) {
print '-' x 20, "\n"; print '-' x 20, "\n";
my $hostinfo = gethostbyaddr($client->peeraddr); my $hostinfo = gethostbyaddr($client->peeraddr);
print "Connect from ", $client->peerhost, " at ", scalar localtime, "\n"; print "Connect from ", $client->peerhost, " at ", scalar localtime, "\n";
handle_client($client, $heartbeat); handle_client($client);
} }
print "Shutting down server.\n"; print "Shutting down server.\n";
} }
sub handle_client($client, $heartbeat) { sub handle_client($client) {
my ($timed_out, $killed) = (0, 0); my ($timed_out, $killed) = (0, 0);
my $r = fork; my $r = fork;
@ -177,30 +137,50 @@ sub handle_client($client, $heartbeat) {
$client->autoflush(1); $client->autoflush(1);
eval { my $input = eval {
# give client 5 seconds to send a line # give client 5 seconds to send a line
local $SIG{ALRM} = sub { die "Client I/O timed-out\n"; }; local $SIG{ALRM} = sub { die "Client I/O timed-out\n"; };
alarm 5; alarm 5;
while (my $line = decode('UTF-8', <$client>)) { my $input;
$line =~ s/[\r\n]+$//;
next if $line =~ m/^\s*$/; while ($input = decode('UTF-8', <$client>)) {
$input =~ s/[\r\n]+$//;
next if $input =~ m/^\s*$/;
# give client 5 more seconds # give client 5 more seconds
alarm 5; alarm 5;
print "[$$] Read [$line]\n"; print "[$$] Read [$input]\n";
if (time - $heartbeat > 5) { # check health
print "[$$] Lost heartbeat, ignoring compile attempt.\n"; my ($health, $health_message) = vm_check_health($input);
print $client "Virtual machine is resetting, try again soon.\n";
if ($health == 2) {
print "[$$] Unable to connect to VM health check, ignoring compile attempt.\n";
print $client "Virtual machine is offline.\n";
last;
}
if ($health == 1 || $health == -13) {
print "[$$] VM not responding to health check, ignoring compile attempt.\n";
print $client "Virtual machine is temporarily unavailable, try again soon.\n";
last;
}
if ($health != 0) {
if (length $health_message) {
print $client $health_message;
} else {
print $client "Virtual machine is misbehaving, try again soon.\n";
}
last; last;
} }
# disable client time-out # disable client time-out
alarm 0; alarm 0;
my ($ret, $result) = execute("perl vm-exec $line"); my ($ret, $result) = execute("perl vm-exec $input");
$result =~ s/\s+$//; $result =~ s/\s+$//;
print "Ret: $ret; result: [$result]\n"; print "Ret: $ret; result: [$result]\n";
@ -217,6 +197,8 @@ sub handle_client($client, $heartbeat) {
print $client encode('UTF-8', $result . "\n"); print $client encode('UTF-8', $result . "\n");
last; last;
} }
return $input;
}; };
# print client time-out exception # print client time-out exception
@ -228,11 +210,11 @@ sub handle_client($client, $heartbeat) {
print "[$$] timed out: $timed_out; killed: $killed\n"; print "[$$] timed out: $timed_out; killed: $killed\n";
if ($timed_out || $killed) { if ($timed_out || $killed) {
vm_revert(); vm_revert($input);
} }
# child done # child done
print "[$$] client exiting\n"; print "[$$] client exit\n";
print "=" x 20, "\n"; print "=" x 20, "\n";
exit; exit;
} }
@ -244,23 +226,8 @@ sub main() {
# let OS clean-up child exits # let OS clean-up child exits
$SIG{CHLD} = 'IGNORE'; $SIG{CHLD} = 'IGNORE';
tie my $heartbeat, 'IPC::Shareable', { key => 'heartbeat', create => 1, destroy => 1 }; # start server
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(); do_server();
}
print "Waiting for heart to stop...\n";
waitpid($heartbeat_pid, 0);
print "Heart stopped.\n";
} }
main(); main();

View File

@ -1,21 +1,25 @@
{ {
"machines" : { "machines" : {
"pbot-vm" : { "pbot-vm" : {
"addr" : "127.0.0.1",
"serial" : 5555, "serial" : 5555,
"heart" : 5556, "health" : 5556,
"cid" : 7, "cid" : 7,
"vport" : 5555 "vport" : 5555,
"vagrant" : 0
}, },
"pbot-test-vm" : { "pbot-test-vm" : {
"addr" : "127.0.0.1",
"serial" : 7777, "serial" : 7777,
"heart" : 7778, "health" : 7778,
"cid" : 42, "cid" : 42,
"vport" : 5555 "vport" : 5555,
"vagrant" : 1
} }
}, },
"aliases" : { "aliases" : {
"openSUSE" : "pbot-vm", "main" : "pbot-vm",
"test" : "pbot-test-vm" "test" : "pbot-test-vm"
}, },
"default-machine" : "openSUSE" "default-machine" : "main"
} }

View File

@ -2,7 +2,7 @@
DOMAIN="${PBOTVM_DOMAIN:-pbot-vm}" DOMAIN="${PBOTVM_DOMAIN:-pbot-vm}"
SERIAL="${PBOTVM_SERIAL:-5555}" SERIAL="${PBOTVM_SERIAL:-5555}"
HEART="${PBOTVM_HEART:-5556}" HEALTH="${PBOTVM_HEALTH:-5556}"
cat > serial-2.xml <<EOF cat > serial-2.xml <<EOF
<serial type='tcp'> <serial type='tcp'>
@ -14,7 +14,7 @@ EOF
cat > serial-3.xml <<EOF cat > serial-3.xml <<EOF
<serial type='tcp'> <serial type='tcp'>
<source mode='bind' host='127.0.0.1' service='$HEART' tls='no'/> <source mode='bind' host='127.0.0.1' service='$HEALTH' tls='no'/>
<protocol type='raw'/> <protocol type='raw'/>
<target port='3'/> <target port='3'/>
</serial> </serial>

View File

@ -1,6 +1,6 @@
#!/usr/bin/env perl #!/usr/bin/env perl
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com> # SPDX-FileCopyrightText: 2021-2024 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT # SPDX-License-Identifier: MIT
use warnings; use warnings;
@ -17,11 +17,11 @@ sub initialize {
$self->{default_options} = ''; $self->{default_options} = '';
$self->{cmdline} = 'bash $options $sourcefile'; $self->{cmdline} = 'bash $options $sourcefile';
$self->{cmdline_opening_comment} = ": <<'____CMDLINE____'\n"; $self->{cmdline_opening_comment} = ": <<'CMDLINE'\n";
$self->{cmdline_closing_comment} = "____CMDLINE____\n"; $self->{cmdline_closing_comment} = "CMDLINE\n";
$self->{output_opening_comment} = ": << '____OUTPUT____'\n"; $self->{output_opening_comment} = ": << 'OUTPUT'\n";
$self->{output_closing_comment} = "____OUTPUT____\n"; $self->{output_closing_comment} = "OUTPUT\n";
} }
1; 1;

View File

@ -1,6 +1,6 @@
#!/usr/bin/env perl #!/usr/bin/env perl
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com> # SPDX-FileCopyrightText: 2021-2024 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT # SPDX-License-Identifier: MIT
use warnings; use warnings;
@ -17,11 +17,11 @@ sub initialize {
$self->{default_options} = ''; $self->{default_options} = '';
$self->{cmdline} = 'ksh $options $sourcefile'; $self->{cmdline} = 'ksh $options $sourcefile';
$self->{cmdline_opening_comment} = ": <<'____CMDLINE____'\n"; $self->{cmdline_opening_comment} = ": <<'CMDLINE'\n";
$self->{cmdline_closing_comment} = "____CMDLINE____\n"; $self->{cmdline_closing_comment} = "CMDLINE\n";
$self->{output_opening_comment} = ": << '____OUTPUT____'\n"; $self->{output_opening_comment} = ": << 'OUTPUT'\n";
$self->{output_closing_comment} = "____OUTPUT____\n"; $self->{output_closing_comment} = "OUTPUT\n";
} }
1; 1;

View File

@ -1,6 +1,6 @@
#!/usr/bin/env perl #!/usr/bin/env perl
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com> # SPDX-FileCopyrightText: 2021-2024 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT # SPDX-License-Identifier: MIT
use warnings; use warnings;
@ -17,11 +17,11 @@ sub initialize {
$self->{default_options} = ''; $self->{default_options} = '';
$self->{cmdline} = 'sh $options $sourcefile'; $self->{cmdline} = 'sh $options $sourcefile';
$self->{cmdline_opening_comment} = ": <<'____CMDLINE____'\n"; $self->{cmdline_opening_comment} = ": <<'CMDLINE'\n";
$self->{cmdline_closing_comment} = "____CMDLINE____\n"; $self->{cmdline_closing_comment} = "CMDLINE\n";
$self->{output_opening_comment} = ": << '____OUTPUT____'\n"; $self->{output_opening_comment} = ": << 'OUTPUT'\n";
$self->{output_closing_comment} = "____OUTPUT____\n"; $self->{output_closing_comment} = "OUTPUT\n";
} }
1; 1;

View File

@ -1,6 +1,6 @@
#!/usr/bin/env perl #!/usr/bin/env perl
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com> # SPDX-FileCopyrightText: 2021-2024 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT # SPDX-License-Identifier: MIT
use warnings; use warnings;
@ -17,11 +17,11 @@ sub initialize {
$self->{default_options} = ''; $self->{default_options} = '';
$self->{cmdline} = 'zsh $options $sourcefile'; $self->{cmdline} = 'zsh $options $sourcefile';
$self->{cmdline_opening_comment} = ": <<'____CMDLINE____'\n"; $self->{cmdline_opening_comment} = ": <<'CMDLINE'\n";
$self->{cmdline_closing_comment} = "____CMDLINE____\n"; $self->{cmdline_closing_comment} = "CMDLINE\n";
$self->{output_opening_comment} = ": << '____OUTPUT____'\n"; $self->{output_opening_comment} = ": << 'OUTPUT'\n";
$self->{output_closing_comment} = "____OUTPUT____\n"; $self->{output_closing_comment} = "OUTPUT\n";
} }
1; 1;

View File

@ -4,8 +4,8 @@
ENV['VAGRANT_DEFAULT_PROVIDER'] = 'libvirt' ENV['VAGRANT_DEFAULT_PROVIDER'] = 'libvirt'
PBOTVM_SERIAL = ENV['PBOTVM_SERIAL'] || 5555 PBOTVM_SERIAL = ENV['PBOTVM_SERIAL'] || 5555
PBOTVM_HEART = ENV['PBOTVM_HEART'] || 5556 PBOTVM_HEALTH = ENV['PBOTVM_HEALTH'] || 5556
PBOTVM_NAME = ENV['PBOTVM_NAME'] || 'pbot-vagrant-vm' PBOTVM_DOMAIN = ENV['PBOTVM_DOMAIN'] || 'pbot-vm'
Vagrant.configure("2") do |config| Vagrant.configure("2") do |config|
# Every Vagrant development environment requires a box. You can search for # Every Vagrant development environment requires a box. You can search for

View File

@ -9,47 +9,73 @@ section, then return to this guide.
To install vagrant on openSUSE, use: To install vagrant on openSUSE, use:
zypper install --no-recommends vagrant vagrant-libvirt zypper install --no-recommends vagrant
Otherwise see https://vagrant-libvirt.github.io/vagrant-libvirt/installation.html for installation instructions for your platform. Otherwise see https://vagrant-libvirt.github.io/vagrant-libvirt/installation.html for installation instructions for your platform.
### Install vagrant-libvirt ### Install vagrant-libvirt
If your distribution does not have a `vagrant-libvirt` package or if you need an up-to-date version use Vagrant's plugin manager:
vagrant plugin install vagrant-libvirt vagrant plugin install vagrant-libvirt
### Start Vagrant Box ### Start Vagrant Box
To start a virtual machine, `cd` into one of the PBot-VM Vagrant sub-directories and run the following command. This will download To start a virtual machine, `cd` into one of the PBot-VM Vagrant sub-directories and run the following command. This will download
the appropriate virtual machine image and automatically configure it as a PBot VM Guest. the appropriate virtual machine image and automatically configure it as the default PBot VM Guest, `pbot-vm` described by
[`host/config/vm-exec.json`](../host/config/vm-exec.json):
vagrant up vagrant up
You may pass optional environment variables to override pbot-vm default configuration (see [PBot VM Environment Variables](../../../doc/VirtualMachine.md#environment-variables)): You may pass optional environment variables to override pbot-vm default configuration (see [PBot VM Environment Variables](../../../doc/VirtualMachine.md#environment-variables)).
For example, to create `pbot-test-vm` described by [`host/config/vm-exec.json`](../host/config/vm-exec.json):
PBOTVM_SERIAL=7777 PBOTVM_HEART=7778 vagrant up PBOTVM_DOMAIN=pbot-test-vm PBOTVM_SERIAL=7777 PBOTVM_HEALTH=7778 vagrant up
### Connect to Vagrant Box ### Connect to Vagrant Box
Use SSH to connect to the PBot VM Guest:
vagrant ssh vagrant ssh
If you specified a `PBOTVM_DOMAIN`, e.g. `pbot-test-vm`, you must specify it:
PBOTVM_DOMAIN=pbot-test-vm vagrant ssh
### Start PBot VM Guest Server ### Start PBot VM Guest Server
sudo guest-server Once connected to the PBot VM Guest via SSH, start `guest-server` in the background:
sudo nohup guest-server &> log &
Some distributions may require you to specify the full path: Some distributions may require you to specify the full path:
sudo /usr/local/bin/guest-server sudo nohup /usr/local/bin/guest-server &> log &
### Disconnect from Vagrant Box
Now you can type `logout` to exit the PBot VM Guest.
### Create snapshot of PBot VM Guest
After you've logged out of the PBot VM Guest with `guest-server` running in the background, create a snapshot. This allows PBot to revert to a known good state when a command times out.
If a `PBOTVM_DOMAIN` was defined, replace `pbot-vm` with that name.
virsh -c qemu:///system snapshot-create-as pbot-vm 1
### Edit vm-exec.json
If you used `vagrant up` without specifying a `PBOTVM_DOMAIN`, you must edit the [`../host/config/vm-exec.json`](../host/config/vm-exec.json)
configuration file to set the `vagrant` value to `1` for the `pbot-vm` machine.
If you have specified a `PBOTVM_DOMAIN`, ensure the appropriate entries exist in the `vm-exec.json` configuration file.
By default, `pbot-test-vm` already has `vagrant` set to `1`.
### Start PBot VM Host Server ### Start PBot VM Host Server
After starting the guest-server, you must now start the host server. cd ../host/bin/
./vm-server
../host/bin/vm-server
### Test PBot VM ### Test PBot VM
In your instance of PBot, the `sh` and `cc`, etc, commands should now produce output: In your instance of PBot, the `sh` and `cc`, etc, commands should now produce output:
<pragma-> sh echo Hello world! <pragma-> sh echo Hello world!

View File

@ -4,15 +4,18 @@
Vagrant.configure("2") do |config| Vagrant.configure("2") do |config|
config.vm.box_check_update = false config.vm.box_check_update = false
config.vm.hostname = PBOTVM_NAME config.vm.define PBOTVM_DOMAIN
config.vm.hostname = PBOTVM_DOMAIN
config.vm.provider :libvirt do |libvirt| config.vm.provider :libvirt do |libvirt|
libvirt.title = PBOTVM_DOMAIN
libvirt.default_prefix = ""
libvirt.qemuargs :value => "-chardev" libvirt.qemuargs :value => "-chardev"
libvirt.qemuargs :value => "socket,id=charserial1,host=127.0.0.1,port=#{PBOTVM_SERIAL},server=on,wait=off" libvirt.qemuargs :value => "socket,id=charserial1,host=127.0.0.1,port=#{PBOTVM_SERIAL},server=on,wait=off"
libvirt.qemuargs :value => "-device" libvirt.qemuargs :value => "-device"
libvirt.qemuargs :value => '{"driver":"isa-serial","chardev":"charserial1","id":"serial1","index":2}' libvirt.qemuargs :value => '{"driver":"isa-serial","chardev":"charserial1","id":"serial1","index":2}'
libvirt.qemuargs :value => "-chardev" libvirt.qemuargs :value => "-chardev"
libvirt.qemuargs :value => "socket,id=charserial2,host=127.0.0.1,port=#{PBOTVM_HEART},server=on,wait=off" libvirt.qemuargs :value => "socket,id=charserial2,host=127.0.0.1,port=#{PBOTVM_HEALTH},server=on,wait=off"
libvirt.qemuargs :value => "-device" libvirt.qemuargs :value => "-device"
libvirt.qemuargs :value => '{"driver":"isa-serial","chardev":"charserial2","id":"serial2","index":3}' libvirt.qemuargs :value => '{"driver":"isa-serial","chardev":"charserial2","id":"serial2","index":3}'
end end

View File

@ -4,8 +4,8 @@
ENV['VAGRANT_DEFAULT_PROVIDER'] = 'libvirt' ENV['VAGRANT_DEFAULT_PROVIDER'] = 'libvirt'
PBOTVM_SERIAL = ENV['PBOTVM_SERIAL'] || 5555 PBOTVM_SERIAL = ENV['PBOTVM_SERIAL'] || 5555
PBOTVM_HEART = ENV['PBOTVM_HEART'] || 5556 PBOTVM_HEALTH = ENV['PBOTVM_HEALTH'] || 5556
PBOTVM_NAME = ENV['PBOTVM_NAME'] || 'pbot-vagrant-vm' PBOTVM_DOMAIN = ENV['PBOTVM_DOMAIN'] || 'pbot-vm'
Vagrant.configure("2") do |config| Vagrant.configure("2") do |config|
# Every Vagrant development environment requires a box. You can search for # Every Vagrant development environment requires a box. You can search for

View File

@ -353,7 +353,8 @@
* [Initial virtual machine set-up complete](VirtualMachine.md#initial-virtual-machine-set-up-complete) * [Initial virtual machine set-up complete](VirtualMachine.md#initial-virtual-machine-set-up-complete)
* [Start PBot VM Host](VirtualMachine.md#start-pbot-vm-host) * [Start PBot VM Host](VirtualMachine.md#start-pbot-vm-host)
* [Test PBot](VirtualMachine.md#test-pbot) * [Test PBot](VirtualMachine.md#test-pbot)
* [QEMU command from libvirt](VirtualMachine.md#qemu-command-from-libvirt) * [Adding additional VMs](VirtualMachine.md#adding-additional-vms)
* [QEMU command from libvirt](VirtualMachine.md#qemu-command-from-libvirt)
<!-- md-toc-end --> <!-- md-toc-end -->
<!-- md-toc-begin --> <!-- md-toc-begin -->
* [Frequently Asked Questions](FAQ.md#frequently-asked-questions) * [Frequently Asked Questions](FAQ.md#frequently-asked-questions)

File diff suppressed because one or more lines are too long

View File

@ -25,8 +25,8 @@ use PBot::Imports;
# These are set by the /misc/update_version script # These are set by the /misc/update_version script
use constant { use constant {
BUILD_NAME => "PBot", BUILD_NAME => "PBot",
BUILD_REVISION => 4740, BUILD_REVISION => 4741,
BUILD_DATE => "2024-04-07", BUILD_DATE => "2024-04-10",
}; };
sub initialize {} sub initialize {}