3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-10-01 17:16:39 +02:00

compiler_vm: add ulimits; fix print_last_statement()

This commit is contained in:
Pragmatic Software 2022-02-06 00:24:04 -08:00
parent 0626397dbf
commit f0dbf8c33a
5 changed files with 55 additions and 20 deletions

View File

@ -350,7 +350,7 @@ sub dispatch_user_command($context, $command) {
'dump' => \&cmd_print,
# special PBot command
'print_last_statement' => \&cmd_print,
'print_last_statement' => \&cmd_print_last_statement,
);
$command = unescape($command);
@ -423,6 +423,22 @@ sub cmd_print($context, $args) {
}
}
sub cmd_print_last_statement($context, $args) {
# invoke the last statement
my $console = gdb_send_and_read_console($context, "print $args");
# don't print last statement if there was program output
return if -s OUTPUT_FILENAME;
foreach my $output (@$console) {
last if $output->{_type} eq RESULT;
if ($output->{_text} =~ /^\$\d+\s*=\s*(.*)/) {
print_gdb_output($context, "no output: $args = $1");
}
}
}
sub handle_program_exit($context, $data) {
my $reason = $data->{reason};
@ -625,7 +641,7 @@ sub run_program($context) {
sub main {
# first command-line argument can override file to debug
my $prog = $ARGV[0] // './prog';
my $prog = shift @ARGV // './prog';
# start gdb and grab references to its input and output streams
open2(my $out, my $in, "LIBC_FATAL_STDERR=1 MALLOC_CHECK_=1 gdb -i mi3 -q -nx $prog");

View File

@ -1,6 +1,6 @@
cp guest/bin/* /usr/local/bin
mkdir /usr/local/share/pbot-vm/ > /dev/null
mkdir -p /usr/local/share/pbot-vm/
cp -r guest/lib/Languages/ /usr/local/share/pbot-vm/
cp guest/include/prelude.h /usr/include
@ -9,8 +9,11 @@ cp guest/polkit/* /etc/polkit-1/rules.d/
nmcli networking off
echo unset DEBUGINFOD_URLS >> /root/.bashrc
echo export ASAN_OPTIONS=detect_leaks=0 >> /root/.bashrc
if ! grep -qF "pbot-vm" /root/.bashrc; then
echo '# pbot-vm' >> /root/.bashrc
echo unset DEBUGINFOD_URLS >> /root/.bashrc
echo export ASAN_OPTIONS=detect_leaks=0 >> /root/.bashrc
fi
echo PBot Guest VM is now set up.
echo

View File

@ -143,6 +143,8 @@ sub run_server {
system("rm -rf /home/$USERNAME/prog*");
system("pkill -u $USERNAME");
system("date -s \@$compile_in->{date}");
$ENV{USER} = $USERNAME;
$ENV{LOGNAME} = $USERNAME;
$ENV{HOME} = $home;
@ -205,11 +207,11 @@ sub interpret {
$mod->preprocess;
print "after preprocess: ", Dumper $mod, "\n";
# print "after preprocess: ", Dumper $mod, "\n";
$mod->postprocess if not $mod->{error} and not $mod->{done};
print "after postprocess: ", Dumper $mod, "\n";
# print "after postprocess: ", Dumper $mod, "\n";
if (exists $mod->{no_output} or not length $mod->{output}) {
if ($h{factoid}) {

View File

@ -20,8 +20,6 @@ sub preprocess {
print $fh "$input\n";
close $fh;
$self->execute(10, undef, 'date', '-s', "\@$self->{date}");
my @cmd = $self->split_line($self->{cmdline}, strip_quotes => 1, preserve_escapes => 0);
if ($self->{code} =~ m/print_last_statement\(.*\);$/m) {
@ -78,15 +76,26 @@ sub postprocess {
}
print "Executing gdb\n";
my @args = $self->split_line($self->{arguments}, strip_quotes => 1, preserve_escapes => 0);
my ($exitval, $stdout, $stderr);
my $ulimits = "ulimit -f 2000; ulimit -t 8; ulimit -u 200";
my @args = $self->split_line($self->{arguments}, strip_quotes => 1, preserve_escapes => 0);
my $quoted_args = '';
foreach my $arg (@args) {
$arg =~ s/'/'"'"'/g;
$quoted_args .= "'$arg' ";
}
if ($self->{cmdline} =~ /-fsanitize=(?:[^ ]+,)?address/) {
# leak sanitizer doesn't work under ptrace/gdb
# 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);
($exitval, $stdout, $stderr) = $self->execute(60, "$ulimits; ./prog $quoted_args\n", '/bin/sh');
} else {
($exitval, $stdout, $stderr) = $self->execute(60, undef, 'guest-gdb', @args);
my $input = "$ulimits; guest-gdb ./prog $quoted_args";
($exitval, $stdout, $stderr) = $self->execute(60, $input, '/bin/sh');
}
my $result = $stderr;

View File

@ -8,9 +8,6 @@ package _default;
use warnings;
use strict;
use feature "switch";
no if $] >= 5.018, warnings => "experimental::smartmatch";
use IPC::Run qw/run timeout/;
use Data::Dumper;
@ -45,13 +42,21 @@ sub preprocess {
print $fh $self->{code} . "\n";
close $fh;
$self->execute(10, undef, 'date', '-s', "\@$self->{date}");
print "Executing [$self->{cmdline}] with args [$self->{arguments}]\n";
my @cmdline = $self->split_line($self->{cmdline}, strip_quotes => 1, preserve_escapes => 0);
push @cmdline, $self->split_line($self->{arguments}, strip_quotes => 1, preserve_escapes => 0);
my ($retval, $stdout, $stderr) = $self->execute(60, $self->{input}, @cmdline);
my @args = $self->split_line($self->{arguments}, strip_quotes => 1, preserve_escapes => 0);
my $quoted_args = '';
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";
my ($retval, $stdout, $stderr) = $self->execute(60, $self->{input}, '/bin/sh');
$self->{output} = $stderr;
$self->{output} .= ' ' if length $self->{output};
$self->{output} .= $stdout;