#!/usr/bin/perl -w (my $sysinfo_revision = '$Rev: 6622 $') =~ s/^.Rev: (\d+) .*/r$1/; (my $sysinfo_date = '$Date: 2021-04-07 08:18:59 -0400 (Wed, 07 Apr 2021) $') =~ s/^.Date: (\S+) .*/$1/; # This is a 'sysinfo' program, for use with SPECaccel. It can help # you get started filling out some important SUT (System Under Test) disclosure # fields, but it does NOT remove the need for a human being to understand the # SUT. # Updates # # This program is likely to evolve. To check for updates, run # runaccel --update # See https://www.spec.org/accel2023/Docs/runaccel.html#update for details # Usage # # (1) In your config file, put the following near the top: # # sysinfo_program = specperl $[top]/bin/sysinfo # # Optional switches: # -f Do not write fields; instead, write comments # -p Do not write platform notes; instead, write comments # # (2) Unless you use the optional -f switch, be sure to search for # "promisedfields", below, to find the list of fields that will # be written by this file. If your config file also sets those fields, # you have several choices for what to do about duplicate fields, which # are described at: # # https://www.spec.org/cpu2017/Docs/config.html#sysinfo # Outputs # # Unless one of the above switches is set, writes some free-form platform # notes plus various sw_xx and hw_xx fields. To find the list of fields # output, search for "promisedfields", below. # # If you choose to write comments, these go to the *output* copy of the config # file that goes to the *result* directory. For more info on this point, See # the sysinfo documentation: # # https://www.spec.org/cpu2017/Docs/config.html#sysinfo # Structure of this script # # The main routine detects the OS, and dispatches to a system-specific # subroutine. # # The system-specific subroutine talks to useful utilities and as it does # so, (1) calls notesout() to format platform notes, and (2) builds the # global data structure # # $hw_fields{fieldname} # # where the "fieldnames" are the familiar fields such as "hw_model", # "sw_os" and so forth. # # After visiting the system-specific subroutine, # # write_fields() # # actually writes them. # Changing or customizing this script # # To add free-form information: # - In the OS-specific routine, visit the system utility that you are # interested in, capture its output, and just send it to notesout() # - Notice that notesout() doesn't mind if you hand it one line or # multiple lines. # # To add a field: # - (1) add code that assigns to $hw_fields{newfield} # - (2) add newfield to the data structure promisedfields # # To delete a field: # - (1) remove (or comment out) the assignment to $hw_fields{whatever} # - (2) remove it from the data structure promisedfields # j.henning jun 2011 # Copyright 2011-2023 Standard Performance Evaluation Corporation # $Id: sysinfo 6622 2021-04-07 12:18:59Z JohnHenning $ # #------------------------------------------------------------------------- # main routine use strict; use Text::Tabs; use Cwd; use Sys::Hostname; use IO::File; use IO::Dir; use List::Util qw(max); use Scalar::Util qw(looks_like_number); eval { require Digest::SHA; Digest::SHA->import() }; my $has_SHA = $@ eq ''; use Text::Wrap qw(wrap $columns); $Text::Wrap::unexpand = 0; $columns = 90; # wrap notes here my $scriptdir = cwd; # globals my $notes_section = "notes_plat_sysinfo"; # which notes setion to use my $punt = "could not determine"; # the last, last resort my $fieldsok = 1; # If this is 1, some output goes to hw_xxx/sw_xxx my $notesok = 1; # If this is 1, some output goes to notes section my $quiet = 0; # If 1, be less chatty. my $fnwidth = 14; # (minimum) width of field names, to align # when pretty-printing. This is used for # both sw_xx, hw_xx, and within some notes my $notenum = 0; # global to recall what notenum we are on my %fields; # global for any fields we figure out my @lscpu; # if 'lscpu' utility is present, lines as reported my %lscpu; # and broken into key/value pairs my $pc4_format = "'N GB (N x N GB nRxn PC4-nnnnX-X)'"; sub notesout; sub write_fields; # process arguments while (my $arg = shift) { if ($arg eq "-f") { $fieldsok = 0; } elsif ($arg eq '-h') { print "$0 options:\n" ." -f to turn fields into comments\n" ." -p to do the same to platform notes\n" ." -q to suppress log messages\n"; exit; } elsif ($arg eq "-p") { $notesok = 0; } elsif ($arg eq "-q") { $quiet = 1; } else { print "# unrecognized argument '$arg' given to $0, use '-h' for help\n"; sleep 2; print "log 0 unrecognized argument '$arg'\n"; } } # Do we know this OS? If so, dispatch begin_report(); my $os = ""; # canonical spelling for key to field list if ($^O =~ /mswin/i) { $os = "mswin"; print "log 0 Getting system information for Windows...\n" unless $quiet; sysinfo_mswin(); } elsif ($^O =~ /linux/i) { $os = "linux"; print "log 0 Getting system information for Linux...\n" unless $quiet; sysinfo_linux(); } elsif ($^O =~ /solaris/i) { $os = "solaris"; print "log 0 Getting system information for Solaris...\n" unless $quiet; sysinfo_solaris(); } elsif ($^O =~ /darwin/i) { $os = "macosx"; print "log 0 Getting system information for MacOS X...\n" unless $quiet; sysinfo_macosx(); } elsif ($^O =~ /aix/i) { $os = "aix"; print "log 0 Getting system information for AIX...\n" unless $quiet; sysinfo_aix(); } else { print "log 0 ==============================================================================\n" . "log 0 ERROR: $^O is not supported by $0.\n" . "log 0 WARNING: If you plan to publish your results, you will need a working sysinfo.\n" . "log 0 For help, contact SPEC technical support.\n" . "log 0 ==============================================================================\n"; notesout( "\n=============================================================================\n" . "ERROR: $^O is not supported by $0\n" . "WARNING: If you plan to publish your results, you will need a working\n" . " sysinfo. For help, contact SPEC technical support.\n" . "=============================================================================\n"); } notesout "\n(End of data from sysinfo program)"; write_fields(); exit; #======================================================================== # Utility subroutines (alphabetical order, please) #======================================================================== #--------------------------------- sub begin_report { my $hostname = hostname(); chomp $hostname; my $date = localtime(); my $selfsum; if ($has_SHA) { $selfsum = filedigest($0, 512, 128); } else { $selfsum = "NOHASH: Could not compute self-sum."; $selfsum .= " To fix, try running $0 under specperl." if ($^X !~ /specperl/); } print "log 0 $sysinfo_revision of $sysinfo_date ($selfsum)\n" unless $quiet; notesout <= $tb and ($bytes % $tb) == 0) { return $bytes / $tb . " TB"; } elsif ($bytes >= $gb and ($bytes % $gb) == 0) { return $bytes / $gb . " GB"; } elsif ($bytes >= $mb and ($bytes % $mb) == 0) { return $bytes / $mb . " MB"; } elsif ($bytes >= $kb and ($bytes % $kb) == 0) { return $bytes / $kb . " KB"; } else { return $bytes; } } #--------------------------------- sub divide_maybe { my $top = shift; my $bottom = shift; my $answer = "(?)"; if (looks_like_number($top) and ($top != 0) and looks_like_number($bottom) and ($bottom != 0) and (int($top/$bottom) == $top/$bottom) ) { $answer = $top/$bottom; } return $answer; } #--------------------------------- sub filedigest { my ($fname, $bits, $trim) = @_; $bits = $bits // 512; $trim = $trim // $bits; my $ctx = Digest::SHA->new($bits); if (!defined($ctx)) { print "log 0 sysinfo: Error getting Digest::SHA context for SHA-$bits\n"; return "NOHASH: Error getting Digest::SHA context for SHA-$bits"; } if (-e $fname) { my $ifh = new IO::File $fname, O_RDONLY|O_BINARY; if (!defined($ifh)) { print "log 0 sysinfo: Error opening $fname for reading\n"; return "NOHASH: Error opening $fname for reading"; } $ctx->addfile($ifh); my $hash = $ctx->hexdigest(); return substr($hash, -($trim / 4)); } return "NOHASH: $fname does not exist"; } #--------------------------------- sub linux_power_chip { my $nchips; my $ppc64cmd = 'ppc64_cpu --cores-present'; my @ppc64 = qx{$ppc64cmd}; my $ncores = 0; if (! @ppc64) { notesout "\n$ppc64cmd\n No result available"; } else { chomp @ppc64; (my $ignore, $ncores) = split "=", $ppc64[0]; chomp $ncores; notesout "\nNumber of cores, from '$ppc64cmd' : $ncores\n"; } notesout "\nWARNING regarding the output of 'lscfg': this utility reports resources" . " for the system, not the current partition. Therefore, for a partition" . " that has a subset of the full system resources:"; notesout " (1) The tester may need to adjust the sysinfo-supplied 'hw_ncores'."; notesout " (2) The tester may need to adjust the sysinfo-supplied 'hw_nchips'."; my $lcmd = 'lscfg -vp'; my @lscfg = qx{$lcmd}; if (! @lscfg) { notesout "\n$lcmd\n No result available. Consider installing lscfg."; } elsif ((scalar @lscfg < 5) && (grep /root/, @lscfg)) { notesout "\nCannot run lscfg; consider running as root."; } else { chomp @lscfg; # hw_nchips my @wayProc; my $ways = 0; my $looking = 0; for my $line (@lscfg) { if ($line =~ m/(\d+)-WAY\s+PROC/) { # PowerVM systems take this path. $ways += $1; $looking = $line; $looking =~ s/^\s+//; push @wayProc, "$looking"; } elsif ($line =~ m/Node: cpu@/) { # POWER servers running OPAL firmware go here... $ways += 1; } elsif ($line =~ m/Node: processor@/) { # ... and here. $looking = $line; $looking =~ s/^\s+//; push @wayProc, "$looking"; } next; } notesout "\nProcessors, from $lcmd\n " . join "\n ", @wayProc; $nchips = scalar @wayProc; if (! defined $ncores) { $ncores = $ways; } elsif ($ncores != $ways) { notesout " ^^^Note: sum of ways = $ways, differs from 'ppc64_cpu --cores-present'\n"; $ncores = "$ncores (?)"; } notesout ""; } my $nthreads = qx'grep -c -P "^processor\s+:" /proc/cpuinfo'; chomp $nthreads; notesout " $nthreads \"processors\""; my $nthreads_per_core = divide_maybe($nthreads, $ncores); return ($nchips, $ncores, $nthreads_per_core); } #--------------------------------- sub linux_sparc_chip { my $nchips = $punt; my $ncores = $punt; my $nthreads_per_core = $punt; my $ncores_per_chip = $punt; if (! lscpu()) { notesout "lscpu utility not available; please consider adding it"; $nchips = $ncores = $nthreads_per_core = $punt; } else { # if (defined($lscpu{"Socket(s)"}) and defined($lscpu{"NUMA node(s)"})) { if ($lscpu{"Socket(s)"} == $lscpu{"NUMA node(s)"}) { notesout " WARNING: the 'lscpu' utility may not be able to correctly report " . "some systems, for example virtual machines. The tester should verify " . 'chip/core/threads independently.'; } else { notesout " WARNING the 'lscpu' utility might confuse its " . 'concept of "sockets" with the SPARC concept of "core clusters". Although the ' . "SPEC 'sysinfo' utility tries to adjust, the tester should verify " . 'chip/core/threads independently.'; } # the above-mentioned adjustment: believe whichever is smaller. if ($lscpu{"Socket(s)"} < $lscpu{"NUMA node(s)"}) { $nchips = $lscpu{"Socket(s)"}; } else { $nchips = $lscpu{"NUMA node(s)"}; } } if (defined($lscpu{"Core(s) per socket"}) and defined($lscpu{"Socket(s)"}) ) { $ncores = $lscpu{"Core(s) per socket"} * $lscpu{"Socket(s)"}; } if (defined ($lscpu{"Thread(s) per core"})) { $nthreads_per_core = $lscpu{"Thread(s) per core"}; } return ($nchips, $ncores, $nthreads_per_core); } } #--------------------------------- sub linux_x86_chip { my $nchips = qx{grep "physical id" /proc/cpuinfo | sort | uniq | wc -l}; chomp $nchips; if ($nchips == 0) { $nchips = $punt; notesout </dev/null}; if (@cachelines) { notesout "\nFrom lscpu --cache:"; for my $line (@cachelines) { notesout " $line"; } } } return scalar @lscpu; } #--------------------------------- sub notesout { # output noteslines with wrapping # Note that you can call this with a single line, or with multiple lines while (@_) { my $arg = shift; # prevent auto-delete of empty lines $arg =~ s/\n/ \n/g; my @lines = split "\n", $arg; chomp @lines; for my $line (@lines) { $line =~ s/(\S)\s+$/$1/; # no trailing blanks my $indent = ""; if ($line =~ m/^(\s+)/) { # respect incoming indents $indent = $1; } my @split_lines = split "\n", wrap("", $indent, $line); push (@split_lines, " ") if ! @split_lines; # respect incoming blank lines for my $sl (@split_lines) { if ($notesok) { printf "%s_%03d = ", $notes_section, ($notenum * 5); $notenum++; } else { printf "# "; } print "$sl\n"; } } } } #--------------------------------- sub numerically { $a <=> $b; } #--------------------------------- sub read_vuln_file { # Read the contents of a file out, prepending the tag to the first line and # padding subsequent lines to line up with the first. # Report "No status reported" if the file does not exist or is empty. my ($tag, $fn) = @_; my @rc = (); my $indent = (' ' x length($tag)); my $ifh = new IO::File '<'.$fn; if (defined($ifh)) { while(defined(my $line = $ifh->getline())) { chomp($line); push @rc, wrap("", $indent.' ', "${tag} ${line}"); $tag = $indent; } } return @rc if @rc; return ("${tag} No status reported"); } #--------------------------------- sub read_directory_files { my ($dir) = @_; my $dh = new IO::Dir $dir; return grep { defined } map { -f $dir.'/'.$_ and $_ or undef } $dh->read() if defined($dh); return (); } #--------------------------------- sub simplify_cpu_name { my $cpu = shift; $cpu =~ s/\((R|tm)\)//ig; $cpu =~ s/CPU//g; $cpu =~ s/processor//ig; $cpu =~ s/\@\s+[\d\.]+\s*GHz//i; # at best nominal speed $cpu =~ s/^\s+//; $cpu =~ s/\s+/ /g; return $cpu; } #--------------------------------- sub write_fields { # # This subroutine actually writes the fields. It also serves as a # backstop, in case the OS-specific subroutines somehow fail to come up # with information about some field(s) that were promised: if we do not # have useful information, then insert at least a minimal template. # my %promisedfields; $promisedfields{"aix"} = < "99999 (integer MHz, as specified by the chip vendor)", hw_cpu_name => "cpu name", hw_disk => "size, type, other perf-relevant char of SPEC disk", hw_memory => "format is $pc4_format", hw_model => "model name", hw_nchips => "number of chips enabled", hw_ncores => "number of cores enabled", hw_nthreadspercore => "number of threads enabled per core", hw_pcache => "size, type, location: e.g. 99 KB I + 99 KB D on chip per core", hw_scache => "size, type, location: e.g. 99 MB I+D on chip per chip", hw_tcache => "size, type, location: e.g. 99 MB I+D off chip per system board", hw_vendor => "hardware manufacturer", sw_os => "operating system", sw_other => "Other performance relevant sw", sw_state => "software state (e.g runlevel)", ); # Verify that we have *something* for all promised fields unless (!defined $promisedfields{$os}) { for my $f (split " ", $promisedfields{$os}) { if (!defined $fields{$f}) { if (defined $templatef{$f}) { $fields{$f} = $templatef{$f}; } else { if ($f =~ m/^([^0-9]+)([0-9]+)$/) { my $basef = $1; my $fnum = $2; if (defined $templatef{$basef}) { $fields{$f} = $templatef{$basef} . " part $fnum"; } else { $fields{$f} = $punt; } } else { $fields{$f} = $punt; } } } } } print "\n"; # use fnwidth global as the minimum, but expand if needed for my $key (sort keys %fields) { $fnwidth = length $key if (length($key) > $fnwidth); } for my $key (sort keys %fields) { print "# " if ! $fieldsok; $fields{$key} =~ s/^\s+//; $fields{$key} =~ s/\s+$//; printf "%-${fnwidth}s = %s\n", $key, $fields{$key}; } } #======================================================================== # The actual sysinfo_xxx routines. #======================================================================== #--------------------------------- AIX ---------------- sub sysinfo_aix { print "log 0 ...getting prtconf info\n" unless $quiet; my @prtconf_lines = qx{/usr/sbin/prtconf}; chomp @prtconf_lines; notesout "WARNING regarding the output of 'prtconf':"; notesout " (1) The tester may need to adjust the sysinfo-supplied 'hw_nominal_mhz'."; notesout " (2) The 'Number of Processors' reported by prtconf is the number of cores available to the partition."; notesout "From prtconf:"; (my $host) = map m/(Host Name:.*)/, @prtconf_lines; notesout " $host\n" if defined $host; # hw_model (my $model) = grep m/System Model:/, @prtconf_lines; if (defined $model and $model =~ m/System Model:\s*(.*)/) { my $tmp = $1; $tmp =~ s/^IBM,//; $fields{"hw_model"} = $tmp; notesout " $model\n"; } # hw_cpu_name my @proctype = grep m/Processor Type:/, @prtconf_lines; if (@proctype) { (my $name) = ($proctype[0] =~ m/Type:\s*(.*)/); if ($name =~ m/PowerPC_(POWER\d.*)/) { $name = $1; } ($fields{"hw_cpu_name"}) = $name; } # hw_cpu_nominal_mhz my @mhz_lines = grep /Processor Clock Speed/, @prtconf_lines; if ((@mhz_lines == 1) && ($mhz_lines[0] =~ m/Processor Clock Speed:\s+(\d+)\s+MHz/)) { my $mhz = $1; notesout " " . $mhz_lines[0]; $fields{"hw_cpu_nominal_mhz"} = $mhz; } elsif (@mhz_lines > 1) { notesout "\nMore than one line about Processor Clock Speed from prtconf:\n"; notesout join "\n ", @mhz_lines; } # hw_ncores my $ncores; (my $nprocs) = grep /Number Of Processors/, @prtconf_lines; if (defined $nprocs) { if ($nprocs =~ m/Number Of Processors:\s*(\d+)/) { $ncores = $1; } notesout " $nprocs"; } # hw_memory (my $memsize) = grep m/^Memory Size:/, @prtconf_lines; if (defined $memsize and $memsize =~ m/(\d+.*)/) { $fields{"hw_memory"} = $1 . " fixme: format is: $pc4_format"; notesout " $memsize\n"; } # fw_bios (my $firmware) = grep m/^Firmware Version:/, @prtconf_lines; (my $ignore, $firmware) = split ":", $firmware; if (defined $firmware and $firmware ne '') { $firmware =~ s/.*\(|\)//g; $fields{"fw_bios"} = $firmware; notesout " BIOS Version: $firmware\n"; } print "log 0 ...getting chip/core/memory info\n" unless $quiet; my $lcmd = 'lscfg -vplsysplanar0'; my @lscfg = qx{$lcmd}; if (! @lscfg) { notesout "\n$lcmd\n No result available"; } else { notesout "\nWARNING regarding the output of 'lscfg': this utility reports resources" . " for the system, not the current partition. Therefore, for a partition" . " that has a subset of the full system resources:"; notesout " (1) The tester may need to adjust the sysinfo-supplied 'hw_ncores'."; notesout " (2) The tester may need to adjust the sysinfo-supplied 'hw_nchips'."; notesout " (3) Be aware that 'hw_memory' is set from 'prtconf', and is correct" . " for the partition, but \"Memory DIMM info from lscfg\" reports the" . " number of DIMMs in the entire server. "; chomp @lscfg; # hw_nchips, hw_ncores my @wayProc; my $ways = 0; my $looking = 0; for my $line (@lscfg) { if ($line =~ m/(\d+)-WAY\s+PROC/) { $ways += $1; $looking = $line; $looking =~ s/^\s+//; next; } next unless $looking; if ($line =~ m/FRU Number[.]+(\S+)/) { push @wayProc, "$looking $1"; $looking = 0; } } notesout "Processors, from $lcmd\n " . join "\n ", @wayProc; my $nchips = scalar @wayProc; if (! defined $ncores) { $ncores = $ways; } elsif ($ncores != $ways) { notesout " ^^^Note: sum of ways = $ways, differs from prtconf 'Number Of Processors'\n"; $ncores = "$ncores (?)"; } $fields{"hw_nchips"} = $nchips; $fields{"hw_ncores"} = $ncores; # # memory detail my %dimms; $looking = 0; for my $line (@lscfg) { $looking = 1 if ($line =~ m/Memory DIMM:/); next unless $looking; if ($line =~ m/FRU Number[.]+(\S+)/) { $dimms{$1}++; $looking = 0; } } notesout "Memory DIMM info from lscfg:\n"; for my $type (sort keys %dimms) { notesout sprintf " %4dx %s", $dimms{$type}, $type; } } print "log 0 ...getting os info\n" unless $quiet; # sw_os my $formal_os_name = qx{uname -s}; my $oslevel = qx{oslevel}; my $oslevel_detail = qx{oslevel -s}; chomp $formal_os_name; chomp $oslevel; chomp $oslevel_detail; notesout "\nOperating System: $formal_os_name $oslevel $oslevel_detail\n"; $fields{"sw_os"} = "$formal_os_name $oslevel"; print "log 0 ...getting disk info\n" unless $quiet; # hw_disk my $s = defined($ENV{"SPEC"}) ? $ENV{'SPEC'} : '.'; my $dcmd = "df -k $s"; my @dlines = qx{$dcmd}; if (@dlines) { chomp @dlines; notesout "\ndisk: $dcmd\n " . join "\n ", @dlines; (undef, my $blocks) = split " ", $dlines[$#dlines]; my @unit = ("KB", "MB", "GB", "TB"); my $n = 0; while ($blocks > 1024) { $blocks /= 1024; $n++; } $fields{"hw_disk"} = sprintf "%.1f %s (add: type, other perf-relevant info)", $blocks, $unit[$n]; } #--------- prepared by ---- my $who; $who = $ENV{"LOGNAME"}; chomp $who; $fields{"prepared_by"} = "$who (is never output, only tags rawfile)"; } #--------------------------------- Solaris --------------- sub sysinfo_solaris { #--------- cpu name ---- print "log 0 ...getting CPU info\n" unless $quiet; # Seen at least three formats output # #The physical processor has 1 virtual processor (0) # UltraSPARC-III (portid 0 impl 0x14 ver 0x34 clock 750 MHz) # #The physical processor has 4 virtual processors (0 4 8 12) # x86 (GenuineIntel 6FB family 6 model 15 step 11 clock 2933 MHz) # Intel(r) Xeon(r) CPU X7350 @ 2.93GHz # #The physical processor has 8 cores and 64 virtual processors (0-63) # The core has 8 virtual processors (0-7) # The core has 8 virtual processors (8-15) # ... notesout "From /usr/sbin/psrinfo \n"; my @cpuname = qx(/usr/sbin/psrinfo -pv | grep -v "processor has" | grep -v "core has" | sort | uniq); for my $c (@cpuname) { $c =~ s/\s+/ /g; # compress blanks notesout " $c"; } if ($#cpuname == -1) { $cpuname[0] = "Did not find cpu model name"; } # try to reduce the number by ignoring stuff not needed my @newcpuname; for my $c (@cpuname) { next if $c =~ m/^\s*x86\s+\(.*MHz\)\s*$/; # skip lines that say x86 (mumble) $c =~ s/\((chipid|portid).*MHz\)//; # remove port/chip numbers my $seenit = 0; for my $new (@newcpuname) { $seenit = 1 if $new eq $c; } push (@newcpuname, $c) unless $seenit; } @cpuname = @newcpuname; my $cpu; if ($#cpuname > 0 ) { $cpu = "more than one type"; } elsif ($#cpuname < 0) { $cpu = "none found"; } else { $cpu = $cpuname[0]; } $fields{"hw_cpu_name"} = simplify_cpu_name($cpu); #--------- nchips ---- my $nchips = qx{/usr/sbin/psrinfo -p"}; chomp $nchips; notesout " $nchips chips\n"; $fields{"hw_nchips"} = $nchips; #--------- threads ---- my $nthreads = qx{/usr/sbin/psrinfo | wc -l}; chomp $nthreads; $nthreads =~ s/^\s+//; $nthreads =~ s/\s+$//; notesout " $nthreads threads\n"; #--------- MHz ---- my $cmd = '/usr/sbin/psrinfo -v | grep processor | grep MHz | sort | uniq'; my @mhz_lines = qx{$cmd}; if ((@mhz_lines == 1) && ($mhz_lines[0] =~ m/(\d+)\s+MHz/)) { my $mhz = $1; notesout " $mhz MHz"; $fields{"hw_cpu_nominal_mhz"} = $mhz; } elsif (@mhz_lines > 1) { notesout "\nMore than one MHz found!\n$cmd"; notesout join "\n ", @mhz_lines; $fields{"hw_cpu_nominal_mhz"} = "mixed!"; } #--------- cores, threads ---- my $ncores = qx{/usr/bin/kstat cpu_info | grep -w core_id | sort -u | wc -l}; chomp $ncores; if ($ncores != 0) { notesout "\nFrom kstat: $ncores cores\n"; $fields{"hw_ncores"} = $ncores; } $fields{"hw_nthreadspercore"} = divide_maybe($nthreads, $ncores); #--------- memory ---- print "log 0 ...getting memory info\n" unless $quiet; my $memsize = qx{/usr/sbin/prtconf | grep \"Memory size:\"}; chomp $memsize; $memsize =~ s/Memory size:\s*//; if ($memsize =~ m/(\d+)\s*Megabytes/i) { notesout "\nFrom prtconf: $memsize\n"; my $megabytes = $1; $fields{"hw_memory001"} = sprintf "%.3f GB fixme: If using DDR4, the format is:", $megabytes / 1024; $fields{"hw_memory002"} = $pc4_format; } #--------- sw OS ---- print "log 0 ...getting OS info\n" unless $quiet; if (-e "/etc/release") { my $etc_release; $etc_release = qx{head -1 /etc/release}; $etc_release =~ s/^\s+//; notesout "\n/etc/release:\n $etc_release"; $etc_release =~ s/(Oracle|Sun)//; $etc_release =~ s/(SPARC|X86)//i; $etc_release =~ s/\s+/ /g; $etc_release =~ s/^\s//; $fields{"sw_os"} = $etc_release; } if (-x "/usr/bin/pkg") { my $pkg_release = qx{/usr/bin/pkg info entire | grep \"Version:\"}; $pkg_release =~ s/^\s+//; notesout "From pkg info entire:\n $pkg_release"; $fields{"sw_os"} = $1 if ($pkg_release =~ m/\s\((.+)\)$/); } my $uname = qx{uname -a}; notesout "uname -a:\n $uname"; #--------- run level ---- my $whoami; if (-x "/usr/gnu/bin/who") { $whoami = "/usr/gnu/bin/who"; } elsif (-x "/bin/who") { $whoami = "who"; } my $rline = qx{$whoami -r}; $rline =~ s/^\s+//; notesout "$whoami -r\n $rline"; if ($rline =~ m/run-level\s+(\S)/i) { $fields{"sw_state"} = "Run level $1 (add definition here)"; } else { $fields{"sw_state"} = "Run level N (add definition here)"; } #--------- disk ---- print "log 0 ...getting disk info\n" unless $quiet; # is -h likely to be supported? my $s = defined($ENV{"SPEC"}) ? $ENV{'SPEC'} : '.'; $cmd = "df -h $s"; my @dlines = qx{$cmd}; if ($? != 0) { $cmd = "df -k $s"; @dlines = qx{$cmd}; } notesout "\ndisk: $cmd"; notesout @dlines; #--------- prepared by ---- my $who; $who = $ENV{"LOGNAME"}; chomp $who; $fields{"prepared_by"} = "$who (is never output, only tags rawfile)"; } #--------------------------------- Windows -------------- sub sysinfo_mswin { my $processor_next; my $nchips = 0; my $ncores = 0; my $logical_procs = 0; my $kount = 0; #--------- talk to 'wmic' ----- # # ==== System name, etc ==== # print "log 0 ...getting SUT info\n" unless $quiet; notesout "System\n"; notesout "...wmic computersystem, wmic bios\n"; # Model= # Manufacturer= my $cmd = "wmic computersystem get model,manufacturer /value"; my @wmicout = qx{$cmd 2>&1}; if (@wmicout < 3 || $wmicout[0] =~ m/not recognized/) { my $tryhere = "$ENV{'SystemRoot'}/System32/Wbem/WMIC.exe"; if (-e $tryhere) { $cmd =~ s/^wmic/$tryhere/; @wmicout = qx{$cmd 2>&1}; } } for my $aline (@wmicout) { chomp $aline; # somehow chomp not killing return... and i'm afraid to mess with $/ $aline =~ s/\r/ /g; $aline =~ s/\s+/ /g; $aline =~ s/\s+$//; next if $aline !~ m/=/; (my $fname, my $fcontent) = split("=", $aline, 2); if ($fname =~ m/^Model$/) { notesout sprintf "%-${fnwidth}s: %s\n", $fname, $fcontent; $fields{"hw_model"} = $fcontent; } elsif ($fname =~ m/^Manufacturer$/) { notesout sprintf "%-${fnwidth}s: %s\n", $fname, $fcontent; $fields{"hw_vendor"} = $fcontent; } } # Add the BIOS to SUT output print "log 0 ...getting BIOS info\n" unless $quiet; # SMBIOSVersion= # Manufacturer= # ReleaseDate= my $bios_oem; my $bios_version; my $bios_releasedate; $cmd = "wmic bios get manufacturer,releasedate,smbiosbiosversion /value"; @wmicout = qx{$cmd 2>&1}; if (@wmicout < 3 || $wmicout[0] =~ m/not recognized/) { my $tryhere = "$ENV{'SystemRoot'}/System32/Wbem/WMIC.exe"; if (-e $tryhere) { $cmd =~ s/^wmic/$tryhere/; @wmicout = qx{$cmd 2>&1}; } } for my $aline (@wmicout) { chomp $aline; # somehow chomp not killing return... and i'm afraid to mess with $/ $aline =~ s/\r/ /g; $aline =~ s/\s+/ /g; $aline =~ s/\s+$//; next if $aline !~ m/=/; (my $fname, my $fcontent) = split("=", $aline, 2); if ($fname =~ m/^Manufacturer$/) { $bios_oem = $fcontent; } elsif ($fname =~ m/^ReleaseDate$/) { $bios_releasedate = $fcontent; } elsif ($fname =~ m/^SMBIOSBIOSVersion$/) { $bios_version = $fcontent; } } $fields{"fw_bios"} = sprintf "%s %s, %s/%s/%s", $bios_oem, $bios_version, substr($bios_releasedate,4,2), substr($bios_releasedate,6,2), substr($bios_releasedate,0,4); notesout sprintf "%-${fnwidth}s: %s\n","BIOS", $fields{"fw_bios"}; # # ==== OS ==== # print "log 0 ...getting OS info\n" unless $quiet; notesout "\nOS\n"; notesout "...wmic os\n"; # Caption= # Version= $cmd = "wmic os get caption, OSArchitecture, version /value"; @wmicout = qx{$cmd 2>&1}; if (@wmicout < 3 || $wmicout[0] =~ m/not recognized/) { my $tryhere = "$ENV{'SystemRoot'}/System32/Wbem/WMIC.exe"; if (-e $tryhere) { $cmd =~ s/^wmic/$tryhere/; @wmicout = qx{$cmd 2>&1}; } } my $os_name; my $os_bitness; for my $aline (@wmicout) { chomp $aline; # somehow chomp not killing return... and i'm afraid to mess with $/ $aline =~ s/\r/ /g; $aline =~ s/\s+/ /g; $aline =~ s/\s+$//; next if $aline !~ m/=/; (my $fname, my $fcontent) = split("=", $aline, 2); if ($fname =~ m/^Caption$/) { notesout sprintf "%-${fnwidth}s: %s\n", $fname, $fcontent; $os_name = $fcontent; } elsif ($fname =~ m/^OSArchitecture$/) { notesout sprintf "%-${fnwidth}s: %s\n", $fname, $fcontent; $os_bitness = $fcontent; } elsif ($fname =~ m/^Version$/) { notesout sprintf "%-${fnwidth}s: %s\n", $fname, $fcontent; $fields{"sw_os002"} = sprintf "Build %s",$fcontent; } } $fields{"sw_os001"} = sprintf "%s (%s)", $os_name, $os_bitness; # # ==== CPU ==== # print "log 0 ...getting CPU info\n" unless $quiet; notesout "\nCPU\n"; notesout "...wmic cpu\n"; # We'll first list the names only - display order from wmic can't be controlled - we always want the CPU name first # Name=Intel(R) Core(TM) i5 CPU M 520 @ 2.40GHz $cmd = "wmic cpu get name /value"; @wmicout = qx{$cmd 2>&1}; if (@wmicout < 3 || $wmicout[0] =~ m/not recognized/) { my $tryhere = "$ENV{'SystemRoot'}/System32/Wbem/WMIC.exe"; if (-e $tryhere) { $cmd =~ s/^wmic/$tryhere/; @wmicout = qx{$cmd 2>&1}; } } for my $aline (@wmicout) { chomp $aline; # somehow chomp not killing return... and i'm afraid to mess with $/ $aline =~ s/\r/ /g; $aline =~ s/\s+/ /g; $aline =~ s/\s+$//; next if $aline !~ m/=/; (my $fname, my $fcontent) = split("=", $aline, 2); if ($nchips <= 0) { notesout sprintf "%-${fnwidth}s: %s\n", $fname, $fcontent; $fields{"hw_cpu_name"} = simplify_cpu_name($fcontent); } $nchips++; } # Show how many chips were found if ($nchips > 0) { my $chip_noun = "chip"; if ($nchips > 1) { $chip_noun = $chip_noun . "s"; } notesout sprintf "%-${fnwidth}s: (%d %s)\n", " ", $nchips,$chip_noun; $fields{"hw_nchips"} = $nchips; } # Now, we'll get the characteristics (assumption is made that only one type is supported on x86) # L2CacheSize=256 # L3CacheSize=3072 # MaxClockSpeed=2400 # Name=Intel(R) Core(TM) i5 CPU M 520 @ 2.40GHz # NumberOfCores=2 # NumberOfLogicalProcessors=4 $cmd = "wmic cpu get l2cachesize,l3cachesize,maxclockspeed,numberofcores,numberoflogicalprocessors /value"; @wmicout = qx{$cmd 2>&1}; if (@wmicout < 3 || $wmicout[0] =~ m/not recognized/) { my $tryhere = "$ENV{'SystemRoot'}/System32/Wbem/WMIC.exe"; if (-e $tryhere) { $cmd =~ s/^wmic/$tryhere/; @wmicout = qx{$cmd 2>&1}; } } $kount = 0; for my $aline (@wmicout) { chomp $aline; # somehow chomp not killing return... and i'm afraid to mess with $/ $aline =~ s/\r/ /g; $aline =~ s/\s+/ /g; $aline =~ s/\s+$//; next if $aline !~ m/=/; (my $fname, my $fcontent) = split("=", $aline, 2); # wmic will do this for each CPU, but we only need to collect it once if ($kount <= 0) { if ($fname =~ m/^L2CacheSize$/) { notesout sprintf "%-${fnwidth}s: %s\n", $fname, $fcontent; $fields{"hw_scache"} = "$fcontent KB I+D on/off chip per ____"; } elsif ($fname =~ m/^L3CacheSize$/) { notesout sprintf "%-${fnwidth}s: %s\n", $fname, $fcontent; $fields{"hw_tcache"} = "$fcontent KB I+D on/off chip per ____"; } elsif ($fname =~ m/^MaxClockSpeed$/) { notesout sprintf "%-${fnwidth}s: %s\n", $fname, $fcontent; $fields{"hw_cpu_nominal_mhz"} = $fcontent; } elsif ($fname =~ m/^Name$/) { notesout sprintf "%-${fnwidth}s: %s\n", $fname, $fcontent; $fields{"hw_cpu_name"} = simplify_cpu_name($fcontent); } elsif ($fname =~ m/^NumberOfCores$/) { notesout sprintf "%-${fnwidth}s: %s\n", $fname, $fcontent; $ncores = $fcontent; $fields{"hw_ncores"} = $fcontent; } elsif ($fname =~ m/^NumberOfLogicalProcessors$/) { notesout sprintf "%-${fnwidth}s: %s\n", $fname, $fcontent; $logical_procs = $fcontent; $kount++; } } } $fields{"hw_nthreadspercore"} = divide_maybe($logical_procs, $ncores); # # ==== Memory DIMM ==== # print "log 0 ...getting memory info\n" unless $quiet; notesout "\nMemory\n"; notesout "...wmic memorychip\n"; # Capacity # ConfiguredClockSpeed # Manufacturer # PartNumber # Speed # Don't want to get specific with this wmic command - not all fields are supported on all systems $cmd = "wmic memorychip get /value"; @wmicout = qx{$cmd 2>&1}; if (@wmicout < 3 || $wmicout[0] =~ m/not recognized/) { my $tryhere = "$ENV{'SystemRoot'}/System32/Wbem/WMIC.exe"; if (-e $tryhere) { $cmd =~ s/^wmic/$tryhere/; @wmicout = qx{$cmd 2>&1}; } } # We're not going to simply display output from WMIC as it's printed # Instead, we will use the data to keep track of the different part numbers AND each of their characteristics # That way the list is short (n x part) rather than listing each one, per line. my $mem_capacityGB; my $mem_capacityRaw; my $mem_configuredclock = 0; my $mem_manufacturer; my $mem_partnumber; my $mem_speed; my $mem_total = 0; my $mem_dimms_kount = 0; my $mem_dimm_index = 0; my $mem_print; my @all_capacityGB; my @all_capacityRaw; my @all_configuredclock; my @all_manufacturer; my @all_partnumber; my @all_speed; my @all_dimms_kount; for my $aline (@wmicout) { chomp $aline; # somehow chomp not killing return... and i'm afraid to mess with $/ $aline =~ s/\r/ /g; $aline =~ s/\s+/ /g; $aline =~ s/\s+$//; next if $aline !~ m/=/; (my $fname, my $fcontent) = split("=", $aline, 2); if ($fname =~ m/^Capacity$/) { $mem_capacityGB = $fcontent/(1024*1024*1024); $mem_capacityRaw = $fcontent; $mem_total += $mem_capacityGB; } elsif ($fname =~ m/^ConfiguredClockSpeed$/) { $mem_configuredclock = $fcontent; } elsif ($fname =~ m/^Manufacturer$/) { $mem_manufacturer = $fcontent; } elsif ($fname =~ m/^PartNumber$/) { $mem_partnumber = $fcontent; } elsif ($fname =~ m/^Speed$/) { # The following logic assumes that Speed is the last atrribute in the list from wmic $mem_speed = $fcontent; # Check to see if we've seen this part before my $found = 0; $kount = 0; # Look through the part arrays to see if we've seen this part (after first pass) if ($mem_dimms_kount > 0) { while ($kount <= $mem_dimm_index) { if ($all_partnumber[$kount] eq $mem_partnumber) { $found++; } $kount++; } if (not $found) { $mem_dimm_index++; } } # Add the new part if we haven't seen it yet if ( not $found) { $all_capacityGB[$mem_dimm_index] = $mem_capacityGB; $all_capacityRaw[$mem_dimm_index] = $mem_capacityRaw; $all_configuredclock[$mem_dimm_index] = $mem_configuredclock; $all_manufacturer[$mem_dimm_index] = $mem_manufacturer; $all_partnumber[$mem_dimm_index] = $mem_partnumber; $all_speed[$mem_dimm_index] = $mem_speed; } else { $found = 0; } $all_dimms_kount[$mem_dimm_index]++; #keep this counter here because it's used above for first-pass logic $mem_dimms_kount++; } } # Some useful information for the user - include the characteristics we already know. $mem_print = sprintf "%d GB (%d x %d GB nRxn PCn-%dT", $mem_total,$mem_dimms_kount,$mem_capacityGB,$mem_speed; if ($mem_configuredclock != 0 and $mem_configuredclock != $mem_speed) { $mem_print = $mem_print . sprintf ", configured at %s", $mem_configuredclock; } $fields{"hw_memory"} = sprintf "%s) ** fixme **\n",$mem_print; # Display each different type of part, with the number of occurrences $kount = 0; while ($kount <= $mem_dimm_index) { $mem_print = sprintf "%4d x %s %s %d GB (%d) at %s", $all_dimms_kount[$kount], $all_manufacturer[$kount], $all_partnumber[$kount], $all_capacityGB[$kount], $all_capacityRaw[$kount], $all_speed[$kount]; if ($all_configuredclock[$kount] != 0 and $all_configuredclock[$kount] != $all_speed[$kount]) { $mem_print = $mem_print . sprintf ", configured at %s", $all_configuredclock[$kount]; } notesout sprintf "%s\n",$mem_print; $kount++; } # Total should appear first in the notes section notesout sprintf "%-${fnwidth}s: %s GB\n","Total Memory",$mem_total; # # ==== Disks ==== # print "log 0 ...getting disk info\n" unless $quiet; notesout "\nDisks\n"; notesout "...wmic diskdrive\n"; # Model # Size $cmd = "wmic diskdrive get model,size /value"; @wmicout = qx{$cmd 2>&1}; if (@wmicout < 3 || $wmicout[0] =~ m/not recognized/) { my $tryhere = "$ENV{'SystemRoot'}/System32/Wbem/WMIC.exe"; if (-e $tryhere) { $cmd =~ s/^wmic/$tryhere/; @wmicout = qx{$cmd 2>&1}; } } my $disk_model; my $disk_size; for my $aline (@wmicout) { chomp $aline; # somehow chomp not killing return... and i'm afraid to mess with $/ $aline =~ s/\r/ /g; $aline =~ s/\s+/ /g; $aline =~ s/\s+$//; next if $aline !~ m/=/; (my $fname, my $fcontent) = split("=", $aline, 2); if ($fname =~ m/^Model$/) { $disk_model = $fcontent; } elsif ($fname =~ m/^Size$/) { $disk_size = $fcontent/(1024*1024*1024); notesout sprintf "%s %d GB", $disk_model,$disk_size; } } $fields{"hw_disk"} = sprintf "n x %d GB SATA/SSD/SAS nnnn RPM ** fixme **",$disk_size; #--------- prepared by---- my $who; $who = $ENV{"USERNAME"}; chomp $who; $fields{"prepared_by"} = "$who (is never output, only tags rawfile)"; } #--------------------------------- Mac OS X sub sysinfo_macosx { #--------- talk to system_profiler ---- print "log 0 ...getting system info from system profiler\n" unless $quiet; my $profile_app = "/usr/sbin/system_profiler"; my @profile_lines; if (! -e $profile_app || ! -x $profile_app) { notesout "could not access system profiler"; } else { @profile_lines = qx{$profile_app SPHardwareDataType SPSoftwareDataType SPMemoryDataType SPDeveloperToolsDataType 2>/dev/null}; if (! @profile_lines) { notesout "no info returned by system profiler"; } else { notesout @profile_lines; } } for my $line (@profile_lines) { chomp $line; if ($line =~ m/Model Name:\s+(.*)/) { # a good thing to find $fields{"hw_model"} = $1; } elsif ($line =~ m/Model Identifier:\s+(.*)/) { # even better $fields{"hw_model"} = $1; } elsif ($line =~ m/Processor Name:\s+(.*)/) { $fields{"hw_cpu_name"} = $1; } elsif ($line =~ m/Processor Speed:\s+(.*)\s*GHz/) { my $ghz = $1; my $mhz = $1 * 1000; $fields{"hw_cpu_nominal_mhz"} = $mhz; } elsif ($line =~ m/Number Of Processors:\s+(.*)/i) { $fields{"hw_nchips"} = $1; } elsif ($line =~ m/Total Number Of Cores:\s+(.*)/i) { $fields{"hw_ncores"} = $1; } # L2 Cache (per Core): 256 KB elsif ($line =~ m/L2 Cache(?:\s+\(([^)]+)\))?:\s+(.*)/) { $fields{"hw_scache"} = $2; if (defined($1) && $1 ne '') { $fields{"hw_scache"} .= lc " $1"; } } elsif ($line =~ m/L3 Cache(?:\s+\(([^)]+)\))?:\s+(.*)/) { $fields{"hw_tcache"} = $2; if (defined($1) && $1 ne '') { $fields{"hw_tcache"} .= lc " $1"; } } elsif ($line =~ m/Memory:\s+(\d+)\s*(.*)/) { my $memory = $1; my $unit = $2; $fields{"hw_memory001"} = sprintf( "%.1f %s fixme: If using DDR4, the format is:", $memory, $unit); $fields{"hw_memory002"} = $pc4_format; } elsif ($line =~ m/System Version:\s+(.*)/) { $fields{"sw_os"} = $1; } elsif ($line =~ m/Xcode:\s+(.*)/) { $fields{"sw_other"} = "Xcode $1"; } } my $sysctl = "/usr/sbin/sysctl"; if (-x $sysctl) { my @wantstrings = qw(hw.memsize cache hw.memsize hw.activecpu hw.physicalcpu hw.logicalcpu hw.pagesize hw.cpufrequency machdep.cpu.vendor machdep.cpu.brand_string machdep.cpu.*features machdep.cpu.microcode_version machdep.cpu.core_count machdep.cpu.thread_count ); my $regexp = join "|", @wantstrings; print "log 0 ...getting system info from sysctl\n" unless $quiet; my @sysctl_lines = grep /$regexp/, qx{$sysctl machdep.cpu hw 2>/dev/null}; if (!@sysctl_lines) { notesout "\nNo info available from sysctl"; } else { notesout "\nFrom sysctl:\n"; my $l1_isize; my $l1_dsize; for my $line (@sysctl_lines) { chomp $line; notesout " ".$line; if ($line =~ m/^hw.l1icachesize:\s+(\d+)/) { $l1_isize = bytes_to_integral_other_unit($1); } elsif ($line =~ m/^hw.l1dcachesize:\s+(\d+)/) { $l1_dsize = bytes_to_integral_other_unit($1); } elsif ($line =~ m/machdep.cpu.brand_string:\s+(.*)/) { my $cpu_brand_string = $1; $fields{"hw_cpu_name"} = simplify_cpu_name $1; } } if (defined $l1_isize and defined $l1_dsize) { $fields{"hw_pcache"} = "$l1_isize I + $l1_dsize D on/off chip per something"; } } } #--------- hw_disk ---- print "log 0 ...getting disk info\n" unless $quiet; my $s = defined($ENV{'SPEC'}) ? $ENV{'SPEC'} : '.'; if ($s ne '.') { notesout "\nSPEC is set to: $s"; } else { notesout "\ndf -h ."; } my @dlines = qx{/bin/df -H $s}; for my $d (@dlines) { notesout " $d"; } # expecting: # Filesystem Size Used Avail Capacity Mounted on # /dev/disk0s2 320G 161G 158G 51% / if ((scalar @dlines == 2) && ($dlines[0] =~ m/Filesystem/)) { my $fssize = (split " ", $dlines[1])[1]; $fssize =~ s{(\d+)(M|G|T)$}{$1 $2B}; if (defined $ENV{"SPEC"}) { $fields{"hw_disk"} = ""; } else { $fields{"hw_disk"} .= "SPEC not defined; current disk has: "; } $fields{"hw_disk"} .= "$fssize add more disk info here"; } else { $fields{"hw_disk"} = " add disk info here"; } #--------- prepared by ---- my $who; $who = $ENV{"LOGNAME"}; chomp $who; $fields{"prepared_by"} = "$who (is never output, only tags rawfile)"; } #--------------------------------- Linux -------------------------------------- sub sysinfo_linux { # There is code below that looks for various possible matches in /etc for # possible release or version info. If there are multiple hits, then the # first match from this list wins. my @prefer_id = qw( /etc/oracle-release /etc/enterprise-release /etc/redhat-release /etc/SuSE-release /etc/sles-release /etc/debian_version /etc/mandrake-release /etc/UnitedLinux-release /etc/gentoo-release /etc/linuxppc-release /etc/nld-release /etc/slackware-version /etc/yellowdog-release ); my %prefer_id; for (my $i=0; $i <= $#prefer_id; $i++) { $prefer_id{$prefer_id[$i]} = $i; } # after the above loop, $prefer_id{OS} contains a number indicating its priority #--------- cpu name ---- print "log 0 ...getting CPU info\n" unless $quiet; notesout "From /proc/cpuinfo"; my @cpuname = qx'grep "model name" /proc/cpuinfo | sort | uniq'; my @cpumoreinfo; if (@cpuname == 0) { # hmmm... maybe power or sparc? @cpuname = qx'grep -P "^cpu\s+:" /proc/cpuinfo | uniq'; if (@cpuname) { if ($cpuname[0] =~ m/power/i) { # notesout " 'clock : ' reported by /proc/cpuinfo may not be reliable. Use with caution.\n"; push (@cpumoreinfo, qx'grep -P "(clock|revision|platform|model|machine)\s+" /proc/cpuinfo | sort | uniq' ); notesout ""; } elsif ($cpuname[0] =~ m/sparc/i) { push (@cpumoreinfo, qx'grep -P "(pmu|prom|type|ncpus probed|ncpus active|cpucaps)\s+" /proc/cpuinfo' ); } } } for my $c (@cpuname, @cpumoreinfo) { $c =~ s/\s+/ /g; # make multiple spaces one $c =~ s/^\s*/ /; # but do indent a little notesout $c; } my $cpu; if (@cpuname == 0) { notesout < 1 ) { $cpu = "more than one type"; } else { (my $ignore, $cpu) = split ":", $cpuname[0], 2; chomp $cpu; $cpu = simplify_cpu_name($cpu); } $fields{"hw_cpu_name"} = $cpu; #--------- chip-dependent stuff ----- if ($cpu =~ m/power/i) { ($fields{"hw_nchips"}, $fields{"hw_ncores"}, $fields{"hw_nthreadspercore"}) = linux_power_chip(); } elsif ($cpu =~ m/sparc/i) { ($fields{"hw_nchips"}, $fields{"hw_ncores"}, $fields{"hw_nthreadspercore"}) = linux_sparc_chip(); } else { # # assume some sort of x86, where we do not try to guess number of cores/chips # $fields{"hw_nchips"} = linux_x86_chip(); } #--------- cache ---- my @cache = qx{grep -i cache /proc/cpuinfo | grep -v alignment | sort | uniq}; if (@cache) { notesout "\n/proc/cpuinfo cache data"; for my $c (@cache) { $c =~ s/\s+/ /g; notesout " $c"; } } # ---- Get the view of cpu and memory according to numactl print "log 0 ...getting info from numactl\n" unless $quiet; my $ncmd = "numactl --hardware"; my @numactl_lines = qx{$ncmd}; if (! @numactl_lines) { notesout "\nUnable to get information from '$ncmd'\nPlease verify numactl installation.\n"; } else { notesout "\nFrom $ncmd\nWARNING: a numactl 'node' might or might not correspond to a physical chip."; for my $nline (@numactl_lines) { notesout " $nline"; } } #--------- memory ---- print "log 0 ...getting memory info\n" unless $quiet; # MemTotal: 65995536 kB notesout "\nFrom /proc/meminfo"; (my $memtotal) = qx{grep MemTotal: /proc/meminfo}; if (defined($memtotal) and $memtotal =~ /MemTotal:\s+(\d+)\s+kb/i) { my $memory = $1; notesout " $memtotal"; my $unit = "GB"; $memory = $memory / 1024 / 1024; $fields{"hw_memory001"} = sprintf "%.3f %s fixme: If using DDR4, the format is:", $memory, $unit; $fields{"hw_memory002"} = $pc4_format; } else { notesout "Did not find total memory in /proc/meminfo"; $fields{"hw_memory"} = $pc4_format; } # HugePages_Total: 0 (my $hugetotal) = qx{grep HugePages_Total: /proc/meminfo}; notesout " $hugetotal" if defined $hugetotal; # Hugepagesize: 2048 kB (my $hugesize) = qx{grep Hugepagesize: /proc/meminfo}; notesout " $hugesize" if defined $hugesize; #------- power ----- print "log 0 ...looking for power info\n" unless $quiet; if (-x "/sbin/tuned-adm") { my $cmd = "/sbin/tuned-adm active"; if (my $profile = qx{$cmd 2>/dev/null}) { chomp $profile; notesout "\n$cmd\n $profile"; } } my $gov_location = '/sys/devices/system/cpu/cpu*/cpufreq/scaling_governor'; if (qx{ls $gov_location 2>/dev/null}) { my @gov = qx{cat $gov_location 2>/dev/null | sort | uniq}; if (scalar @gov == 1) { notesout "\n$gov_location has\n $gov[0]"; } elsif (scalar @gov > 1) { notesout "\nMore than one value found at $gov_location"; for my $gline (@gov) { notesout " $gline"; } } } #--------- sw_os1 ---- print "log 0 ...getting OS info\n" unless $quiet; my $sw_os1 = ""; my $sw_os1_filled_by = 9999; # preference rank of current content # # try lsb_release first; if found, it gets top preference # if (-x "/usr/bin/lsb_release") { my $cmd = "/usr/bin/lsb_release -d"; if (my $lsb = qx{$cmd}) { chomp $lsb; $lsb =~ s/\s*Description:\s*//; $lsb =~ s/\s+/ /g; notesout "\n$cmd\n $lsb"; if ($lsb !~ /^\s*$/) { $sw_os1 = $lsb; $sw_os1_filled_by = -1; } } } # # check out other methods too # notesout "\n"; my @rfiles = qx{ls /etc/*release* /etc/*version* 2>/dev/null}; if (@rfiles < 1 && $sw_os1 eq "") { notesout "Did not find /etc/*release* nor /etc/*version*/"; } my $printed_rlshdr = 0; for my $rfile (@rfiles) { chomp $rfile; # plain file, readable, nonzero, text next unless (-f $rfile && -r $rfile && -s $rfile && -T $rfile); next if $rfile eq "/etc/lsb-release"; notesout "From /etc/*release* /etc/*version*" unless $printed_rlshdr; $printed_rlshdr = 1; my $this_rank; if (defined $prefer_id{$rfile}) { $this_rank = $prefer_id{$rfile}; } else { $this_rank = 9999; } my @rlines = qx{head -8 $rfile}; my $rs = $rfile; #shorter handle $rs =~ s{/etc/}{}; if (@rlines == 1) { my $l = $rlines[0]; $l =~ s/\s+/ /; $l =~ s/^\s*//; notesout " $rs: $l"; } else { notesout " $rs:\n"; for my $l (@rlines) { $l =~ s/\s+/ /; $l =~ s/^\s*/ /; notesout $l; } } if (($sw_os1 eq "") || ($sw_os1_filled_by > $this_rank)) { chomp $rlines[0]; $rlines[0] = "debian " . $rlines[0] if $rfile =~ m/debian/; $sw_os1 = $rlines[0]; $sw_os1_filled_by = $this_rank; } } #--------- sw_os2 ---- my $un = qx{uname -a}; chomp $un; notesout "\nuname -a:\n $un"; my $sw_os2 = qx{uname -r}; chomp $sw_os2; $sw_os1 =~ s/^\s+//; $sw_os2 =~ s/^\s+//; $fields{"sw_os001"} = $sw_os1; $fields{"sw_os002"} = $sw_os2; #--------- vulnerability status ---- my $kernel_vuln_dir = '/sys/devices/system/cpu/vulnerabilities'; my @vuln_files = read_directory_files($kernel_vuln_dir); # Constructing the map like my %kernel_vuln_files = ( (map { $_ => $_ } @vuln_files), 'itlb_multihit' => 'CVE-2018-12207 (iTLB Multihit)', 'l1tf' => 'CVE-2018-3620 (L1 Terminal Fault)', 'mds' => 'Microarchitectural Data Sampling', 'meltdown' => 'CVE-2017-5754 (Meltdown)', 'spectre_v1' => 'CVE-2017-5753 (Spectre variant 1)', 'spectre_v2' => 'CVE-2017-5715 (Spectre variant 2)', 'spec_store_bypass' => 'CVE-2018-3639 (Speculative Store Bypass)', 'srbds' => 'CVE-2020-0543 (Special Register Buffer Data Sampling)', 'tsx_async_abort' => 'CVE-2019-11135 (TSX Asynchronous Abort)', ); print "log 0 ...getting CPU vulnerability status from the kernel\n"; notesout " "; notesout "Kernel self-reported vulnerability status:"; notesout " "; my $label_width = max(map { length } values %kernel_vuln_files) + 1; foreach my $vuln_file (sort keys %kernel_vuln_files) { my $vuln_label = sprintf '%*s', -$label_width, $kernel_vuln_files{$vuln_file}.':'; notesout read_vuln_file($vuln_label, $kernel_vuln_dir.'/'.$vuln_file); } #--------- runlevel ---- my $rline = qx{who -r}; chomp $rline; $rline =~ s/\s+/ /g; $rline =~ s/^\s+//; notesout "\n$rline"; if ($rline =~ m/^\s*run-level\s(\S)/) { my $rl = $1; $fields{"sw_state"} = "Run level $1 (add definition here)"; } else { $fields{"sw_state"} = "Run level N (add definition here)"; } #--------- disk ---- print "log 0 ...getting disk info\n" unless $quiet; my $s = defined($ENV{'SPEC'}) ? $ENV{'SPEC'} : '.'; if ($s ne '.') { notesout "\nSPEC is set to: $s"; } else { notesout "\ndf -h ."; } my @dlines = qx{df -Th $s}; for my $d (@dlines) { notesout " $d"; } # expecting a header line plus a data line, which might be split over # 2 actual lines if ((@dlines <= 3) and (@dlines and $dlines[0] =~ m/^Filesystem/)) { my $dl = $dlines[1]; $dl .= " $dlines[2]" if defined $dlines[2]; (my $ignore, my $fstype, my $fssize) = split " ", $dl; $fields{"sw_file"} = $fstype; $fssize =~ s{(\d+)(G|T)$}{$1 $2B}; if (defined $ENV{"SPEC"}) { $fields{"hw_disk"} = ""; } else { $fields{"hw_disk"} .= "SPEC not defined; current disk has: "; } $fields{"hw_disk"} .= "$fssize add more disk info here"; } else { $fields{"hw_disk"} = " add disk info here"; } # Firmware version for POWER servers my $bios = ""; if (@cpuname and $cpuname[0] =~ m/power/i) { print "log 0 ...firmware version for POWER\n" unless $quiet; my $platform = qx{grep platform /proc/cpuinfo}; (my $ignore, $platform) = split ":", $platform if $platform =~ /:/; if ($platform =~ m/pSeries/i) { # Firmware version for PowerVM systems $bios = qx{cat /proc/device-tree/openprom/ibm,fw-vernum_encoded}; $bios =~ s/.*\(|\)//g; $fields{"fw_bios"} = $bios; notesout "BIOS Version: $bios"; } elsif ($platform =~ m/PowerNV/i) { # Firmware version for POWER servers running OPAL firmware notesout "Unfortunately, there is no direct way to get FW version for OPAL."; notesout "Use the BMC commandline for PNOR and BMC levels to verify the FW version."; notesout "For PNOR level, use"; notesout " cat /var/lib/phosphor-software-manager/pnor/ro/VERSION"; notesout "For BMC level, use"; notesout " cat /etc/os-release"; } else { print "log 100 ...unable to determine platform type for POWER Linux server\n" unless $quiet; } } #--------- prepared by ---- my $who; $who = $ENV{"LOGNAME"}; chomp $who; $fields{"prepared_by"} = "$who (is never output, only tags rawfile)"; # /sys/devices/virtual/dmi/id print "log 0 ...trying to get info from /sys/devices/virtual/dmi/id\n" unless $quiet; my $bios_vendor = ""; my $bios_version = ""; my $bios_date = ""; if (-r "/sys/devices/virtual/dmi/id/bios_vendor") { $bios_vendor = qx{cat /sys/devices/virtual/dmi/id/bios_vendor}; chomp $bios_vendor; } if (-r "/sys/devices/virtual/dmi/id/bios_version") { $bios_version = qx{cat /sys/devices/virtual/dmi/id/bios_version}; chomp $bios_version; } if (-r "/sys/devices/virtual/dmi/id/bios_date") { $bios_date = qx{cat /sys/devices/virtual/dmi/id/bios_date}; chomp $bios_date; } my $id_system_vendor = ""; if (-r "/sys/devices/virtual/dmi/id/sys_vendor") { ($id_system_vendor) = qx{cat /sys/devices/virtual/dmi/id/sys_vendor}; chomp $id_system_vendor; $id_system_vendor = "" if $id_system_vendor =~ m/^($|to be filled|default string|default value)/i; } my $id_product_name = ""; if (-r "/sys/devices/virtual/dmi/id/product_name") { ($id_product_name) = qx{cat /sys/devices/virtual/dmi/id/product_name}; chomp $id_product_name; $id_product_name = "" if $id_product_name =~ m/^($|to be filled|default string|default value)/i; } my $id_product_family = ""; if (-r "/sys/devices/virtual/dmi/id/product_family") { ($id_product_family) = qx{cat /sys/devices/virtual/dmi/id/product_family}; chomp $id_product_family; $id_product_family = "" if $id_product_family =~ m/^($|to be filled|default string|default value)/i; } my $id_product_serial = ""; if (-r "/sys/devices/virtual/dmi/id/product_serial") { ($id_product_serial) = qx{cat /sys/devices/virtual/dmi/id/product_serial}; chomp $id_product_serial; $id_product_serial = "" if $id_product_serial =~ m/^($|to be filled|default string|default value)/i; } if ($id_system_vendor . $id_product_name . $id_product_family . $id_product_serial) { notesout "\nFrom /sys/devices/virtual/dmi/id"; notesout " Vendor: $id_system_vendor" if $id_system_vendor; notesout " Product: $id_product_name" if $id_product_name; notesout " Product Family: $id_product_family" if $id_product_family; notesout " Serial: $id_product_serial" if $id_product_serial; } # # ------- sorta bonus: is dmidecode available? -------- # print "log 0 ...trying to get info from dmidecode\n" unless $quiet; my $bios_revision = ""; my $firmware_revision = ""; my $dmidecode_loc = ""; my $noperm = ""; my @dtrylist = qw ( /usr/local/sbin/dmidecode /usr/sbin/dmidecode /sbin/dmidecode ); my $maybe_dmi = qx{which dmidecode 2>/dev/null}; chomp $maybe_dmi; unshift (@dtrylist, $maybe_dmi) if $maybe_dmi; for my $dtry (@dtrylist) { if (-x $dtry) { my $out = qx{$dtry -t memory 2>&1}; next if $out eq ""; if ($out =~ m/Permission denied/i) { $noperm = $dtry if $noperm eq ""; next; } else { $dmidecode_loc = $dtry; last; } } } if ($dmidecode_loc eq "") { if ($noperm) { notesout "\nCannot run dmidecode; consider saying (as root)\n chmod +s $noperm"; } else { notesout "Could not find dmidecode"; } } else { my @dmidecode = qx{$dmidecode_loc -t memory 2>&1}; my $dmidecode_version = qx{$dmidecode_loc --version}; chomp $dmidecode_version; if (@dmidecode) { notesout "\nAdditional information from dmidecode $dmidecode_version follows. WARNING: Use caution when" . " you interpret this section. The 'dmidecode' program reads system data" . " which is \"intended to allow hardware to be accurately determined\", but" . " the intent may not be met, as there are frequent changes to hardware," . " firmware, and the \"DMTF SMBIOS\" standard."; my %mem; my ($msize, $msize_unit, $mspeed, $mmanu, $mpart, $mrank, $mcspeed); for my $line (@dmidecode) { chomp $line; if ($line =~ m/^(Memory Device|Handle)/i) { ($msize, $msize_unit, $mspeed, $mmanu, $mpart, $mrank, $mcspeed) = ("", "", "", "", "", "", ""); } elsif ($line =~ m/^\s*Size:\s*(\d+)\s*(\S+)/i) { $msize = $1; $msize_unit = uc($2); if (($msize_unit eq "MB") && (($msize % 1024) == 0)) { $msize /= 1024; $msize_unit = "GB"; } } elsif ($line =~ m/^\s*Speed:\s*(\d+)/i) { $mspeed = $1; } elsif ($line =~ m/^\s*Manufacturer:\s*(.*)/i) { ($mmanu = $1) =~ s/\s+$//; } elsif ($line =~ m/^\s*Part Number:\s*(.*)/i) { ($mpart = $1) =~ s/\s+$//; } elsif ($line =~ m/^\s*Rank:\s*(\d+)/i) { ($mrank = $1) =~ s/\s+$//; } elsif ($line =~ m/^\s*Configured (?:Clock|Memory) Speed:\s*(\d+)/i) { $mcspeed = $1; } # last line? if ($line =~ m/^(\s*$|Configured (?:Clock|Memory) Speed)/i) { if (defined $mmanu) { my $mem = "$mmanu $mpart $msize $msize_unit "; $mem .= "$mrank rank " if $mrank ne ""; $mem .= $mspeed; if ($mcspeed ne '' and $mspeed ne $mcspeed) { $mem .= ", configured at $mcspeed"; } $mem{$mem}++; } } } notesout " Memory:" if %mem; for my $mem (sort keys %mem) { next if $mem =~ m/^\s*$/; notesout " $mem{$mem}x $mem"; } # Some info provided by dmidecode is not necessarily present at /sys/devices/virtual/dmi/id if (! $bios_vendor) { $bios_vendor = qx{$dmidecode_loc -s bios-vendor 2>/dev/null}; if (!defined $bios_vendor) { $bios_vendor = ""; } else { chomp $bios_vendor; } } if (! $bios_version) { $bios_version = qx{$dmidecode_loc -s bios-version 2>/dev/null}; if (!defined $bios_version) { $bios_version = ""; } else { chomp $bios_version; } } if (! $bios_date) { $bios_date = qx{$dmidecode_loc -s bios-release-date 2>/dev/null}; if (! defined $bios_date) { $bios_date = ""; } else { chomp $bios_date; } } $bios_revision = qx{$dmidecode_loc -s bios-revision 2>/dev/null}; if (! defined $bios_revision) { $bios_revision = ""; } else { chomp $bios_revision; } $firmware_revision = qx{$dmidecode_loc -s firmware-revision 2>/dev/null}; if (! defined $firmware_revision) { $firmware_revision = ""; } else { chomp $firmware_revision; } # Sigh. Some version of dmidecode know about different '-s field' than others my @tbios = qx{$dmidecode_loc -t bios 2>/dev/null}; for my $tb (@tbios) { if ($tb =~ m/^\s*Vendor:\s*(.*)/i and !$bios_vendor) { $bios_vendor = $1; } elsif ($tb =~ m/^\s*Version:\s*(.*)/i and !$bios_version) { $bios_version = $1; } elsif ($tb =~ m/^\s*Release Date:\s*(.*)/i and !$bios_date) { $bios_date = $1; } elsif ($tb =~ m/^\s*BIOS Revision:\s*(.*)/i and !$bios_revision) { $bios_revision = $1; } elsif ($tb =~ m/\s*Firmware Revision:\s*(.*)/i and !$firmware_revision) { $firmware_revision = $1; } } } } notesout " "; if (! "$bios_vendor$bios_version$bios_date$bios_revision$firmware_revision") { notesout "BIOS: (could not find information)"; } else { notesout "BIOS:"; notesout " BIOS Vendor: $bios_vendor" if $bios_vendor; notesout " BIOS Version: $bios_version" if $bios_version; notesout " BIOS Date: $bios_date" if $bios_date; notesout " BIOS Revision: $bios_revision" if $bios_revision; notesout " Firmware Revision: $firmware_revision" if $firmware_revision; } } # # Editor settings: (please leave this at the end of the file) # vim: set filetype=perl syntax=perl shiftwidth=4 tabstop=8 expandtab nosmarttab colorcolumn=120 mouse= :