mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-05 19:49:32 +01:00
pbot-vm: improve exit-code handling
This commit is contained in:
parent
164ecc45a7
commit
3e2204a6b0
@ -441,8 +441,6 @@ sub cmd_print_last_statement($context, $args) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
sub handle_program_exit($context, $data) {
|
sub handle_program_exit($context, $data) {
|
||||||
my $reason = $data->{reason};
|
|
||||||
|
|
||||||
if (not -s OUTPUT_FILENAME) { # -s gets size of file
|
if (not -s OUTPUT_FILENAME) { # -s gets size of file
|
||||||
my $locals = locals_to_string($context->{locals_end});
|
my $locals = locals_to_string($context->{locals_end});
|
||||||
|
|
||||||
@ -451,6 +449,10 @@ sub handle_program_exit($context, $data) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if (exists $data->{'exit-code'} && $data->{'exit-code'} != 0) {
|
||||||
|
$context->{'exit-code'} = oct $data->{'exit-code'};
|
||||||
|
}
|
||||||
|
|
||||||
_exit($context);
|
_exit($context);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -541,7 +543,7 @@ sub handle_exec_async_output($context, $output) {
|
|||||||
if ($reason eq 'breakpoint-hit') {
|
if ($reason eq 'breakpoint-hit') {
|
||||||
handle_breakpoint_hit($context, $output);
|
handle_breakpoint_hit($context, $output);
|
||||||
}
|
}
|
||||||
elsif ($reason eq 'exited-normally') {
|
elsif ($reason eq 'exited-normally' || $reason eq 'exited') {
|
||||||
handle_program_exit($context, $output);
|
handle_program_exit($context, $output);
|
||||||
}
|
}
|
||||||
elsif ($reason eq 'signal-received') {
|
elsif ($reason eq 'signal-received') {
|
||||||
@ -592,9 +594,9 @@ sub _exit($context) {
|
|||||||
my $output = do { local $/; <$fh> };
|
my $output = do { local $/; <$fh> };
|
||||||
close $fh;
|
close $fh;
|
||||||
|
|
||||||
print STDOUT "$output\n";
|
print STDOUT "$output";
|
||||||
|
|
||||||
exit;
|
exit ($context->{'exit-code'} // 0);
|
||||||
}
|
}
|
||||||
|
|
||||||
# send text to OUTPUT_FILENAME file
|
# send text to OUTPUT_FILENAME file
|
||||||
|
@ -150,9 +150,11 @@ sub run_command($command, $mod) {
|
|||||||
if (not $mod->{error}) {
|
if (not $mod->{error}) {
|
||||||
$mod->{output} .= "Success (no output).\n";
|
$mod->{output} .= "Success (no output).\n";
|
||||||
} else {
|
} else {
|
||||||
$mod->{output} .= "Exit code $mod->{error}.\n";
|
$mod->{output} .= "Exit $mod->{error}.\n";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
} elsif ($mod->{error}) {
|
||||||
|
$mod->{output} .= " [Exit $mod->{error}]";
|
||||||
}
|
}
|
||||||
|
|
||||||
return $mod->{output};
|
return $mod->{output};
|
||||||
|
@ -10,108 +10,110 @@ package _c_base;
|
|||||||
use parent '_default';
|
use parent '_default';
|
||||||
|
|
||||||
sub preprocess {
|
sub preprocess {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
my $input = $self->{input} // '';
|
my $input = $self->{input} // '';
|
||||||
|
|
||||||
open(my $fh, '>:encoding(UTF-8)', '.input');
|
open(my $fh, '>:encoding(UTF-8)', '.input');
|
||||||
print $fh "$input\n";
|
print $fh "$input\n";
|
||||||
close $fh;
|
|
||||||
|
|
||||||
my @cmd = $self->split_line($self->{cmdline}, strip_quotes => 1, preserve_escapes => 0);
|
|
||||||
|
|
||||||
if ($self->{code} =~ m/print_last_statement\(.*\);$/m) {
|
|
||||||
# remove print_last_statement wrapper in order to get warnings/errors from last statement line
|
|
||||||
my $code = $self->{code};
|
|
||||||
$code =~ s/print_last_statement\((.*)\);$/$1;/mg;
|
|
||||||
open(my $fh, '>:encoding(UTF-8)', $self->{sourcefile}) or die $!;
|
|
||||||
print $fh $code . "\n";
|
|
||||||
close $fh;
|
close $fh;
|
||||||
|
|
||||||
print STDERR "Executing [$self->{cmdline}] without print_last_statement\n";
|
my @cmd = $self->split_line($self->{cmdline}, strip_quotes => 1, preserve_escapes => 0);
|
||||||
my ($retval, $stdout, $stderr) = $self->execute(60, undef, @cmd);
|
|
||||||
$self->{output} = $stderr;
|
|
||||||
$self->{output} .= ' ' if length $self->{output};
|
|
||||||
$self->{output} .= $stdout;
|
|
||||||
$self->{error} = $retval;
|
|
||||||
|
|
||||||
# now compile with print_last_statement intact, ignoring compile results
|
if ($self->{code} =~ m/print_last_statement\(.*\);$/m) {
|
||||||
if (not $self->{error}) {
|
# remove print_last_statement wrapper in order to get warnings/errors from last statement line
|
||||||
open(my $fh, '>:encoding(UTF-8)', $self->{sourcefile}) or die $!;
|
my $code = $self->{code};
|
||||||
print $fh $self->{code} . "\n";
|
$code =~ s/print_last_statement\((.*)\);$/$1;/mg;
|
||||||
close $fh;
|
open(my $fh, '>:encoding(UTF-8)', $self->{sourcefile}) or die $!;
|
||||||
|
print $fh $code . "\n";
|
||||||
|
close $fh;
|
||||||
|
|
||||||
print STDERR "Executing [$self->{cmdline}] with print_last_statement\n";
|
print STDERR "Executing [$self->{cmdline}] without print_last_statement\n";
|
||||||
$self->execute(60, undef, @cmd);
|
my ($retval, $stdout, $stderr) = $self->execute(60, undef, @cmd);
|
||||||
|
$self->{output} = $stderr;
|
||||||
|
$self->{output} .= ' ' if length $self->{output};
|
||||||
|
$self->{output} .= $stdout;
|
||||||
|
$self->{error} = $retval;
|
||||||
|
|
||||||
|
# now compile with print_last_statement intact, ignoring compile results
|
||||||
|
if (not $self->{error}) {
|
||||||
|
open(my $fh, '>:encoding(UTF-8)', $self->{sourcefile}) or die $!;
|
||||||
|
print $fh $self->{code} . "\n";
|
||||||
|
close $fh;
|
||||||
|
|
||||||
|
print STDERR "Executing [$self->{cmdline}] with print_last_statement\n";
|
||||||
|
$self->execute(60, undef, @cmd);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
open(my $fh, '>:encoding(UTF-8)', $self->{sourcefile}) or die $!;
|
||||||
|
print $fh $self->{code} . "\n";
|
||||||
|
close $fh;
|
||||||
|
|
||||||
|
print STDERR "Executing [$self->{cmdline}]\n";
|
||||||
|
my ($retval, $stdout, $stderr) = $self->execute(60, undef, @cmd);
|
||||||
|
$self->{output} = $stderr;
|
||||||
|
$self->{output} .= ' ' if length $self->{output};
|
||||||
|
$self->{output} .= $stdout;
|
||||||
|
$self->{error} = $retval;
|
||||||
}
|
}
|
||||||
} else {
|
|
||||||
open(my $fh, '>:encoding(UTF-8)', $self->{sourcefile}) or die $!;
|
|
||||||
print $fh $self->{code} . "\n";
|
|
||||||
close $fh;
|
|
||||||
|
|
||||||
print STDERR "Executing [$self->{cmdline}]\n";
|
if ($self->{cmdline} =~ m/--(?:version|analyze)/) {
|
||||||
my ($retval, $stdout, $stderr) = $self->execute(60, undef, @cmd);
|
$self->{done} = 1;
|
||||||
$self->{output} = $stderr;
|
}
|
||||||
$self->{output} .= ' ' if length $self->{output};
|
|
||||||
$self->{output} .= $stdout;
|
|
||||||
$self->{error} = $retval;
|
|
||||||
}
|
|
||||||
|
|
||||||
if ($self->{cmdline} =~ m/--(?:version|analyze)/) {
|
|
||||||
$self->{done} = 1;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
sub postprocess {
|
sub postprocess {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
$self->SUPER::postprocess;
|
$self->SUPER::postprocess;
|
||||||
|
|
||||||
# no errors compiling, but if output contains something, it must be diagnostic messages
|
# no errors compiling, but if output contains something, it must be diagnostic messages
|
||||||
if(length $self->{output}) {
|
if (length $self->{output}) {
|
||||||
$self->{output} =~ s/^\s+//;
|
$self->{output} =~ s/^\s+//;
|
||||||
$self->{output} =~ s/\s+$//;
|
$self->{output} =~ s/\s+$//;
|
||||||
$self->{output} = "[$self->{output}]\n";
|
$self->{output} = "[$self->{output}]\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
print STDERR "Executing gdb\n";
|
print STDERR "Executing gdb\n";
|
||||||
my ($exitval, $stdout, $stderr);
|
my ($exitval, $stdout, $stderr);
|
||||||
|
|
||||||
my $ulimits = "ulimit -f 2000; ulimit -t 8; ulimit -u 200";
|
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 @args = $self->split_line($self->{arguments}, strip_quotes => 1, preserve_escapes => 0);
|
||||||
|
|
||||||
my $quoted_args = '';
|
my $quoted_args = '';
|
||||||
|
|
||||||
foreach my $arg (@args) {
|
foreach my $arg (@args) {
|
||||||
$arg =~ s/'/'"'"'/g;
|
$arg =~ s/'/'"'"'/g;
|
||||||
$quoted_args .= "'$arg' ";
|
$quoted_args .= "'$arg' ";
|
||||||
}
|
}
|
||||||
|
|
||||||
if ($self->{cmdline} =~ /-fsanitize=(?:[^ ]+,)?address/) {
|
if ($self->{cmdline} =~ /-fsanitize=(?:[^ ]+,)?address/) {
|
||||||
# leak sanitizer doesn't work under ptrace/gdb
|
# 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
|
# 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, "$ulimits; ./prog $quoted_args\n", '/bin/sh');
|
($exitval, $stdout, $stderr) = $self->execute(60, "$ulimits; ./prog $quoted_args\n", '/bin/sh');
|
||||||
} else {
|
} else {
|
||||||
my $input = "$ulimits; guest-gdb ./prog $quoted_args";
|
my $input = "$ulimits; guest-gdb ./prog $quoted_args";
|
||||||
($exitval, $stdout, $stderr) = $self->execute(60, $input, '/bin/sh');
|
($exitval, $stdout, $stderr) = $self->execute(60, $input, '/bin/sh');
|
||||||
}
|
}
|
||||||
|
|
||||||
my $result = $stderr;
|
$self->{error} = $exitval;
|
||||||
$result .= ' ' if length $result;
|
|
||||||
$result .= $stdout;
|
|
||||||
|
|
||||||
if (not length $result) {
|
my $result = $stderr;
|
||||||
$self->{no_output} = 1;
|
$result .= ' ' if length $result;
|
||||||
} elsif ($self->{code} =~ m/print_last_statement\(.*\);$/m
|
$result .= $stdout;
|
||||||
&& ($result =~ m/A syntax error in expression/ || $result =~ m/No symbol.*in current context/ || $result =~ m/has unknown return type; cast the call to its declared return/ || $result =~ m/Can't take address of.*which isn't an lvalue/)) {
|
|
||||||
# strip print_last_statement and rebuild/re-run
|
if (not length $result) {
|
||||||
$self->{code} =~ s/print_last_statement\((.*)\);/$1;/mg;
|
$self->{no_output} = 1;
|
||||||
$self->preprocess;
|
} elsif ($self->{code} =~ m/print_last_statement\(.*\);$/m
|
||||||
$self->postprocess;
|
&& ($result =~ m/A syntax error in expression/ || $result =~ m/No symbol.*in current context/ || $result =~ m/has unknown return type; cast the call to its declared return/ || $result =~ m/Can't take address of.*which isn't an lvalue/)) {
|
||||||
} else {
|
# strip print_last_statement and rebuild/re-run
|
||||||
$self->{output} .= $result;
|
$self->{code} =~ s/print_last_statement\((.*)\);/$1;/mg;
|
||||||
}
|
$self->preprocess;
|
||||||
|
$self->postprocess;
|
||||||
|
} else {
|
||||||
|
$self->{output} .= $result;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
Loading…
Reference in New Issue
Block a user