diff --git a/applets/compiler_vm/guest/bin/guest-server b/applets/compiler_vm/guest/bin/guest-server new file mode 100755 index 00000000..0904c98e --- /dev/null +++ b/applets/compiler_vm/guest/bin/guest-server @@ -0,0 +1,223 @@ +#!/usr/bin/env perl + +# File: guest-server +# +# Purpose: PBot VM Guest server. Runs inside PBot VM Guest and processes +# incoming VM commands from vm-exec. + +# SPDX-FileCopyrightText: 2022 Pragmatic Software +# SPDX-License-Identifier: MIT + +use 5.020; + +use warnings; +use strict; + +use feature qw/signatures/; +no warnings qw(experimental::signatures); + +use English; +use Encode; +use File::Basename; +use JSON::XS; +use Data::Dumper; + +my $USERNAME = 'vm'; # variable for easier string interpolation + +use constant { + MOD_DIR => '/usr/local/share/pbot-vm/Languages', + SERIAL => '/dev/ttyS1', + HEARTBEAT => '/dev/ttyS2', + INPUT => '/dev/stdin', + OUTPUT => '/dev/stdout', +}; + +use lib MOD_DIR; + +my %languages; + +sub load_modules() { + my @files = glob MOD_DIR . "/*.pm"; + foreach my $mod (@files){ + print "Loading module $mod\n"; + my $filename = basename($mod); + require $filename; + $filename =~ s/\.pm$//; + $languages{$filename} = 1; + } +} + +sub do_server($input, $output) { + my $buffer = ''; + my $line; + my $total_read = 0; + + while (1) { + print "Waiting for input...\n"; + my $ret = sysread($input, my $buf, 16384); + + if (not defined $ret) { + print "Error reading: $!\n"; + next; + } + + if ($ret == 0) { + print "Input closed; exiting...\n"; + exit; + } + + $total_read += $ret; + + chomp $buf; + print "read $ret bytes [$total_read so far] [$buf]\n"; + + $buffer .= $buf; + + next if $buffer !~ s/\s*:end:\s*$//m; + + $line = $buffer; + chomp $line; + + $buffer = ''; + $total_read = 0; + + $line = encode('UTF-8', $line); + + print "-" x 40, "\n"; + print "Got [$line]\n"; + + my $command = decode_json($line); + $command->{arguments} //= ''; + $command->{input} //= ''; + + print Dumper $command; + handle_command($command, $output); + } +} + +sub handle_command($command, $output) { + local $SIG{CHLD} = 'IGNORE'; + + my $pid = fork; + + if (not defined $pid) { + print "fork failed: $!\n"; + next; + } + + if ($pid == 0) { + my ($uid, $gid, $home) = (getpwnam $USERNAME)[2, 3, 7]; + + if (not $uid and not $gid) { + print "Could not find user $USERNAME: $!\n"; + exit; + } + + if ($command->{'persist-key'}) { + system ("rm -rf \"/home/$USERNAME/$command->{'persist-key'}\""); + system("mount /dev/vdb1 /root/factdata"); + system("mkdir -p \"/root/factdata/$command->{'persist-key'}\""); + system("cp -R -p \"/root/factdata/$command->{'persist-key'}\" \"/home/$USERNAME/$command->{'persist-key'}\""); + } + + system("chmod -R 755 /home/$USERNAME"); + system("chown -R $USERNAME /home/$USERNAME"); + system("chgrp -R $USERNAME /home/$USERNAME"); + system("rm -rf /home/$USERNAME/prog*"); + system("pkill -u $USERNAME"); + + system("date -s \@$command->{date}"); + + $ENV{USER} = $USERNAME; + $ENV{LOGNAME} = $USERNAME; + $ENV{HOME} = $home; + + $GID = $gid; + $EGID = "$gid $gid"; + $EUID = $UID = $uid; + + chdir("/home/$USERNAME"); + + my $result = run_command(%$command); + + $GID = 0; + $UID = 0; + + my $compile_out = { result => $result }; + + my $json = encode_json($compile_out); + + print "Done compiling: $json\n"; + + print $output "result:$json\n"; + print $output "result:end\n"; + + if ($command->{'persist-key'}) { + system("cp -R -p \"/home/$USERNAME/$command->{'persist-key'}\" \"/root/factdata/$command->{'persist-key'}\""); + system("umount /root/factdata"); + system ("rm -rf \"/home/$USERNAME/$command->{'persist-key'}\""); + } + + print "=" x 40, "\n"; + + # kill any left-over processes started by $USERNAME + system("pkill -u $USERNAME"); + print "after pkill???\n"; + exit; + } +} + +sub run_command(%command) { + $command{lang} = '_default' if not exists $languages{$command{lang}}; + + my $mod = $command{lang}->new(%command); + + local $SIG{CHLD} = 'DEFAULT'; + + $mod->preprocess; + $mod->postprocess if not $mod->{error} and not $mod->{done}; + + if (exists $mod->{no_output} or not length $mod->{output}) { + if ($command{factoid}) { + $mod->{output} = ''; + } else { + $mod->{output} .= "\n" if length $mod->{output}; + + if (not $mod->{error}) { + $mod->{output} .= "Success (no output).\n"; + } else { + $mod->{output} .= "Exit code $mod->{error}.\n"; + } + } + } + + return $mod->{output}; +} + +sub do_heartbeat($heartbeat) { + while (1) { + print $heartbeat "\n"; + sleep 5; + } +} + +sub main() { + load_modules(); + + # set serial to 115200 baud instead of 9600 + system('stty -F ' . SERIAL . ' 115200'); + + open(my $input, '<', SERIAL) or die $!; + open(my $output, '>', SERIAL) or die $!; + open(my $heartbeat, '>', HEARTBEAT) or die $!; + + my $pid = fork // die "Fork failed: $!"; + + if ($pid == 0) { + do_server($input, $output); + } else { + do_heartbeat($heartbeat); + } +} + +main(); diff --git a/applets/compiler_vm/guest/bin/start-guest b/applets/compiler_vm/guest/bin/start-guest deleted file mode 100755 index 9572efe8..00000000 --- a/applets/compiler_vm/guest/bin/start-guest +++ /dev/null @@ -1,232 +0,0 @@ -#!/usr/bin/env perl - -# File: start-guest -# -# Purpose: PBot VM Guest server. Runs inside PBot VM Guest and processes -# incoming VM commands. - -# SPDX-FileCopyrightText: 2022 Pragmatic Software -# SPDX-License-Identifier: MIT - -use warnings; -use strict; - -use English; -use Encode; -use File::Basename; -use JSON::XS; -use Data::Dumper; - -my $USERNAME = 'vm'; # variable for easier string interpolation - -use constant { - MOD_DIR => '/usr/local/share/pbot-vm/Languages', - SERIAL => '/dev/ttyS1', - HEARTBEAT => '/dev/ttyS2', - INPUT => '/dev/stdin', - OUTPUT => '/dev/stdout', -}; - -my $USE_LOCAL = $ENV{'CC_LOCAL'} // 0; - -use lib MOD_DIR; - -my %languages; - -sub load_modules { - my @files = glob MOD_DIR . "/*.pm"; - foreach my $mod (@files){ - print "Loading module $mod\n"; - my $filename = basename($mod); - require $filename; - $filename =~ s/\.pm$//; - $languages{$filename} = 1; - } -} - -sub run_server { - my ($input, $output, $heartbeat); - - if (not $USE_LOCAL) { - # set serial to 115200 baud instead of 9600 - system('stty -F ' . SERIAL . ' 115200'); - - open($input, '<', SERIAL) or die $!; - open($output, '>', SERIAL) or die $!; - open($heartbeat, '>', HEARTBEAT) or die $!; - } else { - open($input, '<', INPUT) or die $!; - open($output, '>', OUTPUT) or die $!; - } - - my $date; - my $lang; - my $sourcefile; - my $execfile; - my $code; - my $cmdline; - my $user_input; - - my $pid = fork; - die "Fork failed: $!" if not defined $pid; - - if ($pid == 0) { - my $buffer = ''; - my $line; - my $total_read = 0; - - while (1) { - print "Waiting for input...\n"; - my $ret = sysread($input, my $buf, 16384); - - if (not defined $ret) { - print "Error reading: $!\n"; - next; - } - - $total_read += $ret; - - if ($ret == 0) { - print "Input closed; exiting...\n"; - print "got buffer [$buffer]\n"; - exit; - } - - chomp $buf; - print "read $ret bytes [$total_read so far] [$buf]\n"; - $buffer.= $buf; - - next if $buffer !~ s/\s*:end:\s*$//m; - - $line = $buffer; - chomp $line; - - $buffer = ''; - $total_read = 0; - - $line = encode('UTF-8', $line); - - print "-" x 40, "\n"; - print "Got [$line]\n"; - - my $compile_in = decode_json($line); - - print Dumper $compile_in; - - $compile_in->{arguments} //= ''; - $compile_in->{input} //= ''; - - my $pid = fork; - - if (not defined $pid) { - print "fork failed: $!\n"; - next; - } - - if ($pid == 0) { - my ($uid, $gid, $home) = (getpwnam $USERNAME)[2, 3, 7]; - - if (not $uid and not $gid) { - print "Could not find user $USERNAME: $!\n"; - exit; - } - - if ($compile_in->{'persist-key'}) { - system ("rm -rf \"/home/$USERNAME/$compile_in->{'persist-key'}\""); - system("mount /dev/vdb1 /root/factdata"); - system("mkdir -p \"/root/factdata/$compile_in->{'persist-key'}\""); - system("cp -R -p \"/root/factdata/$compile_in->{'persist-key'}\" \"/home/$USERNAME/$compile_in->{'persist-key'}\""); - } - - system("chmod -R 755 /home/$USERNAME"); - system("chown -R $USERNAME /home/$USERNAME"); - system("chgrp -R $USERNAME /home/$USERNAME"); - system("rm -rf /home/$USERNAME/prog*"); - system("pkill -u $USERNAME"); - - system("date -s \@$compile_in->{date}"); - - $ENV{USER} = $USERNAME; - $ENV{LOGNAME} = $USERNAME; - $ENV{HOME} = $home; - - $GID = $gid; - $EGID = "$gid $gid"; - $EUID = $UID = $uid; - - chdir("/home/$USERNAME"); - - my $result = interpret(%$compile_in); - - $GID = 0; - $UID = 0; - - my $compile_out = { result => $result }; - - my $json = encode_json($compile_out); - - print "Done compiling: $json\n"; - - print $output "result:$json\n"; - print $output "result:end\n"; - - if ($compile_in->{'persist-key'}) { - system("id"); - system("cp -R -p \"/home/$USERNAME/$compile_in->{'persist-key'}\" \"/root/factdata/$compile_in->{'persist-key'}\""); - system("umount /root/factdata"); - system ("rm -rf \"/home/$USERNAME/$compile_in->{'persist-key'}\""); - } - - exit; - } else { - waitpid $pid, 0; - - # kill any left-over processes started by $USERNAME - system("pkill -u $USERNAME"); - } - - if (not $USE_LOCAL) { - print "=" x 40, "\n"; - next; - } else { - exit; - } - } - } else { - while (1) { - print $heartbeat "\n"; - sleep 5; - } - } - - close $input; - close $output; - close $heartbeat; -} - -sub interpret { - my %h = @_; - - $h{lang} = '_default' if not exists $languages{$h{lang}}; - - my $mod = $h{lang}->new(%h); - - $mod->preprocess; - - $mod->postprocess if not $mod->{error} and not $mod->{done}; - - if (exists $mod->{no_output} or not length $mod->{output}) { - if ($h{factoid}) { - $mod->{output} = ""; - } else { - $mod->{output} .= "\n" if length $mod->{output}; - $mod->{output} .= "Success (no output).\n" if not $mod->{error}; - $mod->{output} .= "Success (exit code $mod->{error}).\n" if $mod->{error}; - } - } - - return $mod->{output}; -} - -load_modules; -run_server; diff --git a/applets/compiler_vm/host/bin/vm-client b/applets/compiler_vm/host/bin/vm-client index e9c39c13..e14c6826 100755 --- a/applets/compiler_vm/host/bin/vm-client +++ b/applets/compiler_vm/host/bin/vm-client @@ -2,17 +2,15 @@ # File: vm-client # -# Purpose: Interfaces with the PBot virtual machine server hosted by -# `vm-server` at PeerAddr/PeerPort defined below. This allows us to -# host instances of virtual machines on remote servers. +# Purpose: Interfaces with the PBot VM Host server hosted by `vm-server` +# at PeerAddr/PeerPort defined below. This allows us to host instances +# of virtual machines on remote servers. # -# This script is intended to be attached to a PBot command such as `cc`. +# This script is intended to be invoked by a PBot command such as `cc`. # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT -# TODO: extend to take a list of server/ports to cycle for load-balancing - use warnings; use strict; @@ -22,6 +20,7 @@ use constant { SERVER_PORT => $ENV{PBOTVM_SERVER} // 9000, }; +# TODO: extend to take a list of server/ports to cycle for load-balancing my $sock = IO::Socket::INET->new( PeerAddr => '127.0.0.1', PeerPort => SERVER_PORT, diff --git a/applets/compiler_vm/host/bin/vm-exec b/applets/compiler_vm/host/bin/vm-exec index 4802e02c..713aa53f 100755 --- a/applets/compiler_vm/host/bin/vm-exec +++ b/applets/compiler_vm/host/bin/vm-exec @@ -2,9 +2,9 @@ # File: vm-exec # -# Purpose: Process and send commands to the PBot virtual machine on the -# default TCP port (5555). Use the PBOTVM_SERIAL environment variable to -# override the port. E.g., to use port 7777 instead: +# Purpose: Process and send commands to the PBot Guest server (guest-server) on +# the default serial TCP port (5555). Use the PBOTVM_SERIAL environment variable +# to override the port. E.g., to use port 7777 instead: # # $ PBOTVM_SERIAL=7777 vm-exec -lang=sh echo test diff --git a/applets/compiler_vm/host/bin/vm-server b/applets/compiler_vm/host/bin/vm-server index 6c9754c6..720a4bb2 100755 --- a/applets/compiler_vm/host/bin/vm-server +++ b/applets/compiler_vm/host/bin/vm-server @@ -2,10 +2,10 @@ # File: vm-server # -# Purpose: The compiler server manages the guest virtual machine state and -# listens for incoming compile requests. This server can be run on any remote -# machine. There can be multiple servers using different ports on the same machine. -# +# Purpose: The PBot Host Server manages the guest virtual machine state and +# listens for incoming commands from vm-client. Invokes vm-exec to send +# commands to the PBot Guest Server (guest-server). + # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT @@ -40,6 +40,9 @@ sub vm_revert() { sub execute($command) { print "execute ($command)\n"; + # to get $? from pipe + local $SIG{CHLD} = 'DEFAULT'; + my $pid = open(my $fh, '-|', split / /, $command); if (not defined $pid) { @@ -47,22 +50,22 @@ sub execute($command) { return (-13, "[Fatal error]"); } - my ($ret, $result) = (0, ''); - - ($ret, $result) = eval { - local $SIG{ALRM} = sub { kill 9, $pid; die "Timed-out: $result\n"; }; + my $result = eval { + my $output = ''; + local $SIG{ALRM} = sub { kill 9, $pid; die "Timed-out: $output\n"; }; alarm(COMPILE_TIMEOUT); while (my $line = <$fh>) { - $result .= $line; + $output .= $line; } - my $ret = $? >> 8; - return ($ret, $result); + return $output; }; - close $fh; alarm 0; + close $fh; + + my $ret = $? >> 8; if (my $exception = $@) { # handle time-out exception @@ -104,6 +107,20 @@ sub connect_to_heartbeat() { 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) { my $server = IO::Socket::INET->new ( Proto => 'tcp', @@ -117,9 +134,52 @@ sub server_listen($port) { return $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"; + my $server = eval { server_listen(SERVER_PORT) }; + + if ($@) { + print STDERR $@; + $running = 0; + return; + } + + while ($running and my $client = $server->accept) { + print '-' x 20, "\n"; + my $hostinfo = gethostbyaddr($client->peeraddr); + print "Connect from ", $client->peerhost, " at ", scalar localtime, "\n"; + handle_client($client, $heartbeat); + } + + print "Shutting down server.\n"; +} + sub handle_client($client, $heartbeat) { my ($timed_out, $killed) = (0, 0); + # we don't care about child exit status + local $SIG{CHLD} = 'IGNORE'; + + my $r = fork; + + if (not defined $r) { + print "Could not fork to handle client: $!\n"; + print $client "Fatal error.\n"; + close $client; + return; + } + + if ($r > 0) { + # nothing for parent to do with client + close $client; + return; + } + + $client->autoflush(1); + eval { # give client 5 seconds to send a line local $SIG{ALRM} = sub { die "Client I/O timed-out\n"; }; @@ -132,10 +192,10 @@ sub handle_client($client, $heartbeat) { # give client 5 more seconds alarm 5; - print "Read [$line]\n"; + print "[$$] Read [$line]\n"; if (time - $heartbeat > 5) { - print "Lost heartbeat, ignoring compile attempt.\n"; + print "[$$] Lost heartbeat, ignoring compile attempt.\n"; print $client "Recovering from previous snippet, try again soon.\n"; last; } @@ -163,59 +223,23 @@ sub handle_client($client, $heartbeat) { }; # print client time-out exception - print "$@" if $@; + print "[$$] $@" if $@; alarm 0; close $client; - print "timed out: $timed_out; killed: $killed\n"; - return $timed_out || $killed; -} + print "[$$] timed out: $timed_out; killed: $killed\n"; -use constant SUCCESS => 0; - -sub do_heartbeat() { - tie my $heartbeat, 'IPC::Shareable', { key => 'heartbeat' }; - tie my $running, 'IPC::Shareable', { key => 'running' }; - - my $heartbeat_monitor = connect_to_heartbeat() || die "No heartbeat.\n"; - - while ($running and <$heartbeat_monitor>) { - $heartbeat = time; + if ($timed_out || $killed) { + vm_revert(); } - $heartbeat = 0; + # child done + print "[$$] client exiting\n"; + print "=" x 20, "\n"; exit; } -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"; - my $server = eval { server_listen(SERVER_PORT) }; - - if ($@) { - print STDERR $@; - $running = 0; - return; - } - - while ($running and my $client = $server->accept) { - $client->autoflush(1); - my $hostinfo = gethostbyaddr($client->peeraddr); - - print '-' x 20, "\n"; - printf "Connect from %s at %s\n", $client->peerhost, scalar localtime; - - if (handle_client($client, $heartbeat) != SUCCESS) { - vm_revert(); - } - } - - print "Shutting down server.\n"; -} - sub main() { tie my $heartbeat, 'IPC::Shareable', { key => 'heartbeat', create => 1, destroy => 1 }; tie my $running, 'IPC::Shareable', { key => 'running', create => 1, destroy => 1 }; diff --git a/applets/compiler_vm/host/lib/Languages/_default.pm b/applets/compiler_vm/host/lib/Languages/_default.pm index 5123c82c..e4eba9a2 100755 --- a/applets/compiler_vm/host/lib/Languages/_default.pm +++ b/applets/compiler_vm/host/lib/Languages/_default.pm @@ -330,6 +330,7 @@ sub execute { print STDERR "Connecting to remote VM port $self->{'vm-port'}\n"; $vm = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $self->{'vm-port'}, Proto => 'tcp', Type => SOCK_STREAM); die "Could not create connection to VM: $!" unless $vm; + print STDERR "Connected to VM.\n"; $vm_output = $vm; } diff --git a/doc/VirtualMachine.md b/doc/VirtualMachine.md index a09136db..94c88d13 100644 --- a/doc/VirtualMachine.md +++ b/doc/VirtualMachine.md @@ -160,7 +160,7 @@ For the C programming language you will need at least these: guest$ dnf install libubsan libasan gdb gcc clang #### Install Perl -Now we need to install Perl on the guest. This allows us to run the PBot VM Guest +Now we need to install Perl on the guest. This allows us to run the PBot VM Guest server script. guest$ dnf install perl-interpreter perl-lib perl-IPC-Run perl-JSON-XS perl-English @@ -169,7 +169,7 @@ That installs the minium packages for the Perl interpreter (note we used `perl-i as well as the Perl `lib`, `IPC::Run`, `JSON::XS` and `English` modules. #### Install PBot VM Guest -Next we install the PBot VM Guest script that fosters communication between the virtual machine guest +Next we install the PBot VM Guest server script that fosters communication between the virtual machine guest and the physical host system. We'll do this inside the virtual machine guest system, logged on as `root` while in the `/root` directory. Feel free to `chdir` to `/tmp` if you prefer. @@ -188,9 +188,9 @@ After running the `setup-guest` script, we need to make the environment changes guest$ source /root/.bashrc #### Start PBot VM Guest -We're ready to start the PBot VM Guest. On the guest, as `root`, execute the command: +We're ready to start the PBot VM Guest server. On the guest, as `root`, execute the command: - guest$ start-guest + guest$ guest-server This starts up a server to listen for incoming commands or code and to handle them. We'll leave this running. @@ -205,7 +205,7 @@ If it says anything other than `Connection succeeded` then make sure you have co under [Set up serial ports](#set-up-serial-ports) and that your network configuration is allowing access. -Let's make sure the PBot VM Guest is listening for and can execute commands. The `vm-exec` command +Let's make sure the PBot VM Guest server is listening for and can execute commands. The `vm-exec` command in the `applets/compiler_vm/host/bin` directory allows you to send commands from the shell. host$ vm-exec -lang=sh echo hello world @@ -245,7 +245,7 @@ To start the PBot VM Host server, execute the `vm-server` script in the 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 `5555`. It will also monitor -the heartbeat port `5556` to ensure the PBot VM Guest is alive. +the heartbeat port `5556` to ensure the PBot VM Guest server is alive. You may override any of the defaults by setting environment variables.