diff --git a/applets/compiler_vm/host/bin/vm-client b/applets/compiler_vm/host/bin/vm-client index 5af14821..4c604b5b 100755 --- a/applets/compiler_vm/host/bin/vm-client +++ b/applets/compiler_vm/host/bin/vm-client @@ -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' ); diff --git a/applets/compiler_vm/host/bin/vm-exec b/applets/compiler_vm/host/bin/vm-exec index 15d36c2a..639d532f 100755 --- a/applets/compiler_vm/host/bin/vm-exec +++ b/applets/compiler_vm/host/bin/vm-exec @@ -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}; diff --git a/applets/compiler_vm/host/bin/vm-server b/applets/compiler_vm/host/bin/vm-server index eb741917..e04b1021 100755 --- a/applets/compiler_vm/host/bin/vm-server +++ b/applets/compiler_vm/host/bin/vm-server @@ -9,9 +9,14 @@ # SPDX-FileCopyrightText: 2021 Pragmatic Software # 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(); diff --git a/doc/VirtualMachine.md b/doc/VirtualMachine.md index d45dd608..7fdc49ab 100644 --- a/doc/VirtualMachine.md +++ b/doc/VirtualMachine.md @@ -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 `` 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.