3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-10-03 01:48:38 +02:00

compiler_vm: make guest debugging output less verbose

This commit is contained in:
Pragmatic Software 2022-02-06 11:33:21 -08:00
parent f0dbf8c33a
commit 46fdd01ccd
3 changed files with 182 additions and 180 deletions

View File

@ -11,6 +11,7 @@ use English;
use Encode;
use File::Basename;
use JSON::XS;
use Data::Dumper;
my $USERNAME = 'vm'; # variable for easier string interpolation
@ -22,12 +23,12 @@ use constant {
OUTPUT => '/dev/stdout',
};
my $USE_LOCAL = $ENV{'CC_LOCAL'} // 0;
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){
@ -42,7 +43,7 @@ sub load_modules {
sub run_server {
my ($input, $output, $heartbeat);
if(not defined $USE_LOCAL or $USE_LOCAL == 0) {
if (not $USE_LOCAL) {
# set serial to 115200 baud instead of 9600
system('stty -F ' . SERIAL . ' 115200');
@ -65,15 +66,14 @@ sub run_server {
my $pid = fork;
die "Fork failed: $!" if not defined $pid;
if($pid == 0) {
my $buffer = "";
my $length = 4096;
if ($pid == 0) {
my $buffer = '';
my $line;
my $total_read = 0;
while (1) {
print "Waiting for input...\n";
my $ret = sysread($input, my $buf, $length);
my $ret = sysread($input, my $buf, 16384);
if (not defined $ret) {
print "Error reading: $!\n";
@ -83,7 +83,7 @@ sub run_server {
$total_read += $ret;
if ($ret == 0) {
print "input ded?\n";
print "Input closed; exiting...\n";
print "got buffer [$buffer]\n";
exit;
}
@ -92,30 +92,26 @@ sub run_server {
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;
}
next if $buffer !~ s/\s*:end:\s*$//m;
$line = $buffer;
chomp $line;
$buffer = '';
$total_read = 0;
$line = encode('UTF-8', $line);
print "-" x 40, "\n";
print "Got [$line]\n";
$line = encode('UTF-8', $line);
my $compile_in = decode_json($line);
print Dumper $compile_in;
$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) {
@ -125,6 +121,7 @@ sub run_server {
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;
@ -153,15 +150,19 @@ sub run_server {
$EGID = "$gid $gid";
$EUID = $UID = $uid;
chdir("/home/$USERNAME");
my $result = interpret(%$compile_in);
$GID = 0;
$UID = 0;
my $compile_out = { result => $result };
my $json = encode_json($compile_out);
print "Done compiling; result: [$result] [$json]\n";
print "Done compiling: $json\n";
print $output "result:$json\n";
print $output "result:end\n";
@ -175,9 +176,12 @@ sub run_server {
exit;
} else {
waitpid $pid, 0;
# kill any left-over processes started by $USERNAME
system("pkill -u $USERNAME");
}
if(not defined $USE_LOCAL or $USE_LOCAL == 0) {
if (not $USE_LOCAL) {
print "=" x 40, "\n";
next;
} else {
@ -201,18 +205,12 @@ sub interpret {
$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} = "";

View File

@ -12,10 +12,8 @@ use parent '_default';
sub preprocess {
my $self = shift;
my $input = $self->{input};
$input = "" if not defined $input;
my $input = $self->{input} // '';
print "writing input [$input]\n";
open(my $fh, '>', '.input');
print $fh "$input\n";
close $fh;

View File

@ -9,8 +9,13 @@ use warnings;
use strict;
use IPC::Run qw/run timeout/;
use Data::Dumper;
$Data::Dumper::Terse = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Useqq = 1;
sub new {
my ($class, %conf) = @_;
my $self = bless {}, $class;
@ -42,16 +47,16 @@ sub preprocess {
print $fh $self->{code} . "\n";
close $fh;
print "Executing [$self->{cmdline}] with args [$self->{arguments}]\n";
my @args = $self->split_line($self->{arguments}, strip_quotes => 1, preserve_escapes => 0);
my $quoted_args = '';
if (length $self->{arguments}) {
my @args = $self->split_line($self->{arguments}, strip_quotes => 1, preserve_escapes => 0);
foreach my $arg (@args) {
$arg =~ s/'/'"'"'/g;
$quoted_args .= "'$arg' ";
}
}
$self->{input} = "ulimit -f 2000; ulimit -t 8; ulimit -u 200; $self->{cmdline} $quoted_args";
@ -63,15 +68,14 @@ sub preprocess {
$self->{error} = $retval;
}
sub postprocess {
my $self = shift;
}
sub postprocess {}
sub execute {
my ($self, $timeout, $stdin, @cmdline) = @_;
$stdin //= '';
print "execute($timeout) [$stdin] ", Dumper \@cmdline, "\n";
print "execute ($timeout) [$stdin] @cmdline\n";
my ($exitval, $stdout, $stderr) = eval {
my ($stdout, $stderr);
@ -80,13 +84,15 @@ sub execute {
return ($exitval, $stdout, $stderr);
};
if ($@) {
my $error = $@;
$error = "[Timed-out]" if $error =~ m/timeout on timer/;
($exitval, $stdout, $stderr) = (-1, '', $error);
if (my $exception = $@) {
$exception = "[Timed-out]" if $exception =~ m/timeout on timer/;
($exitval, $stdout, $stderr) = (-1, '', $exception);
}
print "exitval $exitval stdout [$stdout]\nstderr [$stderr]\n";
$Data::Dumper::Indent = 0;
print "exitval $exitval stderr [", Dumper($stderr), "] stdout [", Dumper($stdout), "]\n";
$Data::Dumper::Indent = 1;
return ($exitval, $stdout, $stderr);
}