mirror of https://github.com/pragma-/pbot.git
Start refactoring virtual machine (1/3)
This is expected to take three commits to complete. This first initial commit does the following: - Begin initial rough-draft of doc/VirtualMachine.md - Begin initial refactoring of scripts The next commit will polish up the initial rough-draft and refactoring. The final commit will quality-check everything and fix anything overlooked.
This commit is contained in:
Pragmatic Software
parent
550544a0be
commit
33e13fd993
|
|
@ -1,93 +0,0 @@
|
|||
Installation:
|
||||
|
||||
If you want to run the compiler inside a virtual machine for more security,
|
||||
these scripts are designed to work with qemu 0.11.1. This is required in
|
||||
order to use PBot's trigger.
|
||||
|
||||
In addition, you can use the provided 'cc' script to use your local compiler tools
|
||||
without installing qemu. No PBot installation or configuration is required in this case.
|
||||
|
||||
To use the local non-vm 'cc' script, you will need to have gcc, gdb and astyle installed locally.
|
||||
|
||||
Be aware that you need to single-quote or escape the code if you use the local 'cc' within a shell,
|
||||
e.g.: ./cc $'char s[] = "hello, world"; puts(s); if(s[0] == \'h\') puts("true");'
|
||||
|
||||
WARNING: Using the local 'cc' script outside of the virtual machine will not use qemu at all;
|
||||
it will affect local system -- compile "safe" code!
|
||||
|
||||
Virtual machine installation:
|
||||
|
||||
You will need to download qemu and set up a virtual machine containing a system
|
||||
with a compiler and, optionally, sensible ulimits/fork-preventation/other security.
|
||||
|
||||
1) copy compiler_vm_server.pl and compiler_watchdog.pl to the virtual machine.
|
||||
2) then start up the compiler_vm_server.pl script inside the virtual machine
|
||||
3) then connect to qemu's monitor and issue the 'savevm 1' command to save the virtual state
|
||||
(After compiles, this state will be loaded via 'loadvm 1' to reset everything within the machine
|
||||
for a clean and working environment for subsequent compiles.)
|
||||
|
||||
Now the virtual machine state 1 is saved in a state where it is listening for incoming code. You can
|
||||
go ahead and quit qemu without shutting down the guest operating sytem.
|
||||
|
||||
Starting the virtual machine for PBot:
|
||||
|
||||
Now that the virtual machine is configured and saved, you may launch the local server to listen for
|
||||
code from PBot to send to the virtual machine's server. To do so, run the compiler_server.pl script.
|
||||
|
||||
Dependencies:
|
||||
|
||||
gcc (tested with 4.4.4)
|
||||
gdb (tested with 7.2)
|
||||
astyle (tested with 1.24 -- not working with astyle 2.0)
|
||||
|
||||
Files:
|
||||
|
||||
(Read within each file for configuration instructions.)
|
||||
|
||||
- cc: Allows you to use the compiler locally with or without qemu installed.
|
||||
Can be used within virtual machine for testing.
|
||||
Requires only compiler_vm_client.pl, compiler_vm_server.pl and compiler_watchdog.pl.
|
||||
Must have gcc, gdb and astyle installed locally if not used within virtual machine.
|
||||
WARNING: If not used within virtual machine will not use qemu at all and will
|
||||
affect local system -- compile "safe" code!
|
||||
|
||||
- compiler_client.pl: Main entry point for compiling snippets. Sends over TCP to
|
||||
compiler_server.pl. This file can be run be run from the
|
||||
client machine or anywhere.
|
||||
|
||||
- compiler_server.pl: Responsible for setting up a TCP server to listen for
|
||||
incoming compile requests; and launching and resetting
|
||||
the virtual machine. Sends to compiler_vm_client.pl.
|
||||
Run this file on the server hosting the virtual machine.
|
||||
|
||||
- compiler_vm_client.pl: Responsible for sending snippets to the virtual
|
||||
machine. Also expands/translates and formats
|
||||
snippets into compilable code (with main function and
|
||||
headers), and handles "interactive-editing".
|
||||
Sends over TCP to qemu serial port, waits for result,
|
||||
then sends result back caller (compiler_server.pl).
|
||||
Run this file on the server hosting the virtual machine.
|
||||
|
||||
- compiler_vm_server.pl: Runs on the system inside the virtual machine.
|
||||
This script listens for incoming code snippets over
|
||||
the virtual machine's serial port.
|
||||
Calls compiler_watchdog.pl to monitor its exit signal
|
||||
or exit status, then returns result back over serial
|
||||
port (to compiler_vm_client.pl).
|
||||
|
||||
- compiler_watchdog.pl: Runs a program and watches its exit signals/status.
|
||||
Run within the virtual machine.
|
||||
|
||||
*** The following files are just auxiliary tools to start/connect to qemu, provided
|
||||
for convenience only. Perhaps they will be useful during installation/testing:
|
||||
|
||||
- monitor: Connects to qemu monitor (internal console) over TCP.
|
||||
|
||||
- serial: Connects to qemu serial port over TCP.
|
||||
|
||||
- runqemu: Launches qemu with a visible window, but without networking support.
|
||||
|
||||
- runeqmu.net: Launches qemu with a visible window, and with networking support.
|
||||
You may load a state previously saved with runqemu and reboot it
|
||||
or otherwise reload its networking configuration to gain networking.
|
||||
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
#!/bin/sh
|
||||
# This Source Code Form is subject to the terms of the Mozilla Public
|
||||
# License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
|
||||
CC_LOCAL=1 ./compiler_vm_client.pl c99 compiler compiler "$@"
|
||||
|
|
@ -1,44 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
# compiler_client.pl connects to compiler_server.pl hosted at PeerAddr/PeerPort below
|
||||
# and sends a nick, language and code, then retreives and prints the compilation/execution output.
|
||||
#
|
||||
# this way we can run the compiler virtual machine on any remote server.
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use IO::Socket;
|
||||
use JSON;
|
||||
|
||||
my $sock = IO::Socket::INET->new(
|
||||
PeerAddr => '127.0.0.1',
|
||||
PeerPort => 9000,
|
||||
Proto => 'tcp');
|
||||
|
||||
if(not defined $sock) {
|
||||
print "Fatal error compiling: $!; try again later\n";
|
||||
die $!;
|
||||
}
|
||||
|
||||
my $json = join ' ', @ARGV;
|
||||
my $h = decode_json $json;
|
||||
my $lang = $h->{lang} // "c11";
|
||||
|
||||
if ($h->{code} =~ s/-lang=([^ ]+)//) {
|
||||
$lang = lc $1;
|
||||
}
|
||||
|
||||
$h->{lang} = $lang;
|
||||
$json = encode_json $h;
|
||||
|
||||
print $sock "$json\n";
|
||||
|
||||
while(my $line = <$sock>) {
|
||||
print "$line";
|
||||
}
|
||||
|
||||
close $sock;
|
||||
|
|
@ -1,276 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use IO::Socket;
|
||||
use Net::hostent;
|
||||
use IPC::Shareable;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
|
||||
my $SERVER_PORT = 9000;
|
||||
my $SERIAL_PORT = 3333;
|
||||
my $HEARTBEAT_PORT = 3336;
|
||||
my $DOMAIN_NAME = 'compiler';
|
||||
|
||||
my $COMPILE_TIMEOUT = 10;
|
||||
|
||||
sub server_listen {
|
||||
my $port = shift @_;
|
||||
|
||||
my $server = IO::Socket::INET->new(
|
||||
Proto => 'tcp',
|
||||
LocalPort => $port,
|
||||
Listen => SOMAXCONN,
|
||||
Reuse => 1);
|
||||
|
||||
die "can't setup server: $!" unless $server;
|
||||
|
||||
print "[Server $0 accepting clients]\n";
|
||||
|
||||
return $server;
|
||||
}
|
||||
|
||||
sub vm_stop {
|
||||
system("virsh shutdown $DOMAIN_NAME");
|
||||
}
|
||||
|
||||
sub vm_start {
|
||||
system("virsh start $DOMAIN_NAME");
|
||||
}
|
||||
|
||||
sub vm_reset {
|
||||
return if $ENV{NORESET};
|
||||
#system("virsh detach-disk $DOMAIN_NAME vdb");
|
||||
system("virsh snapshot-revert $DOMAIN_NAME 1");
|
||||
#system("virsh attach-disk $DOMAIN_NAME --source /var/lib/libvirt/images/factdata.qcow2 --target vdb");
|
||||
print "Reset vm\n";
|
||||
}
|
||||
|
||||
sub execute {
|
||||
my ($cmdline) = @_;
|
||||
|
||||
print "execute($cmdline)\n";
|
||||
|
||||
my @list = split / /, $cmdline;
|
||||
|
||||
my ($ret, $result);
|
||||
|
||||
#$SIG{CHLD} = 'IGNORE';
|
||||
|
||||
my $child = fork;
|
||||
|
||||
if($child == 0) {
|
||||
($ret, $result) = eval {
|
||||
my $result = '';
|
||||
|
||||
my $pid = open(my $fh, '-|', @list);
|
||||
|
||||
if (not defined $pid) {
|
||||
print "Couldn't fork: $!\n";
|
||||
return (-13, "[Fatal error]");
|
||||
}
|
||||
|
||||
local $SIG{ALRM} = sub { print "Time out\n"; kill 9, $pid; print "sent KILL to $pid\n"; die "Timed-out: $result\n"; };
|
||||
alarm($COMPILE_TIMEOUT);
|
||||
|
||||
print "Reading...\n";
|
||||
while(my $line = <$fh>) {
|
||||
print "read [$line]\n";
|
||||
$result .= $line;
|
||||
}
|
||||
|
||||
close $fh;
|
||||
print "Done reading.\n";
|
||||
|
||||
my $ret = $? >> 8;
|
||||
alarm 0;
|
||||
|
||||
print "[$ret, $result]\n";
|
||||
return ($ret, $result);
|
||||
};
|
||||
|
||||
alarm 0;
|
||||
if($@ =~ /Timed-out: (.*)/) {
|
||||
return (-13, "[Timed-out] $1");
|
||||
}
|
||||
|
||||
return ($ret, $result);
|
||||
} else {
|
||||
waitpid($child, 0);
|
||||
print "?: $?\n";
|
||||
my $result = $? >> 8;
|
||||
print "child exited, parent continuing [result = $result]\n";
|
||||
return (undef, $result);
|
||||
}
|
||||
}
|
||||
|
||||
sub compiler_server {
|
||||
my ($server, $heartbeat_pid, $heartbeat_monitor);
|
||||
|
||||
my $heartbeat;
|
||||
my $running;
|
||||
|
||||
tie $heartbeat, 'IPC::Shareable', 'dat1', { create => 1 };
|
||||
tie $running, 'IPC::Shareable', 'dat2', { create => 1 };
|
||||
|
||||
my $last_wait = 0;
|
||||
|
||||
while(1) {
|
||||
$running = 1;
|
||||
$heartbeat = 0;
|
||||
|
||||
vm_reset;
|
||||
print "vm started\n";
|
||||
|
||||
$heartbeat_pid = fork;
|
||||
die "Fork failed: $!" if not defined $heartbeat_pid;
|
||||
|
||||
if($heartbeat_pid == 0) {
|
||||
tie $heartbeat, 'IPC::Shareable', 'dat1', { create => 1 };
|
||||
tie $running, 'IPC::Shareable', 'dat2', { create => 1 };
|
||||
|
||||
$heartbeat_monitor = undef;
|
||||
my $attempts = 0;
|
||||
while((not $heartbeat_monitor) and $attempts < 5) {
|
||||
print "Connecting to heartbeat ...";
|
||||
$heartbeat_monitor = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $HEARTBEAT_PORT, Proto => 'tcp', Type => SOCK_STREAM);
|
||||
if(not $heartbeat_monitor) {
|
||||
print " failed.\n";
|
||||
++$attempts;
|
||||
sleep 2;
|
||||
} else {
|
||||
print " success!\n";
|
||||
}
|
||||
}
|
||||
|
||||
if ($attempts >= 5) {
|
||||
print "heart not beating... restarting\n";
|
||||
$heartbeat = -1;
|
||||
sleep 5;
|
||||
next;
|
||||
}
|
||||
|
||||
print "child: running: $running\n";
|
||||
|
||||
while($running and <$heartbeat_monitor>) {
|
||||
$heartbeat = 1;
|
||||
#print "child: got heartbeat\n";
|
||||
}
|
||||
|
||||
print "child no longer running\n";
|
||||
exit;
|
||||
} else {
|
||||
|
||||
while ($heartbeat <= 0) {
|
||||
if ($heartbeat == -1) {
|
||||
print "heartbeat died\n";
|
||||
last;
|
||||
}
|
||||
print "sleeping for heartbeat...\n";
|
||||
sleep 1;
|
||||
}
|
||||
|
||||
if ($heartbeat == -1) {
|
||||
print "fucking dead, restarting\n";
|
||||
waitpid $heartbeat_pid, 0;
|
||||
#vm_stop;
|
||||
next;
|
||||
}
|
||||
|
||||
print "K, got heartbeat, here we go...\n";
|
||||
|
||||
if(not defined $server) {
|
||||
print "Starting compiler server on port $SERVER_PORT\n";
|
||||
$server = server_listen($SERVER_PORT);
|
||||
} else {
|
||||
print "Compiler server already listening on port $SERVER_PORT\n";
|
||||
}
|
||||
|
||||
print "parent: running: $running\n";
|
||||
|
||||
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;
|
||||
my $timed_out = 0;
|
||||
my $killed = 0;
|
||||
|
||||
eval {
|
||||
local $SIG{ALRM} = sub { die 'Timed-out'; };
|
||||
alarm 5;
|
||||
|
||||
while (my $line = <$client>) {
|
||||
$line =~ s/[\r\n]+$//;
|
||||
next if $line =~ m/^\s*$/;
|
||||
alarm 5;
|
||||
print "got: [$line]\n";
|
||||
|
||||
if($heartbeat <= 0) {
|
||||
print "No heartbeat yet, ignoring compile attempt.\n";
|
||||
print $client "Recovering from previous snippet, please wait.\n" if gettimeofday - $last_wait > 60;
|
||||
$last_wait = gettimeofday;
|
||||
last;
|
||||
}
|
||||
|
||||
print "Attempting compile...\n";
|
||||
alarm 0;
|
||||
|
||||
my ($ret, $result) = execute("perl compiler_vm_client.pl $line");
|
||||
|
||||
if(not defined $ret) {
|
||||
#print "parent continued\n";
|
||||
print "parent continued [$result]\n";
|
||||
$timed_out = 1 if $result == 243 or $result == -13; # -13 == 243
|
||||
$killed = 1 if $result == 242 or $result == -14; # -14 = 242
|
||||
last;
|
||||
}
|
||||
|
||||
$result =~ s/\s+$//;
|
||||
print "Ret: $ret; result: [$result]\n";
|
||||
|
||||
if($result =~ m/\[Killed\]$/) {
|
||||
print "Process was killed\n";
|
||||
$killed = 1;
|
||||
}
|
||||
|
||||
print $client $result . "\n";
|
||||
close $client;
|
||||
|
||||
$ret = -14 if $killed;
|
||||
|
||||
# child exit
|
||||
print "child exit\n";
|
||||
exit $ret;
|
||||
}
|
||||
|
||||
alarm 0;
|
||||
};
|
||||
|
||||
alarm 0;
|
||||
|
||||
close $client;
|
||||
|
||||
print "timed out: $timed_out; killed: $killed\n";
|
||||
next unless ($timed_out or $killed);
|
||||
|
||||
vm_reset;
|
||||
next;
|
||||
|
||||
print "stopping vm\n";
|
||||
#vm_stop;
|
||||
$running = 0;
|
||||
last;
|
||||
}
|
||||
print "Compiler server no longer running, restarting...\n";
|
||||
}
|
||||
print "waiting on heartbeat pid?\n";
|
||||
waitpid($heartbeat_pid, 0);
|
||||
}
|
||||
}
|
||||
|
||||
compiler_server;
|
||||
|
|
@ -1,62 +0,0 @@
|
|||
#!/usr/bin/env perl
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Proc::ProcessTable;
|
||||
use IO::Socket;
|
||||
|
||||
my $SLEEP = 15;
|
||||
my $MAX_PCTCPU = 25;
|
||||
my $QEMU = 'qemu-system-x86';
|
||||
my $MONITOR_PORT = 3335;
|
||||
|
||||
my $last_pctcpu = 0;
|
||||
|
||||
sub reset_vm {
|
||||
print "Resetting vm\n";
|
||||
|
||||
my $sock = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $MONITOR_PORT, Prot => 'tcp');
|
||||
if(not defined $sock) {
|
||||
print "[vm_reset] Unable to connect to monitor: $!\n";
|
||||
return;
|
||||
}
|
||||
|
||||
print $sock "loadvm 1\n";
|
||||
close $sock;
|
||||
|
||||
print "Reset vm\n";
|
||||
}
|
||||
|
||||
while (1) {
|
||||
my $t = new Proc::ProcessTable(enable_ttys => 0);
|
||||
|
||||
my ($pids, $p);
|
||||
|
||||
foreach $p (@{$t->table}) {
|
||||
$pids->{$p->pid} = { fname => $p->fname, ppid => $p->ppid };
|
||||
}
|
||||
|
||||
foreach $p (keys %$pids) {
|
||||
if ($pids->{$p}->{fname} eq $QEMU) {
|
||||
my $ppid = $pids->{$p}->{ppid};
|
||||
if ($pids->{$ppid}->{fname} eq 'compiler_server') {
|
||||
my $pctcpu = `top -b -n 1 -p $p | tail -n 1 | awk '{print \$9}'`;
|
||||
$pctcpu =~ s/^\s+|\s+$//g;
|
||||
print scalar localtime, " :: Got compiler qemu pid: $p; using $pctcpu cpu\n" if $pctcpu > 0;
|
||||
|
||||
if ($pctcpu >= $last_pctcpu and $last_pctcpu >= $MAX_PCTCPU) {
|
||||
reset_vm;
|
||||
$last_pctcpu = 0;
|
||||
} else {
|
||||
$last_pctcpu = $pctcpu;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sleep $SLEEP;
|
||||
}
|
||||
|
|
@ -1,73 +0,0 @@
|
|||
#!/usr/bin/env perl
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use File::Basename;
|
||||
use JSON;
|
||||
|
||||
use lib '.';
|
||||
|
||||
my $json = join ' ', @ARGV;
|
||||
my $h = decode_json $json;
|
||||
|
||||
my $language = lc $h->{lang};
|
||||
|
||||
eval {
|
||||
use lib 'languages';
|
||||
require "$language.pm";
|
||||
} or do {
|
||||
my @modules = glob 'languages/*.pm';
|
||||
my $found = 0;
|
||||
my ($languages, $comma) = ('', '');
|
||||
|
||||
foreach my $module (sort @modules) {
|
||||
$module = basename $module;
|
||||
$module =~ s/.pm$//;
|
||||
next if $module =~ m/^_/;
|
||||
|
||||
require "$module.pm" or die $!;
|
||||
my $mod = $module->new;
|
||||
|
||||
|
||||
if (exists $mod->{name} and $mod->{name} eq $language) {
|
||||
$language = $module;
|
||||
$found = 1;
|
||||
last;
|
||||
}
|
||||
|
||||
$module = $mod->{name} if exists $mod->{name};
|
||||
$languages .= "$comma$module";
|
||||
$comma = ', ';
|
||||
}
|
||||
|
||||
if (not $found) {
|
||||
print "Language '$language' is not supported.\nSupported languages are: $languages\n";
|
||||
exit;
|
||||
}
|
||||
};
|
||||
|
||||
if (not length $h->{code}) {
|
||||
if (exists $h->{usage}) {
|
||||
print "$h->{usage}\n";
|
||||
} else {
|
||||
print "Usage: cc [-lang=<language>] [-info] [-paste] [-args \"command-line arguments\"] [compiler/language options] <code> [-stdin <stdin input>]\n";
|
||||
}
|
||||
exit;
|
||||
}
|
||||
|
||||
my $lang = $language->new(%{$h});
|
||||
|
||||
$lang->{local} = $ENV{CC_LOCAL};
|
||||
|
||||
$lang->process_interactive_edit;
|
||||
$lang->process_standard_options;
|
||||
$lang->process_custom_options;
|
||||
$lang->process_cmdline_options;
|
||||
$lang->preprocess_code;
|
||||
$lang->execute;
|
||||
$lang->postprocess_output;
|
||||
$lang->show_output;
|
||||
|
|
@ -1,212 +0,0 @@
|
|||
#!/usr/bin/env perl
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use English;
|
||||
use File::Basename;
|
||||
use JSON;
|
||||
|
||||
my $USERNAME = 'compiler';
|
||||
my $USE_LOCAL = defined $ENV{'CC_LOCAL'};
|
||||
|
||||
use constant MOD_DIR => '/usr/local/share/compiler_vm/languages';
|
||||
|
||||
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 defined $USE_LOCAL or $USE_LOCAL == 0) {
|
||||
open($input, '<', "/dev/ttyS0") or die $!;
|
||||
open($output, '>', "/dev/ttyS0") or die $!;
|
||||
open($heartbeat, '>', "/dev/ttyS1") or die $!;
|
||||
} else {
|
||||
open($input, '<', "/dev/stdin") or die $!;
|
||||
open($output, '>', "/dev/stdout") 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 $length = 4096;
|
||||
my $line;
|
||||
my $total_read = 0;
|
||||
|
||||
while (1) {
|
||||
print "Waiting for input...\n";
|
||||
my $ret = sysread($input, my $buf, $length);
|
||||
|
||||
if (not defined $ret) {
|
||||
print "Error reading: $!\n";
|
||||
next;
|
||||
}
|
||||
|
||||
$total_read += $ret;
|
||||
|
||||
if ($ret == 0) {
|
||||
print "input ded?\n";
|
||||
print "got buffer [$buffer]\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
chomp $buf;
|
||||
print "read $ret bytes [$total_read so far] [$buf]\n";
|
||||
$buffer.= $buf;
|
||||
|
||||
if ($buffer =~ s/\s*:end:\s*$//m) {
|
||||
$line = $buffer;
|
||||
$buffer = "";
|
||||
$total_read = 0;
|
||||
} else {
|
||||
next;
|
||||
}
|
||||
|
||||
chomp $line;
|
||||
|
||||
print "-" x 40, "\n";
|
||||
print "Got [$line]\n";
|
||||
|
||||
my $compile_in = decode_json($line);
|
||||
|
||||
$compile_in->{arguments} //= '';
|
||||
$compile_in->{input} //= '';
|
||||
|
||||
print "Attempting compile [$compile_in->{lang}] ...\n";
|
||||
|
||||
use Data::Dumper;
|
||||
print Dumper $compile_in;
|
||||
|
||||
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/compiler/$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/compiler/$compile_in->{'persist-key'}\"");
|
||||
}
|
||||
|
||||
system("chmod -R 755 /home/compiler");
|
||||
system("chown -R compiler /home/compiler");
|
||||
system("chgrp -R compiler /home/compiler");
|
||||
system("rm -rf /home/compiler/prog*");
|
||||
system("pkill -u compiler");
|
||||
|
||||
$ENV{USER} = $USERNAME;
|
||||
$ENV{LOGNAME} = $USERNAME;
|
||||
$ENV{HOME} = $home;
|
||||
|
||||
$GID = $gid;
|
||||
$EGID = "$gid $gid";
|
||||
$EUID = $UID = $uid;
|
||||
|
||||
my $result = interpret(%$compile_in);
|
||||
|
||||
my $compile_out = { result => $result };
|
||||
my $json = encode_json($compile_out);
|
||||
|
||||
print "Done compiling; result: [$result] [$json]\n";
|
||||
print $output "result:$json\n";
|
||||
print $output "result:end\n";
|
||||
|
||||
$( = 0;
|
||||
$< = 0;
|
||||
|
||||
if ($compile_in->{'persist-key'}) {
|
||||
system("id");
|
||||
system("cp -R -p \"/home/compiler/$compile_in->{'persist-key'}\" \"/root/factdata/$compile_in->{'persist-key'}\"");
|
||||
system("umount /root/factdata");
|
||||
system ("rm -rf \"/home/compiler/$compile_in->{'persist-key'}\"");
|
||||
}
|
||||
|
||||
exit;
|
||||
} else {
|
||||
waitpid $pid, 0;
|
||||
}
|
||||
|
||||
if(not defined $USE_LOCAL or $USE_LOCAL == 0) {
|
||||
print "=" x 40, "\n";
|
||||
print "input: ";
|
||||
next;
|
||||
} else {
|
||||
exit;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
while(1) {
|
||||
print $heartbeat "\n";
|
||||
sleep 1;
|
||||
}
|
||||
}
|
||||
|
||||
close $input;
|
||||
close $output;
|
||||
close $heartbeat;
|
||||
}
|
||||
|
||||
sub interpret {
|
||||
my %h = @_;
|
||||
|
||||
$h{lang} = '_default' if not exists $languages{$h{lang}};
|
||||
|
||||
chdir("/home/compiler");
|
||||
|
||||
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;
|
||||
|
|
@ -3,9 +3,18 @@
|
|||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
# This script was thrown together quickly and sloppily. It will be
|
||||
# rewritten "soon".
|
||||
|
||||
no warnings;
|
||||
use strict;
|
||||
|
||||
my $cmdlineargs = '';
|
||||
foreach my $arg (@ARGV) {
|
||||
$arg =~ s/'/'"'"'/g;
|
||||
$cmdlineargs .= "'$arg' ";
|
||||
}
|
||||
|
||||
use IPC::Open2;
|
||||
|
||||
my $debug = $ENV{DEBUG} // 0;
|
||||
|
|
@ -26,12 +35,6 @@ my ($main_start, $main_end);
|
|||
sub flushall;
|
||||
sub gdb;
|
||||
|
||||
my $cmdlineargs = '';
|
||||
foreach my $arg (@ARGV) {
|
||||
$arg =~ s/'/'"'"'/g;
|
||||
$cmdlineargs .= "'$arg' ";
|
||||
}
|
||||
|
||||
my ($out, $in);
|
||||
|
||||
sub getlocals {
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
cp guest/bin/* /usr/local/bin
|
||||
mkdir /usr/local/share/pbot-vm/
|
||||
cp -r guest/lib/Languages/ /usr/local/share/pbot-vm/
|
||||
cp guest/include/prelude.h /usr/include
|
||||
|
||||
echo unset DEBUGINFOD_URLS >> /root/.bashrc
|
||||
echo export ASAN_OPTIONS=detect_leaks=0 >> /root/.bashrc
|
||||
|
||||
echo PBot Guest VM is now set up. For changes to take effect, run this command now: source /root/.bashrc
|
||||
|
|
@ -0,0 +1,226 @@
|
|||
#!/usr/bin/env perl
|
||||
|
||||
# This Source Code Form is subject to the terms of the Mozilla Public
|
||||
# License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use English;
|
||||
use Encode;
|
||||
use File::Basename;
|
||||
use JSON::XS;
|
||||
|
||||
my $USERNAME = 'vm'; # variable for easier string interpolation
|
||||
|
||||
use constant MOD_DIR => '/usr/local/share/pbot-vm/Languages';
|
||||
use constant SERIAL => '/dev/ttyS1';
|
||||
use constant HEARTBEAT => '/dev/ttyS2';
|
||||
use constant STDIN => '/dev/stdin';
|
||||
use constant STDOUT => '/dev/stdout';
|
||||
|
||||
use lib MOD_DIR;
|
||||
|
||||
my %languages;
|
||||
|
||||
my $USE_LOCAL = $ENV{'CC_LOCAL'};
|
||||
|
||||
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 defined $USE_LOCAL or $USE_LOCAL == 0) {
|
||||
# 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, '<', STDIN) or die $!;
|
||||
open($output, '>', STDOUT) 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 $length = 4096;
|
||||
my $line;
|
||||
my $total_read = 0;
|
||||
|
||||
while (1) {
|
||||
print "Waiting for input...\n";
|
||||
my $ret = sysread($input, my $buf, $length);
|
||||
|
||||
if (not defined $ret) {
|
||||
print "Error reading: $!\n";
|
||||
next;
|
||||
}
|
||||
|
||||
$total_read += $ret;
|
||||
|
||||
if ($ret == 0) {
|
||||
print "input ded?\n";
|
||||
print "got buffer [$buffer]\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
chomp $buf;
|
||||
print "read $ret bytes [$total_read so far] [$buf]\n";
|
||||
$buffer.= $buf;
|
||||
|
||||
if ($buffer =~ s/\s*:end:\s*$//m) {
|
||||
$line = $buffer;
|
||||
$buffer = "";
|
||||
$total_read = 0;
|
||||
} else {
|
||||
next;
|
||||
}
|
||||
|
||||
chomp $line;
|
||||
|
||||
print "-" x 40, "\n";
|
||||
print "Got [$line]\n";
|
||||
|
||||
$line = encode('UTF-8', $line);
|
||||
my $compile_in = decode_json($line);
|
||||
|
||||
$compile_in->{arguments} //= '';
|
||||
$compile_in->{input} //= '';
|
||||
|
||||
print "Attempting compile [$compile_in->{lang}] ...\n";
|
||||
|
||||
use Data::Dumper;
|
||||
print Dumper $compile_in;
|
||||
|
||||
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");
|
||||
|
||||
$ENV{USER} = $USERNAME;
|
||||
$ENV{LOGNAME} = $USERNAME;
|
||||
$ENV{HOME} = $home;
|
||||
|
||||
$GID = $gid;
|
||||
$EGID = "$gid $gid";
|
||||
$EUID = $UID = $uid;
|
||||
|
||||
my $result = interpret(%$compile_in);
|
||||
|
||||
my $compile_out = { result => $result };
|
||||
my $json = encode_json($compile_out);
|
||||
|
||||
print "Done compiling; result: [$result] [$json]\n";
|
||||
print $output "result:$json\n";
|
||||
print $output "result:end\n";
|
||||
|
||||
$( = 0;
|
||||
$< = 0;
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
if(not defined $USE_LOCAL or $USE_LOCAL == 0) {
|
||||
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}};
|
||||
|
||||
chdir("/home/$USERNAME");
|
||||
|
||||
my $mod = $h{lang}->new(%h);
|
||||
|
||||
$mod->preprocess;
|
||||
|
||||
print "after preprocess: ", Dumper $mod, "\n";
|
||||
|
||||
$mod->postprocess if not $mod->{error} and not $mod->{done};
|
||||
|
||||
print "after postprocess: ", Dumper $mod, "\n";
|
||||
|
||||
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;
|
||||
|
|
@ -86,7 +86,7 @@ sub postprocess {
|
|||
# ASAN_OPTIONS=strict_string_checks=1:detect_stack_use_after_return=1:check_initialization_order=1:strict_init_order=1
|
||||
($exitval, $stdout, $stderr) = $self->execute(60, undef, './prog', @args);
|
||||
} else {
|
||||
($exitval, $stdout, $stderr) = $self->execute(60, undef, 'compiler_watchdog.pl', @args);
|
||||
($exitval, $stdout, $stderr) = $self->execute(60, undef, 'guest-gdb', @args);
|
||||
}
|
||||
|
||||
my $result = $stderr;
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
#!/usr/bin/env perl
|
||||
|
||||
# File: vm-client
|
||||
#
|
||||
# Purpose: Interfaces with the PBot virtual machine server hosted at
|
||||
# PeerAddr/PeerPort defined below. This allows us to host instances of
|
||||
# virtual machines on remote servers.
|
||||
#
|
||||
# This script is intended to be installed to PBot's applets directory
|
||||
# and attached to a PBot command such as `cc`.
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
# TODO: extend to take a list of server/ports to cycle for load-balancing
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use IO::Socket;
|
||||
|
||||
my $sock = IO::Socket::INET->new(
|
||||
PeerAddr => '127.0.0.1',
|
||||
PeerPort => 9000,
|
||||
Proto => 'tcp',
|
||||
);
|
||||
|
||||
if (not defined $sock) {
|
||||
print "Fatal error compiling: $!; try again later\n";
|
||||
die $!;
|
||||
}
|
||||
|
||||
my $nick = shift @ARGV;
|
||||
my $channel = shift @ARGV;
|
||||
my $code = join '', @ARGV;
|
||||
|
||||
my $lang = "c11";
|
||||
|
||||
if ($code =~ s/-lang=([^ ]+)//) {
|
||||
$lang = lc $1;
|
||||
}
|
||||
|
||||
print $sock "compile:$nick:$channel:$lang\n";
|
||||
print $sock "$code\n";
|
||||
print $sock "compile:end\n";
|
||||
|
||||
while (my $line = <$sock>) {
|
||||
print "$line";
|
||||
}
|
||||
|
||||
close $sock;
|
||||
|
|
@ -0,0 +1,103 @@
|
|||
#!/usr/bin/env perl
|
||||
|
||||
# File: vm-exec
|
||||
#
|
||||
# Purpose: Process and send commands to the PBot virtual machine on the
|
||||
# default TCP port (5555). Use the PBOT_VM_PORT environment variable to
|
||||
# override the port. E.g., to use port 6666 instead:
|
||||
#
|
||||
# $ PBOT_VM_PORT=6666 vm-exec -lang=sh echo test
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use File::Basename;
|
||||
use JSON::XS;
|
||||
|
||||
use FindBin qw($RealBin);
|
||||
use lib "$RealBin/../lib";
|
||||
|
||||
my $json = join ' ', @ARGV;
|
||||
|
||||
my $args = eval { decode_json $json };
|
||||
|
||||
if ($@) {
|
||||
# wasn't JSON; make structure manually
|
||||
if ($json =~ s/^-lang=([^ ]+)//) {
|
||||
$args = { lang => $1, code => $json };
|
||||
} else {
|
||||
$args = { code => $json };
|
||||
}
|
||||
}
|
||||
|
||||
if (not exists $args->{code}) {
|
||||
die "Missing `code` field. Usage: $0 {'code':'<code>'}\n";
|
||||
}
|
||||
|
||||
# set any missing fields to default values
|
||||
$args->{nick} //= 'vm';
|
||||
$args->{channel} //= 'vm';
|
||||
$args->{lang} //= 'c11';
|
||||
|
||||
# override vm-port with environment variable
|
||||
if ($ENV{PBOT_VM_PORT}) {
|
||||
$args->{'vm-port'} = $ENV{PBOT_VM_PORT};
|
||||
}
|
||||
|
||||
my $language = lc $args->{lang};
|
||||
|
||||
eval {
|
||||
require "Languages/$language.pm";
|
||||
} or do {
|
||||
my $found = 0;
|
||||
my ($languages, $comma) = ('', '');
|
||||
|
||||
foreach my $module (sort glob "$RealBin/../lib/Languages/*.pm") {
|
||||
$module = basename $module;
|
||||
$module =~ s/.pm$//;
|
||||
next if $module =~ m/^_/;
|
||||
|
||||
require "Languages/$module.pm" or die $!;
|
||||
my $mod = "Languages::$module"->new;
|
||||
|
||||
if (exists $mod->{name} and $mod->{name} eq $language) {
|
||||
$language = $module;
|
||||
$found = 1;
|
||||
last;
|
||||
}
|
||||
|
||||
$module = $mod->{name} if exists $mod->{name};
|
||||
$languages .= "$comma$module";
|
||||
$comma = ', ';
|
||||
}
|
||||
|
||||
if (not $found) {
|
||||
print "Language '$language' is not supported.\nSupported languages are: $languages\n";
|
||||
exit;
|
||||
}
|
||||
};
|
||||
|
||||
if (not length $args->{code}) {
|
||||
if (exists $args->{usage}) {
|
||||
print "$args->{usage}\n";
|
||||
} else {
|
||||
print "Usage: cc [-lang=<language>] [-info] [-paste] [-args \"command-line arguments\"] [compiler/language options] <code> [-stdin <stdin input>]\n";
|
||||
}
|
||||
exit;
|
||||
}
|
||||
|
||||
my $lang = "Languages::$language"->new(%{$args});
|
||||
|
||||
$lang->{local} = $ENV{CC_LOCAL};
|
||||
|
||||
$lang->process_interactive_edit;
|
||||
$lang->process_standard_options;
|
||||
$lang->process_custom_options;
|
||||
$lang->process_cmdline_options;
|
||||
$lang->preprocess_code;
|
||||
$lang->execute;
|
||||
$lang->postprocess_output;
|
||||
$lang->show_output;
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
#!/usr/bin/env perl
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Proc::ProcessTable;
|
||||
use IO::Socket;
|
||||
|
||||
my $SLEEP = 15;
|
||||
my $MAX_PCTCPU = 25;
|
||||
my $QEMU = 'qemu-system-x86';
|
||||
my $DOMAIN = 'pbot-vm';
|
||||
|
||||
my $last_pctcpu = 0;
|
||||
|
||||
sub reset_vm {
|
||||
print "Resetting vm\n";
|
||||
system("virsh snapshot-revert $DOMAIN 1");
|
||||
print "Reset vm\n";
|
||||
}
|
||||
|
||||
while (1) {
|
||||
my $t = Proc::ProcessTable->new(enable_ttys => 0);
|
||||
|
||||
foreach my $p (@{$t->table}) {
|
||||
if ($p->fname eq $QEMU and $p->cmndline =~ m/guest=\Q$DOMAIN\E/) {
|
||||
# $p->pctcpu never updates? so we use top instead.
|
||||
my $pctcpu = `top -b -n 1 -p $p->{pid} | tail -n 1 | awk '{print \$9}'`;
|
||||
$pctcpu =~ s/^\s+|\s+$//g;
|
||||
print scalar localtime, " :: Got $DOMAIN qemu pid: $p; using $pctcpu cpu\n" if $pctcpu > 0;
|
||||
|
||||
if ($pctcpu >= $last_pctcpu and $last_pctcpu >= $MAX_PCTCPU) {
|
||||
reset_vm;
|
||||
$last_pctcpu = 0;
|
||||
} else {
|
||||
$last_pctcpu = $pctcpu;
|
||||
}
|
||||
}
|
||||
}
|
||||
sleep $SLEEP;
|
||||
}
|
||||
|
|
@ -0,0 +1,277 @@
|
|||
#!/usr/bin/env perl
|
||||
|
||||
# File: compiler_server.pl
|
||||
#
|
||||
# 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.
|
||||
#
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use IO::Socket;
|
||||
use Net::hostent;
|
||||
use IPC::Shareable;
|
||||
use Time::HiRes qw/gettimeofday/;
|
||||
use Encode;
|
||||
|
||||
my $SERVER_PORT = 9000;
|
||||
my $SERIAL_PORT = 5555;
|
||||
my $HEARTBEAT_PORT = 5556;
|
||||
my $DOMAIN_NAME = 'pbot-vm';
|
||||
|
||||
my $COMPILE_TIMEOUT = 15;
|
||||
|
||||
sub vm_stop {
|
||||
system("virsh shutdown $DOMAIN_NAME");
|
||||
}
|
||||
|
||||
sub vm_start {
|
||||
system("virsh start $DOMAIN_NAME");
|
||||
}
|
||||
|
||||
sub vm_reset {
|
||||
return if $ENV{NORESET};
|
||||
#system("virsh detach-disk $DOMAIN_NAME vdb");
|
||||
system("virsh snapshot-revert $DOMAIN_NAME 1");
|
||||
#system("virsh attach-disk $DOMAIN_NAME --source /var/lib/libvirt/images/factdata.qcow2 --target vdb");
|
||||
print "Reset vm\n";
|
||||
}
|
||||
|
||||
sub execute {
|
||||
my ($cmdline) = @_;
|
||||
|
||||
print "execute($cmdline)\n";
|
||||
|
||||
my @list = split / /, $cmdline;
|
||||
|
||||
my ($ret, $result);
|
||||
|
||||
my $child = fork;
|
||||
|
||||
if($child == 0) {
|
||||
($ret, $result) = eval {
|
||||
my $result = '';
|
||||
|
||||
my $pid = open(my $fh, '-|', @list);
|
||||
|
||||
if (not defined $pid) {
|
||||
print "Couldn't fork: $!\n";
|
||||
return (-13, "[Fatal error]");
|
||||
}
|
||||
|
||||
local $SIG{ALRM} = sub { kill 9, $pid; die "Timed-out: $result\n"; };
|
||||
alarm($COMPILE_TIMEOUT);
|
||||
|
||||
print "Reading result...\n";
|
||||
while (my $line = <$fh>) {
|
||||
print "read result [$line]\n";
|
||||
$result .= $line;
|
||||
}
|
||||
|
||||
close $fh;
|
||||
print "Done reading result.\n";
|
||||
|
||||
my $ret = $? >> 8;
|
||||
|
||||
print "[$ret, $result]\n";
|
||||
return ($ret, $result);
|
||||
};
|
||||
|
||||
alarm 0;
|
||||
if ($@ =~ /Timed-out: (.*)/) {
|
||||
return (-13, "[Timed-out] $1");
|
||||
}
|
||||
|
||||
return ($ret, $result);
|
||||
} else {
|
||||
waitpid($child, 0);
|
||||
print "?: $?\n";
|
||||
my $result = $? >> 8;
|
||||
print "child exited, parent continuing [result = $result]\n";
|
||||
return (undef, $result);
|
||||
}
|
||||
}
|
||||
|
||||
sub connect_to_heartbeat {
|
||||
my $heartbeat;
|
||||
my $attempts = 15;
|
||||
|
||||
while (!$heartbeat && $attempts > 0) {
|
||||
print "Connecting to heartbeat ... ";
|
||||
|
||||
$heartbeat = IO::Socket::INET->new (
|
||||
PeerAddr => '127.0.0.1',
|
||||
PeerPort => $HEARTBEAT_PORT,
|
||||
Proto => 'tcp',
|
||||
Type => SOCK_STREAM,
|
||||
);
|
||||
|
||||
if (!$heartbeat) {
|
||||
print "failed.\n";
|
||||
--$attempts;
|
||||
print "Trying again in 2 seconds ($attempts attempts remaining) ...\n" if $attempts > 0;
|
||||
sleep 2;
|
||||
} else {
|
||||
print "success!\n";
|
||||
}
|
||||
}
|
||||
|
||||
return $heartbeat;
|
||||
}
|
||||
|
||||
sub server_listen {
|
||||
my $port = shift @_;
|
||||
my $server = IO::Socket::INET->new (
|
||||
Proto => 'tcp',
|
||||
LocalPort => $port,
|
||||
Listen => SOMAXCONN,
|
||||
ReuseAddr => 1,
|
||||
Reuse => 1,
|
||||
);
|
||||
die "Can't setup server: $!" unless $server;
|
||||
print "[Server $0 accepting clients at :$port]\n";
|
||||
return $server;
|
||||
}
|
||||
|
||||
sub vm_server {
|
||||
my ($server, $heartbeat_pid, $heartbeat_monitor);
|
||||
|
||||
my $heartbeat;
|
||||
my $running;
|
||||
|
||||
tie $heartbeat, 'IPC::Shareable', 'dat1', { create => 1 };
|
||||
tie $running, 'IPC::Shareable', 'dat2', { create => 1 };
|
||||
|
||||
my $last_wait = 0;
|
||||
|
||||
$running = 1;
|
||||
$heartbeat = 0;
|
||||
|
||||
vm_reset;
|
||||
print "vm started\n";
|
||||
|
||||
$heartbeat_pid = fork;
|
||||
die "Fork failed: $!" if not defined $heartbeat_pid;
|
||||
|
||||
if ($heartbeat_pid == 0) {
|
||||
# heartbeat
|
||||
|
||||
tie $heartbeat, 'IPC::Shareable', 'dat1', { create => 1 };
|
||||
tie $running, 'IPC::Shareable', 'dat2', { create => 1 };
|
||||
|
||||
if (!($heartbeat_monitor = connect_to_heartbeat)) {
|
||||
die "Could not start heartbeat.\n";
|
||||
}
|
||||
|
||||
print "child: running: $running\n";
|
||||
|
||||
while($running and <$heartbeat_monitor>) {
|
||||
$heartbeat = 1;
|
||||
#print "child: got heartbeat\n";
|
||||
}
|
||||
|
||||
$heartbeat = -1;
|
||||
print "child no longer running\n";
|
||||
|
||||
exit;
|
||||
|
||||
} else {
|
||||
# server
|
||||
|
||||
if (not defined $server) {
|
||||
print "Starting compiler server on port $SERVER_PORT\n";
|
||||
$server = server_listen($SERVER_PORT);
|
||||
} else {
|
||||
print "Compiler server already listening on port $SERVER_PORT\n";
|
||||
}
|
||||
|
||||
print "parent: running: $running\n";
|
||||
|
||||
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;
|
||||
|
||||
my ($timed_out, $killed);
|
||||
|
||||
eval {
|
||||
local $SIG{ALRM} = sub { die 'Timed-out'; };
|
||||
alarm 5;
|
||||
|
||||
while (my $line = <$client>) {
|
||||
$line =~ s/[\r\n]+$//;
|
||||
next if $line =~ m/^\s*$/;
|
||||
alarm 5;
|
||||
print "got: [$line]\n";
|
||||
|
||||
if($heartbeat <= 0) {
|
||||
print "No heartbeat yet, ignoring compile attempt.\n";
|
||||
print $client "Recovering from previous snippet, please wait.\n" if gettimeofday - $last_wait > 60;
|
||||
$last_wait = gettimeofday;
|
||||
last;
|
||||
}
|
||||
|
||||
print "Attempting compile...\n";
|
||||
alarm 0;
|
||||
|
||||
my ($ret, $result) = execute("perl bin/compiler_run.pl $line");
|
||||
|
||||
if(not defined $ret) {
|
||||
#print "parent continued\n";
|
||||
print "parent continued [$result]\n";
|
||||
$timed_out = 1 if $result == 243 or $result == -13; # -13 == 243
|
||||
$killed = 1 if $result == 242 or $result == -14; # -14 = 242
|
||||
last;
|
||||
}
|
||||
|
||||
$result =~ s/\s+$//;
|
||||
print "Ret: $ret; result: [$result]\n";
|
||||
|
||||
if($result =~ m/\[Killed\]$/) {
|
||||
print "Process was killed\n";
|
||||
$killed = 1;
|
||||
}
|
||||
|
||||
print $client $result . "\n";
|
||||
close $client;
|
||||
|
||||
$ret = -14 if $killed;
|
||||
|
||||
# child exit
|
||||
print "child exit\n";
|
||||
exit $ret;
|
||||
}
|
||||
|
||||
alarm 0;
|
||||
};
|
||||
|
||||
alarm 0;
|
||||
|
||||
close $client;
|
||||
|
||||
print "timed out: $timed_out; killed: $killed\n";
|
||||
next unless ($timed_out or $killed);
|
||||
|
||||
vm_reset;
|
||||
next;
|
||||
|
||||
print "stopping vm\n";
|
||||
#vm_stop;
|
||||
$running = 0;
|
||||
last;
|
||||
}
|
||||
|
||||
print "Compiler server no longer running, restarting...\n";
|
||||
}
|
||||
|
||||
print "waiting on heartbeat pid\n";
|
||||
waitpid($heartbeat_pid, 0);
|
||||
}
|
||||
|
||||
vm_server;
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
virsh attach-device --config pbot-vm serial-2.xml
|
||||
virsh attach-device --config pbot-vm serial-3.xml
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
<serial type='tcp'>
|
||||
<source mode='bind' host='127.0.0.1' service='5555' tls='no'/>
|
||||
<protocol type='raw'/>
|
||||
<target port='2'/>
|
||||
</serial>
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
<serial type='tcp'>
|
||||
<source mode='bind' host='127.0.0.1' service='5556' tls='no'/>
|
||||
<protocol type='raw'/>
|
||||
<target port='3'/>
|
||||
</serial>
|
||||
|
|
@ -12,8 +12,8 @@ use feature 'unicode_strings';
|
|||
|
||||
no if $] >= 5.018, warnings => "experimental::smartmatch";
|
||||
|
||||
package _c_base;
|
||||
use parent '_default';
|
||||
package Languages::_c_base;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
use Text::Balanced qw/extract_bracketed/;
|
||||
|
||||
|
|
@ -10,7 +10,7 @@ use feature 'unicode_strings';
|
|||
|
||||
no if $] >= 5.018, warnings => "experimental::smartmatch";
|
||||
|
||||
package _default;
|
||||
package Languages::_default;
|
||||
|
||||
use IPC::Open2;
|
||||
use IO::Socket;
|
||||
|
|
@ -21,21 +21,24 @@ use JSON;
|
|||
use Getopt::Long qw/GetOptionsFromArray :config pass_through no_ignore_case no_auto_abbrev/;
|
||||
use Encode;
|
||||
|
||||
use FindBin qw($RealBin);
|
||||
|
||||
my $EXECUTE_PORT = '3333';
|
||||
|
||||
sub new {
|
||||
my ($class, %conf) = @_;
|
||||
my $self = bless {}, $class;
|
||||
|
||||
$self->{debug} = $conf{debug} // 0;
|
||||
$self->{nick} = $conf{nick};
|
||||
$self->{channel} = $conf{channel};
|
||||
$self->{lang} = $conf{lang};
|
||||
$self->{code} = $conf{code};
|
||||
$self->{max_history} = $conf{max_history} // 10000;
|
||||
$self->{arguments} = $conf{arguments};
|
||||
$self->{factoid} = $conf{factoid};
|
||||
$self->{debug} = $conf{debug} // 0;
|
||||
$self->{nick} = $conf{nick};
|
||||
$self->{channel} = $conf{channel};
|
||||
$self->{lang} = $conf{lang};
|
||||
$self->{code} = $conf{code};
|
||||
$self->{max_history} = $conf{max_history} // 10000;
|
||||
$self->{arguments} = $conf{arguments};
|
||||
$self->{factoid} = $conf{factoid};
|
||||
$self->{'persist-key'} = $conf{'persist-key'};
|
||||
$self->{'vm-port'} = $conf{'vm-port'} // $EXECUTE_PORT;
|
||||
|
||||
$self->{default_options} = '';
|
||||
$self->{cmdline} = 'echo Hello, world!';
|
||||
|
|
@ -68,7 +71,7 @@ sub preprocess_code {
|
|||
}
|
||||
|
||||
unless($self->{got_run} and $self->{copy_code}) {
|
||||
open FILE, ">> log.txt";
|
||||
open FILE, ">> $RealBin/../log.txt";
|
||||
print FILE localtime() . "\n";
|
||||
print FILE "$self->{nick} $self->{channel}: [" . $self->{arguments} . "] " . $self->{cmdline_options} . "$self->{code}\n";
|
||||
close FILE;
|
||||
|
|
@ -140,7 +143,7 @@ sub postprocess_output {
|
|||
my $self = shift;
|
||||
|
||||
unless($self->{got_run} and $self->{copy_code}) {
|
||||
open FILE, ">> log.txt";
|
||||
open FILE, ">> $RealBin/../log.txt";
|
||||
print FILE "--------------------------post processing----------------------------------------------\n";
|
||||
print FILE localtime() . "\n";
|
||||
print FILE "$self->{output}\n";
|
||||
|
|
@ -173,7 +176,7 @@ sub show_output {
|
|||
my $output = $self->{output};
|
||||
|
||||
unless ($self->{got_run} and $self->{copy_code}) {
|
||||
open FILE, ">> log.txt";
|
||||
open FILE, ">> $RealBin/../log.txt";
|
||||
print FILE "------------------------show output------------------------------------------------\n";
|
||||
print FILE localtime() . "\n";
|
||||
print FILE "$output\n";
|
||||
|
|
@ -237,7 +240,7 @@ sub show_output {
|
|||
exit 0;
|
||||
}
|
||||
|
||||
if($self->{channel} =~ m/^#/ and length $output > 22 and open FILE, "< history/$self->{channel}-$self->{lang}.last-output") {
|
||||
if($self->{channel} =~ m/^#/ and length $output > 22 and open FILE, "< $RealBin/../history/$self->{channel}-$self->{lang}.last-output") {
|
||||
my $last_output;
|
||||
my $time = <FILE>;
|
||||
|
||||
|
|
@ -258,7 +261,7 @@ sub show_output {
|
|||
|
||||
print "$output\n";
|
||||
|
||||
open FILE, "> history/$self->{channel}-$self->{lang}.last-output" or die "Couldn't open $self->{channel}-$self->{lang}.last-output: $!";
|
||||
open FILE, "> $RealBin/../history/$self->{channel}-$self->{lang}.last-output" or die "Couldn't open $self->{channel}-$self->{lang}.last-output: $!";
|
||||
my $now = gettimeofday;
|
||||
print FILE "$now\n";
|
||||
print FILE "$output";
|
||||
|
|
@ -319,17 +322,18 @@ sub paste_0x0 {
|
|||
sub execute {
|
||||
my ($self) = @_;
|
||||
|
||||
my ($compiler, $compiler_output, $pid);
|
||||
my ($vm, $vm_output, $pid);
|
||||
|
||||
delete $self->{local};
|
||||
if(exists $self->{local} and $self->{local} != 0) {
|
||||
print "Using local compiler instead of virtual machine\n";
|
||||
$pid = open2($compiler_output, $compiler, './compiler_vm_server.pl') || die "repl failed: $@\n";
|
||||
print "Started compiler, pid: $pid\n";
|
||||
print "Using local machine instead of virtual machine\n";
|
||||
$pid = open2($vm_output, $vm, './compiler_vm_server.pl') || die "repl failed: $@\n"; # XXX
|
||||
print "Started fake-vm, pid: $pid\n";
|
||||
} else {
|
||||
$compiler = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $EXECUTE_PORT, Proto => 'tcp', Type => SOCK_STREAM);
|
||||
die "Could not create socket: $!" unless $compiler;
|
||||
$compiler_output = $compiler;
|
||||
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;
|
||||
$vm_output = $vm;
|
||||
}
|
||||
|
||||
my $date = time;
|
||||
|
|
@ -383,7 +387,7 @@ sub execute {
|
|||
$cmdline =~ s/\$options\s+//;
|
||||
}
|
||||
|
||||
open FILE, ">> log.txt";
|
||||
open FILE, ">> $RealBin/../log.txt";
|
||||
print FILE "---------------------executing---------------------------------------------------\n";
|
||||
print FILE localtime() . "\n";
|
||||
print FILE "$cmdline\n$stdin\n$pretty_code\n";
|
||||
|
|
@ -422,7 +426,7 @@ sub execute {
|
|||
#print FILE "Sending chunk [$chunk]\n";
|
||||
$chunks_sent += length $chunk;
|
||||
|
||||
my $ret = syswrite($compiler, $chunk);
|
||||
my $ret = syswrite($vm, $chunk);
|
||||
|
||||
if (not defined $ret) {
|
||||
print FILE "Error sending: $!\n";
|
||||
|
|
@ -445,7 +449,7 @@ sub execute {
|
|||
my $result = "";
|
||||
my $got_result = 0;
|
||||
|
||||
while(my $line = <$compiler_output>) {
|
||||
while(my $line = <$vm_output>) {
|
||||
utf8::decode($line);
|
||||
print STDERR "Read from vm [$line]\n";
|
||||
|
||||
|
|
@ -465,7 +469,7 @@ sub execute {
|
|||
}
|
||||
}
|
||||
|
||||
close $compiler;
|
||||
close $vm;
|
||||
waitpid($pid, 0) if defined $pid;
|
||||
|
||||
$self->{output} = $result;
|
||||
|
|
@ -486,7 +490,7 @@ sub add_option {
|
|||
sub process_standard_options {
|
||||
my $self = shift;
|
||||
|
||||
my @opt_args = $self->split_line($self->{code}, preserve_escapes => 1, keep_spaces => 1);
|
||||
my @opt_args = $self->split_line($self->{code}, preserve_escapes => 1, keep_spaces => 0);
|
||||
|
||||
use Data::Dumper;
|
||||
print STDERR "code:\n$self->{code}\n";
|
||||
|
|
@ -569,7 +573,7 @@ sub process_interactive_edit {
|
|||
if($subcode =~ s/^\s*copy\s+(\S+)\s*//) {
|
||||
my $copy = $1;
|
||||
|
||||
if(open FILE, "< history/$copy-$self->{lang}.hist") {
|
||||
if(open FILE, "< $RealBin/../history/$copy-$self->{lang}.hist") {
|
||||
$copy_code = <FILE>;
|
||||
close FILE;
|
||||
goto COPY_ERROR if not $copy_code;;
|
||||
|
|
@ -594,7 +598,7 @@ sub process_interactive_edit {
|
|||
$self->{channel} = $1;
|
||||
}
|
||||
|
||||
if(open FILE, "< history/$self->{channel}-$self->{lang}.hist") {
|
||||
if(open FILE, "< $RealBin/../history/$self->{channel}-$self->{lang}.hist") {
|
||||
while(my $line = <FILE>) {
|
||||
chomp $line;
|
||||
push @last_code, $line;
|
||||
|
|
@ -1018,7 +1022,7 @@ sub process_interactive_edit {
|
|||
unshift @last_code, $code;
|
||||
}
|
||||
|
||||
open FILE, "> history/$self->{channel}-$self->{lang}.hist";
|
||||
open FILE, "> $RealBin/../history/$self->{channel}-$self->{lang}.hist";
|
||||
|
||||
my $i = 0;
|
||||
foreach my $line (@last_code) {
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package bash;
|
||||
use parent '_default';
|
||||
package Languages::bash;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package bc;
|
||||
use parent '_default';
|
||||
package Languages::bc;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package bf;
|
||||
use parent '_default';
|
||||
package Languages::bf;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package c11;
|
||||
use parent '_c_base';
|
||||
package Languages::c11;
|
||||
use parent 'Languages::_c_base';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package c89;
|
||||
use parent '_c_base';
|
||||
package Languages::c89;
|
||||
use parent 'Languages::_c_base';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package c99;
|
||||
use parent '_c_base';
|
||||
package Languages::c99;
|
||||
use parent 'Languages::_c_base';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,7 +6,7 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package clang;
|
||||
use parent 'clang11';
|
||||
package Languages::clang;
|
||||
use parent 'Languages::clang11';
|
||||
|
||||
1;
|
||||
|
|
@ -1,20 +1,17 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
|
||||
# SPDX-License-Identifier: MIT
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
package clang11;
|
||||
use parent '_c_base';
|
||||
package Languages::clang11;
|
||||
use parent 'Languages::_c_base';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
||||
$self->{sourcefile} = 'prog.c';
|
||||
$self->{execfile} = 'prog';
|
||||
$self->{default_options} = '-Wextra -Wall -Wno-unused -Wno-unused-parameter -pedantic -Wfloat-equal -Wshadow -std=c11 -lm -Wfatal-errors -fsanitize=integer,undefined,alignment';
|
||||
$self->{default_options} = '-Wextra -Wall -Wno-unused -Wno-unused-parameter -pedantic -Wfloat-equal -Wshadow -std=c11 -lm -Wfatal-errors -fsanitize=integer,undefined,alignment -fsanitize-address-use-after-scope -fno-omit-frame-pointer';
|
||||
$self->{options_paste} = '-fcaret-diagnostics';
|
||||
$self->{options_nopaste} = '-fno-caret-diagnostics';
|
||||
$self->{cmdline} = 'clang -ggdb -g3 $sourcefile $options -o $execfile';
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package clang89;
|
||||
use parent '_c_base';
|
||||
package Languages::clang89;
|
||||
use parent 'Languages::_c_base';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package clang99;
|
||||
use parent '_c_base';
|
||||
package Languages::clang99;
|
||||
use parent 'Languages::_c_base';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package clangpp;
|
||||
use parent '_c_base';
|
||||
package Languages::clangpp;
|
||||
use parent 'Languages::_c_base';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package clisp;
|
||||
use parent '_default';
|
||||
package Languages::clisp;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package cpp;
|
||||
use parent '_c_base';
|
||||
package Languages::cpp;
|
||||
use parent 'Languages::_c_base';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package freebasic;
|
||||
use parent '_default';
|
||||
package Languages::freebasic;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package go;
|
||||
use parent '_default';
|
||||
package Languages::go;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package haskell;
|
||||
use parent '_default';
|
||||
package Languages::haskell;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package java;
|
||||
use parent '_default';
|
||||
package Languages::java;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
use Text::Balanced qw/extract_bracketed/;
|
||||
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package javascript;
|
||||
use parent '_default';
|
||||
package Languages::javascript;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package ksh;
|
||||
use parent '_default';
|
||||
package Languages::ksh;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package lua;
|
||||
use parent '_default';
|
||||
package Languages::lua;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package perl;
|
||||
use parent '_default';
|
||||
package Languages::perl;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
use Text::ParseWords qw(shellwords);
|
||||
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package php;
|
||||
use parent '_default';
|
||||
package Languages::php;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package python;
|
||||
use parent '_default';
|
||||
package Languages::python;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package python3;
|
||||
use parent '_default';
|
||||
package Languages::python3;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package qbasic;
|
||||
use parent '_default';
|
||||
package Languages::qbasic;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package ruby;
|
||||
use parent '_default';
|
||||
package Languages::ruby;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package scheme;
|
||||
use parent '_default';
|
||||
package Languages::scheme;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package sh;
|
||||
use parent '_default';
|
||||
package Languages::sh;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package tcl;
|
||||
use parent '_default';
|
||||
package Languages::tcl;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package tendra;
|
||||
use parent '_c_base';
|
||||
package Languages::tendra;
|
||||
use parent 'Languages::_c_base';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -6,8 +6,8 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package zsh;
|
||||
use parent '_default';
|
||||
package Languages::zsh;
|
||||
use parent 'Languages::_default';
|
||||
|
||||
sub initialize {
|
||||
my ($self, %conf) = @_;
|
||||
|
|
@ -317,11 +317,27 @@
|
|||
<!-- md-toc-begin -->
|
||||
* [Virtual Machine](VirtualMachine.md#virtual-machine)
|
||||
* [About](VirtualMachine.md#about)
|
||||
* [Creating a new virtual machine](VirtualMachine.md#creating-a-new-virtual-machine)
|
||||
* [Configuring the virtual machine](VirtualMachine.md#configuring-the-virtual-machine)
|
||||
* [Installing Linux in the virtual machine](VirtualMachine.md#installing-linux-in-the-virtual-machine)
|
||||
* [Configuring Linux for PBot Communication](VirtualMachine.md#configuring-linux-for-pbot-communication)
|
||||
* [Hardening the PBot virtual machine](VirtualMachine.md#hardening-the-pbot-virtual-machine)
|
||||
* [Initial virtual machine set-up](VirtualMachine.md#initial-virtual-machine-set-up)
|
||||
* [Prerequisites](VirtualMachine.md#prerequisites)
|
||||
* [CPU Virtualization Technology](VirtualMachine.md#cpu-virtualization-technology)
|
||||
* [KVM](VirtualMachine.md#kvm)
|
||||
* [libvirt](VirtualMachine.md#libvirt)
|
||||
* [Make a pbot-vm user or directory](VirtualMachine.md#make-a-pbot-vm-user-or-directory)
|
||||
* [Add libvirt group to your user](VirtualMachine.md#add-libvirt-group-to-your-user)
|
||||
* [Download Linux ISO](VirtualMachine.md#download-linux-iso)
|
||||
* [Creating a new virtual machine](VirtualMachine.md#creating-a-new-virtual-machine)
|
||||
* [Installing Linux in the virtual machine](VirtualMachine.md#installing-linux-in-the-virtual-machine)
|
||||
* [Configuring virtual machine for PBot](VirtualMachine.md#configuring-virtual-machine-for-pbot)
|
||||
* [Set up serial ports](VirtualMachine.md#set-up-serial-ports)
|
||||
* [Install Perl](VirtualMachine.md#install-perl)
|
||||
* [Install PBot VM Guest](VirtualMachine.md#install-pbot-vm-guest)
|
||||
* [Install software](VirtualMachine.md#install-software)
|
||||
* [Start PBot VM Guest](VirtualMachine.md#start-pbot-vm-guest)
|
||||
* [Test PBot VM Guest](VirtualMachine.md#test-pbot-vm-guest)
|
||||
* [Save initial state](VirtualMachine.md#save-initial-state)
|
||||
* [Initial virtual machine set-up complete](VirtualMachine.md#initial-virtual-machine-set-up-complete)
|
||||
* [Start PBot VM Host](VirtualMachine.md#start-pbot-vm-host)
|
||||
* [Test PBot](VirtualMachine.md#test-pbot)
|
||||
<!-- md-toc-end -->
|
||||
<!-- md-toc-begin -->
|
||||
* [Frequently Asked Questions](FAQ.md#frequently-asked-questions)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,30 @@
|
|||
# Virtual Machine
|
||||
|
||||
<!-- md-toc-begin -->
|
||||
* [About](#about)
|
||||
* [Initial virtual machine set-up](#initial-virtual-machine-set-up)
|
||||
* [Prerequisites](#prerequisites)
|
||||
* [CPU Virtualization Technology](#cpu-virtualization-technology)
|
||||
* [KVM](#kvm)
|
||||
* [libvirt](#libvirt)
|
||||
* [Make a pbot-vm user or directory](#make-a-pbot-vm-user-or-directory)
|
||||
* [Add libvirt group to your user](#add-libvirt-group-to-your-user)
|
||||
* [Download Linux ISO](#download-linux-iso)
|
||||
* [Creating a new virtual machine](#creating-a-new-virtual-machine)
|
||||
* [Installing Linux in the virtual machine](#installing-linux-in-the-virtual-machine)
|
||||
* [Configuring virtual machine for PBot](#configuring-virtual-machine-for-pbot)
|
||||
* [Set up serial ports](#set-up-serial-ports)
|
||||
* [Install Perl](#install-perl)
|
||||
* [Install PBot VM Guest](#install-pbot-vm-guest)
|
||||
* [Install software](#install-software)
|
||||
* [Start PBot VM Guest](#start-pbot-vm-guest)
|
||||
* [Test PBot VM Guest](#test-pbot-vm-guest)
|
||||
* [Save initial state](#save-initial-state)
|
||||
* [Initial virtual machine set-up complete](#initial-virtual-machine-set-up-complete)
|
||||
* [Start PBot VM Host](#start-pbot-vm-host)
|
||||
* [Test PBot](#test-pbot)
|
||||
<!-- md-toc-end -->
|
||||
|
||||
## About
|
||||
|
||||
PBot can interact with a virtual machine to safely execute arbitrary user-submitted
|
||||
|
|
@ -9,29 +34,228 @@ This document will guide you through installing and configuring a virtual machin
|
|||
by using the widely available [libvirt](https://libvirt.org) project tools, such as
|
||||
`virt-install`, `virsh`, `virt-manager`, `virt-viewer`, etc.
|
||||
|
||||
Though there are many, many tutorials and walk-throughs available for these tools,
|
||||
this guide will demonstrate the necessary `virt-install` and `virsh` commands to
|
||||
configure the virtual machine.
|
||||
If you're more comfortable working with QEMU directly instead, feel free to do that.
|
||||
I hope this guide will answer everything you need to know to set that up. If not,
|
||||
open an GitHub issue or /msg me on IRC.
|
||||
|
||||
You may install a guest Linux distribution of your choice. Any of the recent popular
|
||||
Linux distributions should suffice. This guide will use Fedora Rawhide because
|
||||
playing around with the latest bleeding-edge software is fun!
|
||||
Some quick terminology:
|
||||
|
||||
Then we will show you the necessary commands to configure the Linux guest system
|
||||
to be able to communicate with PBot. Commands and code snippets are sent over a
|
||||
virtual serial cable. We'll show you how to set that up.
|
||||
* host: your physical Linux system hosting the virtual machine
|
||||
* guest: the Linux system installed inside the virtual machine
|
||||
|
||||
We'll also show a few tips and tricks to help secure the virtual machine against
|
||||
malicious user-submitted commands.
|
||||
## Initial virtual machine set-up
|
||||
These steps need to be done only once during the first-time set-up.
|
||||
|
||||
Let's get started.
|
||||
### Prerequisites
|
||||
#### CPU Virtualization Technology
|
||||
Ensure CPU Virtualization Technology is enabled in your motherboard BIOS.
|
||||
|
||||
## Creating a new virtual machine
|
||||
$ egrep '(vmx|svm)' /proc/cpuinfo
|
||||
|
||||
## Configuring the virtual machine
|
||||
If you see your CPUs listed with `vmx` or `svm` flags, you're good to go.
|
||||
Otherwise, consult your motherboard manual to see how to enable VT.
|
||||
|
||||
## Installing Linux in the virtual machine
|
||||
#### KVM
|
||||
Ensure KVM is set up and loaded.
|
||||
|
||||
## Configuring Linux for PBot Communication
|
||||
$ kvm-ok
|
||||
INFO: /dev/kvm exists
|
||||
KVM acceleration can be used
|
||||
|
||||
## Hardening the PBot virtual machine
|
||||
If you see the above, everything's set up. Otherwise, consult your operating
|
||||
system manual or KVM manual to install and load KVM.
|
||||
|
||||
#### libvirt
|
||||
Ensure libvirt is installed and ready.
|
||||
|
||||
$ virsh version --daemon
|
||||
Compiled against library: libvirt 7.6.0
|
||||
Using library: libvirt 7.6.0
|
||||
Using API: QEMU 7.6.0
|
||||
Running hypervisor: QEMU 6.0.0
|
||||
Running against daemon: 7.6.0
|
||||
|
||||
If there's anything missing, please consult your operating system manual to
|
||||
install the libvirt and QEMU packages.
|
||||
|
||||
On Ubuntu: `sudo apt install qemu-kvm libvirt-daemon-system`
|
||||
|
||||
#### Make a pbot-vm user or directory
|
||||
You can either make a new user account or make a new directory in your current user account.
|
||||
In either case, name it `pbot-vm` so we'll have one place for the install ISO file and the
|
||||
virtual machine disk and snapshot files.
|
||||
|
||||
#### Add libvirt group to your user
|
||||
Add your user or the `pbot-vm` user to the `libvirt` group.
|
||||
|
||||
$ sudo adduser $USER libvirt
|
||||
|
||||
Log out and then log back in for the new group to take effect on your user.
|
||||
|
||||
#### Download Linux ISO
|
||||
Download a preferred Linux ISO. For this guide, we'll use Fedora. Why? I'm
|
||||
using Fedora Rawhide for my PBot VM because I want convenient and reliable
|
||||
access to the latest bleeding-edge versions of software.
|
||||
|
||||
I recommend using the Fedora Stable net-installer for this guide unless you
|
||||
are more comfortable in another Linux distribution. Make sure you choose
|
||||
the minimal install option without a graphical desktop.
|
||||
|
||||
https://download.fedoraproject.org/pub/fedora/linux/releases/35/Server/x86_64/iso/Fedora-Server-netinst-x86_64-35-1.2.iso
|
||||
is the Fedora Stable net-installer ISO used in this guide.
|
||||
|
||||
### Creating a new virtual machine
|
||||
To create a new virtual machine we'll use the `virt-install` command. First, ensure you are
|
||||
the `pbot-vm` user or that you have changed your current working directory to `pbot-vm`.
|
||||
|
||||
$ virt-install --name=pbot-vm --disk=size=12,cache=none,driver.io=native,snapshot=external,path=vm.qcow2 --cpu=host --os-variant=fedora34 --graphics=spice,gl.enable=yes --video=virtio --location=Fedora-Server-netinst-x86_64-35-1.2.iso
|
||||
|
||||
If you are installing over an X-forwarded SSH session, strip the `,gl.enable=yes`
|
||||
part. Note that `disk=size=12` will create a 12 GB sparse file. Sparse means the file
|
||||
won't actually take up 12 GB. It will start at 0 bytes and grow as needed. You can
|
||||
use the `du` command to verify this. After a minimal Fedora install, the size will be
|
||||
approximately 1.7 GB. It will grow to about 2.5 GB with most PBot features installed.
|
||||
|
||||
For further information about `virt-install`, read its manual page. While the above command should
|
||||
give sufficient performance and compatability, there are a great many options worth investigating
|
||||
if you want to fine-tune your virtual machine.
|
||||
|
||||
#### Installing Linux in the virtual machine
|
||||
After executing the `virt-install` command above, you should now see a window
|
||||
showing Linux booting up and launching an installer. For this guide, we'll walk
|
||||
through the Fedora 35 installer. You can adapt these steps for your own distribution
|
||||
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`.
|
||||
* 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`.
|
||||
|
||||
Installation will need to download about 328 RPMs consisting of about 425 MB. It'll take 5 minutes to an hour or longer
|
||||
depending on your hardware and network configuration.
|
||||
|
||||
#### Configuring virtual machine for PBot
|
||||
Once the install finishes, click the `Reboot` button in the Fedora installer in the virtual machine window.
|
||||
|
||||
#### Set up serial ports
|
||||
Now, while the virtual machine is rebooting, switch to a terminal on your host system. Go into the
|
||||
`pbot-vm/host/devices` directory and run the `add-serials` script. Feel free to look inside. It will add
|
||||
the `serial-2.xml` and `serial-3.xml` files to the configuration for the `pbot-vm` libvirt machine.
|
||||
|
||||
This will enable and connect the `/dev/ttyS1` and `/dev/ttyS2` serial ports inside the virtual machine
|
||||
to TCP connections on `127.0.0.1:5555` and `127.0.0.1:5556`, respectively. `ttyS1/5555` is the data
|
||||
channel used to send commands or code to the virtual machine and to read back output. `ttyS2/5556` is
|
||||
simply a newline sent every 5 seconds, representing a heartbeat, used to ensure that the PBot communication
|
||||
channel is healthy.
|
||||
|
||||
Once that's done, switch back to the virtual machine window. Once the virtual machine has rebooted,
|
||||
log in as `root`. Now go ahead and shut the virtual machine down with `shutdown now -h`. We need to
|
||||
restart the virtual machine itself so it loads the new serial device configuration. Once the machine
|
||||
has shutdown, bring it right back up with the following commands on the host system in the terminal
|
||||
used for `virt-install`:
|
||||
|
||||
$ virsh start pbot-vm
|
||||
|
||||
Now the virtual machine will start back up in the background.
|
||||
|
||||
$ virt-viewer pbot-vm
|
||||
|
||||
Now you should see the virtual machine window after a few seconds. Log in as `root` once the login
|
||||
prompt appears.
|
||||
|
||||
#### Install Perl
|
||||
Now we need to install Perl inside the virtual machine. This allows us to run the PBot VM Guest
|
||||
script.
|
||||
|
||||
$ dnf install perl-interpreter perl-lib perl-IPC-Run perl-JSON-XS perl-English
|
||||
|
||||
That installs the minium packages for the Perl interpreter (note we used `perl-interpreter` instead of `perl`),
|
||||
the package for 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
|
||||
and the physical host system. We'll do this inside the virtual machine guest system.
|
||||
|
||||
The `rsync` command isn't installed in a Fedora minimal install, but `scp` is available. Replace
|
||||
`192.168.100.42` below with your own local IP address and `user` with the user account that has the
|
||||
PBot directory and `pbot` with the path to the directory.
|
||||
|
||||
$ scp -r user@192.168.100.42:~/pbot/applets/pbot-vm/guest .
|
||||
|
||||
Once that's done, run the following command:
|
||||
|
||||
$ ./guest/bin/setup-guest
|
||||
|
||||
Feel free to take a look inside to see what it does. It's very short. After running
|
||||
the `setup-guest` script make sure you run `source /root/.bashrc` so the environment
|
||||
changes take effect.
|
||||
|
||||
#### Install software
|
||||
Now you can install any languages you want to use.
|
||||
|
||||
Python3 is already installed.
|
||||
|
||||
For the C programming language you will need at least these:
|
||||
|
||||
$ dnf install libubsan libasan gdb gcc clang
|
||||
|
||||
I'll list all the packages for the others soon. You can use `dnf search <name>` to find packages
|
||||
in Fedora.
|
||||
|
||||
#### Start PBot VM Guest
|
||||
We're ready to start the PBot VM Guest.
|
||||
|
||||
$ start-guest
|
||||
|
||||
This starts up a server to listen for incoming commands or code and to handle them. We'll leave
|
||||
this running.
|
||||
|
||||
#### Test PBot VM Guest
|
||||
Let's make sure everything's working up to this point. There should be two open TCP ports on
|
||||
`5555` and `5556`.
|
||||
|
||||
$ nc -zv 127.0.0.1 5555-5556
|
||||
|
||||
If it says anything other than `Connection succeeded` then make sure you have completed the steps
|
||||
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
|
||||
in the `applets/pbot-vm/host/bin` directory allows you to send commands from the shell.
|
||||
|
||||
$ vm-exec -lang=sh echo hello world
|
||||
|
||||
This should output some logging noise followed by "hello world". You can test other language modules
|
||||
by changing the `-lang=` option. I recommend testing and verifying that all of your desired language
|
||||
modules are configured before going on to the next step.
|
||||
|
||||
If you have multiple PBot VM Guests, or if you used a different TCP port, you can specify the
|
||||
`PBOT_VM_PORT` environment variable when executing the `vm-exec` command:
|
||||
|
||||
$ PBOT_VM_PORT=6666 vm-exec -lang=sh echo test
|
||||
|
||||
#### Save initial state
|
||||
Switch back to an available terminal on the physical host machine. Enter the following command
|
||||
to save a snapshot of the virtual machine waiting for incoming commands.
|
||||
|
||||
$ virsh snapshot-create-as pbot-vm 1
|
||||
|
||||
This will create a snapshot file `vm.1` next to the `vm.qcow2` disk file. If the virtual machine
|
||||
ever times-out or its heartbeat stops responding, PBot will reset the virtual machine to this
|
||||
saved snapshot.
|
||||
|
||||
### Initial virtual machine set-up complete
|
||||
This concludes the initial one-time set-up. You can close the `virt-viewer` window. The
|
||||
virtual machine will continue running in the background until it is manually shutdown (via
|
||||
`shutdown now -h` inside the VM or via `virsh shutdown pbot-vm` on the host).
|
||||
|
||||
## Start PBot VM Host
|
||||
To start the PBot VM Host server, execute the `vm-server` script in the
|
||||
`applets/pbot_vm/host/bin` directory on the host.
|
||||
|
||||
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.
|
||||
|
||||
### Test PBot
|
||||
All done. Everything is set up now. In your instance of PBot, the `sh echo hello` command should output `hello`.
|
||||
|
|
|
|||
Loading…
Reference in New Issue