mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-19 10:29:30 +01:00
compiler_vm: add ulimits; fix print_last_statement()
This commit is contained in:
parent
0626397dbf
commit
f0dbf8c33a
@ -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");
|
||||
|
@ -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
|
||||
|
||||
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
|
||||
|
@ -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}) {
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user