diff options
author | Zack Weinberg <zackw@panix.com> | 2021-09-26 12:04:28 -0400 |
---|---|---|
committer | Zack Weinberg <zackw@panix.com> | 2021-09-26 12:04:28 -0400 |
commit | 08b6f99cef7fffd47083341e464e45ee971ddee1 (patch) | |
tree | 8f5c8d53dc4e96e99ec247ca454eda2cecc30cf0 | |
parent | d2b2a03a240be1d798612dec06e4889d98af8713 (diff) | |
download | autoconf-08b6f99cef7fffd47083341e464e45ee971ddee1.tar.gz |
log_environment: Make version probes more robust.
-rw-r--r-- | BuildCommon.pm | 65 | ||||
-rwxr-xr-x | 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(@_); }; |