From 08b6f99cef7fffd47083341e464e45ee971ddee1 Mon Sep 17 00:00:00 2001
From: Zack Weinberg <zackw@panix.com>
Date: Sun, 26 Sep 2021 12:04:28 -0400
Subject: log_environment: Make version probes more robust.

---
 BuildCommon.pm  | 65 ++++++++++++++++++++++++++++++++++++++++++++++++++++-----
 log_environment | 23 +++++++++++++++++---
 2 files changed, 80 insertions(+), 8 deletions(-)

diff --git a/BuildCommon.pm b/BuildCommon.pm
index 321442ce..137dc38f 100644
--- a/BuildCommon.pm
+++ b/BuildCommon.pm
@@ -32,7 +32,9 @@ use Exporter qw(import);
 BEGIN {
     @EXPORT_OK = qw(
         ensure_C_locale
+        ensure_empty_stdin
         error
+        get_status
         get_status_and_output
         popen
         run
@@ -72,7 +74,7 @@ sub subprocess_error {    ## no critic (Subroutines::RequireArgUnpacking)
     my $status = $?;
     my $cmd    = join q{ }, @_;
     if ($syserr) {
-        error("system error with pipe to $cmd: $syserr");
+        error("system error with $cmd: $syserr");
 
     } elsif ($status == 0) {
         return;
@@ -157,11 +159,21 @@ sub run {    ## no critic (Subroutines::RequireArgUnpacking)
     die 'run: no command to execute'
         if scalar(@_) == 0;
     log_execution(@_);
-    my $status = system { $_[0] } @_;
 
-    return                  if $status == 0;
-    invocation_error($_[0]) if $status == -1;
-    subprocess_error(@_);
+    my $pid = fork
+        // invocation_error($_[0]);
+
+    if ($pid == 0) {
+        # child
+        { exec {$_[0]} @_; };
+        print {*STDERR} "exec $_[0] failed: $!\n";
+        exit(127);
+    }
+
+    # parent
+    waitpid $pid, 0;
+    undef $!;
+    subprocess_error(@_) if $?;
 }
 
 # Run, and log execution of, a subprocess.  @_ should be one of the
@@ -182,6 +194,39 @@ sub popen {
     return $fh;
 }
 
+# Run, and log execution of, a subprocess.  @_ should be an argument vector.
+# If the subprocess exits normally (successful or unsuccessful),
+# returns the exit status.
+# If the subprocess could not be started because there is no such command,
+# returns -1.
+# Otherwise invocation_error/subprocess_error are called as appropriate.
+sub get_status {
+    die 'run: no command to execute'
+        if scalar(@_) == 0;
+    log_execution(@_);
+
+    my $pid = fork
+        // invocation_error($_[0]);
+
+    if ($pid == 0) {
+        # child
+        { exec {$_[0]} @_; };
+        exit(126) if $!{ENOENT};
+        print {*STDERR} "exec $_[0] failed: $!\n";
+        exit(127);
+    }
+
+    # parent
+    waitpid $pid, 0;
+    undef $!;
+    if ($? == 0x7F00 || ($? & 0x7F) != 0) {
+        subprocess_error(@_);
+    }
+    my $status = $? >> 8;
+    return -1 if $status == 126;
+    return $status;
+}
+
 # Run, and log execution of, a subprocess.  Capture all of its output,
 # including both stdout and stderr.
 # @_ should be an argument vector.
@@ -252,6 +297,16 @@ sub ensure_C_locale {
     return;
 }
 
+# Close standard input at the OS level and reopen it on /dev/null.
+# This ensures that no subprocesses will get stuck trying to read from
+# standard input.
+sub ensure_empty_stdin {
+    use POSIX qw(open close dup2 O_RDONLY);
+    my $fd = open('/dev/null', O_RDONLY) // die "open('/dev/null'): $!\n";
+    dup2($fd, 0) // die("dup2($fd, 0): $!\n");
+    close($fd);
+}
+
 # Clean up $ENV{PATH}, and return the cleaned path as a list.
 sub clean_PATH {
     state @path;
diff --git a/log_environment b/log_environment
index 5aa13db1..80388ec3 100755
--- a/log_environment
+++ b/log_environment
@@ -31,7 +31,9 @@ use POSIX ();
 use lib $FindBin::Bin;
 use BuildCommon qw(
     ensure_C_locale
+    ensure_empty_stdin
     error
+    get_status
     get_status_and_output
     run
     sh_quote
@@ -152,7 +154,21 @@ sub report_programs {
         my ($absprog) = which($prog);
         if ($absprog) {
             print sh_quote($prog), ' is ', sh_quote($absprog), "\n";
-            run($absprog, '--version');
+
+            # Try various options that might get a program to print its
+            # version number, in order of likelihood.
+            # mawk only recognizes -Wversion
+            # -qversion is in AC_PROG_CC's list of things to try
+            for my $vopt (qw(--version -V -v -Wversion -qversion)) {
+                my $status = get_status($absprog, $vopt);
+                last if $status == 0;
+                if ($status == -1) {
+                    # 'no such file or directory' doesn't make sense here
+                    print "$absprog $vopt: exit 126\n";
+                } else {
+                    print "$absprog $vopt: exit $status\n";
+                }
+            }
         } else {
             print "WARNING: $prog not found in \$PATH\n";
         }
@@ -163,10 +179,11 @@ sub report_programs {
 sub main {
     my %orig_env = %ENV;
     ensure_C_locale();
+    ensure_empty_stdin();
 
     print "# CI environment report\n";
-    report_machine();
-    report_ENV(\%orig_env);
+    #report_machine();
+    #report_ENV(\%orig_env);
     report_programs(@_) if scalar(@_);
 };
 
-- 
cgit v1.2.1