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: major refactor to support VM sockets (AF_VSOCK)

Browse Source 
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 2022-02-12 16:06:04 -08:00
parent 563dc8c70a
commit 1326b0ac5f
13 changed files with 586 additions and 249 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
applets/compiler_vm/guest/bin/accept-vsock-client Executable file
View 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();

233
applets/compiler_vm/guest/bin/guest-server
View File

@ -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) {
sub vsock_server() {
print "Starting VSOCK server on PID $$\n";
system("socat VSOCK-LISTEN:".VPORT.",reuseaddr,fork EXEC:accept-vsock-client");
print "VSOCK server shutdown.\n";
exit; # exit child process
}
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 = '';
my $line;
my $total_read = 0;
while (1) {
print "Waiting for input...\n";
my $ret = sysread($input, my $buf, 16384);
while ($running) {
my $command = Guest::read_input($input, \$buffer, 'Serial');
if (not defined $ret) {
print "Error reading: $!\n";
if (not defined $command) {
# recoverable error while reading, try again
next;
}
if ($ret == 0) {
print "Input closed; exiting...\n";
if ($command == 0) {
# serial closed, exit child process
exit;
}
$total_read += $ret;
if (not exists $languages{$command->{lang}}) {
$command->{lang} = '_default';
}
chomp $buf;
print "read $ret bytes [$total_read so far] [$buf]\n";
my $mod = $command->{lang}->new(%$command);
$buffer .= $buf;
my $result = Guest::process_command($command, $mod, USERNAME, 'Serial');
next if $buffer !~ s/\s*:end:\s*$//m;
if (not defined $result) {
$result = "[Fatal error]";
}
$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);
if ($result) {
Guest::send_output($output, $result, 'Serial');
exit; # exit child process
}
}
}
sub handle_command($command, $output) {
local $SIG{CHLD} = 'IGNORE';
sub do_server() {
my $pid = fork;
if (not defined $pid) {
print "fork failed: $!\n";
next;
print STDERR "Could not fork server: $!\n";
die;
}
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;
vsock_server();
} else {
serial_server();
}
}
sub run_command(%command) {
$command{lang} = '_default' if not exists $languages{$command{lang}};
sub do_heartbeat() {
open(my $heartbeat, '>', HEARTBEAT) or die $!;
my $mod = $command{lang}->new(%command);
tie my $running, 'IPC::Shareable', { key => 'running' };
local $SIG{CHLD} = 'DEFAULT';
print "Heart beating on PID $$...\n";
$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) {
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();
# set serial to 115200 baud instead of 9600
system('stty -F ' . SERIAL . ' 115200');
install_signal_handlers();
open(my $input, '<', SERIAL) or die $!;
open(my $output, '>', SERIAL) or die $!;
open(my $heartbeat, '>', HEARTBEAT) or die $!;
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();

4
applets/compiler_vm/guest/bin/setup-guest
View File

@ -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
View 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;

8
applets/compiler_vm/guest/lib/Languages/_c_base.pm
View File

@ -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";

4
applets/compiler_vm/guest/lib/Languages/_default.pm
View File

@ -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);

1
applets/compiler_vm/guest/lib/Languages/java.pm
View File

@ -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\"");

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

@ -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+//) {

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

@ -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
View 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
View 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

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

@ -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!';
@ -91,13 +93,13 @@ sub preprocess_code {
foreach my $ch (@chars) {
given ($ch) {
when ('\\') {
if($escaped == 0) {
if ($escaped == 0) {
$escaped = 1;
next;
}
}
if($state == NORMAL) {
if ($state == NORMAL) {
when ($_ eq '"' and not $escaped) {
$state = DOUBLE_QUOTED;
}
@ -112,13 +114,13 @@ sub preprocess_code {
}
}
if($state == DOUBLE_QUOTED) {
if ($state == DOUBLE_QUOTED) {
when ($_ eq '"' and not $escaped) {
$state = NORMAL;
}
}
if($state == SINGLE_QUOTED) {
if ($state == SINGLE_QUOTED) {
when ($_ eq "'" and not $escaped) {
$state = NORMAL;
}
@ -151,10 +153,10 @@ sub postprocess_output {
my $boutput = "";
my $active_position = 0;
$self->{output} =~ s/\n$//;
while($self->{output} =~ /(.)/gms) {
while ($self->{output} =~ /(.)/gms) {
my $c = $1;
if($c eq "\b") {
if(--$active_position <= 0) {
if ($c eq "\b") {
if (--$active_position <= 0) {
$active_position = 0;
}
next;
@ -237,19 +239,19 @@ sub show_output {
exit 0;
}
if($self->{channel} =~ m/^#/ and length $output > 22 and open LOG, "< $RealBin/../history/$self->{channel}-$self->{lang}.last-output") {
if ($self->{channel} =~ m/^#/ and length $output > 22 and open LOG, "< $RealBin/../history/$self->{channel}-$self->{lang}.last-output") {
my $last_output;
my $time = <LOG>;
if(gettimeofday - $time > 60 * 4) {
if (gettimeofday - $time > 60 * 4) {
close LOG;
} else {
while(my $line = <LOG>) {
while (my $line = <LOG>) {
$last_output .= $line;
}
close LOG;
if((not $self->{factoid}) and defined $last_output and $last_output eq $output) {
if ((not $self->{factoid}) and defined $last_output and $last_output eq $output) {
print "Same output.\n";
exit 0;
}
@ -279,7 +281,7 @@ sub paste_ixio {
my %post = ('f:1' => $text);
my $response = $ua->post("http://ix.io", \%post);
if(not $response->is_success) {
if (not $response->is_success) {
return "error pasting: " . $response->status_line;
}
@ -306,7 +308,7 @@ sub paste_0x0 {
Content_Type => 'form-data'
);
if(not $response->is_success) {
if (not $response->is_success) {
return "error pasting: " . $response->status_line;
}
@ -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,38 +466,38 @@ 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$/;
if($line =~ /^result:/) {
if ($line =~ /^result:/) {
$line =~ s/^result://;
my $compile_out = decode_json($line);
$result .= "$compile_out->{result}\n";
@ -453,12 +505,12 @@ sub execute {
next;
}
if($got_result) {
if ($got_result) {
$result .= "$line\n";
}
}
close $vm;
close $input;
waitpid($pid, 0) if defined $pid;
$self->{output} = $result;
@ -555,10 +607,10 @@ sub process_interactive_edit {
while ($subcode =~ s/^\s*(-[^ ]+)\s*//) {}
my $copy_code;
if($subcode =~ s/^\s*copy\s+(\S+)\s*//) {
if ($subcode =~ s/^\s*copy\s+(\S+)\s*//) {
my $copy = $1;
if(open LOG, "< $RealBin/../history/$copy-$self->{lang}.hist") {
if (open LOG, "< $RealBin/../history/$copy-$self->{lang}.hist") {
$copy_code = <LOG>;
close LOG;
goto COPY_ERROR if not $copy_code;;
@ -579,12 +631,12 @@ sub process_interactive_edit {
$self->{copy_code} = 1;
}
if($subcode =~ m/^\s*(?:and\s+)?(?:diff|show)\s+(\S+)\s*$/) {
if ($subcode =~ m/^\s*(?:and\s+)?(?:diff|show)\s+(\S+)\s*$/) {
$self->{channel} = $1;
}
if(open LOG, "< $RealBin/../history/$self->{channel}-$self->{lang}.hist") {
while(my $line = <LOG>) {
if (open LOG, "< $RealBin/../history/$self->{channel}-$self->{lang}.hist") {
while (my $line = <LOG>) {
chomp $line;
push @last_code, $line;
}
@ -593,8 +645,8 @@ sub process_interactive_edit {
unshift @last_code, $copy_code if defined $copy_code;
if($subcode =~ m/^\s*(?:and\s+)?show(?:\s+\S+)?\s*$/i) {
if(defined $last_code[0]) {
if ($subcode =~ m/^\s*(?:and\s+)?show(?:\s+\S+)?\s*$/i) {
if (defined $last_code[0]) {
print "$last_code[0]\n";
} else {
print "No recent code to show.\n"
@ -610,9 +662,9 @@ sub process_interactive_edit {
my $got_undo = 0;
my $last_keyword;
while($subcode =~ s/^\s*(and)?\s*undo//) {
while ($subcode =~ s/^\s*(and)?\s*undo//) {
splice @last_code, 0, 1;
if(not defined $last_code[0]) {
if (not defined $last_code[0]) {
print "No more undos remaining.\n";
exit 0;
} else {
@ -622,17 +674,17 @@ sub process_interactive_edit {
}
}
while(1) {
while (1) {
$got_sub = 0;
$subcode =~ s/^\s*and\s+'/and $last_keyword '/ if defined $last_keyword;
if($subcode =~ m/^\s*(?:and\s+)?diff\b/i) {
if ($subcode =~ m/^\s*(?:and\s+)?diff\b/i) {
$got_diff = 1;
last;
}
if($subcode =~ m/^\s*(?:and\s+)?(again|run|paste)\b/i) {
if ($subcode =~ m/^\s*(?:and\s+)?(again|run|paste)\b/i) {
$self->{got_run} = lc $1;
$self->{only_show} = 0;
if ($prevchange) {
@ -643,7 +695,7 @@ sub process_interactive_edit {
}
}
if($subcode =~ m/^\s*(and)?\s*remove \s*([^']+)?\s*'/) {
if ($subcode =~ m/^\s*(and)?\s*remove \s*([^']+)?\s*'/) {
$last_keyword = 'remove';
my $modifier = 'first';
@ -656,7 +708,7 @@ sub process_interactive_edit {
my $text;
if(defined $e) {
if (defined $e) {
$text = $e;
$text =~ s/^'//;
$text =~ s/'$//;
@ -668,7 +720,7 @@ sub process_interactive_edit {
next;
}
if($subcode =~ s/^\s*(and)?\s*prepend '//) {
if ($subcode =~ s/^\s*(and)?\s*prepend '//) {
$last_keyword = 'prepend';
$subcode = "'$subcode";
@ -676,7 +728,7 @@ sub process_interactive_edit {
my $text;
if(defined $e) {
if (defined $e) {
$text = $e;
$text =~ s/^'//;
$text =~ s/'$//;
@ -685,7 +737,7 @@ sub process_interactive_edit {
$got_sub = 1;
$got_changes = 1;
if(not defined $prevchange) {
if (not defined $prevchange) {
print "No recent code to prepend to.\n";
exit 0;
}
@ -700,7 +752,7 @@ sub process_interactive_edit {
next;
}
if($subcode =~ s/^\s*(and)?\s*append '//) {
if ($subcode =~ s/^\s*(and)?\s*append '//) {
$last_keyword = 'append';
$subcode = "'$subcode";
@ -708,7 +760,7 @@ sub process_interactive_edit {
my $text;
if(defined $e) {
if (defined $e) {
$text = $e;
$text =~ s/^'//;
$text =~ s/'$//;
@ -717,7 +769,7 @@ sub process_interactive_edit {
$got_sub = 1;
$got_changes = 1;
if(not defined $prevchange) {
if (not defined $prevchange) {
print "No recent code to append to.\n";
exit 0;
}
@ -732,7 +784,7 @@ sub process_interactive_edit {
next;
}
if($subcode =~ m/^\s*(and)?\s*replace\s*([^']+)?\s*'.*'\s*with\s*'.*?'/i) {
if ($subcode =~ m/^\s*(and)?\s*replace\s*([^']+)?\s*'.*'\s*with\s*'.*?'/i) {
$last_keyword = 'replace';
$got_sub = 1;
my $modifier = 'first';
@ -745,7 +797,7 @@ sub process_interactive_edit {
my ($from, $to);
my ($e, $r) = extract_delimited($subcode, "'");
if(defined $e) {
if (defined $e) {
$from = $e;
$from =~ s/^'//;
$from =~ s/'$//;
@ -760,7 +812,7 @@ sub process_interactive_edit {
($e, $r) = extract_delimited($subcode, "'");
if(defined $e) {
if (defined $e) {
$to = $e;
$to =~ s/^'//;
$to =~ s/'$//;
@ -795,7 +847,7 @@ sub process_interactive_edit {
next;
}
if($subcode =~ m/^\s*(and)?\s*s\/.*\//) {
if ($subcode =~ m/^\s*(and)?\s*s\/.*\//) {
$last_keyword = undef;
$got_sub = 1;
$subcode =~ s/^\s*(and)?\s*s//;
@ -803,7 +855,7 @@ sub process_interactive_edit {
my ($regex, $to);
my ($e, $r) = extract_delimited($subcode, '/');
if(defined $e) {
if (defined $e) {
$regex = $e;
$regex =~ s/^\///;
$regex =~ s/\/$//;
@ -815,7 +867,7 @@ sub process_interactive_edit {
($e, $r) = extract_delimited($subcode, '/');
if(defined $e) {
if (defined $e) {
$to = $e;
$to =~ s/^\///;
$to =~ s/\/$//;
@ -828,11 +880,11 @@ sub process_interactive_edit {
my $suffix;
$suffix = $1 if $subcode =~ s/^([^ ]+)//;
if(length $suffix and $suffix =~ m/[^gi]/) {
if (length $suffix and $suffix =~ m/[^gi]/) {
print "Bad regex modifier '$suffix'. Only 'i' and 'g' are allowed.\n";
exit 0;
}
if(defined $prevchange) {
if (defined $prevchange) {
$code = $prevchange;
} else {
print "No recent code to change.\n";
@ -842,29 +894,29 @@ sub process_interactive_edit {
my $ret = eval {
my ($ret, $a, $b, $c, $d, $e, $f, $g, $h, $i, $before, $after);
if(not length $suffix) {
if (not length $suffix) {
$ret = $code =~ s|$regex|$to|;
($a, $b, $c, $d, $e, $f, $g, $h, $i) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
$before = $`;
$after = $';
} elsif($suffix =~ /^i$/) {
} elsif ($suffix =~ /^i$/) {
$ret = $code =~ s|$regex|$to|i;
($a, $b, $c, $d, $e, $f, $g, $h, $i) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
$before = $`;
$after = $';
} elsif($suffix =~ /^g$/) {
} elsif ($suffix =~ /^g$/) {
$ret = $code =~ s|$regex|$to|g;
($a, $b, $c, $d, $e, $f, $g, $h, $i) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
$before = $`;
$after = $';
} elsif($suffix =~ /^ig$/ or $suffix =~ /^gi$/) {
} elsif ($suffix =~ /^ig$/ or $suffix =~ /^gi$/) {
$ret = $code =~ s|$regex|$to|gi;
($a, $b, $c, $d, $e, $f, $g, $h, $i) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
$before = $`;
$after = $';
}
if($ret) {
if ($ret) {
$code =~ s/\$1/$a/g;
$code =~ s/\$2/$b/g;
$code =~ s/\$3/$c/g;
@ -881,7 +933,7 @@ sub process_interactive_edit {
return $ret;
};
if($@) {
if ($@) {
my $error = $@;
$error =~ s/ at .* line \d+\.\s*$//;
print "$error\n";
@ -916,13 +968,13 @@ sub process_interactive_edit {
my $to = $replacement->{'to'};
my $modifier = $replacement->{'modifier'};
if(defined $previous_from) {
if($previous_from eq $from and $previous_modifier =~ /^\d+$/) {
if (defined $previous_from) {
if ($previous_from eq $from and $previous_modifier =~ /^\d+$/) {
$modifier -= $modifier - $previous_modifier;
}
}
if(defined $prevchange) {
if (defined $prevchange) {
$code = $prevchange;
} else {
print "No recent code to change.\n";
@ -936,45 +988,45 @@ sub process_interactive_edit {
$first_char = $1 if $from =~ m/^(.)/;
$last_char = $1 if $from =~ m/(.)$/;
if($first_char =~ /\W/) {
if ($first_char =~ /\W/) {
$first_bound = '.?';
} else {
$first_bound = '\b';
}
if($last_char =~ /\W/) {
if ($last_char =~ /\W/) {
$last_bound = '.?';
} else {
$last_bound = '\b';
}
if($modifier eq 'all') {
if($code =~ s/($first_bound)$from($last_bound)/$1$to$2/g) {
if ($modifier eq 'all') {
if ($code =~ s/($first_bound)$from($last_bound)/$1$to$2/g) {
$got_change = 1;
}
} elsif($modifier eq 'last') {
if($code =~ s/(.*)($first_bound)$from($last_bound)/$1$2$to$3/) {
} elsif ($modifier eq 'last') {
if ($code =~ s/(.*)($first_bound)$from($last_bound)/$1$2$to$3/) {
$got_change = 1;
}
} else {
my $count = 0;
my $unescaped = $from;
$unescaped =~ s/\\//g;
if($code =~ s/($first_bound)$from($last_bound)/if(++$count == $modifier) { "$1$to$2"; } else { "$1$unescaped$2"; }/ge) {
if ($code =~ s/($first_bound)$from($last_bound)/if (++$count == $modifier) { "$1$to$2"; } else { "$1$unescaped$2"; }/ge) {
$got_change = 1;
}
}
return $got_change;
};
if($@) {
if ($@) {
my $error = $@;
$error =~ s/ at .* line \d+\.\s*$//;
print "$error\n";
exit 0;
}
if($ret) {
if ($ret) {
$got_sub = 1;
$got_changes = 1;
}
@ -984,7 +1036,7 @@ sub process_interactive_edit {
$previous_modifier = $modifier;
}
if(not $got_changes) {
if (not $got_changes) {
print "No replacements made.\n";
exit 0;
}
@ -1003,7 +1055,7 @@ sub process_interactive_edit {
}
unless (($self->{got_run} or $got_diff) and not $got_changes) {
if($unshift_last_code) {
if ($unshift_last_code) {
unshift @last_code, $code;
}
@ -1011,7 +1063,7 @@ sub process_interactive_edit {
my $i = 0;
foreach my $line (@last_code) {
last if(++$i > $self->{max_history});
last if (++$i > $self->{max_history});
print LOG "$line\n";
}
@ -1019,13 +1071,13 @@ sub process_interactive_edit {
}
if ($got_diff) {
if($#last_code < 1) {
if ($#last_code < 1) {
print "Not enough recent code to diff.\n"
} else {
use Text::WordDiff;
my $diff = word_diff(\$last_code[1], \$last_code[0], { STYLE => 'Diff' });
if($diff !~ /(?:<del>|<ins>)/) {
if ($diff !~ /(?:<del>|<ins>)/) {
$diff = "No difference.";
} else {
$diff =~ s/<del>(.*?)(\s+)<\/del>/<del>$1<\/del>$2/g;

97
doc/VirtualMachine.md
View File

@ -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