From 3e2204a6b00a7ac2e3d5002a4f7231284dae2a3e Mon Sep 17 00:00:00 2001
From: Pragmatic Software <pragma78@gmail.com>
Date: Sun, 6 Mar 2022 13:51:33 -0800
Subject: [PATCH] pbot-vm: improve exit-code handling

---
 applets/pbot-vm/guest/bin/guest-gdb           |  12 +-
 applets/pbot-vm/guest/lib/Guest.pm            |   4 +-
 .../pbot-vm/guest/lib/Languages/_c_base.pm    | 164 +++++++++---------
 3 files changed, 93 insertions(+), 87 deletions(-)

diff --git a/applets/pbot-vm/guest/bin/guest-gdb b/applets/pbot-vm/guest/bin/guest-gdb
index 44071af1..4b03cc5f 100755
--- a/applets/pbot-vm/guest/bin/guest-gdb
+++ b/applets/pbot-vm/guest/bin/guest-gdb
@@ -441,8 +441,6 @@ sub cmd_print_last_statement($context, $args) {
 }
 
 sub handle_program_exit($context, $data) {
-    my $reason = $data->{reason};
-
     if (not -s OUTPUT_FILENAME) { # -s gets size of file
         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);
 }
 
@@ -541,7 +543,7 @@ sub handle_exec_async_output($context, $output) {
         if ($reason eq 'breakpoint-hit') {
             handle_breakpoint_hit($context, $output);
         }
-        elsif ($reason eq 'exited-normally') {
+        elsif ($reason eq 'exited-normally' || $reason eq 'exited') {
             handle_program_exit($context, $output);
         }
         elsif ($reason eq 'signal-received') {
@@ -592,9 +594,9 @@ sub _exit($context) {
     my $output = do { local $/; <$fh> };
     close $fh;
 
-    print STDOUT "$output\n";
+    print STDOUT "$output";
 
-    exit;
+    exit ($context->{'exit-code'} // 0);
 }
 
 # send text to OUTPUT_FILENAME file
diff --git a/applets/pbot-vm/guest/lib/Guest.pm b/applets/pbot-vm/guest/lib/Guest.pm
index 8b55959a..433df93c 100644
--- a/applets/pbot-vm/guest/lib/Guest.pm
+++ b/applets/pbot-vm/guest/lib/Guest.pm
@@ -150,9 +150,11 @@ sub run_command($command, $mod) {
             if (not $mod->{error}) {
                 $mod->{output} .= "Success (no output).\n";
             } 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};
diff --git a/applets/pbot-vm/guest/lib/Languages/_c_base.pm b/applets/pbot-vm/guest/lib/Languages/_c_base.pm
index 52e27bc4..07bbf7ec 100755
--- a/applets/pbot-vm/guest/lib/Languages/_c_base.pm
+++ b/applets/pbot-vm/guest/lib/Languages/_c_base.pm
@@ -10,108 +10,110 @@ package _c_base;
 use parent '_default';
 
 sub preprocess {
-  my $self = shift;
+    my $self = shift;
 
-  my $input = $self->{input} // '';
+    my $input = $self->{input} // '';
 
-  open(my $fh, '>:encoding(UTF-8)', '.input');
-  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";
+    open(my $fh, '>:encoding(UTF-8)', '.input');
+    print $fh "$input\n";
     close $fh;
 
-    print STDERR "Executing [$self->{cmdline}] without print_last_statement\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;
+    my @cmd = $self->split_line($self->{cmdline}, strip_quotes => 1, preserve_escapes => 0);
 
-    # 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;
+    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;
 
-      print STDERR "Executing [$self->{cmdline}] with print_last_statement\n";
-      $self->execute(60, undef, @cmd);
+        print STDERR "Executing [$self->{cmdline}] without print_last_statement\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;
+
+        # 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";
-    my ($retval, $stdout, $stderr) = $self->execute(60, undef, @cmd);
-    $self->{output} = $stderr;
-    $self->{output} .= ' ' if length $self->{output};
-    $self->{output} .= $stdout;
-    $self->{error}  = $retval;
-  }
-
-  if ($self->{cmdline} =~ m/--(?:version|analyze)/) {
-    $self->{done} = 1;
-  }
+    if ($self->{cmdline} =~ m/--(?:version|analyze)/) {
+        $self->{done} = 1;
+    }
 }
 
 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
-  if(length $self->{output}) {
-    $self->{output} =~ s/^\s+//;
-    $self->{output} =~ s/\s+$//;
-    $self->{output} = "[$self->{output}]\n";
-  }
+    # no errors compiling, but if output contains something, it must be diagnostic messages
+    if (length $self->{output}) {
+        $self->{output} =~ s/^\s+//;
+        $self->{output} =~ s/\s+$//;
+        $self->{output} = "[$self->{output}]\n";
+    }
 
-  print STDERR "Executing gdb\n";
-  my ($exitval, $stdout, $stderr);
+    print STDERR "Executing gdb\n";
+    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) {
-      $arg =~ s/'/'"'"'/g;
-      $quoted_args .= "'$arg' ";
-  }
+    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, "$ulimits; ./prog $quoted_args\n", '/bin/sh');
-  } else {
-      my $input = "$ulimits; guest-gdb ./prog $quoted_args";
-      ($exitval, $stdout, $stderr) = $self->execute(60, $input, '/bin/sh');
-  }
+    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, "$ulimits; ./prog $quoted_args\n", '/bin/sh');
+    } else {
+        my $input = "$ulimits; guest-gdb ./prog $quoted_args";
+        ($exitval, $stdout, $stderr) = $self->execute(60, $input, '/bin/sh');
+    }
 
-  my $result = $stderr;
-  $result .= ' ' if length $result;
-  $result .= $stdout;
+    $self->{error} = $exitval;
 
-  if (not length $result) {
-    $self->{no_output} = 1;
-  } elsif ($self->{code} =~ m/print_last_statement\(.*\);$/m
-    && ($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
-    $self->{code} =~ s/print_last_statement\((.*)\);/$1;/mg;
-    $self->preprocess;
-    $self->postprocess;
-  } else {
-    $self->{output} .= $result;
-  }
+    my $result = $stderr;
+    $result .= ' ' if length $result;
+    $result .= $stdout;
+
+    if (not length $result) {
+        $self->{no_output} = 1;
+    } elsif ($self->{code} =~ m/print_last_statement\(.*\);$/m
+        && ($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
+        $self->{code} =~ s/print_last_statement\((.*)\);/$1;/mg;
+        $self->preprocess;
+        $self->postprocess;
+    } else {
+        $self->{output} .= $result;
+    }
 }
 
 1;