GitHub/pbot
3
0
Fork 0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-22 03:49:29 +01:00
Code Issues Projects Releases Wiki Activity

compiler_vm: more refactoring to prepare to handle multiple connections

Browse Source
This commit is contained in:
Pragmatic Software 2022-02-10 10:58:56 -08:00
parent 5fc4b9a6dd
commit d2269a3ca6
7 changed files with 319 additions and 304 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

223
applets/compiler_vm/guest/bin/guest-server Executable file
View File

@ -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 <pragma78@gmail.com>
# 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();

232
applets/compiler_vm/guest/bin/start-guest
View File

@ -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 <pragma78@gmail.com>
# 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;

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

@ -2,17 +2,15 @@
# File: vm-client # File: vm-client
# #
# Purpose: Interfaces with the PBot virtual machine server hosted by # Purpose: Interfaces with the PBot VM Host server hosted by `vm-server`
# `vm-server` at PeerAddr/PeerPort defined below. This allows us to # at PeerAddr/PeerPort defined below. This allows us to host instances
# host instances of virtual machines on remote servers. # 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 <pragma78@gmail.com> # SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT # SPDX-License-Identifier: MIT
# TODO: extend to take a list of server/ports to cycle for load-balancing
use warnings; use warnings;
use strict; use strict;
@ -22,6 +20,7 @@ use constant {
SERVER_PORT => $ENV{PBOTVM_SERVER} // 9000, 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( my $sock = IO::Socket::INET->new(
PeerAddr => '127.0.0.1', PeerAddr => '127.0.0.1',
PeerPort => SERVER_PORT, PeerPort => SERVER_PORT,

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

@ -2,9 +2,9 @@
# File: vm-exec # File: vm-exec
# #
# Purpose: Process and send commands to the PBot virtual machine on the # Purpose: Process and send commands to the PBot Guest server (guest-server) on
# default TCP port (5555). Use the PBOTVM_SERIAL environment variable to # the default serial TCP port (5555). Use the PBOTVM_SERIAL environment variable
# override the port. E.g., to use port 7777 instead: # to override the port. E.g., to use port 7777 instead:
# #
# $ PBOTVM_SERIAL=7777 vm-exec -lang=sh echo test # $ PBOTVM_SERIAL=7777 vm-exec -lang=sh echo test

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

@ -2,10 +2,10 @@
# File: vm-server # File: vm-server
# #
# Purpose: The compiler server manages the guest virtual machine state and # Purpose: The PBot Host Server manages the guest virtual machine state and
# listens for incoming compile requests. This server can be run on any remote # listens for incoming commands from vm-client. Invokes vm-exec to send
# machine. There can be multiple servers using different ports on the same machine. # commands to the PBot Guest Server (guest-server).
#
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com> # SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT # SPDX-License-Identifier: MIT
@ -40,6 +40,9 @@ sub vm_revert() {
sub execute($command) { sub execute($command) {
print "execute ($command)\n"; print "execute ($command)\n";
# to get $? from pipe
local $SIG{CHLD} = 'DEFAULT';
my $pid = open(my $fh, '-|', split / /, $command); my $pid = open(my $fh, '-|', split / /, $command);
if (not defined $pid) { if (not defined $pid) {
@ -47,22 +50,22 @@ sub execute($command) {
return (-13, "[Fatal error]"); return (-13, "[Fatal error]");
} }
my ($ret, $result) = (0, ''); my $result = eval {
my $output = '';
($ret, $result) = eval { local $SIG{ALRM} = sub { kill 9, $pid; die "Timed-out: $output\n"; };
local $SIG{ALRM} = sub { kill 9, $pid; die "Timed-out: $result\n"; };
alarm(COMPILE_TIMEOUT); alarm(COMPILE_TIMEOUT);
while (my $line = <$fh>) { while (my $line = <$fh>) {
$result .= $line; $output .= $line;
} }
my $ret = $? >> 8; return $output;
return ($ret, $result);
}; };
close $fh;
alarm 0; alarm 0;
close $fh;
my $ret = $? >> 8;
if (my $exception = $@) { if (my $exception = $@) {
# handle time-out exception # handle time-out exception
@ -104,6 +107,20 @@ sub connect_to_heartbeat() {
return $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) { sub server_listen($port) {
my $server = IO::Socket::INET->new ( my $server = IO::Socket::INET->new (
Proto => 'tcp', Proto => 'tcp',
@ -117,9 +134,52 @@ sub server_listen($port) {
return $server; 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) { sub handle_client($client, $heartbeat) {
my ($timed_out, $killed) = (0, 0); 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 { 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"; };
@ -132,10 +192,10 @@ sub handle_client($client, $heartbeat) {
# give client 5 more seconds # give client 5 more seconds
alarm 5; alarm 5;
print "Read [$line]\n"; print "[$$] Read [$line]\n";
if (time - $heartbeat > 5) { 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"; print $client "Recovering from previous snippet, try again soon.\n";
last; last;
} }
@ -163,59 +223,23 @@ sub handle_client($client, $heartbeat) {
}; };
# print client time-out exception # print client time-out exception
print "$@" if $@; print "[$$] $@" if $@;
alarm 0; alarm 0;
close $client; close $client;
print "timed out: $timed_out; killed: $killed\n"; print "[$$] timed out: $timed_out; killed: $killed\n";
return $timed_out || $killed;
}
use constant SUCCESS => 0; if ($timed_out || $killed) {
vm_revert();
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;
} }
$heartbeat = 0; # child done
print "[$$] client exiting\n";
print "=" x 20, "\n";
exit; 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() { sub main() {
tie my $heartbeat, 'IPC::Shareable', { key => 'heartbeat', create => 1, destroy => 1 }; tie my $heartbeat, 'IPC::Shareable', { key => 'heartbeat', create => 1, destroy => 1 };
tie my $running, 'IPC::Shareable', { key => 'running', create => 1, destroy => 1 }; tie my $running, 'IPC::Shareable', { key => 'running', create => 1, destroy => 1 };

1
applets/compiler_vm/host/lib/Languages/_default.pm
View File

@ -330,6 +330,7 @@ sub execute {
print STDERR "Connecting to remote VM port $self->{'vm-port'}\n"; 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); $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; die "Could not create connection to VM: $!" unless $vm;
print STDERR "Connected to VM.\n";
$vm_output = $vm; $vm_output = $vm;
} }

12
doc/VirtualMachine.md
View File

@ -160,7 +160,7 @@ For the C programming language you will need at least these:
guest$ dnf install libubsan libasan gdb gcc clang guest$ dnf install libubsan libasan gdb gcc clang
#### Install Perl #### 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. script.
guest$ dnf install perl-interpreter perl-lib perl-IPC-Run perl-JSON-XS perl-English 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. as well as the Perl `lib`, `IPC::Run`, `JSON::XS` and `English` modules.
#### Install PBot VM Guest #### 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` 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. 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 guest$ source /root/.bashrc
#### Start PBot VM Guest #### 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 starts up a server to listen for incoming commands or code and to handle them. We'll leave
this running. 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 under [Set up serial ports](#set-up-serial-ports) and that your network configuration is allowing
access. 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. in the `applets/compiler_vm/host/bin` directory allows you to send commands from the shell.
host$ vm-exec -lang=sh echo hello world 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 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 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. You may override any of the defaults by setting environment variables.