From f0dbf8c33aa3574bd47a7b8bcc44c80b79e78328 Mon Sep 17 00:00:00 2001 From: Pragmatic Software Date: Sun, 6 Feb 2022 00:24:04 -0800 Subject: [PATCH] compiler_vm: add ulimits; fix print_last_statement() --- applets/compiler_vm/guest/bin/guest-gdb | 20 ++++++++++++++++-- applets/compiler_vm/guest/bin/setup-guest | 9 +++++--- applets/compiler_vm/guest/bin/start-guest | 6 ++++-- .../guest/lib/Languages/_c_base.pm | 19 ++++++++++++----- .../guest/lib/Languages/_default.pm | 21 ++++++++++++------- 5 files changed, 55 insertions(+), 20 deletions(-) diff --git a/applets/compiler_vm/guest/bin/guest-gdb b/applets/compiler_vm/guest/bin/guest-gdb index 9e0764b7..5646c587 100755 --- a/applets/compiler_vm/guest/bin/guest-gdb +++ b/applets/compiler_vm/guest/bin/guest-gdb @@ -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"); diff --git a/applets/compiler_vm/guest/bin/setup-guest b/applets/compiler_vm/guest/bin/setup-guest index 1cfb1ca0..57c37efb 100755 --- a/applets/compiler_vm/guest/bin/setup-guest +++ b/applets/compiler_vm/guest/bin/setup-guest @@ -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 diff --git a/applets/compiler_vm/guest/bin/start-guest b/applets/compiler_vm/guest/bin/start-guest index 7aece342..d93bbdcb 100755 --- a/applets/compiler_vm/guest/bin/start-guest +++ b/applets/compiler_vm/guest/bin/start-guest @@ -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}) { diff --git a/applets/compiler_vm/guest/lib/Languages/_c_base.pm b/applets/compiler_vm/guest/lib/Languages/_c_base.pm index 54bfc9d9..63b90092 100755 --- a/applets/compiler_vm/guest/lib/Languages/_c_base.pm +++ b/applets/compiler_vm/guest/lib/Languages/_c_base.pm @@ -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; diff --git a/applets/compiler_vm/guest/lib/Languages/_default.pm b/applets/compiler_vm/guest/lib/Languages/_default.pm index 05d009c9..4f7a77f9 100755 --- a/applets/compiler_vm/guest/lib/Languages/_default.pm +++ b/applets/compiler_vm/guest/lib/Languages/_default.pm @@ -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;