summaryrefslogtreecommitdiff
path: root/log_environment
blob: ee072043a4c219414740a75b2cc50b129baa56ac (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
#! /usr/bin/perl

# Log the environment in which this script is running.
# Each entry in @ARGV is a program of interest, which is invoked with the
# --version option.

# Copyright (C) 2021 Free Software Foundation, Inc.

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <https://www.gnu.org/licenses/>.

use v5.14;    # implicit use strict, use feature ':5.14'
use warnings FATAL => 'all';
use utf8;
use open qw(:utf8);

use Cwd qw(getcwd);
use FindBin ();
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
    which
);

# C library detection for Linux.  Algorithm from NPM package 'detect-libc',
# <https://github.com/lovell/detect-libc>; currently only supports GNU and
# musl libc.  If cross-compiling, the result is for the build environment,
# not the host or target.  Does not use a C compiler.
sub report_linux_libc {
    # Try getconf.
    my ($gcstat, @gcout) = get_status_and_output('getconf', 'GNU_LIBC_VERSION');
    if ($gcstat == 0) {
       my $gcver = $gcout[0];
       chomp $gcver;
       print "C library: $gcver\n\n";
       return;
    } elsif ($gcstat == -1) {
       print "getconf: command not found\n";
    }

    # Try ldd --version.
    my ($ldstat, @ldout) = get_status_and_output('ldd', '--version');
    if ($ldstat == 0 || $ldstat == 1) {
        my $ld1 = $ldout[0];
        my $ld2 = $ldout[1];
        if ($ld1 =~ /\bmusl\b/ia) {
            $ld2 =~ s/^version\s+(\S+).*$/$1/i;
            print "C library: musl $ld2\n\n";
            return;
        }
        if ($ld2 =~ /^copyright.*free software foundation/i) {
            $ld1 =~ s/^\S+\s+\([^\)]+\)\s+//;
            $ld1 =~ s/\s+\z//;
            print "C library: glibc $ld1\n\n";
            return;
        }

        print "WARNING: ldd --version output not recognized:\n";
        for my $line (@ldout) {
            print '> ', $line;
        }
        print "\n";

    } elsif ($ldstat == -1) {
        print "ldd: command not found\n";
    } else {
        print "WARNING: ldd --version exit $ldstat\n";
        for my $line (@ldout) {
            print '> ', $line;
        }
        print "\n";
    }

    # detect-libc goes on to poke around in /lib, which I don't think is
    # solid enough to base an actual detection on, but we may as well list
    # contents that may be relevant.
    print "C library: unknown\n\n";
    run("ls", "-l", glob('/lib*/{libc[.-],ld[-.]*.so}*'));
    print "\n";
}

sub report_machine {
    print "## Machine information:\n\n";

    my ($sysname, undef, $release, $version, $machine) = POSIX::uname();
    print '$(uname -m) = ', sh_quote($machine || 'unknown'), "\n";
    print '$(uname -r) = ', sh_quote($release || 'unknown'), "\n";
    print '$(uname -s) = ', sh_quote($sysname || 'unknown'), "\n";
    print '$(uname -v) = ', sh_quote($version || 'unknown'), "\n";
    print "\n";

    if ($sysname eq 'Linux') {
        report_linux_libc();

        my $npstat = get_status('nproc');
        if ($npstat != 0) {
            print "nproc: exit $npstat\n";
        }

    } elsif ($sysname eq 'FreeBSD') {
        run('sysctl', 'kern.sched.topology_spec');

    } else {
        print "WARNING: don't know how to probe #CPUs on this OS\n";
    }

    print "\n";
    my $cwd = getcwd();
    my $qcwd = sh_quote($cwd);
    print '$(pwd) = ', $qcwd, "\n";
    print "WARNING: working directory requires quotation\n"
        if $cwd ne $qcwd;
    print "\n";

    ## FIXME: Not all df implementations support -h or -T.
    run(qw(df -h -T), $cwd);

    print "\n";
}

sub report_ENV {
    my $envp = $_[0];
    print "## Environment variables:\n\n";
    for my $key (sort keys %$envp) {
        print '  ', sh_quote($key), '=', sh_quote($envp->{$key}), "\n";
    }
    print "\n";
}

sub report_programs {
    print "## Programs used during build:\n\n";

    for my $prog (@_) {
        my ($absprog) = which($prog);
        if ($absprog) {
            print sh_quote($prog), ' is ', sh_quote($absprog), "\n";

            # 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";
        }
        print "\n";
    }
}

sub main {
    my %orig_env = %ENV;
    ensure_C_locale();
    ensure_empty_stdin();

    print "# CI environment report\n";
    report_machine();
    report_ENV(\%orig_env);
    report_programs(@_) if scalar(@_);
};

eval {
    main(@ARGV);
    exit(0);
};
error("$@");