mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-22 03:49:29 +01:00
compiler_vm: major refactor to support VM sockets (AF_VSOCK)
VM socket communication is superior to VM serial communication in every way. Unfortunately at this time only Linux supports them. Fortunately, that's 99% of PBot's userbase. If you're not using Linux or if you're using an older Linux that does not support VM sockets, the PBot VM scripts will gracefully fallback to using the serial connection. You may explicitly disable VM socket connection attempts by setting PBOTVM_CID=0.
This commit is contained in:
Pragmatic Software
parent
563dc8c70a
commit
1326b0ac5f
69
applets/compiler_vm/guest/bin/accept-vsock-client
Executable file
69
applets/compiler_vm/guest/bin/accept-vsock-client
Executable file
@ -0,0 +1,69 @@
|
||||
#!/usr/bin/env perl
|
||||
|
||||
# File: accept-vsock-client
|
||||
#
|
||||
# Purpose: Accepts and handles a client connecting over Linux VM socket.
|
||||
|
||||
# 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 constant {
|
||||
USERNAME => 'vm',
|
||||
MOD_DIR => '/usr/local/share/pbot-vm/',
|
||||
};
|
||||
|
||||
use lib MOD_DIR;
|
||||
|
||||
use Guest;
|
||||
|
||||
sub accept_client() {
|
||||
print STDERR "VSOCK accepted new connection.\n";
|
||||
|
||||
my $buffer = '';
|
||||
|
||||
while (1) {
|
||||
my $command = Guest::read_input(*STDIN, \$buffer, 'VSOCK');
|
||||
|
||||
if (not defined $command) {
|
||||
# recoverable error or waiting for more input
|
||||
next;
|
||||
}
|
||||
|
||||
if (not $command) {
|
||||
# unrecoverable error or input closed
|
||||
exit 1;
|
||||
}
|
||||
|
||||
last;
|
||||
}
|
||||
|
||||
eval { require "Languages/$command->{lang}.pm" };
|
||||
|
||||
if ($@) {
|
||||
require 'Languages/_default.pm';
|
||||
$command->{lang} = '_default';
|
||||
}
|
||||
|
||||
my $mod = $command->{lang}->new(%$command);
|
||||
|
||||
my $result = Guest::process_command($command, $mod, USERNAME, 'VSOCK');
|
||||
|
||||
if (not defined $result) {
|
||||
$result = "[Fatal error]";
|
||||
}
|
||||
|
||||
if ($result) {
|
||||
Guest::send_output(*STDOUT, $result, 'VSOCK');
|
||||
exit; # exit child process
|
||||
}
|
||||
}
|
||||
|
||||
accept_client();
|
||||
@ -16,208 +16,165 @@ 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',
|
||||
USERNAME => 'vm',
|
||||
MOD_DIR => '/usr/local/share/pbot-vm/',
|
||||
SERIAL => '/dev/ttyS1',
|
||||
HEARTBEAT => '/dev/ttyS2',
|
||||
INPUT => '/dev/stdin',
|
||||
OUTPUT => '/dev/stdout',
|
||||
VPORT => $ENV{PBOTVM_VPORT} // 5555,
|
||||
};
|
||||
|
||||
use lib MOD_DIR;
|
||||
use lib MOD_DIR . "Languages";
|
||||
|
||||
use Guest;
|
||||
|
||||
use File::Basename;
|
||||
use IPC::Shareable;
|
||||
|
||||
my %languages;
|
||||
|
||||
sub load_modules() {
|
||||
my @files = glob MOD_DIR . "/*.pm";
|
||||
my @files = glob MOD_DIR . "Languages/*.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;
|
||||
sub vsock_server() {
|
||||
print "Starting VSOCK server on PID $$\n";
|
||||
|
||||
while (1) {
|
||||
print "Waiting for input...\n";
|
||||
my $ret = sysread($input, my $buf, 16384);
|
||||
system("socat VSOCK-LISTEN:".VPORT.",reuseaddr,fork EXEC:accept-vsock-client");
|
||||
|
||||
if (not defined $ret) {
|
||||
print "Error reading: $!\n";
|
||||
next;
|
||||
print "VSOCK server shutdown.\n";
|
||||
exit; # exit child process
|
||||
}
|
||||
|
||||
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();
|
||||
sub serial_server() {
|
||||
print "Starting serial server on PID $$\n";
|
||||
|
||||
# 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 $!;
|
||||
|
||||
tie my $running, 'IPC::Shareable', { key => 'running' };
|
||||
|
||||
my $buffer = '';
|
||||
|
||||
while ($running) {
|
||||
my $command = Guest::read_input($input, \$buffer, 'Serial');
|
||||
|
||||
if (not defined $command) {
|
||||
# recoverable error while reading, try again
|
||||
next;
|
||||
}
|
||||
|
||||
if ($command == 0) {
|
||||
# serial closed, exit child process
|
||||
exit;
|
||||
}
|
||||
|
||||
if (not exists $languages{$command->{lang}}) {
|
||||
$command->{lang} = '_default';
|
||||
}
|
||||
|
||||
my $mod = $command->{lang}->new(%$command);
|
||||
|
||||
my $result = Guest::process_command($command, $mod, USERNAME, 'Serial');
|
||||
|
||||
if (not defined $result) {
|
||||
$result = "[Fatal error]";
|
||||
}
|
||||
|
||||
if ($result) {
|
||||
Guest::send_output($output, $result, 'Serial');
|
||||
exit; # exit child process
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub do_server() {
|
||||
my $pid = fork;
|
||||
|
||||
if (not defined $pid) {
|
||||
print STDERR "Could not fork server: $!\n";
|
||||
die;
|
||||
}
|
||||
|
||||
if ($pid == 0) {
|
||||
vsock_server();
|
||||
} else {
|
||||
serial_server();
|
||||
}
|
||||
}
|
||||
|
||||
sub do_heartbeat() {
|
||||
open(my $heartbeat, '>', HEARTBEAT) or die $!;
|
||||
|
||||
tie my $running, 'IPC::Shareable', { key => 'running' };
|
||||
|
||||
print "Heart beating on PID $$...\n";
|
||||
|
||||
while ($running) {
|
||||
print $heartbeat "\n";
|
||||
sleep 5;
|
||||
}
|
||||
|
||||
print "Heart beat stopped.\n";
|
||||
exit; # exit child process
|
||||
}
|
||||
|
||||
sub install_signal_handlers() {
|
||||
use POSIX qw(:signal_h :errno_h :sys_wait_h);
|
||||
|
||||
$SIG{CHLD} = \&REAPER;
|
||||
|
||||
sub REAPER {
|
||||
my $pid = waitpid(-1, &WNOHANG);
|
||||
|
||||
if ($pid == -1) {
|
||||
# no child waiting. Ignore it.
|
||||
} elsif (WIFEXITED($?)) {
|
||||
print "Process $pid exited.\n";
|
||||
}
|
||||
|
||||
$SIG{CHLD} = \&REAPER; # in case of unreliable signals
|
||||
}
|
||||
}
|
||||
|
||||
sub main() {
|
||||
print "Starting PBot VM Guest server on PID $$\n";
|
||||
|
||||
load_modules();
|
||||
|
||||
install_signal_handlers();
|
||||
|
||||
tie my $running, 'IPC::Shareable', { key => 'running', create => 1, destroy => 1 };
|
||||
|
||||
$running = 1;
|
||||
|
||||
my $pid = fork // die "Fork failed: $!";
|
||||
|
||||
if ($pid == 0) {
|
||||
do_server($input, $output);
|
||||
do_heartbeat();
|
||||
} else {
|
||||
do_heartbeat($heartbeat);
|
||||
do_server();
|
||||
}
|
||||
|
||||
print "PBot VM Guest server shutdown.\n";
|
||||
}
|
||||
|
||||
main();
|
||||
|
||||
@ -11,9 +11,9 @@
|
||||
# copy executable scripts
|
||||
cp guest/bin/* /usr/local/bin
|
||||
|
||||
# language support
|
||||
# lib and language support
|
||||
mkdir -p /usr/local/share/pbot-vm/
|
||||
cp -r guest/lib/Languages/ /usr/local/share/pbot-vm/
|
||||
cp -r guest/lib/* /usr/local/share/pbot-vm/
|
||||
|
||||
# C support and GDB integration
|
||||
cp guest/include/prelude.h /usr/include
|
||||
|
||||
165
applets/compiler_vm/guest/lib/Guest.pm
Normal file
165
applets/compiler_vm/guest/lib/Guest.pm
Normal file
@ -0,0 +1,165 @@
|
||||
#!/usr/bin/env perl
|
||||
|
||||
# File: Guest.pm
|
||||
#
|
||||
# Purpose: Collection of functions to interface with the PBot VM Guest and
|
||||
# execute VM commands.
|
||||
|
||||
# SPDX-FileCopyrightText: 2022 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
package Guest;
|
||||
|
||||
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 IPC::Shareable;
|
||||
use Data::Dumper;
|
||||
|
||||
sub read_input($input, $buffer, $tag) {
|
||||
my $line;
|
||||
my $total_read = 0;
|
||||
|
||||
print STDERR "$tag waiting for input...\n";
|
||||
my $ret = sysread($input, my $buf, 16384);
|
||||
|
||||
if (not defined $ret) {
|
||||
print STDERR "Error reading $tag: $!\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
if ($ret == 0) {
|
||||
print STDERR "$tag input closed.\n";
|
||||
return 0;
|
||||
}
|
||||
|
||||
$total_read += $ret;
|
||||
|
||||
print STDERR "$tag read $ret bytes [$total_read total] [$buf]\n";
|
||||
|
||||
$$buffer .= $buf;
|
||||
|
||||
return undef if $$buffer !~ s/\s*:end:\s*$//m;
|
||||
|
||||
$line = $$buffer;
|
||||
chomp $line;
|
||||
|
||||
$$buffer = '';
|
||||
$total_read = 0;
|
||||
|
||||
$line = encode('UTF-8', $line);
|
||||
|
||||
print STDERR "-" x 40, "\n";
|
||||
print STDERR "$tag got [$line]\n";
|
||||
|
||||
my $command = decode_json($line);
|
||||
$command->{arguments} //= '';
|
||||
$command->{input} //= '';
|
||||
|
||||
print STDERR Dumper($command), "\n";
|
||||
|
||||
return $command;
|
||||
}
|
||||
|
||||
sub process_command($command, $mod, $user, $tag) {
|
||||
my ($uid, $gid, $home) = (getpwnam $user)[2, 3, 7];
|
||||
|
||||
if (not $uid and not $gid) {
|
||||
print STDERR "Could not find user $user: $!\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $pid = fork;
|
||||
|
||||
if (not defined $pid) {
|
||||
print STDERR "process_command: fork failed: $!\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
if ($pid == 0) {
|
||||
if ($command->{'persist-key'}) {
|
||||
system ("rm -rf \"/home/$user/$command->{'persist-key'}\" 1>&2");
|
||||
system("mount /dev/vdb1 /root/factdata 1>&2");
|
||||
system("mkdir -p \"/root/factdata/$command->{'persist-key'}\" 1>&2");
|
||||
system("cp -R -p \"/root/factdata/$command->{'persist-key'}\" \"/home/$user/$command->{'persist-key'}\" 1>&2");
|
||||
}
|
||||
|
||||
system("chmod -R 755 /home/$user 1>&2");
|
||||
system("chown -R $user /home/$user 1>&2");
|
||||
system("chgrp -R $user /home/$user 1>&2");
|
||||
system("rm -rf /home/$user/prog* 1>&2");
|
||||
system("pkill -u $user 1>&2");
|
||||
|
||||
system("date -s \@$command->{date} 1>&2");
|
||||
|
||||
$ENV{USER} = $user;
|
||||
$ENV{LOGNAME} = $user;
|
||||
$ENV{HOME} = $home;
|
||||
|
||||
chdir("/home/$user");
|
||||
|
||||
$GID = $gid;
|
||||
$EGID = "$gid $gid";
|
||||
$EUID = $UID = $uid;
|
||||
|
||||
my $result = run_command($command, $mod);
|
||||
|
||||
print STDERR "=" x 40, "\n";
|
||||
|
||||
return $result;
|
||||
} else {
|
||||
# wait for child to finish
|
||||
waitpid($pid, 0);
|
||||
|
||||
# clean up persistent factoid storage
|
||||
if ($command->{'persist-key'}) {
|
||||
system("cp -R -p \"/home/$user/$command->{'persist-key'}\" \"/root/factdata/$command->{'persist-key'}\"");
|
||||
system("umount /root/factdata");
|
||||
system ("rm -rf \"/home/$user/$command->{'persist-key'}\"");
|
||||
}
|
||||
|
||||
# kill any left-over processes started by $user
|
||||
system("pkill -u $user");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub run_command($command, $mod) {
|
||||
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 send_output($output, $result, $tag) {
|
||||
my $json = encode_json({ result => $result });
|
||||
print $output "result:$json\n";
|
||||
print $output "result:end\n";
|
||||
}
|
||||
|
||||
1;
|
||||
@ -28,7 +28,7 @@ sub preprocess {
|
||||
print $fh $code . "\n";
|
||||
close $fh;
|
||||
|
||||
print "Executing [$self->{cmdline}] without print_last_statement\n";
|
||||
print STDERR "Executing [$self->{cmdline}] without print_last_statement\n";
|
||||
my ($retval, $stdout, $stderr) = $self->execute(60, undef, @cmd);
|
||||
$self->{output} = $stderr;
|
||||
$self->{output} .= ' ' if length $self->{output};
|
||||
@ -41,7 +41,7 @@ sub preprocess {
|
||||
print $fh $self->{code} . "\n";
|
||||
close $fh;
|
||||
|
||||
print "Executing [$self->{cmdline}] with print_last_statement\n";
|
||||
print STDERR "Executing [$self->{cmdline}] with print_last_statement\n";
|
||||
$self->execute(60, undef, @cmd);
|
||||
}
|
||||
} else {
|
||||
@ -49,7 +49,7 @@ sub preprocess {
|
||||
print $fh $self->{code} . "\n";
|
||||
close $fh;
|
||||
|
||||
print "Executing [$self->{cmdline}]\n";
|
||||
print STDERR "Executing [$self->{cmdline}]\n";
|
||||
my ($retval, $stdout, $stderr) = $self->execute(60, undef, @cmd);
|
||||
$self->{output} = $stderr;
|
||||
$self->{output} .= ' ' if length $self->{output};
|
||||
@ -73,7 +73,7 @@ sub postprocess {
|
||||
$self->{output} = "[$self->{output}]\n";
|
||||
}
|
||||
|
||||
print "Executing gdb\n";
|
||||
print STDERR "Executing gdb\n";
|
||||
my ($exitval, $stdout, $stderr);
|
||||
|
||||
my $ulimits = "ulimit -f 2000; ulimit -t 8; ulimit -u 200";
|
||||
|
||||
@ -75,7 +75,7 @@ sub execute {
|
||||
|
||||
$stdin //= '';
|
||||
|
||||
print "execute ($timeout) [$stdin] @cmdline\n";
|
||||
print STDERR "execute ($timeout) [$stdin] @cmdline\n";
|
||||
|
||||
my ($exitval, $stdout, $stderr) = eval {
|
||||
my ($stdout, $stderr);
|
||||
@ -90,7 +90,7 @@ sub execute {
|
||||
}
|
||||
|
||||
$Data::Dumper::Indent = 0;
|
||||
print "exitval $exitval stderr [", Dumper($stderr), "] stdout [", Dumper($stdout), "]\n";
|
||||
print STDERR "exitval $exitval stderr [", Dumper($stderr), "] stdout [", Dumper($stdout), "]\n";
|
||||
$Data::Dumper::Indent = 1;
|
||||
|
||||
return ($exitval, $stdout, $stderr);
|
||||
|
||||
@ -28,7 +28,6 @@ sub postprocess {
|
||||
$self->{output} = "[$self->{output}]\n";
|
||||
}
|
||||
|
||||
print "Executing java\n";
|
||||
my $input_quoted = quotemeta $self->{input};
|
||||
$input_quoted =~ s/\\"/"'\\"'"/g;
|
||||
my ($retval, $result) = $self->execute(60, "bash -c \"date -s \@$self->{date}; ulimit -t 5; echo $input_quoted | java prog $self->{arguments} > .output\"");
|
||||
|
||||
@ -21,7 +21,9 @@ use FindBin qw($RealBin);
|
||||
use lib "$RealBin/../lib";
|
||||
|
||||
use constant {
|
||||
SERIAL_PORT => $ENV{PBOTVM_SERIAL} // 5555,
|
||||
SERIAL => $ENV{PBOTVM_SERIAL} // 5555,
|
||||
CID => $ENV{PBOTVM_CID} // 7,
|
||||
VPORT => $ENV{PBOTVM_VPORT} // 5555,
|
||||
};
|
||||
|
||||
my $json = join ' ', @ARGV;
|
||||
@ -44,7 +46,9 @@ if (not exists $data->{code}) {
|
||||
$data->{nick} //= 'vm';
|
||||
$data->{channel} //= 'vm';
|
||||
$data->{lang} //= 'c11';
|
||||
$data->{'vm-port'} //= SERIAL_PORT;
|
||||
$data->{'vm-serial'} //= SERIAL;
|
||||
$data->{'vm-cid'} //= CID;
|
||||
$data->{'vm-vport'} //= VPORT;
|
||||
|
||||
# parse -lang option
|
||||
if ($data->{code} =~ s/^-lang=([^ ]+)\s+//) {
|
||||
|
||||
@ -196,7 +196,7 @@ sub handle_client($client, $heartbeat) {
|
||||
|
||||
if (time - $heartbeat > 5) {
|
||||
print "[$$] Lost heartbeat, ignoring compile attempt.\n";
|
||||
print $client "Recovering from previous snippet, try again soon.\n";
|
||||
print $client "Virtual machine is resetting, try again soon.\n";
|
||||
last;
|
||||
}
|
||||
|
||||
|
||||
10
applets/compiler_vm/host/devices/add-all
Executable file
10
applets/compiler_vm/host/devices/add-all
Executable file
@ -0,0 +1,10 @@
|
||||
#!/bin/sh
|
||||
|
||||
for script in add-*
|
||||
do
|
||||
if [ $script = 'add-all' ]; then
|
||||
continue
|
||||
fi
|
||||
|
||||
./$script
|
||||
done
|
||||
14
applets/compiler_vm/host/devices/add-vsock
Executable file
14
applets/compiler_vm/host/devices/add-vsock
Executable file
@ -0,0 +1,14 @@
|
||||
#!/bin/sh
|
||||
|
||||
DOMAIN="${PBOTVM_DOMAIN:-pbot-vm}"
|
||||
CID="${PBOTVM_CID:-7}"
|
||||
|
||||
cat > vsock.xml <<EOF
|
||||
<vsock model='virtio'>
|
||||
<cid auto='no' address='$CID'/>
|
||||
</vsock>
|
||||
EOF
|
||||
|
||||
virsh attach-device --config $DOMAIN vsock.xml
|
||||
|
||||
rm vsock.xml
|
||||
@ -36,7 +36,9 @@ sub new {
|
||||
$self->{arguments} = $conf{arguments} // '';
|
||||
$self->{factoid} = $conf{factoid};
|
||||
$self->{'persist-key'} = $conf{'persist-key'};
|
||||
$self->{'vm-port'} = $conf{'vm-port'};
|
||||
$self->{'vm-serial'} = $conf{'vm-serial'};
|
||||
$self->{'vm-cid'} = $conf{'vm-cid'};
|
||||
$self->{'vm-vport'} = $conf{'vm-vport'};
|
||||
|
||||
$self->{default_options} = '';
|
||||
$self->{cmdline} = 'echo Hello, world!';
|
||||
@ -316,22 +318,72 @@ sub paste_0x0 {
|
||||
return $result;
|
||||
}
|
||||
|
||||
sub connect_vsock {
|
||||
my ($self) = @_;
|
||||
|
||||
return undef if not $self->{'vm-cid'};
|
||||
|
||||
print STDERR "Connecting to remote VM socket CID $self->{'vm-cid'} port $self->{'vm-vport'}\n";
|
||||
|
||||
my $command = "socat - VSOCK-CONNECT:$self->{'vm-cid'}:$self->{'vm-vport'}";
|
||||
|
||||
my ($pid, $input, $output) = eval {
|
||||
my $pid = open2(my $output, my $input, $command);
|
||||
return ($pid, $input, $output);
|
||||
};
|
||||
|
||||
if ($@) {
|
||||
print STDERR "Failed to connect to VM socket: $@\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
if (not defined $pid) {
|
||||
print STDERR "Failed to connect to VM socket: $!\n";
|
||||
return undef;
|
||||
}
|
||||
|
||||
return ($input, $output);
|
||||
}
|
||||
|
||||
sub connect_serial {
|
||||
my ($self) = @_;
|
||||
|
||||
print STDERR "Connecting to remote VM serial port $self->{'vm-serial'}\n";
|
||||
|
||||
my $vm = IO::Socket::INET->new(
|
||||
PeerAddr => '127.0.0.1',
|
||||
PeerPort => $self->{'vm-serial'},
|
||||
Proto => 'tcp',
|
||||
Type => SOCK_STREAM
|
||||
);
|
||||
|
||||
# return same $vm handle for ($input, $output)
|
||||
return ($vm, $vm);
|
||||
}
|
||||
|
||||
sub execute {
|
||||
my ($self) = @_;
|
||||
|
||||
my ($vm, $vm_output, $pid);
|
||||
my ($input, $output, $pid);
|
||||
|
||||
delete $self->{local};
|
||||
if(exists $self->{local} and $self->{local} != 0) {
|
||||
if (defined $self->{local} and $self->{local} != 0) {
|
||||
print "Using local machine instead of virtual machine\n";
|
||||
$pid = open2($vm_output, $vm, './compiler_vm_server.pl') || die "repl failed: $@\n"; # XXX
|
||||
$pid = open2($output, $input, './compiler_vm_server.pl') || die "repl failed: $@\n"; # XXX adapt vm-exec into local-exec
|
||||
print "Started fake-vm, pid: $pid\n";
|
||||
} else {
|
||||
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;
|
||||
# attempt preferred VSOCK connection
|
||||
($input, $output) = $self->connect_vsock();
|
||||
|
||||
# fallback to serial
|
||||
if (not defined $input) {
|
||||
($input, $output) = $self->connect_serial();
|
||||
}
|
||||
|
||||
if (not defined $input) {
|
||||
die "Could not create connection to VM: $!";
|
||||
}
|
||||
|
||||
print STDERR "Connected to VM.\n";
|
||||
$vm_output = $vm;
|
||||
}
|
||||
|
||||
my $date = time;
|
||||
@ -414,33 +466,33 @@ sub execute {
|
||||
|
||||
while ($chunks_sent < $length) {
|
||||
my $chunk = substr $compile_json, $chunks_sent, $chunk_size;
|
||||
#print LOG "Sending chunk [$chunk]\n";
|
||||
|
||||
$chunks_sent += length $chunk;
|
||||
|
||||
my $ret = syswrite($vm, $chunk);
|
||||
my $ret = syswrite($input, $chunk);
|
||||
|
||||
if (not defined $ret) {
|
||||
print STDERR "Error sending: $!\n";
|
||||
print LOG "Error sending: $!\n";
|
||||
last;
|
||||
}
|
||||
|
||||
if ($ret == 0) {
|
||||
print STDERR "Sent 0 bytes. Sleep 1 sec and try again\n";
|
||||
print LOG "Sent 0 bytes. Sleep 1 sec and try again\n";
|
||||
sleep 1;
|
||||
next;
|
||||
}
|
||||
|
||||
$sent += $ret;
|
||||
print LOG "Sent $ret bytes, so far $sent ...\n";
|
||||
}
|
||||
|
||||
#print LOG "Done sending!\n";
|
||||
close LOG;
|
||||
|
||||
my $result = "";
|
||||
my $got_result = 0;
|
||||
|
||||
while(my $line = <$vm_output>) {
|
||||
while (my $line = <$output>) {
|
||||
utf8::decode($line);
|
||||
$line =~ s/[\r\n]+$//;
|
||||
last if $line =~ /^result:end$/;
|
||||
@ -458,7 +510,7 @@ sub execute {
|
||||
}
|
||||
}
|
||||
|
||||
close $vm;
|
||||
close $input;
|
||||
waitpid($pid, 0) if defined $pid;
|
||||
|
||||
$self->{output} = $result;
|
||||
|
||||
@ -19,6 +19,20 @@ Some quick terminology:
|
||||
The commands below will be prefixed with `host$` or `guest$` to reflect where
|
||||
the command should be executed.
|
||||
|
||||
Many commands can be configured with environment variables. If a variable is
|
||||
not defined, a sensible default value will be used.
|
||||
|
||||
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 serial heartbeats
|
||||
PBOTVM_CID | `7` | Context ID for VM socket (if using VSOCK)
|
||||
PBOTVM_VPORT | `5555` | VM socket service port (if using VSOCK)
|
||||
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
|
||||
|
||||
## Initial virtual machine set-up
|
||||
These steps need to be done only once during the first-time set-up.
|
||||
|
||||
@ -105,7 +119,7 @@ of choice.
|
||||
|
||||
* Click `Partition disks`. Don't change anything. Click `Done`.
|
||||
* Click `Root account`. Click `Enable root account`. Set a password. Click `Done`.
|
||||
* Click `User creation`. Create a new user. Skip Fullname and set Username to `vm`. Untick `Add to wheel` or `Set as administrator`. Untick `Require password`.
|
||||
* Click `User creation`. Create a new user. Skip Fullname and set Username to `vm`. Untick `Add to wheel` or `Set as administrator`. Untick `Require password`. Click `Done`.
|
||||
* Wait until `Software selection` is done processing and is no longer greyed out. Click it. Change install from `Server` to `Minimal`. Click `Done`.
|
||||
* Click `Begin installation`.
|
||||
|
||||
@ -135,6 +149,65 @@ If you later want to change the serial ports or the TCP ports, execute the comma
|
||||
`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.
|
||||
|
||||
#### Set up virtio-vsock
|
||||
VM sockets (AF_VSOCK) are a Linux-specific feature (at the time of this writing). They
|
||||
are the preferred way for PBot to communicate with the PBot VM Guest server. Serial communication
|
||||
has several limitations. See https://vmsplice.net/~stefan/stefanha-kvm-forum-2015.pdf for an excellent
|
||||
overview.
|
||||
|
||||
To use VM sockets with QEMU and virtio-vsock, you need:
|
||||
|
||||
* a Linux hypervisor with kernel 4.8+
|
||||
* a Linux virtual machine on that hypervisor with kernel 4.8+
|
||||
* QEMU 2.8+ on the hypervisor, running the virtual machine
|
||||
* [socat](http://www.dest-unreach.org/socat/) version 1.7.4+
|
||||
|
||||
If you do not meet these requirements, the PBot VM will fallback to using serial communication. You may
|
||||
explicitly disable VM sockets by setting `PBOTVM_CID=0`. You can skip reading the rest of this section.
|
||||
|
||||
If you do want to use VM sockets, read on.
|
||||
|
||||
First, ensure the `vhost_vsock` Linux kernel module is loaded on the host:
|
||||
|
||||
host$ lsmod | grep vsock
|
||||
vhost_vsock 24576 1
|
||||
vsock 45056 2 vmw_vsock_virtio_transport_common,vhost_vsock
|
||||
vhost 53248 2 vhost_vsock,vhost_net
|
||||
|
||||
If the module is not loaded, load it with:
|
||||
|
||||
host$ sudo modprobe vhost_vsock
|
||||
|
||||
Once the module is loaded, you should have the following character devices:
|
||||
|
||||
host$ ls -l /dev/vhost-vsock
|
||||
crw------- 1 root root 10, 53 May 4 11:55 /dev/vhost-vsock
|
||||
host$ ls -l /dev/vsock
|
||||
crw-rw-rw- 1 root root 10, 54 May 4 11:55 /dev/vsock
|
||||
|
||||
A VM sockets address is comprised of a context ID (CID) and a port; just like an IP address and TCP/UDP port.
|
||||
The CID is represented using an unsigned 32-bit integer. It identifies a given machine as either a hypervisor
|
||||
or a virtual machine. Several addresses are reserved, including 0, 1, and the maximum value for a 32-bit
|
||||
integer: 0xffffffff. The hypervisor is always assigned a CID of 2, and VMs can be assigned any CID between 3
|
||||
and 0xffffffff — 1.
|
||||
|
||||
We must attach a `vhost-vsock-pci` device to the guest to enable VM sockets communication.
|
||||
Each VM on a hypervisor must have a unique context ID (CID). Each service within the VM must
|
||||
have a unique port. The PBot VM Guest defaults to `7` for the CID and `5555` for the port.
|
||||
|
||||
While still in the `applets/compiler_vm/host/devices` directory, run the `add-vsock` script:
|
||||
|
||||
host$ ./add-vsock
|
||||
|
||||
or to configure a different CID:
|
||||
|
||||
host$ PBOTVM_CID=42 ./add-vsock
|
||||
|
||||
In the VM guest (once it reboots), there should be a `/dev/vsock` device:
|
||||
|
||||
guest$ ls -l /dev/vsock
|
||||
crw-rw-rw- 1 root root 10, 55 May 4 13:21 /dev/vsock
|
||||
|
||||
#### Reboot virtual machine
|
||||
Once the Linux installation completes inside the virtual machine, click the `Reboot` button
|
||||
in the installer window. Login as `root` when the virtual machine boots back up.
|
||||
@ -145,6 +218,10 @@ in the virtual machine. Use the `dnf search` command or your distribution's docu
|
||||
to find packages. I will soon make available a script to install all package necessary for all
|
||||
languages supported by PBot.
|
||||
|
||||
To make use of VM sockets, install the `socat` package:
|
||||
|
||||
guest$ dnf install socat
|
||||
|
||||
For the C programming language you will need at least these:
|
||||
|
||||
guest$ dnf install libubsan libasan gdb gcc clang
|
||||
@ -153,10 +230,10 @@ For the C programming language you will need at least these:
|
||||
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
|
||||
guest$ dnf install perl-interpreter perl-lib perl-IPC-Run perl-JSON-XS perl-English perl-IPC-Shareable
|
||||
|
||||
That installs the minium packages for the Perl interpreter (note we used `perl-interpreter` instead of `perl`),
|
||||
as well as the Perl `lib`, `IPC::Run`, `JSON::XS` and `English` modules.
|
||||
as well as a few Perl modules.
|
||||
|
||||
#### Install PBot VM Guest
|
||||
Next we install the PBot VM Guest server script that fosters communication between the virtual machine guest
|
||||
@ -237,18 +314,8 @@ This will start a TCP server on port `9000`. It will listen for incoming command
|
||||
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 server 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:
|
||||
You may override any of the defaults by setting environment variables. 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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user