diff --git a/addincards/install.sh b/addincards/install.sh index e1f59b3..5750a85 100755 --- a/addincards/install.sh +++ b/addincards/install.sh @@ -12,7 +12,7 @@ if [ "${1}" = "late" ]; then cp -vf "${0}" "/tmpRoot/usr/arc/addons/" MODEL="$(cat /proc/sys/kernel/syno_hw_version)" - FILE="/tmpRoot/usr/syno/etc.defaults/adapter_cards.conf" + FILE="/tmpRoot/usr/syno/etc/adapter_cards.conf" [ ! -f "${FILE}.bak" ] && cp -f "${FILE}" "${FILE}.bak" @@ -26,6 +26,6 @@ if [ "${1}" = "late" ]; then elif [ "${1}" = "uninstall" ]; then echo "Installing addon addincards - ${1}" - FILE="/tmpRoot/usr/syno/etc.defaults/adapter_cards.conf" + FILE="/tmpRoot/usr/syno/etc/adapter_cards.conf" [ -f "${FILE}.bak" ] && mv -f "${FILE}.bak" "${FILE}" fi \ No newline at end of file diff --git a/expands/all/usr/bin/expands.sh b/expands/all/usr/bin/expands.sh index 5a31fed..18bf771 100755 --- a/expands/all/usr/bin/expands.sh +++ b/expands/all/usr/bin/expands.sh @@ -7,7 +7,7 @@ # # usb.map -FILE="/usr/syno/etc.defaults/usb.map" +FILE="/usr/syno/etc/usb.map" if [ -f "${FILE}" ]; then STATUS=$(curl -kL -w "%{http_code}" "http://www.linux-usb.org/usb.ids" -o "/tmp/usb.map") if [ $? -ne 0 -o ${STATUS} -ne 200 ]; then @@ -15,10 +15,6 @@ if [ -f "${FILE}" ]; then else [ ! -f "${FILE}.bak" ] && cp -f "${FILE}" "${FILE}.bak" cp -f "/tmp/usb.map" "${FILE}" - if [ -f "${FILE/\.defaults/}" ]; then - [ ! -f "${FILE/\.defaults/}.bak" ] && cp -f "${FILE/\.defaults/}" "${FILE/\.defaults/}.bak" - cp -f "/tmp/usb.map" "${FILE/\.defaults/}" - fi fi fi diff --git a/expands/install.sh b/expands/install.sh index 9d83fef..db05d2b 100755 --- a/expands/install.sh +++ b/expands/install.sh @@ -37,7 +37,7 @@ elif [ "${1}" = "uninstall" ]; then rm -f "/tmpRoot/usr/lib/systemd/system/multi-user.target.wants/expands.service" rm -f "/tmpRoot/usr/lib/systemd/system/expands.service" - FILE="/tmpRoot/usr/syno/etc.defaults/usb.map" + FILE="/tmpRoot/usr/syno/etc/usb.map" [ -f "${FILE}.bak" ] && mv -f "${FILE}.bak" "${FILE}" FILE="/tmpRoot/etc/ssl/certs/ca-certificates.crt" [ -f "${FILE}.bak" ] && mv -f "${FILE}.bak" "${FILE}" diff --git a/hdddb/all/usr/bin/hdddb.sh b/hdddb/all/usr/bin/hdddb.sh index ecd833a..feb9fb3 100755 --- a/hdddb/all/usr/bin/hdddb.sh +++ b/hdddb/all/usr/bin/hdddb.sh @@ -29,7 +29,7 @@ # /var/packages/StorageManager/target/ui/storage_panel.js -scriptver="v3.5.101" +scriptver="v3.5.103" script=Synology_HDD_db repo="007revad/Synology_HDD_db" scriptname=syno_hdd_db @@ -896,11 +896,9 @@ fixdrivemodel(){ get_size_gb(){ # $1 is /sys/block/sata1 or /sys/block/nvme0n1 etc - local float - local int - float=$(synodisk --info /dev/"$(basename -- "$1")" | grep 'Total capacity' | awk '{print $4 * 1.0737}') - int="${float%.*}" - echo "$int" + local disk_size_gb + disk_size_gb=$(synodisk --info /dev/"$(basename -- "$1")" | grep 'Total capacity' | awk '{print int($4 * 1.073741824)}') + echo "$disk_size_gb" } getdriveinfo(){ @@ -1150,15 +1148,23 @@ fi # Expansion units -# Create new /var/log/diskprediction log to ensure newly connected ebox is in latest log -# Otherwise the new /var/log/diskprediction log is only created a midnight. -/usr/syno/bin/syno_disk_data_collector record +# eSATA and InfiniBand ports both appear in syno_slot_mapping as: +# Esata port count: 1 +# Eunit port 1 - RX1214 +# Only device tree models have syno_slot_mapping +if which syno_slot_mapping >/dev/null; then + eunitlist=($(syno_slot_mapping | grep 'Eunit port' | awk '{print $5}')) +else + # Create new /var/log/diskprediction log to ensure newly connected ebox is in latest log + # Otherwise the new /var/log/diskprediction log is only created a midnight. + /usr/syno/bin/syno_disk_data_collector record -# Get list of connected expansion units (aka eunit/ebox) -path="/var/log/diskprediction" -# shellcheck disable=SC2012 -file=$(ls $path | tail -n1) -eunitlist=($(grep -Eowi "([FRD]XD?[0-9]{3,4})(rp|ii|sas){0,2}" "$path/$file" | uniq)) + # Get list of connected expansion units (aka eunit/ebox) + path="/var/log/diskprediction" + # shellcheck disable=SC2012 + file=$(ls $path | tail -n1) + eunitlist=($(grep -Eowi "([FRD]XD?[0-9]{3,4})(rp|ii|sas){0,2}" "$path/$file" | uniq)) +fi # Sort eunitlist array into new eunits array to remove duplicates if [[ ${#eunitlist[@]} -gt "0" ]]; then @@ -2095,10 +2101,12 @@ if [[ $nodbupdate == "yes" ]]; then # Add drive_db_test_url="127.0.0.1" #echo 'drive_db_test_url="127.0.0.1"' >> "$synoinfo" /usr/syno/bin/synosetkeyvalue "$synoinfo" "$dtu" "127.0.0.1" + [ -d /tmpRoot ] && /tmpRoot/usr/syno/bin/synosetkeyvalue /tmpRoot/etc.defaults/synoinfo.conf "$dtu" "127.0.0.1" disabled="yes" elif [[ $url != "127.0.0.1" ]]; then # Edit drive_db_test_url= /usr/syno/bin/synosetkeyvalue "$synoinfo" "$dtu" "127.0.0.1" + [ -d /tmpRoot ] && /tmpRoot/usr/syno/bin/synosetkeyvalue /tmpRoot/etc.defaults/synoinfo.conf "$dtu" "127.0.0.1" disabled="yes" fi diff --git a/misc/all/usr/bin/awk b/misc/all/usr/bin/awk index bab090d..e69de29 100755 Binary files a/misc/all/usr/bin/awk and b/misc/all/usr/bin/awk differ diff --git a/misc/all/usr/lib/libblkid.so b/misc/all/usr/lib/libblkid.so index fe600c4..e69de29 100755 Binary files a/misc/all/usr/lib/libblkid.so and b/misc/all/usr/lib/libblkid.so differ diff --git a/misc/all/usr/lib/libblkid.so.1 b/misc/all/usr/lib/libblkid.so.1 index fe600c4..e69de29 100755 Binary files a/misc/all/usr/lib/libblkid.so.1 and b/misc/all/usr/lib/libblkid.so.1 differ diff --git a/misc/all/usr/sbin/dufs b/misc/all/usr/sbin/dufs index 6f463cf..d2a4281 100755 Binary files a/misc/all/usr/sbin/dufs and b/misc/all/usr/sbin/dufs differ diff --git a/misc/all/usr/sbin/inxi b/misc/all/usr/sbin/inxi new file mode 100755 index 0000000..b400b92 --- /dev/null +++ b/misc/all/usr/sbin/inxi @@ -0,0 +1,38930 @@ +#!/usr/bin/env perl +## infobash: Copyright (C) 2005-2007 Michiel de Boer aka locsmif +## inxi: Copyright (C) 2008-2024 Harald Hope +## Additional features (C) Scott Rogers - kde, cpu info +## Parse::EDID (C): 2005-2010 by Mandriva SA, Pascal Rigaux, Anssi Hannula +## Further fixes (listed as known): Horst Tritremmel +## Steven Barrett (aka: damentz) - usb audio patch; swap percent used patch +## Jarett.Stevens - dmidecode -M patch for older systems without /sys machine +## +## License: GNU GPL v3 or greater +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . +## +## If you don't understand what Free Software is, please read (or reread) +## this page: http://www.gnu.org/philosophy/free-sw.html +## +## DEVS: NOTE: geany/scite folding is picky. Leave 1 space after # or it breaks! + +use strict; +use warnings; +# use diagnostics; +use 5.008; + +## Perl 7 things for testing: depend on Perl 5.032 +# use 5.034; +# use compat::perl5; # act like Perl 5's defaults +# no feature qw(indirect); +# no multidimensional; +# no bareword::filehandles; + +use Cwd qw(abs_path); # #abs_path realpath getcwd +use Data::Dumper qw(Dumper); # print_r +$Data::Dumper::Sortkeys = 1; +# NOTE: load in SystemDebugger unless encounter issues with require/import +# use File::Find; +use File::stat; # needed for Xorg.0.log file mtime comparisons +use Getopt::Long qw(GetOptions); +# Note: default auto_abbrev is enabled +Getopt::Long::Configure ('bundling', 'no_ignore_case', +'no_getopt_compat', 'no_auto_abbrev','pass_through'); +use POSIX qw(ceil uname strftime ttyname); +# use bigint qw/hex/; # to handle large hex number warnings, but Perl 5.010 and later. +# use Benchmark qw(:all);_ +# use Devel::Size qw(size total_size); +# use feature qw(say state); # 5.10 or newer Perl + +### INITIALIZE VARIABLES ### + +## INXI INFO ## +my $self_name='inxi'; +my $self_version='3.3.36'; +my $self_date='2024-09-04'; +my $self_patch='00'; +## END INXI INFO ## + +my ($b_pledge,@pledges); +if (eval {require OpenBSD::Pledge}){ + OpenBSD::Pledge->import(); + $b_pledge = 1; + # cpath/wpath: dir/files .inxi, --debug > 9, -c 9x, -w/W; + # dns/inet: ftp upload --debug > 20; exec/proc/rpath: critical; + # prot_exec: Perl import; getpw: perl getpwuid() -c 9x, Net::FTP --debug > 20; + # stdio: default; error: debugging pledge/perl + # tested. not required: mcast pf ps recvfd sendfd tmppath tty unix vminfo; + # Pledge removal: OptionsHandler::post_process() [dns,inet,cpath,getpw,wpath]; + # SelectColors::set_selection() [getpw] + @pledges = qw(cpath dns exec getpw inet proc prot_exec rpath wpath); + pledge(@pledges); +} + +## Self data +my ($fake_data_dir,$self_path,$user_config_dir,$user_config_file,$user_data_dir); + +## Hashes +my (%alerts,%build_prop,%client,%colors,,%cpuinfo_machine,%comps,%disks_bsd, +%dboot,%devices,%dl,%dmmapper,%force,%loaded,%mapper,%program_values,%ps_data, +%risc,%service_tool,%show,%sysctl,%system_files,%usb,%windows); + +## System Arrays +my (@cpuinfo,@dmi,@ifs,@ifs_bsd,@paths,@ps_aux,@ps_cmd, +@sensors_exclude,@sensors_use,@uname); + +## Disk/Logical/Partition/RAID arrays +my (@btrfs_raid,@glabel,@labels,@lsblk,@lvm,@lvm_raid,@md_raid,@partitions, +@proc_partitions,@raw_logical,@soft_raid,@swaps,@uuids,@zfs_raid); + +## Debuggers +my %debugger = ('level' => 0); +my (@dbg,%fake,@t0); +my ($b_hires,$b_log,$b_log_colors,$b_log_full); +my ($end,$start,$fh_l,$log_file); # log file handle, file +my ($t1,$t2,$t3) = (0,0,0); # timers +## debug / temp tools +$debugger{'sys'} = 1; +$client{'test-konvi'} = 0; + +# NOTE: redhat removed HiRes from Perl Core Modules. +if (eval {require Time::HiRes}){ + Time::HiRes->import('gettimeofday','tv_interval','usleep'); + $b_hires = 1; +} +@t0 = eval 'Time::HiRes::gettimeofday()' if $b_hires; # let's start it right away + +## Booleans [busybox_ps not used actively] +my ($b_admin,$b_android,$b_display,$b_irc,$b_root); + +## System +my ($bsd_type,$device_vm,$language,$os,$pci_tool) = ('','','','',''); +my ($wan_url) = (''); +my ($bits_sys,$cpu_arch,$ppid); +my ($cpu_sleep,$dl_timeout,$limit,$ps_count) = (0.35,4,10,5); +my $sensors_cpu_nu = 0; +my ($weather_source,$weather_unit) = (100,'mi'); + +## Tools +my ($display,$ftp_alt); +my ($display_opt,$sudoas) = ('',''); + +## Output +my $extra = 0;# supported values: 0-3 +my $filter_string = ''; +my $line1 = "----------------------------------------------------------------------\n"; +my $line2 = "======================================================================\n"; +my $line3 = "----------------------------------------\n"; +my ($output_file,$output_type) = ('','screen'); +my $prefix = 0; # for the primary row hash key prefix + +## Initialize internal hashes +# these assign a separator to non irc states. Important! Using ':' can +# trigger stupid emoticon. Note: SEP1/SEP2 from short form not used anymore. +# behaviors in output on IRC, so do not use those. +my %sep = ( +'s1-irc' => ':', +'s1-console' => ':', +'s2-irc' => '', +'s2-console' => ':', +); +#$show{'host'} = 1; +my %size = ( +'console' => 80, # In display, orig: 115 +# Default indentation level. NOTE: actual indent is 1 greater to allow for +# spacing +'indent' => 11, +'indents' => 2, +'irc' => 100, # shorter because IRC clients have nick lists etc +'lines' => 1, # for active output line counter for -Y +'max-cols' => 0, +'max-join-list' => 30, # used in make_list_value() to add space after sep or not. +'max-lines' => 0, +'max-wrap' => 110, +'no-display' => 100, # No Display, orig: 130 +# this will be set dynamically in set_display_size() +'term-cols' => 80, # orig: 80 +'term-lines' => 40, # orig: 100 +); +my %use = ( +'update' => 1, # switched off/on with maintainer config ALLOW_UPDATE +'weather' => 1, # switched off/on with maintainer config ALLOW_WEATHER +); + +######################################################################## +#### STARTUP +######################################################################## + +#### ------------------------------------------------------------------- +#### MAIN +#### ------------------------------------------------------------------- + +sub main { + # print Dumper \@ARGV; + eval $start if $b_log; + initialize(); + ## Uncomment these two values for start client debugging + # $debugger{'level'} = 3; # 3 prints timers / 10 prints to log file + # set_debugger(); # for debugging of konvi and other start client issues + ## legacy method + # my $ob_start = StartClient->new(); + #$ob_start->get_client_data(); + StartClient::set(); + # print_line(Dumper \%client); + OptionsHandler::get(); + set_debugger(); # right after so it's set + CheckTools::set(); + set_colors(); + set_sep(); + # print download_file('stdout','https://') . "\n"; + OutputGenerator::generate(); + eval $end if $b_log; + cleanup(); + # weechat's executor plugin forced me to do this, and rightfully so, + # because else the exit code from the last command is taken.. + exit 0; +} + +#### ------------------------------------------------------------------- +#### INITIALIZE +#### ------------------------------------------------------------------- + +sub initialize { + set_path(); + set_user_paths(); + set_basics(); + set_system_files(); + set_os(); + Configs::set(); + # set_downloader(); + set_display_size(); +} + +## CheckTools ## +{ +package CheckTools; +my (%commands); + +sub set { + eval $start if $b_log; + set_commands(); + my ($action,$program,$message,@data); + foreach my $test (keys %commands){ + ($action,$program) = ('use',''); + $message = main::message('tool-present'); + if ($commands{$test}->[1] && ( + ($commands{$test}->[1] eq 'linux' && $os ne 'linux') || + ($commands{$test}->[1] eq 'bsd' && $os eq 'linux'))){ + $action = 'platform'; + } + elsif ($program = main::check_program($test)){ + # > 0 means error in shell + # my $cmd = "$program $commands{$test} >/dev/null"; + # print "$cmd\n"; + $pci_tool = $test if $test =~ /pci/; + # this test is not ideal because other errors can make program fail, but + # we can't test for root since could be say, wheel permissions needed + if ($commands{$test}->[0] eq 'exec-sys'){ + $action = 'permissions' if system("$program $commands{$test}->[2] >/dev/null 2>&1"); + } + elsif ($commands{$test}->[0] eq 'exec-string'){ + @data = main::grabber("$program $commands{$test}->[2] 2>&1"); + # dmidecode errors are so specific it gets its own section + # also sets custom dmidecode error messages + if ($test eq 'dmidecode'){ + $action = set_dmidecode(\@data) if scalar @data < 15; + } + elsif (grep { $_ =~ /$commands{$test}->[3]/i } @data){ + $action = 'permissions'; + } + } + } + else { + $action = 'missing'; + } + $alerts{$test}->{'action'} = $action; + $alerts{$test}->{'path'} = $program; + if ($action eq 'missing'){ + $alerts{$test}->{'message'} = main::message('tool-missing-recommends',"$test"); + } + elsif ($action eq 'permissions'){ + $alerts{$test}->{'message'} = main::message('tool-permissions',"$test"); + } + elsif ($action eq 'platform'){ + $alerts{$test}->{'message'} = main::message('tool-missing-os', $uname[0] . " $test"); + } + } + print Data::Dumper::Dumper \%alerts if $dbg[25]; + set_fake_bsd_tools() if $fake{'bsd'}; + eval $end if $b_log; +} + +sub set_dmidecode { + my ($data) = @_; + my $action = 'use'; + if ($b_root){ + foreach (@$data){ + # don't need first line or scanning /dev/mem lines + if (/^(# dmi|Scanning)/){ + next; + } + elsif ($_ =~ /No SMBIOS/i){ + $action = 'smbios'; + last; + } + elsif ($_ =~ /^\/dev\/mem: Operation/i){ + $action = 'no-data'; + last; + } + else { + $action = 'unknown-error'; + last; + } + } + } + else { + if (grep {$_ =~ /(^\/dev\/mem: Permission|Permission denied)/i } @$data){ + $action = 'permissions'; + } + else { + $action = 'unknown-error'; + } + } + if ($action ne 'use' && $action ne 'permissions'){ + if ($action eq 'smbios'){ + $alerts{'dmidecode'}->{'message'} = main::message('dmidecode-smbios'); + } + elsif ($action eq 'no-data'){ + $alerts{'dmidecode'}->{'message'} = main::message('dmidecode-dev-mem'); + } + elsif ($action eq 'unknown-error'){ + $alerts{'dmidecode'}->{'message'} = main::message('tool-unknown-error','dmidecode'); + } + } + return $action; +} + +sub set_commands { + # note: gnu/linux has sysctl so it may be used that for something if present + # there is lspci for bsds so doesn't hurt to check it + if (!$bsd_type){ + if ($use{'pci'}){ + $commands{'lspci'} = ['exec-sys','','-n']; + } + if ($use{'logical'}){ + $commands{'lvs'} = ['exec-sys','','']; + } + if ($use{'udevadm'}){ + $commands{'udevadm'} = ['missing','','']; + } + } + else { + if ($use{'pci'}){ + $commands{'pciconf'} = ['exec-sys','','-l']; + $commands{'pcictl'} = ['exec-sys','',' pci0 list']; + $commands{'pcidump'} = ['exec-sys','','']; + } + if ($use{'sysctl'}){ + # note: there is a case of kernel.osrelease but it's a linux distro + $commands{'sysctl'} = ['exec-sys','','kern.osrelease']; + } + if ($use{'bsd-partition'}){ + $commands{'bioctl'} = ['missing','','']; + $commands{'disklabel'} = ['missing','','']; + $commands{'fdisk'} = ['missing','','']; + $commands{'gpart'} = ['missing','','']; + } + } + if ($use{'dmidecode'}){ + $commands{'dmidecode'} = ['exec-string','','-t chassis -t baseboard -t processor','']; + } + if ($use{'usb'}){ + # note: lsusb ships in FreeBSD ports sysutils/usbutils + $commands{'lsusb'} = ['missing','','','']; + # we want these set for various null bsd data tests + $commands{'usbconfig'} = ['exec-string','bsd','list','permissions']; + $commands{'usbdevs'} = ['missing','bsd','','']; + } + if ($show{'bluetooth'}){ + $commands{'bluetoothctl'} = ['missing','linux','','']; + # bt-adapter hangs when bluetooth service is disabled + $commands{'bt-adapter'} = ['missing','linux','','']; + # btmgmt enters its own shell with no options given + $commands{'btmgmt'} = ['missing','linux','','']; + $commands{'hciconfig'} = ['missing','linux','','']; + } + if ($show{'sensor'}){ + $commands{'sensors'} = ['missing','linux','','']; + } + if ($show{'ip'} || ($bsd_type && $show{'network-advanced'})){ + $commands{'ip'} = ['missing','linux','','']; + $commands{'ifconfig'} = ['missing','','','']; + } + # can't check permissions since we need to know the partition/disc + if ($use{'block-tool'}){ + $commands{'blockdev'} = ['missing','linux','','']; + $commands{'lsblk'} = ['missing','linux','','']; + } + if ($use{'btrfs'}){ + $commands{'btrfs'} = ['missing','linux','','']; + } + if ($use{'mdadm'}){ + $commands{'mdadm'} = ['missing','linux','','']; + } + if ($use{'smartctl'}){ + $commands{'smartctl'} = ['missing','','','']; + } + if ($show{'unmounted'}){ + $commands{'disklabel'} = ['missing','bsd','xx']; + } +} + +# only for dev/debugging BSD +sub set_fake_bsd_tools { + $system_files{'dmesg-boot'} = '/var/run/dmesg.boot' if $fake{'dboot'}; + $alerts{'sysctl'}->{'action'} = 'use' if $fake{'sysctl'}; + if ($fake{'pciconf'} || $fake{'pcictl'} || $fake{'pcidump'}){ + $alerts{'pciconf'}->{'action'} = 'use' if $fake{'pciconf'}; + $alerts{'pcictl'}->{'action'} = 'use' if $fake{'pcictl'}; + $alerts{'pcidump'}->{'action'} = 'use' if $fake{'pcidump'}; + $alerts{'lspci'} = { + 'action' => 'missing', + 'message' => 'Required program lspci not available', + }; + } + if ($fake{'usbconfig'} || $fake{'usbdevs'}){ + $alerts{'usbconfig'}->{'action'} = 'use' if $fake{'usbconfig'}; + $alerts{'usbdevs'}->{'action'} = 'use' if $fake{'usbdevs'}; + $alerts{'lsusb'} = { + 'action' => 'missing', + 'message' => 'Required program lsusb not available', + }; + } + if ($fake{'disklabel'}){ + $alerts{'disklabel'}->{'action'} = 'use'; + } +} +} + +sub set_basics { + ### LOCALIZATION - DO NOT CHANGE! ### + # set to default LANG to avoid locales errors with , or . + # Make sure every program speaks English. + $ENV{'LANG'}='C'; + $ENV{'LC_ALL'}='C'; + # remember, perl uses the opposite t/f return as shell!!! + # some versions of busybox do not have tty, like openwrt + $b_irc = 1 if (check_program('tty') && system('tty >/dev/null')); + # print "birc: $b_irc\n"; + # with X, DISPLAY sets, then check Wayland, other DE/WM sessions + if ($ENV{'DISPLAY'} || $ENV{'WAYLAND_DISPLAY'} || + $ENV{'XDG_CURRENT_DESKTOP'} || $ENV{'DESKTOP_SESSION'}){ + $b_display = 1; + } + $b_root = $< == 0; # root UID 0, all others > 0 + $dl{'dl'} = 'curl'; + $dl{'curl'} = 1; + $dl{'fetch'} = 1; + $dl{'tiny'} = 1; # note: two modules needed, tested for in set_downloader + $dl{'wget'} = 1; + $client{'console-irc'} = 0; + $client{'dcop'} = (check_program('dcop')) ? 1 : 0; + $client{'qdbus'} = (check_program('qdbus')) ? 1 : 0; + $client{'konvi'} = 0; + $client{'name'} = ''; + $client{'name-print'} = ''; + $client{'su-start'} = ''; # shows sudo/su + $client{'version'} = ''; + $client{'whoami'} = getpwuid($<) || ''; + $colors{'default'} = 2; + $show{'partition-sort'} = 'id'; # sort order for partitions + @raw_logical = (0,0,0); + $ppid = getppid(); + # seen case where $HOME not set + if (!$ENV{'HOME'}){ + if (my $who = qx(whoami)){ + if (-d "/$who"){ + $ENV{'HOME'} = "/$who";} # root + elsif (-d "/home/$who"){ + $ENV{'HOME'} = "/home/$who";} + elsif (-d "/usr/home/$who"){ + $ENV{'HOME'} = "/usr/home/$who";} + # else give up, we're not going to have any luck here + } + } +} + +sub set_display_size { + ## sometimes tput will trigger an error (mageia) if irc client + if (!$b_irc){ + if (my $program = check_program('tput')){ + # Arch urxvt: 'tput: unknown terminal "rxvt-unicode-256color"' + # trips error if use qx(); in FreeBSD, if you use 2>/dev/null + # it makes default value 80x24, who knows why? + chomp($size{'term-cols'} = qx{$program cols}); + chomp($size{'term-lines'} = qx{$program lines}); + } + # print "tc: $size{'term-cols'} cmc: $size{'console'}\n"; + # double check, just in case it's missing functionality or whatever + if (!is_int($size{'term-cols'} || $size{'term-cols'} == 0)){ + $size{'term-cols'} = 80; + } + if (!is_int($size{'term-lines'} || $size{'term-lines'} == 0)){ + $size{'term-lines'} = 24; + } + } + # this lets you set different size for in or out of display server + if (!$b_display && $size{'no-display'}){ + $size{'console'} = $size{'no-display'}; + } + # term_cols is set in top globals, using tput cols + # print "tc: $size{'term-cols'} cmc: $size{'console'}\n"; + if ($size{'term-cols'} < $size{'console'}){ + $size{'console'} = $size{'term-cols'}; + } + # adjust, some terminals will wrap if output cols == term cols + $size{'console'} = ($size{'console'} - 1); + # echo cmc: $size{'console'} + # comes after source for user set stuff + if (!$b_irc){ + $size{'max-cols'} = $size{'console'}; + } + else { + $size{'max-cols'} = $size{'irc'}; + } + # for -V/-h overrides + $size{'max-cols-basic'} = $size{'max-cols'}; + # print "tc: $size{'term-cols'} cmc: $size{'console'} cm: $size{'max-cols'}\n"; +} + +sub set_os { + @uname = uname(); + $os = lc($uname[0]); + $cpu_arch = lc($uname[-1]); + if ($cpu_arch =~ /arm|aarch/){ + $risc{'arm'} = 1; + $risc{'id'} = 'arm';} + elsif ($cpu_arch =~ /mips/){ + $risc{'mips'} = 1; + $risc{'id'} = 'mips';} + elsif ($cpu_arch =~ /power|ppc/){ + $risc{'ppc'} = 1; + $risc{'id'} = 'ppc';} + elsif ($cpu_arch =~ /riscv/){ + $risc{'riscv'} = 1; + $risc{'id'} = 'riscv';} + elsif ($cpu_arch =~ /(sparc|sun4[uv])/){ + $risc{'sparc'} = 1; + $risc{'id'} = 'sparc';} + # aarch32 mips32, i386. centaur/via/intel/amd handled in cpu + if ($cpu_arch =~ /(armv[1-7]|32|[23456]86)/){ + $bits_sys = 32; + } + elsif ($cpu_arch =~ /(alpha|64|e2k|sparc_v9|sun4[uv]|ultrasparc)/){ + $bits_sys = 64; + # force to string e2k, and also in case we need that ID changed + $cpu_arch = 'elbrus' if $cpu_arch =~ /e2k|elbrus/; + } + # set some less common scenarios + if ($os =~ /cygwin/){ + $windows{'cygwin'} = 1; + } + elsif (-e '/usr/lib/wsl/drivers'){ + $windows{'wsl'} = 1; + } + elsif (-e '/system/build.prop'){ + $b_android = 1; + } + if ($os =~ /(aix|bsd|cosix|dragonfly|darwin|hp-?ux|indiana|illumos|irix|sunos|solaris|ultrix|unix)/){ + if ($os =~ /openbsd/){ + $os = 'openbsd'; + } + elsif ($os =~ /darwin/){ + $os = 'darwin'; + } + # NOTE: most tests internally are against !$bsd_type + if ($os =~ /kfreebsd/){ + $bsd_type = 'debian-bsd'; + } + else { + $bsd_type = $os; + } + } +} + +# Sometimes users will have more PATHs local to their setup, so we want those +# too. +sub set_path { + # Extra path variable to make execute failures less likely, merged below + my (@path); + # NOTE: recent Xorg's show error if you try /usr/bin/Xorg -version but work + # if you use the /usr/lib/xorg-server/Xorg path. Some distros fail to add TDE + my @test = qw(/sbin /bin /usr/sbin /usr/bin /usr/local/sbin /usr/local/bin + /usr/X11R6/bin /opt/trinity/bin); + foreach (@test){ + push(@paths,$_) if -d $_; + } + @path = split(':', $ENV{'PATH'}) if $ENV{'PATH'}; + # print "paths: @paths\nPATH: $ENV{'PATH'}\n"; + # Create a difference of $PATH and $extra_paths and add that to $PATH: + foreach my $id (@path){ + if (-d $id && !(grep {/^$id$/} @paths) && $id !~ /(game)/){ + push(@paths, $id); + } + } + # print "paths: \n", join("\n", @paths),"\n"; +} + +sub set_sep { + if ($b_irc){ + # too hard to read if no colors, so force that for users on irc + if ($colors{'scheme'} == 0){ + $sep{'s1'} = $sep{'s1-console'}; + $sep{'s2'} = $sep{'s2-console'}; + } + else { + $sep{'s1'} = $sep{'s1-irc'}; + $sep{'s2'} = $sep{'s2-irc'}; + } + } + else { + $sep{'s1'} = $sep{'s1-console'}; + $sep{'s2'} = $sep{'s2-console'}; + } +} + +# Important: -n makes it non interactive, no prompt for password +# only use doas/sudo if not root, -n option requires sudo -V 1.7 or greater. +# for some reason sudo -n with < 1.7 in Perl does not print to stderr +# sudo will just error out which is the safest course here for now, +# otherwise that interactive sudo password thing is too annoying +sub set_sudo { + if (!$b_root){ + my ($path); + if (!$force{'no-doas'} && ($path = check_program('doas'))){ + $sudoas = "$path -n "; + } + elsif (!$force{'no-sudo'} && ($path = check_program('sudo'))){ + my @data = ProgramData::full('sudo'); + $data[1] =~ s/^([0-9]+\.[0-9]+).*/$1/; + # print "sudo v: $data[1]\n"; + $sudoas = "$path -n " if is_numeric($data[1]) && $data[1] >= 1.7; + } + } +} + +sub set_system_files { + my %files = ( + 'asound-cards' => '/proc/asound/cards', + 'asound-modules' => '/proc/asound/modules', + 'asound-version' => '/proc/asound/version', + 'dmesg-boot' => '/var/run/dmesg.boot', + 'proc-cmdline' => '/proc/cmdline', + 'proc-cpuinfo' => '/proc/cpuinfo', + 'proc-mdstat' => '/proc/mdstat', + 'proc-meminfo' => '/proc/meminfo', + 'proc-modules' => '/proc/modules', # not used + 'proc-mounts' => '/proc/mounts',# not used + 'proc-partitions' => '/proc/partitions', + 'proc-scsi' => '/proc/scsi/scsi', + 'proc-version' => '/proc/version', + # note: 'xorg-log' is set in set_xorg_log() only if -G is triggered + ); + foreach (keys %files){ + $system_files{$_} = (-e $files{$_}) ? $files{$_} : ''; + } +} + +sub set_user_paths { + my ($b_conf,$b_data); + # this needs to be set here because various options call the parent + # initialize function directly. + $self_path = $0; + $self_path =~ s/[^\/]+$//; + # print "0: $0 sp: $self_path\n"; + # seen case where $HOME not set + if ($ENV{'XDG_CONFIG_HOME'}){ + $user_config_dir=$ENV{'XDG_CONFIG_HOME'}; + $b_conf=1; + } + elsif (-d "$ENV{'HOME'}/.config"){ + $user_config_dir="$ENV{'HOME'}/.config"; + $b_conf=1; + } + else { + $user_config_dir="$ENV{'HOME'}/.$self_name"; + } + if ($ENV{'XDG_DATA_HOME'}){ + $user_data_dir="$ENV{'XDG_DATA_HOME'}/$self_name"; + $b_data=1; + } + elsif (-d "$ENV{'HOME'}/.local/share"){ + $user_data_dir="$ENV{'HOME'}/.local/share/$self_name"; + $b_data=1; + } + else { + $user_data_dir="$ENV{'HOME'}/.$self_name"; + } + # note, this used to be created/checked in specific instance, but we'll just + # do it universally so it's done at script start. + if (! -d $user_data_dir){ + mkdir $user_data_dir; + # system "echo", "Made: $user_data_dir"; + } + if ($b_conf && -f "$ENV{'HOME'}/.$self_name/$self_name.conf"){ + # system 'mv', "-f $ENV{'HOME'}/.$self_name/$self_name.conf", $user_config_dir; + # print "WOULD: Moved $self_name.conf from $ENV{'HOME'}/.$self_name to $user_config_dir\n"; + } + if ($b_data && -d "$ENV{'HOME'}/.$self_name"){ + # system 'mv', '-f', "$ENV{'HOME'}/.$self_name/*", $user_data_dir; + # system 'rm', '-Rf', "$ENV{'HOME'}/.$self_name"; + # print "WOULD: Moved data dir $ENV{'HOME'}/.$self_name to $user_data_dir\n"; + } + $fake_data_dir = "$ENV{'HOME'}/bin/scripts/inxi/data"; + $log_file="$user_data_dir/$self_name.log"; + # system 'echo', "$ENV{'HOME'}/.$self_name/* $user_data_dir"; + # print "scd: $user_config_dir sdd: $user_data_dir \n"; +} + +sub set_xorg_log { + eval $start if $b_log; + my (@temp,@x_logs); + my ($file_holder,$time_holder,$x_mtime) = ('',0,0); + # NOTE: other variations may be /var/run/gdm3/... but not confirmed + # worry about we are just going to get all the Xorg logs we can find, + # and not which is 'right'. Xorg was XFree86 earlier, only in /var/log. + @temp = globber('/var/log/{Xorg,XFree86}.*.log'); + push(@x_logs, @temp) if @temp; + @temp = globber('/var/lib/gdm/.local/share/xorg/Xorg.*.log'); + push(@x_logs, @temp) if @temp; + @temp = globber($ENV{'HOME'} . '/.local/share/xorg/Xorg.*.log',); + push(@x_logs, @temp) if @temp; + # root will not have a /root/.local/share/xorg directory so need to use a + # user one if we can find one. + if ($b_root){ + @temp = globber('/home/*/.local/share/xorg/Xorg.*.log'); + push(@x_logs, @temp) if @temp; + } + foreach (@x_logs){ + if (-r $_){ + my $src_info = File::stat::stat("$_"); + # print "$_\n"; + if ($src_info){ + $x_mtime = $src_info->mtime; + # print $_ . ": $x_time" . "\n"; + if ($x_mtime > $time_holder){ + $time_holder = $x_mtime; + $file_holder = $_; + } + } + } + } + if (!$file_holder && check_program('xset')){ + my $data = qx(xset q 2>/dev/null); + foreach (split('\n', $data)){ + if ($_ =~ /Log file/i){ + $file_holder = get_piece($_,3); + last; + } + } + } + print "Xorg log file: $file_holder\nLast modified: $time_holder\n" if $dbg[14]; + log_data('data',"Xorg log file: $file_holder") if $b_log; + $system_files{'xorg-log'} = $file_holder; + eval $end if $b_log; +} + +######################################################################## +#### UTILITIES +######################################################################## + +#### ------------------------------------------------------------------- +#### COLORS +#### ------------------------------------------------------------------- + +## args: 0: the type of action, either integer, count, or full +sub get_color_scheme { + eval $start if $b_log; + my ($type) = @_; + my $color_schemes = [ + [qw(EMPTY EMPTY EMPTY)], + [qw(NORMAL NORMAL NORMAL)], + # for dark OR light backgrounds + [qw(BLUE NORMAL NORMAL)], + [qw(BLUE RED NORMAL)], + [qw(CYAN BLUE NORMAL)], + [qw(DCYAN NORMAL NORMAL)], + [qw(DCYAN BLUE NORMAL)], + [qw(DGREEN NORMAL NORMAL)], + [qw(DYELLOW NORMAL NORMAL)], + [qw(GREEN DGREEN NORMAL)], + [qw(GREEN NORMAL NORMAL)], + [qw(MAGENTA NORMAL NORMAL)], + [qw(RED NORMAL NORMAL)], + # for light backgrounds + [qw(BLACK DGREY NORMAL)], + [qw(DBLUE DGREY NORMAL)], + [qw(DBLUE DMAGENTA NORMAL)], + [qw(DBLUE DRED NORMAL)], + [qw(DBLUE BLACK NORMAL)], + [qw(DGREEN DYELLOW NORMAL)], + [qw(DYELLOW BLACK NORMAL)], + [qw(DMAGENTA BLACK NORMAL)], + [qw(DCYAN DBLUE NORMAL)], + # for dark backgrounds + [qw(WHITE GREY NORMAL)], + [qw(GREY WHITE NORMAL)], + [qw(CYAN GREY NORMAL)], + [qw(GREEN WHITE NORMAL)], + [qw(GREEN YELLOW NORMAL)], + [qw(YELLOW WHITE NORMAL)], + [qw(MAGENTA CYAN NORMAL)], + [qw(MAGENTA YELLOW NORMAL)], + [qw(RED CYAN NORMAL)], + [qw(RED WHITE NORMAL)], + [qw(BLUE WHITE NORMAL)], + # miscellaneous + [qw(RED BLUE NORMAL)], + [qw(RED DBLUE NORMAL)], + [qw(BLACK BLUE NORMAL)], + [qw(BLACK DBLUE NORMAL)], + [qw(NORMAL BLUE NORMAL)], + [qw(BLUE MAGENTA NORMAL)], + [qw(DBLUE MAGENTA NORMAL)], + [qw(BLACK MAGENTA NORMAL)], + [qw(MAGENTA BLUE NORMAL)], + [qw(MAGENTA DBLUE NORMAL)], + ]; + eval $end if $b_log; + if ($type eq 'count'){ + return scalar @$color_schemes; + } + if ($type eq 'full'){ + return $color_schemes; + } + else { + # print Dumper $color_schemes->[$type]; + return $color_schemes->[$type]; + } +} + +sub set_color_scheme { + eval $start if $b_log; + my ($scheme) = @_; + $colors{'scheme'} = $scheme; + my $index = ($b_irc) ? 1 : 0; # defaults to non irc + # NOTE: qw(...) kills the escape, it is NOT the same as using + # Literal "..", ".." despite docs saying it is. + my %color_palette = ( + 'EMPTY' => [ '', '' ], + 'DGREY' => [ "\e[1;30m", "\x0314" ], + 'BLACK' => [ "\e[0;30m", "\x0301" ], + 'RED' => [ "\e[1;31m", "\x0304" ], + 'DRED' => [ "\e[0;31m", "\x0305" ], + 'GREEN' => [ "\e[1;32m", "\x0309" ], + 'DGREEN' => [ "\e[0;32m", "\x0303" ], + 'YELLOW' => [ "\e[1;33m", "\x0308" ], + 'DYELLOW' => [ "\e[0;33m", "\x0307" ], + 'BLUE' => [ "\e[1;34m", "\x0312" ], + 'DBLUE' => [ "\e[0;34m", "\x0302" ], + 'MAGENTA' => [ "\e[1;35m", "\x0313" ], + 'DMAGENTA' => [ "\e[0;35m", "\x0306" ], + 'CYAN' => [ "\e[1;36m", "\x0311" ], + 'DCYAN' => [ "\e[0;36m", "\x0310" ], + 'WHITE' => [ "\e[1;37m", "\x0300" ], + 'GREY' => [ "\e[0;37m", "\x0315" ], + 'NORMAL' => [ "\e[0m", "\x03" ], + ); + my $color_scheme = get_color_scheme($colors{'scheme'}); + $colors{'c1'} = $color_palette{$color_scheme->[0]}[$index]; + $colors{'c2'} = $color_palette{$color_scheme->[1]}[$index]; + $colors{'cn'} = $color_palette{$color_scheme->[2]}[$index]; + # print Dumper \@scheme; + # print "$colors{'c1'}here$colors{'c2'} we are!$colors{'cn'}\n"; + eval $end if $b_log; +} + +sub set_colors { + eval $start if $b_log; + # it's already been set with -c 0-43 + if (exists $colors{'c1'}){ + return 1; + } + # This let's user pick their color scheme. For IRC, only shows the color + # schemes, no interactive. The override value only will be placed in user + # config files. /etc/inxi.conf can also override + if (exists $colors{'selector'}){ + my $ob_selector = SelectColors->new($colors{'selector'}); + $ob_selector->select_schema(); + return 1; + } + # set the default, then override as required + my $color_scheme = $colors{'default'}; + # these are set in user configs + if (defined $colors{'global'}){ + $color_scheme = $colors{'global'}; + } + else { + if ($b_irc){ + if (defined $colors{'irc-virt-term'} && $b_display && $client{'console-irc'}){ + $color_scheme = $colors{'irc-virt-term'}; + } + elsif (defined $colors{'irc-console'} && !$b_display){ + $color_scheme = $colors{'irc-console'}; + } + elsif (defined $colors{'irc-gui'}){ + $color_scheme = $colors{'irc-gui'}; + } + } + else { + if (defined $colors{'console'} && !$b_display){ + $color_scheme = $colors{'console'}; + } + elsif (defined $colors{'virt-term'}){ + $color_scheme = $colors{'virt-term'}; + } + } + } + # force 0 for | or > output, all others prints to irc or screen + if (!$b_irc && !$force{'colors'} && ! -t STDOUT){ + $color_scheme = 0; + } + set_color_scheme($color_scheme); + eval $end if $b_log; +} + +## SelectColors ## +{ +package SelectColors; +my (@data,%configs,%status); +my ($type,$w_fh); +my $safe_color_count = 12; # null/normal + default color group +my $count = 0; + +# args: 0: type +sub new { + my $class = shift; + ($type) = @_; + my $self = {}; + return bless $self, $class; +} + +sub select_schema { + eval $start if $b_log; + assign_selectors(); + main::set_color_scheme(0); + set_status(); + start_selector(); + create_color_selections(); + if (!$b_irc){ + Configs::check_file(); + get_selection(); + } + else { + print_irc_message(); + } + eval $end if $b_log; +} + +sub set_status { + $status{'console'} = (defined $colors{'console'}) ? "Set: $colors{'console'}" : 'Not Set'; + $status{'virt-term'} = (defined $colors{'virt-term'}) ? "Set: $colors{'virt-term'}" : 'Not Set'; + $status{'irc-console'} = (defined $colors{'irc-console'}) ? "Set: $colors{'irc-console'}" : 'Not Set'; + $status{'irc-gui'} = (defined $colors{'irc-gui'}) ? "Set: $colors{'irc-gui'}" : 'Not Set'; + $status{'irc-virt-term'} = (defined $colors{'irc-virt-term'}) ? "Set: $colors{'irc-virt-term'}" : 'Not Set'; + $status{'global'} = (defined $colors{'global'}) ? "Set: $colors{'global'}" : 'Not Set'; +} + +sub assign_selectors { + if ($type == 94){ + $configs{'variable'} = 'CONSOLE_COLOR_SCHEME'; + $configs{'selection'} = 'console'; + } + elsif ($type == 95){ + $configs{'variable'} = 'VIRT_TERM_COLOR_SCHEME'; + $configs{'selection'} = 'virt-term'; + } + elsif ($type == 96){ + $configs{'variable'} = 'IRC_COLOR_SCHEME'; + $configs{'selection'} = 'irc-gui'; + } + elsif ($type == 97){ + $configs{'variable'} = 'IRC_X_TERM_COLOR_SCHEME'; + $configs{'selection'} = 'irc-virt-term'; + } + elsif ($type == 98){ + $configs{'variable'} = 'IRC_CONS_COLOR_SCHEME'; + $configs{'selection'} = 'irc-console'; + } + elsif ($type == 99){ + $configs{'variable'} = 'GLOBAL_COLOR_SCHEME'; + $configs{'selection'} = 'global'; + } +} + +sub start_selector { + my $whoami = getpwuid($<) || "unknown???"; + if (!$b_irc){ + @data = ( + [ 0, '', '', "Welcome to $self_name! Please select the default + $configs{'selection'} color scheme."], + ); + } + push(@data, + [ 0, '', '', "Because there is no way to know your $configs{'selection'} + foreground/background colors, you can set your color preferences from + color scheme option list below:"], + [ 0, '', '', "0 is no colors; 1 is neutral."], + [ 0, '', '', "After these, there are 4 sets:"], + [ 0, '', '', "1-dark^or^light^backgrounds; 2-light^backgrounds; + 3-dark^backgrounds; 4-miscellaneous"], + [ 0, '', '', ""], + ); + if (!$b_irc){ + push(@data, + [ 0, '', '', "Please note that this will set the $configs{'selection'} + preferences only for user: $whoami"], + ); + } + push(@data, + [ 0, '', '', "$line1"], + ); + main::print_basic(\@data); + @data = (); +} + +sub create_color_selections { + my $spacer = '^^'; # printer removes double spaces, but replaces ^ with ' ' + $count = (main::get_color_scheme('count') - 1); + foreach my $i (0 .. $count){ + if ($i > 9){ + $spacer = '^'; + } + if ($configs{'selection'} =~ /^(global|irc-gui|irc-console|irc-virt-term)$/ && $i > $safe_color_count){ + last; + } + main::set_color_scheme($i); + push(@data, + [0, '', '', "$i)$spacer$colors{'c1'}Card:$colors{'c2'}^nVidia^GT218 + $colors{'c1'}Display^Server$colors{'c2'}^x11^(X.Org^1.7.7)$colors{'cn'}"], + ); + } + main::print_basic(\@data); + @data = (); + main::set_color_scheme(0); +} + +sub get_selection { + my $number = $count + 1; + @data = ( + [0, '', '', ($number++) . ")^Remove all color settings. Restore $self_name default."], + [0, '', '', ($number++) . ")^Continue, no changes or config file setting."], + [0, '', '', ($number++) . ")^Exit, use another terminal, or set manually."], + [0, '', '', "$line1"], + [0, '', '', "Simply type the number for the color scheme that looks best to your + eyes for your $configs{'selection'} settings and hit . NOTE: You can bring this + option list up by starting $self_name with option: -c plus one of these numbers:"], + [0, '', '', "94^-^console,^not^in^desktop^-^$status{'console'}"], + [0, '', '', "95^-^terminal,^desktop^-^$status{'virt-term'}"], + [0, '', '', "96^-^irc,^gui,^desktop^-^$status{'irc-gui'}"], + [0, '', '', "97^-^irc,^desktop,^in^terminal^-^$status{'irc-virt-term'}"], + [0, '', '', "98^-^irc,^not^in^desktop^-^$status{'irc-console'}"], + [0, '', '', "99^-^global^-^$status{'global'}"], + [0, '', '', ""], + [0, '', '', "Your selection(s) will be stored here: $user_config_file"], + [0, '', '', "Global overrides all individual color schemes. Individual + schemes remove the global setting."], + [0, '', '', "$line1"], + ); + main::print_basic(\@data); + @data = (); + chomp(my $response = ); + if (!main::is_int($response) || $response > ($count + 3)){ + @data = ( + [0, '', '', "Error - Invalid Selection. You entered this: $response. Hit to continue."], + [0, '', '', "$line1"], + ); + main::print_basic(\@data); + my $response = ; + start_selector(); + create_color_selections(); + get_selection(); + } + else { + process_selection($response); + } + if ($b_pledge){ + @pledges = grep {$_ ne 'getpw'} @pledges; + OpenBSD::Pledge::pledge(@pledges); + } +} + +sub process_selection { + my $response = shift; + if ($response == ($count + 3)){ + @data = ( + [0, '', '', "Ok, exiting $self_name now. You can set the colors later."], + ); + main::print_basic(\@data); + exit 0; + } + elsif ($response == ($count + 2)){ + @data = ( + [0, '', '', "Ok, continuing $self_name unchanged."], + [0, '', '', "$line1"], + ); + main::print_basic(\@data); + if (defined $colors{'console'} && !$b_display){ + main::set_color_scheme($colors{'console'}); + } + if (defined $colors{'virt-term'}){ + main::set_color_scheme($colors{'virt-term'}); + } + else { + main::set_color_scheme($colors{'default'}); + } + } + elsif ($response == ($count + 1)){ + @data = ( + [0, '', '', "Removing all color settings from config file now..."], + [0, '', '', "$line1"], + ); + main::print_basic(\@data); + delete_all_config_colors(); + main::set_color_scheme($colors{'default'}); + } + else { + main::set_color_scheme($response); + @data = ( + [0, '', '', "Updating config file for $configs{'selection'} color scheme now..."], + [0, '', '', "$line1"], + ); + main::print_basic(\@data); + if ($configs{'selection'} eq 'global'){ + delete_all_colors(); + } + else { + delete_global_color(); + } + set_config_color_scheme($response); + } +} + +sub delete_all_colors { + my @file_lines = main::reader($user_config_file); + open($w_fh, '>', $user_config_file) or main::error_handler('open', $user_config_file, $!); + foreach (@file_lines){ + if ($_ !~ /^(CONSOLE_COLOR_SCHEME|GLOBAL_COLOR_SCHEME|IRC_COLOR_SCHEME|IRC_CONS_COLOR_SCHEME|IRC_X_TERM_COLOR_SCHEME|VIRT_TERM_COLOR_SCHEME)/){ + print {$w_fh} "$_"; + } + } + close $w_fh; +} + +sub delete_global_color { + my @file_lines = main::reader($user_config_file); + open($w_fh, '>', $user_config_file) or main::error_handler('open', $user_config_file, $!); + foreach (@file_lines){ + if ($_ !~ /^GLOBAL_COLOR_SCHEME/){ + print {$w_fh} "$_"; + } + } + close $w_fh; +} + +sub set_config_color_scheme { + my $value = shift; + my @file_lines = main::reader($user_config_file); + my $b_found = 0; + open($w_fh, '>', $user_config_file) or main::error_handler('open', $user_config_file, $!); + foreach (@file_lines){ + if ($_ =~ /^$configs{'variable'}/){ + $_ = "$configs{'variable'}=$value"; + $b_found = 1; + } + print $w_fh "$_\n"; + } + if (!$b_found){ + print $w_fh "$configs{'variable'}=$value\n"; + } + close $w_fh; +} + +sub print_irc_message { + @data = ( + [ 0, '', '', "$line1"], + [ 0, '', '', "After finding the scheme number you like, simply run this again + in a terminal to set the configuration data file for your irc client. You can + set color schemes for the following: start inxi with -c plus:"], + [ 0, '', '', "94 (console,^not^in^desktop^-^$status{'console'})"], + [ 0, '', '', "95 (terminal, desktop^-^$status{'virt-term'})"], + [ 0, '', '', "96 (irc,^gui,^desktop^-^$status{'irc-gui'})"], + [ 0, '', '', "97 (irc,^desktop,^in terminal^-^$status{'irc-virt-term'})"], + [ 0, '', '', "98 (irc,^not^in^desktop^-^$status{'irc-console'})"], + [ 0, '', '', "99 (global^-^$status{'global'})"] + ); + main::print_basic(\@data); + exit 0; +} +} + +#### ------------------------------------------------------------------- +#### CONFIGS +#### ------------------------------------------------------------------- + +## Configs +# public: set() check_file() +{ +package Configs; + +sub set { + my ($b_show) = @_; + my ($b_files,$key, $val,@config_files); + # removed legacy kde @$configs test which never worked + @config_files = ( + qq(/etc/$self_name.conf), + qq(/etc/$self_name.d/$self_name.conf), # this was wrong path, but check in case + qq(/etc/$self_name.conf.d/$self_name.conf), + qq(/usr/etc/$self_name.conf), + qq(/usr/etc/$self_name.conf.d/$self_name.conf), + qq(/usr/local/etc/$self_name.conf), + qq(/usr/local/etc/$self_name.conf.d/$self_name.conf), + qq($user_config_dir/$self_name.conf) + ); + # Config files should be passed in an array as a param to this function. + # Default intended use: global @CONFIGS; + foreach (@config_files){ + next unless -e $_ && open(my $fh, '<', "$_"); + my $b_configs; + $b_files = 1; + print "${line1}Configuration file: $_\n" if $b_show; + while (<$fh>){ + chomp; + s/#.*//; + s/^\s+//; + s/\s+$//; + s/'|"//g; + next unless length; + ($key, $val) = split(/\s*=\s*/, $_, 2); + next unless length($val); + $val =~ s/true/1/i; # switch to 1/0 perl boolean + $val =~ s/false/0/i; # switch to 1/0 perl boolean + if (!$b_show){ + process_item($key,$val); + } + else { + print $line3 if !$b_configs; + print "$key=$val\n"; + $b_configs = 1; + } + # print "f: $file key: $key val: $val\n"; + } + close $fh; + if ($b_show && !$b_configs){ + print "No configuration items found in file.\n"; + } + } + return $b_files if $b_show; +} + +sub show { + print "Showing current active/set configurations, by file. Last overrides previous.\n"; + my $b_files = set(1); + print $line1; + if ($b_files){ + print "All done! Everything look good? If not, fix it.\n"; + } + else { + print "No configuration files found. Is that what you expected?\n"; + } + exit 0; +} + +# note: someone managed to make a config file with corrupted values, so check +# int explicitly, don't assume it was done correctly. +# args: 0: key; 1: value +sub process_item { + my ($key,$val) = @_; + + ## UTILITIES ## + if ($key eq 'ALLOW_UPDATE' || $key eq 'B_ALLOW_UPDATE'){ + $use{'update'} = $val if main::is_int($val)} + elsif ($key eq 'ALLOW_WEATHER' || $key eq 'B_ALLOW_WEATHER'){ + $use{'weather'} = $val if main::is_int($val)} + elsif ($key eq 'CPU_SLEEP'){ + $cpu_sleep = $val if main::is_numeric($val)} + elsif ($key eq 'DL_TIMEOUT'){ + $dl_timeout = $val if main::is_int($val)} + elsif ($key eq 'DOWNLOADER'){ + if ($val =~ /^(curl|fetch|ftp|perl|wget)$/){ + # this dumps all the other data and resets %dl for only the + # desired downloader. + $val = main::set_perl_downloader($val); + %dl = ('dl' => $val, $val => 1); + }} + elsif ($key eq 'FAKE_DATA_DIR'){ + $fake_data_dir = $val} + elsif ($key eq 'FILTER_STRING'){ + $filter_string = $val} + elsif ($key eq 'LANGUAGE'){ + $language = $val if $val =~ /^(en)$/} + elsif ($key eq 'LIMIT'){ + $limit = $val if main::is_int($val)} + elsif ($key eq 'OUTPUT_TYPE'){ + $output_type = $val if $val =~ /^(json|screen|xml)$/} + elsif ($key eq 'NO_DIG'){ + $force{'no-dig'} = $val if main::is_int($val)} + elsif ($key eq 'NO_DOAS'){ + $force{'no-doas'} = $val if main::is_int($val)} + elsif ($key eq 'NO_HTML_WAN'){ + $force{'no-html-wan'} = $val if main::is_int($val)} + elsif ($key eq 'NO_SUDO'){ + $force{'no-sudo'} = $val if main::is_int($val)} + elsif ($key eq 'PARTITION_SORT'){ + if ($val =~ /^(dev-base|fs|id|label|percent-used|size|uuid|used)$/){ + $show{'partition-sort'} = $val; + }} + elsif ($key eq 'PS_COUNT'){ + $ps_count = $val if main::is_int($val) } + elsif ($key eq 'SENSORS_CPU_NO'){ + $sensors_cpu_nu = $val if main::is_int($val)} + elsif ($key eq 'SENSORS_EXCLUDE'){ + @sensors_exclude = split(/\s*,\s*/, $val) if $val} + elsif ($key eq 'SENSORS_USE'){ + @sensors_use = split(/\s*,\s*/, $val) if $val} + elsif ($key eq 'SHOW_HOST' || $key eq 'B_SHOW_HOST'){ + if (main::is_int($val)){ + $show{'host'} = $val; + $show{'no-host'} = 1 if !$show{'host'}; + } + } + elsif ($key eq 'USB_SYS'){ + $force{'usb-sys'} = $val if main::is_int($val)} + elsif ($key eq 'WAN_IP_URL'){ + if ($val =~ /^(ht|f)tp[s]?:\//i){ + $wan_url = $val; + $force{'no-dig'} = 1; + } + } + elsif ($key eq 'WEATHER_SOURCE'){ + $weather_source = $val if main::is_int($val)} + elsif ($key eq 'WEATHER_UNIT'){ + $val = lc($val) if $val; + if ($val && $val =~ /^(c|f|cf|fc|i|m|im|mi)$/){ + my %units = ('c'=>'m','f'=>'i','cf'=>'mi','fc'=>'im'); + $val = $units{$val} if defined $units{$val}; + $weather_unit = $val; + } + } + + ## COLORS/SEP ## + elsif ($key eq 'CONSOLE_COLOR_SCHEME'){ + $colors{'console'} = $val if main::is_int($val)} + elsif ($key eq 'GLOBAL_COLOR_SCHEME'){ + $colors{'global'} = $val if main::is_int($val)} + elsif ($key eq 'IRC_COLOR_SCHEME'){ + $colors{'irc-gui'} = $val if main::is_int($val)} + elsif ($key eq 'IRC_CONS_COLOR_SCHEME'){ + $colors{'irc-console'} = $val if main::is_int($val)} + elsif ($key eq 'IRC_X_TERM_COLOR_SCHEME'){ + $colors{'irc-virt-term'} = $val if main::is_int($val)} + elsif ($key eq 'VIRT_TERM_COLOR_SCHEME'){ + $colors{'virt-term'} = $val if main::is_int($val)} + # note: not using the old short SEP1/SEP2 + elsif ($key eq 'SEP1_IRC'){ + $sep{'s1-irc'} = $val} + elsif ($key eq 'SEP1_CONSOLE'){ + $sep{'s1-console'} = $val} + elsif ($key eq 'SEP2_IRC'){ + $sep{'s2-irc'} = $val} + elsif ($key eq 'SEP2_CONSOLE'){ + $sep{'s2-console'} = $val} + + ## SIZES ## + elsif ($key eq 'COLS_MAX_CONSOLE'){ + $size{'console'} = $val if main::is_int($val)} + elsif ($key eq 'COLS_MAX_IRC'){ + $size{'irc'} = $val if main::is_int($val)} + elsif ($key eq 'COLS_MAX_NO_DISPLAY'){ + $size{'no-display'} = $val if main::is_int($val)} + elsif ($key eq 'INDENT'){ + $size{'indent'} = $val if main::is_int($val)} + elsif ($key eq 'INDENTS'){ + $filter_string = $val if main::is_int($val)} + elsif ($key eq 'LINES_MAX'){ + if ($val =~ /^-?\d+$/ && $val >= -1){ + if ($val == 0){ + $size{'max-lines'} = $size{'term-lines'};} + elsif ($val == -1){ + $use{'output-block'} = 1;} + else { + $size{'max-lines'} = $val;} + }} + elsif ($key eq 'MAX_WRAP' || $key eq 'WRAP_MAX' || $key eq 'INDENT_MIN'){ + $size{'max-wrap'} = $val if main::is_int($val)} + # print "mc: key: $key val: $val\n"; + # print Dumper (keys %size) . "\n"; +} + +sub check_file { + $user_config_file = "$user_config_dir/$self_name.conf"; + if (! -f $user_config_file){ + open(my $fh, '>', $user_config_file) or + main::error_handler('create', $user_config_file, $!); + } +} +} + +#### ------------------------------------------------------------------- +#### DEBUGGERS +#### ------------------------------------------------------------------- + +# called in the initial -@ 10 program args setting so we can get logging +# as soon as possible # will have max 3 files, inxi.log, inxi.1.log, +# inxi.2.log +sub begin_logging { + return 1 if $fh_l; # if we want to start logging for testing before options + my $log_file_2 = "$user_data_dir/$self_name.1.log"; + my $log_file_3 = "$user_data_dir/$self_name.2.log"; + my $data = ''; + $end = 'main::log_data("fe", (caller(1))[3], "");'; + $start = 'main::log_data("fs", (caller(1))[3], \@_);'; + #$t3 = tv_interval ($t0, [gettimeofday]); + $t3 = eval 'Time::HiRes::tv_interval (\@t0, [Time::HiRes::gettimeofday()]);' if $b_hires; + # print Dumper $@; + my $now = strftime "%Y-%m-%d %H:%M:%S", localtime; + return if $debugger{'timers'}; + # do the rotation if logfile exists + if (-f $log_file){ + # copy if present second to third + if (-f $log_file_2){ + rename $log_file_2, $log_file_3 or error_handler('rename', "$log_file_2 -> $log_file_3", "$!"); + } + # then copy initial to second + rename $log_file, $log_file_2 or error_handler('rename', "$log_file -> $log_file_2", "$!"); + } + # now create the logfile + # print "Opening log file for reading: $log_file\n"; + open($fh_l, '>', $log_file) or error_handler(4, $log_file, "$!"); + # and echo the start data + $data = $line2; + $data .= "START $self_name LOGGING:\n"; + $data .= "NOTE: HiRes timer not available.\n" if !$b_hires; + $data .= "$now\n"; + $data .= "Elapsed since start: $t3\n"; + $data .= "n: $self_name v: $self_version p: $self_patch d: $self_date\n"; + $data .= '@paths:' . joiner(\@paths, '::', 'unset') . "\n"; + $data .= $line2; + + print $fh_l $data; +} + +# NOTE: no logging available until get_parameters is run, since that's what +# sets logging # in order to trigger earlier logging manually set $b_log +# to true in top variables. +# args: 0: type [fs|fe|cat|dump|raw]; 1: function name OR data to log; +# [2: function args OR hash/array ref] +sub log_data { + return if !$b_log; + my ($one, $two, $three) = @_; + my ($args,$data,$timer) = ('','',''); + my $spacer = ' '; + # print "1: $one 2: $two 3: $three\n"; + if ($one eq 'fs'){ + if (ref $three eq 'ARRAY'){ + # print Data::Dumper::Dumper $three; + $args = "\n${spacer}Args: " . joiner($three, '; ', 'unset'); + } + else { + $args = "\n${spacer}Args: None"; + } + # $t1 = [gettimeofday]; + #$t3 = tv_interval ($t0, [gettimeofday]); + $t3 = eval 'Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()])' if $b_hires; + # print Dumper $@; + $data = "Start: Function: $two$args\n${spacer}Elapsed: $t3\n"; + $spacer=''; + $timer = $data if $debugger{'timers'}; + } + elsif ($one eq 'fe'){ + # print 'timer:', Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()]),"\n"; + #$t3 = tv_interval ($t0, [gettimeofday]); + eval '$t3 = Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()])' if $b_hires; + # print Dumper $t3; + $data = "${spacer}Elapsed: $t3\nEnd: Function: $two\n"; + $spacer=''; + $timer = $data if $debugger{'timers'}; + } + elsif ($one eq 'cat'){ + if ($b_log_full){ + foreach my $file ($two){ + my $contents = do { local(@ARGV, $/) = $file; <> }; # or: qx(cat $file) + $data = "$data${line3}Full file data: $file\n\n$contents\n$line3\n"; + } + $spacer=''; + } + } + elsif ($one eq 'cmd'){ + $data = "Command: $two\n"; + $data .= qx($two); + } + elsif ($one eq 'data'){ + $data = "$two\n"; + } + elsif ($one eq 'dump'){ + $data = "$two:\n"; + if (ref $three eq 'HASH'){ + $data .= Data::Dumper::Dumper $three; + } + elsif (ref $three eq 'ARRAY'){ + # print Data::Dumper::Dumper $three; + $data .= Data::Dumper::Dumper $three; + } + else { + $data .= Data::Dumper::Dumper $three; + } + $data .= "\n"; + # print $data; + } + elsif ($one eq 'raw'){ + if ($b_log_full){ + $data = "\n${line3}Raw System Data:\n\n$two\n$line3"; + $spacer=''; + } + } + else { + $data = "$two\n"; + } + if ($debugger{'timers'}){ + print $timer if $timer; + } + # print "d: $data"; + elsif ($data){ + print $fh_l "$spacer$data"; + } +} + +sub set_debugger { + user_debug_test_1() if $debugger{'test-1'}; + if ($debugger{'level'} >= 20){ + error_handler('not-in-irc', 'debug data generator') if $b_irc; + my $option = ($debugger{'level'} > 22) ? 'main-full' : 'main'; + $debugger{'gz'} = 1 if ($debugger{'level'} == 22 || $debugger{'level'} == 24); + my $ob_sys = SystemDebugger->new($option); + $ob_sys->run_debugger(); + $ob_sys->upload_file($ftp_alt) if $debugger{'level'} > 20; + exit 0; + } + elsif ($debugger{'level'} >= 10 && $debugger{'level'} <= 12){ + $b_log = 1; + if ($debugger{'level'} == 11){ + $b_log_full = 1; + } + elsif ($debugger{'level'} == 12){ + $b_log_colors = 1; + } + begin_logging(); + } + elsif ($debugger{'level'} <= 3){ + if ($debugger{'level'} == 3){ + $b_log = 1; + $debugger{'timers'} = 1; + begin_logging(); + } + else { + $end = ''; + $start = ''; + } + } +} + +## SystemDebugger ## +{ +package SystemDebugger; +my $option = 'main'; +my ($data_dir,$debug_dir,$debug_gz,$parse_src,$upload) = ('','','','',''); +my @content; +my $b_debug = 0; +my $b_delete_dir = 1; + +# args: 0: type; 1: upload +sub new { + my $class = shift; + ($option) = @_; + my $self = {}; + # print "$f\n"; + # print "$option\n"; + return bless $self, $class; +} + +sub run_debugger { + print "Starting $self_name debugging data collector...\n"; + check_required_items(); + create_debug_directory(); + print "Note: for dmidecode, smartctl, lvm data you must be root.\n" if !$b_root; + print $line3; + if (!$b_debug){ + audio_data(); + bluetooth_data(); + disk_data(); + display_data(); + network_data(); + perl_modules(); + system_data(); + } + system_files(); + print $line3; + if (!$b_debug){ + # note: android has unreadable /sys, but -x and -r tests pass + # main::globber('/sys/*') && + if ($debugger{'sys'} && main::count_dir_files('/sys')){ + build_tree('sys'); + # kernel crash, not sure what creates it, for ppc, as root + if ($debugger{'sys'} && ($debugger{'sys-force'} || !$b_root || !$risc{'ppc'})){ + sys_traverse_data(); + } + } + else { + print "Skipping /sys data collection.\n"; + } + print $line3; + # note: proc has some files that are apparently kernel processes, I've tried + # filtering them out but more keep appearing, so only run proc debugger if not root + if (!$debugger{'no-proc'} && (!$b_root || $debugger{'proc'}) && -d '/proc' && main::count_dir_files('/proc')){ + build_tree('proc'); + proc_traverse_data(); + } + else { + print "Skipping /proc data collection.\n"; + } + print $line3; + } + run_self(); + print $line3; + compress_dir(); +} + +sub check_required_items { + print "Loading required debugger Perl File:: modules... \n"; + # Fedora/Redhat doesn't include File::Find File::Copy in + # core modules. why? Or rather, they deliberately removed them. + if (main::check_perl_module('File::Find')){ + File::Find->import; + } + else { + main::error_handler('required-module', 'File', 'File::Find'); + } + if (main::check_perl_module('File::Copy')){ + File::Copy->import; + } + else { + main::error_handler('required-module', 'File', 'File::Copy'); + } + if (main::check_perl_module('File::Spec::Functions')){ + File::Spec::Functions->import; + } + else { + main::error_handler('required-module', 'File', 'File::Spec::Functions'); + } + if ($debugger{'level'} > 20){ + if (main::check_perl_module('Net::FTP')){ + Net::FTP->import; + } + else { + main::error_handler('required-module', 'Net', 'Net::FTP'); + } + } + print "Checking basic core system programs exist... \n"; + if ($debugger{'level'} > 19){ + # astoundingly, rhel 9 and variants are shipping without tar in minimal install + if (!main::check_program('tar')){ + main::error_handler('required-program', 'tar', 'debugger'); + } + } +} + +sub create_debug_directory { + my $host = main::get_hostname(); + $host =~ s/ /-/g; + $host = 'no-host' if !$host || $host eq 'N/A'; + my ($alt_string,$root_string) = ('',''); + # note: Time::Piece was introduced in perl 5.9.5 + my ($sec,$min,$hour,$mday,$mon,$year) = localtime; + $year = $year+1900; + $mon += 1; + if (length($sec) == 1){$sec = "0$sec";} + if (length($min) == 1){$min = "0$min";} + if (length($hour) == 1){$hour = "0$hour";} + if (length($mon) == 1){$mon = "0$mon";} + if (length($mday) == 1){$mday = "0$mday";} + my $today = "$year-$mon-${mday}_$hour$min$sec"; + # my $date = strftime "-%Y-%m-%d_", localtime; + if ($b_root){ + $root_string = '-root'; + } + my $id = ($debugger{'id'}) ? '-' . $debugger{'id'}: ''; + $alt_string = '-' . uc($risc{'id'}) if %risc; + $alt_string .= "-BSD-$bsd_type" if $bsd_type; + $alt_string .= '-ANDROID' if $b_android; + $alt_string .= '-CYGWIN' if $windows{'cygwin'}; # could be windows arm? + $alt_string .= '-WSL' if $windows{'wsl'}; # could be windows arm? + $debug_dir = "$self_name$alt_string-$host$id-$today$root_string-$self_version-$self_patch"; + $debug_gz = "$debug_dir.tar.gz"; + $data_dir = "$user_data_dir/$debug_dir"; + if (-d $data_dir){ + unlink $data_dir or main::error_handler('remove', "$data_dir", "$!"); + } + mkdir $data_dir or main::error_handler('mkdir', "$data_dir", "$!"); + if (-e "$user_data_dir/$debug_gz"){ + #rmdir "$user_data_dir$debug_gz" or main::error_handler('remove', "$user_data_dir/$debug_gz", "$!"); + print "Failed removing leftover directory:\n$user_data_dir$debug_gz error: $?" if system('rm','-rf',"$user_data_dir$debug_gz"); + } + print "Debugger data going into:\n$data_dir\n"; +} + +sub compress_dir { + print "Creating tar.gz compressed file of this material...\n"; + print "File: $debug_gz\n"; + system("cd $user_data_dir; tar -czf $debug_gz $debug_dir"); + print "Removing $data_dir...\n"; + #rmdir $data_dir or print "failed removing: $data_dir error: $!\n"; + return 1 if !$b_delete_dir; + if (system('rm','-rf',$data_dir)){ + print "Failed removing: $data_dir\nError: $?\n"; + } + else { + print "Directory removed.\n"; + } +} + +# NOTE: incomplete, don't know how to ever find out +# what sound server is actually running, and is in control +sub audio_data { + my (%data,@files,@files2); + print "Collecting audio data...\n"; + my @cmds = ( + ['aplay', '--version'], # alsa + ['aplay', '-l'], # alsa devices + ['aplay', '-L'], # alsa list of features, can detect active sound server + ['artsd', '-v'], # aRts + ['esd', '-v'], # EsounD, to stderr + ['nasd', '-V'], # NAS + ['jackd', '--version'], # JACK + ['pactl', '--version'], # pulseaudio + ['pactl', 'info'], # pulseaudio, check if running as server: Server Name: + ['pactl', 'list'], # pulseaudio + ['pipewire', '--version'], # pipewire + ['pipewire-alsa', '--version'], # pipewire-alsa - just config files + ['pipewire-pulse', '--version'], # pipewire-pulse + ['pulseaudio', '--version'], # PulseAudio + ['pw-jack', '--version'], # pipewire-jack + ['pw-cli', 'ls'], # pipewire, check if running as server + ['pw-cli', 'info all'], + ); + run_commands(\@cmds,'audio'); + @files = main::globber('/proc/asound/card*/codec*'); + if (@files){ + my $asound = qx(head -n 1 /proc/asound/card*/codec* 2>&1); + $data{'proc-asound-codecs'} = $asound; + } + else { + $data{'proc-asound-codecs'} = undef; + } + write_data(\%data,'audio'); + @files = ( + '/proc/asound/cards', + '/proc/asound/version', + ); + @files2 = main::globber('/proc/asound/*/usbid'); + push(@files,@files2) if @files2; + copy_files(\@files,'audio'); +} + +sub bluetooth_data { + print "Collecting bluetooth data...\n"; + # no warnings 'uninitialized'; + my @cmds = ( + ['btmgmt','info'], + ['hciconfig','-a'], # no version + #['hcidump',''], # hangs sometimes + ['hcitool','dev'], + ['rfkill','--output-all'], + ); + # these hang if bluetoothd not enabled + if (@ps_cmd && (grep {m|/bluetoothd|} @ps_cmd)){ + push(@cmds, + ['bt-adapter','--list'], # no version + ['bt-adapter','--info'], + ['bluetoothctl','--version'], + ['bluetoothctl','--list'], + ['bluetoothctl','--show'] + ); + } + run_commands(\@cmds,'bluetooth'); +} + +## NOTE: >/dev/null 2>&1 is sh, and &>/dev/null is bash, fix this +# ls -w 1 /sysrs > tester 2>&1 +sub disk_data { + my (%data,@files,@files2); + print "Collecting dev, label, disk, uuid data, df...\n"; + @files = ( + '/etc/fstab', + '/etc/mtab', + '/proc/devices', + '/proc/mdstat', + '/proc/mounts', + '/proc/partitions', + '/proc/scsi/scsi', + '/proc/sys/dev/cdrom/info', + ); + # very old systems + if (-d '/proc/ide/'){ + my @ides = main::globber('/proc/ide/*/*'); + push(@files, @ides) if @ides; + } + else { + push(@files, '/proc-ide-directory'); + } + copy_files(\@files, 'disk'); + my @cmds = ( + ['blockdev', '--version'], + ['blockdev', '--report'], + ['btrfs', 'fi show'], # no version + ['btrfs', 'filesystem show'], + ['btrfs', 'filesystem show --mounted'], + # ['btrfs', 'filesystem show --all-devices'], + ['df', '-h -T'], # no need for version, and bsd doesn't have its + ['df', '-h'], + ['df', '-k'], + ['df', '-k -P'], + ['df', '-k -T'], + ['df', '-k -T -P'], + ['df', '-k -T -P -a'], + ['df', '-P'], + ['dmsetup', 'ls --tree'], + ['findmnt', ''], + ['findmnt', '--df --no-truncate'], + ['findmnt', '--list --no-truncate'], + ['gpart', 'list'], # no version + ['gpart', 'show'], + ['gpart', 'status'], + ['ls', '-l /dev'],# core util, don't need version + # block is for mmcblk / arm devices + ['ls', '-l /dev/block'], + ['ls', '-l /dev/block/bootdevice'], + ['ls', '-l /dev/block/bootdevice/by-name'], + ['ls', '-l /dev/disk'], + ['ls', '-l /dev/disk/by-id'], + ['ls', '-l /dev/disk/by-label'], + ['ls', '-l /dev/disk/by-partlabel'], + ['ls', '-l /dev/disk/by-partuuid'], + ['ls', '-l /dev/disk/by-path'], + ['ls', '-l /dev/disk/by-uuid'], + # http://comments.gmane.org/gmane.linux.file-systems.zfs.user/2032 + ['ls', '-l /dev/disk/by-wwn'], + ['ls', '-l /dev/mapper'], + ['lsblk', '--version'], # important since lsblk has been changing output + ['lsblk', '-fs'], + ['lsblk', '-fsr'], + ['lsblk', '-fsP'], + ['lsblk', '-a'], + ['lsblk', '-aP'], + ['lsblk', '-ar'], + ['lsblk', '-p'], + ['lsblk', '-pr'], + ['lsblk', '-pP'], + ['lsblk', '-r'], + ['lsblk', '-r --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,MOUNTPOINT,PHY-SEC,LOG-SEC,PARTFLAGS'], + ['lsblk', '-rb --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,MOUNTPOINT,PHY-SEC,LOG-SEC,PARTFLAGS'], + ['lsblk', '-rb --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,SERIAL,MOUNTPOINT,PHY-SEC,LOG-SEC,PARTFLAGS,MAJ:MIN,PKNAME'], + ['lsblk', '-Pb --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE'], + ['lsblk', '-Pb --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,SERIAL,MOUNTPOINT,PHY-SEC,LOG-SEC,PARTFLAGS'], + # this should always be the live command used internally: + ['lsblk', '-bP --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,SERIAL,MOUNTPOINT,PHY-SEC,LOG-SEC,PARTFLAGS,MAJ:MIN,PKNAME'], + ['lvdisplay', '--version'], + ['lvdisplay', '-c'], + ['lvdisplay', '-cv'], + ['lvdisplay', '-cv --segments'], + ['lvdisplay', '-m --segments'], + ['lvdisplay', '-ma --segments'], + ['lvs', '--version'], + ['lvs', '--separator :'], + ['lvs', '--separator : --segments'], + ['lvs', '-o +devices --separator : --segments'], + ['lvs', '-o +devices -v --separator : --segments'], + ['lvs', '-o +devices -av --separator : --segments'], + ['lvs', '-o +devices -aPv --separator : --segments'], + # LSI raid https://hwraid.le-vert.net/wiki/LSIMegaRAIDSAS + ['megacli', '-AdpAllInfo -aAll'], # no version + ['megacli', '-LDInfo -L0 -a0'], + ['megacli', '-PDList -a0'], + ['megaclisas-status', ''], # no version + ['megaraidsas-status', ''], + ['megasasctl', ''], + ['mount', ''], + ['nvme', 'present'], # no version + ['pvdisplay', '--version'], + ['pvdisplay', '-c'], + ['pvdisplay', '-cv'], + ['pvdisplay', '-m'], + ['pvdisplay', '-ma'], + ['pvs', '--version'], + ['pvs', '--separator :'], + ['pvs', '--separator : --segments'], + ['pvs', '-a --separator : --segments'], + ['pvs', '-av --separator : --segments'], + ['pvs', '-aPv --separator : --segments -o +pv_major,pv_minor'], + ['pvs', '-v --separator : --segments'], + ['pvs', '-Pv --separator : --segments'], + ['pvs', '--segments -o pv_name,pv_size,seg_size,vg_name,lv_name,lv_size,seg_pe_ranges'], + ['readlink', '/dev/root'], # coreutils, don't need version + ['swapon', '-s'], # coreutils, don't need version + # 3ware-raid + ['tw-cli', 'info'], + ['vgdisplay', ''], + ['vgdisplay', '-v'], + ['vgdisplay', '-c'], + ['vgdisplay', '-vc'], + ['vgs', '--separator :'], # part of lvm, don't need version + ['vgs', '-av --separator :'], + ['vgs', '-aPv --separator :'], + ['vgs', '-v --separator :'], + ['vgs', '-o +pv_name --separator :'], + ['zfs', 'list'], + ['zpool', 'list'], # don't use version, might not be supported in linux + ['zpool', 'list -v'], + ); + run_commands(\@cmds,'disk'); + @cmds = ( + ['atacontrol', 'list'], + ['camcontrol', 'devlist'], + ['camcontrol', 'devlist -v'], + ['geom', 'part list'], + ['glabel', 'status'], + ['gpart', 'list'], # gpart in linux/bsd but do it here again + ['gpart', 'show'], + ['gpart', 'status'], + ['swapctl', '-l -k'], + ['swapctl', '-l -k'], + ['vmstat', ''], + ['vmstat', '-H'], + ); + run_commands(\@cmds,'disk-bsd'); +} + +sub display_data { + my (%data,@files,@files2); + my $working = ''; + if (!$b_display){ + print "Warning: only some of the data collection can occur if you are not in X\n"; + main::toucher("$data_dir/display-data-warning-user-not-in-x"); + } + if ($b_root){ + print "Warning: only some of the data collection can occur if you are running as Root user\n"; + main::toucher("$data_dir/display-data-warning-root-user"); + } + print "Collecting Xorg log and xorg.conf files...\n"; + if (-d "/etc/X11/xorg.conf.d/"){ + @files = main::globber("/etc/X11/xorg.conf.d/*"); + } + else { + @files = ('/xorg-conf-d'); + } + # keep this updated to handle all possible locations we know about for Xorg.0.log + # not using $system_files{'xorg-log'} for now though it would be best to know what file is used + main::set_xorg_log(); + push(@files, '/var/log/Xorg.0.log'); + push(@files, '/var/lib/gdm/.local/share/xorg/Xorg.0.log'); + push(@files, $ENV{'HOME'} . '/.local/share/xorg/Xorg.0.log'); + push(@files, $system_files{'xorg-log'}) if $system_files{'xorg-log'}; + push(@files, '/etc/X11/XFCconfig-4'); # very old format for xorg.conf + push(@files, '/etc/X11/xorg.conf'); + copy_files(\@files,'display-xorg'); + print "Collecting X, xprop, glxinfo, xrandr, xdpyinfo data, Wayland info...\n"; + %data = ( + 'desktop-session' => $ENV{'DESKTOP_SESSION'}, + 'display' => $ENV{'DISPLAY'}, + 'gdmsession' => $ENV{'GDMSESSION'}, + 'gnome-desktop-session-id' => $ENV{'GNOME_DESKTOP_SESSION_ID'}, + 'kde-full-session' => $ENV{'KDE_FULL_SESSION'}, + 'kde-session-version' => $ENV{'KDE_SESSION_VERSION'}, + 'vdpau-driver' => $ENV{'VDPAU_DRIVER'}, + 'xdg-current-desktop' => $ENV{'XDG_CURRENT_DESKTOP'}, + 'xdg-session-desktop' => $ENV{'XDG_SESSION_DESKTOP'}, + 'xdg-vtnr' => $ENV{'XDG_VTNR'}, + # wayland data collectors: + 'wayland-display' => $ENV{'WAYLAND_DISPLAY'}, + 'xdg-session-type' => $ENV{'XDG_SESSION_TYPE'}, + 'gdk-backend' => $ENV{'GDK_BACKEND'}, + 'qt-qpa-platform' => $ENV{'QT_QPA_PLATFORM'}, + 'clutter-backend' => $ENV{'CLUTTER_BACKEND'}, + 'sdl-videodriver' => $ENV{'SDL_VIDEODRIVER'}, + # program display values + 'size-cols-max' => $size{'max-cols'}, + 'size-indent' => $size{'indent'}, + 'size-lines-max' => $size{'max-lines'}, + 'size-wrap-width' => $size{'max-wrap'}, + ); + write_data(\%data,'display'); + my @cmds = ( + # kde 5/plasma desktop 5, this is maybe an extra package and won't be used + ['about-distro',''], + ['aticonfig','--adapter=all --od-gettemperature'], + ['clinfo',''], + ['clinfo','--list'], + ['clinfo','--raw'], # machine friendly + ['eglinfo',''], + ['eglinfo','-B'], + ['es2_info',''], + ['glxinfo',''], + ['glxinfo','-B'], + ['kded','--version'], + ['kded1','--version'], + ['kded2','--version'], + ['kded3','--version'], + ['kded4','--version'], + ['kded5','--version'], + ['kded6','--version'], + ['kded7','--version'], + ['kdesktop','--version'],# TDE + ['kf-config','--version'], + ['kf4-config','--version'], + ['kf5-config','--version'], + ['kf6-config','--version'], + ['kf7-config','--version'], + ['kwin_wayland','--version'], + ['kwin_x11','--version'], + # ['locate','/Xorg'], # for Xorg.wrap problem + ['loginctl','--no-pager list-sessions'], + ['ls','/sys/class/drm'], + ['nvidia-settings','-q screens'], + ['nvidia-settings','-c :0.0 -q all'], + ['nvidia-smi','-q'], + ['nvidia-smi','-q -x'], + ['plasmashell','--version'], + ['swaymsg','-t get_inputs -p'], + ['swaymsg','-t get_inputs -r'], + ['swaymsg','-t get_outputs -p'], + ['swaymsg','-t get_outputs -r'], + ['swaymsg','-t get_tree'], + ['swaymsg','-t get_workspaces -p'], + ['swaymsg','-t get_workspaces -r'], + ['switcherooctl','list'], + ['twin','--version'], # TDE + ['vainfo',''], + ['vdpauinfo',''], + ['vulkaninfo',''], + ['vulkaninfo','--summary'], + # ['vulkaninfo','--json'], # outputs to file, not sure how to output to stdout + ['wayland-info',''], # wayland-utils + ['weston-info',''], + ['wmctrl','-m'], + ['weston','--version'], + ['wlr-randr',''], + ['xdpyinfo',''], + ['xdriinfo',''], + ['Xfbdev','-version'], + ['Xorg','-version'], + ['xprop','-root'], + ['xrandr',''], + ['xrandr','--prop'], + ['xrandr','--verbose'], + ['Xvesa','-version'], + ['Xvesa','-listmodes'], + ['Xwayland','-version'], + ); + run_commands(\@cmds,'display'); +} + +sub network_data { + print "Collecting networking data...\n"; + # no warnings 'uninitialized'; + my @cmds = ( + ['ifconfig',''], # no version maybe in bsd, --version in linux + ['ip','-Version'], + ['ip','addr'], + ['ip','-s link'], + ); + run_commands(\@cmds,'network'); +} + +sub perl_modules { + print "Collecting Perl module data (this can take a while)...\n"; + my @modules; + my ($dirname,$holder,$mods,$value) = ('','','',''); + my $filename = 'perl-modules.txt'; + my @inc; + foreach (sort @INC){ + # some BSD installs have '.' n @INC path + if (-d $_ && $_ ne '.'){ + $_ =~ s/\/$//; # just in case, trim off trailing slash + $value .= "EXISTS: $_\n"; + push(@inc, $_); + } + else { + $value .= "ABSENT: $_\n"; + } + } + main::writer("$data_dir/perl-inc-data.txt",$value); + File::Find::find({ wanted => sub { + push(@modules, File::Spec->canonpath($_)) if /\.pm\z/ + }, no_chdir => 1 }, @inc); + @modules = sort @modules; + foreach (@modules){ + my $dir = $_; + $dir =~ s/[^\/]+$//; + if (!$holder || $holder ne $dir){ + $holder = $dir; + $value = "DIR: $dir\n"; + $_ =~ s/^$dir//; + $value .= " $_\n"; + } + else { + $value = $_; + $value =~ s/^$dir//; + $value = " $value\n"; + } + $mods .= $value; + } + open(my $fh, '>', "$data_dir/$filename"); + print $fh $mods; + close $fh; +} + +sub system_data { + print "Collecting system data...\n"; + # has to run here because if null, error, list constructor throws fatal error + my $ksh = qx(ksh -c 'printf \%s "\$KSH_VERSION"' 2>/dev/null); + my %data = ( + 'cc' => $ENV{'CC'}, + # @(#)MIRBSD KSH R56 2018/03/09: ksh and mksh + 'ksh-version' => $ksh, # shell, not env, variable + 'manpath' => $ENV{'MANPATH'}, + 'path' => $ENV{'PATH'}, + 'shell' => $ENV{'SHELL'}, + 'xdg-config-home' => $ENV{'XDG_CONFIG_HOME'}, + 'xdg-config-dirs' => $ENV{'XDG_CONFIG_DIRS'}, + 'xdg-data-home' => $ENV{'XDG_DATA_HOME'}, + 'xdg-data-dirs' => $ENV{'XDG_DATA_DIRS'}, + ); + my @files = main::globber('/usr/bin/gcc*'); + if (@files){ + $data{'gcc-versions'} = join("\n", @files); + } + else { + $data{'gcc-versions'} = undef; + } + @files = main::globber('/sys/*'); + if (@files){ + $data{'sys-tree-ls-1-basic'} = join("\n", @files); + } + else { + $data{'sys-tree-ls-1-basic'} = undef; + } + write_data(\%data,'system'); + # bsd tools http://cb.vu/unixtoolbox.xhtml + my @cmds = ( + # general + ['sysctl', '-a'], + ['sysctl', '-b kern.geom.conftxt'], + ['sysctl', '-b kern.geom.confxml'], + ['usbdevs','-v'], + # freebsd + ['ofwdump','-a'], # arm / soc + ['ofwdump','-ar'], # arm / soc + ['pciconf','-l -cv'], + ['pciconf','-vl'], + ['pciconf','-l'], + ['usbconfig','dump_device_desc'], + ['usbconfig','list'], # needs root, sigh... why? + # openbsd + ['ofctl',''], # arm / soc, need to see data sample of this + ['pcidump',''], + ['pcidump','-v'], + # netbsd + ['kldstat',''], + ['pcictl','pci0 list'], + ['pcictl','pci0 list -N'], + ['pcictl','pci0 list -n'], + # sunos + ['prtdiag',''], + ['prtdiag','-v'], + ); + run_commands(\@cmds,'system-bsd'); + # diskinfo -v + # fdisk + @cmds = ( + ['clang','--version'], + # only for prospective ram feature data collection: requires i2c-tools and module eeprom loaded + ['decode-dimms',''], + ['dmidecode','--version'], + ['dmidecode',''], + ['dmesg',''], + ['fruid_print',''], # elbrus + ['gcc','--version'], + ['getconf','-a'], + ['getconf','-l'], # openbsd + ['initctl','list'], + ['ipmi-sensors','-V'], # version + ['ipmi-sensors',''], + ['ipmi-sensors','--output-sensor-thresholds'], + ['ipmitool','-V'],# version + ['ipmitool','sensor'], + ['lscpu',''],# part of util-linux + ['lsmem',''], + ['lsmem','--all'], + ['lspci','--version'], + ['lspci',''], + ['lspci','-k'], + ['lspci','-n'], + ['lspci','-nn'], + ['lspci','-nnk'], + ['lspci','-nnkv'],# returns ports + ['lspci','-nnv'], + ['lspci','-mm'], + ['lspci','-mmk'], + ['lspci','-mmkv'], + ['lspci','-mmv'], + ['lspci','-mmnn'], + ['lspci','-v'], + ['lsusb','--version'], + ['lsusb',''], + ['lsusb','-t'], + ['lsusb','-v'], + ['ps',''], + ['ps','aux'], + ['ps','auxww'], + ['ps','-e'], + ['ps','-p 1'], + ['runlevel',''], + ['rc-status','-a'], + ['rc-status','-l'], + ['rc-status','-r'], + ['sensors','--version'], + ['sensors',''], + ['sensors','-j'], + ['sensors','-u'], + # leaving this commented out to remind that some systems do not + # support strings --version, but will just simply hang at that command + # which you can duplicate by simply typing: strings then hitting enter. + # ['strings','--version'], + ['strings','present'], + ['sysctl','-a'], + ['systemctl','--version'], + ['systemctl','get-default'], + ['systemctl','list-units'], + ['systemctl','list-units --type=target'], + ['systemd-detect-virt',''], + ['tlp-stat',''], # no arg outputs all data + ['tlp-stat','-s'], + ['udevadm','info -e'], + ['udevadm','info -p /devices/virtual/dmi/id'], + ['udevadm','--version'], + ['uname','-a'], + ['upower','-e'], + ['uptime',''], + ['vcgencmd','get_mem arm'], + ['vcgencmd','get_mem gpu'], + ); + run_commands(\@cmds,'system'); + my $glob = '/sys/devices/system/cpu/'; + $glob .= '{cpufreq,cpu*/topology,cpu*/cpufreq,cpu*/cache/index*,smt,'; + $glob .= 'vulnerabilities}/*'; + get_glob('sys','cpu',$glob); + @files = main::globber('/dev/bus/usb/*/*'); + copy_files(\@files, 'system'); +} + +sub system_files { + print "Collecting system files data...\n"; + my (%data,@files,@files2); + @files = RepoItem::get($data_dir); + copy_files(\@files, 'repo'); + # chdir "/etc"; + @files = main::globber('/etc/*[-_]{[rR]elease,[vV]ersion,issue}*'); + push(@files, '/etc/issue',' + /etc/lsb-release', + '/etc/os-release', + '/system/build.prop', # android data file, requires rooted + '/var/log/installer/oem-id'); # ubuntu only for oem installs? + copy_files(\@files,'system-distro'); + @files = main::globber('/etc/upstream[-_]{[rR]elease,[vV]ersion}/*'); + copy_files(\@files,'system-distro'); + @files = main::globber('/etc/calamares/branding/*/branding.desc'); + copy_files(\@files,'system-distro'); + @files = ( + '/etc/systemd/system/default.target', + '/proc/1/comm', + '/proc/bootdata', # elbrus + '/proc/cmdline', + '/proc/cpuinfo', + '/proc/iomem', + '/proc/meminfo', + '/proc/modules', + '/proc/net/arp', + '/proc/version', + ); + @files2=main::globber('/sys/class/power_supply/*/uevent'); + if (@files2){ + push(@files,@files2); + } + else { + push(@files, '/sys-class-power-supply-empty'); + } + copy_files(\@files, 'system'); + @files = ( + '/etc/make.conf', + '/etc/src.conf', + '/var/run/dmesg.boot', + ); + copy_files(\@files,'system-bsd'); + @files = main::globber('/sys/devices/system/cpu/vulnerabilities/*'); + copy_files(\@files,'security'); +} + +## SELF EXECUTE FOR LOG/OUTPUT +sub run_self { + print "Creating $self_name output file now. This can take a few seconds...\n"; + print "Starting $self_name from: $self_path\n"; + my $args = '-FERfJLrploudma --slots --pkg --edid'; + my $a = ($debugger{'arg'}) ? ' ' . $debugger{'arg'} : ''; + my $i = ($option eq 'main-full')? ' -i' : ''; + my $z = ($debugger{'filter'}) ? ' -z' : ''; + my $w = ($debugger{'width'}) ? $debugger{'width'} : 120; + $args = $debugger{'arg-use'} if $debugger{'arg-use'}; + $args = "$args$a$i$z --debug 10 -y $w"; + my $arg_string = $args; + $arg_string =~ s/\s//g; + my $self_file = "$data_dir/$self_name$arg_string.txt"; + my $cmd = "$self_path/$self_name $args > $self_file 2>&1"; + # print "Args: $args\nArg String: $arg_string\n";exit; + system($cmd); + copy($log_file, "$data_dir") or main::error_handler('copy-failed', "$log_file", "$!"); + system("$self_path/$self_name --recommends -y 120 > $data_dir/$self_name-recommends-120.txt 2>&1"); +} + +## UTILITIES COPY/CMD/WRITE +sub copy_files { + my ($files_ref,$type,$alt_dir) = @_; + my ($absent,$error,$good,$name,$unreadable); + my $directory = ($alt_dir) ? $alt_dir : $data_dir; + my $working = ($type ne 'proc') ? "$type-file-": ''; + foreach (@$files_ref){ + $name = $_; + $name =~ s/^\///; + $name =~ s/\//~/g; + # print "$name\n" if $type eq 'proc'; + $name = "$directory/$working$name"; + $good = $name . '.txt'; + $absent = $name . '-absent'; + $error = $name . '-error'; + $unreadable = $name . '-unreadable'; + # proc have already been tested for readable/exists + if ($type eq 'proc' || -e $_){ + print "F:$_\n" if $type eq 'proc' && $debugger{'proc-print'}; + if ($type eq 'proc' || -r $_){ + copy($_,"$good") or main::toucher($error); + } + else { + main::toucher($unreadable); + } + } + else { + main::toucher($absent); + } + } +} + +sub run_commands { + my ($cmds,$type) = @_; + my $holder = ''; + my ($name,$cmd,$args); + foreach my $rows (@$cmds){ + if (my $program = main::check_program($rows->[0])){ + if ($rows->[1] eq 'present'){ + $name = "$data_dir/$type-cmd-$rows->[0]-present"; + main::toucher($name); + } + else { + $args = $rows->[1]; + $args =~ s/\s|--|\/|=/-/g; # for: + $args =~ s/--/-/g;# strip out -- that result from the above + $args =~ s/^-//g; + $args = "-$args" if $args; + $name = "$data_dir/$type-cmd-$rows->[0]$args.txt"; + $cmd = "$program $rows->[1] >$name 2>&1"; + system($cmd); + } + } + else { + if ($holder ne $rows->[0]){ + $name = "$data_dir/$type-cmd-$rows->[0]-absent"; + main::toucher($name); + $holder = $rows->[0]; + } + } + } +} + +sub get_glob { + my ($type,$id,$glob) = @_; + my @files = main::globber($glob); + return if !@files; + my ($item,@result); + foreach (sort @files){ + next if -d $_; + if (-r $_) { + $item = main::reader($_,'strip',0); + } + else { + $item = main::message('root-required'); + } + $item = main::message('undefined') if !defined $item; + push(@result,$_ . '::' . $item); + } + # print Data::Dumper::Dumper \@result; + main::writer("$data_dir/$type-data-$id-glob.txt",\@result); +} + +sub write_data { + my ($data_ref, $type) = @_; + my ($empty,$error,$fh,$good,$name,$undefined,$value); + foreach (keys %$data_ref){ + $value = $data_ref->{$_}; + $name = "$data_dir/$type-data-$_"; + $good = $name . '.txt'; + $empty = $name . '-empty'; + $error = $name . '-error'; + $undefined = $name . '-undefined'; + if (defined $value){ + if ($value || $value eq '0'){ + open($fh, '>', $good) or main::toucher($error); + print $fh "$value"; + } + else { + main::toucher($empty); + } + } + else { + main::toucher($undefined); + } + } +} + +## TOOLS FOR DIRECTORY TREE/LS/TRAVERSE; UPLOADER +sub build_tree { + my ($which) = @_; + if ($which eq 'sys' && main::check_program('tree')){ + print "Constructing /$which tree data...\n"; + my $dirname = '/sys'; + my $cmd; + system("tree -a -L 10 /sys > $data_dir/sys-data-tree-full-10.txt"); + opendir(my $dh, $dirname) or main::error_handler('open-dir',"$dirname", "$!"); + my @files = readdir($dh); + closedir $dh; + foreach (@files){ + next if /^\./; + $cmd = "tree -a -L 10 $dirname/$_ > $data_dir/sys-data-tree-$_-10.txt"; + # print "$cmd\n"; + system($cmd); + } + } + print "Constructing /$which ls data...\n"; + if ($which eq 'sys'){ + directory_ls($which,1); + directory_ls($which,2); + directory_ls($which,3); + directory_ls($which,4); + } + elsif ($which eq 'proc'){ + directory_ls('proc',1); + directory_ls('proc',2,'[a-z]'); + # don't want the /proc/self or /proc/thread-self directories, those are + # too invasive + #directory_ls('proc',3,'[a-z]'); + #directory_ls('proc',4,'[a-z]'); + } +} + +# include is basic regex for ls path syntax, like [a-z] +sub directory_ls { + my ($dir,$depth,$include) = @_; + $include ||= ''; + my ($exclude) = (''); + # we do NOT want to see anything in self or thread-self!! + # $exclude = 'I self -I thread-self' if $dir eq 'proc'; + my $cmd = do { + if ($depth == 1){ "ls -l $exclude /$dir/$include 2>/dev/null" } + elsif ($depth == 2){ "ls -l $exclude /$dir/$include*/ 2>/dev/null" } + elsif ($depth == 3){ "ls -l $exclude /$dir/$include*/*/ 2>/dev/null" } + elsif ($depth == 4){ "ls -l $exclude /$dir/$include*/*/*/ 2>/dev/null" } + elsif ($depth == 5){ "ls -l $exclude /$dir/$include*/*/*/*/ 2>/dev/null" } + elsif ($depth == 6){ "ls -l $exclude /$dir/$include*/*/*/*/*/ 2>/dev/null" } + }; + my @working; + my $output = ''; + my ($type); + my $result = qx($cmd); + open(my $ch, '<', \$result) or main::error_handler('open-data',"$cmd", "$!"); + while (my $line = <$ch>){ + chomp($line); + $line =~ s/^\s+|\s+$//g; + @working = split(/\s+/, $line); + $working[0] ||= ''; + if (scalar @working > 7){ + if ($working[0] =~ /^d/){ + $type = "d - "; + } + elsif ($working[0] =~ /^l/){ + $type = "l - "; + } + elsif ($working[0] =~ /^c/){ + $type = "c - "; + } + else { + $type = "f - "; + } + $working[9] ||= ''; + $working[10] ||= ''; + $output = $output . " $type$working[8] $working[9] $working[10]\n"; + } + elsif ($working[0] !~ /^total/){ + $output = $output . $line . "\n"; + } + } + close $ch; + my $file = "$data_dir/$dir-data-ls-$depth.txt"; + open(my $fh, '>', $file) or main::error_handler('create',"$file", "$!"); + print $fh $output; + close $fh; + # print "$output\n"; +} + +sub proc_traverse_data { + print "Building /proc file list...\n"; + # get rid pointless error:Can't cd to (/sys/kernel/) debug: Permission denied + #no warnings 'File::Find'; + no warnings; + $parse_src = 'proc'; + File::Find::find(\&wanted, "/proc"); + process_proc_traverse(); + @content = (); +} + +sub process_proc_traverse { + my ($data,$fh,$result,$row,$sep); + my $proc_dir = "$data_dir/proc"; + print "Adding /proc files...\n"; + mkdir $proc_dir or main::error_handler('mkdir', "$proc_dir", "$!"); + # @content = sort @content; + copy_files(\@content,'proc',$proc_dir); + # foreach (@content){print "$_\n";} +} + +sub sys_traverse_data { + print "Building /sys file list...\n"; + # get rid pointless error:Can't cd to (/sys/kernel/) debug: Permission denied + #no warnings 'File::Find'; + no warnings; + $parse_src = 'sys'; + File::Find::find(\&wanted, "/sys"); + process_sys_traverse(); + @content = (); +} + +sub process_sys_traverse { + my ($data,$fh,$result,$row,$sep); + my $filename = "sys-data-parse.txt"; + print "Parsing /sys files...\n"; + # no sorts, we want the order it comes in + # @content = sort @content; + foreach (@content){ + $data=''; + $sep=''; + my $b_fh = 1; + print "F:$_\n" if $debugger{'sys-print'}; + open($fh, '<', $_) or $b_fh = 0; + # needed for removing -T test and root + if ($b_fh){ + while ($row = <$fh>){ + chomp($row); + $data .= $sep . '"' . $row . '"'; + $sep=', '; + } + } + else { + $data = ''; + } + $result .= "$_:[$data]\n"; + # print "$_:[$data]\n" + } + # print scalar @content . "\n"; + open($fh, '>', "$data_dir/$filename"); + print $fh $result; + close $fh; + # print $fh "$result"; +} + +# perl compiler complains on start if prune = 1 used only once, so either +# do $File::Find::prune = 1 if !$File::Find::prune; OR use no warnings 'once' +sub wanted { + # note: we want these directories pruned before the -d test so find + # doesn't try to read files inside of the directories + if ($parse_src eq 'proc'){ + if ($File::Find::name =~ m!^/proc/[0-9]+! || + # /proc/registry is from cygwin, we never want to see that + $File::Find::name =~ m!^/proc/(irq|spl|sys|reg)! || + # these choke on sudo/root: kmsg kcore kpage and we don't want keys or kallsyms + $File::Find::name =~ m!^/proc/k! || + $File::Find::name =~ m!^/proc/bus/pci!){ + $File::Find::prune = 1; + return; + } + } + elsif ($parse_src eq 'sys'){ + # note: a new file in 4.11 /sys can hang this, it is /parameter/ then + # a few variables. Since inxi does not need to see that file, we will + # not use it. + if ($File::Find::name =~ m!/(kernel/|trace/|parameters|debug)!){ + $File::Find::prune = 1; + } + } + return if -d; # not directory + return unless -e; # Must exist + return unless -f; # Must be file + return unless -r; # Must be readable + if ($parse_src eq 'sys'){ + # print $File::Find::name . "\n"; + # block maybe: cfgroup\/ + # picdec\/|, wait_for_fb_sleep/wake is an odroid thing caused hang + # wakeup_count also fails for android, but works fine on regular systems + return if $risc{'arm'} && $File::Find::name =~ m!^/sys/power/(wait_for_fb_|wakeup_count$)!; + # do not need . files or __ starting files + return if $File::Find::name =~ m!/\.[a-z]!; + # pp_num_states: amdgpu driver bug; android: wakeup_count + return if $File::Find::name =~ m!/pp_num_states$!; + # comment this one out if you experience hangs or if + # we discover syntax of foreign language characters + # Must be ascii like. This is questionable and might require further + # investigation, it is removing some characters that we might want + # NOTE: this made a bunch of files on arm systems unreadable so we handle + # the readable tests in copy_files() + # return unless -T; + } + elsif ($parse_src eq 'proc'){ + return if $File::Find::name =~ m!(/mb_groups|debug)$!; + } + # print $File::Find::name . "\n"; + push(@content, $File::Find::name); + return; +} + +# args: 0: path to file to be uploaded; 1: optional: alternate ftp upload url +# NOTE: must be in format: ftp.site.com/incoming +sub upload_file { + my ($self, $ftp_url) = @_; + my ($ftp, $domain, $host, $user, $pass, $dir, $error); + $ftp_url ||= main::get_defaults('ftp-upload'); + $ftp_url =~ s/\/$//g; # trim off trailing slash if present + my @url = split('/', $ftp_url); + my $file_path = "$user_data_dir/$debug_gz"; + $host = $url[0]; + $dir = $url[1]; + $domain = $host; + $domain =~ s/^ftp\.//; + $user = "anonymous"; + $pass = "anonymous\@$domain"; + print $line3; + print "Uploading to: $ftp_url\n"; + # print "$host $domain $dir $user $pass\n"; + print "File to be uploaded:\n$file_path\n"; + if ($host && ($file_path && -e $file_path)){ + # NOTE: important: must explicitly set to passive true/1 + $ftp = Net::FTP->new($host, Debug => 0, Passive => 1) || main::error_handler('ftp-connect', $ftp->message); + $ftp->login($user, $pass) || main::error_handler('ftp-login', $ftp->message); + $ftp->binary(); + $ftp->cwd($dir); + print "Connected to FTP server.\n"; + $ftp->put($file_path) || main::error_handler('ftp-upload', $ftp->message); + $ftp->quit; + print "Uploaded file successfully!\n"; + print $ftp->message; + if ($debugger{'gz'}){ + print "Removing debugger gz file:\n$file_path\n"; + unlink $file_path or main::error_handler('remove',"$file_path", "$!"); + print "File removed.\n"; + } + print "Debugger data generation and upload completed. Thank you for your help.\n"; + } + else { + main::error_handler('ftp-bad-path', "$file_path"); + } +} +} + +# see docs/optimization.txt +sub ram_use { + my ($name, $ref) = @_; + printf "%-25s %5d %5d\n", $name, size($ref), total_size($ref); +} + +# Used to create user visible debuugging output for complicated scenarios +# args: 0: $type; 1: data (scalar or array/hash ref); 2: 0/1 dbg item; +sub feature_debugger { + my ($type,$data,$b_switch) = @_; + my @result; + push(@result,'sub: ' . (caller(1))[3],'type: ' . $type); + if (ref $data eq 'ARRAY' || ref $data eq 'HASH'){ + $data = Data::Dumper::Dumper $data; + } + else { + $data .= "\n" if !$b_log; + } + push(@result,'data: ' . $data); + # note, if --debug 3 and eg. --dbg 63 used, we want this to print out + if (!$b_log || ($b_switch && $debugger{'level'} < 10)){ + unshift(@result,'------------------'); + push(@result,"------------------\n") if $b_log; + print join("\n",@result); + } + else { + main::log_data('dump','feature dbg @result',\@result); + } +} + +# random tests for various issues +sub user_debug_test_1 { +# open(my $duped, '>&', STDOUT); +# local *STDOUT = $duped; +# my $item = POSIX::strftime("%c", localtime); +# print "Testing character encoding handling. Perl IO data:\n"; +# print(join(', ', PerlIO::get_layers(STDOUT)), "\n"); +# print "Without binmode: ", $item,"\n"; +# binmode STDOUT,":utf8"; +# print "With binmode: ", $item,"\n"; +# print "Perl IO data:\n"; +# print(join(', ', PerlIO::get_layers(STDOUT)), "\n"); +# close $duped; +} + +#### ------------------------------------------------------------------- +#### DOWNLOADER +#### ------------------------------------------------------------------- + +# args: 0: download type; 1: url; 2: file; 3: [ua type string] +sub download_file { + my ($type, $url, $file,$ua) = @_; + my ($cmd,$args,$timeout) = ('','',''); + my $debug_data = ''; + my $result = 1; + $ua = ($ua && $dl{'ua'}) ? $dl{'ua'} . $ua : ''; + $dl{'no-ssl'} ||= ''; + $dl{'spider'} ||= ''; + $file ||= 'N/A'; # to avoid debug error + if (!$dl{'dl'}){ + return 0; + } + if ($dl{'timeout'}){ + $timeout = "$dl{'timeout'}$dl_timeout"; + } + # print "$dl{'no-ssl'}\n"; + # print "$dl{'dl'}\n"; + # tiny supports spider sort of + ## NOTE: 1 is success, 0 false for Perl + if ($dl{'dl'} eq 'tiny'){ + $cmd = "Using tiny: type: $type \nurl: $url \nfile: $file"; + $result = get_file_http_tiny($type,$url,$file,$ua); + $debug_data = ($type ne 'stdout') ? $result : 'Success: stdout data not null.'; + } + # But: 0 is success, and 1 is false for these + # when strings are returned, they will be taken as true + # urls must be " quoted in case special characters present + else { + if ($type eq 'stdout'){ + $args = $dl{'stdout'}; + $cmd = "$dl{'dl'} $dl{'no-ssl'} $ua $timeout $args \"$url\" $dl{'null'}"; + $result = qx($cmd); + $debug_data = ($result) ? 'Success: stdout data not null.' : 'Download resulted in null data!'; + } + elsif ($type eq 'file'){ + $args = $dl{'file'}; + $cmd = "$dl{'dl'} $dl{'no-ssl'} $ua $timeout $args $file \"$url\" $dl{'null'}"; + system($cmd); + $result = ($?) ? 0 : 1; # reverse these into Perl t/f + $debug_data = $result; + } + elsif ($dl{'dl'} eq 'wget' && $type eq 'spider'){ + $cmd = "$dl{'dl'} $dl{'no-ssl'} $ua $timeout $dl{'spider'} \"$url\""; + system($cmd); + $result = ($?) ? 0 : 1; # reverse these into Perl t/f + $debug_data = $result; + } + } + print "-------\nDownloader Data:\n$cmd\nResult: $debug_data\n" if $dbg[1]; + log_data('data',"$cmd\nResult: $result") if $b_log; + return $result; +} + +sub get_file_http_tiny { + my ($type,$url,$file,$ua) = @_; + $ua = ($ua && $dl{'ua'}) ? $dl{'ua'} . $ua: ''; + my %headers = ($ua) ? ('agent' => $ua) : (); + my $tiny = HTTP::Tiny->new(%headers); + # note: default is no verify, so default here actually is to verify unless overridden + $tiny->verify_SSL => 1 if !$use{'no-ssl'}; + my $response = $tiny->get($url); + my $return = 1; + my $debug = 0; + my $fh; + $file ||= 'N/A'; + log_data('dump','%{$response}',$response) if $b_log; + # print Dumper $response; + if (!$response->{'success'}){ + my $content = $response->{'content'}; + $content ||= "N/A\n"; + my $msg = "Failed to connect to server/file!\n"; + $msg .= "Response: ${content}Downloader: HTTP::Tiny URL: $url\nFile: $file"; + log_data('data',$msg) if $b_log; + print error_defaults('download-error',$msg) if $dbg[1]; + $return = 0; + } + else { + if ($debug){ + print "$response->{success}\n"; + print "$response->{status} $response->{reason}\n"; + while (my ($key, $value) = each %{$response->{'headers'}}){ + for (ref $value eq "ARRAY" ? @$value : $value){ + print "$key: $_\n"; + } + } + } + if ($type eq "stdout" || $type eq "ua-stdout"){ + $return = $response->{'content'}; + } + elsif ($type eq "spider"){ + # do nothing, just use the return value + } + elsif ($type eq "file"){ + open($fh, ">", $file); + print $fh $response->{'content'}; # or die "can't write to file!\n"; + close $fh; + } + } + return $return; +} + +sub set_downloader { + eval $start if $b_log; + my $quiet = ''; + my $ua_raw = 's-tools/' . $self_name . '-'; + $dl{'no-ssl'} = ''; + $dl{'null'} = ''; + $dl{'spider'} = ''; + # we only want to use HTTP::Tiny if it's present in user system. + # It is NOT part of core modules. IO::Socket::SSL is also required + # For some https connections so only use tiny as option if both present + if ($dl{'tiny'}){ + # this only for -U 4, grab file with ftp to avoid unsupported SSL issues + if ($use{'ftp-download'}){ + $dl{'tiny'} = 0; + } + elsif (check_perl_module('HTTP::Tiny') && check_perl_module('IO::Socket::SSL')){ + HTTP::Tiny->import; + IO::Socket::SSL->import; + $dl{'tiny'} = 1; + } + else { + $dl{'tiny'} = 0; + } + } + # print $dl{'tiny'} . "\n"; + if ($dl{'tiny'}){ + $dl{'dl'} = 'tiny'; + $dl{'file'} = ''; + $dl{'stdout'} = ''; + $dl{'timeout'} = ''; + $dl{'ua'} = $ua_raw; + } + elsif ($dl{'curl'} && check_program('curl')){ + $quiet = '-s ' if !$dbg[1]; + $dl{'dl'} = 'curl'; + $dl{'file'} = " -L ${quiet}-o "; + $dl{'no-ssl'} = ' --insecure'; + $dl{'stdout'} = " -L ${quiet}"; + $dl{'timeout'} = ' -y '; + $dl{'ua'} = ' -A ' . $ua_raw; + } + elsif ($dl{'wget'} && check_program('wget')){ + $quiet = '-q ' if !$dbg[1]; + $dl{'dl'} = 'wget'; + $dl{'file'} = " ${quiet}-O "; + $dl{'no-ssl'} = ' --no-check-certificate'; + $dl{'spider'} = " ${quiet}--spider"; + $dl{'stdout'} = " $quiet -O -"; + $dl{'timeout'} = ' -T '; + $dl{'ua'} = ' -U ' . $ua_raw; + } + elsif ($dl{'fetch'} && check_program('fetch')){ + $quiet = '-q ' if !$dbg[1]; + $dl{'dl'} = 'fetch'; + $dl{'file'} = " ${quiet}-o "; + $dl{'no-ssl'} = ' --no-verify-peer'; + $dl{'stdout'} = " ${quiet}-o -"; + $dl{'timeout'} = ' -T '; + $dl{'ua'} = ' --user-agent=' . $ua_raw; + } + # at least openbsd/netbsd + elsif ($bsd_type && check_program('ftp')){ + $dl{'dl'} = 'ftp'; + $dl{'file'} = ' -o '; + $dl{'null'} = ' 2>/dev/null'; + $dl{'stdout'} = ' -o - '; + $dl{'timeout'} = ''; + $dl{'ua'} = ' -U ' . $ua_raw; + } + else { + $dl{'dl'} = ''; + } + # $use{'no-ssl' is set to 1 with --no-ssl, when false, unset to '' + $dl{'no-ssl'} = '' if !$use{'no-ssl'}; + eval $end if $b_log; +} + +sub set_perl_downloader { + my ($downloader) = @_; + $downloader =~ s/perl/tiny/; + return $downloader; +} + +#### ------------------------------------------------------------------- +#### ERROR HANDLER +#### ------------------------------------------------------------------- + +sub error_handler { + eval $start if $b_log; + my ($err,$one,$two) = @_; + my ($b_help,$b_recommends); + my ($b_exit,$errno) = (1,0); + my $message = do { + if ($err eq 'empty'){ 'empty value' } + ## Basic rules + elsif ($err eq 'not-in-irc'){ + $errno=1; "You can't run option $one in an IRC client!" } + ## Internal/external options + elsif ($err eq 'bad-arg'){ + $errno=10; $b_help=1; "Unsupported value: $two for option: $one" } + elsif ($err eq 'bad-arg-int'){ + $errno=11; "Bad internal argument: $one" } + elsif ($err eq 'arg-modifier'){ + $errno=10; $b_help=1; "Missing option: $one must be used with: $two" } + elsif ($err eq 'distro-block'){ + $errno=20; "Option: $one has been disabled by the $self_name distribution maintainer." } + elsif ($err eq 'option-feature-incomplete'){ + $errno=21; "Option: '$one' feature: '$two' has not been implemented yet." } + elsif ($err eq 'unknown-option'){ + $errno=22; $b_help=1; "Unsupported option: $one" } + elsif ($err eq 'option-deprecated'){ + $errno=23; $b_exit=0; + "The option: $one has been deprecated. Please use $two instead." } + elsif ($err eq 'option-removed'){ + $errno=24; $b_help=1; "The option: $one has been remnoved. Please use $two instead." } + ## Data + elsif ($err eq 'open-data'){ + $errno=32; "Error opening data for reading: $one \nError: $two" } + elsif ($err eq 'download-error'){ + $errno=33; "Error downloading file with $dl{'dl'}: $one \nError: $two" } + ## Files: + elsif ($err eq 'copy-failed'){ + $errno=40; "Error copying file: $one \nError: $two" } + elsif ($err eq 'create'){ + $errno=41; "Error creating file: $one \nError: $two" } + elsif ($err eq 'downloader-error'){ + $errno=42; "Error downloading file: $one \nfor download source: $two" } + elsif ($err eq 'file-corrupt'){ + $errno=43; "Downloaded file is corrupted: $one" } + elsif ($err eq 'mkdir'){ + $errno=44; "Error creating directory: $one \nError: $two" } + elsif ($err eq 'open'){ + $errno=45; $b_exit=0; "Error opening file: $one \nError: $two" } + elsif ($err eq 'open-dir'){ + $errno=46; "Error opening directory: $one \nError: $two" } + elsif ($err eq 'output-file-bad'){ + $errno=47; "Value for --output-file must be full path, a writable directory, \nand include file name. Path: $two" } + elsif ($err eq 'not-writable'){ + $errno=48; "The file: $one is not writable!" } + elsif ($err eq 'open-dir-failed'){ + $errno=49; "The directory: $one failed to open with error: $two" } + elsif ($err eq 'remove'){ + $errno=50; "Failed to remove file: $one Error: $two" } + elsif ($err eq 'rename'){ + $errno=51; "There was an error moving files: $one\nError: $two" } + elsif ($err eq 'write'){ + $errno=52; "Failed writing file: $one - Error: $two!" } + elsif ($err eq 'dir-missing'){ + $errno=53; "Directory supplied for option $one does not exist:\n $two" } + ## Downloaders + elsif ($err eq 'missing-downloader'){ + $errno=60; "Downloader program $two could not be located on your system." } + elsif ($err eq 'missing-perl-downloader'){ + $errno=61; $b_recommends=1; "Perl downloader missing required module." } + elsif ($err eq 'no-downloader'){ + $errno=62; $b_recommends=1; "No downloader program located on your system." } + ## FTP + elsif ($err eq 'ftp-bad-path'){ + $errno=70; "Unable to locate for FTP upload file:\n$one" } + elsif ($err eq 'ftp-connect'){ + $errno=71; "There was an error with connection to ftp server: $one" } + elsif ($err eq 'ftp-login'){ + $errno=72; "There was an error with login to ftp server: $one" } + elsif ($err eq 'ftp-upload'){ + $errno=73; "There was an error with upload to ftp server: $one" } + ## Modules + elsif ($err eq 'required-module'){ + $errno=80; $b_recommends=1; "The required $one Perl module is not installed:\n$two" } + ## Programs + elsif ($err eq 'required-program'){ + $errno=90; "Required program '$one' could not be located on your system.\nNeeded for: $two" } + ## DEFAULT + else { + $errno=255; "Error handler ERROR!! Unsupported options: $err!"} + }; + print_line("Error $errno: $message\n"); + if ($b_help){ + print_line("Check -h for correct useage.\n"); + } + if ($b_recommends){ + print_line("See --recommends for more information.\n"); + } + eval $end if $b_log; + exit $errno if $b_exit && !$debugger{'no-exit'}; +} + +sub error_defaults { + my ($type,$one) = @_; + $one ||= ''; + my %errors = ( + 'download-error' => "Download Failure:\n$one\n", + ); + return $errors{$type}; +} + +#### ------------------------------------------------------------------- +#### RECOMMENDS +#### ------------------------------------------------------------------- + +## CheckRecommends ## +{ +package CheckRecommends; +my ($item_data,@modules,@pms); + +sub run { + main::error_handler('not-in-irc', 'recommends') if $b_irc; + my (@data,@rows); + my $rows = []; + my $line = main::make_line(); + @pms = get_pms(); + set_item_data(); + basic_data($rows,$line); + if (!$bsd_type){ + check_items($rows,'required system directories',$line); + } + check_items($rows,'recommended system programs',$line); + check_items($rows,'recommended display information programs',$line); + check_items($rows,'recommended downloader programs',$line); + if (!$bsd_type){ + check_items($rows,'recommended kernel modules',$line); + } + check_items($rows,'recommended Perl modules',$line); + check_items($rows,'recommended directories',$line); + check_items($rows,'recommended files',$line); + push(@$rows, + ['0', '', '', "$line"], + ['0', '', '', "Ok, all done with the checks. Have a nice day."], + ['0', '', '', ''], + ); + # print Data::Dumper::Dumper $rows; + main::print_basic($rows); + exit 0; # shell true +} + +sub basic_data { + my ($rows,$line) = @_; + my (@data,@rows); + $extra = 1; # needed for shell version + ShellData::set(); + my $client = $client{'name-print'}; + $client .= ' ' . $client{'version'} if $client{'version'}; + my $default_shell = 'N/A'; + if ($ENV{'SHELL'}){ + $default_shell = $ENV{'SHELL'}; + $default_shell =~ s/.*\///; + } + my $sh = main::check_program('sh'); + my $sh_real = Cwd::abs_path($sh); + push(@$rows, + ['0', '', '', "$self_name will now begin checking for the programs it needs + to operate."], + ['0', '', '', ""], + ['0', '', '', "Check $self_name --help or the man page (man $self_name) + to see what options are available."], + ['0', '', '', "$line"], + ['0', '', '', "Test: core tools:"], + ['0', '', '', ""], + ['0', '', '', "Perl version: ^$]"], + ['0', '', '', "Current shell: " . $client], + ['0', '', '', "Default shell: " . $default_shell], + ['0', '', '', "sh links to: $sh_real"], + ); + if (scalar @pms == 0){ + push(@$rows,['0', '', '', "Package manager(s): No supported PM(s) detected"]); + } + elsif (scalar @pms == 1){ + push(@$rows,['0', '', '', "Package manager: $pms[0]"]); + } + else { + push(@$rows,['0', '', '', "Package managers detected:"]); + foreach my $pm (@pms){ + push(@$rows,['0', '', '', " pm: $pm"]); + } + } +} + +sub check_items { + my ($rows,$type,$line) = @_; + my (@data,@missing,$row,$result,@unreadable); + my ($b_dir,$b_file,$b_kernel_module,$b_perl_module,$b_program,$item); + my ($about,$extra,$extra2,$extra3,$extra4,$info_os) = ('','','','','','info'); + if ($type eq 'required system directories'){ + @data = qw(/proc /sys); + $b_dir = 1; + $item = 'Directory'; + } + elsif ($type eq 'recommended system programs'){ + if ($bsd_type){ + @data = qw(camcontrol dig disklabel dmidecode doas fdisk file glabel gpart + ifconfig ipmi-sensors ipmitool pciconfig pcidump pcictl ps smartctl sudo + sysctl tree upower uptime usbconfig usbdevs); + $info_os = 'info-bsd'; + } + else { + @data = qw(blockdev bt-adapter btmgmt dig dmidecode doas fdisk file + fruid_print hciconfig hddtemp ifconfig ip ipmitool ipmi-sensors lsblk + lspci lsusb lvs mdadm modinfo ps runlevel sensors smartctl strings sudo + tree udevadm upower uptime); + } + $b_program = 1; + $item = 'Program'; + $extra2 = "Note: IPMI sensors are generally only found on servers. To access + that data, you only need one of the ipmi items."; + } + elsif ($type eq 'recommended display information programs'){ + if ($bsd_type){ + @data = qw(eglinfo glxinfo vulkaninfo wayland-info wmctrl xdpyinfo xprop + xdriinfo xrandr); + $info_os = 'info-bsd'; + } + else { + @data = qw(eglinfo glxinfo vulkaninfo wayland-info wmctrl xdpyinfo xprop + xdriinfo xrandr); + } + $b_program = 1; + $item = 'Program'; + } + elsif ($type eq 'recommended downloader programs'){ + if ($bsd_type){ + @data = qw(curl dig fetch ftp wget); + $info_os = 'info-bsd'; + } + else { + @data = qw(curl dig wget); + } + $b_program = 1; + $extra = ' (You only need one of these)'; + $extra2 = "Perl HTTP::Tiny is the default downloader tool if IO::Socket::SSL is present. + See --help --alt 40-44 options for how to override default downloader(s) in case of issues. "; + $extra3 = "If dig is installed, it is the default for WAN IP data. + Strongly recommended. Dig is fast and accurate."; + $extra4 = ". However, you really only need dig in most cases. All systems should have "; + $extra4 .= "at least one of the downloader options present."; + $item = 'Program'; + } + elsif ($type eq 'recommended Perl modules'){ + @data = qw(File::Copy File::Find File::Spec::Functions HTTP::Tiny IO::Socket::SSL + Time::HiRes JSON::PP Cpanel::JSON::XS JSON::XS XML::Dumper Net::FTP); + if ($bsd_type && $bsd_type eq 'openbsd'){ + push(@data, qw(OpenBSD::Pledge OpenBSD::Unveil)); + } + $b_perl_module = 1; + $item = 'Perl Module'; + $extra = ' (Optional)'; + $extra2 = "None of these are strictly required, but if you have them all, + you can eliminate some recommended non Perl programs from the install. "; + $extra3 = "HTTP::Tiny and IO::Socket::SSL must both be present to use as a + downloader option. For json export Cpanel::JSON::XS is preferred over + JSON::XS, but JSON::PP is in core modules. To run --debug 20-22 File::Copy, + File::Find, and File::Spec::Functions must be present (most distros have + these in Core Modules). + "; + } + elsif ($type eq 'recommended kernel modules'){ + @data = qw(amdgpu drivetemp nouveau radeon); + @modules = main::lister('/sys/module/'); + $b_kernel_module = 1; + $extra2 = "GPU modules are only needed if applicable. NVMe drives do not need drivetemp + but other types do."; + $extra3 = "To load a module: modprobe - To permanently load + add to /etc/modules or /etc/modules-load.d/modules.conf (check your system + paths for exact file/directory names)."; + $item = 'Kernel Module'; + } + elsif ($type eq 'recommended directories'){ + if ($bsd_type){ + @data = qw(/dev); + } + else { + @data = qw(/dev /dev/disk/by-id /dev/disk/by-label /dev/disk/by-path + /dev/disk/by-uuid /sys/class/dmi/id /sys/class/hwmon); + } + $b_dir = 1; + $item = 'Directory'; + } + elsif ($type eq 'recommended files'){ + if ($bsd_type){ + @data = qw(/var/run/dmesg.boot /var/log/Xorg.0.log); + } + else { + @data = qw(/etc/lsb-release /etc/os-release /proc/asound/cards + /proc/asound/version /proc/cpuinfo /proc/mdstat /proc/meminfo /proc/modules + /proc/mounts /proc/scsi/scsi /var/log/Xorg.0.log); + } + $b_file = 1; + $item = 'File'; + $extra2 = "Note that not all of these are used by every system, + so if one is missing it's usually not a big deal."; + } + push(@$rows, + ['0', '', '', "$line" ], + ['0', '', '', "Test: $type$extra:" ], + ['0', '', '', ''], + ); + if ($extra2){ + push(@$rows, + ['0', '', '', $extra2], + ['0', '', '', '']); + } + if ($extra3){ + push(@$rows, + ['0', '', '', $extra3], + ['0', '', '', '']); + } + foreach my $item (@data){ + undef $about; + my $info = $item_data->{$item}; + $about = $info->{$info_os}; + if (($b_dir && -d $item) || ($b_file && -r $item) || + ($b_program && main::check_program($item)) || + ($b_perl_module && main::check_perl_module($item)) || + ($b_kernel_module && @modules && (grep {/^$item$/} @modules))){ + $result = 'Present'; + } + elsif ($b_file && -f $item){ + $result = 'Unreadable'; + push(@unreadable, "$item"); + } + else { + $result = 'Missing'; + push(@missing,"$item"); + if (($b_program || $b_perl_module) && @pms){ + my @install; + foreach my $pm (@pms){ + $info->{$pm} ||= 'N/A'; + push(@install," $pm: $info->{$pm}"); + } + push(@missing,@install); + } + } + $row = make_row($item,$about,$result); + push(@$rows, ['0', '', '', $row]); + } + push(@$rows, ['0', '', '', '']); + if (@missing){ + push(@$rows, ['0', '', '', "The following $type are missing$extra4:"]); + foreach (@missing){ + push(@$rows, ['0', '', '', $_]); + } + } + if (@unreadable){ + push(@$rows, ['0', '', '', "The following $type are not readable: "]); + foreach (@unreadable){ + push(@$rows, ['0', '', '', "$item: $_"]); + } + } + if (!@missing && !@unreadable){ + push(@$rows, ['0', '', '', "All $type are present"]); + } +} + +sub set_item_data { + $item_data = { + ## Directory Data ## + '/dev' => { + 'info' => '-l,-u,-o,-p,-P,-D disk partition data', + }, + '/dev/disk/by-id' => { + 'info' => '-D serial numbers', + }, + '/dev/disk/by-path' => { + 'info' => '-D extra data', + }, + '/dev/disk/by-label' => { + 'info' => '-l,-o,-p,-P partition labels', + }, + '/dev/disk/by-uuid' => { + 'info' => '-u,-o,-p,-P partition uuid', + }, + '/proc' => { + 'info' => '', + }, + '/sys' => { + 'info' => '', + }, + '/sys/class/dmi/id' => { + 'info' => '-M system, motherboard, bios', + }, + '/sys/class/hwmon' => { + 'info' => '-s sensor data (fallback if no lm-sensors)', + }, + ## File Data ## + '/etc/lsb-release' => { + 'info' => '-S distro version data (older version)', + }, + '/etc/os-release' => { + 'info' => '-S distro version data (newer version)', + }, + '/proc/asound/cards' => { + 'info' => '-A sound card data', + }, + '/proc/asound/version' => { + 'info' => '-A ALSA data', + }, + '/proc/cpuinfo' => { + 'info' => '-C cpu data', + }, + '/proc/mdstat' => { + 'info' => '-R mdraid data (if you use dm-raid)', + }, + '/proc/meminfo' => { + 'info' => '-I,-tm, -m memory data', + }, + '/proc/modules' => { + 'info' => '-G module data (sometimes)', + }, + '/proc/mounts' => { + 'info' => '-P,-p partition advanced data', + }, + '/proc/scsi/scsi' => { + 'info' => '-D Advanced hard disk data (used rarely)', + }, + '/var/log/Xorg.0.log' => { + 'info' => '-G graphics driver load status', + }, + '/var/run/dmesg.boot' => { + 'info' => '-D,-d disk data', + }, + ## Kernel Module Data ## + 'amdgpu' => { + 'info' => '-s, -G AMD GPU sensor data (newer GPUs)', + 'info-bsd' => '', + }, + 'drivetemp' => { + 'info' => '-Dx drive temperature (kernel >= 5.6)', + 'info-bsd' => '', + }, + 'nouveau' => { + 'info' => '-s, -G Nvidia GPU sensor data (if using free driver)', + 'info-bsd' => '', + }, + 'radeon' => { + 'info' => '-s, -G AMD GPU sensor data (older GPUs)', + 'info-bsd' => '', + }, + ## START PACKAGE MANAGER BLOCK ## + # BSD only tools do not list package manager install names + ## Programs-System ## + # Note: see inxi-perl branch for details: docs/inxi-custom-recommends.txt + # System Tools + 'blockdev' => { + 'info' => '--admin -p/-P (filesystem blocksize)', + 'info-bsd' => '', + 'apt' => 'util-linux', + 'pacman' => 'util-linux', + 'pkgtool' => 'util-linux', + 'rpm' => 'util-linux', + }, + 'bt-adapter' => { + 'info' => '-E bluetooth data (if no hciconfig, btmgmt)', + 'info-bsd' => '', + 'apt' => 'bluez-tools', + 'pacman' => 'bluez-tools', + 'pkgtool' => '', # needs to be built by user + 'rpm' => 'bluez-tools', + }, + 'btmgmt' => { + 'info' => '-E bluetooth data (if no hciconfig)', + 'info-bsd' => '', + 'apt' => 'bluez', + 'pacman' => 'bluez-utils', + 'pkgtool' => '', # needs to be built by user + 'rpm' => 'bluez', + }, + 'curl' => { + 'info' => '-i (if no dig); -w,-W; -U', + 'info-bsd' => '-i (if no dig); -w,-W; -U', + 'apt' => 'curl', + 'pacman' => 'curl', + 'pkgtool' => 'curl', + 'rpm' => 'curl', + }, + 'camcontrol' => { + 'info' => '', + 'info-bsd' => '-R; -D; -P. Get actual gptid /dev path', + }, + 'dig' => { + 'info' => '-i wlan IP', + 'info-bsd' => '-i wlan IP', + 'apt' => 'dnsutils', + 'pacman' => 'dnsutils', + 'pkgtool' => 'bind', + 'rpm' => 'bind-utils', + }, + 'disklabel' => { + 'info' => '', + 'info-bsd' => '-j, -p, -P; -R; -o (Open/NetBSD+derived)', + }, + 'dmidecode' => { + 'info' => '-M if no sys machine data; -m', + 'info-bsd' => '-M if null sysctl; -m; -B if null sysctl', + 'apt' => 'dmidecode', + 'pacman' => 'dmidecode', + 'pkgtool' => 'dmidecode', + 'rpm' => 'dmidecode', + }, + 'doas' => { + 'info' => '-Dx hddtemp-user; -o file-user (alt for sudo)', + 'info-bsd' => '-Dx hddtemp-user; -o file-user', + 'apt' => 'doas', + 'pacman' => 'doas', + 'pkgtool' => ' opendoas', + 'rpm' => 'doas', + }, + 'fdisk' => { + 'info' => '-D partition scheme (fallback)', + 'info-bsd' => '-D partition scheme', + 'apt' => 'fdisk', + 'pacman' => 'util-linux', + 'pkgtool' => 'util-linux', + 'rpm' => 'util-linux', + }, + 'fetch' => { + 'info' => '', + 'info-bsd' => '-i (if no dig); -w,-W; -U', + }, + 'file' => { + 'info' => '-o unmounted file system (if no lsblk)', + 'info-bsd' => '-o unmounted file system', + 'apt' => 'file', + 'pacman' => 'file', + 'pkgtool' => 'file', + 'rpm' => 'file', + }, + 'ftp' => { + 'info' => '', + 'info-bsd' => '-i (if no dig); -w,-W; -U', + }, + 'fruid_print' => { + 'info' => '-M machine data, Elbrus only', + 'info-bsd' => '', + 'apt' => '', + 'pacman' => '', + 'pkgtool' => '', + 'rpm' => '', + }, + 'glabel' => { + 'info' => '', + 'info-bsd' => '-R; -D; -P. Get actual gptid /dev path', + }, + 'gpart' => { + 'info' => '', + 'info-bsd' => '-p,-P; -R; -o (FreeBSD+derived)', + }, + 'hciconfig' => { + 'info' => '-E bluetooth data (deprecated, good report)', + 'info-bsd' => '', + 'apt' => 'bluez', + 'pacman' => 'bluez-utils-compat (frugalware: bluez-utils)', + 'pkgtool' => 'bluez', + 'rpm' => 'bluez-utils', + }, + 'hddtemp' => { + 'info' => '-Dx show hdd temp, if no drivetemp module', + 'info-bsd' => '-Dx show hdd temp', + 'apt' => 'hddtemp', + 'pacman' => 'hddtemp', + 'pkgtool' => 'hddtemp', + 'rpm' => 'hddtemp', + }, + 'ifconfig' => { + 'info' => '-i ip LAN (deprecated, ip preferred)', + 'info-bsd' => '-i ip LAN', + 'apt' => 'net-tools', + 'pacman' => 'net-tools', + 'pkgtool' => 'net-tools', + 'rpm' => 'net-tools', + }, + 'ip' => { + 'info' => '-i ip LAN', + 'info-bsd' => '', + 'apt' => 'iproute', + 'pacman' => 'iproute2', + 'pkgtool' => 'iproute2', + 'rpm' => 'iproute', + }, + 'ipmi-sensors' => { + 'info' => '-s IPMI sensors (servers)', + 'info-bsd' => '', + 'apt' => 'freeipmi-tools', + 'pacman' => 'freeipmi', + 'pkgtool' => 'freeipmi', + 'rpm' => 'freeipmi', + }, + 'ipmitool' => { + 'info' => '-s IPMI sensors (servers)', + 'info-bsd' => '-s IPMI sensors (servers)', + 'apt' => 'ipmitool', + 'pacman' => 'ipmitool', + 'pkgtool' => 'ipmitool', + 'rpm' => 'ipmitool', + }, + 'lsblk' => { + 'info' => '-L LUKS/bcache; -o unmounted file system (best option)', + 'info-bsd' => '-o unmounted file system', + 'apt' => 'util-linux', + 'pacman' => 'util-linux', + 'pkgtool' => 'util-linux', + 'rpm' => 'util-linux-ng', + }, + 'lspci' => { + 'info' => '-A,-E,-G,-N,-R PCI Device data (/sys supplies much)', + 'info-bsd' => '', + 'apt' => 'pciutils', + 'pacman' => 'pciutils', + 'pkgtool' => 'pciutils', + 'rpm' => 'pciutils', + }, + 'lsusb' => { + 'info' => '-A,-E,-G,-J,-N USB Device data (/sys supplies much)', + 'info-bsd' => '', + 'apt' => 'usbutils', + 'pacman' => 'usbutils', + 'pkgtool' => 'usbutils', + 'rpm' => 'usbutils', + }, + 'lvs' => { + 'info' => '-L LVM data', + 'info-bsd' => '', + 'apt' => 'lvm2', + 'pacman' => 'lvm2', + 'pkgtool' => 'lvm2', + 'rpm' => 'lvm2', + }, + 'mdadm' => { + 'info' => '-Ra advanced mdraid data', + 'info-bsd' => '', + 'apt' => 'mdadm', + 'pacman' => 'mdadm', + 'pkgtool' => 'mdadm', + 'rpm' => 'mdadm', + }, + 'modinfo' => { + 'info' => 'Ax; -Nx module version', + 'info-bsd' => '', + 'apt' => 'module-init-tools', + 'pacman' => 'module-init-tools', + 'pkgtool' => 'kmod (earlier: module-init-tools)', + 'rpm' => 'module-init-tools', + }, + 'pciconfig' => { + 'info' => '', + 'info-bsd' => '-A,-E,-G,-N pci devices (FreeBSD+derived)', + }, + 'pcictl' => { + 'info' => '', + 'info-bsd' => '-A,-E,-G,-N pci devices (NetBSD+derived)', + }, + 'pcidump' => { + 'info' => '', + 'info-bsd' => '-A,-E,-G,-N pci devices (OpenBSD+derived, doas/su)', + }, + 'ps' => { + 'info' => '-G,-I,-n,-S,-t process/programs', + 'info-bsd' => '-G,-I,-n,-S,-t process/programs', + 'apt' => 'procps', + 'pacman' => 'procps', + 'pkgtool' => 'procps', + 'rpm' => 'procps', + }, + 'runlevel' => { + 'info' => '-I fallback to Perl', + 'info-bsd' => '', + 'apt' => 'systemd or sysvinit', + 'pacman' => 'systemd', + 'pkgtool' => 'sysvinit', + 'rpm' => 'systemd or sysvinit', + }, + 'sensors' => { + 'info' => '-s sensors output (optional, /sys supplies most)', + 'info-bsd' => '', + 'apt' => 'lm-sensors', + 'pacman' => 'lm-sensors', + 'pkgtool' => 'lm_sensors', + 'rpm' => 'lm-sensors', + }, + 'smartctl' => { + 'info' => '-Da advanced data', + 'info-bsd' => '-Da advanced data', + 'apt' => 'smartmontools', + 'pacman' => 'smartmontools', + 'pkgtool' => 'smartmontools', + 'rpm' => 'smartmontools', + }, + 'strings' => { + 'info' => '-I sysvinit version', + 'info-bsd' => '', + 'apt' => 'binutils', + 'pacman' => 'binutils', + 'pkgtool' => 'binutils', + 'rpm' => 'binutils', + }, + 'sudo' => { + 'info' => '-Dx hddtemp-user; -o file-user (try doas!)', + 'info-bsd' => '-Dx hddtemp-user; -o file-user (alt for doas)', + 'apt' => 'sudo', + 'pacman' => 'sudo', + 'pkgtool' => 'sudo', + 'rpm' => 'sudo', + }, + 'sysctl' => { + 'info' => '', + 'info-bsd' => '-C; -I; -m; -tm', + }, + 'tree' => { + 'info' => '--debugger 20,21 /sys tree', + 'info-bsd' => '--debugger 20,21 /sys tree', + 'apt' => 'tree', + 'pacman' => 'tree', + 'pkgtool' => 'tree', + 'rpm' => 'tree', + }, + 'udevadm' => { + 'info' => '-m ram data for non-root, or no dmidecode', + 'apt' => 'udev (non-systemd: eudev)', + 'pacman' => 'systemd', + 'pkgtool' => 'eudev', + 'rpm' => 'udev (fedora: systemd-udev)', + }, + 'upower' => { + 'info' => '-sx attached device battery info', + 'info-bsd' => '-sx attached device battery info', + 'apt' => 'upower', + 'pacman' => 'upower', + 'pkgtool' => 'upower', + 'rpm' => 'upower', + }, + 'uptime' => { + 'info' => '-I uptime', + 'info-bsd' => '-I uptime', + 'apt' => 'procps', + 'pacman' => 'procps', + 'pkgtool' => 'procps', + 'rpm' => 'procps', + }, + 'usbconfig' => { + 'info' => '', + 'info-bsd' => '-A; -E; -G; -J; -N; (FreeBSD+derived, doas/su)', + }, + 'usbdevs' => { + 'info' => '', + 'info-bsd' => '-A; -E; -G; -J; -N; (Open/NetBSD+derived)', + }, + 'wget' => { + 'info' => '-i (if no dig); -w,-W; -U', + 'info-bsd' => '-i (if no dig); -w,-W; -U', + 'apt' => 'wget', + 'pacman' => 'wget', + 'pkgtool' => 'wget', + 'rpm' => 'wget', + }, + ## Programs-Display ## + 'eglinfo' => { + 'info' => '-G X11/Wayland EGL info', + 'info-bsd' => '-G X11/Wayland EGL info', + 'apt' => 'mesa-utils (or: mesa-utils-extra)', + 'pacman' => 'mesa-utils', + 'pkgtool' => 'mesa', + 'rpm' => 'egl-utils (SUSE: Mesa-demo-egl)', + }, + 'glxinfo' => { + 'info' => '-G X11 GLX info', + 'info-bsd' => '-G X11 GLX info', + 'apt' => 'mesa-utils', + 'pacman' => 'mesa-utils', + 'pkgtool' => 'mesa', + 'rpm' => 'glx-utils (Fedora: glx-utils; SUSE: Mesa-demo-x)', + }, + 'vulkaninfo' => { + 'info' => '-G Vulkan API info', + 'info-bsd' => '-G Vulkan API info', + 'apt' => 'vulkan-tools', + 'pacman' => 'vulkan-tools', + 'pkgtool' => 'vulkan-tools', + 'rpm' => 'vulkan-demos (Fedora: vulkan-tools; SUSE: vulkan-demos)', + }, + 'wayland-info' => { + 'info' => '-G Wayland data (not for X)', + 'info-bsd' => '-G Wayland data (not for X)', + 'apt' => 'wayland-utils', + 'pacman' => 'wayland-utils', + 'pkgtool' => 'wayland-utils', + 'rpm' => 'wayland-utils', + }, + 'wmctrl' => { + 'info' => '-S active window manager (fallback)', + 'info-bsd' => '-S active window manager (fallback)', + 'apt' => 'wmctrl', + 'pacman' => 'wmctrl', + 'pkgtool' => 'wmctrl', + 'rpm' => 'wmctrl', + }, + 'xdpyinfo' => { + 'info' => '-G (X) Screen resolution, dpi; -Ga Screen size', + 'info-bsd' => '-G (X) Screen resolution, dpi; -Ga Screen size', + 'apt' => 'X11-utils', + 'pacman' => 'xorg-xdpyinfo', + 'pkgtool' => 'xdpyinfo', + 'rpm' => 'xorg-x11-utils (SUSE/Fedora: xdpyinfo)', + }, + 'xdriinfo' => { + 'info' => '-G (X) DRI driver (if missing, fallback to Xorg log)', + 'info-bsd' => '-G (X) DRI driver (if missing, fallback to Xorg log', + 'apt' => 'X11-utils', + 'pacman' => 'xorg-xdriinfo', + 'pkgtool' => 'xdriinfo', + 'rpm' => 'xorg-x11-utils (SUSE/Fedora: xdriinfo)', + }, + 'xprop' => { + 'info' => '-S (X) desktop data', + 'info-bsd' => '-S (X) desktop data', + 'apt' => 'X11-utils', + 'pacman' => 'xorg-xprop', + 'pkgtool' => 'xprop', + 'rpm' => 'x11-utils (Fedora/SUSE: xprop)', + }, + 'xrandr' => { + 'info' => '-G (X) monitors(s) resolution; -Ga monitor data', + 'info-bsd' => '-G (X) monitors(s) resolution; -Ga monitor data', + 'apt' => 'x11-xserver-utils', + 'pacman' => 'xrandr', + 'pkgtool' => 'xrandr', + 'rpm' => 'x11-server-utils (SUSE/Fedora: xrandr)', + }, + ## Perl Modules ## + 'Cpanel::JSON::XS' => { + 'info' => '-G wayland, --output json (faster).', + 'info-bsd' => '-G wayland, --output json (faster).', + 'apt' => 'libcpanel-json-xs-perl', + 'pacman' => 'perl-cpanel-json-xs', + 'pkgtool' => 'perl-Cpanel-JSON-XS', + 'rpm' => 'perl-Cpanel-JSON-XS', + }, + 'File::Copy' => { + 'info' => '--debug 20-22 - required for debugger.', + 'info-bsd' => '--debug 20-22 - required for debugger.', + 'apt' => 'Core Modules', + 'pacman' => 'Core Modules', + 'pkgtool' => 'Core Modules', + 'rpm' => 'perl-File-Copy', + }, + 'File::Find' => { + 'info' => '--debug 20-22 - required for debugger.', + 'info-bsd' => '--debug 20-22 - required for debugger.', + 'apt' => 'Core Modules', + 'pacman' => 'Core Modules', + 'pkgtool' => 'Core Modules', + 'rpm' => 'perl-File-Find', + }, + 'File::Spec::Functions' => { + 'info' => '--debug 20-22 - required for debugger.', + 'info-bsd' => '--debug 20-22 - required for debugger.', + 'apt' => 'Core Modules', + 'pacman' => 'Core Modules', + 'pkgtool' => 'Core Modules', + 'rpm' => 'Core Modules', + }, + 'HTTP::Tiny' => { + 'info' => '-U; -w,-W; -i (if dig not installed).', + 'info-bsd' => '-U; -w,-W; -i (if dig not installed)', + 'apt' => 'libhttp-tiny-perl (Core Modules >= 5.014)', + 'pacman' => 'Core Modules', + 'pkgtool' => 'perl-http-tiny (Core Modules >= 5.014)', + 'rpm' => 'Perl-http-tiny', + }, + 'IO::Socket::SSL' => { + 'info' => '-U; -w,-W; -i (if dig not installed).', + 'info-bsd' => '-U; -w,-W; -i (if dig not installed)', + 'apt' => 'libio-socket-ssl-perl', + 'pacman' => 'perl-io-socket-ssl', + 'pkgtool' => 'perl-IO-Socket-SSL', # maybe in core modules + 'rpm' => 'perl-IO-Socket-SSL', + }, + 'JSON::PP' => { + 'info' => '-G wayland, --output json (in CoreModules, slower).', + 'info-bsd' => '-G wayland, --output json (in CoreModules, slower).', + 'apt' => 'libjson-pp-perl (Core Modules >= 5.014)', + 'pacman' => 'perl-json-pp (Core Modules >= 5.014)', + 'pkgtool' => 'Core Modules >= 5.014', + 'rpm' => 'perl-JSON-PP', + }, + 'JSON::XS' => { + 'info' => '-G wayland, --output json (legacy).', + 'info-bsd' => '-G wayland, --output json (legacy).', + 'apt' => 'libjson-xs-perl', + 'pacman' => 'perl-json-xs', + 'pkgtool' => 'perl-JSON-XS', + 'rpm' => 'perl-JSON-XS', + }, + 'Net::FTP' => { + 'info' => '--debug 21,22', + 'info-bsd' => '--debug 21,22', + 'apt' => 'Core Modules', + 'pacman' => 'Core Modules', + 'pkgtool' => 'Core Modules', + 'rpm' => 'Core Modules', + }, + 'OpenBSD::Pledge' => { + 'info' => "$self_name Perl pledge support.", + 'info-bsd' => "$self_name Perl pledge support.", + }, + 'OpenBSD::Unveil' => { + 'info' => "Experimental: $self_name Perl unveil support.", + 'info-bsd' => "Experimental: $self_name Perl unveil support.", + }, + 'Time::HiRes' => { + 'info' => '-C cpu sleep (not required); --debug timers', + 'info-bsd' => '-C cpu sleep (not required); --debug timers', + 'apt' => 'Core Modules', + 'pacman' => 'Core Modules', + 'pkgtool' => 'Core Modules', + 'rpm' => 'perl-Time-HiRes', + }, + 'XML::Dumper' => { + 'info' => '--output xml - Crude and raw.', + 'info-bsd' => '--output xml - Crude and raw.', + 'apt' => 'libxml-dumper-perl', + 'pacman' => 'perl-xml-dumper', + 'pkgtool' => '', # package does not appear to exist + 'rpm' => 'perl-XML-Dumper', + }, + ## END PACKAGE MANAGER BLOCK ## + }; +} + +sub get_pms { + my @pms = (); + # support maintainers of other pm types using custom lists + if (main::check_program('dpkg')){ + push(@pms,'apt'); + } + if (main::check_program('pacman')){ + push(@pms,'pacman'); + } + # assuming netpkg uses installpkg as backend + if (main::check_program('installpkg')){ + push(@pms,'pkgtool'); + } + # rpm needs to go last because it's sometimes available on other pm systems + if (main::check_program('rpm')){ + push(@pms,'rpm'); + } + return @pms; +} + +# note: end will vary, but should always be treated as longest value possible. +# expected values: Present/Missing +sub make_row { + my ($start,$middle,$end) = @_; + my ($dots,$line,$sep) = ('','',': '); + foreach (0 .. ($size{'max-cols'} - 16 - length("$start$middle"))){ + $dots .= '.'; + } + $line = "$start$sep$middle$dots $end"; + return $line; +} +} + +#### ------------------------------------------------------------------- +#### TOOLS +#### ------------------------------------------------------------------- + +# Duplicates the functionality of awk to allow for one liner +# type data parsing. note: -1 corresponds to awk NF +# args: 0: array of data; 1: search term; 2: field result; 3: separator +# correpsonds to: awk -F='separator' '/search/ {print $2}' <<< @data +# array is sent by reference so it must be dereferenced +# NOTE: if you just want the first row, pass it \S as search string +# NOTE: if $num is undefined, it will skip the second step +sub awk { + eval $start if $b_log; + my ($ref,$search,$num,$sep) = @_; + my ($result); + # print "search: $search\n"; + return if !@$ref || !$search; + foreach (@$ref){ + next if !defined $_; + if (/$search/i){ + $result = $_; + $result =~ s/^\s+|\s+$//g; + last; + } + } + if ($result && defined $num){ + $sep ||= '\s+'; + $num-- if $num > 0; # retain the negative values as is + $result = (split(/$sep/, $result))[$num]; + $result =~ s/^\s+|,|\s+$//g if $result; + } + eval $end if $b_log; + return $result; +} + +# 0: Perl module to check +sub check_perl_module { + my ($module) = @_; + my $b_present = 0; + eval "require $module"; + $b_present = 1 if !$@; + return $b_present; +} + +# args: 0: string or path to search gneerated @paths data for. +# note: a few nano seconds are saved by using raw $_[0] for program +sub check_program { + (grep { return "$_/$_[0]" if -e "$_/$_[0]"} @paths)[0]; +} + +sub cleanup { + # maybe add in future: , $fh_c, $fh_j, $fh_x + foreach my $fh ($fh_l){ + if ($fh){ + close $fh; + } + } +} + +# args: 0,1: version numbers to compare by turning them to strings +# note that the structure of the two numbers is expected to be fairly +# similar, otherwise it may not work perfectly. +sub compare_versions { + my ($one,$two) = @_; + if ($one && !$two){return $one;} + elsif ($two && !$one){return $two;} + elsif (!$one && !$two){return} + my ($pad1,$pad2) = ('',''); + $pad1 = join('', map {$_ = sprintf("%04s", $_);$_ } split(/[._-]/, $one)); + $pad2 = join('', map {$_ = sprintf("%04s", $_);$_ } split(/[._-]/, $two)); + # print "p1:$pad1 p2:$pad2\n"; + if ($pad1 ge $pad2){return $one} + elsif ($pad2 gt $pad1){return $two} +} + +# some things randomly use hex with 0x starter, return always integer +# warning: perl will generate a 32 bit too big number warning if you pass it +# random values that exceed 2^32 in hex, even if the base system is 64 bit. +# sample: convert_hex(0x000b0000000b); +sub convert_hex { + return (defined $_[0] && $_[0] =~ /^0x/) ? hex($_[0]) : $_[0]; +} + +# returns count of files in directory, if 0, dir is empty +sub count_dir_files { + return unless -d $_[0]; + opendir(my $dh, $_[0]) or error_handler('open-dir-failed', "$_[0]", $!); + my $count = grep { ! /^\.{1,2}/ } readdir($dh); # strips out . and .. + closedir $dh; + return $count; +} + +# args: 0: the string to get piece of +# 1: the position in string, starting at 1 for 0 index. +# 2: the separator, default is ' ' +sub get_piece { + eval $start if $b_log; + my ($string, $num, $sep) = @_; + $num--; + $sep ||= '\s+'; + $string =~ s/^\s+|\s+$//g; + my @temp = split(/$sep/, $string); + eval $end if $b_log; + if (exists $temp[$num]){ + $temp[$num] =~ s/,//g; + return $temp[$num]; + } +} + +# args: 0: command to turn into an array; 1: optional: splitter; +# 2: strip-trim, clean data, remove empty lines +# similar to reader() except this creates an array of data +# by lines from the command arg +sub grabber { + eval $start if $b_log; + my ($cmd,$split,$strip,$type) = @_; + $type ||= 'arr'; + $split ||= "\n"; + my @rows; + if ($strip){ + for (split(/$split/, qx($cmd))){ + next if /^\s*(#|$)/; + $_ =~ s/^\s+|\s+$//g; + push(@rows,$_); + } + } + else { + @rows = split(/$split/, qx($cmd)); + } + eval $end if $b_log; + return ($type eq 'arr') ? @rows : \@rows; +} + +# args: 0: string value to glob +sub globber { + eval $start if $b_log; + my @files = <$_[0]>; + eval $end if $b_log; + return @files; +} + +# arg MUST be quoted when inserted, otherwise perl takes it for a hex number +sub is_hex { + return (defined $_[0] && $_[0] =~ /^0x/) ? 1 : 0; +} + +## NOTE: for perl pre 5.012 length(undef) returns warning +# receives string, returns boolean 1 if integer +sub is_int { + return 1 if (defined $_[0] && length($_[0]) && + length($_[0]) == ($_[0] =~ tr/0123456789//)); +} + +# receives string, returns true/1 if >= 0 numeric. tr/// 4x faster than regex +sub is_numeric { + return 1 if (defined $_[0] && ($_[0] =~ tr/0123456789//) >= 1 && + length($_[0]) == ($_[0] =~ tr/0123456789.//) && ($_[0] =~ tr/.//) <= 1); +} + +# gets array ref, which may be undefined, plus join string +# this helps avoid debugger print errors when we are printing arrays +# which we don't know are defined or not null. +# args: 0: array ref; 1: join string; 2: default value, optional +sub joiner { + my ($arr,$join,$default) = @_; + $default ||= ''; + my $string = ''; + foreach (@$arr){ + if (defined $_){ + $string .= $_ . $join; + } + else { + $string .= $default . $join; + } + } + return $string; +} + +# gets directory file list +sub lister { + return if ! -d $_[0]; + opendir my $dir, $_[0] or return; + my @list = readdir $dir; + @list = grep {!/^(\.|\.\.)$/} @list if @list; + closedir $dir; + return @list; +} +# checks for 1 of 3 perl json modules. All three have same encode_json, +# decode_json() methods. +sub load_json { + eval $start if $b_log; + $loaded{'json'} = 1; + # recommended, but not in core modules + if (check_perl_module('Cpanel::JSON::XS')){ + Cpanel::JSON::XS->import(qw(encode_json decode_json)); + # my $new = Cpanel::JSON::XS->new; + $use{'json'} = {'type' => 'cpanel-json-xs', + 'encode' => \&Cpanel::JSON::XS::encode_json, + 'decode' => \&Cpanel::JSON::XS::decode_json,}; + # $use{'json'} = {'type' => 'cpanel-json-xs', + # 'new-json' => \Cpanel::JSON::XS->new()}; + } + # somewhat legacy, not in perl modules + elsif (check_perl_module('JSON::XS')){ + JSON::XS->import; + $use{'json'} = {'type' => 'json-xs', + 'encode' => \&JSON::XS::encode_json, + 'decode' => \&JSON::XS::decode_json}; + } + # perl, in core modules as of 5.14 + elsif (check_perl_module('JSON::PP')){ + JSON::PP->import; + $use{'json'} = {'type' => 'json-pp', + 'encode' => \&JSON::PP::encode_json, + 'decode' => \&JSON::PP::decode_json}; + } + eval $end if $b_log; +} + +# args: 0: full file path, returns array of file lines; +# 1: optionsl, strip and clean data; +# 2: optional: undef|arr|ref|index return specific index, if it exists, else undef +# note: chomp has to chomp the entire action, not just <$fh> +sub reader { + eval $start if $b_log; + my ($file,$strip,$type) = @_; + return if !$file || ! -r $file; # not all OS respect -r tests!! + $type = 'arr' if !defined $type; + my ($error,@rows); + open(my $fh, '<', $file) or $error = $!; # $fh always non null, even on error + if ($error){ + error_handler('open', $file, $error); + } + else { + chomp(@rows = <$fh>); + close $fh; + if (@rows && $strip){ + my @temp; + for (@rows){ + next if /^\s*(#|$)/; + $_ =~ s/^\s+|\s+$//g; + push(@temp,$_); + } + @rows = @temp; + } + } + eval $end if $b_log; + return @rows if $type eq 'arr'; + return \@rows if $type eq 'ref'; + # note: returns undef scalar value if $rows[index] does not exist + return $rows[$type]; +} + +# args: 0: the file to create if not exists +sub toucher { + my $file = shift; + if (! -e $file){ + open(my $fh, '>', $file) or error_handler('create', $file, $!); + } +} + +# calling it trimmer to avoid conflicts with existing trim stuff +# args: 0: string to be right left trimmed. Also slices off \n so no chomp needed +# this thing is super fast, no need to log its times etc, 0.0001 seconds or less +sub trimmer { + # eval $start if $b_log; + my ($str) = @_; + $str =~ s/^\s+|\s+$|\n$//g; + # eval $end if $b_log; + return $str; +} + +# args: 0: array, by ref, modifying by ref +# send array, assign to hash, changed array by reference, uniq values only. +sub uniq { + my %seen; + @{$_[0]} = grep !$seen{$_}++, @{$_[0]}; +} + +# args: 0: file full path to write to; 1: array ref or scalar of data to write. +# note: turning off strict refs so we can pass it a scalar or an array reference. +sub writer { + my ($path, $content) = @_; + my ($contents); + no strict 'refs'; + # print Dumper $content, "\n"; + if (ref $content eq 'ARRAY'){ + $contents = join("\n", @$content); # or die "failed with error $!"; + } + else { + $contents = $content; + } + open(my $fh, ">", $path) or error_handler('open',"$path", "$!"); + print $fh $contents; + close $fh; +} + +#### ------------------------------------------------------------------- +#### UPDATER +#### ------------------------------------------------------------------- + +# args: 0: type to return +sub get_defaults { + my ($type) = @_; + my %defaults = ( + 'ftp-upload' => 'ftp.smxi.org/incoming', + 'inxi-branch-1' => 'https://codeberg.org/smxi/inxi/raw/one/', + 'inxi-branch-2' => 'https://codeberg.org/smxi/inxi/raw/two/', + "$self_name-dev" => 'https://smxi.org/in/', + "$self_name-dev-ftp" => 'ftp://ftp.smxi.org/outgoing/', + "inxi-main" => 'https://codeberg.org/smxi/inxi/raw/master/', + 'pinxi-main' => 'https://codeberg.org/smxi/pinxi/raw/master/', + ); + if ($defaults{$type}){ + return $defaults{$type}; + } + else { + error_handler('bad-arg-int', $type); + } +} + +# args: 0: download url, not including file name; 1: string to print out +# 2: update type option +# note that 0 must end in / to properly construct the url path +sub update_me { + eval $start if $b_log; + my ($self_download,$download_id) = @_; + my $downloader_error=1; + my $file_contents=''; + my $output = ''; + $self_path =~ s/\/$//; # dirname sometimes ends with /, sometimes not + $self_download =~ s/\/$//; # dirname sometimes ends with /, sometimes not + my $full_self_path = "$self_path/$self_name"; + if ($b_irc){ + error_handler('not-in-irc', "-U/--update") + } + if (! -w $full_self_path){ + error_handler('not-writable', "$self_name", ''); + } + $output .= "Starting $self_name self updater.\n"; + if (!$dl{'dl'}){ + print $output; + main::error_handler('no-downloader'); + } + $output .= "Using $dl{'dl'} as downloader.\n"; + $output .= "Currently running $self_name version number: $self_version\n"; + $output .= "Current version patch number: $self_patch\n"; + $output .= "Current version release date: $self_date\n"; + $output .= "Updating $self_name in $self_path using $download_id as download source...\n"; + print $output; + $output = ''; + $self_download = "$self_download/$self_name"; + $file_contents = download_file('stdout', $self_download); + # then do the actual download + if ($file_contents){ + # make sure the whole file got downloaded and is in the variable + print "Validating downloaded data...\n"; + if ($file_contents =~ /###\*\*EOF\*\*###/){ + open(my $fh, '>', $full_self_path); + print $fh $file_contents or error_handler('write', $full_self_path, "$!"); + close $fh; + qx(chmod +x '$self_path/$self_name'); + set_version_data(); + $output .= "Successfully updated to $download_id version: $self_version\n"; + $output .= "New $download_id version patch number: $self_patch\n"; + $output .= "New $download_id version release date: $self_date\n"; + $output .= "To run the new version, just start $self_name again.\n"; + $output .= "$line3\n"; + print $output; + $output = ''; + if ($use{'man'}){ + update_man($self_download,$download_id); + } + else { + print "Skipping man download because branch version is being used.\n"; + } + exit 0; + } + else { + error_handler('file-corrupt', "$self_name"); + } + } + # now run the error handlers on any downloader failure + else { + error_handler('download-error', $self_download, $download_id); + } + eval $end if $b_log; +} + +sub update_man { + eval $start if $b_log; + my ($self_download,$download_id) = @_; + my $man_file_location = set_man_location(); + my $man_file_path = "$man_file_location/$self_name.1" ; + my ($file_contents,$man_file_url,$output,$program) = ('','','',''); + print "Starting download of man page file now.\n"; + if (! -d $man_file_location){ + print "The required man directory was not detected on your system.\n"; + print "Unable to continue: $man_file_location\n"; + return 0; + } + if (! -w $man_file_location){ + print "Cannot write to $man_file_location! Root privileges required.\n"; + print "Unable to continue: $man_file_location\n"; + return 0; + } + if (-f "/usr/share/man/man8/inxi.8.gz"){ + print "Updating man page location to man1.\n"; + rename "/usr/share/man/man8/inxi.8.gz", "$man_file_location/inxi.1.gz"; + if (check_program('mandb')){ + system('mandb'); + } + } + if (!($program = check_program('gzip'))){ + print "Required program gzip not found. Unable to install man page.\n"; + return 0; + } + # first choice is inxi.1/pinxi.1 from gh, second from smxi.org + $man_file_url = $self_download . '.1'; + print "Updating $self_name.1 in $man_file_location\n"; + print "using $download_id branch as download source\n"; + print "Downloading man page file...\n"; + print "Download URL: $man_file_url\n" if $dbg[1]; + $file_contents = download_file('stdout', $man_file_url); + if ($file_contents){ + # make sure the whole file got downloaded and is in the variable + print "Download successful. Validating downloaded man file data...\n"; + if ($file_contents =~ m|\.\\" EOF|){ + print "Contents validated. Writing to man location...\n"; + open(my $fh, '>', $man_file_path); + print $fh $file_contents or error_handler('write', $man_file_path, "$!"); + close $fh; + print "Writing successful. Compressing file...\n"; + system("$program -9 -f $man_file_path > $man_file_path.gz"); + my $err = $?; + if ($err > 0){ + print "Oh no! Something went wrong compressing the man file!\n"; + print "Error: $err\n"; + } + else { + print "Download, install, and compression of man page successful.\n"; + print "Check to make sure it works: man $self_name\n"; + } + } + else { + error_handler('file-corrupt', "$self_name.1"); + } + } + # now run the error handlers on any downloader failure + else { + error_handler('download-error', $man_file_url, $download_id); + } + eval $end if $b_log; +} + +sub set_man_location { + my $location=''; + my $default_location='/usr/share/man/man1'; + my $man_paths=qx(man --path 2>/dev/null); + my $man_local='/usr/local/share/man'; + my $b_use_local=0; + if ($man_paths && $man_paths =~ /$man_local/){ + $b_use_local=1; + } + # for distro installs + if (-f "$default_location/inxi.1.gz"){ + $location=$default_location; + } + else { + if ($b_use_local){ + if (! -d "$man_local/man1"){ + mkdir "$man_local/man1"; + } + $location="$man_local/man1"; + } + } + if (!$location){ + $location=$default_location; + } + return $location; +} + +# update for updater output version info +# note, this is only now used for self updater function so it can get +# the values from the UPDATED file, NOT the running program! +sub set_version_data { + open(my $fh, '<', "$self_path/$self_name"); + while (my $row = <$fh>){ + chomp($row); + $row =~ s/'|;//g; + if ($row =~ /^my \$self_name/){ + $self_name = (split('=', $row))[1]; + } + elsif ($row =~ /^my \$self_version/){ + $self_version = (split('=', $row))[1]; + } + elsif ($row =~ /^my \$self_date/){ + $self_date = (split('=', $row))[1]; + } + elsif ($row =~ /^my \$self_patch/){ + $self_patch = (split('=', $row))[1]; + } + elsif ($row =~ /^## END INXI INFO/){ + last; + } + } + close $fh; +} + +######################################################################## +#### OPTIONS HANDLER / VERSION +######################################################################## + +## OptionsHandler ## +{ +package OptionsHandler; +# Note: used %trigger here, but perl 5.008 had issues, so mmoved to global. +# Careful with hash globals in first Perl 5.0080. +my ($self_download,$download_id); + +sub get { + eval $start if $b_log; + $show{'short'} = 1; + Getopt::Long::GetOptions ( + 'a|admin' => sub { + $b_admin = 1;}, + 'A|audio' => sub { + $show{'short'} = 0; + $show{'audio'} = 1;}, + 'b|basic' => sub { + $show{'short'} = 0; + $show{'battery'} = 1; + $show{'cpu-basic'} = 1; + $show{'raid-basic'} = 1; + $show{'disk-total'} = 1; + $show{'graphic'} = 1; + $show{'graphic-basic'} = 1; + $show{'info'} = 1; + $show{'machine'} = 1; + $show{'network'} = 1; + $show{'system'} = 1;}, + 'B|battery' => sub { + $show{'short'} = 0; + $show{'battery'} = 1; + $show{'battery-forced'} = 1;}, + 'c|color:i' => sub { + my ($opt,$arg) = @_; + if ($arg >= 0 && $arg < main::get_color_scheme('count')){ + main::set_color_scheme($arg); + } + elsif ($arg >= 94 && $arg <= 99){ + $colors{'selector'} = $arg; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'C|cpu' => sub { + $show{'short'} = 0; + $show{'cpu'} = 1;}, + 'config|configs|configuration|configurations' => sub { + $show{'configs'} = 1;}, + 'd|disk-full|optical' => sub { + $show{'short'} = 0; + $show{'disk'} = 1; + $show{'optical'} = 1;}, + 'D|disk' => sub { + $show{'short'} = 0; + $show{'disk'} = 1;}, + 'E|bluetooth' => sub { + $show{'short'} = 0; + $show{'bluetooth'} = 1; + $show{'bluetooth-forced'} = 1;}, + 'edid' => sub { + $b_admin = 1; + $show{'short'} = 0; + $show{'edid'} = 1; + $show{'graphic'} = 1; + $show{'graphic-full'} = 1;}, + 'f|flags|flag' => sub { + $show{'short'} = 0; + $show{'cpu'} = 1; + $show{'cpu-flag'} = 1;}, + 'F|full' => sub { + $show{'short'} = 0; + $show{'audio'} = 1; + $show{'battery'} = 1; + $show{'bluetooth'} = 1; + $show{'cpu'} = 1; + $show{'disk'} = 1; + $show{'graphic'} = 1; + $show{'graphic-basic'} = 1; + $show{'graphic-full'} = 1; + $show{'info'} = 1; + $show{'machine'} = 1; + $show{'network'} = 1; + $show{'network-advanced'} = 1; + $show{'partition'} = 1; + $show{'raid'} = 1; + $show{'sensor'} = 1; + $show{'swap'} = 1; + $show{'system'} = 1;}, + 'gpu|nvidia|nv' => sub { + main::error_handler('option-removed', '--gpu/--nvidia/--nv','-Ga');}, + 'G|graphics|graphic' => sub { + $show{'short'} = 0; + $show{'graphic'} = 1; + $show{'graphic-basic'} = 1; + $show{'graphic-full'} = 1;}, + 'h|help|?' => sub { + $show{'help'} = 1;}, + 'i|ip' => sub { + $show{'short'} = 0; + $show{'ip'} = 1; + $show{'network'} = 1; + $show{'network-advanced'} = 1; + $use{'downloader'} = 1 if !main::check_program('dig');}, + 'ip-limit|limit:i' => sub { + my ($opt,$arg) = @_; + if ($arg != 0){ + $limit = $arg; + $use{'ip-limit'} = 1; + } + else { + main::error_handler('bad-arg',$opt,$arg); + }}, + 'I|info' => sub { + $show{'short'} = 0; + $show{'info'} = 1;}, + 'j|swap|swaps' => sub { + $show{'short'} = 0; + $show{'swap'} = 1;}, + 'J|usb' => sub { + $show{'short'} = 0; + $show{'usb'} = 1;}, + 'l|labels|label' => sub { + $show{'label'} = 1;}, + 'L|logical|lvm' => sub { + $show{'short'} = 0; + $show{'logical'} = 1;}, + 'm|memory' => sub { + $show{'short'} = 0; + $show{'ram'} = 1;}, + 'memory-modules|mm' => sub { + $show{'short'} = 0; + $show{'ram'} = 1; + $show{'ram-modules'} = 1;}, + 'memory-short|ms' => sub { + $show{'short'} = 0; + $show{'ram'} = 1; + $show{'ram-short'} = 1;}, + 'M|machine' => sub { + $show{'short'} = 0; + $show{'machine'} = 1;}, + 'n|network-advanced' => sub { + $show{'short'} = 0; + $show{'network'} = 1; + $show{'network-advanced'} = 1;}, + 'N|network' => sub { + $show{'short'} = 0; + $show{'network'} = 1;}, + 'o|unmounted' => sub { + $show{'short'} = 0; + $show{'unmounted'} = 1;}, + 'p|partition-full|partitions-full' => sub { + $show{'short'} = 0; + $show{'partition'} = 0; + $show{'partition-full'} = 1;}, + 'partition-sort|partitions-sort|ps:s' => sub { + my ($opt,$arg) = @_; + if ($arg =~ /^(dev-base|fs|id|label|percent-used|size|uuid|used)$/){ + $show{'partition-sort'} = $arg; + $use{'partition-sort'} = 1; + } + else { + main::error_handler('bad-arg',$opt,$arg); + }}, + 'P|partition|partitions' => sub { + $show{'short'} = 0; + $show{'partition'} = 1;}, + 'r|repos|repo' => sub { + $show{'short'} = 0; + $show{'repo'} = 1;}, + 'R|raid' => sub { + $show{'short'} = 0; + $show{'raid'} = 1; + $show{'raid-forced'} = 1;}, + 's|sensors|sensor' => sub { + $show{'short'} = 0; + $show{'sensor'} = 1;}, + 'sensors-default' => sub { + $use{'sensors-default'} = 1;}, + 'sensors-exclude:s' => sub { + my ($opt,$arg) = @_; + if ($arg){ + @sensors_exclude = split(/\s*,\s*/, $arg); + $use{'sensors-exclude'} = 1; + } + else { + main::error_handler('bad-arg',$opt,$arg); + }}, + 'sensors-use:s' => sub { + my ($opt,$arg) = @_; + if ($arg){ + @sensors_use = split(/\s*,\s*/, $arg); + $use{'sensors-use'} = 1; + } + else { + main::error_handler('bad-arg',$opt,$arg); + }}, + 'separator|sep:s' => sub { + my ($opt,$arg) = @_; + if ($arg){ + $sep{'s1-console'} = $arg; + $sep{'s2-console'} = $arg; + $sep{'s1-irc'} = $arg; + $sep{'s2-irc'} = $arg; + } + else { + main::error_handler('bad-arg',$opt,$arg); + }}, + 'sleep:s' => sub { + my ($opt,$arg) = @_; + $arg ||= 0; + if ($arg >= 0){ + $cpu_sleep = $arg; + $use{'cpu-sleep'} = 1; + } + else { + main::error_handler('bad-arg',$opt,$arg); + }}, + 'slots|slot' => sub { + $show{'short'} = 0; + $show{'slot'} = 1;}, + 'S|system' => sub { + $show{'short'} = 0; + $show{'system'} = 1;}, + 't|processes|process:s' => sub { + my ($opt,$arg) = @_; + $show{'short'} = 0; + $arg ||= 'cm'; + my $num = $arg; + $num =~ s/^[cm]+// if $num; + if ($arg =~ /^([cm]+)([0-9]+)?$/ && (!$num || $num =~ /^\d+/)){ + $show{'process'} = 1; + if ($arg =~ /c/){ + $show{'ps-cpu'} = 1; + } + if ($arg =~ /m/){ + $show{'ps-mem'} = 1; + } + $ps_count = $num if $num; + } + else { + main::error_handler('bad-arg',$opt,$arg); + }}, + 'u|uuid' => sub { + $show{'uuid'} = 1;}, + 'v|verbosity:i' => sub { + my ($opt,$arg) = @_; + $show{'short'} = 0; + if ($arg =~ /^[0-8]$/){ + if ($arg == 0){ + $show{'short'} = 1; + } + if ($arg >= 1){ + $show{'cpu-basic'} = 1; + $show{'disk-total'} = 1; + $show{'graphic'} = 1; + $show{'graphic-basic'} = 1; + $show{'info'} = 1; + $show{'system'} = 1; + } + if ($arg >= 2){ + $show{'battery'} = 1; + $show{'disk-basic'} = 1; + $show{'raid-basic'} = 1; + $show{'machine'} = 1; + $show{'network'} = 1; + } + if ($arg >= 3){ + $show{'network-advanced'} = 1; + $show{'cpu'} = 1; + $extra = 1; + } + if ($arg >= 4){ + $show{'disk'} = 1; + $show{'partition'} = 1; + } + if ($arg >= 5){ + $show{'audio'} = 1; + $show{'bluetooth'} = 1; + $show{'graphic-full'} = 1; + $show{'label'} = 1; + $show{'optical-basic'} = 1; + $show{'raid'} = 1; + $show{'ram'} = 1; + $show{'sensor'} = 1; + $show{'swap'} = 1; + $show{'uuid'} = 1; + } + if ($arg >= 6){ + $show{'optical'} = 1; + $show{'partition-full'} = 1; + $show{'unmounted'} = 1; + $show{'usb'} = 1; + $extra = 2; + } + if ($arg >= 7){ + $use{'downloader'} = 1 if !main::check_program('dig'); + $show{'battery-forced'} = 1; + $show{'bluetooth-forced'} = 1; + $show{'cpu-flag'} = 1; + $show{'ip'} = 1; + $show{'logical'} = 1; + $show{'raid-forced'} = 1; + $extra = 3; + } + if ($arg >= 8){ + $b_admin = 1; + # $use{'downloader'} = 1; # only if weather + $force{'pkg'} = 1; + $show{'edid'} = 1; + $show{'process'} = 1; + $show{'ps-cpu'} = 1; + $show{'ps-mem'} = 1; + $show{'repo'} = 1; + $show{'slot'} = 1; + # $show{'weather'} = 1; + } + } + else { + main::error_handler('bad-arg',$opt,$arg); + }}, + 'V' => sub { + main::error_handler('option-deprecated', '-V','--version/--vf'); + $show{'version'} = 1;}, + 'version|vf' => sub { + $show{'version'} = 1;}, + 'version-short|vs' => sub { + $show{'version-short'} = 1;}, + 'w|weather:s' => sub { + my ($opt,$arg) = @_; + $show{'short'} = 0; + $use{'downloader'} = 1; + if ($use{'weather'}){ + $arg =~ s/\s//g if $arg; + if ($arg){ + $show{'weather'} = 1; + $show{'weather-location'} = $arg; + } + else { + $show{'weather'} = 1; + } + } + else { + main::error_handler('distro-block', $opt); + }}, + 'W|weather-location:s' => sub { + main::error_handler('option-removed', '-W','-w/--weather [location]');}, + 'ws|weather-source:s' => sub { + my ($opt,$arg) = @_; + # let api processor handle checks if valid, this + # future proofs this + if ($arg =~ /^[1-9]$/){ + $weather_source = $arg; + $use{'weather-source'} = 1; + } + else { + main::error_handler('bad-arg',$opt,$arg); + }}, + 'weather-unit|wu:s' => sub { + my ($opt,$arg) = @_; + $arg ||= ''; + $arg =~ s/\s//g; + $arg = lc($arg) if $arg; + if ($arg && $arg =~ /^(c|f|cf|fc|i|m|im|mi)$/){ + my %units = ('c'=>'m','f'=>'i','cf'=>'mi','fc'=>'im'); + $arg = $units{$arg} if defined $units{$arg}; + $weather_unit = $arg; + $use{'weather-unit'} = 1; + } + else { + main::error_handler('bad-arg',$opt,$arg); + }}, + 'x|extra:i' => sub { + my ($opt,$arg) = @_; + if ($arg > 0){ + $extra = $arg; + } + else { + $extra++; + }}, + 'y|width:i' => sub { + my ($opt, $arg) = @_; + if (defined $arg && $arg == -1){ + $arg = 2000; + } + # note: :i creates 0 value if not supplied even though means optional + elsif (!$arg){ + $arg = 80; + } + if ($arg =~ /\d/ && ($arg == 1 || $arg >= 60)){ + $size{'max-cols-basic'} = $arg if $arg != 1; + $size{'max-cols'} = $arg; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'Y|height|less:i' => sub { + my ($opt, $arg) = @_; + main::error_handler('not-in-irc', '-Y/--height') if $b_irc; + if ($arg >= -3){ + if ($arg >= 0){ + $size{'max-lines'} = ($arg) ? $arg: $size{'term-lines'}; + } + elsif ($arg == -1) { + $use{'output-block'} = 1; + } + elsif ($arg == -2) { + $force{'colors'} = 1; + } + # unset conifiguration set max height + else { + $size{'max-lines'} = 0; + } + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'z|filter' => sub { + $use{'filter'} = 1;}, + 'filter-all|za' => sub { + $use{'filter'} = 1; + $use{'filter-label'} = 1; + $use{'filter-uuid'} = 1; + $use{'filter-vulnerabilities'} = 1;}, + 'filter-label|zl' => sub { + $use{'filter-label'} = 1;}, + 'Z|filter-override|no-filter' => sub { + $use{'filter-override'} = 1;}, + 'filter-uuid|zu' => sub { + $use{'filter-uuid'} = 1;}, + 'filter-v|filter-vulnerabilities|zv' => sub { + $use{'filter-vulnerabilities'} = 1;}, + ## Start non data options + 'alt:i' => sub { + my ($opt,$arg) = @_; + if ($arg == 40){ + $dl{'tiny'} = 0; + $use{'downloader'} = 1;} + elsif ($arg == 41){ + $dl{'curl'} = 0; + $use{'downloader'} = 1;} + elsif ($arg == 42){ + $dl{'fetch'} = 0; + $use{'downloader'} = 1;} + elsif ($arg == 43){ + $dl{'wget'} = 0; + $use{'downloader'} = 1;} + elsif ($arg == 44){ + $dl{'curl'} = 0; + $dl{'fetch'} = 0; + $dl{'wget'} = 0; + $use{'downloader'} = 1;} + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + # set --arm flag separately since android can be on different platforms + 'android' => sub { + $b_android = 1;}, + 'arm' => sub { + undef %risc; + $risc{'id'} = 'arm'; + $risc{'arm'} = 1;}, + 'bsd:s' => sub { + my ($opt,$arg) = @_; + if ($arg =~ /^(darwin|dragonfly|freebsd|openbsd|netbsd)$/i){ + $bsd_type = lc($arg); + $fake{'bsd'} = 1; + } + else { + main::error_handler('bad-arg', $opt, $arg); + } + }, + 'bt-tool:s' => sub { + my ($opt,$arg) = @_; + if ($arg =~ /^(bluetoothctl|bt-adapter|btmgmt|hciconfig|rfkill)$/i){ + $force{lc($arg)} = 1; + } + else { + main::error_handler('bad-arg', $opt, $arg); + } + }, + 'cygwin' => sub { + $windows{'cygwin'} = 1;}, + 'dbg:s' => sub { + my ($opt,$arg) = @_; + if ($arg !~ /^\d+(,\d+)*$/){ + main::error_handler('bad-arg', $opt, $arg); + } + for (split(',',$arg)){ + $dbg[$_] = 1; + }}, + 'debug:i' => sub { + my ($opt,$arg) = @_; + if ($arg =~ /^[1-3]|1[0-3]|2[0-4]$/){ + $debugger{'level'} = $arg; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'debug-arg:s' => sub { + my ($opt,$arg) = @_; + if ($arg && $arg =~ /^--?[a-z]/ig){ + $debugger{'arg'} = $arg; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'debug-arg-use:s' => sub { + my ($opt,$arg) = @_; + print "$arg\n"; + if ($arg && $arg =~ /^--?[a-z]/ig){ + $debugger{'arg-use'} = $arg; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'debug-filter|debug-z' => sub { + $debugger{'filter'} = 1 }, + 'debug-id:s' => sub { + my ($opt,$arg) = @_; + if ($arg){ + $debugger{'id'} = $arg; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'debug-no-eps' => sub { + $debugger{'no-exit'} = 1; + $debugger{'no-proc'} = 1; + $debugger{'sys'} = 0; + }, + 'debug-no-exit' => sub { + $debugger{'no-exit'} = 1 }, + 'debug-no-proc' => sub { + $debugger{'no-proc'} = 1;}, + 'debug-no-sys' => sub { + $debugger{'sys'} = 0;}, + 'debug-proc' => sub { + $debugger{'proc'} = 1;}, + 'debug-proc-print' => sub { + $debugger{'proc-print'} = 1;}, + 'debug-sys-print' => sub { + $debugger{'sys-print'} = 1;}, + 'debug-test-1' => sub { + $debugger{'test-1'} = 1;}, + 'debug-width|debug-y:i' => sub { + my ($opt,$arg) = @_; + $arg ||= 80; + if ($arg =~ /^\d+$/ && ($arg == 1 || $arg >= 80)){ + $debugger{'width'} = $arg; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'debug-zy|debug-yz:i' => sub { + my ($opt,$arg) = @_; + $arg ||= 80; + if ($arg =~ /^\d+$/ && ($arg == 1 || $arg >= 80)){ + $debugger{'width'} = $arg; + $debugger{'filter'} = 1; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'dig' => sub { + $force{'no-dig'} = 0;}, + 'display:s' => sub { + my ($opt,$arg) = @_; + if ($arg =~ /^:?([0-9\.]+)?$/){ + $display=$arg; + $display ||= ':0'; + $display = ":$display" if $display !~ /^:/; + $b_display = ($b_root) ? 0 : 1; + $force{'display'} = 1; + $display_opt = "-display $display"; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'dmi|dmidecode' => sub { + $force{'dmidecode'} = 1;}, + 'downloader:s' => sub { + my ($opt,$arg) = @_; + $arg = lc($arg); + if ($arg =~ /^(curl|fetch|ftp|perl|wget)$/){ + if ($arg eq 'perl' && (!main::check_perl_module('HTTP::Tiny') || + !main::check_perl_module('IO::Socket::SSL'))){ + main::error_handler('missing-perl-downloader', $opt, $arg); + } + elsif (!main::check_program($arg)){ + main::error_handler('missing-downloader', $opt, $arg); + } + else { + # this dumps all the other data and resets %dl for only the + # desired downloader. + $arg = main::set_perl_downloader($arg); + %dl = ('dl' => $arg, $arg => 1); + $use{'downloader'} = 1; + } + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'fake:s' => sub { + my ($opt,$arg) = @_; + if ($arg){ + my $wl = 'bluetooth|compiler|cpu|dboot|dmidecode|egl|elbrus|glx|'; + $wl .= 'iomem|ip-if|ipmi|logical|lspci|partitions|pciconf|pcictl|pcidump|'; + $wl .= 'raid-btrfs|raid-hw|raid-lvm|raid-md|raid-soft|raid-zfs|'; + $wl .= 'sensors|sensors-sys|swaymsg|sys-mem|sysctl|'; + $wl .= 'udevadm|uptime|usbconfig|usbdevs|vmstat|vulkan|wl-info|wlr-randr|'; + $wl .= 'xdpyinfo|xorg-log|xrandr'; + for (split(',',$arg)){ + if ($_ =~ /\b($wl)\b/){ + $fake{lc($1)} = 1; + } + else { + main::error_handler('bad-arg', $opt, $_); + } + } + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'fake-data-dir:s' => sub { + my ($opt,$arg) = @_; + if ($arg && -d $arg){ + $fake_data_dir = $arg; + } + else { + main::error_handler('dir-not-exist', $opt, $arg); + }}, + 'force:s' => sub { + my ($opt,$arg) = @_; + if ($arg){ + my $wl = 'bluetoothctl|bt-adapter|btmgmt|colors|cpuinfo|display|dmidecode|'; + $wl .= 'hciconfig|hddtemp|ip|ifconfig|lsusb|man|meminfo|'; + $wl .= 'no-dig|no-doas|no-html-wan|no-sudo|pkg|rfkill|rpm|sensors-sys|'; + $wl .= 'udevadm|usb-sys|vmstat|wayland|wmctrl'; + for (split(',',$arg)){ + if ($_ =~ /\b($wl)\b/){ + $force{lc($1)} = 1; + } + else { + main::error_handler('bad-arg', $opt, $_); + } + } + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'ftp:s' => sub { + my ($opt,$arg) = @_; + # pattern: ftp.x.x/x + if ($arg =~ /^ftp\..+\..+\/[^\/]+$/){ + $ftp_alt = $arg; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'hddtemp' => sub { + $force{'hddtemp'} = 1;}, + 'host|hostname' => sub { + $show{'host'} = 1; + $show{'no-host'} = 0;}, + 'html-wan' => sub { + $force{'no-html-wan'} = 0;}, + 'ifconfig' => sub { + $force{'ifconfig'} = 1;}, + 'indent:i' => sub { + my ($opt,$arg) = @_; + if ($arg >= 11){ + $size{'indent'} = $arg; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'indents:i' => sub { + my ($opt,$arg) = @_; + if ($arg >= 0 && $arg < 11){ + $size{'indents'} = $arg; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'irc' => sub { + $b_irc = 1;}, + 'man' => sub { + $use{'yes-man'} = 1;}, + 'max-wrap|wrap-max|indent-min:i' => sub { + my ($opt,$arg) = @_; + if ($arg >= 0){ + $size{'max-wrap'} = $arg; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'mips' => sub { + undef %risc; + $risc{'id'} = 'mips'; + $risc{'mips'} = 1;}, + 'no-dig' => sub { + $force{'no-dig'} = 1;}, + 'no-doas' => sub { + $force{'no-doas'} = 1;}, + 'no-host|no-hostname' => sub { + $show{'host'} = 0; + $show{'no-host'} = 1;}, + 'no-html-wan' => sub { + $force{'no-html-wan'}= 1;}, + 'no-man' => sub { + $use{'no-man'} = 0;}, + 'no-ssl' => sub { + $use{'no-ssl'} = 1;}, + 'no-sudo' => sub { + $force{'no-sudo'} = 1;}, + 'output|export:s' => sub { + my ($opt,$arg) = @_; + if ($arg =~ /^(json|screen|xml)$/){ + $output_type = $arg; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'output-file|export-file:s' => sub { + my ($opt,$arg) = @_; + if ($arg){ + if ($arg eq 'print' || main::check_output_path($arg)){ + $output_file = $arg; + } + else { + main::error_handler('output-file-bad', $opt, $arg); + } + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'pkg|rpm' => sub { + $force{'pkg'} = 1;}, + 'ppc' => sub { + undef %risc; + $risc{'id'} = 'ppc'; + $risc{'ppc'} = 1;}, + 'recommends' => sub { + $show{'recommends'} = 1;}, + 'riscv' => sub { + undef %risc; + $risc{'id'} = 'riscv'; + $risc{'riscv'} = 1;}, + 'sensors-sys' => sub { + $force{'sensors-sys'} = 1;}, + 'sparc' => sub { + undef %risc; + $risc{'id'} = 'sparc'; + $risc{'sparc'} = 1;}, + 'sys-debug' => sub { + $debugger{'sys-force'} = 1;}, + 'tty' => sub { # workaround for ansible/scripts running this + $b_irc = 0;}, + 'U|update:s' => sub { # 1,2,3,4 OR http://myserver/path/inxi + my ($opt,$arg) = @_; + process_updater($opt,$arg);}, + 'usb-sys' => sub { + $force{'usb-sys'} = 1;}, + 'usb-tool' => sub { + $force{'lsusb'} = 1;}, + 'wan-ip-url:s' => sub { + my ($opt,$arg) = @_; + if ($arg && $arg =~ /^(f|ht)tp[s]?:\/\//){ + $wan_url = $arg; + $force{'no-dig'} = 1; + } + else { + main::error_handler('bad-arg', $opt, $arg); + }}, + 'wayland|wl' => sub { + $force{'wayland'} = 1;}, + 'wm|wmctrl' => sub { + $force{'wmctrl'} = 1;}, + 'wsl' => sub { + $windows{'wsl'} = 1;}, + '<>' => sub { + my ($opt) = @_; + main::error_handler('unknown-option', "$opt", "");} + ); # or error_handler('unknown-option', "@ARGV", ''); + # run all these after so that we can change widths, downloaders, etc + post_process(); + eval $end if $b_log; +} + +# These options require other option[s] to function, and have no meaning alone. +sub check_modifiers { + if ($use{'cpu-sleep'} && !$show{'cpu'} && !$show{'cpu-basic'} && + !$show{'short'}){ + main::error_handler('arg-modifier', '--sleep', '[no-options], -b, -C, -v [>0]'); + } + if ($show{'label'} && !$show{'partition'} && !$show{'partition-full'} && + !$show{'swap'} && !$show{'unmounted'}){ + main::error_handler('arg-modifier', '-l/--label', '-j, -o, -p, -P'); + } + if ($use{'ip-limit'} && !$show{'ip'}){ + main::error_handler('arg-modifier', '--limit', '-i'); + } + if ($output_type && $output_type ne 'screen' && !$output_file){ + main::error_handler('arg-modifier', '--output', '--output-file [filename]'); + } + if ($use{'partition-sort'} && !$show{'partition'} && !$show{'partition-full'}){ + main::error_handler('arg-modifier', '--partition-sort', '-p, -P'); + } + if ($use{'sensors-default'} && !$show{'sensor'}){ + main::error_handler('arg-modifier', '--sensors-default', '-s'); + } + if ($use{'sensors-exclude'} && !$show{'sensor'}){ + main::error_handler('arg-modifier', '--sensors-exclude', '-s'); + } + if ($use{'sensors-use'} && !$show{'sensor'}){ + main::error_handler('arg-modifier', '--sensors-use', '-s'); + } + if ($show{'uuid'} && !$show{'machine'} && !$show{'partition'} && + !$show{'partition-full'} && !$show{'swap'} && !$show{'unmounted'}){ + main::error_handler('arg-modifier', '-u/--uuid', '-j, -M, -o, -p, -P'); + } + if ($use{'weather-source'} && !$show{'weather'}){ + main::error_handler('arg-modifier', '--weather-source/--ws', '-w'); + } + if ($use{'weather-unit'} && !$show{'weather'}){ + main::error_handler('arg-modifier', '--weather-unit/--wu', '-w'); + } +} + +sub post_process { + # first run all the stuff that exits after running + CheckRecommends::run() if $show{'recommends'}; + Configs::show() if $show{'configs'}; + main::show_options() if $show{'help'}; + main::show_version() if ($show{'version'} || $show{'version-short'}); + # sets for either config or arg here + if ($use{'downloader'} || $wan_url || ($force{'no-dig'} && $show{'ip'})){ + main::set_downloader(); + } + $use{'man'} = 0 if (!$use{'yes-man'} || $use{'no-man'}); + main::update_me($self_download,$download_id) if $use{'update-trigger'}; + main::set_xorg_log() if $show{'graphic'}; + set_pledge() if $b_pledge; + $extra = 3 if $b_admin; # before check_modifiers in case we make $estra based. + check_modifiers(); + # this turns off basic for F/v graphic output levels. + if ($show{'graphic-basic'} && $show{'graphic-full'} && $extra > 1){ + $show{'graphic-basic'} = 0; + } + if ($force{'rpm'}){ + $force{'pkg'} = 1; + delete $force{'rpm'}; + } + if ($use{'sensors-default'}){ + @sensors_exclude = (); + @sensors_use = (); + } + if ($show{'short'} || $show{'disk'} || $show{'disk-basic'} || $show{'disk-total'} || + $show{'logical'} || $show{'partition'} || $show{'partition-full'} || $show{'raid'} || + $show{'unmounted'}){ + $use{'block-tool'} = 1; + } + if ($show{'short'} || $show{'raid'} || $show{'disk'} || $show{'disk-total'} || + $show{'disk-basic'} || $show{'unmounted'}){ + $use{'btrfs'} = 1; + $use{'mdadm'} = 1; + } + if ($b_admin && $show{'disk'}){ + $use{'smartctl'} = 1; + } + # triggers may extend to -D, -pP + if ($show{'short'} || $show{'logical'} || $show{'raid'} || $show{'disk'} || + $show{'disk-total'} || $show{'disk-basic'} || $show{'unmounted'}){ + $use{'logical'} = 1; + } + main::set_sudo() if ($show{'unmounted'} || ($extra > 0 && $show{'disk'})); + if ($use{'filter-override'}){ + $use{'filter'} = 0; + $use{'filter-label'} = 0; + $use{'filter-uuid'} = 0; + $use{'filter-vulnerabilities'} = 0; + } + # override for things like -b or -v2 to -v3 + $show{'cpu-basic'} = 0 if $show{'cpu'}; + $show{'optical-basic'} = 0 if $show{'optical'}; + $show{'partition'} = 0 if $show{'partition-full'}; + $show{'host'} = 0 if $show{'no-host'}; + $show{'host'} = 1 if ($show{'host'} || (!$use{'filter'} && !$show{'no-host'})); + if ($show{'disk'} || $show{'optical'}){ + $show{'disk-basic'} = 0; + $show{'disk-total'} = 0; + } + if ($show{'ram'} || $show{'slot'} || + ($show{'cpu'} && ($extra > 1 || $bsd_type)) || + (($bsd_type || $force{'dmidecode'}) && ($show{'machine'} || $show{'battery'}))){ + $use{'dmidecode'} = 1; + } + if (!$bsd_type && ($show{'ram'})){ + $use{'udevadm'} = 1; + } + if ($show{'audio'} || $show{'bluetooth'} || $show{'graphic'} || + $show{'network'} || $show{'raid'}){ + $use{'pci'} = 1; + } + if ($show{'usb'} || $show{'audio'} || $show{'bluetooth'} || $show{'disk'} || + $show{'graphic'} || $show{'network'}){ + $use{'usb'} = 1; + } + if ($bsd_type){ + if ($show{'audio'}){ + $use{'bsd-audio'} = 1;} + if ($show{'battery'}){ + $use{'bsd-battery'} = 1;} + if ($show{'short'} || $show{'cpu-basic'} || $show{'cpu'}){ + $use{'bsd-cpu'} = 1; + $use{'bsd-sleep'} = 1;} + if ($show{'short'} || $show{'disk-basic'} || $show{'disk-total'} || + $show{'disk'} || $show{'partition'} || $show{'partition-full'} || + $show{'raid'} || $show{'swap'} || $show{'unmounted'}){ + $use{'bsd-disk'} = 1; + $use{'bsd-partition'} = 1; + $use{'bsd-raid'} = 1;} + if ($show{'system'}){ + $use{'bsd-kernel'} = 1;} + if ($show{'machine'}){ + $use{'bsd-machine'} = 1;} + if ($show{'short'} || $show{'info'} || $show{'ps-mem'} || $show{'ram'}){ + $use{'bsd-memory'} = 1;} + if ($show{'optical-basic'} || $show{'optical'}){ + $use{'bsd-optical'} = 1;} + # strictly only used to fill in pci drivers if tool doesn't support that + if ($use{'pci'}){ + $use{'bsd-pci'} = 1;} + if ($show{'raid'}){ + $use{'bsd-raid'} = 1;} + if ($show{'ram'}){ + $use{'bsd-ram'} = 1;} + if ($show{'sensor'}){ + $use{'bsd-sensor'} = 1;} + # always use this, it's too core + $use{'sysctl'} = 1; + } +} + +sub process_updater { + my ($opt,$arg) = @_; + $use{'downloader'} = 1; + if ($use{'update'}){ + $use{'update-trigger'} = 1; + if (!$arg){ + $use{'man'} = 1; + $download_id = "$self_name main branch"; + $self_download = main::get_defaults("$self_name-main"); + } + elsif ($arg && $arg eq '3'){ + $use{'man'} = 1; + $download_id = 'dev server'; + $self_download = main::get_defaults("$self_name-dev"); + } + elsif ($arg && $arg eq '4'){ + $use{'man'} = 1; + $use{'ftp-download'} = 1; + $download_id = 'dev server ftp'; + $self_download = main::get_defaults("$self_name-dev-ftp"); + } + elsif ($arg =~ /^[12]$/){ + if ($self_name eq 'inxi'){ + $download_id = "branch $arg"; + $self_download = main::get_defaults("inxi-branch-$arg"); + } + else { + main::error_handler('bad-arg', $opt, $arg); + } + } + elsif ($arg =~ /^(ftp|https?):/){ + $download_id = 'alt server'; + $self_download = $arg; + } + if ($self_download && $self_name eq 'inxi'){ + $use{'man'} = 1; + $use{'yes-man'} = 1; + } + if (!$self_download){ + main::error_handler('bad-arg', $opt, $arg); + } + } + else { + main::error_handler('distro-block', $opt); + } +} + +sub set_pledge { + my $b_update; + # if -c 9x, remove in SelectColors::set_selection(), else remove here + if (!$colors{'selector'} && $debugger{'level'} < 21){ + @pledges = grep {$_ ne 'getpw'} @pledges; + $b_update = 1; + } + if ($debugger{'level'} < 21){ # remove ftp upload + @pledges = grep {!/(dns|inet)/} @pledges; + $b_update = 1; + } + # not writing/creating .inxi data dirs colors selector launches set_color() + if (!$show{'weather'} && !$colors{'selector'} && $debugger{'level'} < 10 && + $output_type eq 'screen'){ + @pledges = grep {!/(cpath|wpath)/} @pledges; + $b_update = 1; + } + OpenBSD::Pledge::pledge(@pledges) if $b_update; +} +} + +sub show_options { + error_handler('not-in-irc', 'help') if $b_irc; + my $rows = []; + my $line = make_line(); + my $color_scheme_count = get_color_scheme('count') - 1; + my $partition_string='partition'; + my $partition_string_u='Partition'; + my $flags = (%risc || $bsd_type) ? 'features' : 'flags' ; + if ($bsd_type){ + $partition_string='slice'; + $partition_string_u='Slice'; + } + # fit the line to the screen! + push(@$rows, + ['0', '', '', "$self_name supports the following options. For more detailed + information, see man^$self_name. If you start $self_name with no arguments, + it will display a short system summary."], + ['0', '', '', ''], + ['0', '', '', "You can use these options alone or together, + to show or add the item(s) you want to see: A, B, C, d, D, E, f, G, i, I, j, + J, l, L, m, M, n, N, o, p, P, r, R, s, S, t, u, w, --edid, --mm, --ms, + --slots. If you use them with -v [level], -b or -F, $self_name will add the + requested lines to the output."], + ['0', '', '', '' ], + ['0', '', '', "Examples:^$self_name^-v4^-c6 OR $self_name^-bDc^6 OR + $self_name^-FzjJxy^80"], + ['0', '', '', $line ], + ['0', '', '', "See Filter Options for output filtering, Output Control Options + for colors, sizing, output changes, Extra Data Options to extend Main output, + Additional Options and Advanced Options for less common situations."], + ['0', '', '', $line ], + ['0', '', '', "Main Feature Options:"], + ['1', '-A', '--audio', "Audio/sound devices(s), driver; active sound APIs and + servers."], + ['1', '-b', '--basic', "Basic output, short form. Same as $self_name^-v^2."], + ['1', '-B', '--battery', "System battery info, including charge, condition + voltage (if critical), plus extra info (if battery present/detected)."], + ['1', '-C', '--cpu', "CPU output (if each item available): basic topology, + model, type (see man for types), cache, average CPU speed, min/max speeds, + per core clock speeds."], + ['1', '-d', '--disk-full, --optical', "Optical drive data (and floppy disks, + if present). Triggers -D."], + ['1', '-D', '--disk', "Hard Disk info, including total storage and details + for each disk. Disk total used percentage includes swap ${partition_string} + size(s)."], + ['1', '-E', '--bluetooth', "Show bluetooth device data and report, if + available. Shows state, address, IDs, version info."], + ['1', '', '--edid', "Full graphics data, triggers -a, -G. Add monitor chroma, + full modelines (if > 2), EDID errors and warnings, if present."], + ['1', '-f', '--flags', "All CPU $flags. Triggers -C. Not shown with -F to + avoid spamming."], + ['1', '-F', '--full', "Full output. Includes all Upper Case line letters + (except -J, -W) plus --swap, -s and -n. Does not show extra verbose options + such as -d -f -i -J -l -m -o -p -r -t -u -x, unless specified."], + ['1', '-G', '--graphics', "Graphics info (devices(s), drivers, display + protocol (if available), display server/Wayland compositor, resolution, X.org: + renderer, basic EGL, OpenGL, Vulkan API data; Xvesa API: VBE info."], + ['1', '-i', '--ip', "WAN IP address and local interfaces (requires ifconfig + or ip network tool). Triggers -n. Not shown with -F for user security reasons. + You shouldn't paste your local/WAN IP."], + ['1', '', '--ip-limit, --limit', "[-1; 1-x] Set max output limit of IP + addresses for -i (default 10; -1 removes limit)."], + ['1', '-I', '--info', "General info, including processes, uptime, memory (if + -m/-tm not used), IRC client or shell type, $self_name version."], + ['1', '-j', '--swap', "Swap in use. Includes ${partition_string}s, zram, + file."], + ['1', '-J', '--usb', "Show USB data: Hubs and Devices."], + ['1', '-l', '--label', "$partition_string_u labels. Use with -j, -o, -p, -P."], + ['1', '-L', '--logical', "Logical devices, LVM (VG, LV), + LUKS, Crypto, bcache, etc. Shows components/devices, sizes, etc."], + ['1', '-m', '--memory', "Memory (RAM) data. Numbers of devices (slots) + supported and individual memory devices (sticks of memory etc). For devices, + shows device locator, type (e.g. DDR3), size, speed. Also shows System RAM + report, and removes Memory report from -I or -tm."], + ['1', '', '--memory-modules,--mm', "Memory (RAM) data. Exclude empty module slots."], + ['1', '', '--memory-short,--ms', "Memory (RAM) data. Show only short Memory RAM + report, number of arrays, slots, modules, and RAM type."], + ['1', '-M', '--machine', "Machine data. Device type (desktop, server, laptop, + VM etc.), motherboard, BIOS and, if present, system builder (e.g. Lenovo). + Shows UEFI/BIOS/UEFI [Legacy]. Older systems/kernels without the required /sys + data can use dmidecode instead, run as root. Dmidecode can be forced with + --dmidecode"], + ['1', '-n', '--network-advanced', "Advanced Network device info. Triggers -N. + Shows interface, speed, MAC id, state, etc. "], + ['1', '-N', '--network', "Network device(s), driver."], + ['1', '-o', '--unmounted', "Unmounted $partition_string info (includes UUID + and Label if available). Shows file system type if you have lsblk installed + (Linux) or, for BSD/GNU Linux, if 'file' installed and you are root or if + you have added to /etc/sudoers (sudo v. 1.7 or newer)(or try doas)."], + ['1', '', '', "Example: ^^ALL^=^NOPASSWD:^/usr/bin/file^"], + ['1', '-p', '--partitions-full', "Full $partition_string information (-P plus + all other detected ${partition_string}s)."], + ['1', '', '--partitions-sort, --ps', " + [dev-base|fs|id|label|percent-used|size|uuid|used] Change sort order of + ${partition_string} output. See man page for specifics."], + ['1', '-P', '--partitions', "Basic $partition_string info. Shows, if detected: + / /boot /home /opt /tmp /usr /usr/home /var /var/log /var/tmp. Swap + ${partition_string}s show if --swap is not used. Use -p to see all + mounted ${partition_string}s."], + ['1', '-r', '--repos', "Distro repository data. Supported repo types: APK, + APT, CARDS, EOPKG, NETPKG, NIX, PACMAN, PACMAN-G2, PISI, PKG (BSDs), PORTAGE, + PORTS (BSDs), SBOPKG, SBOUI, SCRATCHPKG, SLACKPKG, SLAPT_GET, SLPKG, + T2-EMERGE, TCE, TAZPKG, URPM, XBPS, YUM/ZYPP."], + ['1', '-R', '--raid', "RAID data. Shows RAID devices, states, levels, array + sizes, and components. md-raid: If device is resyncing, also shows resync + progress line."], + ['1', '-s', '--sensors', "Sensors output (if sensors installed/configured): + mobo/CPU/GPU temp; detected fan speeds. Nvidia shows screen number for > 1 + screen. IPMI sensors if present."], + ['1', '', '--slots', "PCI slots: type, speed, status. Requires root."], + ['1', '-S', '--system', "System info: host name, kernel, desktop environment + (if in X/Wayland), distro."], + ['1', '-t', '--processes', "Processes. Requires extra options: c (CPU), m + (memory), cm (CPU+memory). If followed by numbers 1-x, shows that number + of processes for each type (default: 5; if in IRC, max: 5). "], + ['1', '', '', "Make sure that there is no space between letters and + numbers (e.g.^-t^cm10)."], + ['1', '-u', '--uuid', "$partition_string_u, system board UUIDs. Use with -j, + -M, -o, -p, -P."], + ['1', '-v', '--verbosity', "Set $self_name verbosity level (0-8). + Should not be used with -b or -F. Example: $self_name^-v^4"], + ['2', '0', '', "Same as: $self_name"], + ['2', '1', '', "Basic verbose, -S + basic CPU + -G + basic Disk + -I."], + ['2', '2', '', "Networking device (-N), Machine (-M), Battery (-B; if + present), and, if present, basic RAID (devices only; notes if inactive). Same + as $self_name^-b"], + ['2', '3', '', "Advanced CPU (-C), battery (-B), network (-n); + triggers -x. "], + ['2', '4', '', "$partition_string_u size/used data (-P) for + (if present) /, /home, /var/, /boot. Shows full disk data (-D). "], + ['2', '5', '', "Audio device (-A), sensors (-s), memory/RAM (-m), + bluetooth (if present), $partition_string label^(-l), full swap (-j), + UUID^(-u), short form of optical drives, RAID data (if present)."], + ['2', '6', '', "Full $partition_string (-p), + unmounted $partition_string (-o), optical drive (-d), USB (-J), + full RAID; triggers -xx."], + ['2', '7', '', "Network IP data (-i), bluetooth, logical (-L), + RAID forced, full CPU $flags; triggers -xxx."], + ['2', '8', '', "Everything available, including advanced gpu EDID (--edid) + data, repos (-r), processes (-tcm), PCI slots (--slots); triggers + admin (-a)."], + ); + # if distro maintainers don't want the weather feature disable it + if ($use{'weather'}){ + push(@$rows, + ['1', '-w', '--weather', "NO^AUTOMATED^QUERIES^OR^EXCESSIVE^USE^ALLOWED!"], + ['1', '', '', "Without [location]: Your current local (local to + your IP address) weather data/time.Example:^$self_name^-w"], + ['1', '', '', "With [location]: Supported location options are: + postal code[,country/country code]; city, state (USA)/country + (country/two character country code); latitude, longitude. Only use if you + want the weather somewhere other than the machine running $self_name. Use + only ASCII characters, replace spaces in city/state/country names with '+'. + Example:^$self_name^-w^[new+york,ny^london,gb^madrid,es]"], + ['1', '', '--weather-source,--ws', "[1-9] Change weather data source. 1-4 + generally active, 5-9 check. See man."], + ['1', '', '--weather-unit,--wu', "Set weather units to metric (m), imperial + (i), metric/imperial (mi), or imperial/metric (im)."], + ); + } + push(@$rows, + [0, '', '', "$line"], + ['0', '', '', "Filter Options:"], + ['1', '', '--host', "Turn on hostname for -S. Overrides -z."], + ['1', '', '--no-host', "Turn off hostname for -S. Useful if showing output + from servers etc. Activated by -z as well."], + ['1', '-z', '--filter', "Adds security filters for IP/MAC addresses, serial + numbers, location (-w), user home directory name, host name. Default on for + IRC clients."], + ['1', '', '--za,--filter-all', "Shortcut, triggers -z, --zl, --zu, --zv."], + ['1', '', '--zl,--filter-label', "Filters out ${partition_string} labels in + -j, -o, -p, -P, -Sa."], + ['1', '', '--zu,--filter-uuid', "Filters out ${partition_string} UUIDs in -j, + -o, -p, -P, -Sa, board UUIDs in -Mxxx."], + ['1', '', '--zv,--filter-vulnerabilities', "Filters out Vulnerabilities + report in -Ca."], + ['1', '-Z', '--no-filter', "Disable output filters. Useful for debugging + networking issues in IRC, or you needed to use --tty, for example."], + [0, '', '', "$line"], + ['0', '', '', "Output Control Options:"], + ['1', '-c', '--color', "Set color scheme (0-42). For piped or redirected + output, you must use an explicit color selector. Example:^$self_name^-c^11"], + ['1', '', '', "Color selectors let you set the config file value for the + selection (NOTE: IRC and global only show safe color set)"], + ['2', '94', '', "Console, out of X"], + ['2', '95', '', "Terminal, running in X - like xTerm"], + ['2', '96', '', "Gui IRC, running in X - like Xchat, Quassel, Konversation + etc."], + ['2', '97', '', "Console IRC running in X - like irssi in xTerm"], + ['2', '98', '', "Console IRC not in X"], + ['2', '99', '', "Global - Overrides/removes all settings. Setting specific + removes global."], + ['1', '', '--indent', "[11-20] Change default wide mode primary indentation + width."], + ['1', '', '--indents', "[0-10] Change wrapped mode primary indentation width, + and secondary / -y1 indent widths."], + ['1', '', '--max-wrap,--wrap-max', "[70-xxx] Set maximum width where + $self_name autowraps line starters. Current: $size{'max-wrap'}"], + ['1', '', '--output', "[json|screen|xml] Change data output type. Requires + --output-file if not screen."], + ['1', '', '--output-file', "[Full filepath|print] Output file to be used for + --output."], + ['1', '', '--separator, --sep', "[key:value separator character]. Change + separator character(s) for key: value pairs."], + ['1', '-y', '--width', "[empty|-1|1|60-xxx] Output line width max. Overrides + IRC/Terminal settings or actual widths. If no integer give, defaults to 80. + -1 removes line lengths. 1 switches output to 1 key/value pair per line. + Example:^inxi^-y^130"], + ['1', '-Y', '--height', "[empty|-3-xxx] Output height control. Similar to + 'less' command except colors preserved, defaults to console/terminal height. + -1 shows 1 primary Item: at a time; -2 retains color on redirect/piping (to + less -R); -3 removes configuration value; 0 or -Y sets to detected terminal + height. Greater than 0 shows x lines at a time."], + ['0', '', '', "$line"], + ['0', '', '', "Extra Data Options:"], + ['1', '-x', '--extra', "Adds the following extra data (only works with + verbose or line output, not short form):"], + ['2', '-A', '', "Specific vendor/product information (if relevant); + PCI/USB ID of device; Version/port(s)/driver version (if available); + inactive sound servers/APIs."], + ['2', '-B', '', "Current/minimum voltage, vendor/model, status (if available); + attached devices (e.g. wireless mouse, keyboard, if present)."], + ['2', '-C', '', "L1/L3 cache (if most Linux, or if root and dmidecode + installed); smt if disabled, CPU $flags (short list, use -f to see full list); + Highest core speed (if > 1 core); CPU boost (turbo) enabled/disabled, if + present; Bogomips on CPU; CPU microarchitecture + revision (if found, or + unless --admin, then shows as 'stepping')."], + ['2', '-d', '', "Extra optical drive features data; adds rev version to + optical drive."], + ['2', '-D', '', "HDD temp with disk data. Kernels >= 5.6: enable module + drivetemp if not enabled. Older systems require hddtemp, run as + as superuser, or as user if you have added hddtemp to /etc/sudoers + (sudo v. 1.7 or newer)(or try doas). + Example:^^ALL^=^NOPASSWD:^/usr/sbin/hddtemp"], + ['2', '-E', '', "PCI/USB Bus ID of device, driver version, + LMP version."], + ['2', '-G', '', "GPU arch (AMD/Intel/Nvidia only); Specific vendor/product + information (if relevant); PCI/USB ID of device; Screen number GPU is running + on (Nvidia only); device temp (Linux, if found); APIs: EGL: active/inactive + platforms; OpenGL: direct rendering status (in X); Vulkan device counts."], + ['2', '-i', '', "For IPv6, show additional scope addresses: Global, Site, + Temporary, Unknown. See --limit for large counts of IP addresses."], + ['2', '-I', '', "Default system compilers. With -xx, also shows other + installed compiler versions. If running in shell, not in IRC client, shows + shell version number, if detected. Init/RC type and runlevel/target (if + available). Total count of all packages discovered in system (if not -r)."], + ['2', '-j', '', "Add mapped: name if partition mapped."], + ['2', '-J', '', "For Device: driver; Si speed (base 10, bits/s)."], + ['2', '-L', '', "For VG > LV, and other Devices, dm:"], + ['2', '-m,--mm', '', "Max memory module size (if available)."], + ['2', '-N', '', "Specific vendor/product information (if relevant); + PCI/USB ID of device; Version/port(s)/driver version (if available); device + temperature (Linux, if found)."], + ['2', '-o,-p,-P', '', "Add mapped: name if partition mapped."], + ['2', '-r', '', "Packages, see -Ix."], + ['2', '-R', '', "md-raid: second RAID Info line with extra data: + blocks, chunk size, bitmap (if present). Resync line, shows blocks + synced/total blocks. Hardware RAID driver version, bus-ID."], + ['2', '-s', '', "Basic voltages (ipmi, lm-sensors if present): 12v, 5v, 3.3v, + vbat."], + ['2', '-S', '', "Kernel gcc version; system base of distro (if relevant + and detected)"], + ['2', '', '--slots', "Adds BusID for slot."], + ['2', '-t', '', "Adds memory use output to CPU (-xt c), and CPU use to + memory (-xt m)."], + ); + if ($use{'weather'}){ + push(@$rows, + ['2', '-w', '', "Wind speed and direction, humidity, pressure, and time + zone, if available."]); + } + push(@$rows, + ['0', '', '', ''], + ['1', '-xx', '--extra 2', "Show extra, extra data (only works with verbose + or line output, not short form):"], + ['2', '-A', '', "Chip vendor:product ID for each audio device; PCIe speed, + lanes (if found); USB rev, speed, lanes (if found); sound server/api helper + daemons/plugins."], + ['2', '-B', '', "Power used, in watts; serial number."], + ['2', '-D', '', "Disk transfer speed; NVMe lanes; USB rev, speed, lanes (if + found); Disk serial number; LVM volume group free space (if available); disk + duid (some BSDs)."], + ['2', '-E', '', "Chip vendor:product ID, LMP subversion; PCIe speed, lanes + (if found); USB rev, speed, lanes (if found)."], + ['2', '-G', '', "Chip vendor:product ID for each video device; Output ports, + used and empty; PCIe speed, lanes (if found); USB rev, speed, lanes (if + found); Xorg: Xorg compositor; alternate Xorg drivers (if available. Alternate + means driver is on automatic driver check list of Xorg for the device vendor, + but is not installed on system); Xorg Screen data: ID, s-res, dpi; Monitors: + ID, position (if > 1), resolution, dpi, model, diagonal; APIs: EGL: per + platform report; OpenGL: ES version, device-ID, display-ID (if not found in + Display line); Vulkan: per device report."], + ['2', '-I', '', "Adds Power: with children uptime, wakeups (from suspend); + other detected installed gcc versions (if present). System default + target/runlevel. Adds parent program (or pty/tty) for shell info if not in + IRC. Adds Init version number, RC (if found). Adds per package manager + installed package counts (if not -r)."], + ['2', '-j,-p,-P', '', "Swap priority."], + ['2', '-J', '', "Vendor:chip-ID; lanes (Linux only)."], + ['2', '-L', '', "Show internal LVM volumes, like raid image/meta volumes; + for LVM RAID, adds RAID report line (if not -R); show all components > + devices, number of 'c' or 'p' indicate depth of device."], + ['2', '-m,--mm', '', "Manufacturer, part number; single/double + bank (if found); memory array voltage (legacy, rare); module voltage (if + available)."], + ['2', '-M', '', "Chassis info, part number, BIOS ROM size (dmidecode only), + if available."], + ['2', '-N', '', "Chip vendor:product ID; PCIe speed, lanes (if found); USB + rev, speed, lanes (if found)."], + ['2', '-r', '', "Packages, see -Ixx."], + ['2', '-R', '', "md-raid: Superblock (if present), algorithm. If resync, + shows progress bar. Hardware RAID Chip vendor:product ID."], + ['2', '-s', '', "DIMM/SOC voltages (ipmi only)."], + ['2', '-S', '', "Desktop toolkit (tk), if available (only some DE/wm + supported); window manager (wm); display/Login manager (dm,lm) (e.g. kdm, + gdm3, lightdm, greetd, seatd)."], + ['2', '--slots', '', "Slot length; slot voltage, if available."], + ); + if ($use{'weather'}){ + push(@$rows, + ['2', '-w', '', "Snow, rain, precipitation, (last observed hour), cloud + cover, wind chill, dew point, heat index, if available."] + ); + } + push(@$rows, + ['0', '', '', ''], + ['1', '-xxx', '--extra 3', "Show extra, extra, extra data (only works + with verbose or line output, not short form):"], + ['2', '-A', '', "Serial number, class ID."], + ['2', '-B', '', "Chemistry, cycles, location (if available)."], + ['2', '-C', '', "CPU voltage, external clock speed (if root and dmidecode + installed); smt status, if available."], + ['2', '-D', '', "Firmware rev. if available; partition scheme, in some cases; + disk type, rotation rpm (if available)."], + ['2', '-E', '', "Serial number, class ID, bluetooth device class ID, HCI + version and revision."], + ['2', '-G', '', "Device serial number, class ID; Xorg Screen size, diag; + Monitors: hz, size, modes, serial, scale, modes (max/min); APIs: EGL: hardware + driver info; Vulkan: layer count, device hardware vendor."], + ['2', '-I', '', "For Power:, adds states, suspend/hibernate active type; + For 'Shell:' adds ([doas|su|sudo|login]) to shell name if present; adds + default shell+version if different; for 'running in:' adds (SSH) if SSH + session."], + ['2', '-J', '', "If present: Devices: serial number, interface count, max + power."], + ['2', '-m,--mm', '', "Width of memory bus, data and total (if + present and greater than data); Detail for Type, if present; module current, + min, max voltages (if present and different from each other); serial number."], + ['2', '-M', '', "Board/Chassis UUID, if available."], + ['2', '-N', '', "Serial number, class ID."], + ['2', '-R', '', "zfs-raid: portion allocated (used) by RAID devices/arrays. + md-raid: system md-raid support types (kernel support, read ahead, RAID + events). Hardware RAID rev, ports, specific vendor/product information."], + ['2', '-S', '', "Kernel clocksource; if in non console wm/desktop; window + manager version number; if available: panel/tray/bar/dock (with:); + screensavers/lockers running (tools:); virtual terminal number; + display/login manager version number."], + ); + if ($use{'weather'}){ + push(@$rows, + ['2', '-w', '', "Location (uses -z/irc filter), weather observation time, + altitude, sunrise/sunset, if available."] + ); + } + push(@$rows, + ['0', '', '', ''], + ['1', '-a', '--admin', "Adds advanced sys admin data (only works with + verbose or line output, not short form); check man page for explanations!; + also sets --extra=3:"], + ['2', '-A', '', "If available: list of alternate kernel modules/drivers + for device(s); PCIe lanes-max: gen, speed, lanes (if relevant); USB mode (if + found); list of installed tools for servers."], + ['2', '-C', '', "If available: microarchitecture level (64 bit AMD/Intel + only).CPU generation, process node, built years; CPU socket type, base/boost + speeds (dmidecode+root/sudo/doas required); Full topology line, with dies, + clusters, cores, threads, threads per core, granular cache data, smt status; + CPU vulnerabilities (bugs); family, model-id, stepping - format: hex (decimal) + if greater than 9; microcode format: hex."], + ['2', '-d,-D', '', "If available: logical and physical block sizes; drive + family; maj:min; USB mode (if found); USB drive specifics; SMART report."], + ['2', '-E', '', "PCIe lanes-max: gen, speed, lanes (if relevant); USB mode + (if found); If available: in Report:, adds status: discoverable, pairing; + adds Info: line: acl-mtu, sco-mtu, link-policy, link-mode, service-classes."], + ['2', '-G', '', "GPU process node, built year (AMD/Intel/Nvidia only); + non-free driver info (Nvidia only); PCIe lanes-max: gen, speed, lanes (if + relevant); USB mode (if found); list of alternate kernel modules/drivers for + device(s) (if available); Monitor built year, gamma, screen ratio (if + available); APIs: OpenGL: device memory, unified memory status; Vulkan: adds + full device report, device name, driver version, surfaces."], + ['2', '-I', '', "Adds to Power suspend/hibernate available non active states, + hibernate image size, suspend failed totals (if not 0), active power services; + Packages total number of lib files found for each package manager and pm tools + (if not -r); adds init service tool."], + ['2', '-j,-p,-P', '', "For swap (if available): swappiness and vfs cache + pressure, and if values are default or not."], + ['2', '-j', '', "Linux only: (if available): row one zswap data, and per zram + row, active and available zram compressions, max compression streams."], + ['2', '-J', '', "Adds USB mode (Linux only); IEC speed (base 2, Bytes/s)."], + ['2', '-L', '', "LV, Crypto, devices, components: add maj:min; show + full device/components report (speed, mapped names)."], + ['2', '-m', '', "Show full volts report, current, min, max, even if + identical; show firmware version (if available)."], + ['2', '-n,-i', '', "Info: services: line, with running network services."], + ['2', '-n,-N,-i', '', "If available: list of alternate kernel modules/drivers + for device(s); PCIe lanes-max: gen, speed, lanes (if relevant); USB mode (if + found)."], + ['2', '-o', '', "If available: maj:min of device."], + ['2', '-p,-P', '', "If available: raw size of ${partition_string}s, maj:min, + percent available for user, block size of file system (root required)."], + ['2', '-r', '', "Packages, see -Ia."], + ['2', '-R', '', "mdraid: device maj:min; per component: size, maj:min, state."], + ['2', '-S', '', "If available: kernel alternate clocksources, boot parameters; + de extra data (info: eg kde frameworks); screensaver/locker tools available + but not active (avail:)."], + ['2', '--slots', '', "If available: slot bus ID children."], + ); + push(@$rows, + [0, '', '', "$line"], + [0, '', '', "Additional Options:"], + ['1', '--config', '--configuration', "Show active configurations, by file(s). + Last item listed overrides previous."], + ['1', '-h', '--help', "This help menu."], + ['1', '', '--recommends', "Checks $self_name application dependencies + + recommends, and directories, then shows what package(s) you need to install + to add support for that feature."], + ); + if ($use{'update'}){ + push(@$rows, + ['1', '-U', '--update', "Auto-update $self_name. Will also install/update + man page. Note: if you installed as root, you must be root to update, + otherwise user is fine. Man page installs require root. No arguments + downloads from main $self_name git repo."], + ['1', '', '', "Use alternate sources for updating $self_name"], + ['2', '3', '', "Get the dev server (smxi.org) version."], + ['2', '4', '', "Get the dev server (smxi.org) FTP version. Use if SSL issues + and --no-ssl doesn't work."], + ['2', '[http|https|ftp]', '', "Get a version of $self_name from your own + server. Use the full download path, e.g. + ^$self_name^-U^https://myserver.com/inxi"], + ); + } + push(@$rows, + ['1', '', '--version, --vf', "Prints full $self_name version info then exits."], + ['1', '', '--version-short,--vs', "Prints 1 line $self_name version info. Can + be used with other line options."], + ['0', '', '', "$line"], + ['0', '', '', "Advanced Options:"], + ['1', '', '--alt', "Trigger for various advanced options:"], + ['2', '40', '', "Bypass Perl as a downloader option."], + ['2', '41', '', "Bypass Curl as a downloader option."], + ['2', '42', '', "Bypass Fetch as a downloader option."], + ['2', '43', '', "Bypass Wget as a downloader option."], + ['2', '44', '', "Bypass Curl, Fetch, and Wget as downloader options. Forces + Perl if HTTP::Tiny present."], + ['1', '', '--bt-tool', "[bt-adapter btmgmt hciconfig rfkill] Force use of + given tool for bluetooth report. Or use --force [tool]."], + ['1', '', '--dig', "Overrides configuration item NO_DIG (resets to default)."], + ['1', '', '--display', "[:[0-9]] Try to get display data out of X (default: + display 0)."], + ['1', '', '--dmidecode', "Force use of dmidecode data instead of /sys where + relevant + (e.g. -M, -B)."], + ['1', '', '--downloader', "Force $self_name to use [curl fetch perl wget] for + downloads."], + ['1', '', '--force', "[bt-adapter btmgmt dmidecode hciconfig hddtemp ip + ifconfig lsusb meminfo rfkill usb-sys vmstat wmctrl]. + 1 or more in comma separated list. Force use of item(s). + See --hddtemp, --dmidecode, --wm, --usb-tool, --usb-sys."], + ['1', '', '--hddtemp', "Force use of hddtemp for disk temps."], + ['1', '', '--html-wan', "Overrides configuration item NO_HTML_WAN (resets to + default)."], + ['1', '', '--ifconfig', "Force use of ifconfig for IF with -i."], + ); + if ($use{'update'}){ + push(@$rows, + ['1', '', '--man', "Install correct man version for dev branch (-U 3) or + pinxi using -U."], + ); + } + push(@$rows, + ['1', '', '--no-dig', "Skip dig for WAN IP checks, use downloader program."], + ['1', '', '--no-doas', "Skip internal program use of doas features (not + related to starting $self_name with doas)."], + ['1', '', '--no-html-wan', "Skip HTML IP sources for WAN IP checks, use dig + only, or nothing if --no-dig."], + ); + if ($use{'update'}){ + push(@$rows, + ['1', '', '--no-man', "Disable man install for all -U update actions."], + ); + } + push(@$rows, + ['1', '', '--no-ssl', "Skip SSL certificate checks for all downloader actions + (Wget/Fetch/Curl/Perl-HTTP::Tiny)."], + ['1', '', '--no-sudo', "Skip internal program use of sudo features (not + related to starting $self_name with sudo)."], + ['1', '', '--rpm', "Force use of disabled package manager counts for packages + feature with -rx/-Ix. RPM disabled by default due to unacceptably slow rpm + package count query times."], + ['1', '', '--sensors-default', "Removes configuration item SENSORS_USE and + SENSORS_EXCLUDE. Same as default behavior."], + ['1', '', '--sensors-exclude', "[sensor[s] name, comma separated] Exclude + supplied sensor array[s] for -s output (lm-sensors, /sys. Linux only)."], + ['1', '', '--sensors-use', "[sensor[s] name, comma separated] Use only + supplied sensor array[s] for -s output (lm-sensors, /sys. Linux only)."], + ['1', '', '--sleep', "[0-x.x] Change CPU sleep time, in seconds, for -C + (default:^$cpu_sleep). Allows system to catch up and show a more accurate CPU + use. Example:^$self_name^-Cxxx^--sleep^0.15"], + ['1', '', '--tty', "Forces irc flag to false. Generally useful if $self_name + is running inside of another tool like Chef or MOTD and returns corrupted + color codes. Please see man page or file an issue if you need to use this + flag. Must use -y [width] option if you want a specific output width. Always + put this option first in an option list. See -Z for disabling output filters + as well."], + ['1', '', '--usb-sys', "Force USB data to use only /sys as data source (Linux + only)."], + ['1', '', '--usb-tool', "Force USB data to use lsusb as data source [default] + (Linux only)."], + ['1', '', '--wan-ip-url', "[URL] Skips dig, uses supplied URL for WAN IP (-i). + URL output must end in the IP address. See man. + Example:^$self_name^-i^--wan-ip-url^https://yoursite.com/remote-ip"], + ['1', '', '--wm', "Force wm: to use wmctrl as data source. Default uses ps."], + ['0', '', '', $line ], + ['0', '', '', "Debugging Options:"], + ['1', '', '--dbg', "[1-xx[,1-xx]] Comma separated list of debugger numbers. + Each triggers specific debugger[s]. See man page or docs."], + ['2', '1', '', "Show downloader output. Turns off quiet mode."], + ['1', '', '--debug', "[1-3|10|11|20-22] Triggers debugging modes."], + ['2', '1-3', '', "On screen debugger output."], + ['2', '10', '', "Basic logging."], + ['2', '11', '', "Full file/system info logging."], + ['1', '', ,'', "The following create a tar.gz file of system data, plus + $self_name output. To automatically upload debugger data tar.gz file to + ftp.smxi.org: $self_name^--debug^21"], + ['2', '20', '', "Full system data collection: /sys; xorg conf and log data, + xrandr, xprop, xdpyinfo, glxinfo etc.; data from dev, disks, + ${partition_string}s, etc."], + ['2', '21', '', "Upload debugger dataset to $self_name debugger server + automatically, removes debugger data directory, leaves tar.gz debugger file."], + ['2', '22', '', "Upload debugger dataset to $self_name debugger server + automatically, removes debugger data directory and debugger tar.gz file."], + # ['1', '', '--debug-filter', "Add -z flag to debugger $self_name optiions."], + ['1', '', '--debug-id', "[short-string] Add given string to debugger file + name. Helps identify source of debugger dataset. Use with --debug 20-22."], + ['1', '', '--debug-proc', "Force debugger parsing of /proc as sudo/doas/root."], + ['1', '', '--debug-proc-print', "To locate file that /proc debugger hangs on."], + ['1', '', '--debug-no-exit', "Skip exit on error to allow completion."], + ['1', '', '--debug-no-proc', "Skip /proc debugging in case of a hang."], + ['1', '', '--debug-no-sys', "Skip /sys debugging in case of a hang."], + ['1', '', '--debug-sys', "Force PowerPC debugger parsing of /sys as + sudo/doas/root."], + ['1', '', '--debug-sys-print', "To locate file that /sys debugger hangs on."], + ['1', '', '--ftp', "Use with --debugger 21 to trigger an alternate FTP server + for upload. Format:^[ftp.xx.xx/yy]. Must include a remote directory to upload + to. Example:^$self_name^--debug^21^--ftp^ftp.myserver.com/incoming"], + ['0', '', '', "$line"], + ); + print_basic($rows); + exit 0; # shell true +} + +sub show_version { + # if not in PATH could be either . or directory name, no slash starting + my $working_path=$self_path; + my ($link,$self_string); + my $rows = []; + Cwd->import('getcwd'); # no point loading this on top use, we only use getcwd here + if ($working_path eq '.'){ + $working_path = getcwd(); + } + elsif ($working_path !~ /^\//){ + $working_path = getcwd() . "/$working_path"; + } + $working_path =~ s%/$%%; + # handle if it's a symbolic link, rare, but can happen with directories + # in irc clients which would only matter if user starts inxi with -! 30 override + # in irc client + if (-l "$working_path/$self_name"){ + $link="$working_path/$self_name"; + $working_path = readlink "$working_path/$self_name"; + $working_path =~ s/[^\/]+$//; + } + # strange output /./ ending, but just trim it off, I don't know how it happens + $working_path =~ s%/\./%/%; + push(@$rows, [ 0, '', '', "$self_name $self_version-$self_patch ($self_date)"]); + if (!$b_irc && !$show{'version-short'}){ + push(@$rows, [ 0, '', '', '']); + my $year = (split/-/, $self_date)[0]; + push(@$rows, + [ 0, '', '', "Copyright^(C)^2008-$year^Harald^Hope^aka^h2"], + [ 0, '', '', "Forked from Infobash 3.02: Copyright^(C)^2005-2007^Michiel^de^Boer^aka^locsmif." ], + [ 0, '', '', "Using Perl version: $]"], + [ 0, '', '', "Program Location: $working_path" ], + ); + if ($link){ + push(@$rows, [ 0, '', '', "Started via symbolic link: $link" ]); + } + push(@$rows, + [ 0, '', '', '' ], + [ 0, '', '', "Website:^https://codeberg.org/smxi/inxi^or^https://smxi.org/" ], + [ 0, '', '', "IRC:^irc.oftc.net channel:^#smxi" ], + [ 0, '', '', "Forums:^https://techpatterns.com/forums/forum-33.html" ], + [ 0, '', '', '' ], + [ 0, '', '', "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. + (https://www.gnu.org/licenses/gpl.html)" ] + ); + } + print_basic($rows); + exit 0 if !$show{'version-short'} || $show{'short'}; # shell true +} + +######################################################################## +#### STARTUP DATA +######################################################################## + +## StartClient ## +{ +package StartClient; +# use warnings; +# use strict; +my $pppid = ''; + +# NOTE: there's no reason to create an object, we can just access +# the features statically. +# args: none +# sub new { +# my $class = shift; +# my $self = {}; +# # print "$f\n"; +# # print "$type\n"; +# return bless $self, $class; +# } + +sub set { + eval $start if $b_log; + # $b_irc = 1; # for testing, like cli konvi start which shows as tty + if (!$b_irc){ + # we'll run ShellData::set() for -I, but only then + } + else { + $use{'filter'} = 1; + PsData::set() if !$loaded{'ps-data'}; + get_client_name(); + if ($client{'konvi'} == 1 || $client{'konvi'} == 3){ + set_konvi_data(); + } + } + eval $end if $b_log; +} + +sub get_client_name { + eval $start if $b_log; + my $client_name = ''; + # print "$ppid\n"; + if ($ppid && -e "/proc/$ppid/exe"){ + $client_name = lc(readlink "/proc/$ppid/exe"); + $client_name =~ s/^.*\///; + if ($client_name =~ /^(bash|csh|dash|fish|sh|python.*|perl.*|zsh)$/){ + $pppid = (main::grabber("ps -wwp $ppid -o ppid 2>/dev/null"))[1]; + # my @temp = (main::grabber("ps -wwp $ppid -o ppid 2>/dev/null"))[1]; + $pppid =~ s/^\s+|\s+$//g; + $client_name =~ s/[0-9\.]+$//; # clean things like python2.7 + if ($pppid && -f "/proc/$pppid/exe"){ + $client_name = lc(readlink "/proc/$pppid/exe"); + $client_name =~ s/^.*\///; + $client{'native'} = 0; + } + } + $client{'name'} = $client_name; + get_client_version(); + # print "c:$client_name p:$pppid\n"; + # print "$client{'name-print'}\n"; + } + else { + if (!check_modern_konvi()){ + $client_name = (main::grabber("ps -wwp $ppid 2>/dev/null"))[1]; + if ($client_name){ + my @data = split(/\s+/, $client_name); + if ($bsd_type){ + $client_name = lc($data[4]); + } + # gnu/linux uses last value + else { + $client_name = lc($data[-1]); + } + $client_name =~ s/.*\|-(|)//; + $client_name =~ s/[0-9\.]+$//; # clean things like python2.7 + $client{'name'} = $client_name; + $client{'native'} = 1; + get_client_version(); + } + else { + $client{'name'} = "PPID='$ppid' - Empty?"; + } + } + } + if ($b_log){ + my $string = "Client: $client{'name'} :: version: $client{'version'} ::"; + $string .= " konvi: $client{'konvi'} :: PPID: $ppid"; + main::log_data('data', $string); + } + eval $end if $b_log; +} + +sub get_client_version { + eval $start if $b_log; + my @app = ProgramData::values($client{'name'}); + my (@data,@working,$string); + if (@app){ + $string = ($client{'name'} =~ /^gribble|limnoria|supybot$/) ? 'supybot' : $client{'name'}; + $client{'version'} = ProgramData::version($string,$app[0],$app[1],$app[2],$app[4],$app[5],$app[6]); + $client{'name-print'} = $app[3]; + $client{'console-irc'} = $app[4]; + } + if ($client{'name'} =~ /^(bash|csh|fish|dash|sh|zsh)$/){ + $client{'name-print'} = 'shell wrapper'; + $client{'console-irc'} = 1; + } + elsif ($client{'name'} eq 'bitchx'){ + @data = main::grabber("$client{'name'} -v 2>/dev/null"); + $string = awk(\@data,'Version'); + if ($string){ + $string =~ s/[()]|bitchx-//g; + @data = split(/\s+/, $string); + $_=lc for @data; + $client{'version'} = ($data[1] eq 'version') ? $data[2] : $data[1]; + } + } + # 'hexchat' => ['',0,'','HexChat',0,0], # special + # the hexchat author decided to make --version/-v return a gtk dialogue box, lol... + # so we need to read the actual config file for hexchat. Note that older hexchats + # used xchat config file, so test first for default, then legacy. Because it's possible + # for this file to be user edited, doing some extra checks here. + elsif ($client{'name'} eq 'hexchat'){ + if (-f '~/.config/hexchat/hexchat.conf'){ + @data = main::reader('~/.config/hexchat/hexchat.conf','strip'); + } + elsif (-f '~/.config/hexchat/xchat.conf'){ + @data = main::reader('~/.config/hexchat/xchat.conf','strip'); + } + if (@data){ + $client{'version'} = main::awk(\@data,'version',2,'\s*=\s*'); + } + # fingers crossed, hexchat won't open gui!! + if (!$client{'version'}){ + @data = main::grabber("$client{'name'} --version 2>/dev/null"); + $client{'version'} = main::awk(\@data,'hexchat',2,'\s+'); + } + $client{'name-print'} = 'HexChat'; + } + # note: see legacy inxi konvi logic if we need to restore any of the legacy code. + elsif ($client{'name'} eq 'konversation'){ + $client{'konvi'} = (!$client{'native'}) ? 2 : 1; + } + elsif ($client{'name'} =~ /quassel/i){ + @data = main::grabber("$client{'name'} -v 2>/dev/null"); + foreach (@data){ + if ($_ =~ /^Quassel IRC:/){ + $client{'version'} = (split(/\s+/, $_))[2]; + last; + } + elsif ($_ =~ /quassel\s[v]?[0-9]/){ + $client{'version'} = (split(/\s+/, $_))[1]; + last; + } + } + $client{'version'} ||= '(pre v0.4.1)?'; + } + # then do some perl type searches, do this last since it's a wildcard search + elsif ($client{'name'} =~ /^(perl.*|ksirc|dsirc)$/){ + my $cmdline = main::get_cmdline(); + # Dynamic runpath detection is too complex with KSirc, because KSirc is started from + # kdeinit. /proc//exe is a link to /usr/bin/kdeinit + # with one parameter which contains parameters separated by spaces(??), first param being KSirc. + # Then, KSirc runs dsirc as the perl irc script and wraps around it. When /exec is executed, + # dsirc is the program that runs inxi, therefore that is the parent process that we see. + # You can imagine how hosed I am if I try to make inxi find out dynamically with which path + # KSirc was run by browsing up the process tree in /proc. That alone is straightjacket material. + # (KSirc sucks anyway ;) + foreach (@$cmdline){ + if ($_ =~ /dsirc/){ + $client{'name'} = 'ksirc'; + ($client{'name-print'},$client{'version'}) = ProgramData::full('ksirc'); + } + } + $client{'console-irc'} = 1; + perl_python_client(); + } + elsif ($client{'name'} =~ /python/){ + perl_python_client(); + } + # NOTE: these must be empirically determined, not all events that + # show no tty are actually IRC. tmux is not a vt, but runs inside one + if (!$client{'name-print'}){ + my $wl_terms = 'alacritty|altyo|\bate\b|black-screen|conhost|doas|evilvte|'; + $wl_terms .= 'foot|germinal|guake|havoc|hyper|kate|kgx|kitty|kmscon|konsole|'; + $wl_terms .= 'login|macwise|minicom|putty|rxvt|sakura|securecrt|'; + $wl_terms .= 'shellinabox|^st$|sudo|term|tilda|tilix|tmux|tym|wayst|xiki|'; + $wl_terms .= 'yaft|yakuake|\bzoc\b'; + my $wl_clients = 'ansible|chef|run-parts|slurm|sshd'; + my $whitelist = "$wl_terms|$wl_clients"; + # print "$client{'name'}\n"; + if ($client{'name'} =~ /($whitelist)/i){ + if ($client{'name'} =~ /($wl_terms)/i){ + ShellData::set(); + } + else { + $client{'name-print'} = $client{'name'}; + } + $b_irc = 0; + $use{'filter'} = 0; + } + else { + $client{'name-print'} = 'Unknown Client: ' . $client{'name'}; + } + } + eval $end if $b_log; +} + +sub get_cmdline { + eval $start if $b_log; + my @cmdline; + my $i = 0; + if (! -e "/proc/$ppid/cmdline"){ + return 1; + } + local $\ = ''; + open(my $fh, '<', "/proc/$ppid/cmdline") or + print_line("Open /proc/$ppid/cmdline failed: $!"); + my @rows = <$fh>; + close $fh; + foreach (@rows){ + push(@cmdline, $_); + $i++; + last if $i > 31; + } + if ($i == 0){ + $cmdline[0] = $rows[0]; + $i = ($cmdline[0]) ? 1 : 0; + } + main::log_data('string',"cmdline: @cmdline count: $i") if $b_log; + eval $end if $b_log; + return [@cmdline]; +} + +sub perl_python_client { + eval $start if $b_log; + return 1 if $client{'version'}; + my @app; + # this is a hack to try to show konversation if inxi is running but started via /cmd + # OR via program shortcuts, both cases in fact now + # main::print_line("konvi: " . scalar grep { $_ =~ /konversation/ } @ps_cmd); + if ($b_display && main::check_program('konversation') && + (grep { $_ =~ /konversation/ } @ps_cmd)){ + @app = ProgramData::values('konversation'); + $client{'version'} = ProgramData::version('konversation',$app[0],$app[1],$app[2],$app[5],$app[6]); + $client{'name'} = 'konversation'; + $client{'name-print'} = $app[3]; + $client{'console-irc'} = $app[4]; + } + ## NOTE: supybot only appears in ps aux using 'SHELL' command; the 'CALL' command + ## gives the user system irc priority, and you don't see supybot listed, so use SHELL + elsif (!$b_display && + (main::check_program('supybot') || + main::check_program('gribble') || main::check_program('limnoria')) && + (grep { $_ =~ /supybot/ } @ps_cmd)){ + @app = ProgramData::values('supybot'); + $client{'version'} = ProgramData::version('supybot',$app[0],$app[1],$app[2],$app[5],$app[6]); + if ($client{'version'}){ + if (grep { $_ =~ /gribble/ } @ps_cmd){ + $client{'name'} = 'gribble'; + $client{'name-print'} = 'Gribble'; + } + if (grep { $_ =~ /limnoria/ } @ps_cmd){ + $client{'name'} = 'limnoria'; + $client{'name-print'} = 'Limnoria'; + } + else { + $client{'name'} = 'supybot'; + $client{'name-print'} = 'Supybot'; + } + } + else { + $client{'name'} = 'supybot'; + $client{'name-print'} = 'Supybot'; + } + $client{'console-irc'} = 1; + } + else { + $client{'name-print'} = "Unknown $client{'name'} client"; + } + if ($b_log){ + my $string = "namep: $client{'name-print'} name: $client{'name'} "; + $string .= " version: $client{'version'}"; + main::log_data('data',$string); + } + eval $end if $b_log; +} + +# Try to infer the use of Konversation >= 1.2, which shows $PPID improperly +# no known method of finding Konvi >= 1.2 as parent process, so we look to +# see if it is running, and all other irc clients are not running. As of +# 2014-03-25 this isn't used in my cases +sub check_modern_konvi { + eval $start if $b_log; + return 0 if !$client{'qdbus'}; + my ($b_modern_konvi,$konvi,$konvi_version,$pid) = (0,'','',''); + # main::log_data('data',"name: $client{'name'} :: qdb: $client{'qdbus'} :: version: $client{'version'} :: konvi: $client{'konvi'} :: PPID: $ppid") if $b_log; + # sabayon uses /usr/share/apps/konversation as path + # Paths not checked for BSDs to see what they are. + if (-d '/usr/share/kde4/apps/konversation' || -d '/usr/share/apps/konversation'){ + # much faster test, added 2022, newer konvis support + # can also query qdbus to see if it's running, but that's a subshell and grep + if ($ENV{'PYTHONPATH'} && $ENV{'PYTHONPATH'} =~ /konversation/i){ + $konvi = 'konversation'; + } + # was -session, then -qwindowtitle; cli start, nothing, just konversation$ + elsif ($pid = main::awk(\@ps_aux,'konversation( -|$)',2,'\s+')){ + main::log_data('data',"pid: $pid") if $b_log; + if (-e "/proc/$pid/exe"){ + $konvi = readlink("/proc/$pid/exe"); + $konvi =~ s/^.*\///; # basename + } + } + # print "$pid $konvi\n"; + if ($konvi){ + my @app = ProgramData::values('konversation'); + $konvi_version = ProgramData::version($konvi,$app[0],$app[1],$app[2],$app[5],$app[6]); + $client{'console-irc'} = $app[4]; + $client{'konvi'} = 3; + $client{'name'} = 'konversation'; + $client{'name-print'} = $app[3]; + $client{'version'} = $konvi_version; + # note: we need to change this back to a single dot number, like 1.3, not 1.3.2 + my @temp = split('\.', $konvi_version); + $konvi_version = $temp[0] . "." . $temp[1]; + if ($konvi_version > 1.1){ + $b_modern_konvi = 1; + } + } + } + main::log_data('data',"name: $client{'name'} name print: $client{'name-print'} + qdb: $client{'qdbus'} version: $konvi_version konvi: $konvi PID: $pid") if $b_log; + main::log_data('data',"b_is_qt4: $b_modern_konvi") if $b_log; + ## for testing this module + # my $ppid = getppid(); + # system('qdbus org.kde.konversation', '/irc', 'say', $client{'dserver'}, $client{'dtarget'}, + # "getpid_dir: verNum: $konvi_version pid: $pid ppid: $ppid"); + # print "verNum: $konvi_version pid: $pid ppid: $ppid\n"; + eval $end if $b_log; + return $b_modern_konvi; +} + +sub set_konvi_data { + eval $start if $b_log; + # https://userbase.kde.org/Konversation/Scripts/Scripting_guide + if ($client{'konvi'} == 3){ + $client{'dserver'} = shift @ARGV; + $client{'dtarget'} = shift @ARGV; + $client{'dobject'} = 'default'; + } + elsif ($client{'konvi'} == 1){ + $client{'dport'} = shift @ARGV; + $client{'dserver'} = shift @ARGV; + $client{'dtarget'} = shift @ARGV; + $client{'dobject'} = 'Konversation'; + } + # for some reason this logic hiccups on multiple spaces between args + @ARGV = grep { $_ ne '' } @ARGV; + eval $end if $b_log; +} +} + +######################################################################## +#### OUTPUT +######################################################################## + +#### ------------------------------------------------------------------- +#### CLEANERS, FILTERS, AND TOOLS +#### ------------------------------------------------------------------- + +sub clean { + my ($item) = @_; + return $item if !$item;# handle cases where it was 0 or '' or undefined + # note: |nee trips engineering, but I don't know why nee was filtered + $item =~ s/chipset|company|components|computing|computer|corporation|communications|electronics?|electric(al)?|group|incorporation|industrial|international|limited|\bnee\b|?|revision|semiconductor|software|technolog(ies|y)|?|ltd\.||\bltd\b|inc\.||\binc\b|intl\.|co\.||corp\.||\(tm\)|\(r\)|®|\(rev ..\)|\'|\"|\?//gi; + $item =~ s/,|\*/ /g; + $item =~ s/^\s+|\s+$//g; + $item =~ s/\s\s+/ /g; + return $item; +} + +sub clean_arm { + my ($item) = @_; + $item =~ s/(\([^\(]*Device Tree[^\)]*\))//gi; + $item =~ s/^\s+|\s+$//g; + $item =~ s/\s\s+/ /g; + return $item; +} + +# This is used only in distro name strings. +# arg: 0: name string to clean by reference +sub clean_characters { + # newline, pipe, brackets, + sign, with space, then clear doubled + # spaces and then strip out trailing/leading spaces. + # etc/issue often has junk stuff like (\l) \n \l. Removed + because can be + # part of distro name, like Slackware 15.0+ + return if !${$_[0]}; # should not be needed since tests for not empty on use + ${$_[0]} =~ s/[:\47]|\\[a-z]|\n|,|\"|\*|\||\[\s\]|n\/a|\s\s+/ /g; + ${$_[0]} =~ s/\(\s*\)//; + ${$_[0]} =~ s/^\s+|\s+$//g; +} + +sub clean_disk { + my ($item) = @_; + return $item if !$item; + # ?| + $item =~ s/vendor.*|product.*|O\.?E\.?M\.?//gi; + $item =~ s/^\s+|\s+$//g; + $item =~ s/\s\s+/ /g; + return $item; +} + +sub clean_dmi { + my ($string) = @_; + $string = clean_unset($string,'AssetTagNum|^Base Board .*|^Chassis .*|' . + 'Manufacturer.*| Or Motherboard|\bOther\b.*|PartNum.*|SerNum|' . + '^System .*|^0x[0]+$'); + $string =~ s/\bbios\b|\bacpi\b//gi; + $string =~ s/http:\/\/www.abit.com.tw\//Abit/i; + $string =~ s/^[\s'"]+|[\s'"]+$//g; + $string =~ s/\s\s+/ /g; + $string = remove_duplicates($string) if $string; + return $string; +} + +sub clean_pci { + my ($string,$type) = @_; + # print "st1 $type:$string\n"; + my $filter = 'and\ssubsidiaries|compatible\scontroller|licensed\sby|'; + $filter .= '\b(device|controller|connection|multimedia)\b|\([^)]+\)'; + # \[[^\]]+\]$| not trimming off ending [...] initial type filters removes end + $filter = '\[[^\]]+\]$|' . $filter if $type eq 'pci'; + $string =~ s/($filter)//ig; + $string =~ s/^[\s'"]+|[\s'"]+$//g; + $string =~ s/\s\s+/ /g; + # print "st2 $type:$string\n"; + $string = remove_duplicates($string) if $string; + return $string; +} + +sub clean_pci_subsystem { + my ($string) = @_; + # we only need filters for features that might use vendor, -AGN + my $filter = 'and\ssubsidiaries|adapter|(hd\s)?audio|definition|desktop|ethernet|'; + $filter .= 'gigabit|graphics|hdmi(\/[\S]+)?|high|integrated|licensed\sby|'; + $filter .= 'motherboard|network|onboard|raid|pci\s?express'; + $string =~ s/\b($filter)\b//ig; + $string =~ s/^[\s'"]+|[\s'"]+$//g; + $string =~ s/\s\s+/ /g; + return $string; +} + +# Use sparingly, but when we need regex type stuff +# stripped out for reliable string compares, it's better. +# sometimes the pattern comes from unknown strings +# which can contain regex characters, get rid of those +sub clean_regex { + my ($string) = @_; + return if !$string; + $string =~ s/(\{|\}|\(|\)|\[|\]|\|)/ /g; + $string =~ s/^\s+|\s+$//g; + $string =~ s/\s\s+/ /g; + return $string; +} + +# args: 0: string; 1: optional, if you want to add custom filter to defaults +sub clean_unset { + my ($string,$extra) = @_; + my $cleaner = '^(\.)+$|Bad Index|default string|\[?empty\]?|\bnone\b|N\/A|^not |'; + $cleaner .= 'not set|OUT OF SPEC|To be filled|O\.?E\.?M|undefine|unknow|unspecif'; + $cleaner .= '|' . $extra if $extra; + $string =~ s/.*($cleaner).*//i; + return $string; +} + +sub filter { + my ($string,$type) = @_; + if ($string){ + $type ||= 'filter'; + if ($use{$type} && $string ne message('root-required')){ + $string = $filter_string; + } + } + else { + $string = 'N/A'; + } + return $string; +} + +# Note, let the print logic handle N/A cases +# args: 0: type; 1: string, by reference; 2: test value for system +sub filter_partition { + return if !$_[1] || !${$_[1]} || ${$_[1]} eq 'N/A'; + if ($_[0]eq 'system'){ + ${$_[1]} =~ s/${_[2]}[^\s]+/${_[2]}$filter_string/g; + } + else { + ${$_[1]} = $filter_string; + } +} + +# note these are tested before being sent so no need to test for null +# args: 0: string to filter. by reference +sub filter_pci_long { + if ($_[0] =~ /\[AMD(\/ATI)?\]/){ + ${$_[0]} =~ s/Advanced\sMicro\sDevices\s\[AMD(\/ATI)?\]/AMD/; + } +} + +# args: 0: list of values. Return the first one that is defined. +sub get_defined { + for (@_){ + return $_ if defined $_; + } + return; # don't return undef explicitly, only implicitly! +} + +# args: 0: vendor id; 1: product id. +# Returns print ready vendor:chip id string, or na variants +sub get_chip_id { + my ($vendor,$product)= @_; + my $id = 'N/A'; + if ($vendor && $product){ + $id = "$vendor:$product"; + } + elsif ($vendor){ + $id = "$vendor:n/a"; + } + elsif ($product){ + $id = "n/a:$product"; + } + return $id; +} + +# args: 0: size in KiB, return KiB, MiB, GiB, TiB, PiB, EiB; 1: 'string'; +# 2: default value if null. Assumes KiB input. +# Returns string with units or array or size unmodified if not numeric +sub get_size { + my ($size,$type,$empty) = @_; + my (@data); + $type ||= ''; + $empty ||= ''; + return $empty if !defined $size; + if (!is_numeric($size)){ + $data[0] = $size; + $data[1] = ''; + } + elsif ($size > 1024**5){ + $data[0] = sprintf("%.2f",$size/1024**5); + $data[1] = 'EiB'; + } + elsif ($size > 1024**4){ + $data[0] = sprintf("%.2f",$size/1024**4); + $data[1] = 'PiB'; + } + elsif ($size > 1024**3){ + $data[0] = sprintf("%.2f",$size/1024**3); + $data[1] = 'TiB'; + } + elsif ($size > 1024**2){ + $data[0] = sprintf("%.2f",$size/1024**2); + $data[1] = 'GiB'; + } + elsif ($size > 1024){ + $data[0] = sprintf("%.1f",$size/1024); + $data[1] = 'MiB'; + } + else { + $data[0] = sprintf("%.0f",$size); + $data[1] = 'KiB'; + } + $data[0] += 0 if $data[1]; # trim trailing 0s + # note: perl throws strict error if you try to convert string to int + # $data[0] = int($data[0]) if $b_int && $data[0]; + if ($type eq 'string'){ + return ($data[1]) ? join(' ', @data) : $size; + } + else { + return @data; + } +} + +# not used, but keeping logic for now +sub increment_starters { + my ($key,$indexes) = @_; + my $result = $key; + if (defined $indexes->{$key}){ + $indexes->{$key}++; + $result = "$key-$indexes->{$key}"; + } + return $result; +} + +sub make_line { + my $line = ''; + foreach (0 .. $size{'max-cols-basic'} - 2){ + $line .= '-'; + } + return $line; +} + +# Takes an array ref, creates value ref, comma separated, with ','/', ' +# depending on assigned max list value length. +# args: 0: array ref; 1: value result ref; 2: [separator]; 3: [sort]; +# 4: [N/A value, if missing, return undef] +sub make_list_value { + my $sep = $_[2]; + $sep ||= ','; + if (!defined $_[0] || !@{$_[0]}){ + ${$_[1]} = $_[4] if $_[4]; + return; + } + # note: printer only wraps if value 'word' count > 2, and trick with quoting + # array includes 1 white space between values + if (scalar @{$_[0]} > 2 && length("@{$_[0]}") > $size{'max-join-list'}){ + $sep .= ' '; + } + @{$_[0]} = sort {"\L$a" cmp "\L$b"} @{$_[0]} if $_[3] && $_[3] eq 'sort'; + ${$_[1]} = join($sep,@{$_[0]}); +} + +# args: 0: type; 1: info [optional]; 2: info [optional] +sub message { + my ($type,$id,$id2) = @_; + $id ||= ''; + $id2 ||= ''; + my %message = ( + 'arm-cpu-f' => 'Use -f option to see features', + 'audio-server-on-pipewire-pulse' => 'off (using pipewire-pulse)', + 'audio-server-process-on' => 'active (process)', + 'audio-server-root-na' => 'n/a (root, process)', + 'audio-server-root-on' => 'active (root, process)', + 'battery-data' => 'No system battery data found. Is one present?', + 'battery-data-bsd' => 'No battery data found. Try with --dmidecode', + 'battery-data-sys' => 'No /sys data found.', + 'bluetooth-data' => 'No bluetooth data found.', + 'bluetooth-down' => "tool can't run", + 'cpu-bugs-null' => 'No CPU vulnerability/bugs data available.', + 'cpu-model-null' => 'Model N/A', + 'cpu-speeds' => 'No per core speed data found.', + 'cpu-speeds-bsd' => 'No OS support for core speeds.', + 'darwin-feature' => 'Feature not supported iu Darwin/OSX.', + 'dev' => 'Feature under development', + 'device-data' => 'No device data found.', + 'disk-data' => 'No disk data found.', + 'disk-data-bsd' => 'No disk data found.', + 'disk-size-0' => 'Total N/A', + 'display-driver-na' => 'X driver n/a', # legacy, leave for now + 'display-driver-na-try-root' => 'X driver n/a, try sudo/root', + 'display-server' => 'No display server data found. Headless machine?', + 'dmesg-boot-permissions' => 'dmesg.boot permissions', + 'dmesg-boot-missing' => 'dmesg.boot not found', + 'dmidecode-dev-mem' => 'dmidecode is not allowed to read /dev/mem', + 'dmidecode-smbios' => 'No SMBIOS data for dmidecode to process', + 'edid-revision' => "invalid EDID revision: $id", + 'edid-sync' => "bad sync value: $id", + 'edid-version' => "invalid EDID version: $id", + 'egl-missing' => 'EGL data requires eglinfo. Check --recommends.', + 'egl-missing-console' => 'EGL data unavailable in console, eglinfo missing.', + 'egl-null' => 'No EGL data available.', + 'file-unreadable' => 'File not readable (permissions?)', + 'gfx-api' => 'No display API data available.', + 'gfx-api-console' => 'No API data available in console. Headless machine?', + 'glx-console-root' => 'GL data unavailable in console for root.', + 'glx-console-try' => 'GL data unavailable in console. Try -G --display', + 'glx-display-root' => 'GL data unavailable for root.', + 'glx-egl' => 'incomplete (EGL sourced)', + 'glx-egl-console' => 'console (EGL sourced)', + 'glx-egl-missing' => 'glxinfo missing (EGL sourced)', + 'glx-missing' => 'Unable to show GL data. glxinfo is missing.', + 'glx-missing-console' => 'GL data unavailable in console, glxinfo missing.', + 'glx-null' => 'No GL data available.', + 'glx-value-empty' => 'Unset. Missing GL driver?', + 'IP' => "No $id found. Connected to web? SSL issues?", + 'IP-dig' => "No $id found. Connected to web? SSL issues? Try --no-dig", + 'IP-no-dig' => "No $id found. Connected to web? SSL issues? Try enabling dig", + 'logical-data' => 'No logical block device data found.', + 'logical-data-bsd' => "Logical block device feature unsupported in $id.", + 'machine-data' => 'No machine data: try newer kernel.', + 'machine-data-bsd' => 'No machine data: Is dmidecode installed? Try -M --dmidecode.', + 'machine-data-dmidecode' => 'No machine data: try newer kernel. Is dmidecode installed? Try -M --dmidecode.', + 'machine-data-force-dmidecode' => 'No machine data: try newer kernel. Is dmidecode installed? Try -M --dmidecode.', + 'machine-data-fruid' => 'No machine data: Is fruid_print installed?', + 'monitor-console' => 'N/A in console', + 'monitor-id' => 'not-matched', + 'monitor-na' => 'N/A', + 'monitor-wayland' => 'no compositor data', + 'network-services' => 'No services found.', + 'note-check' => 'check', + 'note-est' => 'est.', + 'note-not-reliable' => 'not reliable', + 'nv-current' => "current (as of $id)", + 'nv-current-eol' => "current (as of $id; EOL~$id2)", + 'nv-legacy-active' => "legacy-active (EOL~$id)", + 'nv-legacy-eol' => "legacy (EOL~$id)", + 'optical-data' => 'No optical or floppy data found.', + 'optical-data-bsd' => 'No optical or floppy data found.', + 'output-control' => "-:: 'Enter' to continue to next block. Any key + 'Enter' to exit:", + 'output-control-exit' => 'Exiting output. Have a nice day.', + 'output-limit' => "Output throttled. IPs: $id; Limit: $limit; Override: --limit [1-x;-1 all]", + 'package-data' => 'No packages detected. Unsupported package manager?', + 'partition-data' => 'No partition data found.', + 'partition-hidden' => 'N/A (hidden?)', + 'pci-advanced-data' => 'bus/chip ids n/a', + 'pci-card-data' => 'No PCI device data found.', + 'pci-card-data-root' => 'PCI device data requires root.', + 'pci-slot-data' => 'No PCI Slot data found.', + 'pm-disabled' => "see --$id", + 'pm-no-repos' => "[$id list repo query]", + 'ps-data-null' => 'No process data available.', + 'raid-data' => 'No RAID data found.', + 'ram-data' => "No RAM data found using $id.", + 'ram-data-complete' => 'For complete report, try with --dmidecode', + 'ram-data-dmidecode' => 'No RAM data found. Try with --dmidecode', + 'ram-no-module' => 'no module installed', + 'ram-udevadm' => 'For most reliable report, use superuser + dmidecode.', + 'ram-udevadm-root' => 'For most reliable report, install dmidecode.', + 'ram-udevadm-version' => "Installed udevadm v$id. Requires >= 249. Try root?", + 'recommends' => 'see --recommends', + 'repo-data', "No repo data detected. Does $self_name support your package manager?", + 'repo-data-bsd', "No repo data detected. Does $self_name support $id?", + 'risc-pci' => 'No ' . uc($id) . ' data found for this feature.', + 'root-feature' => 'Feature requires superuser permissions.', + 'root-item-incomplete' => "Full $id report requires superuser permissions.", + 'root-required' => '', + 'root-suggested' => 'try sudo/root',# gdm only + 'screen-wayland' => 'no compositor data', + 'screen-tinyx' => "no X$id data", + 'sensor-data-bsd' => "$id sensor data found but not usable.", + 'sensor-data-bsd-ok' => 'No sensor data found. Are data sources present?', + 'sensor-data-bsd-unsupported' => 'Sensor data not available. Unsupported BSD variant.', + 'sensor-data-ipmi' => 'No ipmi sensor data found.', + 'sensor-data-ipmi-root' => 'Unable to run ipmi sensors. Root privileges required.', + 'sensors-data-linux' => 'No sensor data found. Missing /sys/class/hwmon, lm-sensors.', + 'sensor-data-lm-sensors' => 'No sensor data found. Is lm-sensors configured?', + 'sensor-data-sys' => 'No sensor data found in /sys/class/hwmon.', + 'sensor-data-sys-lm' => 'No sensor data found using /sys/class/hwmon or lm-sensors.', + 'smartctl-command' => 'A mandatory SMART command failed. Various possible causes.', + 'smartctl-open' => 'Unable to open device. Wrong device ID given?', + 'smartctl-udma-crc' => 'Bad cable/connection?', + 'smartctl-usb' => 'Unknown USB bridge. Flash drive/Unsupported enclosure?', + 'stopped' => 'stopped', + 'swap-admin' => 'No admin swap data available.', + 'swap-data' => 'No swap data was found.', + 'tool-missing-basic' => "", + 'tool-missing-incomplete' => "Missing system tool: $id. Output will be incomplete", + 'tool-missing-os' => "No OS support. Is a comparable $id tool available?", + 'tool-missing-recommends' => "Required tool $id not installed. Check --recommends", + 'tool-missing-required' => "Required program $id not available", + 'tool-permissions' => "Unable to run $id. Root privileges required.", + 'tool-present' => 'Present and working', + 'tool-unknown-error' => "Unknown $id error. Unable to generate data.", + 'tools-missing' => "This feature requires one of these tools: $id", + 'tools-missing-bsd' => "This feature requires one of these tools: $id", + 'undefined' => '', + 'unmounted-data' => 'No unmounted partitions found.', + 'unmounted-data-bsd' => "Unmounted partition feature unsupported in $id.", + 'unmounted-file' => 'No /proc/partitions file found.', + 'unsupported' => '', + 'usb-data' => 'No USB data found. Server?', + 'usb-mode-mismatch' => '', + 'unknown-cpu-topology' => 'ERR-103', + 'unknown-desktop-version' => 'ERR-101', + 'unknown-dev' => 'ERR-102', + 'unknown-device-id' => 'unknown device ID', + 'unknown-shell' => 'ERR-100', + 'vulkan-missing' => 'Unable to show Vulkan data. vulkaninfo is missing.', # not used yet + 'vulkan-null' => 'No Vulkan data available.', + 'weather-error' => "Error: $id", + 'weather-null' => "No $id found. Internet connection working?", + 'xvesa-null' => 'No Xvesa VBE/GOP data found.', + ); + return $message{$type}; +} + +# args: 0: string of range types (2-5; 3 4; 3,4,2-12) to generate single regex +# string for +sub regex_range { + return if ! defined $_[0]; + my @processed; + foreach my $item (split(/[,\s]+/,$_[0])){ + if ($item =~ /(\d+)-(\d+)/){ + $item = join('|',($1..$2)); + } + push(@processed,$item); + } + return join('|',@processed); +} + +# Handles duplicates occuring anywhere in string +sub remove_duplicates { + my ($string) = @_; + return if !$string; + my (%holder,@temp); + foreach (split(/\s+/, $string)){ + if (!$holder{lc($_)}){ + push(@temp, $_); + $holder{lc($_)} = 1; + } + } + $string = join(' ', @temp); + return $string; +} + +# args: 0: string to turn to KiB integer value. +# Convert string passed to KB, based on GB/MB/TB id +# NOTE: 1 [K 1000; kB: 1000; KB 1024; KiB 1024] bytes +# The logic will turn false MB to M for this tool +# Hopefully one day sizes will all be in KiB type units +sub translate_size { + my ($working) = @_; + my ($size,$unit) = (0,''); + # print ":$working:\n"; + return if !defined $working; + my $math = ($working =~ /B$/) ? 1000: 1024; + if ($working =~ /^([0-9\.]+)\s*([kKMGTPE])i?B?$/i){ + $size = $1; + $unit = uc($2); + } + if ($unit eq 'K'){ + $size = $1; + } + elsif ($unit eq 'M'){ + $size = $1 * $math; + } + elsif ($unit eq 'G'){ + $size = $1 * $math**2; + } + elsif ($unit eq 'T'){ + $size = $1 * $math**3; + } + elsif ($unit eq 'P'){ + $size = $1 * $math**4; + } + elsif ($unit eq 'E'){ + $size = $1 * $math**5; + } + $size = int($size) if $size; + return $size; +} + +#### ------------------------------------------------------------------- +#### GENERATE OUTPUT +#### ------------------------------------------------------------------- + +sub check_output_path { + my ($path) = @_; + my ($b_good,$dir,$file); + $dir = $path; + $dir =~ s/([^\/]+)$//; + $file = $1; + # print "file: $file : dir: $dir\n"; + $b_good = 1 if (-d $dir && -w $dir && $dir =~ /^\// && $file); + return $b_good; +} + +# Passing along hash ref +sub output_handler { + my ($data) = @_; + # print Dumper \%data; + if ($output_type eq 'screen'){ + print_data($data); + } + elsif ($output_type eq 'json'){ + generate_json($data); + } + elsif ($output_type eq 'xml'){ + generate_xml($data); + } +} + +# Passing along hash ref +# NOTE: file has already been set and directory verified +sub generate_json { + eval $start if $b_log; + my ($data) = @_; + my ($json); + my $b_debug = 0; + my ($b_cpanel,$b_valid); + error_handler('not-in-irc', 'help') if $b_irc; + print Dumper $data if $b_debug; + load_json() if !$loaded{'json'}; + print Data::Dumper::Dumper $use{'json'} if $b_debug; + if ($use{'json'}){ + # ${$use{'json'}->{'new'}}->canonical(1); + # $json = ${$use{'json'}->{'new'}}->json_encode($data); + # ${$use{'json'}->{'new-json'}}->canonical(1); + # $json = ${$use{'json'}->{'new-json'}}->encode_json($data); + $json = &{$use{'json'}->{'encode'}}($data); + } + else { + error_handler('required-module', 'json', 'JSON::PP, Cpanel::JSON::XS or JSON::XS'); + } + if ($json){ + #$json =~ s/"[0-9]+#/"/g; + if ($output_file eq 'print'){ + #$json =~ s/\}/}\n/g; + print "$json"; + } + else { + print_line("Writing JSON data to: $output_file\n"); + open(my $fh, '>', $output_file) or error_handler('open',$output_file,"$!"); + print $fh "$json"; + close $fh; + print_line("Data written successfully.\n"); + } + } + eval $end if $b_log; +} + +# NOTE: So far xml is substantially more difficult than json, so +# using a crude dumper rather than making a nice xml file, but at +# least xml has some output now. +sub generate_xml { + eval $start if $b_log; + my ($data) = @_; + my ($xml); + my $b_debug = 0; + error_handler('not-in-irc', 'help') if $b_irc; + # print Dumper $data if $b_debug; + if (check_perl_module('XML::Dumper')){ + XML::Dumper->import; + $xml = XML::Dumper::pl2xml($data); + #$xml =~ s/"[0-9]+#/"/g; + if ($output_file eq 'print'){ + print "$xml"; + } + else { + print_line("Writing XML data to: $output_file\n"); + open(my $fh, '>', $output_file) or error_handler('open',$output_file,"$!"); + print $fh "$xml"; + close $fh; + print_line("Data written successfully.\n"); + } + } + else { + error_handler('required-module', 'xml', 'XML::Dumper'); + } + eval $end if $b_log; +} + +sub key { + return sprintf("%03d#%s#%s#%s", $_[0],$_[1],$_[2],$_[3]); +} + +sub output_control { + print message('output-control'); + chomp(my $response = ); + if (!$response){ + $size{'lines'} = 1; + } + else { + print message('output-control-exit'), "\n"; + exit 0; + } +} + +sub print_basic { + my ($data) = @_; + my $indent = 18; + my $indent_static = 18; + my $indent1_static = 5; + my $indent2_static = 8; + my $indent1 = 5; + my $indent2 = 8; + my $length = @$data; + my ($start,$i,$j,$line); + my $width = $size{'max-cols-basic'}; + if ($width > 110){ + $indent_static = 22; + } + elsif ($width < 90){ + $indent_static = 15; + } + # print $length . "\n"; + for my $i (0 .. $#$data){ + # print "0: $data->[$i][0]\n"; + if ($data->[$i][0] == 0){ + $indent = 0; + $indent1 = 0; + $indent2 = 0; + } + elsif ($data->[$i][0] == 1){ + $indent = $indent_static; + $indent1 = $indent1_static; + $indent2= $indent2_static; + } + elsif ($data->[$i][0] == 2){ + $indent = ($indent_static + 7); + $indent1 = ($indent_static + 5); + $indent2 = 0; + } + $data->[$i][3] =~ s/\n/ /g; + $data->[$i][3] =~ s/\s+/ /g; + if ($data->[$i][1] && $data->[$i][2]){ + $data->[$i][1] = $data->[$i][1] . ', '; + } + $start = sprintf("%${indent1}s%-${indent2}s",$data->[$i][1],$data->[$i][2]); + if ($indent > 1 && (length($start) > ($indent - 1))){ + $line = sprintf("%-${indent}s\n", "$start"); + print_line($line); + $start = ''; + # print "1-print.\n"; + } + if (($indent + length($data->[$i][3])) < $width){ + $data->[$i][3] =~ s/\^/ /g; + $line = sprintf("%-${indent}s%s\n", "$start", $data->[$i][3]); + print_line($line); + # print "2-print.\n"; + } + else { + my $holder = ''; + my $sep = ' '; + # note: special case, split ' ' trims leading, trailing spaces, + # then splits like awk, on one or more white spaces. + foreach my $word (split(' ', $data->[$i][3])){ + # print "$word\n"; + if (($indent + length($holder) + length($word)) < $width){ + $word =~ s/\^/ /g; + $holder .= $word . $sep; + # print "3-hold.\n"; + } + # elsif (($indent + length($holder) + length($word)) >= $width){ + else { + $line = sprintf("%-${indent}s%s\n", "$start", $holder); + print_line($line); + $start = ''; + $word =~ s/\^/ /g; + $holder = $word . $sep; + # print "4-print-hold.\n"; + } + } + if ($holder !~ /^[ ]*$/){ + $line = sprintf("%-${indent}s%s\n", "$start", $holder); + print_line($line); + # print "5-print-last.\n"; + } + } + } +} + +# This has to get a hash of hashes, at least for now. Because perl does not +# retain insertion order, I use a prefix for each hash key to force sorts. +sub print_data { + my ($data) = @_; + my ($counter,$length,$split_count) = (0,0,0); + my ($hash_id,$holder,$holder2,$start,$start2,$start_holder) = ('','','','','',''); + my $indent = $size{'indent'}; + my (%ids); + my ($b_container,$b_ni2,$key,$line,$val2,$val3); + # these 2 sets are single logic items + my $b_single = ($size{'max-cols'} == 1) ? 1: 0; + my ($b_row1,$indent_2,$indent_use,$indentx) = (1,0,0,0); + # $size{'max-cols'} = 88; + # NOTE: indent < 11 would break the output badly in some cases + if ($size{'max-cols'} < $size{'max-wrap'} || $size{'indent'} < 11){ + $indent = $size{'indents'}; + } + foreach my $key1 (sort { substr($a,0,3) <=> substr($b,0,3) } keys %$data){ + $key = (split('#', $key1))[3]; + $b_row1 = 1; + if ($key ne 'SHORT'){ + $start = sprintf("$colors{'c1'}%-${indent}s$colors{'cn'}","$key$sep{'s1'}"); + if ($use{'output-block'}){ + output_control() if $use{'output-block'} > 1; + $use{'output-block'}++; + } + $start_holder = $key; + $indent_2 = $indent + $size{'indents'}; + $b_ni2 = 0; # ($start_holder eq 'Info') ? 1 : 0; + if ($indent < 10){ + $line = "$start\n"; + print_line($line); + $start = ''; + $line = ''; + } + } + else { + $indent = 0; + } + next if ref($data->{$key1}) ne 'ARRAY'; + # Line starters that will be -x incremented always + # It's a tiny bit faster manually resetting rather than using for loop + %ids = ( + 'Array' => 1, # RAM or RAID + 'Battery' => 1, + 'Card' => 1, + 'Device' => 1, + 'Floppy' => 1, + 'Hardware' => 1, # hardware raid report + 'Hub' => 1, + 'ID' => 1, + 'IF-ID' => 1, + 'LV' => 1, + 'Monitor' => 1, + 'Optical' => 1, + 'Screen' => 1, + 'Server' => 1, # was 'Sound Server' + 'variant' => 1, # arm > 1 cpu type + ); + foreach my $val1 (@{$data->{$key1}}){ + if (ref($val1) eq 'HASH'){ + if (!$b_single){ + $indent_use = $length = ($b_row1 && $key !~ /^(Features)$/) ? $indent : $indent_2; + } + ($counter,$b_row1,$split_count) = (0,1,0); + foreach my $key2 (sort {substr($a,0,3) <=> substr($b,0,3)} keys %$val1){ + ($hash_id,$b_container,$indentx,$key) = (split('#', $key2)); + if (!$b_single){ + $indent_use = ($b_row1 || $b_ni2) ? $indent: $indent_2; + } + # print "m-1: r1: $b_row1 iu: $indent_use\n"; + if ($start_holder eq 'Graphics' && $key eq 'Screen'){ + $ids{'Monitor'} = 1; + } + elsif ($start_holder eq 'Memory' && $key eq 'Array'){ + $ids{'Device'} = 1; + } + elsif ($start_holder eq 'RAID' && $key eq 'Device'){ + $ids{'Array'} = 1; + } + elsif ($start_holder eq 'USB' && $key eq 'Hub'){ + $ids{'Device'} = 1; + } + elsif ($start_holder eq 'Logical' && $key eq 'Device'){ + $ids{'LV'} = 1; + } + if ($counter == 0 && defined $ids{$key}){ + $key .= '-' . $ids{$key}++; + } + $val2 = $val1->{$key2}; + # we have to handle cases where $val2 is 0 + if (!$b_single && $val2 || $val2 eq '0'){ + $val2 .= " "; + } + # See: Use of implicit split to @_ is deprecated. Only get this + # warning in Perl 5.08 oddly enough. ie, no: scalar (split(...)); + my @values = split(/\s+/, $val2); + $split_count = scalar @values; + # print "sc: $split_count l: " . (length("$key$sep{'s2'} $val2") + $indent_use), " val2: $val2\n"; + if (!$b_single && + (length("$key$sep{'s2'} $val2") + $length) <= $size{'max-cols'}){ + # print "h-1: r1: $b_row1 iu: $indent_use\n"; + $length += length("$key$sep{'s2'} $val2"); + $holder .= "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val2"; + } + # Handle case where the key/value pair is > max, and where there are + # a lot of terms, like cpu flags, raid types supported. Raid can have + # the last row have a lot of devices, or many raid types. But we don't + # want to wrap things like: 3.45 MiB (6.3%) + elsif (!$b_single && $split_count > 2 && length($val2) > 24 && + !defined $ids{$key} && + (length("$key$sep{'s2'} $val2") + $indent_use + $length) > $size{'max-cols'}){ + # print "m-2 r1: $b_row1 iu: $indent_use\n"; + $val3 = shift @values; + $start2 = "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val3 "; + # Case where not first item in line, but when key+first word added, + # is wider than max width. + if ($holder && + ($length + length("$key$sep{'s2'} $val3")) > $size{'max-cols'}){ + # print "p-1a r1: $b_row1 iu: $indent_use\n"; + $holder =~ s/\s+$//; + $line = sprintf("%-${indent_use}s%s$colors{'cn'}\n","$start","$holder"); + print_line($line); + $b_row1 = 0; + $start = ''; + $holder = ''; + $length = $indent_use; + } + $length += length("$key$sep{'s2'} $val3 "); + # print scalar @values,"\n"; + foreach (@values){ + # my $l = (length("$_ ") + $length); + # print "$l\n"; + $indent_use = ($b_row1 || $b_ni2) ? $indent : $indent_2; + if ((length("$_ ") + $length) < $size{'max-cols'}){ + # print "h-2: r1: $b_row1 iu: $indent_use\n"; + # print "a\n"; + if ($start2){ + $holder2 .= "$start2$_ "; + $start2 = ''; + } + else { + $holder2 .= "$_ "; + } + $length += length("$_ "); + } + else { + # print "p-1b: r1: $b_row1 iu: $indent_use\n"; + if ($start2){ + $holder2 = "$start2$holder2"; + } + else { + $holder2 = "$colors{'c2'}$holder2"; + } + # print "xx:$holder"; + $holder2 =~ s/\s+$//; + $line = sprintf("%-${indent_use}s%s$colors{'cn'}\n","$start","$holder$holder2"); + print_line($line); + # make sure wrapped value is indented correctly! + $b_row1 = 0; + $indent_use = ($b_row1) ? $indent : $indent_2; + $holder = ''; + $holder2 = "$_ "; + # print "h2: $holder2\n"; + $length = length($holder2) + $indent_use; + $start2 = ''; + $start = ''; + } + } + # We don't want to start a new line, continue until full length. + if ($holder2 !~ /^\s*$/){ + # print "p-2: r1: $b_row1 iu: $indent_use\n"; + $holder2 = "$colors{'c2'}$holder2"; + $holder = $holder2; + $b_row1 = 0; + $holder2 = ''; + $start2 = ''; + $start = ''; + } + } + # NOTE: only these and the last fallback are used for b_single output + else { + if ($holder){ + # print "p-3: r1: $b_row1 iu: $indent_use\n"; + $holder =~ s/\s+$//; + $line = sprintf("%-${indent_use}s%s$colors{'cn'}\n",$start,"$holder"); + $length = length("$key$sep{'s2'} $val2") + $indent_use; + print_line($line); + $b_row1 = 0; + $start = ''; + } + else { + # print "h-3a: r1: $b_row1 iu: $indent_use\n"; + $length = $indent_use; + } + if ($b_single){ + $indent_use = ($indent * $indentx); + } + else { + $indent_use = ($b_row1 || $b_ni2) ? $indent: $indent_2; + } + $holder = "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val2"; + # print "h-3b: r1: $b_row1 iu: $indent_use\n"; + } + $counter++; + } + if ($holder !~ /^\s*$/){ + # print "p-4: r1: $b_row1 iu: $indent_use\n"; + $holder =~ s/\s+$//; + $line = sprintf("%-${indent_use}s%s$colors{'cn'}\n",$start,"$start2$holder"); + print_line($line); + $b_row1 = 0; + $holder = ''; + $length = 0; + $start = ''; + } + } + # Only for repos currently + elsif (ref($val1) eq 'ARRAY'){ + # print "p-5: r1: $b_row1 iu: $indent_use\n"; + my $num = 0; + my ($l1,$l2); + $indent_use = $indent_2; + foreach my $item (@$val1){ + $num++; + if ($size{'max-lines'}){ + $l1 = length("$num$sep{'s2'} $item") + $indent_use; + # Cut down the line string until it's short enough to fit in term + if ($l1 > $size{'term-cols'}){ + $l2 = length("$num$sep{'s2'} ") + $indent_use + 6; + # print "$l1 $size{'term-cols'} $l2 $num $indent_use\n"; + $item = substr($item,0,$size{'term-cols'} - $l2) . '[...]'; + } + } + $line = "$colors{'c1'}$num$sep{'s2'} $colors{'c2'}$item$colors{'cn'}"; + $line = sprintf("%-${indent_use}s%s\n","","$line"); + print_line($line); + } + + } + } + # We want a space between data blocks for single + print_line("\n") if $b_single; + } +} + +sub print_line { + my ($line) = @_; + if ($b_irc && $client{'test-konvi'}){ + $client{'konvi'} = 3; + $client{'dobject'} = 'Konversation'; + } + if ($client{'konvi'} == 1 && $client{'dcop'}){ + # konvi doesn't seem to like \n characters, it just prints them literally + $line =~ s/\n//g; + #qx('dcop "$client{'dport'}" "$client{'dobject'}" say "$client{'dserver'}" "$client{'dtarget'}" "$line 1"); + system('dcop', $client{'dport'}, $client{'dobject'}, 'say', $client{'dserver'}, $client{'dtarget'}, "$line 1"); + } + elsif ($client{'konvi'} == 3 && $client{'qdbus'}){ + # print $line; + $line =~ s/\n//g; + #qx(qdbus org.kde.konversation /irc say "$client{'dserver'}" "$client{'dtarget'}" "$line"); + system('qdbus', 'org.kde.konversation', '/irc', 'say', $client{'dserver'}, $client{'dtarget'}, $line); + } + else { + # print "tl: $size{'term-lines'} ml: $size{'max-lines'} l:$size{'lines'}\n"; + if ($size{'max-lines'}){ + # -y1 + -Y can result in start of output scrolling off screen if terminal + # wrapped lines happen. + if ((($size{'max-lines'} >= $size{'term-lines'}) && + $size{'max-lines'} == $size{'lines'}) || + ($size{'max-lines'} < $size{'term-lines'} && + $size{'max-lines'} + 1 == $size{'lines'})){ + output_control(); + } + } + print $line; + $size{'lines'}++ if $size{'max-lines'}; + } +} + +######################################################################## +#### ITEM PROCESSORS +######################################################################## + +#### ------------------------------------------------------------------- +#### ITEM GENERATORS +#### ------------------------------------------------------------------- + +## AudioItem ## +{ +package AudioItem; + +sub get { + eval $start if $b_log; + my $rows = []; + my $num = 0; + if (%risc && !$use{'soc-audio'} && !$use{'pci-tool'}){ + my $key = 'Message'; + @$rows = ({ + main::key($num++,0,1,$key) => main::message('risc-pci',$risc{'id'}) + }); + } + else { + device_output($rows); + } + if (((%risc && !$use{'soc-audio'} && !$use{'pci-tool'}) || !@$rows) && + (my $file = $system_files{'asound-cards'})){ + asound_output($rows,$file); + } + usb_output($rows); + # note: for servers often no audio, so we don't care about pci specific + if (!@$rows){ + my $key = 'Message'; + my $type = 'device-data'; + if ($pci_tool && $alerts{$pci_tool}->{'action'} eq 'permissions'){ + $type = 'pci-card-data-root'; + } + @$rows = ({main::key($num++,0,1,$key) => main::message($type,'')}); + } + sound_output($rows); + eval $end if $b_log; + return $rows; +} + +sub device_output { + eval $start if $b_log; + return if !$devices{'audio'}; + my $rows = $_[0]; + my ($j,$num) = (0,1); + foreach my $row (@{$devices{'audio'}}){ + $num = 1; + $j = scalar @$rows; + my $driver = $row->[9]; + $driver ||= 'N/A'; + my $device = $row->[4]; + $device = ($device) ? main::clean_pci($device,'output') : 'N/A'; + # have seen absurdly verbose card descriptions, with non related data etc + if (length($device) > 85 || $size{'max-cols'} < 110){ + main::filter_pci_long(\$device); + } + push(@$rows, { + main::key($num++,1,1,'Device') => $device, + }); + if ($extra > 0 && $use{'pci-tool'} && $row->[12]){ + my $item = main::get_pci_vendor($row->[4],$row->[12]); + $rows->[$j]{main::key($num++,0,2,'vendor')} = $item if $item; + } + $rows->[$j]{main::key($num++,1,2,'driver')} = $driver; + if ($extra > 0 && !$bsd_type){ + if ($row->[9]){ + my $version = main::get_module_version($row->[9]); + $rows->[$j]{main::key($num++,0,3,'v')} = $version if $version; + } + } + if ($b_admin && $row->[10]){ + $row->[10] = main::get_driver_modules($row->[9],$row->[10]); + $rows->[$j]{main::key($num++,0,3,'alternate')} = $row->[10] if $row->[10]; + } + if ($extra > 0){ + my $bus_id = (!$row->[2] && !$row->[3]) ? 'N/A' : "$row->[2].$row->[3]"; + if ($extra > 1 && $bus_id ne 'N/A'){ + main::get_pcie_data($bus_id,$j,$rows,\$num); + } + $rows->[$j]{main::key($num++,0,2,'bus-ID')} = $bus_id; + } + if ($extra > 1){ + my $chip_id = main::get_chip_id($row->[5],$row->[6]); + $rows->[$j]{main::key($num++,0,2,'chip-ID')} = $chip_id; + if ($extra > 2 && $row->[1]){ + $rows->[$j]{main::key($num++,0,2,'class-ID')} = $row->[1]; + } + } + # print "$row->[0]\n"; + } + eval $end if $b_log; +} + +# this handles fringe cases where there is no card on pcibus, +# but there is a card present. I don't know the exact architecture +# involved but I know this situation exists on at least one old machine. +sub asound_output { + eval $start if $b_log; + my ($file,$rows) = @_; + my ($device,$driver,$j,$num) = ('','',0,1); + my @asound = main::reader($file); + foreach (@asound){ + # filtering out modems and usb devices like webcams, this might get a + # usb audio card as well, this will take some trial and error + if (!/modem|usb/i && /^\s*[0-9]/){ + $num = 1; + my @working = split(/:\s*/, $_); + # now let's get 1 2 + $working[1] =~ /(.*)\s+-\s+(.*)/; + $device = $2; + $driver = $1; + if ($device){ + $j = scalar @$rows; + $driver ||= 'N/A'; + push(@$rows, { + main::key($num++,1,1,'Device') => $device, + main::key($num++,1,2,'driver') => $driver, + }); + if ($extra > 0){ + my $version = main::get_module_version($driver); + $rows->[$j]{main::key($num++,0,3,'v')} = $version if $version; + $rows->[$j]{main::key($num++,0,2,'message')} = main::message('pci-advanced-data',''); + } + } + } + } + # print Data::Dumper:Dumper $rows; + eval $end if $b_log; +} + +sub usb_output { + eval $start if $b_log; + my $rows = $_[0]; + my (@ids,$path_id,$product,@temp2); + my ($j,$num) = (0,1); + return if !$usb{'audio'}; + foreach my $row (@{$usb{'audio'}}){ + $num = 1; + $j = scalar @$rows; + # make sure to reset, or second device trips last flag + ($path_id,$product) = ('',''); + $product = main::clean($row->[13]) if $row->[13]; + $product ||= 'N/A'; + $row->[15] ||= 'N/A'; + push(@$rows, { + main::key($num++,1,1,'Device') => $product, + main::key($num++,0,2,'driver') => $row->[15], + main::key($num++,1,2,'type') => 'USB', + }); + if ($extra > 0){ + # print "$j \n"; + if ($extra > 1){ + $row->[8] ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'rev')} = $row->[8]; + if ($row->[17]){ + $rows->[$j]{main::key($num++,0,3,'speed')} = $row->[17]; + } + if ($row->[24]){ + $rows->[$j]{main::key($num++,0,3,'lanes')} = $row->[24]; + } + if ($b_admin && $row->[22]){ + $rows->[$j]{main::key($num++,0,3,'mode')} = $row->[22]; + } + } + $path_id = $row->[2] if $row->[2]; + $rows->[$j]{main::key($num++,0,2,'bus-ID')} = "$path_id:$row->[1]"; + if ($extra > 1){ + $row->[7] ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'chip-ID')} = $row->[7]; + } + if ($extra > 2){ + if (defined $row->[5] && $row->[5] ne ''){ + $rows->[$j]{main::key($num++,0,2,'class-ID')} = "$row->[4]$row->[5]"; + } + if ($row->[16]){ + $rows->[$j]{main::key($num++,0,2,'serial')} = main::filter($row->[16]); + } + } + } + } + eval $end if $b_log; +} + +sub sound_output { + eval $start if $b_log; + my $rows = $_[0]; + my ($key,$program,$value); + my ($j,$num) = (0,0); + foreach my $server (@{sound_data()}){ + next if $extra < 1 && (!$server->[3] || $server->[3] !~ /^(active|.*api)/); + $j = scalar @$rows; + $server->[2] ||= 'N/A'; + $server->[3] ||= 'N/A'; + push(@$rows, { + main::key($num++,1,1,$server->[0]) => $server->[1], + main::key($num++,0,2,'v') => $server->[2], + main::key($num++,0,2,'status') => $server->[3], + }); + if ($extra > 1 && defined $server->[4] && ref $server->[4] eq 'ARRAY'){ + my $b_multi = (scalar @{$server->[4]} > 1) ? 1: 0; + my $b_start; + my $k = 0; + foreach my $item (@{$server->[4]}){ + if ($item->[2] eq 'daemon'){ + $key = 'status'; + $value = $item->[3]; + } + else { + $key = 'type'; + $value = $item->[2]; + } + if (!$b_multi){ + $rows->[$j]{main::key($num++,1,2,$item->[0])} = $item->[1]; + $rows->[$j]{main::key($num++,0,3,$key)} = $value; + } + else { + $rows->[$j]{main::key($num++,1,2,$item->[0])} = '' if !$b_start; + $b_start = 1; + $k++; + $rows->[$j]{main::key($num++,1,3,$k)} = $item->[1]; + $rows->[$j]{main::key($num++,0,4,$key)} = $value; + } + } + } + if ($b_admin){ + # Let long lines wrap for high tool counts, but best avoid too many tools + my $join = (defined $server->[5] && length(join(',',@{$server->[5]})) > 40) ? ', ': ','; + my $val = (defined $server->[5]) ? join($join,@{$server->[5]}) : 'N/A'; + $rows->[$j]{main::key($num++,0,2,'tools')} = $val; + } + } + eval $end if $b_log; +} + +# see docs/inxi-audio.txt for unused or alternate helpers/tools +sub sound_data { + eval $start if $b_log; + my ($config,$helpers,$name,$program,$status,$test,$tools,$type,$version); + my $data = []; + ## API Types ## + # not yet, user lib: || main::globber('/usr/lib*{,/*}/libasound.so*') + # the config test is expensive but will only trigger on servers with no audio + # devices. Checks if kernel was compiled with SND_ items, even if no devices. + if (!$bsd_type && -r "/boot/config-$uname[2]"){ + $config = "/boot/config-$uname[2]"; + } + if ($system_files{'asound-version'} || + ($config && (grep {/^CONFIG_SND_/} @{main::reader($config,'','ref')}))){ + $name = 'ALSA'; + $type = 'API'; + # always true until find better test for inactive API test + if ($system_files{'asound-version'}){ + # avoid possible second line if compiled by user + my $content = main::reader($system_files{'asound-version'},'',0); + # we want the string after driver version for old and new ALSA + # some alsa strings have the build date in (...) after Version + if ($content =~ /Driver Version (\S+)(\s|\.?$)/){ + $version = $1; + $version =~ s/\.$//; # trim off period + } + $status = 'kernel-api'; + } + else { + $status = 'inactive'; + $version = $uname[2]; + $version =~ s/^k//; # avoid double kk possible result + $version = 'k' . $version; + } + if ($extra > 1){ + $test = [['osspd','daemon'],['aoss','oss-emulator'], + ['apulse','pulse-emulator'],]; + $helpers = sound_helpers($test); + } + if ($b_admin){ + $test = [qw(alsactl alsamixer alsamixergui amixer)]; + $tools = sound_tools($test); + } + push(@$data,[$type,$name,$version,$status,$helpers,$tools]); + ($status,$version,$helpers,$tools) = ('','',undef,undef); + } + # sndstat file may be removed in linux oss, but ossinfo part of oss4-base + # alsa oss compat driver will create /dev/sndstat in linux however + # Note: kernel compile: SOUND_OSS + if ((-e '/dev/sndstat' && !$system_files{'asound-version'}) || + main::check_program('ossinfo')){ + $name = 'OSS'; + # not a great test, but ok for now, check on current Linux, seems unlikely + # to find OSS on OpenBSD in general. + if ($bsd_type){ + $status = (-e '/dev/sndstat') ? 'kernel-api' : 'inactive'; + } + else { + $status = (-e '/dev/sndstat') ? 'active' : 'off?'; + } + $type = 'API'; # not strictly an API on linux, but almost nobody uses it. + # not certain to be cross distro, Debian/Ubuntu at least. + if (-e '/etc/oss4/version.dat'){ + $version = main::reader('/etc/oss4/version.dat','',0); + } + elsif ($sysctl{'audio'}){ + $version = (grep {/^hw.snd.version:/} @{$sysctl{'audio'}})[0]; + $version = (split(/:\s*/,$version),1)[1] if $version; + $version =~ s|/.*$|| if $version; + } + if ($extra > 1){ + # virtual_oss freebsd, not verified; osspd-alsa/pulseaudio no path exec + $test = [['virtual_oss','daemon'],['virtual_equalizer','plugin']]; + $helpers = sound_helpers($test); + } + if ($b_admin){ + # *mixer are FreeBSD tools + $test = [qw(dsbmixer mixer ossctl ossinfo ossmix ossxmix vmixctl)]; + $tools = sound_tools($test); + } + push(@$data,[$type,$name,$version,$status,$helpers,$tools]); + ($status,$version,$helpers,$tools) = ('','',undef,undef); + } + if ($program = main::check_program('sndiod')){ + if ($bsd_type){ + push(@$data, ['API','sndio',undef,'sound-api',undef,undef]); + } + $name = 'sndiod'; + # verified: accurate + $status = (grep {/sndiod/} @ps_cmd) ? 'active': 'off'; + $type = 'Server'; + # $version: no known method + if ($b_admin){ + $test = [qw(aucat midicat mixerctl sndioctl)]; + $tools = sound_tools($test); + } + push(@$data,[$type,$name,$version,$status,$helpers,$tools]); + ($status,$version,$helpers,$tools) = ('','',undef,undef); + } + ## Servers ## + if ($program = main::check_program('artsd')){ + ($name,$version) = ProgramData::full('arts',$program); + $status = (grep {/artsd/} @ps_cmd) ? 'active': 'off'; + $type = 'Server'; + if ($extra > 1){ + $test = [['artswrapper','daemon'],]; + $helpers = sound_helpers($test); + } + if ($b_admin){ + $test = [qw(artsbuilder artsdsp)]; + $tools = sound_tools($test); + } + push(@$data,[$type,$name,$version,$status,$helpers,$tools]); + ($status,$version,$helpers,$tools) = ('','',undef,undef); + } + # pulseaudio-esound-compat has esd pointing to esdcompat + if (($program = main::check_program('esd')) && + !main::check_program('esdcompat')){ + ($name,$version) = ProgramData::full('esound',$program); + $status = (grep {/\besd\b/} @ps_cmd) ? 'active': 'off'; + $type = 'Server'; + # if ($extra > 1){ + # $test = [['','daemon'],]; + # $helpers = sound_helpers($test); + # } + if ($b_admin){ + $test = [qw(esdcat esdctl esddsp)]; + $tools = sound_tools($test); + } + push(@$data,[$type,$name,$version,$status,$helpers,$tools]); + ($status,$version,$helpers,$tools) = ('','',undef,undef); + } + if ($program = main::check_program('jackd')){ + ($name,$version) = ProgramData::full('jack',$program); + $status = jack_status(); + $type = 'Server'; + if ($extra > 1){ + $test = [['a2jmidid','daemon'],['nsmd','daemon']]; + $helpers = sound_helpers($test); + } + if ($b_admin){ + $test = [qw(agordejo cadence jack_control jack_mixer qjackctl)]; + $tools = sound_tools($test); + } + push(@$data,[$type,$name,$version,$status,$helpers,$tools]); + ($status,$version,$helpers,$tools) = ('','',undef,undef); + } + if ($program = main::check_program('nasd')){ + ($name,$version) = ProgramData::full('nas',$program); + $status = (grep {/(^|\/)nasd/} @ps_cmd) ? 'active': 'off'; + $type = 'Server'; + if ($extra > 1){ + $test = [['audiooss','oss-compat'],]; + $helpers = sound_helpers($test); + } + if ($b_admin){ + $test = [qw(auctl auinfo)]; + $tools = sound_tools($test); + } + push(@$data,[$type,$name,$version,$status,$helpers,$tools]); + ($status,$version,$helpers,$tools) = ('','',undef,undef); + } + if ($program = main::check_program('pipewire')){ + ($name,$version) = ProgramData::full('pipewire',$program); + $status = pipewire_status(); + $type = 'Server'; + if ($extra > 1){ + # pipewire-alsa is a plugin, but is just some config files + $test = [['pipewire-pulse','daemon'],['pipewire-media-session','daemon'], + ['wireplumber','daemon'], + ['pipewire-alsa','plugin','/etc/alsa/conf.d/*-pipewire-default.conf'], + ['pw-jack','plugin']]; + $helpers = sound_helpers($test); + } + if ($b_admin){ + $test = [qw(pw-cat pw-cli wpctl)]; + # note: pactl can be used w/pipewire-pulse; + if (!main::check_program('pulseaudio') && + main::check_program('pipewire-pulse')){ + splice(@$test,0,0,'pactl'); + } + $tools = sound_tools($test); + } + push(@$data,[$type,$name,$version,$status,$helpers,$tools]); + ($status,$version,$helpers,$tools) = ('','',undef,undef); + } + # note: pactl info/list/stat could be used + if ($program = main::check_program('pulseaudio')){ + ($name,$version) = ProgramData::full('pulseaudio',$program); + $status = pulse_status($program); + $type = 'Server'; + if ($extra > 1){ + $test = [['pulseaudio-dlna','daemon'], + ['pulseaudio-alsa','plugin','/etc/alsa/conf.d/*-pulseaudio-default.conf'], + ['esdcompat','plugin'], + ['pulseaudio-jack','module','/usr/lib/pulse*/modules/module-jack-sink.so']]; + $helpers = sound_helpers($test); + } + if ($b_admin){ + $test = [qw(pacat pactl paman pamix pamixer pavucontrol pulsemixer)]; + $tools = sound_tools($test); + } + push(@$data,[$type,$name,$version,$status,$helpers,$tools]); + ($status,$version,$helpers,$tools) = ('','',undef,undef); + } + if ($program = main::check_program('roard')){ + ($name,$version) = ProgramData::full('roaraudio',$program);# no version so far + $status = (grep {/roard/} @ps_cmd) ? 'active': 'off'; + $type = 'Server'; + if ($extra > 1){ + $test = [['roarplaylistd','daemon'],['roarify','pulse/viff-emulation']]; + $helpers = sound_helpers($test); + } + if ($b_admin){ + $test = [qw(roarcat roarctl)]; + $tools = sound_tools($test); + } + push(@$data,[$type,$name,$version,$status,$helpers,$tools]); + ($status,$version,$helpers,$tools) = ('','',undef,undef); + } + main::log_data('dump','sound data: @$data',$data) if $b_log; + print 'Sound data: ', Data::Dumper::Dumper $data if $dbg[26]; + eval $end if $b_log; + return $data; +} + +# assume if jackd running we have active jack, update if required +sub jack_status { + eval $start if $b_log; + my $status; + if (grep {/jackd/} @ps_cmd){ + if (my $program = main::check_program('jack_control')){ + system("$program status > /dev/null 2>&1"); + # 0 means running, always, else 1. + if ($? == 0){ + $status = 'active'; + } + else { + $status = ($b_root) ? main::message('audio-server-root-na') : 'off'; + } + } + $status = main::message('audio-server-process-on') if !$status; + } + else { + $status = 'off'; + } + eval $end if $b_log; + return $status; +} + +# pipewire is complicated, it can be there and running without being active server +# This is NOT verified as valid true/yes case!! +sub pipewire_status { + eval $start if $b_log; + my ($b_process,$program,$status,@data); + if (grep {/(^|\/)pipewire(d|\s|:|$)/} @ps_cmd){ + # note: if pipewire was stopped but not masked, pw-cli can start service so + # only use if pipewire process already running + if ($program = main::check_program('pw-cli')){ + @data = qx($program ls 2>/dev/null); + main::log_data('dump','pw-cli @data', \@data) if $b_log; + print 'pw-cli: ', Data::Dumper::Dumper \@data if $dbg[52]; + if (@data){ + $status = (grep {/media\.class\s*=\s*"(Audio|Midi)/i} @data) ? 'active' : 'off'; + } + elsif ($b_root){ + $status = main::message('audio-server-root-na'); + } + } + $status = main::message('audio-server-process-on') if !$status; + } + else { + $status = 'off'; + } + eval $end if $b_log; + return $status; +} + +# pulse might be running through pipewire +sub pulse_status { + eval $start if $b_log; + my $program = $_[0]; + my ($status,@data); + if (grep {/(^|\/)pulseaudiod?\b/} @ps_cmd){ + # this is almost certainly not needed, but keep for now + system("$program --check > /dev/null 2>&1"); + # 0 means running, always, other could be an error. + if ($? == 0){ + $status = 'active'; + } + else { + $status = ($b_root) ? main::message('audio-server-root-on') : 'off'; + } + } + else { + # can't use pactl info test because starts pulseaudio/pipewire if unmasked + if (main::check_program('pipewire-pulse') && + (grep {/(^|\/)pipewire-pulse/} @ps_cmd)){ + $status = main::message('audio-server-on-pipewire-pulse'); + } + else { + $status = 'off'; + } + } + eval $end if $b_log; + return $status; +} + +sub sound_helpers { + eval $start if $b_log; + my $test = $_[0]; + my ($helpers,$name,$status,$key); + foreach my $item (@$test){ + if (main::check_program($item->[0]) || + (defined $item->[2] && main::globber($item->[2]))){ + $name = $item->[0]; + $key = 'with'; + # these are active/off daemons unless not a daemon + if ($item->[1] eq 'daemon'){ + $status = (grep {/$item->[0]/} @ps_cmd) ? 'active':'off' ; + } + else { + $status = $item->[1]; + } + push(@$helpers,[$key,$name,$item->[1],$status]); + } + } + # push(@$helpers, ['with','pipewire-pulse','daemon','active'],['with','pw-jack','plugin']); + # push(@$helpers, ['with','pipewire-pulse','daemon','active']); + eval $end if $b_log; + # print Data::Dumper::Dumper $helpers; + return $helpers; +} + +sub sound_tools { + eval $start if $b_log; + my $test = $_[0]; + my $tools; + foreach my $item (@$test){ + if (main::check_program($item)){ + push(@$tools,$item); + } + } + eval $end if $b_log; + # print Data::Dumper::Dumper $tools; + return $tools; +} +} + +## BatteryItem ## +{ +package BatteryItem; +my (@upower_items,$b_upower,$upower); + +sub get { + eval $start if $b_log; + my ($key1,$val1); + my $battery = {}; + my $rows = []; + my $num = 0; + if ($force{'dmidecode'}){ + if ($alerts{'dmidecode'}->{'action'} ne 'use'){ + $key1 = $alerts{'dmidecode'}->{'action'}; + $val1 = $alerts{'dmidecode'}->{'message'}; + $key1 = ucfirst($key1); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); + } + else { + battery_data_dmi($battery); + if (!%$battery){ + if ($show{'battery-forced'}){ + $key1 = 'Message'; + $val1 = main::message('battery-data',''); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); + } + } + else { + battery_output($rows,$battery); + } + } + } + elsif ($bsd_type && ($sysctl{'battery'} || $show{'battery-forced'})){ + battery_data_sysctl($battery) if $sysctl{'battery'}; + if (!%$battery){ + if ($show{'battery-forced'}){ + $key1 = 'Message'; + $val1 = main::message('battery-data-bsd',''); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); + } + } + else { + battery_output($rows,$battery); + } + } + elsif (-d '/sys/class/power_supply/'){ + battery_data_sys($battery); + if (!%$battery){ + if ($show{'battery-forced'}){ + $key1 = 'Message'; + $val1 = main::message('battery-data',''); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); + } + } + else { + battery_output($rows,$battery); + } + } + else { + if ($show{'battery-forced'}){ + $key1 = 'Message'; + $val1 = (!$bsd_type) ? main::message('battery-data-sys'): main::message('battery-data-bsd'); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); + } + } + (@upower_items,$b_upower,$upower) = (); + eval $end if $b_log; + return $rows; +} + +# alarm capacity capacity_level charge_full charge_full_design charge_now +# cycle_count energy_full energy_full_design energy_now location manufacturer model_name +# power_now present serial_number status technology type voltage_min_design voltage_now +# 0: name - battery id, not used +# 1: status +# 2: present +# 3: technology +# 4: cycle_count +# 5: voltage_min_design +# 6: voltage_now +# 7: power_now +# 8: energy_full_design +# 9: energy_full +# 10: energy_now +# 11: capacity +# 12: capacity_level +# 13: of_orig +# 14: model_name +# 15: manufacturer +# 16: serial_number +# 17: location +sub battery_output { + eval $start if $b_log; + my ($rows,$battery) = @_; + my ($key); + my $num = 0; + my $j = 0; + # print Data::Dumper::Dumper $battery; + foreach $key (sort keys %$battery){ + $num = 0; + my ($charge,$condition,$model,$serial,$status) = ('','','','',''); + my ($chemistry,$cycles,$location) = ('','',''); + next if !$battery->{$key}{'purpose'} || $battery->{$key}{'purpose'} ne 'primary'; + # $battery->{$key}{''}; + # we need to handle cases where charge or energy full is 0 + if (defined $battery->{$key}{'energy_now'} && $battery->{$key}{'energy_now'} ne ''){ + $charge = "$battery->{$key}{'energy_now'} Wh"; + if ($battery->{$key}{'energy_full'} && + main::is_numeric($battery->{$key}{'energy_full'})){ + my $percent = sprintf("%.1f", $battery->{$key}{'energy_now'}/$battery->{$key}{'energy_full'}*100); + $charge .= ' (' . $percent . '%)'; + } + } + # better than nothing, shows the charged percent + elsif (defined $battery->{$key}{'capacity'} && $battery->{$key}{'capacity'} ne ''){ + $charge = $battery->{$key}{'capacity'} . '%' + } + else { + $charge = 'N/A'; + } + if ($battery->{$key}{'energy_full'} || $battery->{$key}{'energy_full_design'}){ + $battery->{$key}{'energy_full_design'} ||= 'N/A'; + $battery->{$key}{'energy_full'} = (defined $battery->{$key}{'energy_full'} && + $battery->{$key}{'energy_full'} ne '') ? $battery->{$key}{'energy_full'} : 'N/A'; + $condition = "$battery->{$key}{'energy_full'}/$battery->{$key}{'energy_full_design'} Wh"; + if ($battery->{$key}{'of_orig'}){ + $condition .= " ($battery->{$key}{'of_orig'}%)"; + } + } + $condition ||= 'N/A'; + $j = scalar @$rows; + push(@$rows, { + main::key($num++,1,1,'ID') => $key, + main::key($num++,0,2,'charge') => $charge, + main::key($num++,0,2,'condition') => $condition, + }); + if ($extra > 2){ + if ($battery->{$key}{'power_now'}){ + $rows->[$j]{main::key($num++,0,2,'power')} = sprintf('%0.1f W',($battery->{$key}{'power_now'}/10**6)); + } + } + if ($extra > 0 || ($battery->{$key}{'voltage_now'} && + $battery->{$key}{'voltage_min_design'} && + ($battery->{$key}{'voltage_now'} - $battery->{$key}{'voltage_min_design'}) < 0.5)){ + $battery->{$key}{'voltage_now'} ||= 'N/A'; + $rows->[$j]{main::key($num++,1,2,'volts')} = $battery->{$key}{'voltage_now'}; + if ($battery->{$key}{'voltage_now'} ne 'N/A' || $battery->{$key}{'voltage_min_design'}){ + $battery->{$key}{'voltage_min_design'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'min')} = $battery->{$key}{'voltage_min_design'}; + } + } + if ($extra > 0){ + if ($battery->{$key}{'manufacturer'} || $battery->{$key}{'model_name'}){ + if ($battery->{$key}{'manufacturer'} && $battery->{$key}{'model_name'}){ + $model = "$battery->{$key}{'manufacturer'} $battery->{$key}{'model_name'}"; + } + elsif ($battery->{$key}{'manufacturer'}){ + $model = $battery->{$key}{'manufacturer'}; + } + elsif ($battery->{$key}{'model_name'}){ + $model = $battery->{$key}{'model_name'}; + } + } + else { + $model = 'N/A'; + } + $rows->[$j]{main::key($num++,0,2,'model')} = $model; + if ($extra > 2){ + $chemistry = ($battery->{$key}{'technology'}) ? $battery->{$key}{'technology'}: 'N/A'; + $rows->[$j]{main::key($num++,0,2,'type')} = $chemistry; + } + if ($extra > 1){ + $serial = main::filter($battery->{$key}{'serial_number'}); + $rows->[$j]{main::key($num++,0,2,'serial')} = $serial; + } + $status = ($battery->{$key}{'status'}) ? $battery->{$key}{'status'}: 'N/A'; + $rows->[$j]{main::key($num++,0,2,'status')} = $status; + if ($extra > 2){ + if ($battery->{$key}{'cycle_count'}){ + $rows->[$j]{main::key($num++,0,2,'cycles')} = $battery->{$key}{'cycle_count'}; + } + if ($battery->{$key}{'location'}){ + $rows->[$j]{main::key($num++,0,2,'location')} = $battery->{$key}{'location'}; + } + } + } + $battery->{$key} = undef; + } + # print Data::Dumper::Dumper \%$battery; + # now if there are any devices left, print them out, excluding Mains + if ($extra > 0){ + $upower = main::check_program('upower'); + foreach $key (sort keys %$battery){ + $num = 0; + next if !defined $battery->{$key} || $battery->{$key}{'purpose'} eq 'mains'; + my ($charge,$model,$serial,$percent,$status,$vendor) = ('','','','','',''); + $j = scalar @$rows; + my $upower_data = ($upower) ? upower_data($key) : {}; + if ($upower_data->{'percent'}){ + $charge = $upower_data->{'percent'}; + } + elsif ($battery->{$key}{'capacity_level'} && + lc($battery->{$key}{'capacity_level'}) ne 'unknown'){ + $charge = $battery->{$key}{'capacity_level'}; + } + else { + $charge = 'N/A'; + } + $model = $battery->{$key}{'model_name'} if $battery->{$key}{'model_name'}; + $vendor = $battery->{$key}{'manufacturer'} if $battery->{$key}{'manufacturer'}; + if ($vendor || $model){ + if ($vendor && $model){ + $model = "$vendor $model"; + } + elsif ($vendor){ + $model = $vendor; + } + } + else { + $model = 'N/A'; + } + push(@$rows, { + main::key($num++,1,1,'Device') => $key, + main::key($num++,0,2,'model') => $model, + },); + if ($extra > 1){ + $serial = main::filter($battery->{$key}{'serial_number'}); + $rows->[$j]{main::key($num++,0,2,'serial')} = $serial; + } + $rows->[$j]{main::key($num++,0,2,'charge')} = $charge; + if ($extra > 2 && $upower_data->{'rechargeable'}){ + $rows->[$j]{main::key($num++,0,2,'rechargeable')} = $upower_data->{'rechargeable'}; + } + $status = ($battery->{$key}{'status'}) ? $battery->{$key}{'status'}: 'N/A' ; + $rows->[$j]{main::key($num++,0,2,'status')} = $status; + } + } + eval $end if $b_log; +} + +# charge: mAh energy: Wh +sub battery_data_sys { + eval $start if $b_log; + my $battery = $_[0]; + my ($b_ma,$file,$id,$item,$path,$value); + my $num = 0; + my @batteries = main::globber("/sys/class/power_supply/*"); + # note: there is no 'location' file, but dmidecode has it + # 'type' is generic, like: Battery, Mains + # capacity_level is a string, like: Normal + my @items = qw(alarm capacity capacity_level charge_full charge_full_design + charge_now constant_charge_current constant_charge_current_max cycle_count + energy_full energy_full_design energy_now location manufacturer model_name + power_now present scope serial_number status technology type voltage_min_design + voltage_now); + foreach $item (@batteries){ + $b_ma = 0; + $id = $item; + $id =~ s%/sys/class/power_supply/%%g; + foreach $file (@items){ + $path = "$item/$file"; + # android shows some files only root readable + $value = (-r $path) ? main::reader($path,'',0): ''; + # mains, plus in psu + if ($file eq 'type' && $value && lc($value) ne 'battery'){ + $battery->{$id}{'purpose'} = 'mains'; + } + if ($value){ + $value = main::trimmer($value); + if ($file eq 'voltage_min_design'){ + $value = sprintf("%.1f", $value/1000000); + } + elsif ($file eq 'voltage_now'){ + $value = sprintf("%.1f", $value/1000000); + } + elsif ($file eq 'energy_full_design'){ + $value = $value/1000000; + } + elsif ($file eq 'energy_full'){ + $value = $value/1000000; + } + elsif ($file eq 'energy_now'){ + $value = sprintf("%.1f", $value/1000000); + } + # note: the following 3 were off, 100000 instead of 1000000 + # why this is, I do not know. I did not document any reason for that + # so going on assumption it is a mistake. + # CHARGE is mAh, which are converted to Wh by: mAh x voltage. + # Note: voltage fluctuates so will make results vary slightly. + elsif ($file eq 'charge_full_design'){ + $value = $value/1000000; + $b_ma = 1; + } + elsif ($file eq 'charge_full'){ + $value = $value/1000000; + $b_ma = 1; + } + elsif ($file eq 'charge_now'){ + $value = $value/1000000; + $b_ma = 1; + } + elsif ($file eq 'manufacturer'){ + $value = main::clean_dmi($value); + } + elsif ($file eq 'model_name'){ + $value = main::clean_dmi($value); + } + # Valid values: Unknown,Charging,Discharging,Not charging,Full + # don't use clean_unset because Not charging is a valid value. + elsif ($file eq 'status'){ + $value = lc($value); + $value =~ s/unknown//; + + } + } + elsif ($b_root && -e $path && ! -r $path){ + $value = main::message('root-required'); + } + $battery->{$id}{$file} = $value; + # print "$battery->{$id}{$file}\n"; + } + # note, too few data sets, there could be sbs-charger but not sure + if (!$battery->{$id}{'purpose'}){ + # NOTE: known ids: BAT[0-9] CMB[0-9]. arm may be like: sbs- sbm- but just check + # if the energy/charge values exist for this item, if so, it's a battery, if not, + # it's a device. + if ($id =~ /^(BAT|CMB).*$/i || + ($battery->{$id}{'energy_full'} || $battery->{$id}{'charge_full'} || + $battery->{$id}{'energy_now'} || $battery->{$id}{'charge_now'} || + $battery->{$id}{'energy_full_design'} || $battery->{$id}{'charge_full_design'}) || + $battery->{$id}{'voltage_min_design'} || $battery->{$id}{'voltage_now'}){ + $battery->{$id}{'purpose'} = 'primary'; + } + else { + $battery->{$id}{'purpose'} = 'device'; + } + } + # note:voltage_now fluctuates, which will make capacity numbers change a bit + # if any of these values failed, the math will be wrong, but no way to fix that + # tests show more systems give right capacity/charge with voltage_min_design + # than with voltage_now + if ($b_ma && $battery->{$id}{'voltage_min_design'}){ + if ($battery->{$id}{'charge_now'}){ + $battery->{$id}{'energy_now'} = $battery->{$id}{'charge_now'} * $battery->{$id}{'voltage_min_design'}; + } + if ($battery->{$id}{'charge_full'}){ + $battery->{$id}{'energy_full'} = $battery->{$id}{'charge_full'}*$battery->{$id}{'voltage_min_design'}; + } + if ($battery->{$id}{'charge_full_design'}){ + $battery->{$id}{'energy_full_design'} = $battery->{$id}{'charge_full_design'} * $battery->{$id}{'voltage_min_design'}; + } + } + if ($battery->{$id}{'energy_now'} && $battery->{$id}{'energy_full'}){ + $battery->{$id}{'capacity'} = 100 * $battery->{$id}{'energy_now'}/$battery->{$id}{'energy_full'}; + $battery->{$id}{'capacity'} = sprintf("%.1f", $battery->{$id}{'capacity'}); + } + if ($battery->{$id}{'energy_full_design'} && $battery->{$id}{'energy_full'}){ + $battery->{$id}{'of_orig'} = 100 * $battery->{$id}{'energy_full'}/$battery->{$id}{'energy_full_design'}; + $battery->{$id}{'of_orig'} = sprintf("%.1f", $battery->{$id}{'of_orig'}); + } + if ($battery->{$id}{'energy_now'}){ + $battery->{$id}{'energy_now'} = sprintf("%.1f", $battery->{$id}{'energy_now'}); + } + if ($battery->{$id}{'energy_full_design'}){ + $battery->{$id}{'energy_full_design'} = sprintf("%.1f",$battery->{$id}{'energy_full_design'}); + } + if ($battery->{$id}{'energy_full'}){ + $battery->{$id}{'energy_full'} = sprintf("%.1f", $battery->{$id}{'energy_full'}); + } + } + print Data::Dumper::Dumper $battery if $dbg[33]; + main::log_data('dump','sys: %$battery',$battery) if $b_log; + eval $end if $b_log; +} + +sub battery_data_sysctl { + eval $start if $b_log; + my $battery = $_[0]; + my ($id); + for (@{$sysctl{'battery'}}){ + if (/^(hw\.sensors\.)acpi([^\.]+)(\.|:)/){ + $id = uc($2); + } + if (/volt[^:]+:([0-9\.]+)\s+VDC\s+\(voltage\)/){ + $battery->{$id}{'voltage_min_design'} = $1; + } + elsif (/volt[^:]+:([0-9\.]+)\s+VDC\s+\(current voltage\)/){ + $battery->{$id}{'voltage_now'} = $1; + } + elsif (/watthour[^:]+:([0-9\.]+)\s+Wh\s+\(design capacity\)/){ + $battery->{$id}{'energy_full_design'} = $1; + } + elsif (/watthour[^:]+:([0-9\.]+)\s+Wh\s+\(last full capacity\)/){ + $battery->{$id}{'energy_full'} = $1; + } + elsif (/watthour[^:]+:([0-9\.]+)\s+Wh\s+\(remaining capacity\)/){ + $battery->{$id}{'energy_now'} = $1; + } + elsif (/amphour[^:]+:([0-9\.]+)\s+Ah\s+\(design capacity\)/){ + $battery->{$id}{'charge_full_design'} = $1; + } + elsif (/amphour[^:]+:([0-9\.]+)\s+Ah\s+\(last full capacity\)/){ + $battery->{$id}{'charge_full'} = $1; + } + elsif (/amphour[^:]+:([0-9\.]+)\s+Ah\s+\(remaining capacity\)/){ + $battery->{$id}{'charge_now'} = $1; + } + elsif (/raw[^:]+:[0-9\.]+\s+\((battery) ([^\)]+)\)/){ + $battery->{$id}{'status'} = $2; + } + elsif (/^acpi[\S]+:at [^:]+:\s*$id\s+/i){ + if (/\s+model\s+(.*?)\s*/){ + $battery->{$id}{'model_name'} = main::clean_dmi($1); + } + if (/\s*serial\s+([\S]*?)\s*/){ + $battery->{$id}{'serial_number'} = main::clean_unset($1,'^(0x)0+$'); + } + if (/\s*type\s+(.*?)\s*/){ + $battery->{$id}{'technology'} = $1; + } + if (/\s*oem\s+(.*)/){ + $battery->{$id}{'manufacturer'} = main::clean_dmi($1); + } + } + } + # then do the condition/charge percent math + for my $id (keys %$battery){ + $battery->{$id}{'purpose'} = 'primary'; + # CHARGE is Ah, which are converted to Wh by: Ah x voltage. + if ($battery->{$id}{'voltage_min_design'}){ + if ($battery->{$id}{'charge_now'}){ + $battery->{$id}{'energy_now'} = $battery->{$id}{'charge_now'} * $battery->{$id}{'voltage_min_design'}; + } + if ($battery->{$id}{'charge_full'}){ + $battery->{$id}{'energy_full'} = $battery->{$id}{'charge_full'}*$battery->{$id}{'voltage_min_design'}; + } + if ($battery->{$id}{'charge_full_design'}){ + $battery->{$id}{'energy_full_design'} = $battery->{$id}{'charge_full_design'} * $battery->{$id}{'voltage_min_design'}; + } + } + if ($battery->{$id}{'energy_full_design'} && $battery->{$id}{'energy_full'}){ + $battery->{$id}{'of_orig'} = 100 * $battery->{$id}{'energy_full'}/$battery->{$id}{'energy_full_design'}; + $battery->{$id}{'of_orig'} = sprintf("%.1f", $battery->{$id}{'of_orig'}); + } + if ($battery->{$id}{'energy_now'} && $battery->{$id}{'energy_full'}){ + $battery->{$id}{'capacity'} = 100 * $battery->{$id}{'energy_now'}/$battery->{$id}{'energy_full'}; + $battery->{$id}{'capacity'} = sprintf("%.1f", $battery->{$id}{'capacity'}); + } + if ($battery->{$id}{'energy_now'}){ + $battery->{$id}{'energy_now'} = sprintf("%.1f", $battery->{$id}{'energy_now'}); + } + if ($battery->{$id}{'energy_full'}){ + $battery->{$id}{'energy_full'} = sprintf("%.1f", $battery->{$id}{'energy_full'}); + } + if ($battery->{$id}{'energy_full_design'}){ + $battery->{$id}{'energy_full_design'} = sprintf("%.1f", $battery->{$id}{'energy_full_design'}); + } + } + print Data::Dumper::Dumper $battery if $dbg[33]; + main::log_data('dump','dmi: %$battery',$battery) if $b_log; + eval $end if $b_log; +} + +# note, dmidecode does not have charge_now or charge_full +sub battery_data_dmi { + eval $start if $b_log; + my $battery = $_[0]; + my ($id); + my $i = 0; + foreach my $row (@dmi){ + # Portable Battery + if ($row->[0] == 22){ + $id = "BAT$i"; + $i++; + $battery->{$id}{'purpose'} = 'primary'; + # skip first three row, we don't need that data + foreach my $item (@$row[3 .. $#$row]){ + my @value = split(/:\s+/, $item); + next if !$value[0]; + if ($value[0] eq 'Location'){ + $battery->{$id}{'location'} = $value[1]} + elsif ($value[0] eq 'Manufacturer'){ + $battery->{$id}{'manufacturer'} = main::clean_dmi($value[1])} + elsif ($value[0] =~ /Chemistry/){ + $battery->{$id}{'technology'} = $value[1]} + elsif ($value[0] =~ /Serial Number/){ + $battery->{$id}{'serial_number'} = $value[1]} + elsif ($value[0] =~ /^Name/){ + $battery->{$id}{'model_name'} = main::clean_dmi($value[1])} + elsif ($value[0] eq 'Design Capacity'){ + $value[1] =~ s/\s*mwh$//i; + $battery->{$id}{'energy_full_design'} = sprintf("%.1f", $value[1]/1000); + } + elsif ($value[0] eq 'Design Voltage'){ + $value[1] =~ s/\s*mv$//i; + $battery->{$id}{'voltage_min_design'} = sprintf("%.1f", $value[1]/1000); + } + } + if ($battery->{$id}{'energy_now'} && $battery->{$id}{'energy_full'}){ + $battery->{$id}{'capacity'} = 100 * $battery->{$id}{'energy_now'} / $battery->{$id}{'energy_full'}; + $battery->{$id}{'capacity'} = sprintf("%.1f%", $battery->{$id}{'capacity'}); + } + if ($battery->{$id}{'energy_full_design'} && $battery->{$id}{'energy_full'}){ + $battery->{$id}{'of_orig'} = 100 * $battery->{$id}{'energy_full'} / $battery->{$id}{'energy_full_design'}; + $battery->{$id}{'of_orig'} = sprintf("%.0f%", $battery->{$id}{'of_orig'}); + } + } + elsif ($row->[0] > 22){ + last; + } + } + print Data::Dumper::Dumper $battery if $dbg[33]; + main::log_data('dump','dmi: %$battery',$battery) if $b_log; + eval $end if $b_log; +} + +sub upower_data { + my ($id) = @_; + eval $start if $b_log; + my $data = {}; + if (!$b_upower && $upower){ + @upower_items = main::grabber("$upower -e 2>/dev/null",'','strip'); + $b_upower = 1; + } + if ($upower && @upower_items){ + foreach (@upower_items){ + if ($_ =~ /$id/){ + my @working = main::grabber("$upower -i $_ 2>/dev/null",'','strip'); + foreach my $row (@working){ + my @temp = split(/\s*:\s*/, $row); + if ($temp[0] eq 'percentage'){ + $data->{'percent'} = $temp[1]; + } + elsif ($temp[0] eq 'rechargeable'){ + $data->{'rechargeable'} = $temp[1]; + } + } + last; + } + } + } + main::log_data('dump','upower: %$data',$data) if $b_log; + eval $end if $b_log; + return $data; +} +} + +## BluetoothItem ## +{ +package BluetoothItem; +my ($b_bluetooth,$b_hci_error,$b_hci,$b_rfk,$b_service); +my ($service); +my (%hci); + +sub get { + eval $start if $b_log; + my $rows = []; + my $num = 0; + if ($fake{'bluetooth'} || (@ps_cmd && (grep {m|/bluetoothd\b|} @ps_cmd))){ + $b_bluetooth = 1; + } + # note: rapi 4 has pci bus + if (%risc && !$use{'soc-bluetooth'} && !$use{'pci-tool'}){ + # do nothing, but keep the test conditions to force + # the non risc case to always run + # my $key = 'Message'; + # @$rows = ({ + # main::key($num++,0,1,$key) => main::message('risc-pci',$risc{'id'}) + # }); + } + else { + device_output($rows); + } + usb_output($rows); + if (!@$rows){ + if ($show{'bluetooth-forced'}){ + my $key = 'Message'; + @$rows = ({main::key($num++,0,1,$key) => main::message('bluetooth-data')}); + } + } + # if there are any unhandled hci items print them out + if (%hci){ + advanced_output($rows,'check',''); + } + eval $end if $b_log; + return $rows; +} + +sub device_output { + eval $start if $b_log; + return if !$devices{'bluetooth'}; + my $rows = $_[0]; + my ($bus_id); + my ($j,$num) = (0,1); + foreach my $row (@{$devices{'bluetooth'}}){ + $num = 1; + $bus_id = ''; + $j = scalar @$rows; + my $driver = ($row->[9]) ? $row->[9] : 'N/A'; + my $device = $row->[4]; + $device = ($device) ? main::clean_pci($device,'output') : 'N/A'; + # have seen absurdly verbose card descriptions, with non related data etc + if (length($device) > 85 || $size{'max-cols'} < 110){ + main::filter_pci_long(\$device); + } + push(@$rows, { + main::key($num++,1,1,'Device') => $device, + },); + if ($extra > 0 && $use{'pci-tool'} && $row->[12]){ + my $item = main::get_pci_vendor($row->[4],$row->[12]); + $rows->[$j]{main::key($num++,0,2,'vendor')} = $item if $item; + } + $rows->[$j]{main::key($num++,1,2,'driver')} = $driver; + if ($extra > 0 && $row->[9] && !$bsd_type){ + my $version = main::get_module_version($row->[9]); + $rows->[$j]{main::key($num++,0,3,'v')} = $version if $version; + } + if ($b_admin && $row->[10]){ + $row->[10] = main::get_driver_modules($row->[9],$row->[10]); + $rows->[$j]{main::key($num++,0,3,'alternate')} = $row->[10] if $row->[10]; + } + if ($extra > 0){ + $bus_id = (!$row->[2] && !$row->[3]) ? 'N/A' : "$row->[2].$row->[3]"; + if ($extra > 1 && $bus_id ne 'N/A'){ + main::get_pcie_data($bus_id,$j,$rows,\$num); + } + $rows->[$j]{main::key($num++,0,2,'bus-ID')} = $bus_id; + } + if ($extra > 1){ + my $chip_id = main::get_chip_id($row->[5],$row->[6]); + $rows->[$j]{main::key($num++,0,2,'chip-ID')} = $chip_id; + if ($extra > 2 && $row->[1]){ + $rows->[$j]{main::key($num++,0,2,'class-ID')} = $row->[1]; + } + } + # weird serial rpi bt + if ($use{'soc-bluetooth'}){ + # /sys/devices/platform/soc/fe201000.serial/ + $bus_id = "$row->[6].$row->[1]" if defined $row->[1] && defined $row->[6]; + } + else { + # only theoretical, never seen one + $bus_id = "$row->[2].$row->[3]" if defined $row->[2] && defined $row->[3]; + } + advanced_output($rows,'pci',$bus_id) if $bus_id; + # print "$row->[0]\n"; + } + eval $end if $b_log; +} + +sub usb_output { + eval $start if $b_log; + return if !$usb{'bluetooth'}; + my $rows = $_[0]; + my ($path_id,$product); + my ($j,$num) = (0,1); + foreach my $row (@{$usb{'bluetooth'}}){ + # print Data::Dumper::Dumper $row; + $num = 1; + $j = scalar @$rows; + # makre sure to reset, or second device trips last flag + ($path_id,$product) = ('',''); + $product = main::clean($row->[13]) if $row->[13]; + $product ||= 'N/A'; + $row->[15] ||= 'N/A'; + $path_id = $row->[2] if $row->[2]; + push(@$rows, { + main::key($num++,1,1,'Device') => $product, + main::key($num++,1,2,'driver') => $row->[15], + },); + if ($extra > 0 && $row->[15] && !$bsd_type){ + my $version = main::get_module_version($row->[15]); + $rows->[$j]{main::key($num++,0,3,'v')} = $version if $version; + } + $rows->[$j]{main::key($num++,1,2,'type')} = 'USB'; + if ($extra > 0){ + if ($extra > 1){ + $row->[8] ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'rev')} = $row->[8]; + if ($row->[17]){ + $rows->[$j]{main::key($num++,0,3,'speed')} = $row->[17]; + } + if ($row->[24]){ + $rows->[$j]{main::key($num++,0,3,'lanes')} = $row->[24]; + } + if ($b_admin && $row->[22]){ + $rows->[$j]{main::key($num++,0,3,'mode')} = $row->[22]; + } + } + $rows->[$j]{main::key($num++,0,2,'bus-ID')} = "$path_id:$row->[1]"; + if ($extra > 1){ + $row->[7] ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'chip-ID')} = $row->[7]; + } + if ($extra > 2){ + if (defined $row->[5] && $row->[5] ne ''){ + $rows->[$j]{main::key($num++,0,2,'class-ID')} = "$row->[4]$row->[5]"; + } + if ($row->[16]){ + $rows->[$j]{main::key($num++,0,2,'serial')} = main::filter($row->[16]); + } + } + } + advanced_output($rows,'usb',$path_id) if $path_id; + } + eval $end if $b_log; +} + +sub advanced_output { + eval $start if $b_log; + my ($rows,$type,$bus_id) = @_; + my (@temp); + my ($j,$num,$k,$l,$m,$n,$address,$id,$note,$tool) = (0,1,2,3,4,5,'','','',''); + set_bluetooth_data(\$tool); + # print "bid: $bus_id\n"; + if ($type ne 'check'){ + @temp = main::globber('/sys/class/bluetooth/*'); + @temp = map {$_ = Cwd::abs_path($_);$_} @temp if @temp; + # print Data::Dumper::Dumper \@temp; + @temp = grep {/$bus_id/} @temp if @temp; + @temp = map {$_ =~ s|^/.*/||;$_;} @temp if @temp; + # print Data::Dumper::Dumper \@temp; + } + elsif ($type eq 'check' && %hci){ + @temp = keys %hci; + $id = '-ID'; + ($k,$l,$m,$n) = (1,2,3,4); + } + if (@temp && %hci){ + if ($hci{'alert'}){ + if (keys %hci == 1){ + check_service(); # sets $service + $j = scalar @$rows; + $rows->[$j]{main::key($num++,1,$k,'Report')} = $tool; + $rows->[$j]{main::key($num++,0,$l,'bt-service')} = $service; + $rows->[$j]{main::key($num++,0,$l,'note')} = $hci{'alert'}; + } + else { + $note = $hci{'alert'}; + } + delete $hci{'alert'}; + } + foreach my $item (@temp){ + if ($hci{$item}){ + $j = scalar @$rows; + push(@$rows,{ + main::key($num++,1,$k,'Report' . $id) => $tool, + },); + if ($note){ + $rows->[$j]{main::key($num++,0,$l,'note')} = $note; + } + # synthesize for rfkill + if (!$hci{$item}->{'state'}){ + $hci{$item}->{'state'} = ($b_bluetooth) ? 'up' : 'down'; + } + $rows->[$j]{main::key($num++,0,$l,'ID')} = $item; + if (defined $hci{$item}->{'rf-index'} && + ($extra > 0 || $hci{$item}->{'state'} eq 'down')){ + $rows->[$j]{main::key($num++,0,$m,'rfk-id')} = $hci{$item}->{'rf-index'}; + } + $rows->[$j]{main::key($num++,1,$l,'state')} = $hci{$item}->{'state'}; + # this only appears for hciconfig, bt-adapter does not run without bt service + if (!$b_bluetooth || $hci{$item}->{'state'} eq 'down'){ + if (!$b_bluetooth || $hci{$item}->{'state'} eq 'down'){ + check_service(); # sets $service + $rows->[$j]{main::key($num++,0,$m,'bt-service')} = $service; + } + if ($hci{$item}->{'hard-blocked'}){ + $rows->[$j]{main::key($num++,1,$m,'rfk-block')} = ''; + $rows->[$j]{main::key($num++,0,$n,'hardware')} = $hci{$item}->{'hard-blocked'}; + $rows->[$j]{main::key($num++,0,$n,'software')} = $hci{$item}->{'soft-blocked'}; + } + } + if (!$hci{$item}->{'address'} && $tool eq 'rfkill'){ + $address = main::message('recommends'); + } + else { + $address = main::filter($hci{$item}->{'address'}); + } + $rows->[$j]{main::key($num++,0,$l,'address')} = $address; + # lmp/hci version only hciconfig + if ($hci{$item}->{'bt-version'}){ + $rows->[$j]{main::key($num++,0,$l,'bt-v')} = $hci{$item}->{'bt-version'}; + } + if ($extra > 0 && defined $hci{$item}->{'lmp-version'}){ + $rows->[$j]{main::key($num++,0,$l,'lmp-v')} = $hci{$item}->{'lmp-version'}; + if ($extra > 1 && $hci{$item}->{'lmp-subversion'}){ + $rows->[$j]{main::key($num++,0,$m,'sub-v')} = $hci{$item}->{'lmp-subversion'}; + } + } + if ($extra > 0 && defined $hci{$item}->{'hci-version'} && + ($extra > 2 || !$hci{$item}->{'lmp-version'} || + ($hci{$item}->{'lmp-version'} && + $hci{$item}->{'lmp-version'} ne $hci{$item}->{'hci-version'}))){ + $rows->[$j]{main::key($num++,0,$l,'hci-v')} = $hci{$item}->{'hci-version'}; + if ($extra > 1 && $hci{$item}->{'hci-revision'}){ + $rows->[$j]{main::key($num++,0,$m,'rev')} = $hci{$item}->{'hci-revision'}; + } + } + if ($b_admin && + ($hci{$item}->{'discoverable'} || $hci{$item}->{'pairable'})){ + $rows->[$j]{main::key($num++,1,$l,'status')} = ''; + if ($hci{$item}->{'discoverable'}){ + $rows->[$j]{main::key($num++,1,$m,'discoverable')} = $hci{$item}->{'discoverable'}; + if ($hci{$item}->{'discovering'}){ + $rows->[$j]{main::key($num++,1,$n,'active')} = $hci{$item}->{'discovering'}; + } + } + if ($hci{$item}->{'pairable'}){ + $rows->[$j]{main::key($num++,0,$m,'pairing')} = $hci{$item}->{'pairable'}; + } + } + if ($extra > 2 && $hci{$item}->{'class'}){ + $rows->[$j]{main::key($num++,0,$l,'class-ID')} = $hci{$item}->{'class'}; + } + # this data only from hciconfig + if ($b_admin && ($hci{$item}->{'acl-mtu'} || $hci{$item}->{'sco-mtu'} || + $hci{$item}->{'link-policy'})){ + $j = scalar @$rows; + push(@$rows,{ + main::key($num++,1,$l,'Info') => '', + },); + if ($hci{$item}->{'acl-mtu'}){ + $rows->[$j]{main::key($num++,0,$m,'acl-mtu')} = $hci{$item}->{'acl-mtu'}; + } + if ($hci{$item}->{'sco-mtu'}){ + $rows->[$j]{main::key($num++,0,$m,'sco-mtu')} = $hci{$item}->{'sco-mtu'}; + } + if ($hci{$item}->{'link-policy'}){ + $rows->[$j]{main::key($num++,0,$m,'link-policy')} = $hci{$item}->{'link-policy'}; + } + if ($hci{$item}->{'link-mode'}){ + $rows->[$j]{main::key($num++,0,$m,'link-mode')} = $hci{$item}->{'link-mode'}; + } + if ($hci{$item}->{'service-classes'}){ + $rows->[$j]{main::key($num++,0,$m,'service-classes')} = $hci{$item}->{'service-classes'}; + } + } + delete $hci{$item}; + } + } + } + # since $rows is ref, we need to just check if no $j were set. + if (!$j && !$b_hci_error && ($alerts{'hciconfig'}->{'action'} ne 'use' && + $alerts{'bt-adapter'}->{'action'} ne 'use' && + $alerts{'btmgmt'}->{'action'} ne 'use')){ + my $key = 'Report'; + my $value = ''; + if ($alerts{'hciconfig'}->{'action'} eq 'platform' || + $alerts{'bt-adapter'}->{'action'} eq 'platform' || + $alerts{'btmgmt'}->{'action'} eq 'platform'){ + $value = main::message('tool-missing-os','bluetooth'); + } + else { + $value = main::message('tools-missing','hciconfig/bt-adapter'); + } + push(@$rows,{ + main::key($num++,0,1,$key) => $value, + },); + $b_hci_error = 1; + } + eval $end if $b_log; +} + +# note: echo 'show' | bluetoothctl outputs everything but hciX ID, and is fast +# args: 0: $tool, by ref +sub set_bluetooth_data { + eval $start if $b_log; + if (!$b_hci && !$force{'bt-adapter'} && !$force{'btmgmt'} && + !$force{'rfkill'} && + ($fake{'bluetooth'} || $alerts{'hciconfig'}->{'action'} eq 'use')){ + hciconfig_data(); + ${$_[0]} = 'hciconfig'; + } + elsif (!$b_hci && !$force{'rfkill'} && !$force{'bt-adapter'} && + ($fake{'bluetooth'} || $alerts{'btmgmt'}->{'action'} eq 'use')){ + btmgmt_data(); + ${$_[0]} = 'btmgmt'; + } + elsif (!$b_hci && !$force{'rfkill'} && + ($fake{'bluetooth'} || $alerts{'bt-adapter'}->{'action'} eq 'use')){ + bt_adapter_data(); + ${$_[0]} = 'bt-adapter'; + } + if (!$b_rfk && ($fake{'bluetooth'} || -e '/sys/class/bluetooth/')){ + rfkill_data(); + ${$_[0]} = 'rfkill' if !${$_[0]}; + } + eval $end if $b_log; +} + +sub bt_adapter_data { + eval $start if $b_log; + $b_hci = 1; + my (@data,$id); + if ($fake{'bluetooth'}){ + my $file; + $file = ""; + @data = main::reader($file,'strip'); + } + else { + if ($b_bluetooth){ + my $cmd = "$alerts{'bt-adapter'}->{'path'} --info 2>/dev/null"; + @data = main::grabber($cmd,'','strip'); + } + } + # print Data::Dumper::Dumper \@data; + main::log_data('dump','@data', \@data) if $b_log; + foreach (@data){ + my @working = split(/:\s*/,$_); + # print Data::Dumper::Dumper \@working; + next if ! @working; + if ($working[0] =~ /^\[([^\]]+)\]/){ + $id = $1; + } + elsif ($working[0] eq 'Address'){ + $hci{$id}->{'address'} = join(':',@working[1 .. $#working]); + } + elsif ($working[0] eq 'Class' && $working[1] =~ /^0x0*(\S+)/){ + $hci{$id}->{'class'} = $1; + } + elsif ($working[0] eq 'Powered'){ + $hci{$id}->{'state'} = ($working[1] =~ /^(1|yes)\b/) ? 'up': 'down'; + } + elsif ($working[0] eq 'Discoverable'){ + $hci{$id}->{'discoverable'} = ($working[1] =~ /^(1|yes)\b/) ? 'yes': 'no'; + } + elsif ($working[0] eq 'Pairable'){ + $hci{$id}->{'pairable'} = ($working[1] =~ /^(1|yes)\b/) ? 'yes': 'no'; + } + elsif ($working[0] eq 'Discovering'){ + $hci{$id}->{'discovering'} = ($working[1] =~ /^(1|yes)\b/) ? 'yes': 'no'; + } + } + if (!@data && !$b_bluetooth){ + $hci{'alert'} = main::message('bluetooth-down'); + } + print 'bt-adapter: ', Data::Dumper::Dumper \%hci if $dbg[27]; + main::log_data('dump','%hci', \%hci) if $b_log; + eval $end if $b_log; +} + +sub btmgmt_data { + eval $start if $b_log; + $b_hci = 1; + my (@data,$id); + if ($fake{'bluetooth'}){ + my $file; + $file = "$fake_data_dir/bluetooth/btmgmt-2.txt"; + @data = main::reader($file,'strip'); + } + else { + if ($b_bluetooth){ + my $cmd = "$alerts{'btmgmt'}->{'path'} info 2>/dev/null"; + @data = main::grabber($cmd,'', 'strip'); + } + } + # print Data::Dumper::Dumper \@data; + main::log_data('dump','@data', \@data) if $b_log; + foreach (@data){ + next if /^Index list/; + if (/^(hci[0-9]+):\s+/){ + $id = $1; + } + # addr 4C:F3:72:9C:B4:D3 version 6 manufacturer 15 class 0x000104 + elsif (/^addr\s+([0-9A-F:]+)\s+version\s+([0-9]+)\s/){ + $hci{$id}->{'address'} = $1; + $hci{$id}->{'lmp-version'} = $2; # assume non hex integer + $hci{$id}->{'bt-version'} = bluetooth_version($2); + if (/ class\s+0x0*(\S+)\b/){ + $hci{$id}->{'class'} = $1; + } + } + elsif (/^current settings:\s+(.*)/){ + my $settings = $1; + $hci{$id}->{'state'} = ($settings =~ /\bpowered\b/) ? 'up' : 'down'; + $hci{$id}->{'discoverable'} = ($settings =~ /\bdiscoverable\b/) ? 'yes' : 'no'; + $hci{$id}->{'pairable'} = ($settings =~ /\bconnectable\b/) ? 'yes' : 'no'; + } + } + print 'btmgmt: ', Data::Dumper::Dumper \%hci if $dbg[27]; + main::log_data('dump','%hci', \%hci) if $b_log; + eval $end if $b_log; +} + +sub hciconfig_data { + eval $start if $b_log; + $b_hci = 1; + my (@data,$id); + if ($fake{'bluetooth'}){ + my $file; + $file = "$fake_data_dir/bluetooth/hciconfig-a-2.txt"; + @data = main::reader($file,'strip'); + } + else { + my $cmd = "$alerts{'hciconfig'}->{'path'} -a 2>/dev/null"; + @data = main::grabber($cmd,'', 'strip'); + } + # print Data::Dumper::Dumper \@data; + main::log_data('dump','@data', \@data) if $b_log; + foreach (@data){ + if (/^(hci[0-9]+):\s+Type:\s+(.*)\s+Bus:\s+([\S]+)/){ + $id = $1; + $hci{$id} = { + 'type'=> $2, + 'bus' => $3, + }; + } + elsif (/^BD Address:\s+([0-9A-F:]*)\s+ACL\s+MTU:\s+([0-9:]+)\s+SCO MTU:\s+([0-9:]+)/){ + $hci{$id}->{'address'} = $1; + $hci{$id}->{'acl-mtu'} = $2; + $hci{$id}->{'sco-mtu'} = $3; + } + elsif (/^(UP|DOWN).*/){ + $hci{$id}->{'state'} = lc($1); + } + elsif (/^Class:\s+0x0*(\S+)/){ + $hci{$id}->{'class'} = $1; + } + # HCI Version: 4.0 (0x6) Revision: 0x1000 + # HCI Version: 6.6 Revision: 0x1000 [don't know if this exists] + # HCI Version: (0x7) Revision: 0x3101 + elsif (/^HCI Version:\s+(([0-9\.]+)\s+)?\(0x([0-9a-f]+)\)\s+Revision:\s+0x([0-9a-f]+)/i){ + $hci{$id}->{'hci-revision'} = $4; + if (defined $3){ + $hci{$id}->{'bt-version'} = bluetooth_version(hex($3)); + $hci{$id}->{'hci-version'} = hex($3); + $hci{$id}->{'hci-version-hex'} = $3; + } + } + # LMP Version: 4.0 (0x6) Subversion: 0x220e + # LMP Version: 6.6 Revision: 0x1000 [don't know if this exists] + # LMP Version: (0x7) Subversion: 0x1 + elsif (/^LMP Version:\s+(([0-9\.]+)\s+)?\(0x([0-9a-f]+)\)\s+Subversion:\s+0x([0-9a-f]+)/i){ + $hci{$id}->{'lmp-subversion'} = $4; + $hci{$id}->{'bt-version'} = bluetooth_version(hex($3)); + $hci{$id}->{'lmp-version'} = hex($3); + $hci{$id}->{'lmp-version-hex'} = $3; + } + elsif (/^Link policy:\s+(.*)/){ + $hci{$id}->{'link-policy'} = lc($1); + } + elsif (/^Link mode:\s+(.*)/){ + $hci{$id}->{'link-mode'} = lc($1); + } + elsif (/^Service Classes?:\s+(.+)/){ + $hci{$id}->{'service-classes'} = main::clean_unset(lc($1)); + } + } + print 'hciconfig: ', Data::Dumper::Dumper \%hci if $dbg[27]; + main::log_data('dump','%hci', \%hci) if $b_log; + eval $end if $b_log; +} + +sub rfkill_data { + eval $start if $b_log; + $b_rfk = 1; + my (@data,$id,$value); + if ($fake{'bluetooth'}){ + my $file; + $file = ""; + @data = main::reader($file,'strip'); + } + else { + # /state is the state of rfkill, NOT bluetooth! + @data = main::globber('/sys/class/bluetooth/hci*/rfkill*/{hard,index,soft}'); + } + # print Data::Dumper::Dumper \@data; + main::log_data('dump','@data', \@data) if $b_log; + foreach (@data){ + $id = (split(/\//,$_))[4]; + if (m|/soft$|){ + $value = main::reader($_,'strip',0); + $hci{$id}->{'soft-blocked'} = ($value) ? 'yes': 'no'; + $hci{$id}->{'state'} = 'down' if $hci{$id}->{'soft-blocked'} eq 'yes'; + } + elsif (m|/hard$|){ + $value = main::reader($_,'strip',0); + $hci{$id}->{'hard-blocked'} = ($value) ? 'yes': 'no'; + $hci{$id}->{'state'} = 'down' if $hci{$id}->{'hard-blocked'} eq 'yes'; + } + elsif (m|/index$|){ + $value = main::reader($_,'strip',0); + $hci{$id}->{'rf-index'} = $value; + } + } + print 'rfkill: ', Data::Dumper::Dumper \%hci if $dbg[27]; + main::log_data('dump','%hci', \%hci) if $b_log; + eval $end if $b_log; +} + +sub check_service { + eval $start if $b_log; + if (!$b_service){ + $service = ServiceData::get('status','bluetooth'); + $service ||= 'N/A'; + $b_service = 1; + } + eval $end if $b_log; +} + +# args: 0: lmp versoin - could be hex, but probably decimal, like 6.6 +sub bluetooth_version { + eval $start if $b_log; + my ($lmp) = @_; + return if !defined $lmp; + return if !main::is_numeric($lmp); + $lmp = int($lmp); + # Conveniently, LMP starts with 0, so perfect for array indexes. + # 6.0 is coming, but might be 5.5 first, nobody knows. + my @bt = qw(1.0b 1.1 1.2 2.0 2.1 3.0 4.0 4.1 4.2 5.0 5.1 5.2 5.3 5.4); + return $bt[$lmp]; + eval $end if $b_log; +} +} + +## CpuItem ## +{ +package CpuItem; +my (%fake_data,$type); + +sub get { + eval $start if $b_log; + ($type) = @_; + my $rows = []; + if ($type eq 'short' || $type eq 'basic'){ + # note, for short form, just return the raw data, not the processed output + my $cpu = short_data(); + if ($type eq 'basic'){ + short_output($rows,$cpu); + } + else { + $rows = $cpu; + } + } + else { + full_output($rows); + } + eval $end if $b_log; + return $rows; +} + +## OUTPUT HANDLERS ## +sub full_output { + eval $start if $b_log; + my $rows = $_[0]; + my $num = 0; + my ($b_speeds,$core_speeds_value,$cpu); + my $sleep = $cpu_sleep * 1000000; + if (my $file = $system_files{'proc-cpuinfo'}){ + $cpu = cpuinfo_data($file); + } + elsif ($bsd_type){ + my ($key1,$val1) = ('',''); + if ($alerts{'sysctl'}){ + if ($alerts{'sysctl'}->{'action'} eq 'use'){ + # $key1 = 'Status'; + # $val1 = main::message('dev'); + $cpu = cpu_sysctl_data(); + } + else { + $key1 = ucfirst($alerts{'sysctl'}->{'action'}); + $val1 = $alerts{'sysctl'}->{'message'}; + @$rows = ({main::key($num++,0,1,$key1) => $val1}); + return; + } + } + } + my $properties = cpu_properties($cpu); + my $type = ($properties->{'cpu-type'}) ? $properties->{'cpu-type'}: ''; + my $j = scalar @$rows; + $cpu->{'model_name'} ||= 'N/A'; + push(@$rows, { + main::key($num++,1,1,'Info') => $properties->{'topology-string'}, + main::key($num++,0,2,'model') => $cpu->{'model_name'}, + },); + if ($cpu->{'system-cpus'}){ + my %system_cpus = %{$cpu->{'system-cpus'}}; + my $i = 1; + my $counter = (%system_cpus && scalar keys %system_cpus > 1) ? '-' : ''; + foreach my $key (keys %system_cpus){ + $counter = '-' . $i++ if $counter; + $rows->[$j]{main::key($num++,0,2,'variant' . $counter)} = $key; + } + } + if ($b_admin && $properties->{'socket'}){ + if ($properties->{'upgrade'}){ + $rows->[$j]{main::key($num++,1,2,'socket')} = $properties->{'socket'} . ' (' . $properties->{'upgrade'} . ')'; + $rows->[$j]{main::key($num++,0,3,'note')} = main::message('note-check'); + } + else { + $rows->[$j]{main::key($num++,0,2,'socket')} = $properties->{'socket'}; + } + } + $properties->{'bits-sys'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'bits')} = $properties->{'bits-sys'}; + if ($type){ + $rows->[$j]{main::key($num++,0,2,'type')} = $type; + if (!$properties->{'topology-full'} && $cpu->{'smt'} && ($extra > 2 || + ($extra > 0 && $cpu->{'smt'} eq 'disabled'))){ + $rows->[$j]{main::key($num++,0,2,'smt')} = $cpu->{'smt'}; + } + } + if ($extra > 0){ + $cpu->{'arch'} ||= 'N/A'; + $rows->[$j]{main::key($num++,1,2,'arch')} = $cpu->{'arch'}; + if ($cpu->{'arch-note'}){ + $rows->[$j]{main::key($num++,0,3,'note')} = $cpu->{'arch-note'}; + } + if ($b_admin && $cpu->{'gen'}){ + $rows->[$j]{main::key($num++,0,3,'gen')} = $cpu->{'gen'}; + } + if ($b_admin && $properties->{'arch-level'}){ + $rows->[$j]{main::key($num++,1,2,'level')} = $properties->{'arch-level'}[0]; + if ($properties->{'arch-level'}[1]){ + $rows->[$j]{main::key($num++,0,3,'note')} = $properties->{'arch-level'}[1]; + } + } + if ($b_admin){ + if ($cpu->{'year'}){ + $rows->[$j]{main::key($num++,0,2,'built')} = $cpu->{'year'}; + } + if ($cpu->{'process'}){ + $rows->[$j]{main::key($num++,0,2,'process')} = $cpu->{'process'}; + } + } + # note: had if arch, but stepping can be defined where arch failed, stepping can be 0 + if (!$b_admin && (defined $cpu->{'stepping'} || defined $cpu->{'revision'})){ + my $rev = main::get_defined($cpu->{'stepping'},$cpu->{'revision'}); + $rows->[$j]{main::key($num++,0,2,'rev')} = $rev; + } + } + if ($b_admin){ + $rows->[$j]{main::key($num++,0,2,'family')} = hex_and_decimal($cpu->{'family'}); + $rows->[$j]{main::key($num++,0,2,'model-id')} = hex_and_decimal($cpu->{'model-id'}); + if (defined $cpu->{'stepping'}){ + $rows->[$j]{main::key($num++,0,2,'stepping')} = hex_and_decimal($cpu->{'stepping'}); + } + elsif (defined $cpu->{'revision'}){ + $rows->[$j]{main::key($num++,0,2,'rev')} = $cpu->{'revision'}; + } + if (!%risc && $cpu->{'type'} ne 'elbrus'){ + $cpu->{'microcode'} = ($cpu->{'microcode'}) ? '0x' . $cpu->{'microcode'} : 'N/A'; + $rows->[$j]{main::key($num++,0,2,'microcode')} = $cpu->{'microcode'}; + } + } + # note, risc cpus are using l1, L2, L3 more often, but if risc and no L2, skip + if ($properties->{'topology-string'} && (($extra > 1 && + ($properties->{'l1-cache'} || $properties->{'l3-cache'})) || + (!%risc || $properties->{'l2-cache'}) || $properties->{'cache'})){ + full_output_caches($j,$properties,\$num,$rows); + } + # all tests already done to load this, admin, etc + if ($properties->{'topology-full'}){ + $j = scalar @$rows; + push(@$rows, { + main::key($num++,1,1,'Topology') => '', + },); + my ($id,$var) = (2,''); + if (scalar @{$properties->{'topology-full'}} > 1){ + $var = 'variant'; + $id = 3; + } + foreach my $topo (@{$properties->{'topology-full'}}){ + if ($var){ + $rows->[$j]{main::key($num++,1,2,'variant')} = ''; + } + my $x = ($size{'max-cols'} == 1 || $output_type ne 'screen') ? '' : 'x'; + $rows->[$j]{main::key($num++,0,$id,'cpus')} = $topo->{'cpus'} . $x; + if ($topo->{'dies-count'}){ + $rows->[$j]{main::key($num++,0,$id+1,'dies')} = $topo->{'dies-count'}; + } + if ($topo->{'clusters'}){ + $rows->[$j]{main::key($num++,0,$id+1,'clusters')} = $topo->{'clusters'}; + } + $rows->[$j]{main::key($num++,1,$id+1,'cores')} = $topo->{'cores'}; + if ($topo->{'threads'}){ + $rows->[$j]{main::key($num++,0,$id+1,'threads')} = $topo->{'threads'}; + } + if ($topo->{'cores-mt'} && $topo->{'cores-st'}){ + $rows->[$j]{main::key($num++,1,$id+2,'mt')} = $topo->{'cores-mt'}; + $rows->[$j]{main::key($num++,0,$id+3,'tpc')} = $topo->{'tpc'}; + $rows->[$j]{main::key($num++,0,$id+2,'st')} = $topo->{'cores-st'}; + } + elsif ($topo->{'cores-mt'}){ + $rows->[$j]{main::key($num++,0,$id+2,'tpc')} = $topo->{'tpc'}; + } + if ($topo->{'max'} || $topo->{'min'}){ + my ($freq,$key) = ('',''); + if ($topo->{'max'} && $topo->{'min'}){ + $key = 'min/max'; + $freq = $topo->{'min'} . '/' . $topo->{'max'}; + } + elsif ($topo->{'max'}){ + $key = 'max'; + $freq = $topo->{'max'}; + } + else { + $key = 'min'; + $freq = $topo->{'min'}; + } + $rows->[$j]{main::key($num++,0,$id+1,$key)} = $freq; + } + + } + $cpu->{'smt'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'smt')} = $cpu->{'smt'}; + full_output_caches($j,$properties,\$num,$rows); + } + my $speeds = $cpu->{'processors'}; + my $core_key = (defined $speeds && scalar @{$speeds} > 1) ? 'cores' : 'core'; + my $speed_key = ($properties->{'speed-key'}) ? $properties->{'speed-key'}: 'Speed'; + my $min_max = ($properties->{'min-max'}) ? $properties->{'min-max'}: 'N/A'; + my $min_max_key = ($properties->{'min-max-key'}) ? $properties->{'min-max-key'}: 'min/max'; + my $speed = ''; + if (!$properties->{'avg-speed-key'}){ + $speed = (defined $properties->{'speed'}) ? $properties->{'speed'}: 'N/A'; + } + # Aren't able to get per core speeds in BSDs. Why don't they support this? + if (defined $speeds && @$speeds){ + # only if defined and not 0 + if (grep {$_} @{$speeds}){ + $core_speeds_value = ''; + $b_speeds = 1; + } + else { + my $id = ($bsd_type) ? 'cpu-speeds-bsd' : 'cpu-speeds'; + $core_speeds_value = main::message($id); + } + } + else { + $core_speeds_value = main::message('cpu-speeds'); + } + $j = scalar @$rows; + push(@$rows, { + main::key($num++,1,1,$speed_key) => $speed, + }); + if ($properties->{'avg-speed-key'}){ + $rows->[$j]{main::key($num++,0,2,$properties->{'avg-speed-key'})} = $properties->{'speed'}; + if ($extra > 0 && $properties->{'high-speed-key'}){ + $rows->[$j]{main::key($num++,0,2,$properties->{'high-speed-key'})} = $cpu->{'high-freq'}; + } + } + $rows->[$j]{main::key($num++,0,2,$min_max_key)} = $min_max; + if ($extra > 0 && defined $cpu->{'boost'}){ + $rows->[$j]{main::key($num++,0,2,'boost')} = $cpu->{'boost'}; + } + if ($b_admin && $properties->{'dmi-speed'} && $properties->{'dmi-max-speed'}){ + $rows->[$j]{main::key($num++,0,2,'base/boost')} = $properties->{'dmi-speed'} . '/' . $properties->{'dmi-max-speed'}; + } + if ($b_admin && ($cpu->{'governor'} || $cpu->{'scaling-driver'})){ + $rows->[$j]{main::key($num++,1,2,'scaling')} = ''; + $cpu->{'driver'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'driver')} = $cpu->{'scaling-driver'}; + $cpu->{'governor'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'governor')} = $cpu->{'governor'}; + # only set if different from cpu min/max + if ($cpu->{'scaling-min-max'} && $cpu->{'scaling-min-max-key'}){ + $rows->[$j]{main::key($num++,0,3,$cpu->{'scaling-min-max-key'})} = $cpu->{'scaling-min-max'}; + } + } + if ($extra > 2){ + if ($properties->{'volts'}){ + $rows->[$j]{main::key($num++,0,2,'volts')} = $properties->{'volts'} . ' V'; + } + if ($properties->{'ext-clock'}){ + $rows->[$j]{main::key($num++,0,2,'ext-clock')} = $properties->{'ext-clock'}; + } + } + $rows->[$j]{main::key($num++,1,2,$core_key)} = $core_speeds_value; + my $i = 1; + # if say 96 0 speed cores, no need to print all those 0s + if ($b_speeds){ + foreach (@{$speeds}){ + $rows->[$j]{main::key($num++,0,3,$i++)} = $_; + } + } + if ($extra > 0 && !$bsd_type){ + my $bogomips = ($cpu->{'bogomips'} && + main::is_numeric($cpu->{'bogomips'})) ? int($cpu->{'bogomips'}) : 'N/A'; + $rows->[$j]{main::key($num++,0,2,'bogomips')} = $bogomips; + } + if (($extra > 0 && !$show{'cpu-flag'}) || $show{'cpu-flag'}){ + my @flags = ($cpu->{'flags'}) ? split(/\s+/, $cpu->{'flags'}) : (); + my $flag_key = (%risc || $bsd_type) ? 'Features': 'Flags'; + my $flag = 'N/A'; + if (!$show{'cpu-flag'}){ + if (@flags){ + # failure to read dmesg.boot: dmesg.boot permissions; then short -Cx list flags + @flags = grep {/^(dmesg.boot|permissions|avx[2-9]?|ht|lm|nx|pae|pni|(sss|ss)e([2-9])?([a-z])?(_[0-9])?|svm|vmx)$/} @flags; + @flags = map {s/pni/sse3/; $_} @flags if @flags; + @flags = sort @flags; + } + # only ARM has Features, never seen them for MIPS/PPC/SPARC/RISCV, but check + if ($risc{'arm'} && $flag eq 'N/A'){ + $flag = main::message('arm-cpu-f'); + } + } + if (@flags){ + @flags = sort @flags; + $flag = join(' ', @flags); + } + push(@$rows, { + main::key($num++,0,1,$flag_key) => $flag, + },); + } + if ($b_admin){ + my $value = ''; + if (!defined $cpu->{'bugs-hash'}){ + if ($cpu->{'bugs-string'}){ + my @proc_bugs = split(/\s+/, $cpu->{'bugs-string'}); + @proc_bugs = sort @proc_bugs; + $value = join(' ', @proc_bugs); + } + else { + $value = main::message('cpu-bugs-null'); + } + } + if ($use{'filter-vulnerabilities'} && + (defined $cpu->{'bugs-hash'} || $cpu->{'bugs-string'})){ + $value = $filter_string; + undef $cpu->{'bugs-hash'}; + } + push(@$rows, { + main::key($num++,1,1,'Vulnerabilities') => $value, + },); + if (defined $cpu->{'bugs-hash'}){ + $j = scalar @$rows; + foreach my $key (sort keys %{$cpu->{'bugs-hash'}}){ + $rows->[$j]{main::key($num++,1,2,'Type')} = $key; + $rows->[$j]{main::key($num++,0,3,$cpu->{'bugs-hash'}->{$key}[0])} = $cpu->{'bugs-hash'}->{$key}[1]; + $j++; + } + } + } + eval $end if $b_log; +} + +# $num, $rows passed by reference +sub full_output_caches { + eval $start if $b_log; + my ($j,$properties,$num,$rows) = @_; + my $value = ''; + if (!$properties->{'l1-cache'} && !$properties->{'l2-cache'} && + !$properties->{'l3-cache'}){ + $value = ($properties->{'cache'}) ? $properties->{'cache'} : 'N/A'; + } + $rows->[$j]{main::key($$num++,1,2,'cache')} = $value; + if ($extra > 0 && $properties->{'l1-cache'}){ + $rows->[$j]{main::key($$num++,2,3,'L1')} = $properties->{'l1-cache'}; + if ($b_admin && ($properties->{'l1d-desc'} || $properties->{'l1i-desc'})){ + my $desc = ''; + if ($properties->{'l1d-desc'}){ + $desc .= 'd-' . $properties->{'l1d-desc'}; + } + if ($properties->{'l1i-desc'}){ + $desc .= '; ' if $desc; + $desc .= 'i-' . $properties->{'l1i-desc'}; + } + $rows->[$j]{main::key($$num++,0,4,'desc')} = $desc; + } + } + # $rows->[$j]{main::key($$num++,1,$l,$key)} = $support; + if (!$value){ + $properties->{'l2-cache'} = ($properties->{'l2-cache'}) ? $properties->{'l2-cache'} : 'N/A'; + $rows->[$j]{main::key($$num++,1,3,'L2')} = $properties->{'l2-cache'}; + if ($b_admin && $properties->{'l2-desc'}){ + $rows->[$j]{main::key($$num++,0,4,'desc')} = $properties->{'l2-desc'}; + } + } + if ($extra > 0 && $properties->{'l3-cache'}){ + $rows->[$j]{main::key($$num++,1,3,'L3')} = $properties->{'l3-cache'}; + if ($b_admin && $properties->{'l3-desc'}){ + $rows->[$j]{main::key($$num++,0,4,'desc')} = $properties->{'l3-desc'}; + } + } + if ($properties->{'cache-check'}){ + $rows->[$j]{main::key($$num++,0,3,'note')} = $properties->{'cache-check'}; + } + eval $end if $b_log; +} + +sub short_output { + eval $start if $b_log; + my ($rows,$cpu) = @_; + my $num = 0; + $cpu->[1] ||= main::message('cpu-model-null'); + $cpu->[2] ||= 'N/A'; + push(@$rows,{ + main::key($num++,1,1,'Info') => $cpu->[0] . ' ' . $cpu->[1] . ' [' . $cpu->[2] . ']' + #main::key($num++,0,2,'type') => $cpu->[2], + }); + if ($extra > 0){ + $rows->[0]{main::key($num++,1,2,'arch')} = $cpu->[8]; + if ($cpu->[9]){ + $rows->[0]{main::key($num++,0,3,'note')} = $cpu->[9]; + } + } + my $value = ($cpu->[7]) ? '' : $cpu->[4]; + $rows->[0]{main::key($num++,1,2,$cpu->[3])} = $value; + if ($cpu->[7]){ + $rows->[0]{main::key($num++,0,3,$cpu->[7])} = $cpu->[4]; + } + if ($cpu->[6]){ + $rows->[0]{main::key($num++,0,3,$cpu->[5])} = $cpu->[6]; + } + eval $end if $b_log; +} + +## SHORT OUTPUT DATA ## +sub short_data { + eval $start if $b_log; + my $num = 0; + my ($cpu,$data,%speeds); + my $sys = '/sys/devices/system/cpu/cpufreq/policy0'; + # NOTE: : Permission denied, ie, this is not always readable + # /sys/devices/system/cpu/cpu0/cpufreq/cpuinfo_cur_freq + if (my $file = $system_files{'proc-cpuinfo'}){ + $cpu = cpuinfo_data($file); + } + elsif ($bsd_type){ + my ($key1,$val1) = ('',''); + if ($alerts{'sysctl'}){ + if ($alerts{'sysctl'}->{'action'} eq 'use'){ + # $key1 = 'Status'; + # $val1 = main::message('dev'); + $cpu = cpu_sysctl_data($type); + } + else { + $key1 = ucfirst($alerts{'sysctl'}->{'action'}); + $val1 = $alerts{'sysctl'}->{'message'}; + $data = ({main::key($num++,0,1,$key1) => $val1,}); + return $data; + } + } + } + # $cpu{'cur-freq'} = $cpu[0]->{'core-id'}[0]{'speed'}; + $data = prep_short_data($cpu); + eval $end if $b_log; + return $data; +} + +sub prep_short_data { + eval $start if $b_log; + my ($cpu_data) = @_; + my $properties = cpu_properties($cpu_data); + my ($cpu,$speed_key,$speed,$type) = ('','speed',0,''); + $cpu = $cpu_data->{'model_name'} if $cpu_data->{'model_name'}; + $type = $properties->{'cpu-type'} if $properties->{'cpu-type'}; + $speed_key = $properties->{'speed-key'} if $properties->{'speed-key'}; + $speed = $properties->{'speed'} if $properties->{'speed'}; + my $result = [ + $properties->{'topology-string'}, + $cpu, + $type, + $speed_key, + $speed, + $properties->{'min-max-key'}, + $properties->{'min-max'}, + $properties->{'avg-speed-key'}, + ]; + if ($extra > 0){ + $cpu_data->{'arch'} ||= 'N/A'; + $result->[8] = $cpu_data->{'arch'}; + $result->[9] = $cpu_data->{'arch-note'}; + } + eval $end if $b_log; + return $result; +} + +## CPUINFO/SYS DATA GENERATORS ## + +## DEBUGGER DATA +# Set in one place to make sure we get them all consistent +sub set_fake_cpu_data { + $loaded{'cpu-fake-data'} = 1; + my ($ci,$sys); + ## CPUINFO DATA FILES ## + ## ARM/MIPS + # $ci = "$fake_data_dir/cpu/arm/arm-4-core-pinebook-1.txt"; + # $ci = "$fake_data_dir/cpu/arm/armv6-single-core-1.txt"; + # $ci = "$fake_data_dir/cpu/arm/armv7-dual-core-1.txt"; + # $ci = "$fake_data_dir/cpu/arm/armv7-new-format-model-name-single-core.txt"; + # $ci = "$fake_data_dir/cpu/arm/arm-2-die-96-core-rk01.txt"; + # $ci = "$fake_data_dir/cpu/arm/arm-shevaplug-1.2ghz.txt"; + # $ci = "$fake_data_dir/cpu/mips/mips-mainusg-cpuinfo.txt"; + # $ci = "$fake_data_dir/cpu/ppc/ppc-debian-ppc64-cpuinfo.txt"; + ## x86 + # $ci = "$fake_data_dir/cpu/amd/16-core-32-mt-ryzen.txt"; + # $ci = "$fake_data_dir/cpu/amd/2-16-core-epyc-abucodonosor.txt"; + # $ci = "$fake_data_dir/cpu/amd/2-core-probook-antix.txt"; + # $ci = "$fake_data_dir/cpu/amd/4-core-jean-antix.txt"; + # $ci = "$fake_data_dir/cpu/amd/4-core-althlon-mjro.txt"; + # $ci = "$fake_data_dir/cpu/amd/4-core-apu-vc-box.txt"; + # $ci = "$fake_data_dir/cpu/amd/4-core-a10-5800k-1.txt"; + # $ci = "$fake_data_dir/cpu/intel/1-core-486-fourtysixandtwo.txt"; + # $ci = "$fake_data_dir/cpu/intel/2-core-ht-atom-bruh.txt"; + # $ci = "$fake_data_dir/cpu/intel/core-2-i3.txt"; + # $ci = "$fake_data_dir/cpu/intel/8-core-i7-damentz64.txt"; + # $ci = "$fake_data_dir/cpu/intel/2-10-core-xeon-ht.txt"; + # $ci = "$fake_data_dir/cpu/intel/4-core-xeon-fake-dual-die-zyanya.txt"; + # $ci = "$fake_data_dir/cpu/intel/2-core-i5-fake-dual-die-hek.txt"; + # $ci = "$fake_data_dir/cpu/intel/2-1-core-xeon-vm-vs2017.txt"; + # $ci = "$fake_data_dir/cpu/intel/4-1-core-xeon-vps-frodo1.txt"; + # $ci = "$fake_data_dir/cpu/intel/4-6-core-xeon-no-mt-lathander.txt"; + ## Elbrus + # $cpu_type = 'elbrus'; # uncomment to test elbrus + # $ci = "$fake_data_dir/cpu/elbrus/elbrus-2c3/cpuinfo.txt"; + # $ci = "$fake_data_dir/cpu/elbrus/1xE1C-8.txt"; + # $ci = "$fake_data_dir/cpu/elbrus/1xE2CDSP-4.txt"; + # $ci = "$fake_data_dir/cpu/elbrus/1xE2S4-3-monocub.txt"; + # $ci = "$fake_data_dir/cpu/elbrus/1xMBE8C-7.txt"; + # $ci = "$fake_data_dir/cpu/elbrus/4xEL2S4-3.txt"; + # $ci = "$fake_data_dir/cpu/elbrus/4xE8C-7.txt"; + # $ci = "$fake_data_dir/cpu/elbrus/4xE2CDSP-4.txt"; + # $ci = "$fake_data_dir/cpu/elbrus/cpuinfo.e8c2.txt"; + ## Loongson + # $cpu_type = 'elbrus'; # uncomment to test loongson + # $ci = "$fake_data_dir/cpu/loongson/3A5000M-4-core-4.19.0.txt"; + + ## CPU CPUINFO/SYS PAIRS DATA FILES ## + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/android-pocom3-fake-cpuinfo.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/android-pocom3-fake-sys.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/arm-pine64-cpuinfo-1.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/arm-pine64-sys-1.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/arm-riscyslack2-cpuinfo-1.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/arm-riscyslack2-sys-1.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/ppc-stuntkidz~cpuinfo.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/ppc-stuntkidz~sys.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/riscv-unmatched-2021~cpuinfo-1.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/riscv-unmatched-2021~sys-1.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/x86-brickwizard-atom-n270~cpuinfo-1.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/x86-brickwizard-atom-n270~sys-1.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/x86-amd-phenom-chrisretusn-cpuinfo-1.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/x86-amd-phenom-chrisretusn-sys-1.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/x86-drgibbon-intel-i7-cpuinfo.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/x86-drgibbon-intel-i7-sys.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/ryzen-threadripper-1x64-3950x-cpuinfo.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/ryzen-threadripper-1x64-3950x-sys.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/amd-threadripper-1x12-5945wx-cpuinfo-1.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/amd-threadripper-1x12-5945wx-sys-1.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/intel-i7-1165G7-4-core-no-smt-cpuinfo.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/intel-i7-1165G7-4-core-no-smt-sys.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/elbrus-e16c-1-cpuinfo.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/elbrus-e16c-1-sys.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/intel-raptor-lake-10-core-cpuinfo-1.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/intel-raptor-lake-10-core-sys-1.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/risc-v-spacemit-8-core-cpuinfo.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/risc-v-spacemit-8-core-sys.txt"; + # $ci = "$fake_data_dir/cpu/sys-ci-pairs/intel-xeon-2x12-core-mt-cpuinfo-1.txt"; + # $sys = "$fake_data_dir/cpu/sys-ci-pairs/intel-xeon-2x12-core-mt-sys-1.txt"; + $ci = "$fake_data_dir/cpu/sys-ci-pairs/amd-epyc-2x-16-core-4-die-cpuinfo-1.txt"; + $sys = "$fake_data_dir/cpu/sys-ci-pairs/amd-epyc-2x-16-core-4-die-sys-1.txt"; + $fake_data{'cpuinfo'} = $ci; + $fake_data{'sys'} = $sys; +} + +## CPUINFO DATA +sub cpuinfo_data_grabber { + eval $start if $b_log; + my ($file,$cpu_type) = @_; # type by ref + $loaded{'cpuinfo'} = 1; + # use --arm flag when testing arm cpus, and --fake-cpu to trigger fake data + $file = $fake_data{'cpuinfo'} if $fake{'cpu'}; + my $raw = main::reader($file,'','ref'); + @$raw = map {$_ =~ s/^\s*$/~~~/;$_;} @$raw; + push(@$raw,'~~~') if @$raw; + my ($b_processor,$key,$value); + my ($i) = (0); + my @key_tests = ('firmware','hardware','mmu','model','motherboard', + 'platform','system type','timebase'); + foreach my $row (@$raw){ + ($key,$value) = split(/\s*:\s*/,$row,2); + next if !defined $key; + # ARM: 'Hardware' can appear in processor block; system type (mips) + # ARM: CPU revision; machine: Revision/PPC: revision (CPU implied) + # orangepi3 has Hardware/Processor embedded in processor block + if (%risc && ((grep {lc($key) eq $_} @key_tests) || + (!$risc{'ppc'} && lc($key) eq 'revision'))){ + $b_processor = 0; + } + else { + $b_processor = 1; + } + if ($b_processor){ + if ($key eq '~~~'){ + $i++; + next; + } + # A small handful of ARM devices use Processor instead of 'model name' + # Processor : AArch64 Processor rev 4 (aarch64) + # Processor : Feroceon 88FR131 rev 1 (v5l) + $key = ($key eq 'Processor') ? 'model name' : lc($key); + $cpuinfo[$i]->{$key} = $value; + } + else { + next if $cpuinfo_machine{lc($key)}; + $cpuinfo_machine{lc($key)} = $value; + } + } + if ($b_log){ + main::log_data('dump','@cpuinfo',\@cpuinfo); + main::log_data('dump','%cpuinfo_machine',\%cpuinfo_machine); + } + if ($dbg[41]){ + print Data::Dumper::Dumper \@cpuinfo; + print Data::Dumper::Dumper \%cpuinfo_machine; + } + eval $end if $b_log; +} + +sub cpuinfo_data { + eval $start if $b_log; + my ($file)= @_; + my ($cpu,$arch,$note,$temp); + # has to be set above fake cpu section + set_cpu_data(\$cpu); + set_fake_cpu_data() if $fake{'cpu'} && !$loaded{'cpu-fake-data'}; + # sleep is also set in front of cpu_sysctl_data for BSDs, same idea + my $sleep = $cpu_sleep * 1000000; + if ($b_hires){ + eval 'Time::HiRes::usleep($sleep)'; + } + else { + select(undef, undef, undef, $cpu_sleep); + } + # Run first to get raw as possible speeds + cpuinfo_speed_sys(\$cpu) if $fake{'cpu'} || -e '/sys/devices/system/cpu/'; + cpuinfo_data_grabber($file,\$cpu->{'type'}) if !$loaded{'cpuinfo'}; + $cpu->{'type'} = cpu_vendor($cpu_arch) if $cpu_arch eq 'elbrus'; # already set to lower + my ($core_count,$proc_count,$speed) = (0,0,0); + my ($b_block_1) = (1); + # need to prime for arm cpus, which do not have physical/core ids usually + # level 0 is phys id, level 1 is die id, level 2 is core id + # note, there con be a lot of processors, 32 core HT would have 64, for example. + foreach my $block (@cpuinfo){ + # get the repeated data for CPUs, after assign the dynamic per core data + next if !$block; + if ($b_block_1){ + $b_block_1 = 0; + # this may also kick in for centaur/via types, but no data available, guess + if (!$cpu->{'type'} && $block->{'vendor_id'}){ + $cpu->{'type'} = cpu_vendor($block->{'vendor_id'}); + } + # PPC can use 'cpu', MIPS 'cpu model' + $temp = main::get_defined($block->{'model name'},$block->{'cpu'}, + $block->{'cpu model'}); + if ($temp){ + $cpu->{'model_name'} = $temp; + $cpu->{'model_name'} = main::clean($cpu->{'model_name'}); + $cpu->{'model_name'} = clean_cpu($cpu->{'model_name'}); + if ($risc{'arm'} || $cpu->{'model_name'} =~ /ARM|AArch/i){ + $cpu->{'type'} = 'arm'; + if ($cpu->{'model_name'} =~ /(.*)\srev\s([\S]+)\s(\(([\S]+)\))?/){ + $cpu->{'model_name'} = $1; + $cpu->{'stepping'} = $2; + if ($4){ + $cpu->{'arch'} = $4; + if ($cpu->{'model_name'} !~ /\Q$cpu->{'arch'}\E/i){ + $cpu->{'model_name'} .= ' ' . $cpu->{'arch'}; + } + } + # print "p0:\n"; + } + } + elsif ($cpu->{'model_name'} =~ /loongson|godson/i){ + $cpu->{'type'} = 'loongson'; + } + elsif ($risc{'mips'} || $cpu->{'model_name'} =~ /mips/i){ + $cpu->{'type'} = 'mips'; + } + } + $temp = main::get_defined($block->{'architecture'}, + $block->{'cpu family'},$block->{'cpu architecture'}); + if ($temp){ + if ($temp =~ /^\d+$/){ + # translate integers to hex + $cpu->{'family'} = uc(sprintf("%x",$temp)); + } + elsif ($risc{'arm'}){ + $cpu->{'arch'} = $temp; + } + } + # note: stepping and ARM cpu revision are integers + $temp = main::get_defined($block->{'stepping'},$block->{'cpu revision'}); + # can be 0, but can be 'unknown' + if (defined $temp || + ($cpu->{'type'} eq 'elbrus' && defined $block->{'revision'})){ + $temp = $block->{'revision'} if defined $block->{'revision'}; + if ($temp =~ /^\d+$/){ + $cpu->{'stepping'} = uc(sprintf("%x",$temp)); + } + # loongson, hex: 0x11 + elsif ($temp =~ /^0x[0-9a-f]{1,2}$/){ + $cpu->{'stepping'} = $temp; + } + } + # PPC revision is a string, but elbrus revision is hex + elsif (defined $block->{'revision'}){ + $cpu->{'revision'} = $block->{'revision'}; + } + # this is hex so uc for cpu arch id. raspi 4 has Model rather than Hardware + if (defined $block->{'model'}){ + # can be 0, but can be 'unknown' + $cpu->{'model-id'} = uc(sprintf("%x",$block->{'model'})); + } + if ($block->{'cpu variant'}){ + $cpu->{'model-id'} = uc($block->{'cpu variant'}); + $cpu->{'model-id'} =~ s/^0X//; + } + # this is per cpu, not total if > 1 pys cpus + if (!$cpu->{'cores'} && $block->{'cpu cores'}){ + $cpu->{'cores'} = $block->{'cpu cores'}; + } + ## this is only for -C full cpu output + if ($type eq 'full'){ + # note: in cases where only cache is there, don't guess, it can be L1, + # L2, or L3, but never all of them added togehter, so give up. + if ($block->{'cache size'} && + $block->{'cache size'} =~ /(\d+\s*[KMG])i?B?$/){ + $cpu->{'cache'} = main::translate_size($1); + } + if ($block->{'l1 cache size'} && + $block->{'l1 cache size'} =~ /(\d+\s*[KMG])i?B?$/){ + $cpu->{'l1-cache'} = main::translate_size($1); + } + if ($block->{'l2 cache size'} && + $block->{'l2 cache size'} =~ /(\d+\s*[KMG])i?B?$/){ + $cpu->{'l2-cache'} = main::translate_size($1); + } + if ($block->{'l3 cache size'} && + $block->{'l3 cache size'} =~ /(\d+\s*[KMG])i?B?$/){ + $cpu->{'l3-cache'} = main::translate_size($1); + } + $temp = main::get_defined($block->{'flags'} || $block->{'features'}); + if ($temp){ + $cpu->{'flags'} = $temp; + } + if ($b_admin){ + # note: not used unless maybe /sys data missing? + if ($block->{'bugs'}){ + $cpu->{'bugs-string'} = $block->{'bugs'}; + } + # unlike family and model id, microcode appears to be hex already + if ($block->{'microcode'}){ + if ($block->{'microcode'} =~ /0x/){ + $cpu->{'microcode'} = uc($block->{'microcode'}); + $cpu->{'microcode'} =~ s/^0X//; + } + else { + $cpu->{'microcode'} = uc(sprintf("%x",$block->{'microcode'})); + } + } + } + } + } + # These occurs in a separate block with E2C3, last in cpuinfo blocks, + # otherwise per block in E8C variants + if ($cpu->{'type'} eq 'elbrus' && (!$cpu->{'l1i-cache'} && + !$cpu->{'l1d-cache'} && !$cpu->{'l2-cache'} && !$cpu->{'l3-cache'})){ + # note: cache0 is L1i and cache1 L1d. cp_caches_fallback handles + if ($block->{'cache0'} && + $block->{'cache0'} =~ /size\s*=\s*(\d+)K\s/){ + $cpu->{'l1i-cache'} = $1; + } + if ($block->{'cache1'} && + $block->{'cache1'} =~ /size\s*=\s*(\d+)K\s/){ + $cpu->{'l1d-cache'} = $1; + } + if ($block->{'cache2'} && + $block->{'cache2'} =~ /size\s*=\s*(\d+)(K|M)\s/){ + $cpu->{'l2-cache'} = ($2 eq 'M') ? ($1*1024) : $1; + } + if ($block->{'cache3'} && + $block->{'cache3'} =~ /size\s*=\s*(\d+)(K|M)\s/){ + $cpu->{'l3-cache'} = ($2 eq 'M') ? ($1*1024) : $1; + } + } + ## Start incrementers + $temp = main::get_defined($block->{'cpu mhz'},$block->{'clock'}); + if ($temp){ + $speed = clean_speed($temp); + push(@{$cpu->{'processors'}},$speed); + } + # new arm shows bad bogomip value, so don't use it, however, ancient + # cpus, intel 486, can have super low bogomips, like 33.17 + if ($extra > 0 && $block->{'bogomips'} && ((%risc && + $block->{'bogomips'} > 50) || !%risc)){ + $cpu->{'bogomips'} += $block->{'bogomips'}; + } + # just to get core counts for ARM/MIPS/PPC systems + if (defined $block->{'processor'} && !$temp){ + if ($block->{'processor'} =~ /^\d+$/){ + push(@{$cpu->{'processors'}},0); + } + } + # note: for alder lake, could vary, depending on if e or p core but we + # only care aobut the highest value for crude logic here + if ($block->{'siblings'} && + (!$cpu->{'siblings'} || $block->{'siblings'} > $cpu->{'siblings'})){ + $cpu->{'siblings'} = $block->{'siblings'}; + } + # Ignoring trying to catch dies with $block->{'physical id'}, + # that's too buggy for cpuinfo + if (defined $block->{'core id'}){ + # https://www.pcworld.com/article/3214635/components-processors/ryzen-threadripper-review-we-test-amds-monster-cpu.html + my $phys = (defined $block->{'physical id'}) ? $block->{'physical id'}: 0; + my $die_id = 0; + if (!grep {$_ eq $block->{'core id'}} @{$cpu->{'ids'}->[$phys][$die_id]}){ + push(@{$cpu->{'ids'}->[$phys][$die_id]},$block->{'core id'}); + } + } + } + undef @cpuinfo; # we're done with it, dump it + undef %cpuinfo_machine; + if (%risc){ + if (!$cpu->{'type'}){ + $cpu->{'type'} = $risc{'id'}; + } + if (!$bsd_type){ + my $system_cpus = system_cpu_name(); + $cpu->{'system-cpus'} = $system_cpus if %$system_cpus; + } + } + main::log_data('dump','%$cpu',$cpu) if $b_log; + print 'cpuinfo: ', Data::Dumper::Dumper $cpu if $dbg[8]; + eval $end if $b_log; + return $cpu; +} + +# args: 0: $cpu ref; +sub cpuinfo_speed_sys { + eval $start if $b_log; + my @data; + my $val_id = 0; + # Run this logic first to make sure we get the speeds as raw as possible. + # Not in function to avoid unnecessary cpu use, we have slept right before. + # ARM and legacy systems etc do not always have cpufreq. + # note that there can be a definite cost to reading scaling_cur_freq, which + # must be generated on the fly based on some time snippet sample. + if ($fake{'cpu'}){ + if ($fake_data{'sys'} && (my @fake = main::reader($fake_data{'sys'},'strip'))){ + my $pattern = '/sys/devices/system/cpu/cpufreq/policy\d+/(affected_cpus|'; + # reading cpuinfo WAY faster than scaling, but root only + if (grep {m%/sys/devices/system/cpu/cpufreq/policy0/cpuinfo_cur_freq%} @fake){ + $pattern .= 'cpuinfo_cur_freq)'; + } + else { + $pattern .= 'scaling_cur_freq)'; + } + @data = grep {m%^$pattern%} @fake; + # print Data::Dumper::Dumper \@fake,"\n"; + } + $val_id = 1; + } + else { + my $glob = '/sys/devices/system/cpu/cpu*/cpufreq/{affected_cpus,'; + # reading cpuinfo WAY faster than scaling, but root only + if (-r '/sys/devices/system/cpu/cpu0/cpufreq/cpuinfo_cur_freq'){ + $glob .= 'cpuinfo_cur_freq}'; + } + else { + $glob .= 'scaling_cur_freq}'; + } + @data = main::globber($glob); + } + my ($error,$file,$key,%working,%freq,@value); + foreach (@data){ + next if !$fake{'cpu'} && ! -r $_; + undef $error; + # print "loop: $_\n"; + my $fh; + # $fh always non null, even on error + if (!$fake{'cpu'}){ + open($fh, '<', $_) or $error = $!; + } + if (!$error){ + if (m%/sys/devices/system/cpu/(cpufreq/)?(cpu|policy)(\d+)/(cpufreq/)?(affected_cpus|(cpuinfo|scaling)_cur_freq)%){ + $key = $3; + $file = $5; + if (!$fake{'cpu'}){ + chomp(@value = <$fh>); + close $fh; + } + else { + @value = split(/::/,$_,2); + } + if ($file eq 'affected_cpus'){ + # chomp seems to turn undefined into '', not sure why. Behavior varies + # so check for both cases. + if (defined $value[$val_id] && $value[$val_id] ne ''){ + $working{$key}->[0] = $value[$val_id]; + } + } + else { + $working{$key}->[1] = clean_speed($value[$val_id],'khz'); + } + } + } + } + if (%working){ + foreach (keys %working){ + $freq{sprintf("%04d",$_)} = $working{$_}->[1] if defined $working{$_}->[0]; + } + ${$_[0]}->{'sys-freq'} = \%freq if %freq; + # print 'result: ', Data::Dumper::Dumper $_[0]; + } + eval $end if $b_log; +} + +## SYS DATA +sub cpu_sys_data_grabber { + eval $start if $b_log; + my (@files); + set_fake_cpu_data() if $fake{'cpu'} && !$loaded{'cpu-fake-data'}; + # this data has to match the data in cpuinfo grabber fake cpu, and remember + # to use --arm flag if arm tests + if ($fake{'cpu'}){ + # print "$fake_data{'sys'}\n"; + @files = main::reader($fake_data{'sys'}) if $fake_data{'sys'}; + # print Data::Dumper::Dumper \@files; + } + # There's a massive time hit reading full globbed set of files, so grab and + # read only what we need. + else { + my $glob = '/sys/devices/system/cpu/{'; + if ($dbg[43]){ + $glob .= 'cpufreq,cpu*/topology,cpu*/cpufreq,cpu*/cache/index*,smt,vulnerabilities}/*'; + } + else { + $glob .= 'cpu*/topology/'; + $glob .= '{{cluster_cpus,core_cpus,core_siblings,thread_siblings}_list,'; + $glob .= '{core,die,cluster,node,physical_package,socket}_id}'; + $glob .= ',cpufreq/{boost,ondemand}'; + $glob .= ',cpu*/cpufreq/'; + $glob .= '{cpb,{cpuinfo_max,cpuinfo_min,scaling_max,scaling_min}_freq'; + if ($type eq 'full' && $b_admin){ + $glob .= ',scaling_driver,scaling_governor'; + } + $glob .= '}'; + if ($type eq 'full'){ + $glob .= ',cpu*/cache/index*/{level,shared_cpu_list,shared_cpu_map,size,type}'; + } + $glob .= ',smt/{active,control}'; + $glob .= ',vulnerabilities/*' if $b_admin; + $glob .= '}'; + } + # print "sys glob: $glob\n"; + @files = main::globber($glob); + } + main::log_data('dump','@files',\@files) if $b_log; + print Data::Dumper::Dumper \@files if $dbg[40]; + my ($b_bug,$b_cache,$b_freq,$b_topo,$b_main); + my $working = {}; + my ($main_id,$main_key,$holder,$id,$item,$key) = ('','','','','',''); + # need to return hash reference on failure or old systems complain + return $working if !@files; + foreach (sort @files){ + if ($fake{'cpu'}){ + ($_,$item) = split(/::/,$_,2); + } + else { + next if -d $_ || ! -e $_; + undef $item; + } + $key = $_; + $key =~ m|/([^/]+)/([^/]+)$|; + my ($key_1,$key_2) = ($1,$2); + if (m|/cpu(\d+)/|){ + if (!$holder || $1 ne $holder){ + $id = sprintf("%04d",$1); + $holder = $1; + } + $b_bug = 0; + $b_cache = 0; + $b_freq = 0; + $b_main = 0; + $b_topo = 0; + if ($key_1 eq 'cpufreq'){ + $b_freq = 1; + $main_key = $key_2; + $key = $key_1; + } + elsif ($key_1 eq 'topology'){ + $b_topo = 1; + $main_key = $key_2; + $key = $key_1; + } + elsif ($key_1 =~ /^index(\d+)$/){ + $b_cache = 1; + $main_key = $key_2; + $main_id = sprintf("%02d",$1); + $key = 'cache'; + } + } + elsif ($key_1 eq 'vulnerabilities'){ + $id = $key_1; + $key = $key_2; + $b_bug = 1; + $b_cache = 0; + $b_main = 0; + $b_freq = 0; + $b_topo = 0; + $main_key = ''; + $main_id = ''; + } + else { + $id = $key_1 . '-' . $key_2; + $b_bug = 0; + $b_cache = 0; + $b_main = 1; + $b_freq = 0; + $b_topo = 0; + $main_key = ''; + $main_id = ''; + } + if (!$fake{'cpu'}){ + if (-r $_) { + my $error; + # significantly faster to skip reader() and do it directly + # $fh always non null, even on error + open(my $fh, '<', $_) or $error = $!; + if (!$error){ + chomp(my @value = <$fh>); + close $fh; + $item = $value[0]; + } + # $item = main::reader($_,'strip',0); + } + else { + $item = main::message('root-required'); + } + $item = main::message('undefined') if !defined $item; + } + # print "$key_1 :: $key_2 :: $item\n"; + if ($b_main){ + $working->{'data'}{$id} = $item; + } + elsif ($b_bug){ + my $type = ($item =~ /^Mitigation:/) ? 'mitigation': 'status'; + $item =~ s/Mitigation: //; + $working->{'data'}{$id}{$key} = [$type,$item]; + } + elsif ($b_cache){ + $working->{'cpus'}{$id}{$key}{$main_id}{$main_key} = $item; + } + elsif ($b_freq || $b_topo){ + $working->{'cpus'}{$id}{$key}{$main_key} = $item; + } + } + main::log_data('dump','%$working',$working) if $b_log; + print Data::Dumper::Dumper $working if $dbg[39]; + eval $end if $b_log; + return $working; +} + +sub cpu_sys_data { + eval $start if $b_log; + my $sys_freq = $_[0]; + my $cpu_sys = {}; + my $working = cpu_sys_data_grabber(); + return $cpu_sys if !%$working; + $cpu_sys->{'data'} = $working->{'data'} if $working->{'data'}; + my ($core_id,$fake_core_id,$die_id,$phys_id) = (0,0,0,-1); + my (%cache_ids,@ci_freq_max,@ci_freq_min,@sc_freq_max,@sc_freq_min); + foreach my $id (sort keys %{$working->{'cpus'}}){ + ($core_id,$phys_id) = (0,0); + my $cpu_id = $id + 0; + my ($cluster_id,$speed); + my $phys_cpu = $working->{'cpus'}{$id}; + if (defined $phys_cpu->{'topology'}{'physical_package_id'}){ + $phys_id = sprintf("%04d",$phys_cpu->{'topology'}{'physical_package_id'}); + } + if (defined $phys_cpu->{'topology'}{'die_id'}){ + $cpu_sys->{'data'}{'die-file'} = 'die_id'; + $die_id = sprintf("%08d",$phys_cpu->{'topology'}{$cpu_sys->{'data'}{'die-file'}}); + } + else { + $die_id = 'ID-UNSET'; + } + # RISCV seen with no die_id but cluster_id with core_ids per cluster + # node_id, socket_id not seen but possibles but don't use until real case + # also alder lake haw one die but > 1 clusters + if (defined $phys_cpu->{'topology'}{'cluster_id'}){ + $cpu_sys->{'data'}{'cluster-file'} = 'cluster_id'; + $cluster_id = sprintf("%08d",$phys_cpu->{'topology'}{$cpu_sys->{'data'}{'cluster-file'}}); + } + if (defined $phys_cpu->{'topology'}{'core_id'}){ + # id is not consistent, seen 5 digit id + $core_id = sprintf("%08d",$phys_cpu->{'topology'}{'core_id'}); + if ($fake{'cpu'}){ + if (defined $phys_cpu->{'cpufreq'}{'scaling_cur_freq'} && + $phys_cpu->{'cpufreq'}{'affected_cpus'} && + $phys_cpu->{'cpufreq'}{'affected_cpus'} ne 'UNDEFINED' && + # manually generated cpu debuggers will show '', not UNDEFINED + $phys_cpu->{'cpufreq'}{'affected_cpus'} ne ''){ + $speed = clean_speed($phys_cpu->{'cpufreq'}{'scaling_cur_freq'},'khz'); + } + } + elsif (defined $sys_freq && defined $sys_freq->{$phys_id}){ + $speed = $sys_freq->{$phys_id}; + } + # ($cluster_id,$die_id) = (); + if (defined $speed){ + if ($cpu_sys->{'data'}{'die-file'} || !$cluster_id){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'dies'}{$die_id}{'cores'}{$core_id}},$speed); + } + if ($cluster_id){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'dies'}{$die_id}{'clusters'}{$cluster_id}{'cores'}{$core_id}},$speed); + } + push(@{$cpu_sys->{'data'}{'speeds'}{'all'}},$speed); + } + else { + push(@{$cpu_sys->{'data'}{'speeds'}{'all'}},0); + # seen cases, riscv, where core id, phys id, are all -1 + my $id = ($core_id != -1) ? $core_id: $fake_core_id++; + if ($cpu_sys->{'data'}{'die-file'} || !$cluster_id){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'dies'}{$die_id}{'cores'}{$id}},0); + } + if ($cluster_id){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'dies'}{$die_id}{'clusters'}{$cluster_id}{'cores'}{$id}},0); + } + } + # Only use if topology core-id exists, some virtualized cpus can list + # frequency data for the non available cores, but those do not show + # topology data. + # For max / min, we want to prep for the day 1 pys cpu has > 1 min/max freq + if (defined $phys_cpu->{'cpufreq'}{'cpuinfo_max_freq'}){ + $phys_cpu->{'cpufreq'}{'cpuinfo_max_freq'} = clean_speed($phys_cpu->{'cpufreq'}{'cpuinfo_max_freq'},'khz'); + if (!grep {$_ eq $phys_cpu->{'cpufreq'}{'cpuinfo_max_freq'}} @ci_freq_max){ + push(@ci_freq_max,$phys_cpu->{'cpufreq'}{'cpuinfo_max_freq'}); + } + if (!grep {$_ eq $phys_cpu->{'cpufreq'}{'cpuinfo_max_freq'}} @{$cpu_sys->{'cpus'}{$phys_id}{'max-freq'}}){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'max-freq'}},$phys_cpu->{'cpufreq'}{'cpuinfo_max_freq'}); + } + } + if (defined $phys_cpu->{'cpufreq'}{'cpuinfo_min_freq'}){ + $phys_cpu->{'cpufreq'}{'cpuinfo_min_freq'} = clean_speed($phys_cpu->{'cpufreq'}{'cpuinfo_min_freq'},'khz'); + if (!grep {$_ eq $phys_cpu->{'cpufreq'}{'cpuinfo_min_freq'}} @ci_freq_min){ + push(@ci_freq_min,$phys_cpu->{'cpufreq'}{'cpuinfo_min_freq'}); + } + if (!grep {$_ eq $phys_cpu->{'cpufreq'}{'cpuinfo_min_freq'}} @{$cpu_sys->{'cpus'}{$phys_id}{'min-freq'}}){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'min-freq'}},$phys_cpu->{'cpufreq'}{'cpuinfo_min_freq'}); + } + } + if (defined $phys_cpu->{'cpufreq'}{'scaling_max_freq'}){ + $phys_cpu->{'cpufreq'}{'scaling_max_freq'} = clean_speed($phys_cpu->{'cpufreq'}{'scaling_max_freq'},'khz'); + if (!grep {$_ eq $phys_cpu->{'cpufreq'}{'scaling_max_freq'}} @sc_freq_max){ + push(@sc_freq_max,$phys_cpu->{'cpufreq'}{'scaling_max_freq'}); + } + if (!grep {$_ eq $phys_cpu->{'cpufreq'}{'scaling_max_freq'}} @{$cpu_sys->{'cpus'}{$phys_id}{'max-freq'}}){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'max-freq'}},$phys_cpu->{'cpufreq'}{'scaling_max_freq'}); + } + } + if (defined $phys_cpu->{'cpufreq'}{'scaling_min_freq'}){ + $phys_cpu->{'cpufreq'}{'scaling_min_freq'} = clean_speed($phys_cpu->{'cpufreq'}{'scaling_min_freq'},'khz'); + if (!grep {$_ eq $phys_cpu->{'cpufreq'}{'scaling_min_freq'}} @sc_freq_min){ + push(@sc_freq_min,$phys_cpu->{'cpufreq'}{'scaling_min_freq'}); + } + if (!grep {$_ eq $phys_cpu->{'cpufreq'}{'scaling_min_freq'}} @{$cpu_sys->{'cpus'}{$phys_id}{'min-freq'}}){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'min-freq'}},$phys_cpu->{'cpufreq'}{'scaling_min_freq'}); + } + } + if (defined $phys_cpu->{'cpufreq'}{'scaling_governor'}){ + if (!grep {$_ eq $phys_cpu->{'cpufreq'}{'scaling_governor'}} @{$cpu_sys->{'cpus'}{$phys_id}{'governor'}}){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'governor'}},$phys_cpu->{'cpufreq'}{'scaling_governor'}); + } + } + if (defined $phys_cpu->{'cpufreq'}{'scaling_driver'}){ + $cpu_sys->{'cpus'}{$phys_id}{'scaling-driver'} = $phys_cpu->{'cpufreq'}{'scaling_driver'}; + } + } + if (!defined $cpu_sys->{'data'}{'cpufreq-boost'} && defined $phys_cpu->{'cpufreq'}{'cpb'}){ + $cpu_sys->{'data'}{'cpufreq-boost'} = $phys_cpu->{'cpufreq'}{'cpb'}; + } + if (defined $phys_cpu->{'topology'}{'core_cpus_list'}){ + $phys_cpu->{'topology'}{'thread_siblings_list'} = $phys_cpu->{'topology'}{'core_cpus_list'}; + } + if (defined $phys_cpu->{'cache'} && keys %{$phys_cpu->{'cache'}} > 0){ + foreach my $key2 (sort keys %{$phys_cpu->{'cache'}}){ + my $cache = $phys_cpu->{'cache'}{$key2}; + my $type = ($cache->{'type'} =~ /^([DI])/i) ? lc($1): ''; + my $level = 'l' . $cache->{'level'} . $type; + # Very old systems, 2.6.xx do not have shared_cpu_list + if (!defined $cache->{'shared_cpu_list'} && defined $cache->{'shared_cpu_map'}){ + $cache->{'shared_cpu_list'} = $cache->{'shared_cpu_map'}; + } + # print Data::Dumper::Dumper $cache; + if (defined $cache->{'shared_cpu_list'}){ + # not needed, the cpu is always in the range + # my $range = main::regex_range($cache->{'shared_cpu_list'}); + my $size = main::translate_size($cache->{'size'}); + # print "cpuid: $cpu_id phys-core: $phys_id-$core_id level: $level range: $range shared: $cache->{'shared_cpu_list'}\n"; + if (!(grep {$_ eq $cache->{'shared_cpu_list'}} @{$cache_ids{$phys_id}->{$level}})){ + push(@{$cache_ids{$phys_id}->{$level}},$cache->{'shared_cpu_list'}); + push(@{$cpu_sys->{'cpus'}{$phys_id}{'caches'}{$level}},$size); + } + } + } + } + } + if (defined $cpu_sys->{'data'}{'cpufreq-boost'} && + $cpu_sys->{'data'}{'cpufreq-boost'} =~ /^[01]$/){ + if ($cpu_sys->{'data'}{'cpufreq-boost'}){ + $cpu_sys->{'data'}{'cpufreq-boost'} = 'enabled'; + } + else { + $cpu_sys->{'data'}{'cpufreq-boost'} = 'disabled'; + } + } + # cpuinfo_max_freq:["2000000"] cpuinfo_max_freq:["1500000"] + # cpuinfo_min_freq:["200000"] + if (@ci_freq_max){ + $cpu_sys->{'data'}{'speeds'}{'max-freq'} = join(':',@ci_freq_max); + } + if (@ci_freq_min){ + $cpu_sys->{'data'}{'speeds'}{'min-freq'} = join(':',@ci_freq_min); + } + # also handle off chance that cpuinfo_min/max not set, but scaling_min/max there + if (@sc_freq_max){ + $cpu_sys->{'data'}{'speeds'}{'scaling-max-freq'} = join(':',@sc_freq_max); + if (!$cpu_sys->{'data'}{'speeds'}{'max-freq'}){ + $cpu_sys->{'data'}{'speeds'}{'max-freq'} = $cpu_sys->{'data'}{'speeds'}{'scaling-max-freq'}; + } + } + if (@sc_freq_min){ + $cpu_sys->{'data'}{'speeds'}{'scaling-min-freq'} = join(':',@sc_freq_min); + if (!$cpu_sys->{'data'}{'speeds'}{'min-freq'}){ + $cpu_sys->{'data'}{'speeds'}{'min-freq'} = $cpu_sys->{'data'}{'speeds'}{'scaling-min-freq'}; + } + } + # this corrects a bug we see sometimes in min/max frequencies + if ((scalar @ci_freq_max < 2 && scalar @ci_freq_min < 2) && + (defined $cpu_sys->{'data'}{'speeds'}{'min-freq'} && + defined $cpu_sys->{'data'}{'speeds'}{'max-freq'}) && + ($cpu_sys->{'data'}{'speeds'}{'min-freq'} > $cpu_sys->{'data'}{'speeds'}{'max-freq'} || + $cpu_sys->{'data'}{'speeds'}{'min-freq'} == $cpu_sys->{'data'}{'speeds'}{'max-freq'})){ + $cpu_sys->{'data'}{'speeds'}{'min-freq'} = 0; + } + main::log_data('dump','%$cpu_sys',$cpu_sys) if $b_log; + print 'cpu_sys_data: %$cpu-sys: ', Data::Dumper::Dumper $cpu_sys if $dbg[8]; + eval $end if $b_log; + return $cpu_sys; +} + +# all values passed by reference so no need for returns +sub cp_data_sys { + eval $start if $b_log; + my ($cpu,$cpu_sys,$caches,$counts) = @_; + my @phys_keys = sort keys %{$cpu_sys->{'cpus'}}; + return if ! @phys_keys; + $counts->{'physical'} = scalar @phys_keys; + if ($type eq 'full' && $cpu_sys->{'cpus'}{$phys_keys[0]}{'caches'}){ + cp_sys_caches($cpu_sys->{'cpus'}{$phys_keys[0]}{'caches'},$caches,'l1','l1d'); + cp_sys_caches($cpu_sys->{'cpus'}{$phys_keys[0]}{'caches'},$caches,'l1','l1i'); + cp_sys_caches($cpu_sys->{'cpus'}{$phys_keys[0]}{'caches'},$caches,'l2',''); + cp_sys_caches($cpu_sys->{'cpus'}{$phys_keys[0]}{'caches'},$caches,'l3',''); + } + if ($cpu_sys->{'data'}{'speeds'}{'all'}){ + $counts->{'processors'} = scalar @{$cpu_sys->{'data'}{'speeds'}{'all'}}; + } + if (defined $cpu_sys->{'data'}{'smt-active'}){ + if ($cpu_sys->{'data'}{'smt-active'}){ + $cpu->{'smt'} = 'enabled'; + } + # values: on/off/notsupported/notimplemented + elsif (defined $cpu_sys->{'data'}{'smt-control'} && + $cpu_sys->{'data'}{'smt-control'} =~ /^not/){ + $cpu->{'smt'} = main::message('unsupported'); + } + else { + $cpu->{'smt'} = 'disabled'; + } + } + my $i = 0; + my ($b_skip,@governor,@max,@min,@phys_cores); + foreach my $phys_id (@phys_keys){ + cp_dies_clusters( + $cpu, + $counts, + $cpu_sys->{'cpus'}{$phys_id}, + $cpu_sys->{'data'}, + $i, + $b_skip); + $b_skip = 1; # skips count->{cpu-cores} after first phys iteration + foreach my $die_id (sort keys %{$cpu_sys->{'cpus'}{$phys_id}{'dies'}}){ + # If we ever get > 1 min/max speed per phy cpu, we'll need to fix the [0] + if ($cpu_sys->{'cpus'}{$phys_id}{'max-freq'}[0]){ + if (!grep {$cpu_sys->{'cpus'}{$phys_id}{'max-freq'}[0] eq $_} @max){ + push(@max,$cpu_sys->{'cpus'}{$phys_id}{'max-freq'}[0]); + } + $counts->{'cpu-topo'}[$i]{'max'} = $cpu_sys->{'cpus'}{$phys_id}{'max-freq'}[0]; + } + if ($cpu_sys->{'cpus'}{$phys_id}{'min-freq'}[0]){ + if (!grep {$cpu_sys->{'cpus'}{$phys_id}{'min-freq'}[0] eq $_} @min){ + push(@min,$cpu_sys->{'cpus'}{$phys_id}{'min-freq'}[0]); + } + $counts->{'cpu-topo'}[$i]{'min'} = $cpu_sys->{'cpus'}{$phys_id}{'min-freq'}[0]; + } + # cheating, this is not a count, but we need the data for topology, must + # sort since governors can be in different order if > 1 + if ($cpu_sys->{'cpus'}{$phys_id}{'governor'}){ + foreach my $gov (@{$cpu_sys->{'cpus'}{$phys_id}{'governor'}}){ + push(@governor,$gov) if !grep {$_ eq $gov} @governor; + } + $cpu->{'governor'} = join(',',@governor); + } + if ($cpu_sys->{'cpus'}{$phys_id}{'scaling-driver'}){ + $cpu->{'scaling-driver'} = $cpu_sys->{'cpus'}{$phys_id}{'scaling-driver'}; + } + if ($cpu_sys->{'cpus'}{$phys_id}{'scaling-driver'}){ + $cpu->{'scaling-driver'} = $cpu_sys->{'cpus'}{$phys_id}{'scaling-driver'}; + } + if ($cpu_sys->{'cpus'}{$phys_id}{'scaling-max-freq'}){ + $cpu->{'scaling-max-freq'} = $cpu_sys->{'cpus'}{$phys_id}{'scaling-max-freq'}; + } + if ($cpu_sys->{'cpus'}{$phys_id}{'scaling-min-freq'}){ + $cpu->{'scaling-min-freq'} = $cpu_sys->{'cpus'}{$phys_id}{'scaling-min-freq'}; + } + if (!grep {$counts->{'cpu-cores'} eq $_} @phys_cores){ + push(@phys_cores,$counts->{'cpu-cores'}); + } + } + if ($counts->{'processors'} && $counts->{'processors'} > $counts->{'cpu-cores'}){ + foreach my $die_id (sort keys %{$cpu_sys->{'cpus'}{$phys_id}{'dies'}}){ + if (!$cpu_sys->{'cpus'}{$phys_id}{'dies'}{$die_id}{'clusters'}){ + if ($cpu_sys->{'cpus'}{$phys_id}{'dies'}{$die_id}{'cores'}){ + cp_set_threads( + $cpu_sys->{'cpus'}{$phys_id}{'dies'}{$die_id}{'cores'}, + $counts, + $i); + } + } + else { + foreach my $cluster_id (sort keys %{$cpu_sys->{'cpus'}{$phys_id}{'dies'}{$die_id}{'clusters'}}){ + if ($cpu_sys->{'cpus'}{$phys_id}{'dies'}{$die_id}{'clusters'}{$cluster_id}{'cores'}){ + cp_set_threads( + $cpu_sys->{'cpus'}{$phys_id}{'dies'}{$die_id}{'clusters'}{$cluster_id}{'cores'}, + $counts, + $i); + } + } + } + + } + } + $i++; + } + $counts->{'struct-max'} = 1 if scalar @max > 1; + $counts->{'struct-min'} = 1 if scalar @min > 1; + $counts->{'struct-cores'} = 1 if scalar @phys_cores > 1; + if ($b_log){ + main::log_data('dump','%$caches',$caches); + main::log_data('dump','%$counts',$counts); + } + if ($dbg[68]){ + print '%$cpu: ', Data::Dumper::Dumper $cpu; + print 'cpu %$caches: ', Data::Dumper::Dumper $caches; + print 'cpu %$counts: ', Data::Dumper::Dumper $counts; + } + eval $end if $b_log; +} + +# args: 0: $cpu by ref; 1: $counts by ref; 2: $phy_cpu by ref; 3: $i +sub cp_dies_clusters { + eval $start if $b_log; + my ($cpu,$counts,$phys_cpu,$data,$i,$b_skip) = @_; + # we don't want the placeholder die ID counted as an actual die! + if ($phys_cpu->{'dies'} && $data->{'die-file'}){ + $counts->{'cpu-topo'}[$i]{'dies'} = scalar keys %{$phys_cpu->{'dies'}}; + $cpu->{'dies-count'} = $counts->{'cpu-topo'}[$i]{'dies'}; + } + foreach my $id (sort keys %{$phys_cpu->{'dies'}}){ + if ($phys_cpu->{'dies'}{$id}{'clusters'}){ + # this will show dies x clusters in output, since no way to know if cluster + # ids are per phys cpu or per die. + $cpu->{'clusters-count'} = scalar keys %{$phys_cpu->{'dies'}{$id}{'clusters'}}; + $counts->{'cpu-topo'}[$i]{'clusters'} = $cpu->{'clusters-count'}; + foreach my $cluster_id (sort keys %{$phys_cpu->{'dies'}{$id}{'clusters'}}){ + if ($phys_cpu->{'dies'}{$id}{'clusters'}{$cluster_id}{'cores'}){ + cp_core_counter( + $cpu, + $phys_cpu->{'dies'}{$id}{'clusters'}{$cluster_id}{'cores'}, + $counts, + $i, + $b_skip); + } + } + } + else { + if ($phys_cpu->{'dies'}{$id}{'cores'}){ + cp_core_counter( + $cpu, + $phys_cpu->{'dies'}{$id}{'cores'}, + $counts, + $i, + $b_skip); + } + } + } + eval $end if $b_log; +} + +# args: 0: $cpu by ref; 1: $cores; 2: $counts (by ref); 3: $i; +# 4: $b_dies: 0 for first iteration +sub cp_core_counter { + eval $start if $b_log; + my ($cpu,$item,$counts,$i,$b_skip) = @_; + my $cores = 0; + $cores = scalar keys %{$item}; + $counts->{'cpu-topo'}[$i]{'cores'} += $cores; + $cpu->{'cores'} = $cores; + $counts->{'cpu-cores'} += $cores if !$b_skip; + eval $end if $b_log; +} + +# args: 0: cores hash; 1: $counts, by ref; 2: $i +sub cp_set_threads { + eval $start if $b_log; + my ($cores,$counts,$i) = @_; + foreach my $core_key (sort keys %{$cores}){ + if ((my $threads = scalar @{$cores->{$core_key}}) > 1){ + $counts->{'cpu-topo'}[$i]{'cores-mt'}++; + $counts->{'cpu-topo'}[$i]{'threads'} += $threads; + # note: for mt+st type cpus, we need to handle tpc on output per type + $counts->{'cpu-topo'}[$i]{'tpc'} = $threads; + $counts->{'struct-mt'} = 1; + } + else { + $counts->{'cpu-topo'}[$i]{'cores-st'}++; + $counts->{'cpu-topo'}[$i]{'threads'}++; + $counts->{'struct-st'} = 1; + } + } + eval $end if $b_log; +} + +sub cp_sys_caches { + eval $start if $b_log; + my ($sys_caches,$caches,$id,$id_di) = @_; + my $cache_id = ($id_di) ? $id_di: $id; + my %cache_desc; + if ($sys_caches->{$cache_id}){ + # print Data::Dumper::Dumper $cpu_sys->{'cpus'}; + foreach (@{$sys_caches->{$cache_id}}){ + # android seen to have cache data without size item + next if !defined $_; + $caches->{$cache_id} += $_; + $cache_desc{$_}++ if $b_admin; + } + $caches->{$id} += $caches->{$id_di} if $id_di; + $caches->{$cache_id . '-desc'} = cp_cache_desc(\%cache_desc) if $b_admin; + } + eval $end if $b_log; +} +## END SYS DATA ## + +## BSD DATA +sub cpu_sysctl_data { + eval $start if $b_log; + my ($cpu,@line,%speeds,@working); + my ($sep) = (''); + my ($die_holder,$die_id,$phys_holder,$phys_id,$proc_count,$speed) = (0,0,0,0,0,0,0); + set_cpu_data(\$cpu); + @{$sysctl{'cpu'}} = () if !$sysctl{'cpu'}; # don't want error next! + foreach (@{$sysctl{'cpu'}}){ + @line = split(/\s*:\s*/, $_); + next if !$line[0]; + # darwin shows machine, like MacBook7,1, not cpu + # machdep.cpu.brand_string: Intel(R) Core(TM)2 Duo CPU P8600 @ 2.40GHz + if (($bsd_type ne 'darwin' && $line[0] eq 'hw.model') || + $line[0] eq 'machdep.cpu.brand_string'){ + # cut L2 cache/cpu max speed out of model string, if available + # openbsd 5.6: AMD Sempron(tm) Processor 3400+ ("AuthenticAMD" 686-class, 256KB L2 cache) + # openbsd 6.x has Lx cache data in dmesg.boot + # freebsd 10: hw.model: AMD Athlon(tm) II X2 245 Processor + $line[1] = main::clean($line[1]); + $line[1] = clean_cpu($line[1]); + if ($line[1] =~ /([0-9]+)[\s-]*([KM]B)\s+L2 cache/i){ + my $multiplier = ($2 eq 'MB') ? 1024: 1; + $cpu->{'l2-cache'} = $1 * $multiplier; + } + if ($line[1] =~ /([^0-9\.][0-9\.]+)[\s-]*[MG]Hz/){ + $cpu->{'max-freq'} = $1; + if ($cpu->{'max-freq'} =~ /MHz/i){ + $cpu->{'max-freq'} =~ s/[\s-]*MHz//; + $cpu->{'max-freq'} = clean_speed($cpu->{'max-freq'},'mhz'); + } + elsif ($cpu->{'max-freq'} =~ /GHz/){ + $cpu->{'max-freq'} =~ s/[\s-]*GHz//i; + $cpu->{'max-freq'} = $cpu->{'max-freq'} / 1000; + $cpu->{'max-freq'} = clean_speed($cpu->{'max-freq'},'mhz'); + } + } + if ($line[1] =~ /\)$/){ + $line[1] =~ s/\s*\(.*\)$//; + } + $cpu->{'model_name'} = $line[1]; + $cpu->{'type'} = cpu_vendor($line[1]); + } + # NOTE: hw.l1icachesize: hw.l1dcachesize: ; in bytes, apparently + elsif ($line[0] eq 'hw.l1dcachesize'){ + $cpu->{'l1d-cache'} = $line[1]/1024; + } + elsif ($line[0] eq 'hw.l1icachesize'){ + $cpu->{'l1i-cache'} = $line[1]/1024; + } + elsif ($line[0] eq 'hw.l2cachesize'){ + $cpu->{'l2-cache'} = $line[1]/1024; + } + elsif ($line[0] eq 'hw.l3cachesize'){ + $cpu->{'l3-cache'} = $line[1]/1024; + } + # hw.smt: openbsd + elsif ($line[0] eq 'hw.smt'){ + $cpu->{'smt'} = ($line[1]) ? 'enabled' : 'disabled'; + } + # htl: maybe freebsd, never seen, 1 is disabled, sigh... + elsif ($line[0] eq 'machdep.hlt_logical_cpus'){ + $cpu->{'smt'} = ($line[1]) ? 'disabled' : 'enabled'; + } + # this is in mghz in samples + elsif (!$cpu->{'cur-freq'} && + ($line[0] eq 'hw.clockrate' || $line[0] eq 'hw.cpuspeed')){ + $cpu->{'cur-freq'} = $line[1]; + } + # these are in hz: 2400000000 + elsif ($line[0] eq 'hw.cpufrequency'){ + $cpu->{'cur-freq'} = $line[1]/1000000; + } + elsif ($line[0] eq 'hw.busfrequency_min'){ + $cpu->{'min-freq'} = $line[1]/1000000; + } + elsif ($line[0] eq 'hw.busfrequency_max'){ + $cpu->{'max-freq'} = $line[1]/1000000; + } + # FB seems to call freq something other than clock speed, unreliable + # eg: 1500 Mhz real shows as 2400 freq, which is wrong + # elsif ($line[0] =~ /^dev\.cpu\.([0-9]+)\.freq$/){ + # $speed = clean_speed($line[1]); + # $cpu->{'processors'}->[$1] = $speed; + # } + # weird FB thing, freq can be wrong, so just count the cores and call it + # done. + elsif ($line[0] =~ /^dev\.cpu\.([0-9]+)\./ && + (!$cpu->{'processors'} || !defined $cpu->{'processors'}->[$1])){ + $cpu->{'processors'}->[$1] = undef; + } + elsif ($line[0] eq 'machdep.cpu.vendor'){ + $cpu->{'type'} = cpu_vendor($line[1]); + } + # darwin only? + elsif ($line[0] eq 'machdep.cpu.features'){ + $cpu->{'flags'} = lc($line[1]); + } + # is this per phys or total? + elsif ($line[0] eq 'hw.ncpu'){ + $cpu->{'cores'} = $line[1]; + } + # Freebsd does some voltage hacking to actually run at lowest listed + # frequencies. The cpu does not actually support all the speeds output + # here but works in freebsd. Disabled this, the freq appear to refer to + # something else, not cpu clock. Remove XXX to enable + elsif ($line[0] eq 'dev.cpu.0.freq_levelsXXX'){ + $line[1] =~ s/^\s+|\/[0-9]+|\s+$//g; + if ($line[1] =~ /[0-9]+\s+[0-9]+/){ + # get rid of -1 in FB: 2400/-1 2200/-1 2000/-1 1800/-1 + $line[1] =~ s|/-1||g; + my @temp = split(/\s+/, $line[1]); + $cpu->{'max-freq'} = $temp[0]; + $cpu->{'min-freq'} = $temp[-1]; + $cpu->{'scalings'} = \@temp; + } + } + # Disabled w/XXX. this is almost certainly bad data, should not be used + elsif (!$cpu->{'cur-freq'} && $line[0] eq 'dev.cpu.0.freqXXX'){ + $cpu->{'cur-freq'} = $line[1]; + } + # the following have only been seen in DragonflyBSD data but thumbs up! + elsif ($line[0] eq 'hw.cpu_topology.members'){ + my @temp = split(/\s+/, $line[1]); + my $count = scalar @temp; + $count-- if $count > 0; + # no way to get per processor speeds yet, so assign 0 to each + foreach (0 .. $count){ + $cpu->{'processors'}->[$_] = 0; + } + } + elsif ($line[0] eq 'hw.cpu_topology.cpu1.physical_siblings'){ + # string, like: cpu0 cpu1 + my @temp = split(/\s+/, $line[1]); + $cpu->{'siblings'} = scalar @temp; + } + # increment by 1 for every new physical id we see. These are in almost all + # cases separate cpus, not separate dies within a single cpu body. + # This needs DATA!! Almost certainly wrong!! + elsif ($line[0] eq 'hw.cpu_topology.cpu0.physical_id'){ + if ($phys_holder != $line[1]){ + $phys_id++; + $phys_holder = $line[1]; + push(@{$cpu->{'ids'}->[$phys_id][$die_id]},0); + } + } + elsif ($line[0] eq 'hw.cpu_topology.cpu0.core_id'){ + $cpu->{'ids'}->[$phys_id][$line[1]] = $speed; + } + } + if (!$cpu->{'flags'} || !$cpu->{'family'}){ + my $dmesg_boot = cp_dboot_data(); + # this core count may fix failed MT detection. + $cpu->{'cores'} = $dmesg_boot->{'cores'} if $dmesg_boot->{'cores'}; + $cpu->{'flags'} = $dmesg_boot->{'flags'} if !$cpu->{'flags'}; + $cpu->{'family'} = $dmesg_boot->{'family'} if !$cpu->{'family'}; + $cpu->{'l1d-cache'} = $dmesg_boot->{'l1d-cache'} if !$cpu->{'l1d-cache'}; + $cpu->{'l1i-cache'} = $dmesg_boot->{'l1i-cache'} if !$cpu->{'l1i-cache'}; + $cpu->{'l2-cache'} = $dmesg_boot->{'l2-cache'} if !$cpu->{'l2-cache'}; + $cpu->{'l3-cache'} = $dmesg_boot->{'l3-cache'} if !$cpu->{'l3-cache'}; + $cpu->{'microcode'} = $dmesg_boot->{'microcode'} if !$cpu->{'microcode'}; + $cpu->{'model-id'} = $dmesg_boot->{'model-id'} if !$cpu->{'model-id'}; + $cpu->{'max-freq'} = $dmesg_boot->{'max-freq'} if !$cpu->{'max-freq'}; + $cpu->{'min-freq'} = $dmesg_boot->{'min-freq'} if !$cpu->{'min-freq'}; + $cpu->{'scalings'} = $dmesg_boot->{'scalings'} if !$cpu->{'scalings'}; + $cpu->{'siblings'} = $dmesg_boot->{'siblings'} if !$cpu->{'siblings'}; + $cpu->{'stepping'} = $dmesg_boot->{'stepping'} if !$cpu->{'stepping'}; + $cpu->{'type'} = $dmesg_boot->{'type'} if !$cpu->{'type'}; + } + main::log_data('dump','%$cpu',$cpu) if $b_log; + print 'sysctl $cpu: ', Data::Dumper::Dumper $cpu if $dbg[8]; + eval $end if $b_log; + return $cpu; +} + +sub cp_dboot_data { + eval $start if $b_log; + my ($max_freq,$min_freq,@scalings); + my ($family,$flags,$microcode,$model,$sep,$stepping,$type) = ('','','','','','',''); + my ($cores,$siblings) = (0,0); + my ($l1d,$l1i,$l2,$l3) = (0,0,0,0); + # this will be null if it was not readable + my $file = $system_files{'dmesg-boot'}; + if ($dboot{'cpu'}){ + foreach (@{$dboot{'cpu'}}){ + # can be ~Features/Features2/AMD Features + if (/Features/ || ($bsd_type eq "openbsd" && + /^cpu0:\s*[a-z0-9]{2,3}(\s|,)[a-z0-9]{2,3}(\s|,)/i)){ + my @line = split(/:\s*/, lc($_)); + # free bsd has to have weird syntax: <....,> + # Features2=0x1e98220b + $line[1] =~ s/^[^<]*<|>[^>]*$//g; + # then get rid of stuff + $line[1] =~ s/<[^>]+>//g; + # handle corner case like ,EL3 32, + $line[1] =~ s/ (32|64)/_$1/g; + # and replace commas with spaces + $line[1] =~ s/,/ /g; + $flags .= $sep . $line[1]; + $sep = ' '; + } + # cpu0:AMD E1-1200 APU with Radeon(tm) HD Graphics, 1398.66 MHz, 14-02-00 + elsif (/^cpu0:\s*([^,]+),\s+([0-9\.]+\s*MHz),\s+([0-9a-f]+)-([0-9a-f]+)-([0-9a-f]+)/){ + $type = cpu_vendor($1); + $family = uc($3); + $model = uc($4); + $stepping = uc($5); + $family =~ s/^0//; + $model =~ s/^0//; + $stepping =~ s/^0//; # can be 00 + } + # note: cpu cache is in KiB MiB even though they call it KB and MB + # cpu31: 32KB 64b/line 8-way I-cache, 32KB 64b/line 8-way D-cache, 512KB 64b/line 8-way L2 cache + # 8-way means 1 per core, 16-way means 1/2 per core + elsif (/^cpu0:\s*[0-9\.]+[KMG]B\s/){ + # cpu0: 32KB 64b/line 4-way L1 VIPT I-cache, 32KB 64b/line 4-way L1 D-cache + # cpu0:48KB 64b/line 3-way L1 PIPT I-cache, 32KB 64b/line 2-way L1 D-cache + if (/\b([0-9\.]+[KMG])i?B\s\S+\s([0-9]+)-way\sD[\s-]?cache/){ + $l1d = main::translate_size($1); + } + if (/\b([0-9\.]+[KMG])i?B\s\S+\s([0-9]+)-way\s(L1 \S+\s)?I[\s-]?cache/){ + $l1i = main::translate_size($1); + } + if (/\b([0-9\.]+[KMG])i?B\s\S+\s([0-9]+)-way\sL2[\s-]?cache/){ + $l2 = main::translate_size($1); + } + if (/\b([0-9\.]+[KMG])i?B\s\S+\s([0-9]+)-way\sL3[\s-]?cache/){ + $l3 = main::translate_size($1); + } + } + elsif (/^~Origin:(.+?)[\s,]+(Id|Family|Model|Stepping)/){ + $type = cpu_vendor($1); + if (/\bId\s*=\s*(0x)?([0-9a-f]+)\b/){ + $microcode = ($1) ? uc($2) : $2; + } + if (/\bFamily\s*=\s*(0x)?([a-f0-9]+)\b/){ + $family = ($1) ? uc($2) : $2; + } + if (/\bModel\s*=\s*(0x)?([a-f0-9]+)\b/){ + $model = ($1) ? uc($2) : $2; + } + # they don't seem to use hex for steppings, so convert it + if (/\bStepping\s*=\s*(0x)?([0-9a-f]+)\b/){ + $stepping = (!$1) ? uc(sprintf("%X",$2)) : $2; + } + } + elsif (/^cpu0:.*?[0-9\.]+\s?MHz:\sspeeds:\s(.*?)\s?MHz/){ + @scalings = split(/[,\s]+/,$1); + $min_freq = $scalings[-1]; + $max_freq = $scalings[0]; + } + # 2 core MT Intel Core/Rzyen similar, use smt 0 as trigger to count: + # cpu2:smt 0, core 1, package 0 + # cpu3:smt 1, core 1, package 0 + ## but: older AMD Athlon 2 core: + # cpu0:smt 0, core 0, package 0 + # cpu0:smt 0, core 0, package 1 + elsif (/cpu([0-9]+):smt\s([0-9]+),\score\s([0-9]+)(,\spackage\s([0-9]+))?/){ + $siblings = $1 + 1; + $cores += 1 if $2 == 0; + } + } + if ($flags){ + $flags =~ s/\s+/ /g; + $flags =~ s/^\s+|\s+$//g; + } + } + else { + if ($file && ! -r $file){ + $flags = main::message('dmesg-boot-permissions'); + } + } + my $values = { + 'cores' => $cores, + 'family' => $family, + 'flags' => $flags, + 'l1d-cache' => $l1d, + 'l1i-cache' => $l1i, + 'l2-cache' => $l2, + 'l3-cache' => $l3, + 'max-freq' => $max_freq, + 'microcode' => $microcode, + 'min-freq' => $min_freq, + 'model-id' => $model, + 'scalings' => \@scalings, + 'siblings' => $siblings, + 'stepping' => $stepping, + 'type' => $type, + }; + print 'dboot $values: ', Data::Dumper::Dumper $values if $dbg[27]; + eval $end if $b_log; + return $values; +} +## END BSD DATA ## + +## DMIDECODE DATA ## +sub cpu_dmidecode_data { + eval $start if $b_log; + my $dmi_data = {'L1' => 0, 'L2' => 0,'L3' => 0, 'phys-cnt' => 0, + 'ext-clock' => undef, 'socket' => undef, 'speed' => undef, + 'max-speed' => undef, 'upgrade' => undef, 'volts' => undef}; + return $dmi_data if !@dmi; + my ($id,$amount,$socket,$upgrade); + foreach my $item (@dmi){ + next if ref $item ne 'ARRAY'; + next if ($item->[0] < 4 || $item->[0] == 5 || $item->[0] == 6); + last if $item->[0] > 7; + if ($item->[0] == 7){ + # skip first three rows, we don't need that data + # seen very bad data, L2 labeled L3, and random phantom type 7 caches + ($id,$amount) = ('',0); + # Configuration: Disabled, Not Socketed, Level 2 + next if $item->[4] =~ /^Configuration:.*Disabled/i; + # labels have to be right before the block, otherwise exiting sub errors + DMI: + foreach my $value (@$item[3 .. $#$item]){ + next if $value =~ /^~/; + # variants: L3 - Cache; L3 Cache; L3-cache; L2 CACHE; CPU Internal L1 + if ($value =~ /^Socket Designation:.*? (L[1-3])\b/){ + $id = lc($1); + } + # some cpus only show Socket Designation: Internal cache + elsif (!$id && $value =~ /^Configuration:.* Level.*?([1-3])\b/){ + if ($value !~ /Disabled/i){ + $id = "l$1"; + } + } + # NOTE: cache is in KiB or MiB but they call it kB or MB + # so we send translate_size k or M which trips KiB/MiB mode + # if disabled can be 0. + elsif ($id && $value =~ /^Installed Size:\s+(.*?[kKM])i?B$/){ + # Config..Disabled test should have gotten this, but just in case 0 size + next DMI if !$1; + $amount = main::translate_size($1); + } + if ($id && $amount){ + $dmi_data->{$id} = $amount; + last; + } + } + } + # note: for multi cpu systems, we're hoping that these values are + # the same for each cpu, which in most pc situations they will be, + # and most ARM etc won't be using dmi data here anyway. + # Older dmidecode appear to have unreliable Upgrade outputs + elsif ($item->[0] == 4){ + # skip first three row,s we don't need that data + ($socket,$upgrade) = (); + $dmi_data->{'phys-cnt'}++; # try to catch bsds without physical cpu count + foreach my $value (@$item[3 .. $#$item]){ + next if $value =~ /^~/; + # note: on single cpu systems, Socket Designation shows socket type, + # but on multi, shows like, CPU1; CPU Socket #2; Socket 0; so check values a bit. + # Socket Designation: Intel(R) Core(TM) i5-3470 CPU @ 3.20GHz + # Sometimes shows as CPU Socket... + if ($value =~ /^Socket Designation:\s*(CPU\s*Socket|Socket)?[\s-]*(.*)$/i){ + $upgrade = main::clean_dmi($2) if $2 !~ /(cpu|[mg]hz|onboard|socket|@|^#?[0-9]$)/i; + # print "$socket_temp\n"; + } + # normally we prefer this value, but sometimes it's garbage + # older systems often show: Upgrade: ZIF Socket which is a generic term, legacy + elsif ($value =~ /^Upgrade:\s*(CPU\s*Socket|Socket)?[\s-]*(.*)$/i){ + # print "$2\n"; + $socket = main::clean_dmi($2) if $2 !~ /(ZIF|\bslot\b)/i; + } + # seen: Voltage: 5.0 V 2.9 V + elsif ($value =~ /^Voltage:\s*([0-9\.]+)\s*(V|Volts)?\b/i){ + $dmi_data->{'volts'} = main::clean_dmi($1); + } + elsif ($value =~ /^Current Speed:\s*([0-9\.]+)\s*([MGK]Hz)?\b/i){ + $dmi_data->{'speed'} = main::clean_dmi($1); + } + elsif ($value =~ /^Max Speed:\s*([0-9\.]+)\s*([MGK]Hz)?\b/i){ + $dmi_data->{'max-speed'} = main::clean_dmi($1); + } + elsif ($value =~ /^External Clock:\s*([0-9\.]+\s*[MGK]Hz)\b/){ + $dmi_data->{'ext-clock'} = main::clean_dmi($1); + } + } + } + } + # Seen older cases where Upgrade: Other value exists + if ($socket || $upgrade){ + if ($socket && $upgrade){ + undef $upgrade if $socket eq $upgrade; + } + elsif ($upgrade){ + $socket = $upgrade; + undef $upgrade; + } + $dmi_data->{'socket'} = $socket; + $dmi_data->{'upgrade'} = $upgrade; + } + main::log_data('dump','%$dmi_data',$dmi_data) if $b_log; + print 'dmidecode $dmi_data: ', Data::Dumper::Dumper $dmi_data if $dbg[27]; + eval $end if $b_log; + return $dmi_data; +} + +# everything is passed by reference so no need to return anything +sub cp_data_dmi { + eval $start if $b_log; + my ($cpu,$dmi_data,$caches,$counts,$cache_check) = @_; + my $cpu_dmi = cpu_dmidecode_data(); + # fix for bsds that do not show physical cpus, like openbsd + if ($cpu_dmi->{'phys-cnt'} && $counts->{'physical'} == 1 && + $cpu_dmi->{'phys-cnt'} > 1){ + $counts->{'physical'} = $cpu_dmi->{'phys-cnt'}; + } + # We have to undef all the sys stuff to get back to the true dmidecode results + # Too many variants to treat one by one, just clear it out if forced. + undef $caches if $force{'dmidecode'}; + # We don't want to use dmi L1/L2/L3 at all for non BSD systems unless forced + # because have seen totally gibberish dmidecode data for caches. /sys cache + # data preferred, more granular and basically consistently right. + # Only run for linux if no cache data found, but BSD use to fill in missing + # (we don't care about legacy errors for BSD since the data isn't adequate). + # legacy dmidecode cache data used the per cache value, NOT the per CPU total + # value like it does today. Which makes it impossible to know for sure if the + # given value is right (new, or if cache matched cpu total) or inadequate. + if ((!$bsd_type && !$caches->{'l1'} && !$caches->{'l2'} && !$caches->{'l3'}) || + ($bsd_type && (!$caches->{'l1'} || !$caches->{'l2'} || !$caches->{'l3'}))){ + # Newer dmi: cache type total per phys cpu; Legacy: raw cache size only + if ($cpu_dmi->{'l1'} && !$caches->{'l1'}){ + $caches->{'l1'} = $cpu_dmi->{'l1'}; + $$cache_check = main::message('note-check'); + } + # note: bsds often won't have L2 catch data found yet, but bsd sysctl can + # have these values so let's check just in case. OpenBSD does have it often. + if ($cpu_dmi->{'l2'} && !$caches->{'l2'}){ + $caches->{'l2'} = $cpu_dmi->{'l2'}; + $$cache_check = main::message('note-check'); + } + if ($cpu_dmi->{'l3'} && !$caches->{'l3'}){ + $caches->{'l3'} = $cpu_dmi->{'l3'}; + $$cache_check = main::message('note-check'); + } + } + $dmi_data->{'max-speed'} = $cpu_dmi->{'max-speed'}; + $dmi_data->{'socket'} = $cpu_dmi->{'socket'} if $cpu_dmi->{'socket'}; + $dmi_data->{'upgrade'} = $cpu_dmi->{'upgrade'} if $cpu_dmi->{'upgrade'}; + $dmi_data->{'speed'} = $cpu_dmi->{'speed'} if $cpu_dmi->{'speed'}; + $dmi_data->{'ext-clock'} = $cpu_dmi->{'ext-clock'} if $cpu_dmi->{'ext-clock'}; + $dmi_data->{'volts'} = $cpu_dmi->{'volts'} if $cpu_dmi->{'volts'}; + eval $end if $b_log; +} +## END DMIDECODE DATA ## + +## CPU PROPERTIES ## +sub cpu_properties { + my ($cpu) = @_; + my ($cpu_sys,$arch_level); + my $dmi_data = {}; + my $tests = {}; + my $caches = { + 'cache' => 0, # general, non id'ed from cpuinfo generic cache + 'l1' => 0, + 'l1d' => 0, + 'l1i' => 0, + 'l2' => 0, + 'l3' => 0, + }; + my $counts = { + 'dies' => 0, + 'cpu-cores' => 0, + 'cores' => 0, + 'cores-multiplier' => 0, + 'physical' => 0, + 'processors' => 0, + }; + my ($cache_check) = (''); + if (!$bsd_type && -d '/sys/devices' && !$force{'cpuinfo'}){ + $cpu_sys = cpu_sys_data($cpu->{'sys-freq'}); + } + cp_test_types($cpu,$tests) if $cpu->{'type'}; + undef $cpu_sys if $dbg[42]; + ## START CPU DATA HANDLERS ## + if (defined $cpu_sys->{'cpus'}){ + cp_data_sys( + $cpu, + $cpu_sys, + $caches, + $counts + ); + } + if (!defined $cpu_sys->{'cpus'} || !$counts->{'physical'} || + !$counts->{'cpu-cores'}){ + cp_data_fallback( + $cpu, + $caches, + \$cache_check, + $counts, + $tests, + ); + } + # some arm cpus report each core as its own die, but that's wrong + if (%risc && $counts->{'dies'} > 1 && + $counts->{'cpu-cores'} == $counts->{'dies'}){ + $counts->{'dies'} = 1; + $cpu->{'dies-count'} = 1; + } + if ($type eq 'full' && ($extra > 1 || ($bsd_type && !$cpu->{'l2-cache'}))){ + cp_data_dmi( + $cpu, + $dmi_data, + $caches, + $counts, # only to set BSD phys cpu counts if not found + \$cache_check, + ); + } + ## END CPU DATA HANDLERS ## + + # print "pc: $counts{'processors'} s: $cpu->{'siblings'} cpuc: $counts{'cpu-cores'} corec: $counts{'cores'}\n"; + + ## START CACHE PROCESSING ## + # Get BSD and legacy linux caches if not already from dmidecode or cpu_sys. + if ($type eq 'full' && + !$caches->{'l1'} && !$caches->{'l2'} && !$caches->{'l2'}){ + cp_caches_fallback( + $counts, + $cpu, + $caches, + \$cache_check, + ); + } + # nothing to check! + if ($type eq 'full'){ + if (!$caches->{'l1'} && !$caches->{'l2'} && !$caches->{'l3'} && + !$caches->{'cache'}){ + $cache_check = ''; + } + if ($caches->{'cache'}){ + # we don't want any math done on this one, who knows what it is + $caches->{'cache'} = cp_cache_processor($caches->{'cache'},1); + } + if ($caches->{'l1'}){ + $caches->{'l1'} = cp_cache_processor($caches->{'l1'},$counts->{'physical'}); + } + if ($caches->{'l2'}){ + $caches->{'l2'} = cp_cache_processor($caches->{'l2'},$counts->{'physical'}); + } + if ($caches->{'l3'}){ + $caches->{'l3'} = cp_cache_processor($caches->{'l3'},$counts->{'physical'}); + } + } + ## END CACHE PROCESSING ## + + ## START TYPE/LAYOUT/ARCH/BUGS ## + my ($cpu_type) = (''); + $cpu_type = cp_cpu_type( + $counts, + $cpu, + $tests + ); + my $topology = {}; + cp_topology($counts,$topology); + # print "$cpu->{'type'}\n"; + # print Data::Dumper::Dumper $cpu; + my $arch = cp_cpu_arch( + $cpu->{'type'}, + $cpu->{'family'}, + $cpu->{'model-id'}, + $cpu->{'stepping'}, + $cpu->{'model_name'}, + ); + # print Data::Dumper::Dumper $arch; + # arm cpuinfo case only; confirm on bsds, not sure all get family/ids + if ($arch->[0] && !$cpu->{'arch'}){ + ($cpu->{'arch'},$cpu->{'arch-note'},$cpu->{'process'},$cpu->{'gen'}, + $cpu->{'year'}) = @$arch; + } + # cpu_arch comes from set_os() + if (!$cpu->{'arch'} && $cpu_arch && %risc){ + $cpu->{'arch'} = $cpu_arch; + } + if ($b_admin && defined $cpu_sys->{'data'}{'vulnerabilities'}){ + $cpu->{'bugs-hash'} = $cpu_sys->{'data'}{'vulnerabilities'}; + } + ## END TYPE/LAYOUT/ARCH/BUGS ## + + ## START SPEED/BITS ## + my $speed_info = cp_speed_data($cpu,$cpu_sys); + # seen case where 64 bit cpu with lm flag shows as i686 (tinycore) + if (!%risc && $cpu->{'flags'} && (!$bits_sys || $bits_sys == 32)){ + $bits_sys = ($cpu->{'flags'} =~ /\blm\b/) ? 64 : 32; + } + # must run after to make sure we have cpu bits + if ($b_admin && !%risc && $bits_sys && $bits_sys == 64 && $cpu->{'flags'}){ + $arch_level = cp_cpu_level( + $cpu->{'flags'} + ); + } + ## END SPEED/BITS ## + + ## LOAD %cpu_properties + my $cpu_properties = { + 'arch-level' => $arch_level, + 'avg-speed-key' => $speed_info->{'avg-speed-key'}, + 'bits-sys' => $bits_sys, + 'cache' => $caches->{'cache'}, + 'cache-check' => $cache_check, + 'cpu-type' => $cpu_type, + 'dmi-max-speed' => $dmi_data->{'max-speed'}, + 'dmi-speed' => $dmi_data->{'speed'}, + 'ext-clock' => $dmi_data->{'ext-clock'}, + 'high-speed-key' => $speed_info->{'high-speed-key'}, + 'l1-cache' => $caches->{'l1'}, + 'l1d-desc' => $caches->{'l1d-desc'}, + 'l1i-desc' => $caches->{'l1i-desc'}, + 'l2-cache' => $caches->{'l2'}, + 'l2-desc' => $caches->{'l2-desc'}, + 'l3-cache' => $caches->{'l3'}, + 'l3-desc' => $caches->{'l3-desc'}, + 'min-max-key' => $speed_info->{'min-max-key'}, + 'min-max' => $speed_info->{'min-max'}, + 'socket' => $dmi_data->{'socket'}, + 'scaling-min-max-key' => $speed_info->{'scaling-min-max-key'}, + 'scaling-min-max' => $speed_info->{'scaling-min-max'}, + 'speed-key' => $speed_info->{'speed-key'}, + 'speed' => $speed_info->{'speed'}, + 'topology-full' => $topology->{'full'}, + 'topology-string' => $topology->{'string'}, + 'upgrade' => $dmi_data->{'upgrade'}, + 'volts' => $dmi_data->{'volts'}, + }; + if ($b_log){ + main::log_data('dump','%$cpu_properties',$cpu_properties); + main::log_data('dump','%$topology',$topology); + } + # print Data::Dumper::Dumper $cpu; + if ($dbg[38]){ + print Data::Dumper::Dumper $cpu_properties; + print Data::Dumper::Dumper $topology; + } + # my $dc = scalar @dies; + # print 'phys: ' . $pc . ' dies: ' . $dc, "\n"; + eval $end if $b_log; + return $cpu_properties; +} + +## CP TOOLS +sub cp_cache_desc { + my ($cache_desc) = @_; + my ($desc,$sep) = ('',''); + foreach (sort keys %{$cache_desc}){ + $desc .= $sep . $cache_desc->{$_} . 'x' . main::get_size($_,'string'); + $sep = ', '; + } + undef $cache_desc; + return $desc; +} + +# args: 0: $caches passed by reference +sub cp_cache_processor { + my ($cache,$count) = @_; + my $output; + if ($count > 1){ + $output = $count . 'x ' . main::get_size($cache,'string'); + $output .= ' (' . main::get_size($cache * $count,'string') . ')'; + } + else { + $output = main::get_size($cache,'string'); + } + # print "$cache :: $count :: $output\n"; + return $output; +} + +sub cp_caches_fallback { + eval $start if $b_log; + my ($counts,$cpu,$caches,$cache_check) = @_; + # L1 Cache + if ($cpu->{'l1-cache'}){ + $caches->{'l1'} = $cpu->{'l1-cache'} * $counts->{'cores-multiplier'}; + } + else { + if ($cpu->{'l1d-cache'}){ + $caches->{'l1d-desc'} = $counts->{'cores-multiplier'} . 'x'; + $caches->{'l1d-desc'} .= main::get_size($cpu->{'l1d-cache'},'string'); + $caches->{'l1'} += $cpu->{'l1d-cache'} * $counts->{'cores-multiplier'}; + } + if ($cpu->{'l1i-cache'}){ + $caches->{'l1i-desc'} = $counts->{'cores-multiplier'} . 'x'; + $caches->{'l1i-desc'} .= main::get_size($cpu->{'l1i-cache'},'string'); + $caches->{'l1'} += $cpu->{'l1i-cache'} * $counts->{'cores-multiplier'}; + } + } + # L2 Cache + # If summed by dmidecode or from cpu_sys don't use this + if ($cpu->{'l2-cache'}){ + # the only possible change for bsds is if dmidecode method gives phy counts + # Looks like Intel on bsd shows L2 per core, not total. Note: Pentium N3540 + # uses 2(not 4)xL2 cache size for 4 cores, sigh... you just can't win... + if ($bsd_type){ + $caches->{'l2'} = $cpu->{'l2-cache'} * $counts->{'cores-multiplier'}; + } + # AMD SOS chips appear to report full L2 cache per cpu + elsif ($cpu->{'type'} eq 'amd' && ($cpu->{'family'} eq '14' || + $cpu->{'family'} eq '15' || $cpu->{'family'} eq '16')){ + $caches->{'l2'} = $cpu->{'l2-cache'}; + } + elsif ($cpu->{'type'} ne 'intel'){ + $caches->{'l2'} = $cpu->{'l2-cache'} * $counts->{'cpu-cores'}; + } + # note: this handles how intel reports L2, total instead of per core like + # AMD does when cpuinfo sourced, when caches sourced, is per core as expected + else { + $caches->{'l2'} = $cpu->{'l2-cache'}; + } + } + # l3 Cache - usually per physical cpu, but some rzyen will have per ccx. + if ($cpu->{'l3-cache'}){ + $caches->{'l3'} = $cpu->{'l3-cache'}; + } + # don't do anything with it, we have no ideaw if it's L1, L2, or L3, generic + # cpuinfo fallback, it's junk data essentially, and will show as cache: + # only use this fallback if no cache data was found + if ($cpu->{'cache'} && !$caches->{'l1'} && !$caches->{'l2'} && + !$caches->{'l3'}){ + $caches->{'cache'} = $cpu->{'cache'}; + $$cache_check = main::message('note-check'); + } + eval $end if $b_log; +} + +sub cp_cores_alpha { + my $cores = $_[0]; + my $string = ''; + if ($cores > 4){ + $string = $cores . '-core'; + } + elsif ($cores == 0){ + $string = main::message('unknown-cpu-topology'); + } + else { + my @alpha = qw(single dual triple quad); + $string = $alpha[$cores-1] . ' core'; + } + return $string; +} + +# Only AMD/Intel 64 bit cpus +sub cp_cpu_level { + eval $start if $b_log; + my %flags = map {$_ =>1} split(/\s+/,$_[0]); + my ($level,$note,@found); + # note, each later cpu level must contain all subsequent cpu flags + # baseline: all x86_64 cpus lm cmov cx8 fpu fxsr mmx syscall sse2 + my @l1 = qw(cmov cx8 fpu fxsr lm mmx syscall sse2); + my @l2 = qw(cx16 lahf_lm popcnt sse4_1 sse4_2 ssse3); + my @l3 = qw(abm avx avx2 bmi1 bmi2 f16c fma movbe xsave); + my @l4 = qw(avx512f avx512bw avx512cd avx512dq avx512vl); + if ((@found = grep {$flags{$_}} @l1) && scalar(@found) == scalar(@l1)){ + $level = 'v1'; + # print 'v1: ', Data::Dumper::Dumper \@found; + if ((@found = grep {$flags{$_}} @l2) && scalar(@found) == scalar(@l2)){ + $level = 'v2'; + # print 'v2: ', Data::Dumper::Dumper \@found; + # It's not 100% certain that if flags exist v3/v4 supported. flags don't + # give full possible outcomes in these cases. See: docs/inxi-cpu.txt + if ((@found = grep {$flags{$_}} @l3) && scalar(@found) == scalar(@l3)){ + $level = 'v3'; + # print 'v3: ', Data::Dumper::Dumper \@found; + $note = main::message('note-check'); + if ((@found = grep {$flags{$_}} @l4) && scalar(@found) == scalar(@l4)){ + $level = 'v4'; + # print 'v4: ', Data::Dumper::Dumper \@found; + } + } + } + } + $level = [$level,$note] if $level; + eval $end if $b_log; + return $level; +} + +# Logic: +# if > 1 processor && processor id (physical id) == core id then Multi threaded (MT) +# if siblings > 1 && siblings == 2 * num_of_cores ($cpu->{'cores'}) then Multi threaded (MT) +# if > 1 processor && processor id (physical id) != core id then Multi-Core Processors (MCP) +# if > 1 processor && processor ids (physical id) > 1 then Symmetric Multi Processing (SMP) +# if = 1 processor then single core/processor Uni-Processor (UP) +sub cp_cpu_type { + eval $start if $b_log; + my ($counts,$cpu,$tests) = @_; + my $cpu_type = ''; + if ($counts->{'processors'} > 1 || + (defined $tests->{'intel'} && $tests->{'intel'} && $cpu->{'siblings'} > 0)){ + # cpu_sys detected MT + if ($counts->{'struct-mt'}){ + if ($counts->{'struct-mt'} && $counts->{'struct-st'}){ + $cpu_type .= 'MST'; + } + else { + $cpu_type .= 'MT'; + } + } + # handle case of OpenBSD that has hw.smt but no other meaningful topology + elsif ($cpu->{'smt'}){ + $cpu_type .= 'MT' if $cpu->{'smt'} eq 'enabled'; + } + # non-multicore MT, with 2 or more threads per core + elsif ($counts->{'processors'} && $counts->{'physical'} && + $counts->{'cpu-cores'} && + $counts->{'processors'}/($counts->{'physical'} * $counts->{'cpu-cores'}) >= 2){ + # print "mt:1\n"; + $cpu_type .= 'MT'; + } + # 2 or more siblings per cpu real core + elsif ($cpu->{'siblings'} > 1 && $cpu->{'siblings'}/$counts->{'cpu-cores'} >= 2){ + # print "mt:3\n"; + $cpu_type .= 'MT'; + } + # non-MT multi-core or MT multi-core + if ($counts->{'cpu-cores'} > 1){ + if ($counts->{'struct-mt'} && $counts->{'struct-st'}){ + $cpu_type .= ' AMCP'; + } + else { + $cpu_type .= ' MCP'; + } + } + # only solidly known > 1 die cpus will use this + if (defined $cpu->{'dies'} && $cpu->{'dies'} > 1){ + $cpu_type .= ' MCM'; + } + # >1 cpu sockets active: Symetric Multi Processing + if ($counts->{'physical'} > 1){ + if ($counts->{'struct-cores'} || $counts->{'struct-max'} || + $counts->{'struct-min'}){ + $cpu_type .= ' AMP'; + } + else { + $cpu_type .= ' SMP'; + } + } + $cpu_type =~ s/^\s+//; + } + else { + $cpu_type = 'UP'; + } + eval $end if $b_log; + return $cpu_type; +} + +sub cp_speed_data { + eval $start if $b_log; + my ($cpu,$cpu_sys) = @_; + my $info = {}; + if (defined $cpu_sys->{'data'}){ + if (defined $cpu_sys->{'data'}{'speeds'}{'min-freq'}){ + $cpu->{'min-freq'} = $cpu_sys->{'data'}{'speeds'}{'min-freq'}; + } + if (defined $cpu_sys->{'data'}{'speeds'}{'max-freq'}){ + $cpu->{'max-freq'} = $cpu_sys->{'data'}{'speeds'}{'max-freq'}; + } + if (defined $cpu_sys->{'data'}{'speeds'}{'scaling-min-freq'}){ + $cpu->{'scaling-min-freq'} = $cpu_sys->{'data'}{'speeds'}{'scaling-min-freq'}; + } + if (defined $cpu_sys->{'data'}{'speeds'}{'scaling-max-freq'}){ + $cpu->{'scaling-max-freq'} = $cpu_sys->{'data'}{'speeds'}{'scaling-max-freq'}; + } + # we don't need to see these if they are the same + if ($cpu->{'min-freq'} && $cpu->{'max-freq'} && + $cpu->{'scaling-min-freq'} && $cpu->{'scaling-max-freq'} && + $cpu->{'min-freq'} eq $cpu->{'scaling-min-freq'} && + $cpu->{'max-freq'} eq $cpu->{'scaling-max-freq'}){ + undef $cpu->{'scaling-min-freq'}; + undef $cpu->{'scaling-max-freq'}; + } + if (defined $cpu_sys->{'data'}{'speeds'}{'all'}){ + # only replace if we got actual speed values from cpufreq, or if no legacy + # sourced processors data. Handles fake syz core speeds for counts. + if ((grep {$_} @{$cpu_sys->{'data'}{'speeds'}{'all'}}) || + !@{$cpu->{'processors'}}){ + $cpu->{'processors'} = $cpu_sys->{'data'}{'speeds'}{'all'}; + } + } + if (defined $cpu_sys->{'data'}{'cpufreq-boost'}){ + $cpu->{'boost'} = $cpu_sys->{'data'}{'cpufreq-boost'}; + } + } + if (defined $cpu->{'processors'}){ + if (scalar @{$cpu->{'processors'}} > 1){ + my ($agg,$high) = (0,0); + for (@{$cpu->{'processors'}}){ + next if !$_; # bsds might have 0 or undef value, that's junk + $agg += $_; + $high = $_ if $_ > $high; + } + if ($agg){ + $cpu->{'avg-freq'} = int($agg/scalar @{$cpu->{'processors'}}); + $cpu->{'cur-freq'} = $high; + $info->{'avg-speed-key'} = 'avg'; + $info->{'speed'} = $cpu->{'avg-freq'}; + if ($high > $cpu->{'avg-freq'}){ + $cpu->{'high-freq'} = $high; + $info->{'high-speed-key'} = 'high'; + } + } + } + elsif ($cpu->{'processors'}[0]) { + $cpu->{'cur-freq'} = $cpu->{'processors'}[0]; + $info->{'speed'} = $cpu->{'cur-freq'}; + } + } + # BSDs generally will have processors count, but not per core speeds + if ($cpu->{'cur-freq'} && !$info->{'speed'}){ + $info->{'speed'} = $cpu->{'cur-freq'}; + } + if ($cpu->{'min-freq'} || $cpu->{'max-freq'}){ + ($info->{'min-max'},$info->{'min-max-key'}) = cp_speed_min_max( + $cpu->{'min-freq'}, + $cpu->{'max-freq'}); + } + if ($cpu->{'scaling-min-freq'} || $cpu->{'scaling-max-freq'}){ + ($info->{'scaling-min-max'},$info->{'scaling-min-max-key'}) = cp_speed_min_max( + $cpu->{'scaling-min-freq'}, + $cpu->{'scaling-max-freq'}, + 'sc'); + } + if ($cpu->{'cur-freq'}){ + if ($show{'short'}){ + $info->{'speed-key'} = 'speed'; + } + elsif ($show{'cpu-basic'}){ + $info->{'speed-key'} = 'speed (MHz)'; + } + else { + $info->{'speed-key'} = 'Speed (MHz)'; + } + } + eval $end if $b_log; + return $info; +} + +sub cp_speed_min_max { + my ($min,$max,$type) = @_; + my ($min_max,$key); + if ($min && $max){ + $min_max = "$min/$max"; + $key = "min/max"; + } + elsif ($max){ + $min_max = $max; + $key = "max"; + } + elsif ($min){ + $min_max = $min; + $key = "min"; + } + $key = $type . '-' . $key if $type && $key; + return ($min_max,$key); +} + +# args: 0: cpu, by ref; 1: update $tests by reference +sub cp_test_types { + my ($cpu,$tests) = @_; + if ($cpu->{'type'} eq 'intel'){ + $$tests{'intel'} = 1; + $$tests{'xeon'} = 1 if $cpu->{'model_name'} =~ /Xeon/i; + } + elsif ($cpu->{'type'} eq 'amd'){ + if ($cpu->{'family'} && $cpu->{'family'} eq '17'){ + $$tests{'amd-zen'} = 1; + if ($cpu->{'model_name'}){ + if ($cpu->{'model_name'} =~ /Ryzen/i){ + $$tests{'ryzen'} = 1; + } + elsif ($cpu->{'model_name'} =~ /EPYC/i){ + $$tests{'epyc'} = 1; + } + } + } + } + elsif ($cpu->{'type'} eq 'elbrus'){ + $$tests{'elbrus'} = 1; + } +} + +sub cp_topology { + my ($counts,$topology) = @_; + my @alpha = qw(Single Dual Triple Quad); + my ($sep) = (''); + my (%keys,%done); + my @tests = ('x'); # prefill [0] because iterator runs before 'next' test. + if ($counts->{'cpu-topo'}){ + # first we want to find out how many of each physical variant there are + foreach my $topo (@{$counts->{'cpu-topo'}}){ + # turn sorted hash into string + my $test = join('::', map{$_ . ':' . $topo->{$_}} sort keys %$topo); + if ($keys{$test}){ + $keys{$test}++; + } + else { + $keys{$test} = 1; + } + push(@tests,$test); + } + my ($i,$j) = (0,0); + # then we build up the topology data per variant + foreach my $topo (@{$counts->{'cpu-topo'}}){ + my $key = ''; + $i++; + next if $done{$tests[$i]}; + $done{$tests[$i]} = 1; + if ($b_admin && $type eq 'full'){ + $topology->{'full'}[$j]{'cpus'} = $keys{$tests[$i]}; + $topology->{'full'}[$j]{'cores'} = $topo->{'cores'}; + if ($topo->{'threads'} && $topo->{'cores'} != $topo->{'threads'}){ + $topology->{'full'}[$j]{'threads'} = $topo->{'threads'}; + } + if ($topo->{'dies'}){ + $topology->{'full'}[$j]{'dies-count'} = $topo->{'dies'}; + } + if ($topo->{'clusters'}){ + # clusters _should_ be per die, but it's not a guarantee + if ($topo->{'dies'} && $topo->{'dies'} > 1){ + $topo->{'clusters'} = $topo->{'dies'} . 'x' . $topo->{'clusters'}; + } + $topology->{'full'}[$j]{'clusters'} = $topo->{'clusters'}; + } + if ($counts->{'struct-mt'}){ + $topology->{'full'}[$j]{'cores-mt'} = $topo->{'cores-mt'}; + } + if ($counts->{'struct-st'}){ + $topology->{'full'}[$j]{'cores-st'} = $topo->{'cores-st'}; + } + if ($counts->{'struct-max'} || $counts->{'struct-min'}){ + $topology->{'full'}[$j]{'max'} = $topo->{'max'}; + $topology->{'full'}[$j]{'min'} = $topo->{'min'}; + } + if ($topo->{'smt'}){ + $topology->{'full'}[$j]{'smt'} = $topo->{'smt'}; + } + if ($topo->{'tpc'}){ + $topology->{'full'}[$j]{'tpc'} = $topo->{'tpc'}; + } + $j++; + } + else { + # start building string + $topology->{'string'} .= $sep; + $sep = ','; + if ($counts->{'physical'} > 1) { + my $phys = ($topology->{'struct-cores'}) ? $keys{$tests[$i]} : $counts->{'physical'}; + $topology->{'string'} .= $phys . 'x '; + $topology->{'string'} .= $topo->{'cores'} . '-core'; + } + else { + $topology->{'string'} .= cp_cores_alpha($topo->{'cores'}); + } + # alder lake type cpu + if ($topo->{'cores-st'} && $topo->{'cores-mt'}){ + $topology->{'string'} .= ' (' . $topo->{'cores-mt'} . '-mt/'; + $topology->{'string'} .= $topo->{'cores-st'} . '-st)'; + } + # we only want to show > 1 phys short form basic if cpus have different + # core counts, not different min/max frequencies + last if !$topology->{'struct-cores'}; + } + } + } + else { + if ($counts->{'physical'} > 1) { + $topology->{'string'} = $counts->{'physical'} . 'x '; + $topology->{'string'} .= $counts->{'cpu-cores'} . '-core'; + } + else { + $topology->{'string'} = cp_cores_alpha($counts->{'cpu-cores'}); + } + } + $topology->{'string'} ||= ''; +} +## END CP TOOLS +## END CPU PROPERTIES ## + +## START CPU ARCH ## +sub cp_cpu_arch { + eval $start if $b_log; + my ($type,$family,$model,$stepping,$name) = @_; + # we can get various random strings for rev/stepping, particularly for arm,ppc + # but we want stepping to be integer for math comparisons, so convert, or set + # to 0 so it won't break anything. + if (defined $stepping && $stepping =~ /^(0x)?[A-F0-9]{1,3}$/i){ + $stepping = hex($stepping); + } + else { + $stepping = 0 + } + $family ||= ''; + $model = '' if !defined $model; # model can be 0 + $name = '' if !defined $name; + my ($arch,$gen,$note,$process,$year); + my $check = main::message('note-check'); + # See: docs/inxi-cpu.txt + # print "type:$type fam:$family model:$model step:$stepping\n"; + # Note: AMD family is not Ext fam . fam but rather Ext-fam + fam. + # But model is Ext model . model... + if ($type eq 'amd'){ + if ($family eq '3'){ + $arch = 'Am386'; + $process = 'AMD 900-1500nm'; + $year = '1991-92'; + } + elsif ($family eq '4'){ + if ($model =~ /^(3|7|8|9|A)$/){ + $arch = 'Am486'; + $process = 'AMD 350-700nm'; + $year = '1993-95';} + elsif ($model =~ /^(E|F)$/){ + $arch = 'Am5x86'; + $process = 'AMD 350nm'; + $year = '1995-99';} + } + elsif ($family eq '5'){ + ## verified + if ($model =~ /^(0|1|2|3)$/){ + $arch = 'K5'; + $process = 'AMD 350nm'; + $year = '1996-97';} + elsif ($model =~ /^(6)$/){ + $arch = 'K6'; + $process = 'AMD 350nm'; + $year = '1997-98';} + elsif ($model =~ /^(7)$/){ + $arch = 'K6'; + $process = 'AMD 250nm'; + $year = '1997-98';} + elsif ($model =~ /^(8)$/){ + $arch = 'K6-2'; + $process = 'AMD 250nm'; + $year = '1998-2003';} + elsif ($model =~ /^(9)$/){ + $arch = 'K6-3'; + $process = 'AMD 250nm'; + $year = '1999-2003';} + elsif ($model =~ /^(D)$/){ + $arch = 'K6-3'; + $process = 'AMD 180nm'; + $year = '1999-2003';} + ## unverified + elsif ($model =~ /^(A)$/){ + $arch = 'K6 Geode'; + $process = 'AMD 150-350nm'; + $year = '1999';} # dates uncertain, 1999 start + ## fallback + else { + $arch = 'K6'; + $process = 'AMD 250-350nm'; + $year = '1999-2003';} + } + elsif ($family eq '6'){ + ## verified + if ($model =~ /^(1)$/){ + $arch = 'K7'; # 1:2:argon + $process = 'AMD 250nm'; + $year = '1999-2001';} + elsif ($model =~ /^(2|3|4|6)$/){ + # 3:0:duron;3:1:spitfire;4:2,4:thunderbird; 6:2:Palomino, duron; 2:1:Pluto + $arch = 'K7'; + $process = 'AMD 180nm'; + $year = '2000-01';} + elsif ($model =~ /^(7|8|A)$/){ + $arch = 'K7'; # 7:0,1:Morgan;8:1:thoroughbred,duron-applebred; A:0:barton + $process = 'AMD 130nm'; + $year = '2002-04';} + ## fallback + else { + $arch = 'K7'; + $process = 'AMD 130-180nm'; + $year = '2003-14';} + } + # note: family F K8 needs granular breakdowns, was a long lived family + elsif ($family eq 'F'){ + ## verified + # check: B|E|F + if ($model =~ /^(4|5|7|8|B|C|E|F)$/){ + # 4:0:clawhammer;5:8:sledgehammer;8:2,4:8:dubin;7:A;C:0:NewCastle; + $arch = 'K8'; + $process = 'AMD 130nm'; + $year = '2004-05';} + # check: 14|17|18|1B|25|48|4B|5D + elsif ($model =~ /^(14|15|17|18|1B|1C|1F|21|23|24|25|27|28|2C|2F|37|3F|41|43|48|4B|4C|4F|5D|5F|C1)$/){ + # 1C:0,2C:2:Palermo;21:0,2,23:2:denmark;1F:0:winchester;2F:2:Venice; + # 27:1,37:2:san diego;28:1,3F:2:Manchester;23:2:Toledo;$F:2,5F:2,3:Orleans; + # 5F:2:Manila?;37:2;C1:3:windsor fx;43:2,3:santa ana;41:2:santa rosa; + # 4C:2:Keene;2C:2:roma;24:2:newark + $arch = 'K8'; + $process = 'AMD 90nm'; + $year = '2004-06';} + elsif ($model =~ /^(68|6B|6C|6F|7C|7F)$/){ + $arch = 'K8'; # 7F:1,2:Lima; 68:1,6B:1,2:Brisbane;6F:2:conesus;7C:2:sherman + $process = 'AMD 65nm'; + $year = '2005-08';} + ## fallback + else { + $arch = 'K8'; + $process = 'AMD 65-130nm'; + $year = '2004-2008';} + } + # K9 was planned but skipped + elsif ($family eq '10'){ # 1F + ## verified + if ($model =~ /^(2)$/){ + $arch = 'K10'; # 2:2:budapest;2:1,3:barcelona + $process = 'AMD 65nm'; + $year = '2007-08';} + elsif ($model =~ /^(4|5|6|8|9|A)$/){ + # 4:2:Suzuka;5:2,3:propus;6:2:Regor;8:0:Istanbul;9:1:maranello + $arch = 'K10'; + $process = 'AMD 45nm'; + $year = '2009-13';} + ## fallback + else { + $arch = 'K10'; + $process = 'AMD 45-65nm'; + $year = '2007-13';} + } + # very loose, all stepping 1: covers athlon x2, sempron, turion x2 + # years unclear, could be 2005 start, or 2008 + elsif ($family eq '11'){ # 2F + if ($model =~ /^(3)$/){ + $arch = 'K11 Turion X2'; # mix of K8/K10 + $note = $check; + $process = 'AMD 65-90nm'; + $year = ''; } + } + # might also need cache handling like 14/16 + elsif ($family eq '12'){ # 3F + if ($model =~ /^(1)$/){ + $arch = 'K12 Fusion'; # K10 based apu, llano + $process = 'GF 32nm'; + $year = '2011';} # check years + else { + $arch = 'K12 Fusion'; + $process = 'GF 32nm'; + $year = '2011';} # check years + } + # SOC, apu + elsif ($family eq '14'){ # 5F + if ($model =~ /^(1|2)$/){ + $arch = 'Bobcat'; + $process = 'GF 40nm'; + $year = '2011-13';} + else { + $arch = 'Bobcat'; + $process = 'GF 40nm'; + $year = '2011-13';} + } + elsif ($family eq '15'){ # 6F + # note: only model 1 confirmd + if ($model =~ /^(0|1|3|4|5|6|7|8|9|A|B|C|D|E|F)$/){ + $arch = 'Bulldozer'; + $process = 'GF 32nm'; + $year = '2011';} + # note: only 2,10,13 confirmed + elsif ($model =~ /^(2|10|11|12|13|14|15|16|17|18|19|1A|1B|1C|1D|1E|1F)$/){ + $arch = 'Piledriver'; + $process = 'GF 32nm'; + $year = '2012-13';} + # note: only 30,38 confirmed + elsif ($model =~ /^(30|31|32|33|34|35|36|37|38|39|3A|3B|3C|3D|3E|3F)$/){ + $arch = 'Steamroller'; + $process = 'GF 28nm'; + $year = '2014';} + # note; only 60,65,70 confirmed + elsif ($model =~ /^(60|61|62|63|64|65|66|67|68|69|6A|6B|6C|6D|6E|6F|70|71|72|73|74|75|76|77|78|79|7A|7B|7C|7D|7E|7F)$/){ + $arch = 'Excavator'; + $process = 'GF 28nm'; + $year = '2015';} + else { + $arch = 'Bulldozer'; + $process = 'GF 32nm'; + $year = '2011-12';} + } + # SOC, apu + elsif ($family eq '16'){ # 7F + if ($model =~ /^(0|1|2|3|4|5|6|7|8|9|A|B|C|D|E|F)$/){ + $arch = 'Jaguar'; + $process = 'GF 28nm'; + $year = '2013-14';} + elsif ($model =~ /^(30|31|32|33|34|35|36|37|38|39|3A|3B|3C|3D|3E|3F)$/){ + $arch = 'Puma'; + $process = 'GF 28nm'; + $year = '2014-15';} + else { + $arch = 'Jaguar'; + $process = 'GF 28nm'; + $year = '2013-14';} + } + elsif ($family eq '17'){ # 8F + # can't find stepping/model for no ht 2x2 core/die models, only first ones + if ($model =~ /^(1|11|20)$/){ + $arch = 'Zen'; + $process = 'GF 14nm'; + $year = '2017-19';} + # Seen: stepping 1 is Zen+ Ryzen 7 3750H. But stepping 1 Zen is: Ryzen 3 3200U + # AMD Ryzen 3 3200G is stepping 1, Zen+ + # Unknown if stepping 0 is Zen or either. + elsif ($model =~ /^(18)$/){ + $arch = 'Zen/Zen+'; + $gen = '1'; + $process = 'GF 12nm'; + $note = $check; + $year = '2019';} + # shares model 8 with zen, stepping unknown + elsif ($model =~ /^(8)$/){ + $arch = 'Zen+'; + $gen = '1+'; + $process = 'GF 12nm'; + $year = '2018-21';} + # used this but it didn't age well: ^(2[0123456789ABCDEF]| + elsif ($model =~ /^(3.|4.|5.|6.|7.|8.|9.|A.)$/){ + $arch = 'Zen 2'; + $gen = '2'; + $process = 'TSMC n7 (7nm)'; # some consumer maybe GF 14nm + $year = '2020-22';} + else { + $arch = 'Zen'; + $note = $check; + $process = '7-14nm'; + $year = '';} + } + # Joint venture between AMD and Chinese companies. Type amd? or hygon? + elsif ($family eq '18'){ # 9F + # model 0, zen 1 + $arch = 'Zen (Hygon Dhyana)'; + $gen = '1'; + $process = 'GF 14nm'; + $year = '';} + elsif ($family eq '19'){ # AF + # zen 4 raphael, phoenix 1 use n5 I believe + # Epyc Bergamo zen4c 4nm, only few full model IDs, update when appear + # zen4c is for cloud hyperscale + if ($model =~ /^(78)$/){ + $arch = 'Zen 4c'; + $gen = '4'; + $process = 'TSMC n5 (5nm)'; # roadmapped to n4 originally + $year = '2023+';} + # ext model 6,7, base models trickling in + # 10 engineering sample + elsif ($model =~ /^(1.|6.|7.|A.)$/){ + $arch = 'Zen 4'; + $gen = '4'; + $process = 'TSMC n5 (5nm)'; + $year = '2022+';} + # double check 40, 44; 21 confirmed + elsif ($model =~ /^(21|4.)$/){ + $arch = 'Zen 3+'; + $gen = '3'; + $process = 'TSMC n6 (7nm)'; + $year = '2022';} + # 21, 50: step 0; known: 21, 3x, 50 + elsif ($model =~ /^(0|1|8|2.|3.|5.)$/){ + $arch = 'Zen 3'; + $gen = '3'; + $process = 'TSMC n7 (7nm)'; + $year = '2021-22';} + else { + $arch = 'Zen 3/4'; + $note = $check; + $process = 'TSMC n5 (5nm)'; + $year = '2021-22';} + } + # Zen 5: TSMC n3/n4, epyc turin / granite ridge? / turin dense zen 5c 3nm + elsif ($family eq '20'){ # BF + if ($model =~ /^(0)$/){ + $arch = 'Zen 5'; + $gen = '5'; + $process = 'TSMC n4 (4nm)'; # turin could be 4nm, need more data + $year = '2023+';} + elsif ($model =~ /^(1.)$/){ + $arch = 'Zen 5c'; + $gen = '5'; + $process = 'TSMC n3 (3nm)'; # turin could be 4nm, need more data + $year = '2024+';} + # Strix Point; Granite Ridge; Krackan Point; Strix Halo + elsif ($model =~ /^(2.|4.|6.|7.)$/){ + $arch = 'Zen 5'; + $gen = '5'; + $process = 'TSMC n4 (4nm)'; # desktop, granite ridge, confirm 2024 + $year = '2024+';} + else { + $arch = 'Zen 5'; + $note = $check; + $process = 'TSMC n3/n4 (3,4nm)'; + $year = '2024+';} + } + # Roadmap: check to verify, AMD is usually closer to target than Intel + # Epyc 4 genoa: zen 4, nm, 2022+ (dec 2022), cxl-1.1,pcie-5, ddr-5 + } + # we have no advanced data for ARM cpus, this is an area that could be improved? + elsif ($type eq 'arm'){ + if ($family ne ''){ + $arch="ARMv$family";} + else { + $arch='ARM';} + } + # elsif ($type eq 'ppc'){ + # $arch='PPC'; + # } + # aka VIA + elsif ($type eq 'centaur'){ + if ($family eq '5'){ + if ($model =~ /^(4)$/){ + $arch = 'WinChip C6'; + $process = '250nm'; + $year = '';} + elsif ($model =~ /^(8)$/){ + $arch = 'WinChip 2'; + $process = '250nm'; + $year = '';} + elsif ($model =~ /^(9)$/){ + $arch = 'WinChip 3'; + $process = '250nm'; + $year = '';} + } + elsif ($family eq '6'){ + if ($model =~ /^(6)$/){ + $arch = 'Via Cyrix III (WinChip 5)'; + $process = '150nm'; # guess + $year = '';} + elsif ($model =~ /^(7|8)$/){ + $arch = 'Via C3'; + $process = '150nm'; + $year = '';} + elsif ($model =~ /^(9)$/){ + $arch = 'Via C3-2'; + $process = '130nm'; + $year = '';} + elsif ($model =~ /^(A|D)$/){ + $arch = 'Via C7'; + $process = '90nm'; + $year = '';} + elsif ($model =~ /^(F)$/){ + if ($stepping <= 1){ + $arch = 'Via CN Nano (Isaah)';} + elsif ($stepping <= 2){ + $arch = 'Via Nano (Isaah)';} + elsif ($stepping <= 10){ + $arch = 'Via Nano (Isaah)';} + elsif ($stepping <= 12){ + $arch = 'Via Isaah';} + elsif ($stepping <= 13){ + $arch = 'Via Eden';} + elsif ($stepping <= 14){ + $arch = 'Zhaoxin ZX';} + $process = '90nm'; # guess + $year = '';} + } + elsif ($family eq '7'){ + if ($model =~ /^(1.|3.)$/){ + $arch = 'Zhaoxin ZX'; + $process = '90nm'; # guess + $year = ''; + } + } + } + # note, to test uncoment $cpu{'type'} = Elbrus in proc/cpuinfo logic + # ExpLicit Basic Resources Utilization Scheduling + elsif ($type eq 'elbrus'){ + # E8CB + if ($family eq '4'){ + if ($model eq '1'){ + $arch = 'Elbrus 2000 (gen-1)'; + $process = 'Mikron 130nm'; + $year = '2005';} + elsif ($model eq '2'){ + $arch = 'Elbrus-S (gen-2)'; + $process = 'Mikron 90nm'; + $year = '2010';} + elsif ($model eq '3'){ + $arch = 'Elbrus-4C (gen-3)'; + $process = 'TSMC 65nm'; + $year = '2014';} + elsif ($model eq '4'){ + $arch = 'Elbrus-2C+ (gen-2)'; + $process = 'Mikron 90nm'; + $year = '2011';} + elsif ($model eq '6'){ + $arch = 'Elbrus-2CM (gen-2)'; + $note = $check; + $process = 'Mikron 90nm'; + $year = '2011 (?)';} + elsif ($model eq '7'){ + if ($stepping >= 2){ + $arch = 'Elbrus-8C1 (gen-4)'; + $process = 'TSMC 28nm'; + $year = '2016';} + else { + $arch = 'Elbrus-8C (gen-4)'; + $process = 'TSMC 28nm'; + $year = '2016';} + } # note: stepping > 1 may be 8C1 + elsif ($model eq '8'){ + $arch = 'Elbrus-1C+ (gen-4)'; + $process = 'TSMC 40nm'; + $year = '2016';} + # 8C2 morphed out of E8CV, but the two were the same die + elsif ($model eq '9'){ + $arch = 'Elbrus-8CV/8C2 (gen-4/5)'; + $process = 'TSMC 28nm'; + $note = $check; + $year = '2016/2020';} + elsif ($model eq 'A'){ + $arch = 'Elbrus-12C (gen-6)'; + $process = 'TSMC 16nm'; + $year = '2021+';} + elsif ($model eq 'B'){ + $arch = 'Elbrus-16C (gen-6)'; + $process = 'TSMC 16nm'; + $year = '2021+';} + elsif ($model eq 'C'){ + $arch = 'Elbrus-2C3 (gen-6)'; + $process = 'TSMC 16nm'; + $year = '2021+';} + else { + $arch = 'Elbrus-??';; + $note = $check; + $year = '';} + } + elsif ($family eq '5'){ + if ($model eq '9'){ + $arch = 'Elbrus-8C2 (gen-4)'; + $process = 'TSMC 28nm'; + $year = '2020';} + else { + $arch = 'Elbrus-??'; + $note = $check; + $process = ''; + $year = '';} + } + elsif ($family eq '6'){ + if ($model eq 'A'){ + $arch = 'Elbrus-12C (gen-6)'; + $process = 'TSMC 16nm'; + $year = '2021+';} + elsif ($model eq 'B'){ + $arch = 'Elbrus-16C (gen-6)'; + $process = 'TSMC 16nm'; + $year = '2021+';} + elsif ($model eq 'C'){ + $arch = 'Elbrus-2C3 (gen-6)'; + $process = 'TSMC 16nm'; + $year = '2021+';} + # elsif ($model eq '??'){ + # $arch = 'Elbrus-32C (gen-7)'; + # $process = '?? 7nm'; + # $year = '2025';} + else { + $arch = 'Elbrus-??'; + $note = $check; + $process = ''; + $year = '';} + } + else { + $arch = 'Elbrus-??'; + $note = $check; + } + } + elsif ($type eq 'intel'){ + if ($family eq '4'){ + if ($model =~ /^(0|1|2)$/){ + $arch = 'i486'; + $process = '1000nm'; # 33mhz + $year = '1989-98';} + elsif ($model =~ /^(3)$/){ + $arch = 'i486'; + $process = '800nm'; # 66mhz + $year = '1992-98';} + elsif ($model =~ /^(4|5|6|7|8|9)$/){ + $arch = 'i486'; + $process = '600nm'; # 100mhz + $year = '1993-98';} + else { + $arch = 'i486'; + $process = '600-1000nm'; + $year = '1989-98';} + } + # 1993-2000 + elsif ($family eq '5'){ + # verified + if ($model =~ /^(1)$/){ + $arch = 'P5'; + $process = 'Intel 800nm'; # 1:3,5,7:800 + $year = '1993-94';} + elsif ($model =~ /^(2)$/){ + $arch = 'P5'; # 2:5:MMX + # 2:C:350[or 600]; 2:1,4,5,6:600;but: + if ($stepping > 9){ + $process = 'Intel 350nm'; + $year = '1996-2000';} + else { + $process = 'Intel 600nm'; + $year = '1993-95';} + } + elsif ($model =~ /^(4)$/){ + $arch = 'P5'; + $process = 'Intel 350nm'; # MMX. 4:3:P55C + $year = '1997';} + # unverified + elsif ($model =~ /^(3|7)$/){ + $arch = 'P5'; # 7:0:MMX + $process = 'Intel 350-600nm'; + $year = '';} + elsif ($model =~ /^(8)$/){ + $arch = 'P5'; + $process = 'Intel 350-600nm'; # MMX + $year = '';} + elsif ($model =~ /^(9|A)$/){ + $arch = 'Lakemont'; + $process = 'Intel 350nm'; + $year = '';} + # fallback + else { + $arch = 'P5'; + $process = 'Intel 350-600nm'; # MMX + $year = '1994-2000';} + } + elsif ($family eq '6'){ + if ($model =~ /^(1)$/){ + $arch = 'P6 Pro'; + $process = 'Intel 350nm'; + $year = '';} + elsif ($model =~ /^(3)$/){ + $arch = 'P6 II Klamath'; + $process = 'Intel 350nm'; + $year = '';} + elsif ($model =~ /^(5)$/){ + $arch = 'P6 II Deschutes'; + $process = 'Intel 250nm'; + $year = '';} + elsif ($model =~ /^(6)$/){ + $arch = 'P6 II Mendocino'; + $process = 'Intel 250nm'; # 6:5:P6II-celeron-mendo + $year = '1999';} + elsif ($model =~ /^(7)$/){ + $arch = 'P6 III Katmai'; + $process = 'Intel 250nm'; + $year = '1999';} + elsif ($model =~ /^(8)$/){ + $arch = 'P6 III Coppermine'; + $process = 'Intel 180nm'; + $year = '1999';} + elsif ($model =~ /^(9)$/){ + $arch = 'M Banias'; # Pentium M + $process = 'Intel 130nm'; + $year = '2003';} + elsif ($model =~ /^(A)$/){ + $arch = 'P6 III Xeon'; + $process = 'Intel 180-250nm'; + $year = '1999';} + elsif ($model =~ /^(B)$/){ + $arch = 'P6 III Tualitin'; # 6:B:1,4 + $process = 'Intel 130nm'; + $year = '2001';} + elsif ($model =~ /^(D)$/){ + $arch = 'M Dothan'; # Pentium M + $process = 'Intel 90nm'; + $year = '2003-05';} + elsif ($model =~ /^(E)$/){ + $arch = 'M Yonah'; + $process = 'Intel 65nm'; + $year = '2006-08';} + elsif ($model =~ /^(F|16)$/){ + $arch = 'Core2 Merom'; # 16:1:conroe-l[65nm] + $process = 'Intel 65nm'; + $year = '2006-09';} + elsif ($model =~ /^(15)$/){ + $arch = 'M Tolapai'; # pentium M system on chip + $process = 'Intel 90nm'; + $year = '2008';} + elsif ($model =~ /^(17)$/){ + $arch = 'Penryn'; # 17:A:Core 2,Celeron-wolfdale,yorkfield + $process = 'Intel 45nm'; + $year = '2008';} + # had 25 also, but that's westmere, at least for stepping 2 + elsif ($model =~ /^(1A|1E|1F|2C|2E|2F)$/){ + $arch = 'Nehalem'; + $process = 'Intel 45nm'; + $year = '2008-10';} + elsif ($model =~ /^(1C|26)$/){ + $arch = 'Bonnell'; + $process = 'Intel 45nm'; + $year = '2008-13';} # atom Bonnell? 27? + elsif ($model =~ /^(1D)$/){ + $arch = 'Penryn'; + $process = 'Intel 45nm'; + $year = '2007-08';} + # 25 may be nahelem in a stepping, check. Stepping 2 is westmere + elsif ($model =~ /^(25|2C|2F)$/){ + $arch = 'Westmere'; # die shrink of nehalem + $process = 'Intel 32nm'; + $year = '2010-11';} + elsif ($model =~ /^(27|35|36)$/){ + $arch = 'Saltwell'; + $process = 'Intel 32nm'; + $year = '2011-13';} + elsif ($model =~ /^(2A|2D)$/){ + $arch = 'Sandy Bridge'; + $process = 'Intel 32nm'; + $year = '2010-12';} + elsif ($model =~ /^(37|4A|4D|5A|5D)$/){ + $arch = 'Silvermont'; + $process = 'Intel 22nm'; + $year = '2013-15';} + elsif ($model =~ /^(3A|3E)$/){ + $arch = 'Ivy Bridge'; + $process = 'Intel 22nm'; + $year = '2012-15';} + elsif ($model =~ /^(3C|3F|45|46)$/){ + $arch = 'Haswell'; + $process = 'Intel 22nm'; + $year = '2013-15';} + elsif ($model =~ /^(3D|47|4F|56)$/){ + $arch = 'Broadwell'; + $process = 'Intel 14nm'; + $year = '2015-18';} + elsif ($model =~ /^(4C)$/){ + $arch = 'Airmont'; + $process = 'Intel 14nm'; + $year = '2015-17';} + elsif ($model =~ /^(4E)$/){ + $arch = 'Skylake'; + $process = 'Intel 14nm'; + $year = '2015';} + # need to find stepping for these, guessing stepping 4 is last for SL + elsif ($model =~ /^(55)$/){ + if ($stepping >= 5 && $stepping <= 7){ + $arch = 'Cascade Lake'; + $process = 'Intel 14nm'; + $year = '2019';} + elsif ($stepping >= 8){ + $arch = 'Cooper Lake'; # 55:A:14nm + $process = 'Intel 14nm'; + $year = '2020';} + else { + $arch = 'Skylake'; + $process = 'Intel 14nm'; + $year = '';}} + elsif ($model =~ /^(57)$/){ + $arch = 'Knights Landing'; + $process = 'Intel 14nm'; + $year = '2016+';} + elsif ($model =~ /^(5C|5F)$/){ + $arch = 'Goldmont'; + $process = 'Intel 14nm'; + $year = '2016';} + elsif ($model =~ /^(5E)$/){ + $arch = 'Skylake-S'; + $process = 'Intel 14nm'; + $year = '2015';} + elsif ($model =~ /^(66|67)$/){ + $arch = 'Cannon Lake'; + $process = 'Intel 10nm'; + $year = '2018';} + # 6 are servers, 7 not + elsif ($model =~ /^(6A|6C|7D|7E|9F)$/){ + $arch = 'Ice Lake'; + $process = 'Intel 10nm'; + $year = '2019-21';} + elsif ($model =~ /^(7A)$/){ + $arch = 'Goldmont Plus'; + $process = 'Intel 14nm'; + $year = '2017';} + elsif ($model =~ /^(85)$/){ + $arch = 'Knights Mill'; + $process = 'Intel 14nm'; + $year = '2017-19';} + elsif ($model =~ /^(86)$/){ + $arch = 'Tremont Snow Ridge'; # embedded + $process = 'Intel 10nm'; + $year = '2020';} + elsif ($model =~ /^(87)$/){ + $arch = 'Tremont Parker Ridge'; # embedded + $process = 'Intel 10nm'; + $year = '2022';} + elsif ($model =~ /^(8A)$/){ + $arch = 'Tremont Lakefield'; + $process = 'Intel 10nm'; + $year = '2020';} # ? + elsif ($model =~ /^(96)$/){ + $arch = 'Tremont Elkhart Lake'; + $process = 'Intel 10nm'; + $year = '2020';} # ? + elsif ($model =~ /^(8C|8D)$/){ + $arch = 'Tiger Lake'; + $process = 'Intel 10nm'; + $year = '2020';} + elsif ($model =~ /^(8E)$/){ + # can be AmberL or KabyL + if ($stepping == 9){ + $arch = 'Amber/Kaby Lake'; + $note = $check; + $process = 'Intel 14nm'; + $year = '2017';} + elsif ($stepping == 10){ + $arch = 'Coffee Lake'; + $process = 'Intel 14nm'; + $year = '2017';} + elsif ($stepping == 11){ + $arch = 'Whiskey Lake'; + $process = 'Intel 14nm'; + $year = '2018';} + # can be WhiskeyL or CometL + elsif ($stepping == 12){ + $arch = 'Comet/Whiskey Lake'; + $note = $check; + $process = 'Intel 14nm'; + $year = '2018';} + # note: had it as > 13, but 0xC seems to be CL + elsif ($stepping >= 13){ + $arch = 'Comet Lake'; # 10 gen + $process = 'Intel 14nm'; + $year = '2019-20';} + # NOTE: not enough info to lock this down + else { + $arch = 'Kaby Lake'; + $note = $check; + $process = 'Intel 14nm'; + $year = '~2018-20';} + } + elsif ($model =~ /^(8F|95)$/){ + $arch = 'Sapphire Rapids'; + $process = 'Intel 7 (10nm ESF)'; + $year = '2023+';} # server + elsif ($model =~ /^(97|9A|9C|BE)$/){ + $arch = 'Alder Lake'; # socket LG 1700 + $process = 'Intel 7 (10nm ESF)'; + $year = '2021+';} + elsif ($model =~ /^(9E)$/){ + if ($stepping == 9){ + $arch = 'Kaby Lake'; + $process = 'Intel 14nm'; + $year = '2018';} + elsif ($stepping >= 10 && $stepping <= 13){ + $arch = 'Coffee Lake'; # 9E:A,B,C,D + $process = 'Intel 14nm'; + $year = '2018';} + else { + $arch = 'Kaby Lake'; + $note = $check; + $process = 'Intel 14nm'; + $year = '2018';} + } + elsif ($model =~ /^(A5|A6)$/){ + $arch = 'Comet Lake'; # 10 gen; stepping 0-5 + $process = 'Intel 14nm'; + $year = '2020';} + elsif ($model =~ /^(A7|A8)$/){ + $arch = 'Rocket Lake'; # 11 gen; stepping 1 + $process = 'Intel 14nm'; + $year = '2021+';} + # More info: comet: shares family/model, need to find stepping numbers + # Coming: meteor lake; granite rapids; emerald rapids, diamond rapids + ## IDS UNKNOWN, release late 2022 + elsif ($model =~ /^(AA|AB|AC|B5)$/){ + $arch = 'Meteor Lake'; # 14 gen + $process = 'Intel 4 (7nm)'; + $year = '2023+';} + elsif ($model =~ /^(AD|AE)$/){ + $arch = 'Granite Rapids'; # ? + $process = 'Intel 3 (7nm+)'; # listed with intel 3 and 7 + $year = '2024+';} + elsif ($model =~ /^(AF)$/){ + $arch = 'Sierra Forest'; # ? + $process = 'Intel 3 (5nm)'; + $year = '2024+';} + elsif ($model =~ /^(B6)$/){ + $arch = 'Grand Ridge'; # 14 gen + $process = 'Intel 4 (7nm)'; # confirm + $year = '2023+';} + elsif ($model =~ /^(B7|BA|BF)$/){ + $arch = 'Raptor Lake'; # 13 gen, socket LG 1700,1800 + $process = 'Intel 7 (10nm)'; + $year = '2022+';} + elsif ($model =~ /^(BC|BD)$/){ + $arch = 'Lunar Lake'; # 15 gn + $process = 'TSMC n3b (3nm)'; # n6 controller tile. Announced w/intel 18a + $year = '2024+';} # seen APU IDs, so out there + # Meteor Lake-S maybe cancelled, replaced by arrow + elsif ($model =~ /^(C5|C6|CA)$/){ + $arch = 'Arrow Lake'; # 15 gen; igpu battleimage 3/4nm + # gfx tile is TSMC 3nm + $process = 'Intel 20a (2nm)';# TSMC 3nm (corei3-5)/Intel 20A 2nm (core i5-9) + $year = '2024+';} # check when actually in production + elsif ($model =~ /^(CC)$/){ + $arch = 'Panther Lake'; # 17 gen + $process = 'Intel 18a (1.8nm)'; + $year = '2025+';} + elsif ($model =~ /^(CF)$/){ + $arch = 'Emerald Rapids'; # 5th gen xeon + $process = 'Intel 7 (10nm)'; + $year = '2023+';} + elsif ($model =~ /^(DD)$/){ + $arch = 'Clearwater Forest'; + $process = 'Intel 18a (1.8nm)'; + $year = '2025+';} + ## roadmaps: check and update, since Intel misses their targets often + # Sapphire Rapids: 13 gen (?), Intel 7 (10nm), 2023 + # Emerald Rapids: Intel 7 (10nm), 2023 + # Granite Rapids: Intel 3 (7nm+), 2024 + # Diamond Rapids: Intel 3 (7nm+), 2025 + # Raptor Lake: 13 gen, Intel 7 (10nm), 2022 + # Meteor Lake: 14 gen, Intel 4 (7nm+) + # Arrow Lake: 15 gen, TSMC 3nm (corei3-5)/Intel 20A 2nm (core i5-9), 2024 + # Arrow Lake: 16 gen, TSMC 3nm (corei3-5)/Intel 20A 2nm (core i5-9), 2024, refresh + # Lunar Lake: 15 gen, TSMC’s 3nm (N3B), 2024-5 + # Panther Lake:17 gen, ?, late 2025, cougar cove Xe3 Celestial GPU architecture + # Beast Lake: 16 gen, ?, 2026? + # Nova Lake: 18 gen, Intel 14A (1.4nm), 2026 + } + # itanium 1 family 7 all recalled + elsif ($family eq 'B'){ + if ($model =~ /^(0)$/){ + $arch = 'Knights Ferry'; + $process = 'Intel 45nm'; + $year = '2010-11';} + if ($model =~ /^(1)$/){ + $arch = 'Knights Corner'; + $process = 'Intel 22nm'; + $year = '2012-13';} + } + # pentium 4 + elsif ($family eq 'F'){ + if ($model =~ /^(0|1)$/){ + $arch = 'Netburst Willamette'; + $process = 'Intel 180nm'; + $year = '2000-01';} + elsif ($model =~ /^(2)$/){ + if ($stepping <= 4 || $stepping > 6){ + $arch = 'Netburst Northwood';} + elsif ($stepping == 5){ + $arch = 'Netburst Gallatin';} + else { + $arch = 'Netburst';} + $process = 'Intel 130nm'; + $year = '2002-03';} + elsif ($model =~ /^(3)$/){ + $arch = 'Netburst Prescott'; + $process = 'Intel 90nm'; + $year = '2004-06';} # 6? Nocona + elsif ($model =~ /^(4)$/){ + # these are vague, and same stepping can have > 1 core names + if ($stepping < 10){ + $arch = 'Netburst Prescott'; # 4:1,9:prescott + $process = 'Intel 90nm'; + $year = '2004-06';} + else { + $arch = 'Netburst Smithfield'; + $process = 'Intel 90nm'; + $year = '2005-06';} # 6? Nocona + } + elsif ($model =~ /^(6)$/){ + $arch = 'Netburst Presler'; # 6:2,4,5:presler + $process = 'Intel 65nm'; + $year = '2006';} + else { + $arch = 'Netburst'; + $process = 'Intel 90-180nm'; + $year = '2000-06';} + } + # this is not going to e accurate, WhiskyL or Kaby L can ID as Skylake + # but if it's a new cpu microarch not handled yet, it may give better + # than nothing result. This is intel only + # This is probably the gcc/clang -march/-mtune value, which is not + # necessarily the same as actual microarch, and varies between gcc/clang versions + if (!$arch){ + my $file = '/sys/devices/cpu/caps/pmu_name'; + $arch = main::reader($file,'strip',0) if -r $file; + $note = $check if $arch; + } + # gen 1 had no gen, only 3 digits: Core i5-661 Core i5-655K; Core i5 M 520 + # EXCEPT gen 1: Core i7-720QM Core i7-740QM Core i7-840QM + # 2nd: Core i5-2390T Core i7-11700F Core i5-8400 + # 2nd variants: Core i7-1165G7 + if ($name){ + if ($name =~ /\bi[357][\s-]([A-Z][\s-]?)?(\d{3}([^\d]|\b)|[78][24]00M)/){ + $gen = ($gen) ? "$gen (core 1)": 'core 1'; + } + elsif ($name =~ /\bi[3579][\s-]([A-Z][\s-]?)?([2-9]|1[0-4])(\d{3}|\d{2}[A-Z]\d)/){ + $gen = ($gen) ? "$gen (core $2)" : "core $2"; + } + } + } + # Note: their cpu family value is either missing for early, or generic + # No model: [id]/family: [id]. Just cpu family: [string], model name: [string] + elsif ($type eq 'loongson'){ + # can't safely match model 1, but nobody will run inxi on that + # Not certain when SMIC took over from STM, which is a swiss firm. + if ($name =~ /\b2[BCE]\b/){ + $arch = 'Godson'; + $process = 'STM 180nm'; + $year = '2003-2006';} + elsif ($name =~ /\b1[ABCD]\b/){ + $arch = 'Loongson-1'; + $process = 'STM 130nm'; + $year = '2010-2014';} + elsif ($name =~ /\b1C101/){ + $arch = 'Loongson-1'; + $process = 'STM 130nm'; + $year = '2018';} + elsif ($name =~ /\b2F\b/){ + $arch = 'Loongson-2'; + $process = 'STM 90nm'; + $year = '2007';} + elsif ($name =~ /\b2[GIH]\b/){ + $arch = 'Loongson-2'; + $process = 'STM 65nm'; + $year = '2012-2013';} + elsif ($name =~ /\b2K(1000)?\b/){ + $arch = 'Loongson-2'; + $process = 'STM 40nm'; + $year = '2017';} + elsif ($name =~ /3A1000/){ + $arch = 'Godson-3/Loongson-3'; + $process = 'SMIC 65nm'; + $year = '2009';} + elsif ($name =~ /3B1000/){ + $arch = 'Godson-3/Loongson-3'; + $process = 'SMIC 65nm'; + $year = '2010';} + elsif ($name =~ /3B1500/){ + $arch = 'Godson-3/Loongson-3'; + $process = 'SMIC 32nm'; + $year = '2012';} + elsif ($name =~ /3A1500-I|3[AB]2000/){ + $arch = 'Godson-3/Loongson-3'; + $process = 'SMIC 40nm'; + $year = '2015';} + elsif ($name =~ /3[AB]3000/){ + $arch = 'Godson-3/Loongson-3'; + $process = 'SMIC 28nm'; + $year = '2016';} + elsif ($name =~ /3[AB]4000/){ + $arch = 'Godson-3/Loongson-3'; + $process = 'SMIC 28nm'; + $year = '2019';} + elsif ($name =~ /3[A-C]5000/){ + $arch = 'Loongson-3/LoongArch'; + $process = 'SMIC 12-14nm'; + $year = '2021+';} + elsif ($name =~ /3[A-C]6000/){ + $arch = 'Loongson-3/LoongArch'; + $process = 'SMIC 12-14nm'; + $year = '2023+';} + } + eval $end if $b_log; + return [$arch,$note,$process,$gen,$year]; +} +## END CPU ARCH ## + +## LEGACY CPU DATA ENGINE ## +sub cp_data_fallback { + eval $start if $b_log; + my ($cpu,$caches,$cache_check,$counts,$tests) = @_; + if (!$counts->{'physical'}){ + # handle case where cpu reports say, phys id 0, 2, 4, 6 + foreach (@{$cpu->{'ids'}}){ + $counts->{'physical'}++ if $_; + } + } + # count unique processors ## + # note, this fails for intel cpus at times + # print ref $cpu->{'processors'}, "\n"; + if (!$counts->{'processors'}){ + $counts->{'processors'} = scalar @{$cpu->{'processors'}}; + } + # print "p count:$counts->{'processors'}\n"; + # print Data::Dumper::Dumper $cpu->{'processors'}; + # $counts->{'cpu-cores'} is per physical cpu + # note: elbrus supports turning off cores, so we need to add one for cases + # where rounds to 0 or 1 less + # print "$cpu{'type'},$cpu{'family'},$cpu{'model-id'},$cpu{'arch'}\n"; + if ($tests->{'elbrus'} && $counts->{'processors'}){ + my $elbrus = cp_elbrus_data($cpu->{'family'},$cpu->{'model-id'}, + $counts->{'processors'},$cpu->{'arch'}); + $counts->{'cpu-cores'} = $elbrus->[0]; + $counts->{'physical'} = $elbrus->[1]; + $cpu->{'arch'} = $elbrus->[2]; + # print 'model id: ' . $cpu->{'model-id'} . ' arch: ' . $cpu->{'arch'} . " cpc: $counts->{'cpu-cores'} phyc: $counts->{'physical'} proc: $counts->{'processors'} \n"; + } + $counts->{'physical'} ||= 1; # assume 1 if no id found, as with ARM + foreach my $die_ref (@{$cpu->{'ids'}}){ + next if ref $die_ref ne 'ARRAY'; + $counts->{'cores'} = 0; + $counts->{'dies'} = scalar @$die_ref; + #$cpu->{'dies-count'} = $counts->{'dies'}; + foreach my $core_ref (@$die_ref){ + next if ref $core_ref ne 'ARRAY'; + $counts->{'cores'} = 0;# reset for each die!! + # NOTE: the counters can be undefined because the index comes from + # core id: which can be 0 skip 1 then 2, which leaves index 1 undefined + # risc cpus do not actually show core id so ignore that counter + foreach my $id (@$core_ref){ + $counts->{'cores'}++ if defined $id && !%risc; + } + # print 'cores: ' . $counts->{'cores'}, "\n"; + } + } + # this covers potentially cases where ARM cpus have > 1 die + # maybe applies to all risc, not sure, but dies is broken anyway for cpuinfo + if (!$cpu->{'dies-count'}){ + if ($risc{'arm'} && $counts->{'dies'} <= 1 && $cpu->{'dies-count'} > 1){ + $counts->{'dies'} = $cpu->{'dies-count'}; + } + else { + $cpu->{'dies-count'} = $counts->{'dies'}; + } + } + # this is an attempt to fix the amd family 15 bug with reported cores vs actual cores + # NOTE: amd A6-4400M APU 2 core reports: cores: 1 siblings: 2 + # NOTE: AMD A10-5800K APU 4 core reports: cores: 2 siblings: 4 + if (!$counts->{'cpu-cores'}){ + if ($cpu->{'cores'} && !$counts->{'cores'} || + $cpu->{'cores'} >= $counts->{'cores'}){ + $counts->{'cpu-cores'} = $cpu->{'cores'}; + } + elsif ($counts->{'cores'} > $cpu->{'cores'}){ + $counts->{'cpu-cores'} = $counts->{'cores'}; + } + } + # print "cpu-c:$counts->{'cpu-cores'}\n"; + # $counts->{'cpu-cores'} = $cpu->{'cores'}; + # like, intel core duo + # NOTE: sadly, not all core intel are HT/MT, oh well... + # xeon may show wrong core / physical id count, if it does, fix it. A xeon + # may show a repeated core id : 0 which gives a fake num_of_cores=1 + if ($tests->{'intel'}){ + if ($cpu->{'siblings'} && $cpu->{'siblings'} > 1 && + $cpu->{'cores'} && $cpu->{'cores'} > 1){ + if ($cpu->{'siblings'}/$cpu->{'cores'} == 1){ + $tests->{'intel'} = 0; + $tests->{'ht'} = 0; + } + else { + $counts->{'cpu-cores'} = ($cpu->{'siblings'}/2); + $tests->{'ht'} = 1; + } + } + } + # ryzen is made out of blocks of 2, 4, or 8 core dies... + if ($tests->{'ryzen'}){ + $counts->{'cpu-cores'} = $cpu->{'cores'}; + # note: posix ceil isn't present in Perl for some reason, deprecated? + my $working = $counts->{'cpu-cores'} / 8; + my @temp = split('\.', $working); + $cpu->{'dies-count'} = ($temp[1] && $temp[1] > 0) ? $temp[0]++ : $temp[0]; + $counts->{'dies'} = $cpu->{'dies-count'}; + } + # these always have 4 dies + elsif ($tests->{'epyc'}){ + $counts->{'cpu-cores'} = $cpu->{'cores'}; + $counts->{'dies'} = $cpu->{'dies-count'} = 4; + } + # final check, override the num of cores value if it clearly is wrong + # and use the raw core count and synthesize the total instead of real count + if ($counts->{'cpu-cores'} == 0 && + $cpu->{'cores'} * $counts->{'physical'} > 1){ + $counts->{'cpu-cores'} = ($cpu->{'cores'} * $counts->{'physical'}); + } + # last check, seeing some intel cpus and vms with intel cpus that do not show any + # core id data at all, or siblings. + if ($counts->{'cpu-cores'} == 0 && $counts->{'processors'} > 0){ + $counts->{'cpu-cores'} = $counts->{'processors'}; + } + # this happens with BSDs which have very little cpu data available + if ($counts->{'processors'} == 0 && $counts->{'cpu-cores'} > 0){ + $counts->{'processors'} = $counts->{'cpu-cores'}; + if ($bsd_type && ($tests->{'ht'} || $tests->{'amd-zen'}) && + $counts->{'cpu-cores'} > 2){ + $counts->{'cpu-cores'} = $counts->{'cpu-cores'}/2;; + } + my $count = $counts->{'processors'}; + $count-- if $count > 0; + $cpu->{'processors'}[$count] = 0; + # no way to get per processor speeds yet, so assign 0 to each + # must be a numeric value. Could use raw speed from core 0, but + # that would just be a hack. + foreach (0 .. $count){ + $cpu->{'processors'}[$_] = 0; + } + } + # so far only OpenBSD has a way to detect MT cpus, but Openbsd has disabled MT + if ($bsd_type){ + if ($cpu->{'siblings'} && + $counts->{'cpu-cores'} && $counts->{'cpu-cores'} > 1){ + $counts->{'cores-multiplier'} = $counts->{'cpu-cores'}; + } + # if no siblings we couldn't get MT status of cpu so can't trust cache + else { + $$cache_check = main::message('note-check'); + } + } + # only elbrus shows L1 / L3 cache data in cpuinfo, cpu_sys data should show + # for newer full linux. + elsif ($counts->{'cpu-cores'} && + ($tests->{'elbrus'} || $counts->{'cpu-cores'} > 1)) { + $counts->{'cores-multiplier'} = $counts->{'cpu-cores'}; + } + # last test to catch some corner cases + # seen a case where a xeon vm in a dual xeon system actually had 2 cores, no MT + # so it reported 4 siblings, 2 cores, but actually only had 1 core per virtual cpu + # print "prc: $counts->{'processors'} phc: $counts->{'physical'} coc: $counts->{'cores'} cpc: $counts->{'cpu-cores'}\n"; + # this test was for arm but I think it applies to all risc, but risc will be sys + if (!%risc && + $counts->{'processors'} == $counts->{'physical'} * $counts->{'cores'} && + $counts->{'cpu-cores'} > $counts->{'cores'}){ + $tests->{'ht'} = 0; + # $tests->{'xeon'} = 0; + $tests->{'intel'} = 0; + $counts->{'cpu-cores'} = 1; + $counts->{'cores'} = 1; + $cpu->{'siblings'} = 1; + } + eval $end if $b_log; +} + +# Legacy: this data should be comfing from the /sys tool now. +# Was needed because no physical_id in cpuinfo, but > 1 cpu systems exist +# returns: 0: per cpu cores; 1: phys cpu count; 2: override model defaul names +sub cp_elbrus_data { + eval $start if $b_log; + my ($family_id,$model_id,$count,$arch) = @_; + # 0: cores + my $return = [0,1,$arch]; + my %cores = ( + # key=family id + model id + '41' => 1, + '42' => 1, + '43' => 4, + '44' => 2, + '46' => 1, + '47' => 8, + '48' => 1, + '49' => 8, + '59' => 8, + '4A' => 12, + '4B' => 16, + '4C' => 2, + '6A' => 12, + '6B' => 16, + '6C' => 2, + ); + $return->[0] = $cores{$family_id . $model_id} if $cores{$family_id . $model_id}; + if ($return->[0]){ + $return->[1] = ($count % $return->[0]) ? int($count/$return->[0]) + 1 : $count/$return->[0]; + } + eval $end if $b_log; + return $return; +} +## END LEGACY CPU DATA ENGINE ## + +## CPU SHARED UTILITIES ## +# args: 0: vendor_id,like GenuineIntel, AuthenticAMD +sub cpu_vendor { + eval $start if $b_log; + my $string = $_[0]; + my $vendor = ''; + $string = lc($string); + if ($string =~ /intel/){ + $vendor = "intel"; + } + elsif ($string =~ /amd/){ + $vendor = "amd"; + } + # via/centaur/zhaoxin branding + elsif ($string =~ /centaur|zhaoxin/){ + $vendor = "centaur"; + } + elsif ($string eq 'elbrus'){ + $vendor = "elbrus"; + } + eval $end if $b_log; + return $vendor; +} + +# do not define model-id, stepping, or revision, those can be 0 valid value +sub set_cpu_data { + ${$_[0]} = { + 'arch' => '', + 'avg-freq' => 0, # MHz + 'bogomips' => 0, + 'cores' => 0, + 'cur-freq' => 0, # MHz + 'family' => '', + 'flags' => '', + 'ids' => [], + 'l1-cache' => 0, # store in KB + 'l2-cache' => 0, # store in KB + 'l3-cache' => 0, # store in KB + 'max-freq' => 0, # MHz + 'min-freq' => 0, # MHz + 'model_name' => '', + 'processors' => [], + 'scalings' => [], + 'siblings' => 0, + 'type' => '', + }; +} + +sub system_cpu_name { + eval $start if $b_log; + my ($compat,@working); + my $cpus = {}; + if (@working = main::globber('/sys/firmware/devicetree/base/cpus/cpu@*/compatible')){ + foreach my $file (@working){ + $compat = main::reader($file,'',0); + next if $compat =~ /timer/; # seen on android + # these can have non printing ascii... why? As long as we only have the + # splits for: null 00/start header 01/start text 02/end text 03 + $compat = (split(/\x01|\x02|\x03|\x00/, $compat))[0] if $compat; + $compat = (split(/,\s*/, $compat))[-1] if $compat; + $cpus->{$compat} = ($cpus->{$compat}) ? ++$cpus->{$compat}: 1; + } + } + # synthesize it, [4] will be like: cortex-a15-timer; sunxi-timer + # so far all with this directory show soc name, not cpu name for timer + elsif (! -d '/sys/firmware/devicetree/base' && $devices{'timer'}){ + foreach my $working (@{$devices{'timer'}}){ + next if $working->[0] ne 'timer' || !$working->[4] || $working->[4] =~ /timer-mem$/; + $working->[4] =~ s/(-system)?-timer$//; + $compat = $working->[4]; + $cpus->{$compat} = ($cpus->{$compat}) ? ++$cpus->{$compat}: 1; + } + } + main::log_data('dump','%$cpus',$cpus) if $b_log; + eval $end if $b_log; + return $cpus; +} +## END CPU SHARED UTILITIES ## + +## CLEANERS/OUTPUT HANDLERS ## +# MHZ - cell cpus +sub clean_speed { + my ($speed,$opt) = @_; + # eq '0' might be for string typing; value can be: + return if !$speed || $speed eq '0' || $speed =~ /^\D/; + $speed =~ s/[GMK]HZ$//gi; + $speed = ($speed/1000) if $opt && $opt eq 'khz'; + $speed = sprintf("%.0f", $speed); + return $speed; +} + +sub clean_cpu { + my ($cpu) = @_; + return if !$cpu; + my $filters = '@|cpu |cpu deca|([0-9]+|single|dual|two|triple|three|tri|quad|four|'; + $filters .= 'penta|five|hepta|six|hexa|seven|octa|eight|multi)[ -]core|'; + $filters .= 'ennea|genuine|multi|processor|single|triple|[0-9\.]+ *[MmGg][Hh][Zz]'; + $cpu =~ s/$filters//ig; + $cpu =~ s/\s\s+/ /g; + $cpu =~ s/^\s+|\s+$//g; + return $cpu; +} + +sub hex_and_decimal { + my ($data) = @_; + $data = '' if !defined $data; + if ($data =~ /\S/){ + # only handle if a short hex number!! No need to prepend 0x to 0-9 + if ($data =~ /^[0-9a-f]{1,3}$/i && hex($data) ne $data){ + $data .= ' (' . hex($data) . ')'; + $data = '0x' . $data; + } + } + else { + $data = 'N/A'; + } + return $data; +} +## END CLEANERS/OUTPUT HANDLERS +} +## END CpuItem ## + +## DriveItem ## +{ +package DriveItem; +my ($b_hddtemp,$b_nvme,$smartctl_missing,$vendors); +my ($hddtemp,$nvme) = ('',''); +my (@by_id,@by_path); +my ($debugger_dir); +# main::writer("$debugger_dir/system-repo-data-urpmq.txt",\@data2) if $debugger_dir; + +sub get { + eval $start if $b_log; + my ($type) = @_; + $type ||= 'standard'; + my ($key1,$val1); + my $rows = []; + my $num = 0; + my $data = drive_data($type); + # NOTE: + if (@$data){ + if ($type eq 'standard'){ + storage_output($rows,$data); + drive_output($rows,$data) if $show{'disk'}; + if ($bsd_type && !$dboot{'disk'} && $type eq 'standard' && $show{'disk'}){ + $key1 = 'Drive Report'; + my $file = $system_files{'dmesg-boot'}; + if ($file && ! -r $file){ + $val1 = main::message('dmesg-boot-permissions'); + } + elsif (!$file){ + $val1 = main::message('dmesg-boot-missing'); + } + else { + $val1 = main::message('disk-data-bsd'); + } + push(@$rows,{main::key($num++,0,1,$key1) => $val1,}); + } + } + # used by short form, raw data returned + else { + $rows = $data; + # print Data::Dumper::Dumper $rows; + } + } + else { + $key1 = 'Message'; + $val1 = main::message('disk-data'); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); + } + if (!@$rows){ + $key1 = 'Message'; + $val1 = main::message('disk-data'); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); + } + # push(@rows,@data); + if ($show{'optical'} || $show{'optical-basic'}){ + OpticalItem::get($rows); + } + ($b_hddtemp,$b_nvme,$hddtemp,$nvme,$vendors) = (); + (@by_id,@by_path) = (); + eval $end if $b_log; + return $rows; +} + +sub storage_output { + eval $start if $b_log; + my ($rows,$disks) = @_; + my ($num,$j) = (0,0); + my ($size,$size_value,$used) = ('','',''); + push(@$rows, { + main::key($num++,1,1,'Local Storage') => '', + }); + # print Data::Dumper::Dumper $disks; + $size = main::get_size($disks->[0]{'size'},'string','N/A'); + if ($disks->[0]{'logical-size'}){ + $rows->[$j]{main::key($num++,1,2,'total')} = ''; + $rows->[$j]{main::key($num++,0,3,'raw')} = $size; + $size = main::get_size($disks->[0]{'logical-size'},'string'); + $size_value = $disks->[0]{'logical-size'}; + # print Data::Dumper::Dumper $disks; + $rows->[$j]{main::key($num++,1,3,'usable')} = $size; + } + else { + $size_value = $disks->[0]{'size'} if $disks->[0]{'size'}; + $rows->[$j]{main::key($num++,0,2,'total')} = $size; + } + $used = main::get_size($disks->[0]{'used'},'string','N/A'); + if ($extra > 0 && $disks->[0]{'logical-free'}){ + $size = main::get_size($disks->[0]{'logical-free'},'string'); + $rows->[$j]{main::key($num++,0,4,'lvm-free')} = $size; + } + if (($size_value && $size_value =~ /^[0-9]/) && + ($used && $disks->[0]{'used'} =~ /^[0-9]/)){ + $used = $used . ' (' . sprintf("%0.1f", $disks->[0]{'used'}/$size_value*100) . '%)'; + } + $rows->[$j]{main::key($num++,0,2,'used')} = $used; + shift @$disks; + eval $end if $b_log; +} + +sub drive_output { + eval $start if $b_log; + my ($rows,$disks) = @_; + # print Data::Dumper::Dumper $disks; + my ($b_smart_permissions,$block,$smart_age,$smart_basic,$smart_fail); + my ($num,$j) = (0,0); + my ($id,$model,$size) = ('','',''); + # note: specific smartctl non-missing errors handled inside loop + if ($smartctl_missing){ + $j = scalar @$rows; + $rows->[$j]{main::key($num++,0,1,'SMART Message')} = $smartctl_missing; + } + elsif ($b_admin){ + my $result = smartctl_fields(); + ($smart_age,$smart_basic,$smart_fail) = @$result; + } + foreach my $row (sort { $a->{'id'} cmp $b->{'id'} } @$disks){ + ($id,$model,$size) = ('','',''); + $num = 1; + $model = ($row->{'model'}) ? $row->{'model'}: 'N/A'; + $id = ($row->{'id'}) ? "/dev/$row->{'id'}":'N/A'; + $size = ($row->{'size'}) ? main::get_size($row->{'size'},'string') : 'N/A'; + # print Data::Dumper::Dumper $disks; + $j = scalar @$rows; + if (!$b_smart_permissions && $row->{'smart-permissions'}){ + $b_smart_permissions = 1; + $rows->[$j]{main::key($num++,0,1,'SMART Message')} = $row->{'smart-permissions'}; + $j = scalar @$rows; + } + push(@$rows, { + main::key($num++,1,1,'ID') => $id, + }); + if ($b_admin && $row->{'maj-min'}){ + $rows->[$j]{main::key($num++,0,2,'maj-min')} = $row->{'maj-min'}; + } + + if ($row->{'vendor'}){ + $rows->[$j]{main::key($num++,0,2,'vendor')} = $row->{'vendor'}; + } + $rows->[$j]{main::key($num++,0,2,'model')} = $model; + if ($row->{'drive-vendor'}){ + $rows->[$j]{main::key($num++,0,2,'drive vendor')} = $row->{'drive-vendor'}; + } + if ($row->{'drive-model'}){ + $rows->[$j]{main::key($num++,0,2,'drive model')} = $row->{'drive-model'}; + } + if ($row->{'family'}){ + $rows->[$j]{main::key($num++,0,2,'family')} = $row->{'family'}; + } + $rows->[$j]{main::key($num++,0,2,'size')} = $size; + if ($b_admin && $row->{'block-physical'}){ + $rows->[$j]{main::key($num++,1,2,'block-size')} = ''; + $rows->[$j]{main::key($num++,0,3,'physical')} = "$row->{'block-physical'} B"; + $block = ($row->{'block-logical'}) ? "$row->{'block-logical'} B" : 'N/A'; + $rows->[$j]{main::key($num++,0,3,'logical')} = $block; + } + if ($row->{'type'}){ + $rows->[$j]{main::key($num++,1,2,'type')} = $row->{'type'}; + if ($extra > 1 && $row->{'type'} eq 'USB' && $row->{'abs-path'} && + $usb{'disk'}){ + foreach my $device (@{$usb{'disk'}}){ + if ($device->[8] && $device->[26] && + $row->{'abs-path'} =~ /^$device->[26]/){ + $rows->[$j]{main::key($num++,0,3,'rev')} = $device->[8]; + if ($device->[17]){ + $rows->[$j]{main::key($num++,0,3,'spd')} = $device->[17]; + } + if ($device->[24]){ + $rows->[$j]{main::key($num++,0,3,'lanes')} = $device->[24]; + } + if ($b_admin && $device->[22]){ + $rows->[$j]{main::key($num++,0,3,'mode')} = $device->[22]; + } + last; + } + } + } + } + if ($extra > 1 && $row->{'speed'}){ + if ($row->{'sata'}){ + $rows->[$j]{main::key($num++,0,2,'sata')} = $row->{'sata'}; + } + $rows->[$j]{main::key($num++,0,2,'speed')} = $row->{'speed'}; + $rows->[$j]{main::key($num++,0,2,'lanes')} = $row->{'lanes'} if $row->{'lanes'}; + } + if ($extra > 2){ + $row->{'tech'} ||= 'N/A'; + $rows->[$j]{main::key($num++,1,2,'tech')} = $row->{'tech'}; + if ($row->{'rotation'}){ + $rows->[$j]{main::key($num++,0,2,'rpm')} = $row->{'rotation'}; + } + } + if ($extra > 1){ + if (!$row->{'serial'} && $alerts{'bioctl'} && + $alerts{'bioctl'}->{'action'} eq 'permissions'){ + $row->{'serial'} = main::message('root-required'); + } + else { + $row->{'serial'} = main::filter($row->{'serial'}); + } + $rows->[$j]{main::key($num++,0,2,'serial')} = $row->{'serial'}; + if ($row->{'drive-serial'}){ + $rows->[$j]{main::key($num++,0,2,'drive serial')} = main::filter($row->{'drive-serial'}); + } + if ($row->{'firmware'}){ + $rows->[$j]{main::key($num++,0,2,'fw-rev')} = $row->{'firmware'}; + } + if ($row->{'drive-firmware'}){ + $rows->[$j]{main::key($num++,0,2,'drive-rev')} = $row->{'drive-firmware'}; + } + } + if ($extra > 0 && $row->{'temp'}){ + $rows->[$j]{main::key($num++,0,2,'temp')} = $row->{'temp'} . ' C'; + } + if ($extra > 1 && $alerts{'bioctl'}){ + if (!$row->{'duid'} && $alerts{'bioctl'}->{'action'} eq 'permissions'){ + $rows->[$j]{main::key($num++,0,2,'duid')} = main::message('root-required'); + } + elsif ($row->{'duid'}){ + $rows->[$j]{main::key($num++,0,2,'duid')} = main::filter($row->{'duid'}); + } + } + # Extra level tests already done + if (defined $row->{'partition-table'}){ + $rows->[$j]{main::key($num++,0,2,'scheme')} = $row->{'partition-table'}; + } + if ($row->{'smart'} || $row->{'smart-error'}){ + $j = scalar @$rows; + ## Basic SMART and drive info ## + smart_output('basic',$smart_basic,$row,$j,\$num,$rows); + ## Old-Age errors ## + smart_output('age',$smart_age,$row,$j,\$num,$rows); + ## Pre-Fail errors ## + smart_output('fail',$smart_fail,$row,$j,\$num,$rows); + } + } + eval $end if $b_log; +} + +# args: $num and $rows passed by reference +sub smart_output { + eval $start if $b_log; + my ($type,$smart_data,$row,$j,$num,$rows) = @_; + my ($b_found); + my ($l,$m,$p) = ($type eq 'basic') ? (2,3,0) : (3,4,0); + my ($m_h,$p_h) = ($m,$p); + for (my $i = 0; $i < scalar @$smart_data;$i++){ + if ($row->{$smart_data->[$i][0]}){ + if (!$b_found){ + my ($key,$support) = ('',''); + if ($type eq 'basic'){ + $support = ($row->{'smart'}) ? $row->{'smart'}: $row->{'smart-error'}; + $key = $smart_data->[$i][1]; + } + elsif ($type eq 'age'){$key = 'Old-Age';} + elsif ($type eq 'fail'){$key = 'Pre-Fail';} + $rows->[$j]{main::key($$num++,1,$l,$key)} = $support; + $b_found = 1; + next if $type eq 'basic'; + } + if ($type ne 'basic'){ + if ($smart_data->[$i][0] =~ /-a[vr]?$/){ + ($p,$m) = (1,$m_h); + } + elsif ($smart_data->[$i][0] =~ /-[ftvw]$/){ + ($p,$m) = (0,5); + } + else { + ($p,$m) = ($p_h,$m_h); + } + } + $rows->[$j]{main::key($$num++,$p,$m,$smart_data->[$i][1])} = $row->{$smart_data->[$i][0]}; + } + } + eval $end if $b_log; +} + +sub drive_data { + eval $start if $b_log; + my ($type) = @_; + my ($data,@devs); + my $num = 0; + my ($used) = (0); + PartitionItem::set_partitions() if !$loaded{'set-partitions'}; + RaidItem::raid_data() if !$loaded{'raid'}; + # see docs/inxi-partitions.txt > FILE SYSTEMS for more on remote/fuse fs + my $fs_skip = PartitionItem::get_filters('fs-exclude'); + foreach my $row (@partitions){ + # don't count remote/distributed/union type fs towards used + next if ($row->{'fs'} && $row->{'fs'} =~ /^$fs_skip$/); + # don't count non partition swap + next if ($row->{'swap-type'} && $row->{'swap-type'} ne 'partition'); + # in some cases, like redhat, mounted cdrom/dvds show up in partition data + next if ($row->{'dev-base'} && $row->{'dev-base'} =~ /^sr[0-9]+$/); + # this is used for specific cases where bind, or incorrect multiple mounts + # to same partitions, or btrfs sub volume mounts, is present. The value is + # searched for an earlier appearance of that partition and if it is present, + # the data is not added into the partition used size. + if ($row->{'dev-base'} !~ /^(\/\/|:\/)/ && !(grep {/$row->{'dev-base'}/} @devs)){ + $used += $row->{'used'} if $row->{'used'}; + push(@devs, $row->{'dev-base'}); + } + } + if (!$bsd_type){ + $data = proc_data($used); + } + else { + $data = bsd_data($used); + } + if ($b_admin){ + if ($alerts{'smartctl'} && $alerts{'smartctl'}->{'action'} eq 'use'){ + smartctl_data($data); + } + else { + $smartctl_missing = $alerts{'smartctl'}->{'message'}; + } + } + print Data::Dumper::Dumper $data if $dbg[13]; + main::log_data('data',"used: $used") if $b_log; + eval $end if $b_log; + return $data; +} + +sub proc_data { + eval $start if $b_log; + my ($used) = @_; + my (@drives); + my ($b_hdx,$logical_size,$size) = (0,0,0); + PartitionData::set() if !$bsd_type && !$loaded{'partition-data'}; + foreach my $row (@proc_partitions){ + if ($row->[-1] =~ /^(fio[a-z]+|[hsv]d[a-z]+|(ada|mmcblk|n[b]?d|nvme[0-9]+n)[0-9]+)$/){ + $b_hdx = 1 if $row->[-1] =~ /^hd[a-z]/; + push(@drives, { + 'firmware' => '', + 'id' => $row->[-1], + 'maj-min' => $row->[0] . ':' . $row->[1], + 'model' => '', + 'serial' => '', + 'size' => $row->[2], + 'spec' => '', + 'speed' => '', + 'temp' => '', + 'type' => '', + 'vendor' => '', + }); + } + # See http://lanana.org/docs/device-list/devices-2.6+.txt for major numbers used below + # See https://www.mjmwired.net/kernel/Documentation/devices.txt for kernel 4.x device numbers + # if ($row->[0] =~ /^(3|22|33|8)$/ && $row->[1] % 16 == 0) { + # $size += $row->[2]; + # } + # special case from this data: 8 0 156290904 sda + # 43 0 48828124 nbd0 + # note: known starters: vm: 252/253/254; grsec: 202; nvme: 259 mmcblk: 179 + # Note: with > 1 nvme drives, the minor number no longer passes the modulus tests, + # It appears to just increase randomly from the first 0 minor of the first nvme to + # nvme partitions to next nvme, so it only passes the test for the first nvme drive. + # note: 66 16 9766436864 sdah ; 65 240 9766436864 sdaf[maybe special case when double letters? + # Check /proc/devices for major number matches + if ($row->[0] =~ /^(3|8|22|33|43|6[5-9]|7[12]|12[89]|13[0-5]|179|202|252|253|254|259)$/ && + $row->[-1] =~ /(mmcblk[0-9]+|n[b]?d[0-9]+|nvme[0-9]+n[0-9]+|fio[a-z]+|[hsv]d[a-z]+)$/ && + ($row->[1] % 16 == 0 || $row->[1] % 16 == 8 || $row->[-1] =~ /(nvme[0-9]+n[0-9]+)$/)){ + $size += $row->[2]; + } + } + # raw_logical[0] is total of all logical raid/lvm found + # raw_logical[1] is total of all components found. If this totally fails, + # and we end up with raw logical less than used, give up + if (@raw_logical && $raw_logical[0] && (!$used || $raw_logical[0] > $used)){ + $logical_size = ($size - $raw_logical[1] + $raw_logical[0]); + } + # print Data::Dumper::Dumper \@drives; + main::log_data('data',"size: $size") if $b_log; + my $result = [{ + 'logical-size' => $logical_size, + 'logical-free' => $raw_logical[2], + 'size' => $size, + 'used' => $used, + }]; + # print Data::Dumper::Dumper \@data; + if ($show{'disk'}){ + unshift(@drives,@$result); + # print 'drives:', Data::Dumper::Dumper \@drives; + $result = proc_data_advanced($b_hdx,\@drives); + } + main::log_data('dump','@$result',$result) if $b_log; + print Data::Dumper::Dumper $result if $dbg[24]; + eval $end if $b_log; + return $result; +} + +sub proc_data_advanced { + eval $start if $b_log; + my ($b_hdx,$drives) = @_; + my ($i) = (0); + my ($disk_data,$scsi,@temp,@working); + my ($pt_cmd) = ('unset'); + my ($block_type,$file,$firmware,$model,$path, + $partition_scheme,$serial,$vendor,$working_path); + @by_id = main::globber('/dev/disk/by-id/*'); + # these do not contain any useful data, no serial or model name + # wwn-0x50014ee25fb50fc1 and nvme-eui.0025385b71b07e2e + # scsi-SATA_ST980815A_ simply repeats ata-ST980815A_; same with scsi-0ATA_WDC_WD5000L31X + # we also don't need the partition items + my $pattern = '^\/dev\/disk\/by-id\/(md-|lvm-|dm-|wwn-|nvme-eui|raid-|scsi-([0-9]ATA|SATA))|-part[0-9]+$'; + @by_id = grep {!/$pattern/} @by_id if @by_id; + # print join("\n", @by_id), "\n"; + @by_path = main::globber('/dev/disk/by-path/*'); + ## check for all ide type drives, non libata, only do it if hdx is in array + ## this is now being updated for new /sys type paths, this may handle that ok too + ## skip the first rows in the loops since that's the basic size/used data + if ($b_hdx){ + for ($i = 1; $i < scalar @$drives; $i++){ + $file = "/proc/ide/$drives->[$i]{'id'}/model"; + if ($drives->[$i]{'id'} =~ /^hd[a-z]/ && -e $file){ + $model = main::reader($file,'strip',0); + $drives->[$i]{'model'} = $model; + } + } + } + # scsi stuff + if ($file = $system_files{'proc-scsi'}){ + $scsi = scsi_data($file); + } + # print 'drives:', Data::Dumper::Dumper $drives; + for ($i = 1; $i < scalar @$drives; $i++){ + #next if $drives->[$i]{'id'} =~ /^hd[a-z]/; + ($block_type,$firmware,$model,$partition_scheme, + $serial,$vendor,$working_path) = ('','','','','','',''); + # print "$drives->[$i]{'id'}\n"; + $disk_data = disk_data_by_id("/dev/$drives->[$i]{'id'}"); + main::log_data('dump','@$disk_data', $disk_data) if $b_log; + if ($drives->[$i]{'id'} =~ /[sv]d[a-z]/){ + $block_type = 'sdx'; + $working_path = "/sys/block/$drives->[$i]{'id'}/device/"; + } + elsif ($drives->[$i]{'id'} =~ /mmcblk/){ + $block_type = 'mmc'; + $working_path = "/sys/block/$drives->[$i]{'id'}/device/"; + } + elsif ($drives->[$i]{'id'} =~ /nvme/){ + $block_type = 'nvme'; + # this results in: + # /sys/devices/pci0000:00/0000:00:03.2/0000:06:00.0/nvme/nvme0/nvme0n1 + # but we want to go one level down so slice off trailing nvme0n1 + $working_path = Cwd::abs_path("/sys/block/$drives->[$i]{'id'}"); + $working_path =~ s/nvme[^\/]*$//; + } + if ($working_path){ + $drives->[$i]{'abs-path'} = Cwd::abs_path($working_path); + } + main::log_data('data',"working path: $working_path") if $b_log; + if ($b_admin && -e "/sys/block/"){ + ($drives->[$i]{'block-logical'},$drives->[$i]{'block-physical'}) = @{block_data($drives->[$i]{'id'})}; + } + if ($block_type && $scsi && @$scsi && @by_id && ! -e "${working_path}model" && + ! -e "${working_path}name"){ + ## ok, ok, it's incomprehensible, search /dev/disk/by-id for a line that contains the + # discovered disk name AND ends with the correct identifier, sdx + # get rid of whitespace for some drive names and ids, and extra data after - in name + SCSI: + foreach my $row (@$scsi){ + if ($row->{'model'}){ + $row->{'model'} = (split(/\s*-\s*/,$row->{'model'}))[0]; + foreach my $id (@by_id){ + if ($id =~ /$row->{'model'}/ && "/dev/$drives->[$i]{'id'}" eq Cwd::abs_path($id)){ + $drives->[$i]{'firmware'} = $row->{'firmware'}; + $drives->[$i]{'model'} = $row->{'model'}; + $drives->[$i]{'vendor'} = $row->{'vendor'}; + last SCSI; + } + } + } + } + } + # note: an entire class of model names gets truncated by /sys so that should be the last + # in priority re tests. + elsif ((!@$disk_data || !$disk_data->[0]) && $block_type){ + # NOTE: while path ${working_path}vendor exists, it contains junk value, like: ATA + $path = "${working_path}model"; + if (-r $path){ + $model = main::reader($path,'strip',0); + $drives->[$i]{'model'} = $model if $model; + } + elsif ($block_type eq 'mmc' && -r "${working_path}name"){ + $path = "${working_path}name"; + $model = main::reader($path,'strip',0); + $drives->[$i]{'model'} = $model if $model; + } + } + if (!$drives->[$i]{'model'} && @$disk_data){ + $drives->[$i]{'model'} = $disk_data->[0] if $disk_data->[0]; + $drives->[$i]{'vendor'} = $disk_data->[1] if $disk_data->[1]; + } + # maybe rework logic if find good scsi data example, but for now use this + elsif ($drives->[$i]{'model'} && !$drives->[$i]{'vendor'}){ + $drives->[$i]{'model'} = main::clean_disk($drives->[$i]{'model'}); + my $result = disk_vendor($drives->[$i]{'model'},''); + $drives->[$i]{'model'} = $result->[1] if $result->[1]; + $drives->[$i]{'vendor'} = $result->[0] if $result->[0]; + } + if ($working_path){ + $path = "${working_path}removable"; + if (-r $path && main::reader($path,'strip',0)){ + $drives->[$i]{'type'} = 'Removable' ; # 0/1 value + } + } + my $peripheral = peripheral_data($drives->[$i]{'id'}); + # note: we only want to update type if we found a peripheral, otherwise preserve value + $drives->[$i]{'type'} = $peripheral if $peripheral; + # print "type:$drives->[$i]{'type'}\n"; + if ($extra > 0){ + $drives->[$i]{'temp'} = hdd_temp("$drives->[$i]{'id'}"); + if ($extra > 1){ + my $speed_data = drive_speed($drives->[$i]{'id'}); + # only assign if defined / not 0 + $drives->[$i]{'speed'} = $speed_data->[0] if $speed_data->[0]; + $drives->[$i]{'lanes'} = $speed_data->[1] if $speed_data->[1]; + if (@$disk_data && $disk_data->[2]){ + $drives->[$i]{'serial'} = $disk_data->[2]; + } + else { + $path = "${working_path}serial"; + if (-r $path){ + $serial = main::reader($path,'strip',0); + $drives->[$i]{'serial'} = $serial if $serial; + } + } + if ($extra > 2 && !$drives->[$i]{'firmware'}){ + my @fm = ('rev','fmrev','firmware_rev'); # 0 ~ default; 1 ~ mmc; 2 ~ nvme + foreach my $firmware (@fm){ + $path = "${working_path}$firmware"; + if (-r $path){ + $drives->[$i]{'firmware'} = main::reader($path,'strip',0); + last; + } + } + } + } + } + if ($extra > 2){ + my $result = disk_data_advanced($pt_cmd,$drives->[$i]{'id'}); + $pt_cmd = $result->[0]; + $drives->[$i]{'partition-table'} = uc($result->[1]) if $result->[1]; + if ($result->[2]){ + $drives->[$i]{'rotation'} = $result->[2]; + $drives->[$i]{'tech'} = 'HDD'; + } + elsif (($block_type && $block_type ne 'sdx') || + # note: this case could conceivabley be wrong for a spun down HDD + (defined $result->[2] && $result->[2] eq '0') || + ($drives->[$i]{'model'} && + $drives->[$i]{'model'} =~ /(flash|mmc|msata|\bm[\.-]?2\b|nvme|ssd|solid\s?state)/i)){ + $drives->[$i]{'tech'} = 'SSD'; + } + } + } + main::log_data('dump','$drives',$drives) if $b_log; + print Data::Dumper::Dumper $drives if $dbg[24]; + eval $end if $b_log; + return $drives; +} + +# camcontrol identify |grep ^serial (this might be (S)ATA specific) +# smartcl -i |grep ^Serial +# see smartctl; camcontrol devlist; gptid status; +sub bsd_data { + eval $start if $b_log; + my ($used) = @_; + my (@drives,@softraid,@temp); + my ($i,$logical_size,$size,$working) = (0,0,0,0); + my $file = $system_files{'dmesg-boot'}; + DiskDataBSD::set() if !$loaded{'disk-data-bsd'}; + # we don't want non dboot disk data from gpart or disklabel + if ($file && ! -r $file){ + $size = main::message('dmesg-boot-permissions'); + } + elsif (!$file){ + $size = main::message('dmesg-boot-missing'); + } + elsif (%disks_bsd){ + if ($sysctl{'softraid'}){ + @softraid = map {$_ =~ s/.*\(([^\)]+)\).*/$1/;$_} @{$sysctl{'softraid'}}; + } + foreach my $id (sort keys %disks_bsd){ + next if !$disks_bsd{$id} || !$disks_bsd{$id}->{'size'}; + $drives[$i]->{'id'} = $id; + $drives[$i]->{'firmware'} = ''; + $drives[$i]->{'temp'} = ''; + $drives[$i]->{'type'} = ''; + $drives[$i]->{'vendor'} = ''; + $drives[$i]->{'block-logical'} = $disks_bsd{$id}->{'block-logical'}; + $drives[$i]->{'block-physical'} = $disks_bsd{$id}->{'block-physical'}; + $drives[$i]->{'partition-table'} = $disks_bsd{$id}->{'scheme'}; + $drives[$i]->{'serial'} = $disks_bsd{$id}->{'serial'}; + $drives[$i]->{'size'} = $disks_bsd{$id}->{'size'}; + # don't count OpenBSD RAID/CRYPTO virtual disks! + if ($drives[$i]->{'size'} && (!@softraid || !(grep {$id eq $_} @softraid))){ + $size += $drives[$i]->{'size'} if $drives[$i]->{'size'}; + } + $drives[$i]->{'spec'} = $disks_bsd{$id}->{'spec'}; + $drives[$i]->{'speed'} = $disks_bsd{$id}->{'speed'}; + $drives[$i]->{'type'} = $disks_bsd{$id}->{'type'}; + # generate the synthetic model/vendor data + $drives[$i]->{'model'} = $disks_bsd{$id}->{'model'}; + if ($drives[$i]->{'model'}){ + my $result = disk_vendor($drives[$i]->{'model'},''); + $drives[$i]->{'vendor'} = $result->[0] if $result->[0]; + $drives[$i]->{'model'} = $result->[1] if $result->[1]; + } + if ($disks_bsd{$id}->{'duid'}){ + $drives[$i]->{'duid'} = $disks_bsd{$id}->{'duid'}; + } + if ($disks_bsd{$id}->{'partition-table'}){ + $drives[$i]->{'partition-table'} = $disks_bsd{$id}->{'partition-table'}; + } + $i++; + } + # raw_logical[0] is total of all logical raid/lvm found + # raw_logical[1] is total of all components found. If this totally fails, + # and we end up with raw logical less than used, give up + if (@raw_logical && $size && $raw_logical[0] && + (!$used || $raw_logical[0] > $used)){ + $logical_size = ($size - $raw_logical[1] + $raw_logical[0]); + } + if (!$size){ + $size = main::message('data-bsd'); + } + } + my $result = [{ + 'logical-size' => $logical_size, + 'logical-free' => $raw_logical[2], + 'size' => $size, + 'used' => $used, + }]; + #main::log_data('dump','$data',\@data) if $b_log; + if ($show{'disk'}){ + push(@$result,@drives); + # print 'data:', Data::Dumper::Dumper \@data; + } + main::log_data('dump','$result',$result) if $b_log; + print Data::Dumper::Dumper $result if $dbg[24]; + eval $end if $b_log; + return $result; +} + +# return indexes: 0 - age; 1 - basic; 2 - fail +# make sure to update if fields added in smartctl_data() +sub smartctl_fields { + eval $start if $b_log; + my $data = [ + [ # age + ['smart-gsense-error-rate-ar','g-sense error rate'], + ['smart-media-wearout-a','media wearout'], + ['smart-media-wearout-t','threshold'], + ['smart-media-wearout-f','alert'], + ['smart-multizone-errors-av','write error rate'], + ['smart-multizone-errors-t','threshold'], + ['smart-udma-crc-errors-ar','UDMA CRC errors'], + ['smart-udma-crc-errors-f','alert'], + ], + [ # basic + ['smart','SMART'], + ['smart-error','SMART Message'], + ['smart-support','state'], + ['smart-status','health'], + ['smart-power-on-hours','on'], + ['smart-cycles','cycles'], + ['smart-units-read','read-units'], + ['smart-units-written','written-units'], + ['smart-read','read'], + ['smart-written','written'], + ], + [ # fail + ['smart-end-to-end-av','end-to-end'], + ['smart-end-to-end-t','threshold'], + ['smart-end-to-end-f','alert'], + ['smart-raw-read-error-rate-av','read error rate'], + ['smart-raw-read-error-rate-t','threshold'], + ['smart-raw-read-error-rate-f','alert'], + ['smart-reallocated-sectors-av','reallocated sector'], + ['smart-reallocated-sectors-t','threshold'], + ['smart-reallocated-sectors-f','alert'], + ['smart-retired-blocks-av','retired block'], + ['smart-retired-blocks-t','threshold'], + ['smart-retired-blocks-f','alert'], + ['smart-runtime-bad-block-av','runtime bad block'], + ['smart-runtime-bad-block-t','threshold'], + ['smart-runtime-bad-block-f','alert'], + ['smart-seek-error-rate-av', 'seek error rate'], + ['smart-seek-error-rate-t', 'threshold'], + ['smart-seek-error-rate-f', 'alert'], + ['smart-spinup-time-av','spin-up time'], + ['smart-spinup-time-t','threshold'], + ['smart-spinup-time-f','alert'], + ['smart-ssd-life-left-av','life left'], + ['smart-ssd-life-left-t','threshold'], + ['smart-ssd-life-left-f','alert'], + ['smart-unused-reserve-block-av','unused reserve block'], + ['smart-unused-reserve-block-t','threshold'], + ['smart-unused-reserve-block-f','alert'], + ['smart-used-reserve-block-av','used reserve block'], + ['smart-used-reserve-block-t','threshold'], + ['smart-used-reserve-block-f','alert'], + ['smart-unknown-1-a','attribute'], + ['smart-unknown-1-v','value'], + ['smart-unknown-1-w','worst'], + ['smart-unknown-1-t','threshold'], + ['smart-unknown-1-f','alert'], + ['smart-unknown-2-a','attribute'], + ['smart-unknown-2-v','value'], + ['smart-unknown-2-w','worst'], + ['smart-unknown-2-t','threshold'], + ['smart-unknown-2-f','alert'], + ['smart-unknown-3-a','attribute'], + ['smart-unknown-3-v','value'], + ['smart-unknown-3-w','worst'], + ['smart-unknown-3-t','threshold'], + ['smart-unknown-4-f','alert'], + ['smart-unknown-4-a','attribute'], + ['smart-unknown-4-v','value'], + ['smart-unknown-4-w','worst'], + ['smart-unknown-4-t','threshold'], + ['smart-unknown-4-f','alert'], + ['smart-unknown-5-f','alert'], + ['smart-unknown-5-a','attribute'], + ['smart-unknown-5-v','value'], + ['smart-unknown-5-w','worst'], + ['smart-unknown-5-t','threshold'], + ['smart-unknown-5-f','alert'], + ] + ]; + eval $end if $b_log; + return $data; +} + +sub smartctl_data { + eval $start if $b_log; + my ($data) = @_; + my ($b_attributes,$b_intel,$b_kingston,$cmd,%holder,$id,@working,@result,@split); + my ($splitter,$num,$a,$f,$r,$t,$v,$w,$y) = (':\s*',0,0,8,1,5,3,4,6); # $y is type, $t threshold, etc + for (my $i = 0; $i < scalar @$data; $i++){ + next if !$data->[$i]{'id'}; + ($b_attributes,$b_intel,$b_kingston,$splitter,$num,$a,$r) = (0,0,0,':\s*',0,0,1); + %holder = (); + # print $data->[$i]{'id'},"\n"; + # m2 nvme failed on nvme0n1 drive id: + $id = $data->[$i]{'id'}; + $id =~ s/n[0-9]+$// if $id =~ /^nvme/; + # openbsd needs the 'c' partition, which is the entire disk + $id .= 'c' if $bsd_type && $bsd_type eq 'openbsd'; + $cmd = $alerts{'smartctl'}->{'path'} . " -AHi /dev/" . $id . ' 2>/dev/null'; + @result = main::grabber($cmd, '', 'strip'); + main::log_data('dump','@result', \@result) if $b_log; # log before cleanup + @result = grep {!/^(smartctl|Copyright|==)/} @result; + print 'Drive:/dev/' . $id . ":\n", Data::Dumper::Dumper\@result if $dbg[12]; + if (scalar @result < 5){ + if (grep {/failed: permission denied/i} @result){ + $data->[$i]{'smart-permissions'} = main::message('tool-permissions','smartctl'); + } + elsif (grep {/unknown usb bridge/i} @result){ + $data->[$i]{'smart-error'} = main::message('smartctl-usb'); + } + # can come later in output too + elsif (grep {/A mandatory SMART command failed/i} @result){ + $data->[$i]{'smart-error'} = main::message('smartctl-command'); + } + elsif (grep {/open device.*Operation not supported by device/i} @result){ + $data->[$i]{'smart-error'} = main::message('smartctl-open'); + } + else { + $data->[$i]{'smart-error'} = main::message('tool-unknown-error','smartctl'); + } + next; + } + else { + foreach my $row (@result){ + if ($row =~ /^ID#/){ + $splitter = '\s+'; + $b_attributes = 1; + $a = 1; + $r = 9; + next; + } + @split = split(/$splitter/, $row); + next if !$b_attributes && ! defined $split[$r]; + # some cases where drive not in db threshhold will be: --- + # value is usually 0 padded which confuses perl. However this will + # make subsequent tests easier, and will strip off leading 0s + if ($b_attributes){ + $split[$t] = (main::is_numeric($split[$t])) ? int($split[$t]) : 0; + $split[$v] = (main::is_numeric($split[$v])) ? int($split[$v]) : 0; + } + # can occur later in output so retest it here + if ($split[$a] =~ /A mandatory SMART command failed/i){ + $data->[$i]{'smart-error'} = main::message('smartctl-command'); + } + ## DEVICE INFO ## + if ($split[$a] eq 'Device Model'){ + $b_intel = 1 if $split[$r] =~/\bintel\b/i; + $b_kingston = 1 if $split[$r] =~/kingston/i; + # usb/firewire/thunderbolt enclosure id method + if ($data->[$i]{'type'}){ + my $result = disk_vendor("$split[$r]"); + if ($data->[$i]{'model'} && $data->[$i]{'model'} ne $result->[1]){ + $data->[$i]{'drive-model'} = $result->[1]; + } + if ($data->[$i]{'vendor'} && $data->[$i]{'vendor'} ne $result->[0]){ + $data->[$i]{'drive-vendor'} = $result->[0]; + } + } + # fallback for very corner cases where primary model id failed + if (!$data->[$i]{'model'} && $split[$r]){ + my $result = disk_vendor("$split[$r]"); + $data->[$i]{'model'} = $result->[1] if $result->[1]; + $data->[$i]{'vendor'} = $result->[0] if $result->[0] && !$data->[$i]{'vendor'}; + } + } + elsif ($split[$a] eq 'Model Family'){ + my $result = disk_vendor("$split[$r]"); + $data->[$i]{'family'} = $result->[1] if $result->[1]; + # $data->[$i]{'family'} =~ s/$data->[$i]{'vendor'}\s*// if $data->[$i]{'vendor'}; + } + elsif ($split[$a] eq 'Firmware Version'){ + # 01.01A01 vs 1A01 + if ($data->[$i]{'firmware'} && $split[$r] !~ /$data->[$i]{'firmware'}/){ + $data->[$i]{'drive-firmware'} = $split[$r]; + } + elsif (!$data->[$i]{'firmware'}){ + $data->[$i]{'firmware'} = $split[$r]; + } + } + elsif ($split[$a] eq 'Rotation Rate'){ + if ($split[$r] !~ /^Solid/){ + $data->[$i]{'rotation'} = $split[$r]; + $data->[$i]{'rotation'} =~ s/\s*rpm$//i; + $data->[$i]{'tech'} = 'HDD'; + } + else { + $data->[$i]{'tech'} = 'SSD'; + } + } + elsif ($split[$a] eq 'Serial Number'){ + if (!$data->[$i]{'serial'}){ + $data->[$i]{'serial'} = $split[$r]; + } + elsif ($data->[$i]{'type'} && $split[$r] ne $data->[$i]{'serial'}){ + $data->[$i]{'drive-serial'} = $split[$r]; + } + } + elsif ($split[$a] eq 'SATA Version is'){ + if ($split[$r] =~ /SATA ([0-9.]+), ([0-9.]+ [^\s]+)(\(current: ([1-9.]+ [^\s]+)\))?/){ + $data->[$i]{'sata'} = $1; + $data->[$i]{'speed'} = $2 if !$data->[$i]{'speed'}; + } + } + # seen both Size and Sizes. Linux will usually have both, BSDs not physical + elsif ($split[$a] =~ /^Sector Sizes?$/){ + if ($data->[$i]{'type'} || !$data->[$i]{'block-logical'} || !$data->[$i]{'block-physical'}){ + if ($split[$r] =~ m|^([0-9]+) bytes logical/physical|){ + $data->[$i]{'block-logical'} = $1; + $data->[$i]{'block-physical'} = $1; + } + # 512 bytes logical, 4096 bytes physical + elsif ($split[$r] =~ m|^([0-9]+) bytes logical, ([0-9]+) bytes physical|){ + $data->[$i]{'block-logical'} = $1; + $data->[$i]{'block-physical'} = $2; + } + } + } + ## SMART STATUS/HEALTH ## + elsif ($split[$a] eq 'SMART support is'){ + if ($split[$r] =~ /^(Available|Unavailable) /){ + $data->[$i]{'smart'} = $1; + $data->[$i]{'smart'} = ($data->[$i]{'smart'} eq 'Unavailable') ? 'no' : 'yes'; + } + elsif ($split[$r] =~ /^(Enabled|Disabled)/){ + $data->[$i]{'smart-support'} = lc($1); + } + } + elsif ($split[$a] eq 'SMART overall-health self-assessment test result'){ + $data->[$i]{'smart-status'} = $split[$r]; + # seen nvme that only report smart health, not smart support + $data->[$i]{'smart'} = 'yes' if !$data->[$i]{'smart'}; + } + + ## DEVICE CONDITION: temp/read/write/power on/cycles ## + # Attributes data fields, sometimes are same syntax as info block:... + elsif ($split[$a] eq 'Power_Cycle_Count' || $split[$a] eq 'Power Cycles'){ + $data->[$i]{'smart-cycles'} = $split[$r] if $split[$r]; + } + elsif ($split[$a] eq 'Power_On_Hours' || $split[$a] eq 'Power On Hours' || + $split[$a] eq 'Power_On_Hours_and_Msec'){ + if ($split[$r]){ + $split[$r] =~ s/,//; + # trim off: h+0m+00.000s which is useless and at times empty anyway + $split[$r] =~ s/h\+.*$// if $split[$a] eq 'Power_On_Hours_and_Msec'; + # $split[$r] = 43; + if ($split[$r] =~ /^([0-9]+)$/){ + if ($1 > 9000){ + $data->[$i]{'smart-power-on-hours'} = int($1/(24*365)) . 'y ' . int($1/24)%365 . 'd ' . $1%24 . 'h'; + } + elsif ($1 > 100){ + $data->[$i]{'smart-power-on-hours'} = int($1/24) . 'd ' . $1%24 . 'h'; + } + else { + $data->[$i]{'smart-power-on-hours'} = $split[$r] . ' hrs'; + } + } + else { + $data->[$i]{'smart-power-on-hours'} = $split[$r]; + } + } + } + # 'Airflow_Temperature_Cel' like: 29 (Min/Max 14/43) so can't use -1 index + # Temperature like 29 Celsisu + elsif ($split[$a] eq 'Temperature_Celsius' || $split[$a] eq 'Temperature' || + $split[$a] eq 'Airflow_Temperature_Cel'){ + if (!$data->[$i]{'temp'} && $split[$r]){ + $data->[$i]{'temp'} = $split[$r]; + } + } + ## DEVICE USE: Reads/Writes ## + elsif ($split[$a] eq 'Data Units Read'){ + $data->[$i]{'smart-units-read'} = $split[$r]; + } + elsif ($split[$a] eq 'Data Units Written'){ + $data->[$i]{'smart-units-written'} = $split[$r]; + } + elsif ($split[$a] eq 'Host_Reads_32MiB'){ + $split[$r] = $split[$r] * 32 * 1024; + $data->[$i]{'smart-read'} = main::get_size($split[$r],'string'); + } + elsif ($split[$a] eq 'Host_Writes_32MiB'){ + $split[$r] = $split[$r] * 32 * 1024; + $data->[$i]{'smart-written'} = main::get_size($split[$r],'string'); + } + elsif ($split[$a] eq 'Lifetime_Reads_GiB'){ + $data->[$i]{'smart-read'} = $split[$r] . ' GiB'; + } + elsif ($split[$a] eq 'Lifetime_Writes_GiB'){ + $data->[$i]{'smart-written'} = $split[$r] . ' GiB'; + } + elsif ($split[$a] eq 'Total_LBAs_Read'){ + if (main::is_numeric($split[$r])){ + # blocks in bytes, so convert to KiB, the internal unit here + # reports in 32MiB units, sigh + if ($b_intel){ + $split[$r] = $split[$r] * 32 * 1024; + } + # reports in 1 GiB units, sigh + elsif ($b_kingston){ + $split[$r] = $split[$r] * 1024 * 1024; + } + # rare fringe cases, cygwin run as user, block size will not be found + # this is what it's supposed to refer to + elsif ($data->[$i]{'block-logical'}) { + $split[$r] = int($data->[$i]{'block-logical'} * $split[$r] / 1024); + } + if ($b_intel || $b_kingston || $data->[$i]{'block-logical'}){ + $data->[$i]{'smart-read'} = main::get_size($split[$r],'string'); + } + } + } + elsif ($split[$a] eq 'Total_LBAs_Written'){ + if (main::is_numeric($split[$r]) && $data->[$i]{'block-logical'}){ + # blocks in bytes, so convert to KiB, the internal unit here + # reports in 32MiB units, sigh + if ($b_intel){ + $split[$r] = $split[$r] * 32 * 1024; + } + # reports in 1 GiB units, sigh + elsif ($b_kingston){ + $split[$r] = $split[$r] * 1024 * 1024; + } + # rare fringe cases, cygwin run as user, block size will not be found + # this is what it's supposed to refer to, in byte blocks + elsif ($data->[$i]{'block-logical'}) { + $split[$r] = int($data->[$i]{'block-logical'} * $split[$r] / 1024); + } + if ($b_intel || $b_kingston || $data->[$i]{'block-logical'}){ + $data->[$i]{'smart-written'} = main::get_size($split[$r],'string'); + } + } + } + ## DEVICE OLD AGE ## + # 191 G-Sense_Error_Rate 0x0032 001 001 000 Old_age Always - 291 + elsif ($split[$a] eq 'G-Sense_Error_Rate'){ + # $data->[$i]{'smart-media-wearout'} = $split[$r]; + if ($b_attributes && $split[$r] > 100){ + $data->[$i]{'smart-gsense-error-rate-ar'} = $split[$r]; + } + } + elsif ($split[$a] eq 'Media_Wearout_Indicator'){ + # $data->[$i]{'smart-media-wearout'} = $split[$r]; + # seen case where they used hex numbers because values + # were in 47 billion range in hex. You can't hand perl an unquoted + # hex number that is > 2^32 without tripping a perl warning + if ($b_attributes && $split[$r] && !main::is_hex("$split[$r]") && $split[$r] > 0){ + $data->[$i]{'smart-media-wearout-av'} = $split[$v]; + $data->[$i]{'smart-media-wearout-t'} = $split[$t]; + $data->[$i]{'smart-media-wearout-f'} = $split[$f] if $split[$f] ne '-'; + } + } + elsif ($split[$a] eq 'Multi_Zone_Error_Rate'){ + # note: all t values are 0 that I have seen + if (($split[$v] - $split[$t]) < 50){ + $data->[$i]{'smart-multizone-errors-av'} = $split[$v]; + $data->[$i]{'smart-multizone-errors-t'} = $split[$v]; + } + + } + elsif ($split[$a] eq 'UDMA_CRC_Error_Count'){ + if (main::is_numeric($split[$r]) && $split[$r] > 50){ + $data->[$i]{'smart-udma-crc-errors-ar'} = $split[$r]; + $data->[$i]{'smart-udma-crc-errors-f'} = main::message('smartctl-udma-crc') if $split[$r] > 500; + } + } + + ## DEVICE PRE-FAIL ## + elsif ($split[$a] eq 'Available_Reservd_Space'){ + # $data->[$i]{'smart-available-reserved-space'} = $split[$r]; + if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){ + $data->[$i]{'smart-available-reserved-space-av'} = $split[$v]; + $data->[$i]{'smart-available-reserved-space-t'} = $split[$t]; + $data->[$i]{'smart-available-reserved-space-f'} = $split[$f] if $split[$f] ne '-'; + } + } + ## nvme splits these into two field/value sets + elsif ($split[$a] eq 'Available Spare'){ + $split[$r] =~ s/%$//; + $holder{'spare'} = int($split[$r]) if main::is_numeric($split[$r]); + } + elsif ($split[$a] eq 'Available Spare Threshold'){ + $split[$r] =~ s/%$//; + if ($holder{'spare'} && main::is_numeric($split[$r]) && $split[$r]/$holder{'spare'} > 0.92){ + $data->[$i]{'smart-available-reserved-space-ar'} = $holder{'spare'}; + $data->[$i]{'smart-available-reserved-space-t'} = int($split[$r]); + } + } + elsif ($split[$a] eq 'End-to-End_Error'){ + if ($b_attributes && int($split[$r]) > 0 && $split[$t]){ + $data->[$i]{'smart-end-to-end-av'} = $split[$v]; + $data->[$i]{'smart-end-to-end-t'} = $split[$t]; + $data->[$i]{'smart-end-to-end-f'} = $split[$f] if $split[$f] ne '-'; + } + } + # seen raw value: 0/8415644 + elsif ($split[$a] eq 'Raw_Read_Error_Rate'){ + if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){ + $data->[$i]{'smart-raw-read-error-rate-av'} = $split[$v]; + $data->[$i]{'smart-raw-read-error-rate-t'} = $split[$t]; + $data->[$i]{'smart-raw-read-error-rate-f'} = $split[$f] if $split[$f] ne '-'; + } + } + elsif ($split[$a] eq 'Reallocated_Sector_Ct'){ + if ($b_attributes && int($split[$r]) > 0 && $split[$t]){ + $data->[$i]{'smart-reallocated-sectors-av'} = $split[$v]; + $data->[$i]{'smart-reallocated-sectors-t'} = $split[$t]; + $data->[$i]{'smart-reallocated-sectors-f'} = $split[$f] if $split[$f] ne '-'; + } + } + elsif ($split[$a] eq 'Retired_Block_Count'){ + if ($b_attributes && int($split[$r]) > 0 && $split[$t]){ + $data->[$i]{'smart-retired-blocks-av'} = $split[$v]; + $data->[$i]{'smart-retired-blocks-t'} = $split[$t]; + $data->[$i]{'smart-retired-blocks-f'} = $split[$f] if $split[$f] ne '-'; + } + } + elsif ($split[$a] eq 'Runtime_Bad_Block'){ + if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){ + $data->[$i]{'smart-runtime-bad-block-av'} = $split[$v]; + $data->[$i]{'smart-runtime-bad-block-t'} = $split[$t]; + $data->[$i]{'smart-runtime-bad-block-f'} = $split[$f] if $split[$f] ne '-'; + } + } + elsif ($split[$a] eq 'Seek_Error_Rate'){ + # value 72; threshold either 000 or 30 + if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){ + $data->[$i]{'smart-seek-error-rate-av'} = $split[$v]; + $data->[$i]{'smart-seek-error-rate-t'} = $split[$t]; + $data->[$i]{'smart-seek-error-rate-f'} = $split[$f] if $split[$f] ne '-'; + } + } + elsif ($split[$a] eq 'Spin_Up_Time'){ + # raw will always be > 0 on spinning disks + if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){ + $data->[$i]{'smart-spinup-time-av'} = $split[$v]; + $data->[$i]{'smart-spinup-time-t'} = $split[$t]; + $data->[$i]{'smart-spinup-time-f'} = $split[$f] if $split[$f] ne '-'; + } + } + elsif ($split[$a] eq 'SSD_Life_Left'){ + # raw will always be > 0 on spinning disks + if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){ + $data->[$i]{'smart-ssd-life-left-av'} = $split[$v]; + $data->[$i]{'smart-ssd-life-left-t'} = $split[$t]; + $data->[$i]{'smart-ssd-life-left-f'} = $split[$f] if $split[$f] ne '-'; + } + } + elsif ($split[$a] eq 'Unused_Rsvd_Blk_Cnt_Tot'){ + # raw will always be > 0 on spinning disks + if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){ + $data->[$i]{'smart-unused-reserve-block-av'} = $split[$v]; + $data->[$i]{'smart-unused-reserve-block-t'} = $split[$t]; + $data->[$i]{'smart-unused-reserve-block-f'} = $split[$f] if $split[$f] ne '-'; + } + } + elsif ($split[$a] eq 'Used_Rsvd_Blk_Cnt_Tot'){ + # raw will always be > 0 on spinning disks + if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){ + $data->[$i]{'smart-used-reserve-block-av'} = $split[$v]; + $data->[$i]{'smart-used-reserve-block-t'} = $split[$t]; + $data->[$i]{'smart-used-reserve-block-f'} = $split[$f] if $split[$f] ne '-'; + } + } + elsif ($b_attributes){ + if ($split[$y] eq 'Pre-fail' && ($split[$f] ne '-' || + ($split[$t] && $split[$v] && $split[$t]/$split[$v] > 0.92))){ + $num++; + $data->[$i]{'smart-unknown-' . $num . '-a'} = $split[$a]; + $data->[$i]{'smart-unknown-' . $num . '-v'} = $split[$v]; + $data->[$i]{'smart-unknown-' . $num . '-w'} = $split[$v]; + $data->[$i]{'smart-unknown-' . $num . '-t'} = $split[$t]; + $data->[$i]{'smart-unknown-' . $num . '-f'} = $split[$f] if $split[$f] ne '-'; + } + } + } + } + } + print Data::Dumper::Dumper $data if $dbg[19]; + eval $end if $b_log; +} + +# check for usb/firewire/[and thunderbolt when data found] +sub peripheral_data { + eval $start if $b_log; + my ($id) = @_; + my ($type) = (''); + # print "$id here\n"; + if (@by_id){ + foreach (@by_id){ + if ("/dev/$id" eq Cwd::abs_path($_)){ + # print "$id here\n"; + if (/usb-/i){ + $type = 'USB'; + } + elsif (/ieee1394-/i){ + $type = 'FireWire'; + } + last; + } + } + } + # note: sometimes with wwn- numbering usb does not appear in by-id but it does in by-path + if (!$type && @by_path){ + foreach (@by_path){ + if ("/dev/$id" eq Cwd::abs_path($_)){ + if (/usb-/i){ + $type = 'USB'; + } + elsif (/ieee1394--/i){ + $type = 'FireWire'; + } + last; + } + } + } + eval $end if $b_log; + return $type; +} + +sub disk_data_advanced { + eval $start if $b_log; + my ($set_cmd,$id) = @_; + my ($cmd,$pt,$program,@data); + my $advanced = []; + if ($set_cmd ne 'unset'){ + $advanced->[0] = $set_cmd; + } + else { + # runs as user, but is SLOW: udisksctl info -b /dev/sda + # line: org.freedesktop.UDisks2.PartitionTable: + # Type: dos + if ($program = main::check_program('udevadm')){ + $advanced->[0] = "$program info -q property -n "; + } + elsif ($b_root && -e "/lib/udev/udisks-part-id"){ + $advanced->[0] = "/lib/udev/udisks-part-id /dev/"; + } + elsif ($b_root && ($program = main::check_program('fdisk'))){ + $advanced->[0] = "$program -l /dev/"; + } + if (!$advanced->[0]){ + $advanced->[0] = 'na' + } + } + if ($advanced->[0] ne 'na'){ + $cmd = "$advanced->[0]$id 2>&1"; + main::log_data('cmd',$cmd) if $b_log; + @data = main::grabber($cmd); + # for pre ~ 2.30 fdisk did not show gpt, but did show gpt scheme error, so + # if no gpt match, it's dos = mbr + if ($cmd =~ /fdisk/){ + foreach (@data){ + if (/^WARNING:\s+GPT/){ + $advanced->[1] = 'gpt'; + last; + } + elsif (/^Disklabel\stype:\s*(.+)/i){ + $advanced->[1] = $1; + last; + } + } + $advanced->[1] = 'dos' if !$advanced->[1]; + } + else { + foreach (@data){ + if (/^(UDISKS_PARTITION_TABLE_SCHEME|ID_PART_TABLE_TYPE)/){ + my @working = split('=', $_); + $advanced->[1] = $working[1]; + } + elsif (/^ID_ATA_ROTATION_RATE_RPM/){ + my @working = split('=', $_); + $advanced->[2] = $working[1]; + } + last if defined $advanced->[1] && defined $advanced->[2]; + } + } + $advanced->[1] = 'mbr' if $advanced->[1] && lc($advanced->[1]) eq 'dos'; + } + eval $end if $b_log; + return $advanced; +} + +sub scsi_data { + eval $start if $b_log; + my ($file) = @_; + my @temp = main::reader($file); + my $scsi = []; + my ($firmware,$model,$vendor) = ('','',''); + foreach (@temp){ + if (/Vendor:\s*(.*)\s+Model:\s*(.*)\s+Rev:\s*(.*)/i){ + $vendor = $1; + $model = $2; + $firmware = $3; + } + if (/Type:/i){ + if (/Type:\s*Direct-Access/i){ + push(@$scsi, { + 'vendor' => $vendor, + 'model' => $model, + 'firmware' => $firmware, + }); + } + else { + ($firmware,$model,$vendor) = ('','',''); + } + } + } + main::log_data('dump','@$scsi', $scsi) if $b_log; + eval $end if $b_log; + return $scsi; +} + +# @b_id has already been cleaned of partitions, wwn-, nvme-eui +sub disk_data_by_id { + eval $start if $b_log; + my ($device) = @_; + my ($model,$serial,$vendor) = ('','',''); + my $disk_data = []; + foreach (@by_id){ + if ($device eq Cwd::abs_path($_)){ + my @data = split('_', $_); + last if scalar @data < 2; # scsi-3600508e000000000876995df43efa500 + $serial = pop @data if @data; + # usb-PNY_USB_3.0_FD_3715202280-0:0 + $serial =~ s/-[0-9]+:[0-9]+$//; + $model = join(' ', @data); + # get rid of the ata-|nvme-|mmc- etc + $model =~ s/^\/dev\/disk\/by-id\/([^-]+-)?//; + $model = main::clean_disk($model); + my $result = disk_vendor($model,$serial); + $vendor = $result->[0] if $result->[0]; + $model = $result->[1] if $result->[1]; + # print $device, '::', Cwd::abs_path($_),'::', $model, '::', $vendor, '::', $serial, "\n"; + @$disk_data = ($model,$vendor,$serial); + last; + } + } + eval $end if $b_log; + return $disk_data; +} + +## START DISK VENDOR BLOCK ## +# 0 - match pattern; 1 - replace pattern; 2 - vendor print; 3 - serial pattern +sub set_disk_vendors { + eval $start if $b_log; + $vendors = [ + ## MOST LIKELY/COMMON MATCHES ## + ['(Crucial|^(C[34]00$|(C300-)?CTF|(FC)?CT|DDAC|M4(\b|SSD))|-CT|Gizmo!)','Crucial','Crucial',''], + # H10 HBRPEKNX0202A NVMe INTEL 512GB + ['(\bINTEL\b|^(SSD(PAM|SA2)|HBR|(MEM|SSD)PEB?K|SSD(MCE|S[AC])))','\bINTEL\b','Intel',''], + ['^(Intel[\s_-]?)?SRCSAS?','^Intel','Intel RAID',''], + # note: S[AV][1-9]\d can trigger false positives + ['(K(ING)?STON|^(A400|ASTC|OM8P|RBU|S100\d\d|S[AV][1234]00|S[HMN]S|SK[CY]|SQ5|SS200|SVP|SS0|SUV|SNV|T52|T[ABY]29|Y29\d|Ultimate CF)|V100|DataTraveler|DT\s?(DUO|Microduo|101)|HyperX|13fe\b)','(KINGSTON|13fe)','Kingston',''], # maybe SHS: SHSS37A SKC SUV + # must come before samsung MU. NOTE: toshiba can have: TOSHIBA_MK6475GSX: mush: MKNSSDCR120GB_ + ['(^MKN|Mushkin)','Mushkin','Mushkin',''], # MKNS + # MU = Multiple_Flash_Reader too risky: |M[UZ][^L] HD103SI HD start risky + # HM320II HM320II HM + ['(SAMSUNG|^(AGN[BD]|AWMB|[BC]DS20|[BCD]WB|BJ[NT]|[BC]GND|CJ[NT]|CKT|CUT|[DG]3 Station|DUO\b|DUT|EB\dMW|E[CS]\d[A-Z]\d|ED2|EE4|FD\d[A-Z]\d|[GS]2 Portable|GE4|GN|HD\d{3}[A-Z]{2}$|(HM|SP)\d{2}|HS\d|KLUD|M[AB]G\d[FG]|MCC|MCBOE|MCG\d+GC|[CD]JN|MZ|^G[CD][1-9][QS]|P[BM]\d|(SSD\s?)?SM\s?841)|^SSD\s?[89]\d{2}\s(DCT|PRO|QVD|\d+[GT]B)|\bEVO\b|SV\d|[BE][A-Z][1-9]QT|YP\b|[CH]N-M|MMC[QR]E)','SAMSUNG','Samsung',''], # maybe ^SM, ^HM + # Android UMS Composite?U1 + ['(SanDisk|0781|^(A[BCD]LC[DE]|AFGCE|D[AB]4|DX[1-9]|Extreme|EZSD|Firebird|S[CD]\d{2}G|SB\d+G|SC\d{3,4}|SD(CF|S[S]?[ADQ]|SL\d+G|SU\d|U\d|\sUltra)|SDW[1-9]|SE\d{2}|SEM\d{2}|\d[STU]|U(3\b|1\d0))|Clip Sport|Cruzer|iXpand|SN(\d+G|128|256)|SSD (Plus|U1[01]0) [1-9]|SU(02|04|08|16|32|64)G|ULTRA\s(FIT|trek|II)|^X[1-6]\d{2})','(SanDisk|0781)','SanDisk',''], + # these are HP/Sandisk cobranded. DX110064A5xnNMRI ids as HP and Sandisc + ['(^DX[1-9])','^(HP\b|SANDDISK)','Sandisk/HP',''], # ssd drive, must come before seagate ST test + # real, SSEAGATE Backup+; XP1600HE30002 | 024 HN (spinpoint) ; possible usb: 24AS + # ST[numbers] excludes other ST starting devices + ['([S]?SEAGATE|^((Barra|Fire)Cuda|BUP|EM\d{3}|Expansion|(ATA\s|HDD\s)?ST\d{2}|5AS|X[AFP])|Backup(\+|\s?Plus)\s?(Hub)?|DS2\d|Expansion Desk|FreeAgent|GoFlex|INIC|IronWolf|OneTouch|Slim\s?BK)','[S]?SEAGATE','Seagate',''], + ['^(WD|WL[0]9]|Western Digital|My (Book|Passport)|\d*LPCX|Elements|easystore|EA[A-Z]S|EARX|EFRX|EZRX|\d*EAVS|G[\s-]Drive|i HTS|0JD|JP[CV]|MD0|M000|\d+(BEV|(00)?AAK|AAV|AZL|EA[CD]S)|PC\sSN|SN530|SPZX|3200[AB]|2500[BJ]|20G2|5000[AB]|6400[AB]|7500[AB]|00[ABL][A-Z]{2}|SSC\b)','(^WDC|Western\s?Digital)','Western Digital',''], + # rare cases WDC is in middle of string + ['(\bWDC\b|1002FAEX)','','Western Digital',''], + + ## THEN BETTER KNOWN ONES ## + ['^(AccelStor|GS\d{3,})','^AccelStor','AccelStor',''], + ['^Acer','^Acer','Acer',''], + # A-Data can be in middle of string + ['^(.*\bA-?DATA|ASP\d|AX[MN]|CH11|FX63|HV[1-9]|IM2|HD[1-9]|HDD\s?CH|IUM|SX\d|Swordfish)','A-?DATA','A-Data',''], + ['^(ASUS|ROG)','^ASUS','ASUS',''], # ROG ESD-S1C + # ATCS05 can be hitachi travelstar but not sure + ['^ATP','^ATP\b','ATP',''], + ['^(BlueRay|SSD\d+GM)','^BlueRay','BlueRay',''], + # Force MP500 + ['^(Corsair|Force\s|(Flash\s*)?(Survivor|Voyager)|Neutron|Padlock)','^Corsair','Corsair',''], + ['^(FUJITSU|MJA|MH[RTVWYZ]\d|MP|MAP\d|F\d00s?-)','^FUJITSU','Fujitsu',''], + # MAB3045SP shows as HP or Fujitsu, probably HP branded fujitsu + ['^(MAB\d)','^(HP\b|FUJITSU)','Fujitsu/HP',''], + # note: 2012: wdc bought hgst + ['^(DKR|HGST|Touro|54[15]0|7250|HC[CT]\d)','^HGST','HGST (Hitachi)',''], # HGST HUA + ['^((ATA\s)?Hitachi|HCS|HD[PST]|DK\d|IC|(HDD\s)?HT|HU|HMS|HDE|0G\d|IHAT)','Hitachi','Hitachi',''], + # vb: VB0250EAVER but clashes with vbox; HP_SSD_S700_120G ;GB0500EAFYL GB starter too generic? + ['^(HP\b|c350|DF\d|EG0\d{3}|EX9\d\d|G[BJ]\d|F[BK]|0-9]|HC[CPY]\d|MM\d{4}|[MV]B[0-6]|PSS|VO0|VK0|v\d{3}[bgorw]$|x\d{3}[w]$|XR\d{4})','^HP','HP',''], + ['^(Lexar|LSD|JumpDrive|JD\s?Firefly|LX\d|NCard|ND\d+GB|WorkFlow)','^Lexar','Lexar',''], # mmc-LEXAR_0xb016546c; JD Firefly; + # these must come before maxtor because STM + ['^STmagic','^STmagic','STmagic',''], + ['^(STMicro|SMI|CBA)','^(STMicroelectronics|SMI)','SMI (STMicroelectronics)',''], + # note M2 M3 is usually maxtor, but can be samsung. Can conflict with Team: TM\d{4}| + ['^(MAXTOR|Atlas|4R\d{2}|E0\d0L|L(250|500)|[KL]0[1-9]|Y\d{3}[A-Z]|STM\d|F\d{3}L)','^MAXTOR','Maxtor',''], + # OCZSSD2-2VTXE120G is OCZ-VERTEX2_3.5 + ['^(OCZ|Agility|APOC|D2|DEN|DEN|DRSAK|EC188|FTNC|GFGC|MANG|MMOC|NIMC|NIMR|PSIR|RALLY2|TALOS2|TMSC|TRSAK|VERTEX|Trion|Onyx|Vector[\s-]?15)','^OCZ[\s-]','OCZ',''], + ['^(OWC|Aura|Mercury[\s-]?(Electra|Extreme))','^OWC\b','OWC',''], + ['^(Philips|GoGear)','^Philips','Philips',''], + ['^PIONEER','^PIONEER','Pioneer',''], + ['^(PNY|Hook\s?Attache|SSD2SC|(SSD7?)?EP7|CS\d{3}|Elite\s?P)','^PNY\s','PNY','','^PNY'], + # note: get rid of: M[DGK] becasue mushkin starts with MK + # note: seen: KXG50ZNV512G NVMe TOSHIBA 512GB | THNSN51T02DUK NVMe TOSHIBA 1024GB + ['(TOSHIBA|TransMemory|KBG4|^((A\s)?DT01A|M[GKQ]\d|HDW|SA\d{2}G$|(008|016|032|064|128)G[379E][0-9A]$|[S]?TOS|THN)|0930|KSG\d)','S?(TOSHIBA|0930)','Toshiba',''], # scsi-STOSHIBA_STOR.E_EDITION_ + + ## LAST: THEY ARE SHORT AND COULD LEAD TO FALSE ID, OR ARE UNLIKELY ## + # unknown: AL25744_12345678; ADP may be usb 2.5" adapter; udisk unknown: Z1E6FTKJ 00AAKS + # SSD2SC240G726A10 MRS020A128GTS25C EHSAJM0016GB + ['^2[\s-]?Power','^2[\s-]?Power','2-Power',''], + ['^(3ware|9650SE)','^3ware','3ware (controller)',''], + ['^5ACE','^5ACE','5ACE',''], # could be seagate: ST316021 5ACE + ['^51RISC','^51RISC','51risc',''], + ['^(Aar(vex)?|AX\d{2})','^AARVEX','AARVEX',''], + ['^(AbonMax|ASU\d)','^AbonMax','AbonMax',''], + ['^Acasis','^Acasis','Acasis (hub)',''], + ['^Acclamator','^Acclamator','Acclamator',''], + ['^(Actions|HS USB Flash|10d6)','^(Actions|10d6)','Actions',''], + ['^(A-?DATA|ED\d{3}|NH01|Swordfish|SU\d{3}|SX\d{3}|XM\d{2})','^A-?DATA','ADATA',''], + ['^Addlink','^Addlink','Addlink',''], + ['^(ADplus|SuperVer\b)','^ADplus','ADplus',''], + ['^ADTRON','^ADTRON','Adtron',''], + ['^(Advantech|SQF)','^Advantech','Advantech',''], + ['^AEGO','^AEGO','AEGO',''], + ['^AFOX','^AFOX','AFOX',''], + ['^AFTERSHOCK','^AFTERSHOCK','AFTERSHOCK',''], + ['^(Agile|AGI)','^(AGI|Agile\s?Gear\s?Int[a-z]*)','AGI',''], + ['^Aigo','^Aigo','Aigo',''], + ['^AirDisk','^AirDisk','AirDisk',''], + ['^Aireye','^Aireye','Aireye',''], + ['^AiteFeir','^AiteFeir','AiteFeir',''], + ['^Alcatel','^Alcatel','Alcatel',''], + ['^(Alcor(\s?Micro)?|058F)','^(Alcor(\s?Micro)?|058F)','Alcor Micro',''], + ['^Alfawise','^Alfawise','Alfawise',''], + ['(^ALKETRON|FireWizard)','^ALKETRON','ALKETRON',''], + ['^ANACOMDA','^ANACOMDA','ANACOMDA',''], + ['^Android','^Android','Android',''], + ['^ANK','^Anker','Anker',''], + ['^Ant[\s_-]?Esports','^Ant[\s_-]?Esports','Ant Esports',''], + ['^Anucell','^Anucell','Anucell',''], + ['^Aoluska','^Aoluska','Aoluska',''], + ['^(Aotec|AOK)','^Aotec','Aotec',''], + ['^Apotop','^Apotop','Apotop',''], + # must come before AP|Apacer + ['^(APPLE|iPod|SSD\sSM\d+[CEGT])','^APPLE','Apple',''], + ['^(AP|Apacer)','^Apacer','Apacer',''], + ['^(Apricom|SATAWire)','^Apricom','Apricom',''], + ['^(A-?RAM|ARSSD)','^A-?RAM','A-RAM',''], + ['^Arch','^Arch(\s*Memory)?','Arch Memory',''], + ['(Ardor|\bAlly\b|\bAL\d\d)','Ardor(\sGaming)?','Ardor Gaming',''], + ['^(Asenno|AS[1-9])','^Asenno','Asenno',''], + ['^Asgard','^Asgard','Asgard',''], + ['^ASint','^ASint','ASint',''], + ['^(ASL|\d+[A-Z]{1,2}\d+-ASL\b)','^ASL','ASL',''], # 99IB3321-ASL + ['^(ASM|2115)','^ASM','ASMedia',''],#asm1153e + ['^ASolid','^ASolid','ASolid',''], + # ASTC (Advanced Storage Technology Consortium) + ['^(AVEXIR|AVSSD)','^AVEXIR','Avexir',''], + ['^Axiom','^Axiom','Axiom',''], + ['^(Baititon|BT\d)','^Baititon','Baititon',''], + ['^Bamba','^Bamba','Bamba',''], + ['^(Beckhoff)','^Beckhoff','Beckhoff',''], + ['^Bell\b','^Bell','Packard Bell',''], + ['^(BelovedkaiAE|GhostPen)','^BelovedkaiAE','BelovedkaiAE',''], + ['^BHM\b','^BHM','BHM',''], + ['^(BHT|WR20)','^BHT','BHT',''], + ['^(Big\s?Reservoir|B[RG][_\s-])','^Big\s?Reservoir','Big Reservoir',''], + ['^BIOSTAR','^BIOSTAR','Biostar',''], + ['^BIWIN','^BIWIN','BIWIN',''], + ['^Blackpcs','^Blackpcs','Blackpcs',''], + ['^(BlitzWolf|BW-?PSSD)','^BlitzWolf','BlitzWolf',''], + ['^(BlueCase|BS2N\d)','^BlueCase[\s-]?(Horizon)?','BlueCase Horizon',''], + ['^(Blue[\s-]?Feather|BF\d)','^Blue[\s-]?Feather','Blue Feather',''], + ['^(BlueRay|SDM\d)','^BlueRay','BlueRay',''], + ['^Bory','^Bory','Bory',''], + ['^Braveeagle','^Braveeagle','BraveEagle',''], + ['^(BUFFALO|BSC)','^BUFFALO','Buffalo',''], # usb: BSCR05TU2 + ['^Bugatek','^Bugatek','Bugatek',''], + ['^Bulldozer','^Bulldozer','Bulldozer',''], + ['^BUSlink','^BUSlink','BUSlink',''], + ['^(Canon|MP49)','^Canon','Canon',''], + ['^Centerm','^Centerm','Centerm',''], + ['^(Centon|DS pro)','^Centon','Centon',''], + ['^(CFD|CSSD)','^CFD','CFD',''], + ['^CHIPAL','^CHIPAL','CHIPAL',''], + ['^(Chipsbank|CHIPSBNK)','^Chipsbank','Chipsbank',''], + ['^(Chipfancie)','^Chipfancier','Chipfancier',''], + ['\bCKS','\bCKS','CKS',''], + ['^Clover','^Clover','Clover',''], + ['^Codeo','^Codeo','Codeo',''], + ['^CODi','^CODi','CODi',''], + ['^Colorful\b','^Colorful','Colorful',''], + ['^CONSISTENT','^CONSISTENT','Consistent',''], + # note: www.cornbuy.com is both a brand and also sells other brands, like newegg + # addlink; colorful; goldenfir; kodkak; maxson; netac; teclast; vaseky + ['^Corn','^Corn','Corn',''], + ['^CnMemory|Spaceloop','^CnMemory','CnMemory',''], + ['^(Creative|(Nomad\s?)?MuVo)','^Creative','Creative',''], + ['^CSD','^CSD','CSD',''], + ['^CYX\b','^CYX','CYX',''], + ['^(Dane-?Elec|Z Mate)','^Dane-?Elec','DaneElec',''], + ['^DATABAR','^DATABAR','DataBar',''], + # Daplink vfs is an ARM software thing + ['^(Data\s?Memory\s?Systems|DMS)','^Data\s?Memory\s?Systems','Data Memory Systems',''], + ['^Dataram','^Dataram','Dataram',''], + ['^DELAIHE','^DELAIHE','DELAIHE',''], + # DataStation can be Trekstore or I/O gear + ['^Dell\b','^Dell','Dell',''], + ['^DeLOCK','^Delock(\s?products)?','Delock',''], + ['^Derler','^Derler','Derler',''], + ['^detech','^detech','DETech',''], + ['^DEXP','^DEXP','DEXP',''], + ['^DGM','^DGM\b','DGM',''], + ['^(DICOM|MAESTRO)','^DICOM','DICOM',''], + ['^Digifast','^Digifast','Digifast',''], + ['^(DIGIRICH|DGSSD)','^DIGIRICH','DIGIRICH',''], + ['^DIGITAL\s?FILM','DIGITAL\s?FILM','Digital Film',''], + ['(Digma|\bRun\s)','\bDigma','Digma',''], + ['^Dikom','^Dikom','Dikom',''], + ['^DINGGE','^DINGGE','DINGGE',''], + ['^Disain','^Disain','Disain',''], + ['^(Disco|Go-Infinity)','^Disco','Disco',''], + ['^(Disk2go|Three[\s_-]?O)','^Disk2go','Disk2go',''], + ['^(Disney|PIX[\s]?JR)','^Disney','Disney',''], + ['^(Doggo|DQ-|Sendisk|Shenchu)','^(doggo|Sendisk(.?Shenchu)?|Shenchu(.?Sendisk)?)','Doggo (SENDISK/Shenchu)',''], + ['^(Dogfish|M\.2 2242|Shark)','^Dogfish(\s*Technology)?','Dogfish Technology',''], + ['^DragonDiamond','^DragonDiamond','DragonDiamond',''], + ['^(DREVO\b|X1\s\d+[GT])','^DREVO','Drevo',''], + ['^Drobo','^Drobo','Drobo',''], + ['^DSS','^DSS DAHUA','DSS DAHUA',''], + ['^(Duex|DX\b)','^Duex','Duex',''], # DX\d may be starter for sandisk string + ['^(Dynabook|AE[1-3]00)','^Dynabook','Dynabook',''], + # DX1100 is probably sandisk, but could be HP, or it could be hp branded sandisk + ['^(Eaget|V8$)','^Eaget','Eaget',''], + ['^(Easy[\s-]?Memory|EYM\d)','^Easy[\s-]?Memory','Easy Memory',''], + ['^EDGE','^EDGE','EDGE Tech',''], + ['^(EDILOCA|ES\d+\b)','^EDILOCA','Ediloca',''], + ['^Elecom','^Elecom','Elecom',''], + ['^Eluktro','^Eluktronics','Eluktronics',''], + ['^Emperor','^Emperor','Emperor',''], + ['^Emtec','^Emtec','Emtec',''], + ['^ENE\b','^ENE','ENE',''], + ['^Energy','^Energy','Energy',''], + ['^eNova','^eNOVA','eNOVA',''], + ['^Epson','^Epson','Epson',''], + ['^(Etelcom|SSD051)','^Etelcom','Etelcom',''], + ['^(Shenzhen\s)?Etopso(\sTechnology)?','^(Shenzhen\s)?Etopso(\sTechnology)?','Etopso',''], + ['^EURS','^EURS','EURS',''], + ['^eVAULT','^eVAULT','eVAULT',''], + ['\bEVM','\bEVM','EVM',''], + ['^eVtran','^eVtran','eVtran',''], + ['\bExbom','^\bExbom','Exbom',''], + ['^(ExeGate|EX\d\d)','^ExeGate','ExeGate',''], + # NOTE: ESA3... may be IBM PCIe SAD card/drives + ['^(EXCELSTOR|r technology)','^EXCELSTOR( TECHNO(LOGY)?)?','ExcelStor',''], + ['^EXRAM','^EXRAM','EXRAM',''], + ['^EYOTA','^EYOTA','EYOTA',''], + ['^EZCOOL','^EZCOOL','EZCOOL',''], + ['^EZLINK','^EZLINK','EZLINK',''], + ['^Fantom','^Fantom( Drive[s]?)?','Fantom Drives',''], + ['^Fanxiang','^Fanxiang','Fanxiang',''], + ['^(Faspeed|K3[\s-])','^Faspeed','Faspeed',''], + ['^FASTDISK','^FASTDISK','FASTDISK',''], + ['^Festtive','^Festtive','Festtive',''], + ['^FiiO','^FiiO','FiiO',''], + ['^FixMeStick','^FixMeStick','FixMeStick',''], + ['^(FIKWOT|FS\d{3})','^FIKWOT','Kikwot',''], + ['^FNK[\s-]?TECH','^FNK[\s-]?TECH','FNK Tech',''], + ['^Fordisk','^Fordisk','Fordisk',''], + # FK0032CAAZP/FB160C4081 FK or FV can be HP but can be other things + ['^(FORESEE|B[123]0)|P900F|S900M','^FORESEE','Foresee',''], + ['^Founder','^Founder','Founder',''], + ['^(FOXIN|FX\d\d)','^FOXIN','FOXIN',''], + ['^(FOXLINE|FLD)','^FOXLINE','Foxline',''], # russian vendor? + ['^(Gateway|W800S)','^Gateway','Gateway',''], + ['^Freecom','^Freecom(\sFreecom)?','Freecom',''], + ['^(FronTech)','^FronTech','Frontech',''], + ['^(Fuhler|FL-D\d{3})','^Fuhler','Fuhler',''], + ['^(FuturePath|FPT)','^FuturePath([\s-]?Technologies)?','FuturePath',''], + ['^Gaiver','^Gaiver','Gaiver',''], + ['^(GALAX\b|Gamer\s?L|TA\dD|Gamer[\s-]?V)','^GALAX','GALAX',''], + ['^Galaxy\b','^Galaxy','Galaxy',''], + ['^Gamer[_\s-]?Black','^Gamer[_\s-]?Black','Gamer Black',''], + ['^(Garmin|Fenix|Nuvi|Zumo)','^Garmin','Garmin',''], + ['^Geil','^Geil','Geil',''], + ['^GelL','^GelL','GelL',''], # typo for Geil? GelL ZENITH R3 120GB + ['^(GemiBook|G52)','^GemiBook','GemiBook',''], + ['^(Generic|58A4|58K7|A3A|G1J3|M0S00|SCA\d{2}|SCY|SLD|S0J\d|UY[567])','^Generic','Generic',''], + ['^(Genesis(\s?Logic)?|05e3)','(Genesis(\s?Logic)?|05e3)','Genesis Logic',''], + ['^Geonix','^Geonix','Geonix',''], + ['^(Gerffins)','^Gerffins','Gerffins',''], + ['^Getrich','^Getrich','Getrich',''], + ['^(Gigabyte|GP-G)','^Gigabyte','Gigabyte',''], # SSD + ['^Gigastone','^Gigastone','Gigastone',''], + ['^Gigaware','^Gigaware','Gigaware',''], + ['^GJN','^GJN\b','GJN',''], + ['^(Global[\s-]?Memory)','Global[\s-]?Memory','Global Memory',''], + ['^(Gloway|FER\d)','^Gloway','Gloway',''], + ['^GLOWY','^GLOWY','Glowy',''], + ['^Goldendisk','^Goldendisk','Goldendisk',''], + ['^Goldenfir','^Goldenfir','Goldenfir',''], + ['^(Goldkey|GKH\d)','^Goldkey','Goldkey',''], + ['^Golden[\s_-]?Memory','^Golden[\s_-]?Memory','Golden Memory',''], + ['^(Goldkey|GKP)','^Goldkey','GoldKey',''], + ['^(Goline)','^Goline','Goline',''], + # Wilk Elektronik SA, poland + ['^((Wilk|WE)\s*)?(GOODRAM|GOODDRIVE|IR[\s-]?SSD|IRP|SSDPR|Iridium)','^GOODRAM','GOODRAM',''], + ['^(Gost)','^Gost','Gost',''], + ['^(GreatWall|GW\d{3})','^GreatWall','GreatWall',''], + ['^(GreenHouse|GH\b)','^GreenHouse','GreenHouse',''], + ['^Gritronix','^Gritronixx?','Gritronix',''], + # supertalent also has FM: |FM + ['^(G[\.]?SKILL)','^G[\.]?SKILL','G.SKILL',''], + ['^G[\s-]*Tech','^G[\s-]*Tech(nology)?','G-Technology',''], + ['\b(GTL|XEON)','\bGTL\b','GTL',''], + ['^(Gudga|GIM\d+|G[NV](R\d|\d{2,4}\b)|GS-?\d\d)','^Gudga','Gudga',''], + ['^(Hajaan|HS[1-9])','^Haajan','Haajan',''], + ['^Haizhide','^Haizhide','Haizhide',''], + ['^(Hama|FlashPen\s?Fancy)','^Hama','Hama',''], + ['^(Hanye|Q60)','^Hanye','Hanye',''], + ['^HDC','^HDC\b','HDC',''], + ['^Hectron','^Hectron','Hectron',''], + ['^HEMA','^HEMA','HEMA',''], + ['(HEORIADY|^HX-0)','^HEORIADY','HEORIADY',''], + ['^(Heovose)','^Heovose','Heovose',''], + ['^(Hikvision|HKVSN|HS-SSD)','^Hikvision','Hikvision',''], + ['^Hi[\s-]?Level ','^Hi[\s-]?Level ','Hi-Level',''], # ^HI\b with no Level? + ['^(Hisense|H8G)','^Hisense','Hisense',''], + ['^(HJDK|MHD)','^HJDK','HJDK',''], + ['^(HMZM)','^HMZM','HMZM',''], + ['^Hoodisk','^Hoodisk','Hoodisk',''], + ['^(HRUIYL)','^HRUIYL','HRUIYL',''], + ['^(HUAWEI|HWE)','^HUAWEI','Huawei',''], + ['^Hypertec','^Hypertec','Hypertec',''], + ['^HyperX','^HyperX','HyperX',''], + ['^(HYSSD|HY-)','^HYSSD','HYSSD',''], + ['^(Hyundai|C2S\d|Sapphire)','^Hyundai','Hyundai',''], + ['^iMRAM','^iMRAM','iMRA',''], + ['^(IBM|DT|ESA[1-9]|GBR|ServeRaid)','^IBM','IBM',''], # M5110 too common + ['^IEI Tech','^IEI Tech(\.|nology)?( Corp(\.|oration)?)?','IEI Technology',''], + ['^(IGEL|UD Pocket)','^IGEL','IGEL',''], + ['^(Imation|Nano\s?Pro|HQT|Ridge)','^Imation(\sImation)?','Imation',''], # Imation_ImationFlashDrive; TF20 is imation/tdk + ['^(IMC|Kanguru)','^IMC\b','IMC',''], + ['^(Inateck|FE20)','^Inateck','Inateck',''], + ['^(Inca\b|Npenterprise)','^Inca','Inca',''], + ['^(Indilinx|IND-)','^Indilinx','Indilinx',''], + ['^INDMEM','^INDMEM','INDMEM',''], + ['^(Infokit)','^Infokit','Infokit',''], + # note: Initio default controller, means master/slave jumper is off/wrong, not a vendor + ['^Inland','^Inland','Inland',''], + ['^(InnoDisk|DEM\d|Innolite|SATA\s?Slim|DRPS)','^InnoDisk( Corp.)?','InnoDisk',''], + ['(Innostor|1f75)','(Innostor|1f75)','Innostor',''], + ['(^Innovation|Innovation\s?IT)','Innovation(\s*IT)?','Innovation IT',''], + ['^Innovera','^Innovera','Innovera',''], + ['^(I\.?norys|INO-?IH])','^I\.?norys','I.norys',''] + ,['(^Insignia|NS[\s-]?PCNV)','^Insignia','Insignia',''], + ['^Intaiel','^Intaiel','Intaiel',''], + ['^(INM|Integral|V\s?Series)','^Integral(\s?Memory)?','Integral Memory',''], + ['^(lntenso|Intenso|(Alu|Basic|Business|Micro|c?Mobile|Premium|Rainbow|Slim|Speed|Twister|Ultra) Line|Rainbow)','^Intenso','Intenso',''], + ['^(I-?O Data|HDCL)','^I-?O Data','I-O Data',''], + ['^(INO-|i\.?norys)','^i\.?norys','i.norys',''], + ['^(Integrated[\s-]?Technology|IT\d+)','^Integrated[\s-]?Technology','Integrated Technology',''], + ['^(Iomega|ZIP\b|Clik!)','^Iomega','Iomega',''], + ['^(IPASON|PD\d\d)','^IPASON','IPASON',''], + ['^(i[\s_-]?portable\b|ATCS)','^i[\s_-]?portable','i-Portable',''], + ['^ISOCOM','^ISOCOM','ISOCOM (Shenzhen Longsys Electronics)',''], + ['^iTE[\s-]*Tech','^iTE[\s-]*Tech(nology)?','iTE Tech',''], + ['^(James[\s-]?Donkey|JD\d)','^James[\s-]?Donkey','James Donkey',''], + ['^(Jaster|JS\d)','^Jaster','Jaster',''], + ['^JingX','^JingX','JingX',''], #JingX 120G SSD - not confirmed, but guessing + ['^Jingyi','^Jingyi','Jingyi',''], + # NOTE: ITY2 120GB hard to find + ['^JMicron','^JMicron(\s?Tech(nology)?)?','JMicron Tech',''], #JMicron H/W raid + ['^Joint','^Joint','Joint',''], + ['^JSYERA','^JSYERA','Jsyera',''], + ['^(Jual|RX7)','^Jual','Jual',''], + ['^(J\.?ZAO|JZ)','^J\.?ZAO','J.ZAO',''], + ['^(KAPBOM|KA-)','KAPBOM','KAPBOM',''], + ['^(KaBuM!?|KBM)','KaBuM!?','KaBuM!',''], + ['(Kaizen|KZ\d\d)','Kaizen','Kaizen',''], + ['^Kazuk','^Kazuk','Kazuk',''], + ['(\bKDI\b|^OM3P)','\bKDI\b','KDI',''], + ['^KEEPDATA','^KEEPDATA','KeepData',''], + ['^KLLISRE','^KLLISRE','KLLISRE',''], + ['^KimMIDI','^KimMIDI','KimMIDI',''], + ['^Kimtigo','^Kimtigo','Kimtigo',''], + ['^Kingbank','^Kingbank','Kingbank',''], + ['^(KingCell|KC\b)','^KingCell','KingCell',''], + ['^Kingchux[\s-]?ing','^Kingchux[\s-]?ing','Kingchuxing',''], + ['^(KINGCOMP|KCSSD)','^KINGCOMP','KingComp',''], + ['(KingDian|^NGF|S(280|400))','KingDian','KingDian',''], + ['^(Kingfast|TYFS|2710)','^Kingfast','Kingfast',''], + ['^KingMAX','^KingMAX','KingMAX',''], + ['^Kingrich','^Kingrich','Kingrich',''], + ['^Kingsand','^Kingsand','Kingsand',''], + ['KING\s?SHA\s?RE','KING\s?SHA\s?RE','KingShare',''], + ['^(KingSpec|ACSC|C3000|CHA|KS[DQ]|MSH|N[ET]-\d|NX-\d{2,4}|P3$|P4\b|PA[_-]?(18|25)|Q-180|SPK|T-(3260|64|128)|Z(\d\s|F\d))','^KingSpec','KingSpec',''], + ['^KingSSD','^KingSSD','KingSSD',''], + # kingwin docking, not actual drive + ['^(EZD|EZ-Dock)','','Kingwin Docking Station',''], + ['^Kingwin','^Kingwin','Kingwin',''], + ['^KLLISRE','^KLLISRE','KLLISRE',''], + # company name comes after product ID + ['(KIOXIA|\bCL\d-|^K[BX]G\d|SSSTC|Solid\s?State\s?Storage\s?Tech)','KIOXIA','KIOXIA',''], + ['^(KLEVV|NEO\sN|CRAS)','^KLEVV','KLEVV',''], + ['^(KNUP|KP\b)','^KNUP','KNUP',''], + ['^(Kodak|Memory\s?Saver)','^Kodak','Kodak',''], + ['^(KOOTION)','^KOOTION','KOOTION',''], + ['^(KUAIKAI|MSAM)','^KUAIKAI','KuaKai',''], + ['(KUIJIA|DAHUA)','^KUIJIA','KUIJIA',''], + ['^KUNUP','^KUNUP','KUNUP',''], + ['^KUU','^KUU\b','KUU',''], # KUU-128GB + ['^(Lacie|P92|itsaKey|iamaKey)','^Lacie','LaCie',''], + ['^LANBO','^LANBO','LANBO',''], + ['^LankXin','^LankXin','LankXin',''], + ['^LANTIC','^LANTIC','Lantic',''], + ['^Lapcare','^Lapcare','Lapcare',''], + ['^(Lazos|L-?ISS)','^Lazos','Lazos',''], + ['^LDLC','^LDLC','LDLC',''], + ['^(Leica|MSD\d\d)','^Leica','Leica',''], + # LENSE30512GMSP34MEAT3TA / UMIS RPITJ256PED2MWX + ['^(LEN|UMIS|Think)','^Lenovo','Lenovo',''], + ['^RPFT','','Lenovo O.E.M.',''], + # JAJS300M120C JAJM600M256C JAJS600M1024C JAJS600M256C JAJMS600M128G + ['^(Leven|JAJ[MS])','^Leven','Leven',''], + ['^(LEQIXIANG)','^LEQIXIANG','Leqixiang',''], + ['^(LG\b|Xtick)','^LG','LG',''], + ['^Lidermix','Lidermix','Lidermix',''], + ['(LITE[-\s]?ON[\s-]?IT)','LITE[-]?ON[\s-]?IT','LITE-ON IT',''], # LITEONIT_LSS-24L6G + # PH6-CE240-L; CL1-3D256-Q11 NVMe LITEON 256GB + ['(LITE[-\s]?ON|^PH[1-9]|^DMT|^CV\d-|L(8[HT]|AT|C[HST]|JH|M[HST]|S[ST])-|^S900)','LITE[-]?ON','LITE-ON',''], + ['^LONDISK','^LONDISK','LONDISK',''], + ['^Longline','^Longline','Longline',''], + ['^LuminouTek','^LuminouTek','LuminouTek',''], + ['^Lunatic','^Lunatic','Lunatic',''], + ['^(LSI|MegaRAID|MR\d{3,4}\b)','^LSI\b','LSI',''], + ['^(M-Systems|DiskOnKey)','^M-Systems','M-Systems',''], + ['^(Mach\s*Xtreme|MXSSD|MXU|MX[\s-])','^Mach\s*Xtreme','Mach Xtreme',''], + ['^(MacroVIP|MV(\d|GLD))','^MacroVIP','MacroVIP',''], # maybe MV alone + ['^Mainic','^Mainic','Mainic',''], + ['^(Mancer|MCR)','^ Mancer[\s-]?Reaper','Mancer Reaper',''], + ['^MARKVISION','^MARKVISION','MarkVision',''], + ['^(MARSHAL\b|MAL\d)','^MARSHAL','Marshal',''], + ['^Maxell','^Maxell','Maxell',''], + ['^Maximus','^Maximus','Maximus',''], + ['^MAXIO','^MAXIO','Maxio',''], + ['^Maxmem','^Maxmem','Maxmem',''], + ['^Maxone','^Maxone','Maxone',''], + ['^MARVELL','^MARVELL','Marvell',''], + ['^Maxsun','^Maxsun','Maxsun',''], + ['^(McQuest)','^McQuest([\s-]?Digital)?','McQuest Digital',''], + ['^MDT\b','^MDT','MDT (rebuilt WD/Seagate)',''], # mdt rebuilds wd/seagate hdd + # MD1TBLSSHD, careful with this MD starter!! + ['^MD[1-9]','^Max\s*Digital','MaxDigital',''], + ['^(Media[\s-]?Dice|MD[\s-])','^Media[\s-]?Dice','MediaDice',''], + ['^Medion','^Medion','Medion',''], + ['^(MEDIAMAX|WL\d{2})','^MEDIAMAX','MediaMax',''], + ['^(Memorex|TravelDrive|TD\s?Classic)','^Memorex','Memorex',''], + ['^Mengmi','^Mengmi','Mengmi',''], + ['^MGTEC','^MGTEC','MGTEC',''], + ['^MicroFrom','^MicroFrom','MicroFrom',''], + ['^(MILLENNIUM[\s-]?TECHNOLOGY|MIL\d\d)','^MILLENNIUM[\s-]?TECHNOLOGY','Millenium Technology',''], + # must come before micron + ['^(Mtron|MSP)','^Mtron','Mtron',''], + # note: C300/400 can be either micron or crucial, but C400 is M4 from crucial + # micron can be in middle of model name + ['(\bMicron|^(2200[SV]|MT|M5|(\d+|[CM]\d+)\sMTF)|00-MT)','\bMicron','Micron',''],# C400-MTFDDAK128MAM + ['^(Microsoft|S31)','^Microsoft','Microsoft',''], + ['^MidasForce','^MidasForce','MidasForce',''], + ['^Milan','^Milan','Milan',''], + ['^(Mimoco|Mimobot)','^Mimoco','Mimoco',''], + ['^MINIX','^MINIX','MINIX',''], + ['^Miracle','^Miracle','Miracle',''], + ['^MLLSE','^MLLSE','MLLSE',''], + ['^Moba','^Moba','Moba',''], + # Monster MONSTER DIGITAL + ['^(Monster\s)+(Digital)?|OD[\s-]?ADVANCE','^(Monster\s)+(Digital)?','Monster Digital',''], + ['^Morebeck','^Morebeck','Morebeck',''], + ['^(Moser\s?Bear|MBIL)','^Moser\s?Bear','Moser Bear',''], + ['^(Motile|SSM\d)','^Motile','Motile',''], + ['^(Motorola|XT\d{4}|Moto[\s-]?[EG])','^Motorola','Motorola',''], + ['^Moweek','^Moweek','Moweek',''], + ['^(Move[\s-]?Speed|YSSD)','^Move[\s-]?Speed','Move Speed',''], + #MRMAD4B128GC9M2C + ['^(MRMA|Memoright)','^Memoright','Memoright',''], + ['^MSI\b','^MSI\b','MSI',''], + ['^MTASE','^MTASE','MTASE',''], + ['^MTRON','^MTRON','MTRON',''], + ['^(MyDigitalSSD|BP[4X])','^MyDigitalSSD','MyDigitalSSD',''], # BP4 = BulletProof4 + ['^MyMedia','^MyMedia','MyMedia',''], + ['^(Myson)','^Myson([\s-]?Century)?([\s-]?Inc\.?)?','Myson Century',''], + ['^(Natusun|i-flashdisk)','^Natusun','Natusun',''], + ['^(Neo\s*Forza|NFS\d)','^Neo\s*Forza','Neo Forza',''], + ['^(Netac|NS\d{3}|OnlyDisk|S535N|SMTC)','^Netac','Netac',''], + ['^Newsmy','^Newsmy','Newsmy',''], + ['^NFHK','^NFHK','NFHK',''], + # NGFF is a type, like msata, sata + ['^Nik','^Nikimi','Nikimi',''], + ['^NOREL','^NOREL(SYS)?','NorelSys',''], + ['^(N[\s-]?Tech|NT\d)','^N[\s-]?Tec','N Tech',''], # coudl be ^NT alone + ['^NXTech','^NXTech','NXTech',''], + ['^ODYS','^ODYS','ODYS',''], + ['^Olympus','^Olympus','Olympus',''], + ['^Orico','^Orico','Orico',''], + ['(Origin|Inception|^TLC\d)','^Origin','Origin',''], + ['^Ortial','^Ortial','Ortial',''], + ['^OSC','^OSC\b','OSC',''], + ['^(Ovation)','^Ovation','Ovation',''], + ['^oyunkey','^oyunkey','Oyunkey',''], + ['^PALIT','PALIT','Palit',''], # ssd + ['^Panram','^Panram','Panram',''], # ssd + ['^(Parker|TP00)','^Parker','Parker',''], + ['^(Pasoul|OASD)','^Pasoul','Pasoul',''], + ['^(Patriot|PS[8F]|P2\d{2}|PBT|VPN|Viper|Burst|Blast|Blaze|Pyro|Ignite)','^Patriot([-\s]?Memory)?','Patriot',''],#Viper M.2 VPN100 + ['^PERC\b','','Dell PowerEdge RAID Card',''], # ssd + ['(\bPhilips)','\bPhilips','Philips',''], + ['(PHISON[\s-]?|ESR\d|PS[5E]|311CD|\bSSG\d\d)','PHISON[\s-]?','Phison',''],# E12-256G-PHISON-SSD-B3-BB1 + ['^(Pichau[\s-]?Gaming|PG\d{2})','^Pichau[\s-]?Gaming','Pichau Gaming',''], + ['^Pioneer','Pioneer','Pioneer',''], + ['^Platinet','Platinet','Platinet',''], + ['^(PLEXTOR|PX-)','^PLEXTOR','Plextor',''], + ['^(Polion)','^Polion','Polion',''], + ['^(PQI|Intelligent\s?Stick|Cool\s?Drive)','^PQI','PQI',''], + ['^(Premiertek|QSSD|Quaroni)','^Premiertek','Premiertek',''], + ['^(-?Pretec|UltimateGuard)','-?Pretec','Pretec',''], + ['^(Prolific)','^Prolific( Technolgy Inc\.)?','Prolific',''], + # PS3109S9 is the result of an error condition with ssd controller: Phison PS3109 + ['^PUSKILL','^PUSKILL','Puskill',''], + ['QEMU','^\d*QEMU( QEMU)?','QEMU',''], # 0QUEMU QEMU HARDDISK + ['^QNIX','^QNIX','QNIX',''], + ['(^Quantum|Fireball)','^Quantum','Quantum',''], + ['(^Quanxing)','^Quanxing','Quanxing',''], + ['(^QOOTEC|QMT)','^QOOTEC','QOOTEC',''], + ['^(QUMO|Q\dDT)','^QUMO','Qumo',''], + ['^QOPP','^QOPP','Qopp',''], + ['^Qunion','^Qunion','Qunion',''], + ['^(R[3-9]|AMD\s?(RADEON)?|Radeon)','AMD\s?(RADEON)?','AMD Radeon',''], # ssd + ['^(Ramaxel|RT|RM|RPF|RDM)','^Ramaxel','Ramaxel',''], + ['^(Ramsta|RT|SSD\d+GBS8)','^Ramsta','Ramsta',''], + ['^RAMOS','^RAMOS','RAmos',''], + ['^(Ramsta|R[1-9])','^Ramsta','Ramsta',''], + ['^RCESSD','^RCESSD','RCESSD',''], + ['^(Realtek|RTL)','^Realtek','Realtek',''], + ['^(Redragon|\bHaste)','^Redragon','Redragon',''], + ['^(Reletech)','^Reletech','Reletech',''], # id: P400 but that's too short + ['^RENICE','^RENICE','Renice',''], + ['^RevuAhn','^RevuAhn','RevuAhn',''], + ['^(Ricoh|R5)','^Ricoh','Ricoh',''], + ['^RIM[\s]','^RIM','RIM',''], + ['^(Rococo|ITE\b|IT\d{4})','^Rococo','Rococo',''], + #RTDMA008RAV2BWL comes with lenovo but don't know brand + ['^Runcore','^Runcore','Runcore',''], + ['^Rundisk','^Rundisk','RunDisk',''], + ['^(RUNENG)','^RUNENG','RUNENG',''], + ['^RZX','^RZX\b','RZX',''], + ['^(S3Plus|S3\s?SSD)','^S3Plus','S3Plus',''], + ['^(Sabrent|Rocket)','^Sabrent','Sabrent',''], + ['^Sage','^Sage(\s?Micro)?','Sage Micro',''], + ['^SAMSWEET','^SAMSWEET','Samsweet',''], + ['^SandForce','^SandForce','SandForce',''], + ['^Sannobel','^Sannobel','Sannobel',''], + ['^(Sansa|fuse\b)','^Sansa','Sansa',''], + # SATADOM can be innodisk or supermirco: dom == disk on module + # SATAFIRM is an ssd failure message + ['^SCUDA','^SCUDA','SCUDA',''], + ['^(Sea\s?Tech|Transformer)','^Sea\s?Tech','Sea Tech',''], + ['^(SEIWHALE)','^SEIWHALE','SEIWHALE',''], + ['^(SIEMENS)','^SIEMENS','Siemens',''], + ['^SigmaTel','^SigmaTel','SigmaTel',''], + # DIAMOND_040_GB + ['^(SILICON\s?MOTION|SM\d|090c)','^(SILICON\s?MOTION|090c)','Silicon Motion',''], + ['(Silicon[\s-]?Power|^SP[CP]C|^Silicon|^Diamond|^HasTopSunlightpeed)','Silicon[\s-]?Power','Silicon Power',''], + # simple drive could also maybe be hgst + ['^(Simple\s?Tech|Simple[\s-]?Drive)','^Simple\s?Tech','SimpleTech',''], + ['^(Simmtronics?|S[79]\d{2}|ZipX)','^Simmtronics?','Simmtronics',''], + ['^SINTECHI?','^SINTECHI?','SinTech (adapter)',''], + ['^SiS\b','^SiS','SiS',''], + ['Smartbuy','\s?Smartbuy','Smartbuy',''], # SSD Smartbuy 60GB; mSata Smartbuy 3 + # HFS128G39TND-N210A; seen nvme with name in middle + ['(SK\s?HYNIX|^HF[MS]|^H[BC]G|^HFB|^BC\d{3}|^SC[234]\d\d\sm?SATA|^SK[\s-]?\d{2,4})','\s?SK\s?HYNIX','SK Hynix',''], + ['(hynix|^HAG\d|h[BC]8aP|PC\d{3})','hynix','Hynix',''],# nvme middle of string, must be after sk hynix + ['^SH','','Smart Modular Tech.',''], + ['^Skill','^Skill','Skill',''], + ['^(SMART( Storage Systems)?|TX)','^(SMART( Storage Systems)?)','Smart Storage Systems',''], + ['^Sobetter','^Sobetter','Sobetter',''], + ['^Solidata','^Solidata','Solidata',''], + ['^(SOLIDIGM|SSDPFK)','^SOLIDIGM\b','solidgm',''], + ['^(Sony|IM9|Microvalut|S[FR]-)','^Sony','Sony',''], + # Note: SSC can be prefix for several companies + ['^SSK\b','^SSK','SSK',''], + ['^(SSSTC|CL1-)','^SSSTC','SSSTC',''], + ['^(SST|SG[AN])','^SST\b','SST',''], + ['^STE[CK]','^STE[CK]','sTec',''], # wd bought this one + ['^STORFLY','^STORFLY','StorFly',''], + ['\dSUN\d','^SUN(\sMicrosystems)?','Sun Microsystems',''], + ['^Sundisk','^Sundisk','Sundisk',''], + ['^SUNEAST','^SUNEAST','SunEast',''], + ['^Suntrsi','^Suntrsi','Suntrsi',''], + ['^SuperMicro','^SuperMicro','SuperMicro',''], + ['^Supersonic','^Supersonic','Supersonic',''], + ['^SuperSSpeed','^SuperSSpeed','SuperSSpeed',''], + # NOTE: F[MNETU] not reliable, g.skill starts with FM too: + # Seagate ST skips STT. + ['^(Super\s*Talent|STT|F[HTZ]M\d|PicoDrive|Teranova)','','Super Talent',''], + ['^(SF|Swissbit)','^Swissbit','Swissbit',''], + # ['^(SUPERSPEED)','^SUPERSPEED','SuperSpeed',''], # superspeed is a generic term + ['^(SXMicro|NF8)','^SXMicro','SXMicro',''], + ['^Taisu','^Taisu','Taisu',''], + ['^(TakeMS|ColorLine)','^TakeMS','TakeMS',''], + ['^Tammuz','^Tammuz','Tammuz',''], + ['^TANDBERG','^TANDBERG','Tanberg',''], + ['^(TC[\s-]*SUNBOW|X3\s\d+[GT])','^TC[\s-]*SUNBOW','TCSunBow',''], + ['^(TDK|TF[1-9]\d|LoR)','^TDK','TDK',''], + ['(^TEAC|\bUF00)','^TEAC','TEAC',''], + ['^(TEAM|T[\s-]?Create|CX[12]\b|L\d\s?Lite|T\d{3,}[A-Z]|TM\d|(Dark\s?)?L3\b|T[\s-]?Force)','^TEAM(\s*Group)?','TeamGroup',''], + ['^(Teclast|CoolFlash)','^Teclast','Teclast',''], + ['^(tecmiyo)','^tecmiyo','TECMIYO',''], + ['^Teelkoou','^Teelkoou','Teelkoou',''], + ['^Tele2','^Tele2','Tele2',''], + ['^Teleplan','^Teleplan','Teleplan',''], + ['^TEUTONS','^TEUTONS','TEUTONS',''], + ['^(Textorm)','^Textorm','Textorm',''], # B5 too short + ['^(T(&|\s?and\s?)?G\d{3})','^T&G\b','T&G',''], + ['^THU','^THU','THU',''], + ['^Tiger[\s_-]?Jet','^Tiger[\s_-]?Jet','TigerJet',''], + ['^Tigo','^Tigo','Tigo',''], + ['^(Timetec|35TT)','^Timetec','Timetec',''], + ['^TKD','^TKD','TKD',''], + ['^TopSunligt','^TopSunligt','TopSunligt',''], # is this a typo? hard to know + ['^TopSunlight','^TopSunlight','TopSunlight',''], + ['^TOROSUS','^TOROSUS','Torosus',''], + ['(Transcend|^((SSD\s|F)?TS|ESD\d|EZEX|USDU)|1307|JetDrive|JetFlash)','\b(Transcend|1307)\b','Transcend',''], + ['^(TrekStor|DS (maxi|pocket)|DataStation)','^TrekStor','TrekStor',''], + ['^Turbox','^Turbox','Turbox',''], + ['^TurXun','^TurXun','TurXun',''], + ['^(TwinMOS|TW\d)','^TwinMOS','TwinMOS',''], + # note: udisk means usb disk, it's not a vendor ID + ['^UDinfo','^UDinfo','UDinfo',''], + ['^UMAX','^UMAX','UMAX',''], + ['^UpGamer','^UpGamer','UpGamer',''], + ['^(UMIS|RP[IJ]TJ)','^UMIS','UMIS',''], + ['^USBTech','^USBTech','USBTech',''], + ['^(UNIC2)','^UNIC2','UNIC2',''], + ['^(UG|Unigen)','^Unigen','Unigen',''], + ['^UnionSine','UnionSine','UnionSine',''], + ['^(UNIREX)','^UNIREX','UNIREX',''], + ['^(UNITEK)','^UNITEK','UNITEK',''], + ['^(USBest|UT16)','^USBest','USBest',''], + ['^(OOS[1-9]|Utania)','Utania','Utania',''], + ['^U-TECH','U-TECH','U-Tech',''], + ['^(Value\s?Tech|VTP\d)','^Value\s?Tech','ValueTech',''], + ['^VBOX','','VirtualBox',''], + ['^(Veno|Scorp)','^Veno','Veno',''], + ['^(VenomRX|VRX)','^VenomRX','VenomRX',''], + ['^(Verbatim|STORE\s?\'?N\'?\s?(FLIP|GO)|Vi[1-9]|OTG\s?Tiny)','^Verbatim','Verbatim',''], + ['^V-?GEN','^V-?GEN','V-Gen',''], + ['^VICK','VICK','VICK',''], + ['^V[\s-]?(7|Seven)','^V[\s-]?(7|Seven)\b','VSeven',''], + ['^(Victorinox|Swissflash)','^Victorinox','Victorinox',''], + ['^(Virtium|VTD)','^Virtium','Virtium',''], + ['^(Visipro|SDVP)','^Visipro','Visipro',''], + ['^VISIONTEK','^VISIONTEK','VisionTek',''], + ['^VMware','^VMware','VMware',''], + ['^(Vseky|Vaseky|V8\d{2})','^Vaseky','Vaseky',''], # ata-Vseky_V880_350G_ + ['^(Walgreen|Infinitive)','^Walgreen','Walgreen',''], + ['^Walram','^Walram','WALRAM',''], + ['^Walton','^Walton','Walton',''], + ['^(Wearable|Air-?Stash)','^Wearable','Wearable',''], + ['\b(WiebeTech|eRazer)','WiebeTech','WiebeTech',''], + ['^Wellcomm','^Wellcomm','Wellcomm',''], + ['^(WHALEKOM|WK)','^WHALEKOM','Whalekom',''], + ['^(wicgtyp|[MN][V]?900)','^wicgtyp','wicgtyp',''], + ['^Wilk','^Wilk','Wilk',''], + ['^(WinMemory|SW[GR]\d)','^WinMemory','WinMemory',''], + ['^(Winton|WT\d{2})','^Winton','Winton',''], + ['^(WISE)','^WISE','WISE',''], + ['^WPC','^WPC','WPC',''], # WPC-240GB + ['^(Wortmann(\sAG)?|Terra\s?US)','^Wortmann(\sAG)?','Wortmann AG',''], + ['^(XDisk|X9\b)','^XDisk','XDisk',''], + ['^(XinTop|XT-)','^XinTop','XinTop',''], + ['^Xintor','^Xintor','Xintor',''], + ['^XPG','^XPG','XPG',''], + ['^XrayDisk','^XrayDisk','XrayDisk',''], + ['^Xstar','^Xstar','Xstar',''], + ['^(Xtigo)','^Xtigo','Xtigo',''], + ['^(XUM|HX\d)','^XUM','XUM',''], + ['^XUNZHE','^XUNZHE','XUNZHE',''], + ['^(Yangtze|ZhiTai|PC00[5-9]|SC00[1-9])','^Yangtze(\s*Memory)?','Yangtze Memory',''], + ['^(Yeyian|valk)','^Yeyian','Yeyian',''], + ['^(YHJC|YHS)','^YHJC','YHJC',''], + ['^(YingChu|YGC)','^YingChu','YingChu',''], + ['^YongzhenWeiye','^YongzhenWeiye','YongzhenWeiye',''], + ['^(YUCUN|R880)','^YUCUN','YUCUN',''], + ['^(ZALMAN|ZM\b)','^ZALMAN','Zalman',''], + # Zao/J.Zau: marvell ssd controller + ['^ZXIC','^ZXIC','ZXIC',''], + ['^(Zebronics|ZEB)','^Zebronics','Zebronics',''], + ['^Zenfast','^Zenfast','Zenfast',''], + ['^Zenith','^Zenith','Zenith',''], + ['^ZEUSLAP','^ZEUSLAP','ZEUSLAP',''], + ['^ZEUSS','^ZEUSS','Zeuss',''], + ['^(Zheino|CHN|CNM)','^Zheino','Zheino',''], + ['^(Zotac|ZTSSD)','^Zotac','Zotac',''], + ['^ZOZT','^ZOZT','ZOZT',''], + ['^ZSPEED','^ZSPEED','ZSpeed',''], + ['^Zsuit','^Zsuit','Zsuit',''], + ['^ZTC','^ZTC','ZTC',''], + ['^ZTE','^ZTE','ZTE',''], + ['^(ZY|ZhanYao)','^ZhanYao([\s-]?data)','ZhanYao',''], + ['^(ASMT|2115)','^ASMT','ASMT (case)',''], + ]; + eval $end if $b_log; +} +## END DISK VENDOR BLOCK ## + +# receives space separated string that may or may not contain vendor data +sub disk_vendor { + eval $start if $b_log; + my ($model,$serial) = @_; + my ($vendor) = (''); + return if !$model; + # 0 - match pattern; 1 - replace pattern; 2 - vendor print; 3 - serial pattern + # Data URLs: inxi-resources.txt Section: DriveItem device_vendor() + # $model = 'H10 HBRPEKNX0202A NVMe INTEL 512GB'; + # $model = 'SD Ultra 3D 1TB'; + # $model = 'ST8000DM004-2CX188_WCT193ZX'; + set_disk_vendors() if !$vendors; + # prefilter this one, some usb enclosurs and wrong master/slave hdd show default + $model =~ s/^Initio[\s_]//i; + foreach my $row (@$vendors){ + if ($model =~ /$row->[0]/i || ($row->[3] && $serial && $serial =~ /$row->[3]/)){ + $vendor = $row->[2]; + # Usually we want to assign N/A at output phase, maybe do this logic there? + if ($row->[1]){ + if ($model !~ m/$row->[1]$/i){ + $model =~ s/$row->[1]//i; + } + else { + $model = 'N/A'; + } + } + $model =~ s/^[\/\[\s_-]+|[\/\s_-]+$//g; + $model =~ s/\s\s/ /g; + last; + } + } + eval $end if $b_log; + return [$vendor,$model]; +} + +# Normally hddtemp requires root, but you can set user rights in /etc/sudoers. +# args: 0: /dev/ to be tested for +sub hdd_temp { + eval $start if $b_log; + my ($device) = @_; + my ($path) = (''); + my (@data,$hdd_temp); + $hdd_temp = hdd_temp_sys($device) if !$force{'hddtemp'} && -e "/sys/block/$device"; + if (!$hdd_temp){ + $device = "/dev/$device"; + if ($device =~ /nvme/i){ + if (!$b_nvme){ + $b_nvme = 1; + if ($path = main::check_program('nvme')){ + $nvme = $path; + } + } + if ($nvme){ + $device =~ s/n[0-9]//; + @data = main::grabber("$sudoas$nvme smart-log $device 2>/dev/null"); + foreach (@data){ + my @row = split(/\s*:\s*/, $_); + next if !$row[0]; + # other rows may have: Temperature sensor 1 : + if ($row[0] eq 'temperature'){ + $row[1] =~ s/\s*C//; + $hdd_temp = $row[1]; + last; + } + } + } + } + else { + if (!$b_hddtemp){ + $b_hddtemp = 1; + if ($path = main::check_program('hddtemp')){ + $hddtemp = $path; + } + } + if ($hddtemp){ + $hdd_temp = (main::grabber("$sudoas$hddtemp -nq -u C $device 2>/dev/null"))[0]; + } + } + $hdd_temp =~ s/\s?(Celsius|C)$// if $hdd_temp; + } + eval $end if $b_log; + return $hdd_temp; +} + +sub hdd_temp_sys { + eval $start if $b_log; + my ($device) = @_; + my ($hdd_temp,$hdd_temp_alt,%sensors,@data,@working); + my ($holder,$index) = ('',''); + my $path = "/sys/block/$device/device"; + my $path_trimmed = Cwd::abs_path("/sys/block/$device"); + # slice out the part of path that gives us hwmon in earlier kernel drivetemp + $path_trimmed =~ s%/(block|nvme)/.*$%% if $path_trimmed; + print "device: $device path: $path\n path_trimmed: $path_trimmed\n" if $dbg[21]; + return if ! -e $path && (!$path_trimmed || ! -e "$path_trimmed/hwmon"); + # first type, trimmed block,nvme (ata and nvme), 5.9 kernel: + # /sys/devices/pci0000:10/0000:10:08.1/0000:16:00.2/ata8/host7/target7:0:0/7:0:0:0/hwmon/hwmon5/ + # /sys/devices/pci0000:10/0000:10:01.2/0000:13:00.0/hwmon/hwmon0/ < nvme + # /sys/devices/pci0000:00/0000:00:01.3/0000:01:00.1/ata2/host1/target1:0:0/1:0:0:0/hwmon/hwmon3/ + # second type, 5.10+ kernel: + # /sys/devices/pci0000:20/0000:20:03.1/0000:21:00.0/nvme/nvme0/nvme0n1/device/hwmon1 + # /sys/devices/pci0000:00/0000:00:08.1/0000:0b:00.2/ata12/host11/target11:0:0/11:0:0:0/block/sdd/device/hwmon/hwmon1 + # we don't want these items: crit|max|min|lowest|highest + # original kernel 5.8/9 match for nvme and sd, 5.10+ match for sd + if (-e "$path_trimmed/hwmon/"){ + @data = main::globber("$path_trimmed/hwmon/hwmon*/temp*_{input,label}"); + } + # this case only happens if path_trimmed case isn't there, but leave in case + elsif (-e "$path/hwmon/"){ + @data = main::globber("$path/hwmon/hwmon*/temp*_{input,label}"); + } + # current match for nvme, but fails for 5.8/9 kernel nvme + else { + @data = main::globber("$path/hwmon*/temp*_{input,label}"); + } + # seeing long lag to read temp input files for some reason + foreach (sort @data){ + # print "file: $_\n"; + # print(main::reader($_,'',0),"\n"); + $path = $_; + # cleanup everything in front of temp, the path + $path =~ s/^.*\///; + @working = split('_', $path); + if ($holder ne $working[0]){ + $holder = $working[0]; + } + $sensors{$holder}->{$working[1]} = main::reader($_,'strip',0); + } + return if !%sensors; + if (keys %sensors == 1){ + if ($sensors{$holder}->{'input'} && main::is_numeric($sensors{$holder}->{'input'})){ + $hdd_temp = $sensors{$holder}->{'input'}; + } + } + else { + # nvme drives can have > 1 temp types, but composite is the one we want if there + foreach (keys %sensors){ + next if !$sensors{$_}->{'input'} || !main::is_numeric($sensors{$_}->{'input'}); + if ($sensors{$_}->{'label'} && $sensors{$_}->{'label'} eq 'Composite'){ + $hdd_temp = $sensors{$_}->{'input'}; + last; + } + else{ + $hdd_temp_alt = $sensors{$_}->{'input'}; + } + } + $hdd_temp = $hdd_temp_alt if !defined $hdd_temp && defined $hdd_temp_alt; + } + $hdd_temp = sprintf("%.1f", $hdd_temp/1000) if $hdd_temp; + main::log_data('data',"device: $device temp: $hdd_temp") if $b_log; + main::log_data('dump','%sensors',\%sensors) if $b_log; + print Data::Dumper::Dumper \%sensors if $dbg[21]; + eval $end if $b_log; + return $hdd_temp; +} + +# args: 0: block id +sub block_data { + eval $start if $b_log; + my ($id) = @_; + # 0: logical block size 1: disk physical block size/partition block size; + my ($block_log,$block_size) = (0,0); + # my $path_size = "/sys/block/$id/size"; + my $path_log_block = "/sys/block/$id/queue/logical_block_size"; + my $path_phy_block = "/sys/block/$id/queue/physical_block_size"; + # legacy system path + if (! -e $path_phy_block && -e "/sys/block/$id/queue/hw_sector_size"){ + $path_phy_block = "/sys/block/$id/queue/hw_sector_size"; + } + $block_log = main::reader($path_log_block,'',0) if -r $path_log_block; + $block_size = main::reader($path_phy_block,'',0) if -r $path_phy_block; + # print "l-b: $block_log p-b: $block_size raw: $size_raw\n"; + my $blocks = [$block_log,$block_size]; + main::log_data('dump','@blocks',$blocks) if $b_log; + eval $end if $b_log; + return $blocks; +} + +sub drive_speed { + eval $start if $b_log; + my ($device) = @_; + my ($b_nvme,$lanes,$speed); + my $working = Cwd::abs_path("/sys/class/block/$device"); + # print "$working\n"; + if ($working){ + my ($id); + # slice out the ata id: + # /sys/devices/pci0000:00:11.0/ata1/host0/target0: + if ($working =~ /^.*\/ata([0-9]+)\/.*/){ + $id = $1; + } + # /sys/devices/pci0000:00/0000:00:05.0/virtio1/block/vda + elsif ($working =~ /^.*\/virtio([0-9]+)\/.*/){ + $id = $1; + } + # /sys/devices/pci0000:10/0000:10:01.2/0000:13:00.0/nvme/nvme0/nvme0n1 + elsif ($working =~ /^.*\/(nvme[0-9]+)\/.*/){ + $id = $1; + $b_nvme = 1; + } + # do host last because the strings above might have host as well as their search item + # 0000:00:1f.2/host3/target3: increment by 1 sine ata starts at 1, but host at 0 + elsif ($working =~ /^.*\/host([0-9]+)\/.*/){ + $id = $1 + 1 if defined $1; + } + # print "$working $id\n"; + if (defined $id){ + if ($b_nvme){ + $working = "/sys/class/nvme/$id/device/max_link_speed"; + $speed = main::reader($working,'',0) if -r $working; + if (defined $speed && $speed =~ /([0-9\.]+)\sGT\/s/){ + $speed = $1; + # pcie1: 2.5 GT/s; pcie2: 5.0 GT/s; pci3: 8 GT/s + # NOTE: PCIe 3 stopped using the 8b/10b encoding but a sample pcie3 nvme has + # rated speed of GT/s * .8 anyway. GT/s * (128b/130b) + $speed = ($speed <= 5) ? $speed * .8 : $speed * 128/130; + $speed = sprintf("%.1f",$speed) if $speed; + $working = "/sys/class/nvme/$id/device/max_link_width"; + $lanes = main::reader($working,'',0) if -r $working; + $lanes ||= 1; + # https://www.edn.com/electronics-news/4380071/What-does-GT-s-mean-anyway- + # https://www.anandtech.com/show/2412/2 + # http://www.tested.com/tech/457440-theoretical-vs-actual-bandwidth-pci-express-and-thunderbolt/ + # PCIe 1,2 use “8b/10b” encoding: eight bits are encoded into a 10-bit symbol + # PCIe 3,4,5 use "128b/130b" encoding: 128 bits are encoded into a 130 bit symbol + $speed = ($speed * $lanes) . " Gb/s"; + } + } + else { + $working = "/sys/class/ata_link/link$id/sata_spd"; + $speed = main::reader($working,'',0) if -r $working; + $speed = main::clean_disk($speed) if $speed; + $speed =~ s/Gbps/Gb\/s/ if $speed; + } + } + } + # print "$working $speed\n"; + eval $end if $b_log; + return [$speed,$lanes]; +} +} + +## GraphicItem ## +{ +package GraphicItem; +my ($b_primary,$b_wayland_data,%graphics,%mesa_drivers, +$monitor_ids,$monitor_map); +my ($gpu_amd,$gpu_intel,$gpu_loongson,$gpu_nv); + +sub get { + eval $start if $b_log; + my $rows = []; + my $num = 0; + if (%risc && !$use{'soc-gfx'} && !$use{'pci-tool'}){ + my $key = 'Message'; + @$rows = ({ + main::key($num++,0,1,$key) => main::message('risc-pci',$risc{'id'}) + }); + } + else { + device_output($rows); + ($gpu_amd,$gpu_intel,$gpu_loongson,$gpu_nv) = (); + if (!@$rows){ + my $key = 'Message'; + my $message = ''; + my $type = 'pci-card-data'; + if ($pci_tool && $alerts{$pci_tool}->{'action'} eq 'permissions'){ + $type = 'pci-card-data-root'; + } + elsif (!$bsd_type && !%risc && !$pci_tool && + $alerts{'lspci'}->{'action'} && + $alerts{'lspci'}->{'action'} eq 'missing'){ + $message = $alerts{'lspci'}->{'message'}; + } + $message = main::message($type,'') if !$message; + @$rows = ({ + main::key($num++,0,1,$key) => $message + }); + } + } + # note: not perfect, but we need usb gfx to show for all types, soc, pci, etc + usb_output($rows); + display_output($rows); + display_api($rows); + (%graphics,$monitor_ids,$monitor_map) = (); + eval $end if $b_log; + return $rows; +} + +## DEVICE OUTPUT ## +sub device_output { + eval $start if $b_log; + return if !$devices{'graphics'}; + my $rows = $_[0]; + my ($j,$num) = (0,1); + my ($bus_id); + set_monitors_sys() if !$monitor_ids && -e '/sys/class/drm'; + foreach my $row (@{$devices{'graphics'}}){ + $num = 1; + # print "$row->[0] $row->[3]\n"; + # not using 3D controller yet, needs research: |3D controller |display controller + # note: this is strange, but all of these can be either a separate or the same + # card. However, by comparing bus id, say: 00:02.0 we can determine that the + # cards are either the same or different. We want only the .0 version as a valid + # card. .1 would be for example: Display Adapter with bus id x:xx.1, not the right one + next if $row->[3] != 0; + # print "$row->[0] $row->[3]\n"; + $j = scalar @$rows; + my $device = main::trimmer($row->[4]); + ($bus_id) = (); + $device = ($device) ? main::clean_pci($device,'output') : 'N/A'; + # have seen absurdly verbose card descriptions, with non related data etc + if (length($device) > 85 || $size{'max-cols'} < 110){ + main::filter_pci_long(\$device); + } + push(@$rows, { + main::key($num++,1,1,'Device') => $device, + },); + if ($extra > 0 && $use{'pci-tool'} && $row->[12]){ + my $item = main::get_pci_vendor($row->[4],$row->[12]); + $rows->[$j]{main::key($num++,0,2,'vendor')} = $item if $item; + } + push(@{$graphics{'gpu-drivers'}},$row->[9]) if $row->[9]; + my $driver = ($row->[9]) ? $row->[9]:'N/A'; + $rows->[$j]{main::key($num++,1,2,'driver')} = $driver; + if ($row->[9] && !$bsd_type){ + my $version = main::get_module_version($row->[9]); + $version ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'v')} = $version; + } + if ($b_admin && $row->[10]){ + $row->[10] = main::get_driver_modules($row->[9],$row->[10]); + $rows->[$j]{main::key($num++,0,3,'alternate')} = $row->[10] if $row->[10]; + } + if ($extra > 0 && $row->[5] && $row->[6] && + $row->[5] =~ /^(0014|1002|10de|12d2|8086)$/){ + # legacy: 1180 0df7 0029 current: 13bc 1c8d 24b1 regex: H100, RTX 4000 + # ($row->[5],$row->[6],$row->[4]) = ('12de','0029',''); + # ($row->[5],$row->[6],$row->[4]) = ('0014','7a25',''); # loongson + my ($gpu_data,$b_nv) = gpu_data($row->[5],$row->[6],$row->[4]); + if (!$bsd_type && $b_nv && $b_admin){ + if ($gpu_data->{'legacy'}){ + $rows->[$j]{main::key($num++,1,3,'non-free')} = ''; + $rows->[$j]{main::key($num++,0,4,'series')} = $gpu_data->{'series'}; + $rows->[$j]{main::key($num++,0,4,'status')} = $gpu_data->{'status'}; + if ($gpu_data->{'xorg'}){ + $rows->[$j]{main::key($num++,1,4,'last')} = ''; + $rows->[$j]{main::key($num++,0,5,'release')} = $gpu_data->{'release'}; + $rows->[$j]{main::key($num++,0,5,'kernel')} = $gpu_data->{'kernel'}; + $rows->[$j]{main::key($num++,0,5,'xorg')} = $gpu_data->{'xorg'}; + } + } + else { + $gpu_data->{'series'} ||= 'N/A'; + $rows->[$j]{main::key($num++,1,3,'non-free')} = $gpu_data->{'series'}; + $rows->[$j]{main::key($num++,0,4,'status')} = $gpu_data->{'status'}; + } + } + if ($gpu_data->{'arch'}){ + $rows->[$j]{main::key($num++,1,2,'arch')} = $gpu_data->{'arch'}; + # we don't need to see repeated values here, but usually code is different. + if ($b_admin && $gpu_data->{'code'} && + $gpu_data->{'code'} ne $gpu_data->{'arch'}){ + $rows->[$j]{main::key($num++,0,3,'code')} = $gpu_data->{'code'}; + } + if ($b_admin && $gpu_data->{'process'}){ + $rows->[$j]{main::key($num++,0,3,'process')} = $gpu_data->{'process'}; + } + if ($b_admin && $gpu_data->{'years'}){ + $rows->[$j]{main::key($num++,0,3,'built')} = $gpu_data->{'years'}; + } + } + } + if ($extra > 0){ + $bus_id = (!$row->[2] && !$row->[3]) ? 'N/A' : "$row->[2].$row->[3]"; + if ($extra > 1 && $bus_id ne 'N/A'){ + main::get_pcie_data($bus_id,$j,$rows,\$num,'gpu'); + } + if ($extra > 1 && $monitor_ids){ + port_output($bus_id,$j,$rows,\$num); + } + $rows->[$j]{main::key($num++,0,2,'bus-ID')} = $bus_id; + } + if ($extra > 1){ + my $chip_id = main::get_chip_id($row->[5],$row->[6]); + $rows->[$j]{main::key($num++,0,2,'chip-ID')} = $chip_id; + } + if ($extra > 2 && $row->[1]){ + $rows->[$j]{main::key($num++,0,2,'class-ID')} = $row->[1]; + } + if (!$bsd_type && $extra > 0 && $bus_id ne 'N/A' && $bus_id =~ /\.0$/){ + my $temp = main::get_device_temp($bus_id); + if ($temp){ + $rows->[$j]{main::key($num++,0,2,'temp')} = $temp . ' C'; + } + } + # print "$row->[0]\n"; + } + eval $end if $b_log; +} + +sub usb_output { + eval $start if $b_log; + my $rows = $_[0]; + my (@ids,$driver,$path_id,$product,@temp2); + my ($j,$num) = (0,1); + return if !$usb{'graphics'}; + foreach my $row (@{$usb{'graphics'}}){ + # these tests only work for /sys based usb data for now + $num = 1; + $j = scalar @$rows; + # make sure to reset, or second device trips last flag + ($driver,$path_id,$product) = ('','',''); + $product = main::clean($row->[13]) if $row->[13]; + $driver = $row->[15] if $row->[15]; + $path_id = $row->[2] if $row->[2]; + $product ||= 'N/A'; + # note: for real usb video out, no generic drivers? webcams may have one though + if (!$driver){ + if ($row->[14] eq 'audio-video'){ + $driver = 'N/A'; + } + else { + $driver = 'N/A'; + } + } + push(@$rows, { + main::key($num++,1,1,'Device') => $product, + main::key($num++,0,2,'driver') => $driver, + main::key($num++,1,2,'type') => 'USB', + },); + if ($extra > 0){ + if ($extra > 1){ + $row->[8] ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'rev')} = $row->[8]; + if ($row->[17]){ + $rows->[$j]{main::key($num++,0,3,'speed')} = $row->[17]; + } + if ($row->[24]){ + $rows->[$j]{main::key($num++,0,3,'lanes')} = $row->[24]; + } + if ($b_admin && $row->[22]){ + $rows->[$j]{main::key($num++,0,3,'mode')} = $row->[22]; + } + } + my $bus_id = "$path_id:$row->[1]"; + if ($monitor_ids){ + port_output($bus_id,$j,$rows,\$num); + } + $rows->[$j]{main::key($num++,0,2,'bus-ID')} = $bus_id; + if ($extra > 1){ + $row->[7] ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'chip-ID')} = $row->[7]; + } + if ($extra > 2){ + if (defined $row->[5] && $row->[5] ne ''){ + $rows->[$j]{main::key($num++,0,2,'class-ID')} = "$row->[4]$row->[5]"; + } + if ($row->[16]){ + $rows->[$j]{main::key($num++,0,2,'serial')} = main::filter($row->[16]); + } + } + } + } + eval $end if $b_log; +} + +# args: $rows, $num by ref +sub port_output { + my ($bus_id,$j,$rows,$num) = @_; + my (@connected,@disabled,@empty); + foreach my $id (keys %$monitor_ids){ + next if !$monitor_ids->{$id}{'status'}; + if ($monitor_ids->{$id}{'path'} =~ m|\Q$bus_id/drm/\E|){ + # status can be: connected|disconnected|unknown + if ($monitor_ids->{$id}{'status'} eq 'connected'){ + if ($monitor_ids->{$id}{'enabled'} eq 'enabled'){ + push(@connected,$id); + } + else { + push(@disabled,$id); + } + } + else { + push(@empty,$id); + } + } + } + if (@connected || @empty || @disabled){ + my ($off,$active,$unused); + my $split = ','; # add space if many to allow for wrapping + $rows->[$j]{main::key($$num++,1,2,'ports')} = ''; + $split = ', ' if scalar @connected > 3; + $active = (@connected) ? join($split,sort @connected) : 'none'; + $rows->[$j]{main::key($$num++,0,3,'active')} = $active; + if (@disabled){ + $split = (scalar @disabled > 3) ? ', ' : ','; + $off = join($split,sort @disabled); + $rows->[$j]{main::key($$num++,0,3,'off')} = $off; + } + $split = (scalar @empty > 3) ? ', ' : ','; + $unused = (@empty) ? join($split,sort @empty) : 'none'; + $rows->[$j]{main::key($$num++,0,3,'empty')} = $unused; + } +} + +## DISPLAY OUTPUT ## +sub display_output(){ + eval $start if $b_log; + my $rows = $_[0]; + my ($num,$j) = (0,scalar @$rows); + # note: these may not always be set, they won't be out of X, for example + display_protocol(); + # get rid of all inactive or disabled monitor port ids + set_active_monitors() if $monitor_ids; + $graphics{'protocol'} = 'wayland' if $force{'wayland'}; + # note, since the compositor is the server with wayland, always show it + if ($extra > 1 || $graphics{'protocol'} eq 'wayland'){ + set_compositor_data(); + } + if ($b_display){ + # Add compositors as data sources found + if ($graphics{'protocol'} eq 'wayland'){ + display_data_wayland(); + } + if (!$b_wayland_data){ + display_data_x() if !$force{'wayland'}; + } + } + else { + $graphics{'tty'} = tty_data(); + } + # no xdpyinfo installed + # undef $graphics{'x-server'}; + # Completes X server data if no previous detections, tests/adds xwayland + display_server_data(); + if (!defined $graphics{'display-id'} && defined $ENV{'DISPLAY'}){ + $graphics{'display-id'} = $ENV{'DISPLAY'}; + } + # print Data::Dumper::Dumper $graphics{'x-server'}; + # print Data::Dumper::Dumper \%graphics; + if (%graphics){ + my ($driver_note,$resolution,$server_string) = ('','',''); + my ($b_screen_monitors); + my $x_drivers = (!$force{'wayland'}) ? display_drivers_x() : []; + # print 'result: ', Data::Dumper::Dumper $x_drivers; + # print "$graphics{'x-server'} $graphics{'x-version'} $graphics{'x-vendor-release'}","\n"; + if ($graphics{'x-server'}){ + $server_string = $graphics{'x-server'}->[0][0]; + # print "$server_string\n"; + } + if (!$graphics{'protocol'} && !$server_string && !$graphics{'x-server'} && + !@$x_drivers && !$graphics{'compositors'}){ + $server_string = main::message('display-server'); + push(@$rows,{ + main::key($num++,1,1,'Display') => '', + main::key($num++,0,2,'server') => $server_string, + }); + } + else { + $server_string ||= 'N/A'; + push(@$rows, { + main::key($num++,1,1,'Display') => $graphics{'protocol'}, + main::key($num++,1,2,'server') => $server_string, + }); + if ($graphics{'x-server'} && $graphics{'x-server'}->[0][1]){ + $rows->[$j]{main::key($num++,0,3,'v')} = $graphics{'x-server'}->[0][1]; + } + if ($graphics{'x-server'} && $graphics{'x-server'}->[1][0]){ + $rows->[$j]{main::key($num++,1,3,'with')} = $graphics{'x-server'}->[1][0]; + if ($graphics{'x-server'}->[1][1]){ + $rows->[$j]{main::key($num++,0,4,'v')} = $graphics{'x-server'}->[1][1]; + } + } + if ($graphics{'compositors'}){ + if (scalar @{$graphics{'compositors'}} == 1){ + $rows->[$j]{main::key($num++,1,2,'compositor')} = $graphics{'compositors'}->[0][0]; + if ($graphics{'compositors'}->[0][1]){ + $rows->[$j]{main::key($num++,0,3,'v')} = $graphics{'compositors'}->[0][1]; + } + } + else { + my $i =1; + $rows->[$j]{main::key($num++,1,2,'compositors')} = ''; + foreach (@{$graphics{'compositors'}}){ + $rows->[$j]{main::key($num++,1,3,$i)} = $_->[0]; + if ($_->[1]){ + $rows->[$j]{main::key($num++,0,4,'v')} = $_->[1]; + } + $i++; + } + } + } + # note: if no xorg log, and if wayland, there will be no xorg drivers, + # obviously, so we use the driver(s) found in the card section. + # Those come from lspci kernel drivers so should be no xorg/wayland issues. + if (!@$x_drivers || !$x_drivers->[0]){ + # Fallback: specific case: in Arch/Manjaro gdm run systems, Xorg.0.log is + # located inside this directory, which is not readable unless you are root + # Normally Arch gdm log is here: ~/.local/share/xorg/Xorg.1.log + if (!$graphics{'protocol'} || $graphics{'protocol'} ne 'wayland'){ + # Problem: as root, wayland has no info anyway, including wayland detection. + if (-e '/var/lib/gdm' && !$b_root){ + if ($graphics{'gpu-drivers'}){ + $driver_note = main::message('display-driver-na-try-root'); + } + else { + $driver_note = main::message('root-suggested'); + } + } + } + } + # if TinyX, will always have display-driver set + if ($graphics{'tinyx'} && $graphics{'display-driver'}){ + $rows->[$j]{main::key($num++,0,2,'driver')} = join(',',@{$graphics{'display-driver'}}); + } + else { + my $gpu_drivers = gpu_drivers_sys('all'); + my $note_indent = 4; + if (@$gpu_drivers || $graphics{'dri-drivers'} || @$x_drivers){ + $rows->[$j]{main::key($num++,1,2,'driver')} = ''; + # The only wayland setups with x drivers have xorg, transitional that is. + if (@$x_drivers){ + $rows->[$j]{main::key($num++,1,3,'X')} = ''; + my $driver = ($x_drivers->[0]) ? join(',',@{$x_drivers->[0]}) : 'N/A'; + $rows->[$j]{main::key($num++,1,4,'loaded')} = $driver; + if ($x_drivers->[1]){ + $rows->[$j]{main::key($num++,0,4,'unloaded')} = join(',',@{$x_drivers->[1]}); + } + if ($x_drivers->[2]){ + $rows->[$j]{main::key($num++,0,4,'failed')} = join(',',@{$x_drivers->[2]}); + } + if ($extra > 1 && $x_drivers->[3]){ + $rows->[$j]{main::key($num++,0,4,'alternate')} = join(',',@{$x_drivers->[3]}); + } + } + if ($graphics{'dri-drivers'}){ + # note: if want to exclude if matches gpu/x driver, loop through and test. + # Here using all dri drivers found. + $rows->[$j]{main::key($num++,1,3,'dri')} = join(',',@{$graphics{'dri-drivers'}}); + } + my $drivers; + if (@$gpu_drivers){ + $drivers = join(',',@$gpu_drivers); + } + else { + $drivers = ($graphics{'gpu-drivers'}) ? join(',',@{$graphics{'gpu-drivers'}}): 'N/A'; + } + $rows->[$j]{main::key($num++,1,3,'gpu')} = $drivers; + } + else { + $note_indent = 3; + $rows->[$j]{main::key($num++,1,2,'driver')} = 'N/A'; + } + if ($driver_note){ + $rows->[$j]{main::key($num++,0,$note_indent,'note')} = $driver_note; + } + } + } + if (!$show{'graphic-basic'} && $extra > 1 && $graphics{'display-rect'}){ + $rows->[$j]{main::key($num++,0,2,'d-rect')} = $graphics{'display-rect'}; + } + if (!$show{'graphic-basic'} && $extra > 1){ + if (defined $graphics{'display-id'}){ + $rows->[$j]{main::key($num++,0,2,'display-ID')} = $graphics{'display-id'}; + } + if (defined $graphics{'display-screens'}){ + $rows->[$j]{main::key($num++,0,2,'screens')} = $graphics{'display-screens'}; + } + if (defined $graphics{'display-default-screen'} && + $graphics{'display-screens'} && $graphics{'display-screens'} > 1){ + $rows->[$j]{main::key($num++,0,2,'default screen')} = $graphics{'display-default-screen'}; + } + } + # TinyX may pack actual resolution data into no-screens if it was found + if ($graphics{'no-screens'}){ + my $res = (!$show{'graphic-basic'} && $extra > 1 && !$graphics{'tinyx'}) ? 'note' : 'resolution'; + $rows->[$j]{main::key($num++,0,2,$res)} = $graphics{'no-screens'}; + } + elsif ($graphics{'screens'}){ + my ($diag,$dpi,$hz,$size); + my ($m_count,$basic_count,$screen_count) = (0,0,0); + my $s_count = ($graphics{'screens'}) ? scalar @{$graphics{'screens'}}: 0; + foreach my $main (@{$graphics{'screens'}}){ + $m_count = scalar keys %{$main->{'monitors'}} if $main->{'monitors'}; + $screen_count++; + ($diag,$dpi,$hz,$resolution,$size) = (); + $j++ if !$show{'graphic-basic'}; + if (!$show{'graphic-basic'} || $m_count == 0){ + if (!$show{'graphic-basic'} && defined $main->{'screen'}){ + $rows->[$j]{main::key($num++,1,2,'Screen')} = $main->{'screen'}; + } + if ($main->{'res-x'} && $main->{'res-y'}){ + $resolution = $main->{'res-x'} . 'x' . $main->{'res-y'}; + if ($main->{'hz'} && $show{'graphic-basic'}){ + $resolution .= '~' . $main->{'hz'} . 'Hz'; + } + } + $resolution ||= 'N/A'; + if ($s_count == 1 || !$show{'graphic-basic'}){ + $rows->[$j]{main::key($num++,0,3,'s-res')} = $resolution; + } + elsif ($show{'graphic-basic'}){ + $rows->[$j]{main::key($num++,0,3,'s-res')} = '' if $screen_count == 1; + $rows->[$j]{main::key($num++,0,3,$screen_count)} = $resolution; + } + if ($main->{'s-dpi'} && (!$show{'graphic-basic'} && $extra > 1)){ + $rows->[$j]{main::key($num++,0,3,'s-dpi')} = $main->{'s-dpi'}; + } + if (!$show{'graphic-basic'} && $extra > 2){ + if ($main->{'size-missing'}){ + $rows->[$j]{main::key($num++,0,3,'s-size')} = $main->{'size-missing'}; + } + else { + if ($main->{'size-x'} && $main->{'size-y'}){ + $size = $main->{'size-x'} . 'x' . $main->{'size-y'} . + 'mm ('. $main->{'size-x-i'} . 'x' . $main->{'size-y-i'} . '")'; + $rows->[$j]{main::key($num++,0,3,'s-size')} = $size; + } + if ($main->{'diagonal'}){ + $diag = $main->{'diagonal-m'} . 'mm ('. $main->{'diagonal'} . '")'; + $rows->[$j]{main::key($num++,0,3,'s-diag')} = $diag; + } + } + } + } + if ($main->{'monitors'}){ + # print $basic_count . '::' . $m_count, "\n"; + $b_screen_monitors = 1; + if ($show{'graphic-basic'}){ + monitors_output_basic('screen',$main->{'monitors'}, + $main->{'s-dpi'},$j,$rows,\$num); + } + else { + monitors_output_full('screen',$main->{'monitors'}, + \$j,$rows,\$num); + } + } + elsif (!$show{'graphic-basic'} && $graphics{'no-monitors'}){ + $rows->[$j]{main::key($num++,0,4,'monitors')} = $graphics{'no-monitors'}; + } + } + } + elsif (!$b_display){ + $graphics{'tty'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'tty')} = $graphics{'tty'}; + } + # fallback, if no xrandr/xdpyinfo, if wayland, if console. Note we've + # deleted each key used in advanced_monitor_data() so those won't show again + if (!$b_screen_monitors && $monitor_ids && %$monitor_ids){ + if ($show{'graphic-basic'}){ + monitors_output_basic('monitor',$monitor_ids,'',$j,$rows,\$num); + } + else { + monitors_output_full('monitor',$monitor_ids,\$j,$rows,\$num); + } + } + } + eval $end if $b_log; +} + +sub monitors_output_basic { + eval $start if $b_log; + my ($type,$monitors,$s_dpi,$j,$row,$num) = @_; + my ($dpi,$resolution); + my ($basic_count,$m_count) = (0,scalar keys %{$monitors}); + foreach my $key (sort keys %{$monitors}){ + if ($type eq 'monitor' && (!$monitors->{$key}{'res-x'} || + !$monitors->{$key}{'res-y'})){ + next; + } + ($dpi,$resolution) = (); + $basic_count++; + if ($monitors->{$key}{'res-x'} && $monitors->{$key}{'res-y'}){ + $resolution = $monitors->{$key}{'res-x'} . 'x' . $monitors->{$key}{'res-y'}; + } + # using main, not monitor, dpi because we want xorg dpi, not physical screen dpi + $dpi = $s_dpi if $resolution && $extra > 1 && $s_dpi; + if ($monitors->{$key}{'hz'} && $resolution){ + $resolution .= '~' . $monitors->{$key}{'hz'} . 'Hz'; + } + $resolution ||= 'N/A'; + if ($basic_count == 1 && $m_count == 1){ + $row->[$j]{main::key($$num++,0,2,'resolution')} = $resolution; + } + else { + if ($basic_count == 1){ + $row->[$j]{main::key($$num++,1,2,'resolution')} = ''; + } + $row->[$j]{main::key($$num++,0,3,$basic_count)} = $resolution; + } + if (!$show{'graphic-basic'} && $m_count == $basic_count && $dpi){ + $row->[$j]{main::key($$num++,0,2,'s-dpi')} = $dpi; + } + } + eval $end if $b_log; +} + +# args: $j, $row, $num passed by ref +sub monitors_output_full { + eval $start if $b_log; + my ($type,$monitors,$j,$rows,$num) = @_; + my ($b_no_size,$resolution); + my ($m1,$m2,$m3,$m4) = ($type eq 'screen') ? (3,4,5,6) : (2,3,4,5); + # note: in case where mapped id != sys id, the key will not match 'monitor' + foreach my $key (sort keys %{$monitors}){ + $$j++; + $rows->[$$j]{main::key($$num++,1,$m1,'Monitor')} = $monitors->{$key}{'monitor'}; + if ($monitors->{$key}{'monitor-mapped'}){ + $rows->[$$j]{main::key($$num++,0,$m2,'mapped')} = $monitors->{$key}{'monitor-mapped'}; + } + if ($monitors->{$key}{'disabled'}){ + $rows->[$$j]{main::key($$num++,0,$m2,'note')} = $monitors->{$key}{'disabled'}; + } + if ($monitors->{$key}{'position'}){ + $rows->[$$j]{main::key($$num++,0,$m2,'pos')} = $monitors->{$key}{'position'}; + } + if ($monitors->{$key}{'model'}){ + $rows->[$$j]{main::key($$num++,0,$m2,'model')} = $monitors->{$key}{'model'}; + } + elsif ($monitors->{$key}{'model-id'}){ + $rows->[$$j]{main::key($$num++,0,$m2,'model-id')} = $monitors->{$key}{'model-id'}; + } + if ($extra > 2 && $monitors->{$key}{'serial'}){ + $rows->[$$j]{main::key($$num++,0,$m2,'serial')} = main::filter($monitors->{$key}{'serial'}); + } + if ($b_admin && $monitors->{$key}{'build-date'}){ + $rows->[$$j]{main::key($$num++,0,$m2,'built')} = $monitors->{$key}{'build-date'}; + } + if ($monitors->{$key}{'res-x'} || $monitors->{$key}{'res-y'} || + $monitors->{$key}{'hz'} || $monitors->{$key}{'size-x'} || + $monitors->{$key}{'size-y'}){ + if ($monitors->{$key}{'res-x'} && $monitors->{$key}{'res-y'}){ + $resolution = $monitors->{$key}{'res-x'} . 'x' . $monitors->{$key}{'res-y'}; + } + $resolution ||= 'N/A'; + $rows->[$$j]{main::key($$num++,0,$m2,'res')} = $resolution; + } + else { + if ($b_display){ + $resolution = main::message('monitor-na'); + } + else { + $resolution = main::message('monitor-console'); + } + $b_no_size = 1; + $rows->[$$j]{main::key($$num++,0,$m2,'size-res')} = $resolution; + } + if ($extra > 2 && $monitors->{$key}{'hz'}){ + $rows->[$$j]{main::key($$num++,0,$m2,'hz')} = $monitors->{$key}{'hz'}; + } + if ($monitors->{$key}{'dpi'}){ + $rows->[$$j]{main::key($$num++,0,$m2,'dpi')} = $monitors->{$key}{'dpi'}; + } + if ($b_admin && $monitors->{$key}{'gamma'}){ + $rows->[$$j]{main::key($$num++,0,$m2,'gamma')} = $monitors->{$key}{'gamma'}; + } + if ($show{'edid'} && $monitors->{$key}{'colors'}){ + $rows->[$$j]{main::key($$num++,1,$m2,'chroma')} = ''; + $rows->[$$j]{main::key($$num++,1,$m3,'red')} = ''; + $rows->[$$j]{main::key($$num++,0,$m4,'x')} = $monitors->{$key}{'colors'}{'red_x'}; + $rows->[$$j]{main::key($$num++,0,$m4,'y')} = $monitors->{$key}{'colors'}{'red_y'}; + $rows->[$$j]{main::key($$num++,1,$m3,'green')} = ''; + $rows->[$$j]{main::key($$num++,0,$m4,'x')} = $monitors->{$key}{'colors'}{'green_x'}; + $rows->[$$j]{main::key($$num++,0,$m4,'y')} = $monitors->{$key}{'colors'}{'green_y'}; + $rows->[$$j]{main::key($$num++,1,$m3,'blue')} = ''; + $rows->[$$j]{main::key($$num++,0,$m4,'x')} = $monitors->{$key}{'colors'}{'blue_x'}; + $rows->[$$j]{main::key($$num++,0,$m4,'y')} = $monitors->{$key}{'colors'}{'blue_y'}; + $rows->[$$j]{main::key($$num++,1,$m3,'white')} = ''; + $rows->[$$j]{main::key($$num++,0,$m4,'x')} = $monitors->{$key}{'colors'}{'white_x'}; + $rows->[$$j]{main::key($$num++,0,$m4,'y')} = $monitors->{$key}{'colors'}{'white_y'}; + } + if ($extra > 2 && $monitors->{$key}{'scale'}){ + $rows->[$$j]{main::key($$num++,0,$m2,'scale')} = $monitors->{$key}{'scale'}; + } + if ($extra > 2 && $monitors->{$key}{'size-x'} && $monitors->{$key}{'size-y'}){ + my $size = $monitors->{$key}{'size-x'} . 'x' . $monitors->{$key}{'size-y'} . + 'mm ('. $monitors->{$key}{'size-x-i'} . 'x' . $monitors->{$key}{'size-y-i'} . '")'; + $rows->[$$j]{main::key($$num++,0,$m2,'size')} = $size; + } + if ($monitors->{$key}{'diagonal'}){ + my $diag = $monitors->{$key}{'diagonal-m'} . 'mm ('. $monitors->{$key}{'diagonal'} . '")'; + $rows->[$$j]{main::key($$num++,0,$m2,'diag')} = $diag; + } + elsif ($b_display && !$b_no_size && !$monitors->{$key}{'size-x'} && + !$monitors->{$key}{'size-y'}){ + $rows->[$$j]{main::key($$num++,0,$m2,'size')} = main::message('monitor-na');; + } + if ($b_admin && $monitors->{$key}{'ratio'}){ + $rows->[$$j]{main::key($$num++,0,$m2,'ratio')} = $monitors->{$key}{'ratio'}; + } + if ($extra > 2){ + if (!$monitors->{$key}{'modes'} || !@{$monitors->{$key}{'modes'}}){ + $monitors->{$key}{'modes'} = ['N/A']; + } + my $cnt = scalar @{$monitors->{$key}{'modes'}}; + if ($cnt == 1 || ($cnt > 2 && $show{'edid'})){ + $rows->[$$j]{main::key($$num++,0,$m2,'modes')} = join(', ', @{$monitors->{$key}{'modes'}}); + } + else { + $rows->[$$j]{main::key($$num++,1,$m2,'modes')} = ''; + $rows->[$$j]{main::key($$num++,0,$m3,'max')} = ${$monitors->{$key}{'modes'}}[0]; + $rows->[$$j]{main::key($$num++,0,$m3,'min')} = ${$monitors->{$key}{'modes'}}[-1]; + } + } + if ($show{'edid'}){ + if ($monitors->{$key}{'edid-errors'}){ + $$j++; + my $cnt = 1; + $rows->[$$j]{main::key($$num++,1,$m2,'EDID-Errors')} = ''; + foreach my $err (@{$monitors->{$key}{'edid-errors'}}){ + $rows->[$$j]{main::key($$num++,0,$m3,$cnt)} = $err; + $cnt++; + } + } + if ($monitors->{$key}{'edid-warnings'}){ + $$j++; + my $cnt = 1; + $rows->[$$j]{main::key($$num++,1,$m2,'EDID-Warnings')} = ''; + foreach my $warn (@{$monitors->{$key}{'edid-warnings'}}){ + $rows->[$$j]{main::key($$num++,0,$m3,$cnt)} = $warn; + $cnt++; + } + } + } + } + # we only want to see gpu drivers for wayland since otherwise it's x drivers. +# if ($b_display && $b_admin && $graphics{'protocol'} && +# $graphics{'protocol'} eq 'wayland' && $monitors->{$key}{'drivers'}){ +# $driver = join(',',@{$monitors->{$key}{'drivers'}}); +# $rows->[$j]{main::key($$num++,0,$m2,'driver')} = $driver; +# } + eval $end if $b_log; +} + +## DISPLAY API ## + +# API Output # + +# GLX/OpenGL EGL Vulkan XVesa +sub display_api { + eval $start if $b_log; + my $rows = $_[0]; + # print ("$b_display : $b_root\n"); + # xvesa is absolute, if it's there, it works in or out of display + if ($graphics{'xvesa'}){ + xvesa_output($rows); + return; + } + my ($b_egl,$b_egl_print,$b_glx,$b_glx_print,$b_vulkan,$api,$program,$type); + my $gl = {}; + if ($fake{'egl'} || ($program = main::check_program('eglinfo'))){ + gl_data('egl',$program,$rows,$gl); + $b_egl = 1; + } + if ($fake{'glx'} || ($program = main::check_program('glxinfo'))){ + gl_data('glx',$program,$rows,$gl) if $b_display; + $b_glx = 1; + } + # Note: we let gl/egl output handle null or root null data issues + if ($gl->{'glx'}){ + process_glx_data($gl->{'glx'},$b_glx); + } + # egl/vulkan give data out of display, and for root + # if ($b_egl}){ + if ($b_egl && ($show{'graphic-full'} || !$gl->{'glx'})){ + egl_output($rows,$gl); + $b_egl_print = 1; + } + # fill in whatever was missing from eglinfo, or if legacy system/no eglinfo + # if ($b_glx || $gl->{'glx'}){ + if (($show{'graphic-full'} && ($b_glx || $gl->{'glx'})) || + (!$show{'graphic-full'} && !$b_egl_print && ($b_glx || $gl->{'glx'}))){ + opengl_output($rows,$gl); + $b_glx = 1; + $b_glx_print = 1; + } + # if ($fake{'vulkan'} || ($program = main::check_program('vulkaninfo'))){ + if (($fake{'vulkan'} || ($program = main::check_program('vulkaninfo'))) && + ($show{'graphic-full'} || (!$b_egl_print && !$b_glx_print))){ + vulkan_output($program,$rows); + $b_vulkan = 1; + } + if ($show{'graphic-full'} || (!$b_egl_print && !$b_glx_print)){ + # remember, sudo/root usually has empty $DISPLAY as well + if ($b_display){ + # first do positive tests, won't be set for sudo/root + if (!$b_glx && $graphics{'protocol'} eq 'x11'){ + $api = 'OpenGL'; + $type = 'glx-missing'; + } + elsif (!$b_egl && $graphics{'protocol'} eq 'wayland'){ + $api = 'EGL'; # /GBM + $type = 'egl-missing'; + } + elsif (!$b_glx && + (main::check_program('X') || main::check_program('Xorg'))){ + $api = 'OpenGL'; + $type = 'glx-missing'; + } + elsif (!$b_egl && main::check_program('Xwayland')){ + $api = 'EGL'; + $type = 'egl-missing'; + } + elsif (!$b_egl && !$b_glx && !$b_vulkan) { + $api = 'N/A'; + $type = 'gfx-api'; + } + } + else { + if (!$b_glx && + (main::check_program('X') || main::check_program('Xorg'))){ + $api = 'OpenGL'; + $type = 'glx-missing-console'; + } + elsif (!$b_egl && main::check_program('Xwayland')){ + $api = 'EGL'; + $type = 'egl-missing-console'; + } + # we don't know what it is, headless system, non xwayland wayland + elsif (!$b_egl && !$b_glx && !$b_vulkan) { + $api = 'N/A'; + $type = 'gfx-api-console'; + } + } + no_data_output($api,$type,$rows) if $type; + } + eval $end if $b_log; +} + +sub no_data_output { + eval $start if $b_log; + my ($api,$type,$rows) = @_; + my $num = 0; + push(@$rows, { + main::key($num++,1,1,'API') => $api, + main::key($num++,0,2,'Message') => main::message($type) + }); + eval $end if $b_log; +} + +sub egl_output { + eval $start if $b_log; + my ($rows,$gl) = @_; + if (!$gl->{'egl'}){ + my $api = 'EGL'; + my $type = 'egl-null'; + no_data_output($api,$type,$rows); + return 0; + } + my ($i,$j,$num) = (0,scalar @$rows,0); + my ($value); + my $ref; + my $data = $gl->{'egl'}{'data'}; + my $plat = $gl->{'egl'}{'platforms'}; + push(@$rows, { + main::key($num++,1,1,'API') => 'EGL', + }); + if ($extra < 2){ + $value = ($data->{'versions'}) ? join(',',sort keys %{$data->{'versions'}}): 'N/A'; + } + else { + $value = ($data->{'version'}) ? $data->{'version'}: 'N/A'; + } + $rows->[$j]{main::key($num++,0,2,'v')} = $value; + if ($extra < 2){ + $value = ($data->{'drivers'}) ? join(',',sort keys %{$data->{'drivers'}}): 'N/A'; + $rows->[$j]{main::key($num++,0,2,'drivers')} = $value; + $value = ($data->{'platforms'}{'active'}) ? join(',',@{$data->{'platforms'}{'active'}}) : 'N/A'; + if ($extra < 1){ + $rows->[$j]{main::key($num++,0,2,'platforms')} = $value; + } + else { + $rows->[$j]{main::key($num++,1,2,'platforms')} = ''; + $rows->[$j]{main::key($num++,0,3,'active')} = $value; + $value = ($data->{'platforms'}{'inactive'}) ? join(',',@{$data->{'platforms'}{'inactive'}}) : 'N/A'; + $rows->[$j]{main::key($num++,0,3,'inactive')} = $value; + } + } + else { + if ($extra > 2 && $data->{'hw'}){ + $i = 0; + $rows->[$j]{main::key($num++,1,2,'hw')} = ''; + foreach my $key (sort keys %{$data->{'hw'}}){ + $value = ($key ne $data->{'hw'}{$key}) ? $data->{'hw'}{$key} . ' ' . $key: $key; + $rows->[$j]{main::key($num++,0,3,'drv')} = $value; + } + } + $rows->[$j]{main::key($num++,1,2,'platforms')} = ''; + $data->{'version'} ||= 0; + $i = 0; + foreach my $key (sort keys %$plat){ + next if !$plat->{$key}{'status'} || $plat->{$key}{'status'} eq 'inactive'; + if ($key eq 'device'){ + foreach my $id (sort keys %{$plat->{$key}}){ + next if ref $plat->{$key}{$id} ne 'HASH'; + $rows->[$j]{main::key($num++,1,3,$key)} = $id; + $ref = $plat->{$key}{$id}{'egl'}; + egl_advanced_output($rows,$ref,\$num,$j,4,$data->{'version'}); + } + } + else { + $rows->[$j]{main::key($num++,1,3,$key)} = ''; + $ref = $plat->{$key}{'egl'}; + egl_advanced_output($rows,$ref,\$num,$j,4,$data->{'version'}); + } + } + if (!$data->{'platforms'}{'active'}){ + $rows->[$j]{main::key($num++,0,3,'active')} = 'N/A'; + } + if ($data->{'platforms'}{'inactive'}){ + $rows->[$j]{main::key($num++,0,3,'inactive')} = join(',',@{$data->{'platforms'}{'inactive'}}); + } + } + eval $end if $b_log; +} + +# args: 0: $rows; 1: data ref; 2: \$num; 3: $j; 4: indent; 5: $b_plat_v +sub egl_advanced_output { + my ($rows,$ref,$num,$j,$ind,$version) = @_; + my $value; + # version is set to 0 for math + if ($version && (!$ref->{'version'} || $version != $ref->{'version'})){ + $value = ($ref->{'version'}) ? $ref->{'version'} : 'N/A'; + $rows->[$j]{main::key($$num++,0,$ind,'egl')} = $value; + undef $value; + } + if ($ref->{'driver'}){ + $value = $ref->{'driver'}; + } + else { + if ($ref->{'vendor'} && $ref->{'vendor'} ne 'mesa'){ + $value = $ref->{'vendor'}; + } + $value ||= 'N/A'; + } + $rows->[$j]{main::key($$num++,0,$ind,'drv')} = $value; +} + +sub opengl_output { + eval $start if $b_log; + my ($rows,$gl) = @_; + # egl will have set $glx if present + if (!$gl->{'glx'}){ + my $api = 'OpenGL'; + my $type; + if ($b_display){ + $type = ($b_root) ? 'glx-display-root': 'glx-null'; + } + else { + $type = ($b_root) ? 'glx-console-root' : 'glx-console-try'; + } + no_data_output($api,$type,$rows); + return 0; + } + my ($j,$num) = (scalar @$rows,0); + my $value; + # print join("\n", %$gl),"\n"; + my $glx = $gl->{'glx'}; + $glx->{'opengl'}{'version'} ||= 'N/A'; + push(@$rows, { + main::key($num++,1,1,'API') => 'OpenGL', + main::key($num++,0,2,'v') => $glx->{'opengl'}{'version'}, + }); + if ($glx->{'opengl'}{'compatibility'}{'version'}){ + $rows->[$j]{main::key($num++,0,2,'compat-v')} = $glx->{'opengl'}{'compatibility'}{'version'}; + } + if ($glx->{'opengl'}{'vendor'}){ + $rows->[$j]{main::key($num++,1,2,'vendor')} = $glx->{'opengl'}{'vendor'}; + $glx->{'opengl'}{'driver'}{'version'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'v')} = $glx->{'opengl'}{'driver'}{'version'}; + } + if ($extra > 0 && $glx->{'glx-version'}){ + $rows->[$j]{main::key($num++,0,2,'glx-v')} = $glx->{'glx-version'}; + } + if ($extra > 1 && $glx->{'es'}{'version'}){ + $rows->[$j]{main::key($num++,0,2,'es-v')} = $glx->{'es'}{'version'};; + } + if ($glx->{'note'}){ + $rows->[$j]{main::key($num++,0,2,'note')} = $glx->{'note'}; + } + if ($extra > 0 && (!$glx->{'note'} || $glx->{'direct-render'})){ + $glx->{'direct-render'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'direct-render')} = $glx->{'direct-render'}; + } + if (!$glx->{'note'} || $glx->{'opengl'}{'renderer'}){ + $glx->{'opengl'}{'renderer'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'renderer')} = $glx->{'opengl'}{'renderer'}; + } + if ($extra > 1 && $glx->{'info'}){ + if ($glx->{'info'}{'vendor-id'} && $glx->{'info'}{'device-id'}){ + $value = $glx->{'info'}{'vendor-id'} . ':' . $glx->{'info'}{'device-id'}; + $rows->[$j]{main::key($num++,0,2,'device-ID')} = $value; + } + if ($b_admin && $glx->{'info'}{'device-memory'}){ + $rows->[$j]{main::key($num++,1,2,'memory')} = $glx->{'info'}{'device-memory'}; + if ($glx->{'info'}{'unified-memory'}){ + $rows->[$j]{main::key($num++,0,3,'unified')} = $glx->{'info'}{'unified-memory'}; + } + } + # display id depends on xdpyinfo in Display line, which may not be present, + if (!$graphics{'display-id'} && $glx->{'display-id'} && $extra > 1){ + $rows->[$j]{main::key($num++,0,2,'display-ID')} = $glx->{'display-id'}; + } + } + eval $end if $b_log; +} + +sub vulkan_output { + eval $start if $b_log; + my ($program,$rows) = @_; + my $vulkan = {}; + vulkan_data($program,$vulkan); + if (!%$vulkan){ + my $api = 'Vulkan'; + my $type = 'vulkan-null'; + no_data_output($api,$type,$rows); + return 0; + } + my $num = 0; + my $j = scalar @$rows; + my ($value); + my $data = $vulkan->{'data'}; + my $devices = $vulkan->{'devices'}; + $data->{'version'} ||= 'N/A'; + push(@$rows,{ + main::key($num++,1,1,'API') => 'Vulkan', + main::key($num++,0,2,'v') => $data->{'version'}, + }); + # this will be expanded with -a to a full device report + if ($extra < 2){ + $value = ($data->{'drivers'}) ? join(',',@{$data->{'drivers'}}): 'N/A'; + $rows->[$j]{main::key($num++,0,2,'drivers')} = $value; + } + if ($extra > 2){ + $data->{'layers'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'layers')} = $data->{'layers'}; + } + if (!$b_admin){ + $value = ($data->{'surfaces'}) ? join(',',@{$data->{'surfaces'}}) : 'N/A'; + $rows->[$j]{main::key($num++,0,2,'surfaces')} = $value; + } + if ($extra > 0){ + if (!$devices){ + $rows->[$j]{main::key($num++,0,2,'devices')} = 'N/A'; + } + else { + if ($extra < 2){ + $value = scalar keys %{$devices}; + $rows->[$j]{main::key($num++,0,2,'devices')} = $value; + } + else { + foreach my $id (sort keys %$devices){ + $rows->[$j]{main::key($num++,1,2,'device')} = $id; + $devices->{$id}{'device-type'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'type')} = $devices->{$id}{'device-type'}; + if ((($extra == 3 && !$b_admin) || + ($extra > 2 && !$devices->{$id}{'device-name'})) && + $devices->{$id}{'hw'} && $devices->{$id}{'hw'} ne 'nvidia'){ + $rows->[$j]{main::key($num++,0,3,'hw')} = $devices->{$id}{'hw'}; + } + if ($b_admin){ + $value = ($devices->{$id}{'device-name'}) ? + $devices->{$id}{'device-name'}: 'N/A'; + $rows->[$j]{main::key($num++,0,3,'name')} = $value; + } + if ($extra > 1){ + if ($devices->{$id}{'driver-name'}){ + $value = $devices->{$id}{'driver-name'}; + if ($devices->{$id}{'mesa'} && $value ne 'mesa'){ + $value = 'mesa ' . $value; + } + $rows->[$j]{main::key($num++,1,3,'driver')} = $value; + if ($b_admin && $devices->{$id}{'driver-info'}){ + $rows->[$j]{main::key($num++,0,4,'v')} = $devices->{$id}{'driver-info'}; + } + } + else { + $rows->[$j]{main::key($num++,0,3,'driver')} = 'N/A'; + } + $value = ($devices->{$id}{'device-id'} && $devices->{$id}{'vendor-id'}) ? + $devices->{$id}{'vendor-id'} . ':' . $devices->{$id}{'device-id'} : 'N/A'; + $rows->[$j]{main::key($num++,0,3,'device-ID')} = $value; + if ($b_admin){ + $value = ($devices->{$id}{'surfaces'}) ? + join(',',@{$devices->{$id}{'surfaces'}}): 'N/A'; + $rows->[$j]{main::key($num++,0,3,'surfaces')} = $value; + } + } + } + } + } + } + eval $end if $b_log; +} + +sub xvesa_output { + eval $start if $b_log; + my ($rows) = @_; + my ($controller,$dac,$interface,$ram,$source,$version); + # note: goes to stderr, not stdout + my @data = main::grabber($graphics{'xvesa'} . ' -listmodes 2>&1'); + my $j = scalar @$rows; + my $num = 0; + # gop replaced uga, both for uefi + # WARNING! Never seen a GOP type UEFI, needs more data + if ($data[0] && $data[0] =~ /^(VBE|GOP|UGA)\s+version\s+(\S+)\s\(([^)]+)\)/i){ + $interface = $1; + $version = $2; + $source = $3; + } + if ($data[1] && $data[1] =~ /^DAC is ([^,]+), controller is ([^,]+)/i){ + $dac = $1; + $controller = $2; + } + if ($data[2] && $data[2] =~ /^Total memory:\s+(\d+)\s/i){ + $ram = $1; + $ram = main::get_size($ram,'string'); + } + if (!$interface){ + $rows->[$j]{main::key($num++,1,1,'API')} = 'VBE/GOP'; + $rows->[$j]{main::key($num++,0,2,'Message')} = main::message('xvesa-null'); + } + else { + $rows->[$j]{main::key($num++,1,1,'API')} = $interface; + $rows->[$j]{main::key($num++,0,2,'v')} = ($version) ? $version : 'N/A'; + $rows->[$j]{main::key($num++,0,2,'source')} = ($source) ? $source : 'N/A'; + if ($dac){ + $rows->[$j]{main::key($num++,0,2,'dac')} = $dac; + $rows->[$j]{main::key($num++,0,2,'controller')} = $controller; + } + if ($ram){ + $rows->[$j]{main::key($num++,0,2,'ram')} = $ram; + } + } + eval $end if $b_log; +} + +# API Data # +sub gl_data { + eval $start if $b_log; + my ($source,$program,$rows,$gl) = @_; + my ($b_opengl,$msg); + my ($gl_data,$results) = ([],[]); + # only check these if no eglinfo or eglinfo had no opengl data + $b_opengl = 1 if ($source eq 'egl' || !$gl->{'glx'}); + # NOTE: glxinfo -B is not always available, unfortunately + if ($dbg[56] || $b_log){ + $msg = "${line1}GL Source: $source\n${line3}"; + print $msg if $dbg[56]; + push(@$results,$msg) if $b_log; + } + if ($source eq 'glx'){ + if (!$fake{'glx'}){ + $gl_data = main::grabber("$program $display_opt 2>/dev/null",'','','ref'); + } + else { + my $file; + # $file = "$fake_data_dir/graphics/glxinfo/glxinfo-2012-nvidia-glx1.4.txt"; + # $file = "$fake_data_dir/graphics/glxinfo/glxinfo-ssh-centos.txt"; + # $file = "$fake_data_dir/graphics/glxinfo/glxiinfo-t420-intel-1.txt"; + # $file = "$fake_data_dir/graphics/glxinfo/glxinfo-mali-allwinner-lima-1.txt"; + # $file = "$fake_data_dir/graphics/glxinfo/glxinfo-partial-intel-5500-1.txt"; + # $file = "$fake_data_dir/graphics/glxinfo/glxinfo-vbox-debian-etch-1.txt"; + # $file = "$fake_data_dir/graphics/glxinfo/glxinfo-x11-neomagic-lenny-1.txt"; + # $file = "$fake_data_dir/graphics/glxinfo/glxinfo-nvidia-gl4.6-chr.txt"; + # $file = "$fake_data_dir/graphics/glxinfo/glxinfo-intel-atom-dell_studio-bm.txt"; + # $file = "$fake_data_dir/graphics/glxinfo/glxinfo-asus_1025c-atom-bm.txt"; + # $file = "$fake_data_dir/graphics/glxinfo/glxinfo-2011-nvidia-glx1.4.txt"; + # $file = "$fake_data_dir/graphics/glxinfo/glxinfo-amd-dz-mesa-git.txt"; + $gl_data= main::reader($file,'','ref'); + } + } + else { + if (!$fake{'egl'}){ + $gl_data = main::grabber("$program 2>/dev/null",'','','ref'); + } + else { + my $file; + # $file = "$fake_data_dir/graphics/egl-es/eglinfo-x11-3.txt"; + # $file = "$fake_data_dir/graphics/egl-es/eglinfo-wayland-intel-c30.txt"; + # $file = "$fake_data_dir/grapOhics/egl-es/eglinfo-2022-x11-nvidia-egl1.5.txt"; + # $file = "$fake_data_dir/graphics/egl-es/eglinfo-wayland-intel-nvidia-radu.txt"; + # $file = "$fake_data_dir/graphics/egl-es/eglinfo-intel-atom-dell_studio-bm.txt"; + # $file = "$fake_data_dir/graphics/egl-es/eglinfo-asus_1025c-atom-bm.txt"; + # $file = "$fake_data_dir/graphics/egl-es/eglinfo-x11-amd-raphael-1.txt"; + # $file = "$fake_data_dir/graphics/egl-es/eglinfo-x11-vm-version-odd.txt"; + $gl_data = main::reader($file,'','ref'); + } + } + # print join("\n", @$gl_data),"\n"; + if (!$gl_data || !@$gl_data){ + if ($dbg[56] || $b_log){ + $msg = "No data found for GL Source: $source" if $dbg[56]; + print "$msg\n" if $dbg[56]; + push(@$results,$msg) if $b_log; + } + return 0; + } + # some error cases have only a few top value but not empty + elsif ($source eq 'glx' && scalar @$gl_data > 5){ + $gl->{'glx'}{'source'} = $source; + } + set_mesa_drivers() if $source eq 'egl' && !%mesa_drivers; + my ($b_device,$b_platform,$b_mem_info,$b_rend_info,$device,$platform, + $value,$value2,@working); + foreach my $line (@$gl_data){ + next if (!$b_rend_info && !$b_mem_info) && $line =~ /^(\s|0x)/; + if (($b_rend_info || $b_mem_info) && $line =~ /^\S/){ + ($b_mem_info,$b_rend_info) = (); + } + @working = split(/\s*:\s*/,$line,2); + next if !@working; + if ($dbg[56] || $b_log){ + $msg = $line; + print "$msg\n" if $dbg[56]; + push(@$results,$msg) if $b_log; + } + if ($source eq 'egl'){ + # eglinfo: eglInitialize failed + # This is first line after platform fail for devices, but for Device + # it would be the second or later line. The Device platform can fail, or + # specific device can fail + if ($b_platform){ + $value = ($line =~ /Initialize failed/) ? 'inactive': 'active'; + push(@{$gl->{'egl'}{'data'}{'platforms'}{$value}},$platform); + $gl->{'egl'}{'platforms'}{$platform}{'status'} = $value; + $b_platform = 0; + } + # note: can be sub item: Platform Device platform:; Platform Device: + elsif ($working[0] =~ /^(\S+) platform/i){ + $platform = lc($1); + undef $device; + $b_platform = 1; + } + if ($platform && defined $device && $working[0] eq 'eglinfo'){ + push(@{$gl->{'egl'}{'data'}{'platforms'}{'inactive'}},"$platform-$device"); + undef $device; + } + if ($platform && $platform eq 'device' && $working[0] =~ /^Device #(\d+)/){ + $device = $1; + } + if ($working[0] eq 'EGL API version'){ + if (!defined $platform){ + $gl->{'egl'}{'data'}{'api-version'} = $working[1]; + } + elsif (defined $device){ + $gl->{'egl'}{'platforms'}{$platform}{$device}{'egl'}{'api-version'} = $working[1]; + } + else { + $gl->{'egl'}{'platforms'}{$platform}{'egl'}{'api-version'} = $working[1]; + } + } + elsif ($working[0] eq 'EGL version string'){ + # seen case of: 1.4 (DRI2) + $working[1] =~ s/^([\d\.]+)(\s.*)?/$1/; + if (!defined $platform){ + $gl->{'egl'}{'data'}{'version'} = $working[1]; + } + elsif (defined $device){ + $gl->{'egl'}{'platforms'}{$platform}{$device}{'egl'}{'version'} = $working[1]; + } + else { + $gl->{'egl'}{'platforms'}{$platform}{'egl'}{'version'} = $working[1]; + } + $value = (defined $device) ? "$platform-$device": $platform; + push(@{$gl->{'egl'}{'data'}{'versions'}{$working[1]}},$value); + if (!$gl->{'egl'}{'data'}{'version'} || + $working[1] > $gl->{'egl'}{'data'}{'version'}){ + $gl->{'egl'}{'data'}{'version'} = $working[1]; + } + } + elsif ($working[0] eq 'EGL vendor string'){ + $working[1] = lc($working[1]); + $working[1] =~ s/^(\S+)(\s.+|$)/$1/; + if (!defined $platform){ + $gl->{'egl'}{'data'}{'vendor'} = $working[1]; + } + elsif (defined $device){ + $gl->{'egl'}{'platforms'}{$platform}{$device}{'egl'}{'vendor'} = $working[1]; + if ($working[1] eq 'nvidia'){ + $gl->{'egl'}{'platforms'}{$platform}{$device}{'egl'}{'driver'} = $working[1]; + } + } + else { + $gl->{'egl'}{'platforms'}{$platform}{'egl'}{'vendor'} = $working[1]; + if ($working[1] eq 'nvidia'){ + $gl->{'egl'}{'platforms'}{$platform}{'egl'}{'driver'} = $working[1]; + } + } + push(@{$gl->{'egl'}{'data'}{'vendors'}},$working[1]); + if ($platform && $working[1] eq 'nvidia'){ + $value = (defined $device) ? "$platform-$device": $platform; + push(@{$gl->{'egl'}{'data'}{'drivers'}{$working[1]}},$value); + $gl->{'egl'}{'data'}{'hw'}{$working[1]} = $working[1]; + } + } + elsif ($platform && $working[0] eq 'EGL driver name'){ + if (!defined $device){ + $gl->{'egl'}{'platforms'}{$platform}{'egl'}{'driver'} = $working[1]; + if ($mesa_drivers{$working[1]}){ + $gl->{'egl'}{'platforms'}{$platform}{'egl'}{'hw'} = $mesa_drivers{$working[1]}; + } + } + else { + $gl->{'egl'}{'platforms'}{$platform}{$device}{'egl'}{'driver'} = $working[1]; + if ($mesa_drivers{$working[1]}){ + $gl->{'egl'}{'platforms'}{$platform}{$device}{'egl'}{'hw'} = $mesa_drivers{$working[1]}; + } + } + $value = (defined $device) ? "$platform-$device": $platform; + push(@{$gl->{'egl'}{'data'}{'drivers'}{$working[1]}},$value); + if ($mesa_drivers{$working[1]}){ + $gl->{'egl'}{'data'}{'hw'}{$working[1]} = $mesa_drivers{$working[1]}; + } + } + if ($platform && $working[0] eq 'EGL client APIs'){ + if (defined $device){ + $gl->{'egl'}{'platforms'}{$platform}{$device}{'egl'}{'client-apis'} = [split(/\s+/,$working[1])]; + } + else { + $gl->{'egl'}{'platforms'}{$platform}{'egl'}{'client-apis'} = [split(/\s+/,$working[1])]; + } + } + } + # glx specific values, only found in glxinfo + else { + if (lc($working[0]) eq 'direct rendering'){ + $working[1] = lc($working[1]); + if (!$gl->{'glx'}{'direct-renderers'} || + !(grep {$_ eq $working[1]} @{$gl->{'glx'}{'direct-renders'}})){ + push(@{$gl->{'glx'}{'direct-renders'}}, $working[1]); + } + } + # name of display: does not always list the screen number + elsif (lc($working[0]) eq 'display'){ + if ($working[1] =~ /^(:\d+)\s+screen:\s+(\d+)/){ + $gl->{'glx'}{'display-id'} = $1 . '.' . $2; + } + } + elsif (lc($working[0]) eq 'glx version'){ + if (!$gl->{'glx'}{'glx-version'}){ + $gl->{'glx'}{'glx-version'} = $working[1]; + } + } + elsif (!$b_rend_info && $working[0] =~ /^Extended renderer info/i){ + $b_rend_info = 1; + } + # only check Memory info if no prior device memory found + elsif (!$b_mem_info && $working[0] =~ /^Memory info/i){ + $b_mem_info = (!$gl->{'glx'}{'info'} || !$gl->{'glx'}{'info'}{'device-memory'}) ? 1 : 0; + } + elsif ($b_rend_info){ + if ($line =~ /^\s+Vendor:\s+.*?\(0x([\da-f]+)\)$/){ + $gl->{'glx'}{'info'}{'vendor-id'} = sprintf("%04s",$1); + } + elsif ($line =~ /^\s+Device:\s+.*?\(0x([\da-f]+)\)$/){ + $gl->{'glx'}{'info'}{'device-id'} = sprintf("%04s",$1); + } + elsif ($line =~ /^\s+Video memory:\s+(\d+\s?[MG]B)$/){ + my $size = main::translate_size($1); + $gl->{'glx'}{'info'}{'device-memory'} = main::get_size($size,'string'); + } + elsif ($line =~ /^\s+Unified memory:\s+(\S+)$/){ + $gl->{'glx'}{'info'}{'unified-memory'} = lc($1); + } + } + elsif ($b_mem_info){ + # fallback, nvidia does not seem to have Extended renderer info + if ($line =~ /^\s+Dedicated video memory:\s+(\d+\s?[MG]B)$/){ + my $size = main::translate_size($1); + $gl->{'glx'}{'info'}{'device-memory'} = main::get_size($size,'string'); + $b_mem_info = 0; + } + # we're in the wrong memory block! + elsif ($line =~ /^\s+(VBO|Texture)/){ + $b_mem_info = 0; + } + } + elsif (lc($working[0]) eq 'opengl vendor string'){ + if ($working[1] =~ /^([^\s]+)(\s+\S+)?/){ + my $vendor = lc($1); + $vendor =~ s/(^mesa\/|[\.,]$)//; # Seen Mesa/X.org + if (!$gl->{'glx'}{'opengl'}{'vendor'}){ + $gl->{'glx'}{'opengl'}{'vendor'} = $vendor; + } + } + } + elsif (lc($working[0]) eq 'opengl renderer string'){ + if ($working[1]){ + $working[1] = main::clean($working[1]); + } + # note: seen cases where gl drivers are missing, with empty field value. + else { + $gl->{'glx'}{'no-gl'} = 1; + $working[1] = main::message('glx-value-empty'); + } + if (!$gl->{'glx'}{'opengl'}{'renderers'} || + !(grep {$_ eq $working[1]} @{$gl->{'glx'}{'opengl'}{'renderers'}})){ + push(@{$gl->{'glx'}{'opengl'}{'renderers'}}, $working[1]) ; + } + } + # Dropping all conditions from this test to just show full mesa information + # there is a user case where not f and mesa apply, atom mobo + # This can be the compatibility version, or just the version the hardware + # supports. Core version will override always if present. + elsif (lc($working[0]) eq 'opengl version string'){ + if ($working[1]){ + # first grab the actual gl version + # non free drivers like nvidia may only show their driver version info + # $working[1] = '4.5 (Compatibility Profile) Mesa 22.3.6'; + if ($working[1] =~ /^(\S+)(\s|$)/){ + push(@{$gl->{'glx'}{'opengl'}{'versions'}}, $1); + } + # handle legacy format: 1.2 (1.5 Mesa 6.5.1) + # as well as more current: + # 4.5 (Compatibility Profile) Mesa 22.3.6 + # Note: legacy: fglrx starting adding compat strings but they don't + # change this result: + # 4.5 Compatibility Profile Context Mesa 15.3.6 + # 4.6 (Core Profile) Mesa 24.2.0-devel (git-92f0620dae) + if ($working[1] =~ /(Mesa|NVIDIA)\s(\S+?)\)?(\s.*)?$/i){ + if ($1 && $2 && !$gl->{'glx'}{'opengl'}{'driver'}){ + $gl->{'glx'}{'opengl'}{'driver'}{'vendor'} = lc($1); + $gl->{'glx'}{'opengl'}{'driver'}{'version'} = $2; + } + } + } + elsif (!$gl->{'glx'}{'no-gl'}){ + $gl->{'glx'}{'no-gl'} = 1; + push(@{$gl->{'glx'}{'opengl'}{'versions'}},main::message('glx-value-empty')); + } + } + # if -B was always available, we could skip this, but it is not + elsif ($line =~ /GLX Visuals/){ + last; + } + } + # eglinfo/glxinfo share these + if ($b_opengl){ + if ($working[0] =~ /^OpenGL (compatibility|core) profile version( string)?$/){ + $value = lc($1); + # $working[1] = '4.6 (Core Profile) Mesa 24.2.0-devel (git-92f0620dae)'; + # note: no need to apply empty message here since we don't have the data + # anyway + if ($working[1]){ + # non free drivers like nvidia only show their driver version info + if ($working[1] =~ /^(\S+)(\s|$)/){ + push(@{$gl->{'glx'}{'opengl'}{$value}{'versions'}}, $1); + } + # fglrx started appearing with this extra string, does not appear + # to communicate anything of value + # 4.6 (Core Profile) Mesa 24.2.0-devel + # 4.6 (Core Profile) Mesa 24.2.0-devel (git-92f0620dae) + if ($working[1] =~ /\s+(Mesa|NVIDIA)\s+(\S+)(\s.*)?$/){ + if ($1 && $2 && !$gl->{'glx'}{'opengl'}{$value}{'vendor'}){ + $gl->{'glx'}{'opengl'}{$value}{'driver'}{'vendor'} = lc($1); + $gl->{'glx'}{'opengl'}{$value}{'driver'}{'version'} = $2; + } + if ($source eq 'egl' && $platform){ + if (defined $device){ + $gl->{'egl'}{'platforms'}{$platform}{$device}{'opengl'}{$value}{'vendor'} = lc($1); + $gl->{'egl'}{'platforms'}{$platform}{$device}{'opengl'}{$value}{'version'} = $2; + } + else { + $gl->{'egl'}{'platforms'}{$platform}{'opengl'}{$value}{'vendor'} = lc($1); + $gl->{'egl'}{'platforms'}{$platform}{'opengl'}{$value}{'version'} = $2; + } + } + } + } + } + elsif ($working[0] =~ /^OpenGL (compatibility|core) profile renderer?$/){ + $value = lc($1); + if ($working[1]){ + $working[1] = main::clean($working[1]); + } + # note: seen cases where gl drivers are missing, with empty field value. + else { + $gl->{'glx'}{'no-gl'} = 1; + $working[1] = main::message('glx-value-empty'); + } + if (!$gl->{'glx'}{'opengl'}{$value}{'renderers'} || + !(grep {$_ eq $working[1]} @{$gl->{'glx'}{'opengl'}{$value}{'renderers'}})){ + push(@{$gl->{'glx'}{'opengl'}{$value}{'renderers'}}, $working[1]) ; + } + if ($source eq 'egl' && $platform){ + if ($value eq 'core'){ + $value2 = (defined $device) ? "$platform-$device": $platform; + push(@{$gl->{'egl'}{'data'}{'renderers'}{$working[1]}},$value2); + } + if (defined $device){ + $gl->{'egl'}{'platforms'}{$platform}{$device}{'opengl'}{$value}{'renderer'} = $working[1]; + } + else { + $gl->{'egl'}{'platforms'}{$platform}{'opengl'}{$value}{'renderer'} = $working[1]; + } + } + } + elsif ($working[0] =~ /^OpenGL (compatibility|core) profile vendor$/){ + $value = lc($1); + if (!$gl->{'glx'}{'opengl'}{$value}{'vendors'} || + !(grep {$_ eq $working[1]} @{$gl->{'glx'}{'opengl'}{$value}{'vendors'}})){ + push(@{$gl->{'glx'}{'opengl'}{$value}{'vendors'}}, $working[1]) ; + } + if ($source eq 'egl' && $platform){ + if (defined $device){ + $gl->{'egl'}{'platforms'}{$platform}{$device}{'opengl'}{$value}{'vendor'} = $working[1]; + } + else { + $gl->{'egl'}{'platforms'}{$platform}{'opengl'}{$value}{'vendor'} = $working[1]; + } + + } + } + elsif (lc($working[0]) eq 'opengl es profile version string'){ + if ($working[1] && !$gl->{'glx'}{'es-version'}){ + # OpenGL ES 3.2 Mesa 23.0.3 + if ($working[1] =~ /^OpenGL ES (\S+) Mesa (\S+)/){ + $gl->{'glx'}{'es'}{'version'} = $1; + if ($2 && !$gl->{'glx'}{'es'}{'mesa-version'}){ + $gl->{'glx'}{'es'}{'mesa-version'} = $2; + } + if ($source eq 'egl' && $platform){ + if (defined $device){ + $gl->{'egl'}{'platforms'}{$platform}{$device}{'opengl'}{'es'}{'vendor'} = 'mesa'; + $gl->{'egl'}{'platforms'}{$platform}{$device}{'opengl'}{'es'}{'version'} = $working[1]; + } + else { + $gl->{'egl'}{'platforms'}{$platform}{'opengl'}{'es'}{'vendor'} = 'mesa'; + $gl->{'egl'}{'platforms'}{$platform}{'opengl'}{'es'}{'version'} = $working[1]; + } + } + } + } + } + } + } + main::log_data('dump',"$source \$results",$results) if $b_log; + if ($source eq 'egl'){ + print "GL Data: $source: ", Data::Dumper::Dumper $gl if $dbg[57]; + main::log_data('dump',"GL data: $source:",$gl) if $b_log; + } + else { + print "GL Data: $source: ", Data::Dumper::Dumper $gl->{'glx'} if $dbg[57]; + main::log_data('dump',"GLX data: $source:",$gl->{'glx'}) if $b_log; + } + eval $end if $b_log; +} + +sub process_glx_data { + eval $start if $b_log; + my ($glx,$b_glx) = @_; + my $value; + # Remember: if you test for a hash ref hash ref, you create the first hash ref! + if ($glx->{'direct-renders'}){ + $glx->{'direct-render'} = join(', ', @{$glx->{'direct-renders'}}); + } + if (!$glx->{'opengl'}{'renderers'} && $glx->{'opengl'}{'compatibility'} && + $glx->{'opengl'}{'compatibility'}{'renderers'}){ + $glx->{'opengl'}{'renderers'} = $glx->{'opengl'}{'compatibility'}{'renderers'}; + } + # This is tricky, GLX OpenGL version string can be compatibility version, + # but usually they are the same. Just in case, try this. Note these are + # x.y.z type numbering formats generally so use string compare + if ($glx->{'opengl'}{'core'} && $glx->{'opengl'}{'core'}{'versions'}){ + $glx->{'opengl'}{'version'} = (sort @{$glx->{'opengl'}{'core'}{'versions'}})[-1]; + } + elsif ($glx->{'opengl'}{'versions'}){ + $glx->{'opengl'}{'version'} = (sort @{$glx->{'opengl'}{'versions'}})[-1]; + } + if ($glx->{'opengl'}{'version'} && + ($glx->{'opengl'}{'compatibility'} || $glx->{'opengl'}{'versions'})){ + # print "v: $glx->{'opengl'}{'version'}\n"; + # print Data::Dumper::Dumper $glx->{'opengl'}{'versions'}; + # print 'v1: ', (sort @{$glx->{'opengl'}{'versions'}})[0], "\n"; + # here we look for different versions, and determine most likely compat one + if ($glx->{'opengl'}{'compatibility'} && + $glx->{'opengl'}{'compatibility'}{'versions'} && + (sort @{$glx->{'opengl'}{'compatibility'}{'versions'}})[0] ne $glx->{'opengl'}{'version'}){ + $value = (sort @{$glx->{'opengl'}{'compatibility'}{'versions'}})[0]; + $glx->{'opengl'}{'compatibility'}{'version'} = $value; + } + elsif ($glx->{'opengl'}{'versions'} && + (sort @{$glx->{'opengl'}{'versions'}})[0] ne $glx->{'opengl'}{'version'}){ + $value = (sort @{$glx->{'opengl'}{'versions'}})[0]; + $glx->{'opengl'}{'compatibility'}{'version'} = $value; + } + } + if ($glx->{'opengl'}{'renderers'}){ + $glx->{'opengl'}{'renderer'} = join(', ', @{$glx->{'opengl'}{'renderers'}}); + } + # likely eglinfo or advanced glxinfo + if ($glx->{'opengl'}{'vendor'} && + $glx->{'opengl'}{'core'} && + $glx->{'opengl'}{'core'}{'driver'} && + $glx->{'opengl'}{'core'}{'driver'}{'vendor'} && + $glx->{'opengl'}{'core'}{'driver'}{'vendor'} eq 'mesa' && + $glx->{'opengl'}{'vendor'} ne $glx->{'opengl'}{'core'}{'driver'}{'vendor'}){ + $value = $glx->{'opengl'}{'vendor'} . ' '; + $value .= $glx->{'opengl'}{'core'}{'driver'}{'vendor'}; + $glx->{'opengl'}{'vendor'} = $value; + } + # this can be glxinfo only case, no eglinfo + elsif ($glx->{'opengl'}{'vendor'} && + $glx->{'opengl'}{'driver'} && + $glx->{'opengl'}{'driver'}{'vendor'} && + $glx->{'opengl'}{'driver'}{'vendor'} eq 'mesa' && + $glx->{'opengl'}{'vendor'} ne $glx->{'opengl'}{'driver'}{'vendor'}){ + $value = $glx->{'opengl'}{'vendor'} . ' '; + $value .= $glx->{'opengl'}{'driver'}{'vendor'}; + $glx->{'opengl'}{'vendor'} = $value; + } + elsif (!$glx->{'opengl'}{'vendor'} && + $glx->{'opengl'}{'core'} && $glx->{'opengl'}{'core'}{'driver'} && + $glx->{'opengl'}{'core'}{'driver'}{'vendor'}){ + $glx->{'opengl'}{'vendor'} = $glx->{'opengl'}{'core'}{'driver'}{'vendor'}; + } + if ((!$glx->{'opengl'}{'driver'} || + !$glx->{'opengl'}{'driver'}{'version'}) && + $glx->{'opengl'}{'core'} && + $glx->{'opengl'}{'core'}{'driver'} && + $glx->{'opengl'}{'core'}{'driver'}{'version'}){ + $value = $glx->{'opengl'}{'core'}{'driver'}{'version'}; + $glx->{'opengl'}{'driver'}{'version'} = $value; + } + # only tripped when glx filled by eglinfo + if (!$glx->{'source'}){ + my $type; + if (!$b_glx){ + $type = 'glx-egl-missing'; + } + elsif ($b_display){ + $type = 'glx-egl'; + } + else { + $type = 'glx-egl-console'; + } + $glx->{'note'} = main::message($type); + } + print "GLX Data: ", Data::Dumper::Dumper $glx if $dbg[57]; + main::log_data('dump',"GLX data:",$glx) if $b_log; + eval $end if $b_log; +} + +sub vulkan_data { + eval $start if $b_log; + my ($program,$vulkan) = @_; + my ($data,$msg,@working); + my ($results) = ([]); + if ($dbg[56] || $b_log){ + $msg = "${line1}Vulkan Data\n${line3}"; + print $msg if $dbg[56]; + push(@$results,$msg) if $b_log; + } + if (!$fake{'vulkan'}){ + $data = main::grabber("$program 2>/dev/null",'','','ref'); + } + else { + my $file; + $file = "$fake_data_dir/graphics/vulkan/vulkaninfo-intel-llvm-1.txt"; + $file = "$fake_data_dir/graphics/vulkan/vulkaninfo-nvidia-1.txt"; + $file = "$fake_data_dir/graphics/vulkan/vulkaninfo-intel-1.txt"; + $file = "$fake_data_dir/graphics/vulkan/vulkaninfo-amd-dz.txt"; + $file = "$fake_data_dir/graphics/vulkan/vulkaninfo-mali-3.txt"; + $data = main::reader($file,'','ref'); + } + if (!$data){ + if ($dbg[56] || $b_log){ + $msg = "No Vulkan data found" if $dbg[56]; + print "$msg\n" if $dbg[56]; + push(@$results,$msg) if $b_log; + } + return 0; + } + set_mesa_drivers() if !%mesa_drivers; + my ($id,%active); + foreach my $line (@$data){ + next if $line =~ /^(\s*|-+|=+)$/; + @working = split(/\s*:\s*/,$line,2); + next if !@working; + if ($line =~ /^\S/){ + if ($active{'start'}){undef $active{'start'}} + if ($active{'layers'}){undef $active{'layers'}} + if ($active{'groups'}){undef $active{'groups'}} + if ($active{'limits'}){undef $active{'limits'}} + if ($active{'features'}){undef $active{'features'}} + if ($active{'extensions'}){undef $active{'extensions'}} + if ($active{'format'}){undef $active{'format'}} + if ($active{'driver'}){($active{'driver'},$id) = ()} + } + next if $active{'start'}; + next if $active{'groups'}; + next if $active{'limits'}; + next if $active{'features'}; + next if $active{'extensions'}; + next if $active{'format'}; + if ($dbg[56] || $b_log){ + $msg = $line; + print "$msg\n" if $dbg[56]; + push(@$results,$msg) if $b_log; + } + if ($working[0] eq 'Vulkan Instance Version'){ + $vulkan->{'data'}{'version'} = $working[1]; + $active{'start'} = 1; + } + elsif ($working[0] eq 'Layers'){ + if ($working[1] =~ /count\s*=\s*(\d+)/){ + $vulkan->{'data'}{'layers'} = $1; + } + $active{'layers'} = 1; + } + # note: can't close this because Intel didn't use proper indentation + elsif ($working[0] eq 'Presentable Surfaces'){ + $active{'surfaces'} = 1; + } + elsif ($working[0] eq 'Device Groups'){ + $active{'groups'} = 1; + $active{'surfaces'} = 0; + } + elsif ($working[0] eq 'Device Properties and Extensions'){ + $active{'devices'} = 1; + $active{'surfaces'} = 0; + undef $id; + } + elsif ($working[0] eq 'VkPhysicalDeviceProperties'){ + $active{'props'} = 1; + } + elsif ($working[0] eq 'VkPhysicalDeviceDriverProperties'){ + $active{'driver'} = 1; + } + elsif ($working[0] =~ /^\S+Features/i){ + $active{'features'} = 1; + } + # seen as line starter string or inner VkPhysicalDeviceProperties + elsif ($working[0] =~ /^\s*\S+Limits/i){ + $active{'limits'} = 1; + } + elsif ($working[0] =~ /^FORMAT_/){ + $active{'format'} = 1; + } + elsif ($working[0] =~ /^(Device|Instance) Extensions/){ + $active{'extensions'} = 1; + } + if ($active{'surfaces'}){ + if ($working[0] eq 'GPU id'){ + if ($working[1] =~ /^(\d+)\s+\((.*?)\):?$/){ + $id = $1; + $vulkan->{'devices'}{$id}{'model'} = main::clean($2); + } + } + if (defined $id){ + # seen leading space, no leading space + if ($line =~ /^\s*Surface type/){ + $active{'surface-type'} = 1; + } + if ($active{'surface-type'} && $line =~ /\S+_(\S+)_surface$/){ + if (!$vulkan->{'devices'}{$id}{'surfaces'} || + !(grep {$_ eq $1} @{$vulkan->{'devices'}{$id}{'surfaces'}})){ + push(@{$vulkan->{'devices'}{$id}{'surfaces'}},$1); + } + if (!$vulkan->{'data'}{'surfaces'} || + !(grep {$_ eq $1} @{$vulkan->{'data'}{'surfaces'}})){ + push(@{$vulkan->{'data'}{'surfaces'}},$1); + } + } + if ($working[0] =~ /^\s*Formats/){ + undef $active{'surface-type'}; + } + } + } + if ($active{'devices'}){ + if ($working[0] =~ /^GPU(\d+)/){ + $id = $1; + } + elsif (defined $id){ + # apiVersion=4194528 (1.0.224); 1.3.246 (4206838); 79695971 (0x4c01063) + if ($line =~ /^\s+apiVersion\s*=\s*(\S+)(\s+\(([^)]+)\))?/i){ + my ($a,$b) = ($1,$3); + my $api = (!$b || $b =~ /^(0x)?\d+$/) ? $a : $b; + $vulkan->{'devices'}{$id}{'device-api-version'} = $api; + } + elsif ($line =~ /^\s+driverVersion\s*=\s*(\S+)/i){ + $vulkan->{'devices'}{$id}{'device-driver-version'} = $1; + } + elsif ($line =~ /^\s+vendorID\s*=\s*0x(\S+)/i){ + $vulkan->{'devices'}{$id}{'vendor-id'} = $1; + } + elsif ($line =~ /^\s+deviceID\s*=\s*0x(\S+)/i){ + $vulkan->{'devices'}{$id}{'device-id'} = $1; + } + # deviceType=DISCRETE_GPU; PHYSICAL_DEVICE_TYPE_DISCRETE_GPU + elsif ($line =~ /^\s+deviceType\s*=\s*(\S+?_TYPE_)?(\S+)$/i){ + $vulkan->{'devices'}{$id}{'device-type'} = lc($2); + $vulkan->{'devices'}{$id}{'device-type'} =~ s/_/-/g; + } + # deviceName=AMD Radeon RX 6700 XT (RADV NAVI22); AMD RADV HAWAII + # lvmpipe (LLVM 15.0.6, 256 bits); NVIDIA GeForce GTX 1650 Ti + elsif ($line =~ /^\s+deviceName\s*=\s*(\S+)(\s.*|$)/i){ + $vulkan->{'devices'}{$id}{'device-vendor'} = main::clean(lc($1)); + $vulkan->{'devices'}{$id}{'device-name'} = main::clean($1 . $2); + } + } + } + if ($active{'driver'}){ + if (defined $id){ + # driverName=llvmpipe; radv; + if ($line =~ /^\s+driverName\s*=\s*(\S+)(\s|$)/i){ + my $driver = lc($1); + if ($mesa_drivers{$driver}){ + $vulkan->{'devices'}{$id}{'hw'} = $mesa_drivers{$driver}; + } + $vulkan->{'devices'}{$id}{'driver-name'} = $driver; + if (!$vulkan->{'data'}{'drivers'} || + !(grep {$_ eq $driver} @{$vulkan->{'data'}{'drivers'}})){ + push(@{$vulkan->{'data'}{'drivers'}},$driver); + } + } + # driverInfo=Mesa 23.1.3 (LLVM 15.0.7); 525.89.02; Mesa 23.1.3 + elsif ($line =~ /^\s+driverInfo\s*=\s*((Mesa)\s)?(.*)/i){ + $vulkan->{'devices'}{$id}{'mesa'} = lc($2) if $2; + $vulkan->{'devices'}{$id}{'driver-info'} = $3; + } + } + } + } + main::log_data('dump','$results',$results) if $b_log; + print 'Vulkan Data: ', Data::Dumper::Dumper $vulkan if $dbg[57]; + main::log_data('dump','$vulkan',$vulkan) if $b_log; + eval $end if $b_log; +} + +## DISPLAY DATA WAYLAND ## +sub display_data_wayland { + eval $start if $b_log; + my ($b_skip_pos,$program); + if ($ENV{'WAYLAND_DISPLAY'}){ + $graphics{'display-id'} = $ENV{'WAYLAND_DISPLAY'}; + # return as wayland-0 or 0? + $graphics{'display-id'} =~ s/wayland-?//i; + } + if ($fake{'swaymsg'} || ($program = main::check_program('swaymsg'))){ + swaymsg_data($program); + } + # until we get data proving otherwise, assuming these have same output + elsif ($fake{'wl-info'} || (($program = main::check_program('wayland-info')) || + ($program = main::check_program('weston-info')))){ + wlinfo_data($program); + } + elsif ($fake{'wlr-randr'} || ($program = main::check_program('wlr-randr'))){ + wlrrandr_data($program); + } + # make sure we got enough for advanced position data, might be from /sys + if ($extra > 1 && $monitor_ids){ + $b_skip_pos = check_wayland_data(); + } + if ($extra > 1 && $monitor_ids && $b_wayland_data){ + # map_monitor_ids([keys %$monitors]); # not required, but leave in case. + wayland_data_advanced($b_skip_pos); + } + print 'Wayland monitors: ', Data::Dumper::Dumper $monitor_ids if $dbg[17]; + main::log_data('dump','$monitor_ids',$monitor_ids) if $b_log; + eval $end if $b_log; +} + +# If we didn't get explicit tool for wayland data, check to see if we got most +# of the data from /sys/class/drm edid and then skip xrandr to avoid gunking up +# the data, in that case, all we get from xrandr would be the position, which is +# nice but not a must-have. We've already cleared out all disabled ports. +sub check_wayland_data { + eval $start if $b_log; + my ($b_skip_pos,$b_invalid); + foreach my $key (keys %$monitor_ids){ + # we need these 4 items to construct the grid rectangle + if (!defined $monitor_ids->{$key}{'pos-x'} || + !defined $monitor_ids->{$key}{'pos-y'} || + !$monitor_ids->{$key}{'res-x'} || !$monitor_ids->{$key}{'res-y'}){ + $b_skip_pos = 1; + } + if (!$monitor_ids->{$key}{'res-x'} || !$monitor_ids->{$key}{'res-y'}){ + $b_invalid = 1; + } + } + # ok, we have enough, we don't need to do fallback xrandr checks + $b_wayland_data = 1 if !$b_invalid; + eval $end if $b_log; + return $b_skip_pos; +} + +# Set Display rect size for > 1 monitors, monitor positions, size-i, diag +sub wayland_data_advanced { + eval $start if $b_log; + my ($b_skip_pos) = @_; + my (%x_pos,%y_pos); + my ($x_max,$y_max) = (0,0); + my @keys = keys %$monitor_ids; + foreach my $key (@keys){ + if (!$b_skip_pos){ + if ($monitor_ids->{$key}{'res-x'} && $monitor_ids->{$key}{'res-x'} > $x_max){ + $x_max = $monitor_ids->{$key}{'res-x'}; + } + if ($monitor_ids->{$key}{'res-y'} && $monitor_ids->{$key}{'res-y'} > $y_max){ + $y_max = $monitor_ids->{$key}{'res-y'}; + } + # Now we'll add the detected x, y res to the trackers + if (!defined $x_pos{$monitor_ids->{$key}{'pos-x'}}){ + $x_pos{$monitor_ids->{$key}{'pos-x'}} = $monitor_ids->{$key}{'res-x'}; + } + if (!defined $y_pos{$monitor_ids->{$key}{'pos-y'}}){ + $y_pos{$monitor_ids->{$key}{'pos-y'}} += $monitor_ids->{$key}{'res-y'}; + } + } + # this means we failed to get EDID real data, and are using just the wayland + # tool to get this info, eg. with BSD without compositor data. + if ($monitor_ids->{$key}{'size-x'} && $monitor_ids->{$key}{'size-y'} && + (!$monitor_ids->{$key}{'size-x-i'} || !$monitor_ids->{$key}{'size-y-i'} || + !$monitor_ids->{$key}{'dpi'} || !$monitor_ids->{$key}{'diagonal'})){ + my $size_x = $monitor_ids->{$key}{'size-x'}; + my $size_y = $monitor_ids->{$key}{'size-y'}; + $monitor_ids->{$key}{'size-x-i'} = sprintf("%.2f", ($size_x/25.4)) + 0; + $monitor_ids->{$key}{'size-y-i'} = sprintf("%.2f", ($size_y/25.4)) + 0; + $monitor_ids->{$key}{'diagonal'} = sprintf("%.2f", (sqrt($size_x**2 + $size_y**2)/25.4)) + 0; + $monitor_ids->{$key}{'diagonal-m'} = sprintf("%.0f", (sqrt($size_x**2 + $size_y**2))); + if ($monitor_ids->{$key}{'res-x'}){ + my $res_x = $monitor_ids->{$key}{'res-x'}; + $monitor_ids->{$key}{'dpi'} = sprintf("%.0f", $res_x * 25.4 / $size_x); + } + } + } + if (!$b_skip_pos){ + if (scalar @keys > 1 && %x_pos && %y_pos){ + my ($x,$y) = (0,0); + foreach (keys %x_pos){$x += $x_pos{$_}} + foreach (keys %y_pos){$y += $y_pos{$_}} + # handle cases with one tall portrait mode > 2 short landscapes, etc. + $x = $x_max if $x_max > $x; + $y = $y_max if $y_max > $y; + $graphics{'display-rect'} = $x . 'x' . $y; + } + my $layouts = []; + set_monitor_layouts($layouts); + # only update position, we already have all the rest of the data + advanced_monitor_data($monitor_ids,$layouts); + undef $layouts; + } + eval $end if $b_log; +} + +## WAYLAND COMPOSITOR DATA TOOLS ## +# NOTE: These patterns are VERY fragile, and depend on no changes at all to +# the data structure, and more important, the order. Something I would put +# almost no money on being able to count on. +sub wlinfo_data { + eval $start if $b_log; + my ($program) = @_; + my ($data,%mon,@temp,$ref); + my ($b_iwlo,$b_izxdg,$file,$hz,$id,$pos_x,$pos_y,$res_x,$res_y,$scale); + if (!$fake{'wl-info'}){ + undef $monitor_ids; + $data = main::grabber("$program 2>/dev/null",'','strip','ref'); + } + else { + $file = "$fake_data_dir/graphics/wayland/weston-info-2-mon-1.txt"; + $file = "$fake_data_dir/graphics/wayland/wayland-info-weston-vm-sparky.txt"; + $data = main::reader($file,'strip','ref'); + } + print 'wayland/weston-info raw: ', Data::Dumper::Dumper $data if $dbg[46]; + main::log_data('dump','@$data', $data) if $b_log; + foreach (@$data){ + # print 'l: ', $_,"\n"; + if (/^interface: 'wl_output', version: \d+, name: (\d+)$/){ + $b_iwlo = 1; + $id = $1; + } + elsif (/^interface: 'zxdg_output/){ + $b_izxdg = 1; + $b_iwlo = 0; + } + if ($b_iwlo){ + if (/^x: (\d+), y: (\d+), scale: ([\d\.]+)/){ + $mon{$id}->{'pos-x'} = $1; + $mon{$id}->{'pos-y'} = $2; + $mon{$id}->{'scale'} = $3; + } + elsif (/^physical_width: (\d+) mm, physical_height: (\d+) mm/){ + $mon{$id}->{'size-x'} = $1 if $1; # can be 0 if edid data n/a + $mon{$id}->{'size-y'} = $2 if $2; # can be 0 if edid data n/a + } + elsif (/^make: '([^']+)', model: '([^']+)'/){ + my $make = main::clean($1); + my $model = main::clean($2); + $mon{$id}->{'model'} = $make; + if ($make && $model){ + $mon{$id}->{'model'} = $make . ' ' . $model; + } + elsif ($model) { + $mon{$id}->{'model'} = $model; + } + elsif ($make) { + $mon{$id}->{'model'} = $make; + } + # includes remove duplicates and remove unset + if ($mon{$id}->{'model'}){ + $mon{$id}->{'model'} = main::clean_dmi($mon{$id}->{'model'}); + } + } + elsif (/^width: (\d+) px, height: (\d+) px, refresh: ([\d\.]+) Hz,/){ + $mon{$id}->{'res-x'} = $1; + $mon{$id}->{'res-y'} = $2; + $mon{$id}->{'hz'} = sprintf('%.0f',$3); + } + } + # note: we don't want to use the 'description' field because that doesn't + # always contain make/model data, sometimes it's: Built-in/Unknown Display + elsif ($b_izxdg){ + if (/^output: (\d+)/){ + $id = $1; + } + elsif (/^name: '([^']+)'$/){ + $mon{$id}->{'monitor'} = $1; + } + elsif (/^logical_x: (\d+), logical_y: (\d+)/){ + $mon{$id}->{'log-pos-x'} = $1; + $mon{$id}->{'log-pos-y'} = $2; + } + elsif (/^logical_width: (\d+), logical_height: (\d+)/){ + $mon{$id}->{'log-x'} = $1; + $mon{$id}->{'log-y'} = $2; + } + } + if ($b_izxdg && /^interface: '(?!zxdg_output)/){ + last; + } + } + # now we need to map %mon back to $monitor_ids + if (%mon){ + $b_wayland_data = 1; + foreach my $key (keys %mon){ + next if !$mon{$key}->{'monitor'}; # no way to know what it is, sorry + $id = $mon{$key}->{'monitor'}; + $monitor_ids->{$id}{'monitor'} = $id; + $monitor_ids->{$id}{'log-x'} = $mon{$key}->{'log-x'} if defined $mon{$key}->{'log-x'}; + $monitor_ids->{$id}{'log-y'} = $mon{$key}->{'log-y'} if defined $mon{$key}->{'log-y'}; + $monitor_ids->{$id}{'pos-x'} = $mon{$key}->{'pos-x'} if defined $mon{$key}->{'pos-x'}; + $monitor_ids->{$id}{'pos-y'} = $mon{$key}->{'pos-y'} if defined $mon{$key}->{'pos-y'}; + $monitor_ids->{$id}{'res-x'} = $mon{$key}->{'res-x'} if defined $mon{$key}->{'res-x'}; + $monitor_ids->{$id}{'res-y'} = $mon{$key}->{'res-y'} if defined $mon{$key}->{'res-y'}; + $monitor_ids->{$id}{'size-x'} = $mon{$key}->{'size-x'} if defined $mon{$key}->{'size-x'}; + $monitor_ids->{$id}{'size-y'} = $mon{$key}->{'size-y'} if defined $mon{$key}->{'size-y'}; + $monitor_ids->{$id}{'hz'} = $mon{$key}->{'hz'} if defined $mon{$key}->{'hz'}; + if (defined $mon{$key}->{'model'} && !$monitor_ids->{$id}{'model'}){ + $monitor_ids->{$id}{'model'} = $mon{$key}->{'model'}; + } + $monitor_ids->{$id}{'scale'} = $mon{$key}->{'scale'} if defined $mon{$key}->{'scale'}; + # fallbacks in case wl_output block is not present, which happens + if (!defined $mon{$key}->{'pos-x'} && defined $mon{$key}->{'log-pos-x'}){ + $monitor_ids->{$id}{'pos-x'} = $mon{$key}->{'log-pos-x'}; + } + if (!defined $mon{$key}->{'pos-y'} && defined $mon{$key}->{'log-pos-y'}){ + $monitor_ids->{$id}{'pos-y'} = $mon{$key}->{'log-pos-y'}; + } + if (!defined $mon{$key}->{'res-x'} && defined $mon{$key}->{'log-x'}){ + $monitor_ids->{$id}{'res-x'} = $mon{$key}->{'log-x'}; + } + if (!defined $mon{$key}->{'res-y'} && defined $mon{$key}->{'log-y'}){ + $monitor_ids->{$id}{'res-y'} = $mon{$key}->{'log-y'}; + } + } + } + print '%mon: ', Data::Dumper::Dumper \%mon if $dbg[46]; + main::log_data('dump','%mon', \%mon) if $b_log; + print 'wayland/weston-info: monitor_ids: ', Data::Dumper::Dumper $monitor_ids if $dbg[46]; + eval $end if $b_log; +} + +# Note; since not all systems will have /sys data, we'll repack it if it's +# missing here. +sub swaymsg_data { + eval $start if $b_log; + my ($program) = @_; + my (@data,%json,@temp,$ref); + my ($b_json,$file,$hz,$id,$model,$pos_x,$pos_y,$res_x,$res_y,$scale,$serial); + if (!$fake{'swaymsg'}){ + main::load_json() if !$loaded{'json'}; + if ($use{'json'}){ + my $result = qx($program -t get_outputs -r 2>/dev/null); + # returns array of monitors found + @data = &{$use{'json'}->{'decode'}}($result) if $result; + $b_json = 1; + print "$use{'json'}->{'type'}: " if $dbg[46]; + # print "using: $use{'json'}->{'type'}\n"; + } + else { + @data = main::grabber("$program -t get_outputs -p 2>/dev/null",'','strip'); + } + } + else { + undef $monitor_ids; + $file = "$fake_data_dir/graphics/wayland/swaymsg-2-monitor-1.txt"; + @data = main::reader($file,'strip'); + } + print 'swaymsg: ', Data::Dumper::Dumper \@data if $dbg[46]; + main::log_data('dump','@data', \@data) if $b_log; + # print Data::Dumper::Dumper \@data; + if ($b_json){ + $b_wayland_data = 1 if scalar @data > 0; + foreach my $display (@data){ + foreach my $mon (@$display){ + ($hz,$pos_x,$pos_y,$res_x,$res_y,$scale) = (); + $id = $mon->{'name'}; + if (!$monitor_ids->{$id}{'monitor'}){ + $monitor_ids->{$id}{'monitor'} = $mon->{'name'}; + } + # we don't want to overwrite good edid model data if we already got it + if (!$monitor_ids->{$id}{'model'} && $mon->{'make'}){ + $monitor_ids->{$id}{'model'} = main::clean($mon->{'make'}); + if ($mon->{'model'}){ + $monitor_ids->{$id}{'model'} .= ' ' . main::clean($mon->{'model'}); + } + $monitor_ids->{$id}{'model'} = main::remove_duplicates($monitor_ids->{$id}{'model'}); + } + if ($monitor_ids->{$id}{'primary'}){ + if ($monitor_ids->{$id}{'primary'} ne 'false'){ + $monitor_ids->{$id}{'primary'} = $id; + $b_primary = 1; + } + else { + $monitor_ids->{$id}{'primary'} = undef; + } + } + if (!$monitor_ids->{$id}{'serial'}){ + $monitor_ids->{$id}{'serial'} = main::clean_dmi($mon->{'serial'}); + } + # sys data will only have edid type info, not active state res/pos/hz + if ($mon->{'current_mode'}){ + if ($hz = $mon->{'current_mode'}{'refresh'}){ + $hz = sprintf('%.0f',($mon->{'current_mode'}{'refresh'}/1000)); + $monitor_ids->{$id}{'hz'} = $hz; + } + $monitor_ids->{$id}{'res-x'} = $mon->{'current_mode'}{'width'}; + $monitor_ids->{$id}{'res-y'} = $mon->{'current_mode'}{'height'}; + } + if ($mon->{'rect'}){ + $monitor_ids->{$id}{'pos-x'} = $mon->{'rect'}{'x'}; + $monitor_ids->{$id}{'pos-y'} = $mon->{'rect'}{'y'}; + } + if ($mon->{'scale'}){ + $monitor_ids->{$id}{'scale'} =$mon->{'scale'}; + } + } + } + } + else { + foreach (@data){ + push(@temp,'~~') if /^Output/i; + push(@temp,$_); + } + push(@temp,'~~') if @temp; + @data = @temp; + $b_wayland_data = 1 if scalar @data > 8; + foreach (@data){ + if ($_ eq '~~' && $id){ + $monitor_ids->{$id}{'hz'} = $hz; + $monitor_ids->{$id}{'model'} = $model if $model; + $monitor_ids->{$id}{'monitor'} = $id; + $monitor_ids->{$id}{'pos-x'} = $pos_x; + $monitor_ids->{$id}{'pos-y'} = $pos_y; + $monitor_ids->{$id}{'res-x'} = $res_x; + $monitor_ids->{$id}{'res-y'} = $res_y; + $monitor_ids->{$id}{'scale'} = $scale; + $monitor_ids->{$id}{'serial'} = $serial if $serial; + ($hz,$model,$pos_x,$pos_y,$res_x,$res_y,$scale,$serial) = (); + $b_wayland_data = 1; + } + # Output VGA-1 ' ' (focused) + # unknown how 'primary' is shown, if it shows in this output + if (/^Output (\S+) '([^']+)'/i){ + $id = $1; + if ($2 && !$monitor_ids->{$id}{'model'}){ + ($model,$serial) = get_model_serial($2); + } + } + elsif (/^Current mode:\s+(\d+)x(\d+)\s+\@\s+([\d\.]+)\s+Hz/i){ + $res_x = $1; + $res_y = $2; + $hz = (sprintf('%.0f',($3/1000)) + 0) if $3; + } + elsif (/^Position:\s+(\d+),(\d+)/i){ + $pos_x = $1; + $pos_y = $2; + } + elsif (/^Scale factor:\s+([\d\.]+)/i){ + $scale = $1 + 0; + } + } + } + print 'swaymsg: ', Data::Dumper::Dumper $monitor_ids if $dbg[46]; + eval $end if $b_log; +} + +# Like a basic stripped down swaymsg -t get_outputs -p, less data though +# This is EXTREMELY LIKELY TO FAIL! Any tiny syntax change will break this. +sub wlrrandr_data { + eval $start if $b_log; + my ($program) = @_; + my ($file,$hz,$id,$info,$model,$pos_x,$pos_y,$res_x,$res_y,$scale,$serial); + my ($data,@temp); + if (!$fake{'wlr-randr'}){ + $data = main::grabber("$program 2>/dev/null",'','strip','ref'); + } + else { + undef $monitor_ids; + $file = "$fake_data_dir/graphics/wayland/wlr-randr-2-monitor-1.txt"; + $data = main::reader($file,'strip','ref'); + } + foreach (@$data){ + push(@temp,'~~') if /^([A-Z]+-[ABID\d-]+)\s['"]/i; + push(@temp,$_); + } + push(@temp,'~~') if @temp; + @$data = @temp; + $b_wayland_data = 1 if scalar @$data > 4; + print 'wlr-randr: ', Data::Dumper::Dumper $data if $dbg[46]; + main::log_data('dump','@$data', $data) if $b_log; + foreach (@$data){ + if ($_ eq '~~' && $id){ + $monitor_ids->{$id}{'hz'} = $hz; + $monitor_ids->{$id}{'model'} = $model if $model && !$monitor_ids->{$id}{'model'}; + $monitor_ids->{$id}{'monitor'} = $id; + $monitor_ids->{$id}{'pos-x'} = $pos_x; + $monitor_ids->{$id}{'pos-y'} = $pos_y; + $monitor_ids->{$id}{'res-x'} = $res_x; + $monitor_ids->{$id}{'res-y'} = $res_y; + $monitor_ids->{$id}{'scale'} = $scale; + $monitor_ids->{$id}{'serial'} = $serial if $serial && !$monitor_ids->{$id}{'serial'}; + ($hz,$info,$model,$pos_x,$pos_y,$res_x,$res_y,$scale,$serial) = (); + $b_wayland_data = 1; + } + # Output: VGA-1 ' ' (focused) + # DVI-I-1 'Samsung Electric Company SyncMaster H9NX843762' (focused) + # unknown how 'primary' is shown, if it shows in this output + if (/^([A-Z]+-[ABID\d-]+)\s([']([^']+)['])?/i){ + $id = $1; + # if model is set, we got edid data + if ($3 && !$monitor_ids->{$id}{'model'}){ + ($model,$serial) = get_model_serial($3); + } + } + elsif (/^(\d+)x(\d+)\s+px,\s+([\d\.]+)\s+Hz \([^\)]*?current\)/i){ + $res_x = $1; + $res_y = $2; + $hz = sprintf('%.0f',$3) if $3; + } + elsif (/^Position:\s+(\d+),(\d+)/i){ + $pos_x = $1; + $pos_y = $2; + } + elsif (/^Scale:\s+([\d\.]+)/i){ + $scale = $1 + 0; + } + } + print 'wlr-randr: ', Data::Dumper::Dumper $monitor_ids if $dbg[46]; + eval $end if $b_log; +} + +# Return model/serial for those horrible string type values we have to process +# in swaymsg -t get_outputs -p and wlr-randr default output +sub get_model_serial { + eval $start if $b_log; + my $info = $_[0]; + my ($model,$serial); + $info = main::clean($info); + return if !$info; + my @parts = split(/\s+/, $info); + # Perl Madness, lol: the last just checks how many integers in string + if (scalar @parts > 1 && (length($parts[-1]) > 7) && + (($parts[-1] =~ tr/[0-9]//) > 4)){ + $serial = pop @parts; + $serial = main::clean_dmi($serial); # clears out 0x00000 type non data + } + # we're assuming that we'll never get a serial without make/model data too. + $model = join(' ',@parts) if @parts; + $model = main::remove_duplicates($model) if $model && scalar @parts > 1; + eval $end if $b_log; + return ($model,$serial); +} + +# DISPLAY DATA X.org ## +sub display_data_x { + eval $start if $b_log; + my ($prog_xdpyinfo,$prog_xdriinfo,$prog_xrandr); + if ($prog_xdpyinfo = main::check_program('xdpyinfo')){ + xdpyinfo_data($prog_xdpyinfo); + } + # print Data::Dumper::Dumper $graphics{'screens'}; + if ($prog_xrandr = main::check_program('xrandr')){ + xrandr_data($prog_xrandr); + } + # if tool not installed, falls back to testing Xorg log file + if ($prog_xdriinfo = main::check_program('xdriinfo')){ + xdriinfo_data($prog_xdriinfo); + } + if (!$graphics{'screens'}){ + $graphics{'tty'} = tty_data(); + } + if (!$prog_xrandr){ + $graphics{'no-monitors'} = main::message('tool-missing-basic','xrandr'); + if (!$prog_xdpyinfo){ + if ($graphics{'protocol'} eq 'wayland'){ + $graphics{'no-screens'} = main::message('screen-wayland'); + } + else { + $graphics{'no-screens'} = main::message('tool-missing-basic','xdpyinfo/xrandr'); + } + } + } + print 'Final display x: ', Data::Dumper::Dumper $graphics{'screens'} if $dbg[17]; + main::log_data('dump','$graphics{screens}',$graphics{'screens'}) if $b_log; + eval $end if $b_log; +} + +sub xdriinfo_data { + eval $start if $b_log; + my $program = $_[0]; + my (%dri_drivers,$screen,$xdriinfo); + if (!$fake{'xdriinfo'}){ + $xdriinfo = main::grabber("$program $display_opt 2>/dev/null",'','strip','ref'); + } + else { + # $xdriinfo = main::reader("$fake_data_dir/xrandr/xrandr-test-1.txt",'strip','ref'); + } + foreach $screen (@$xdriinfo){ + if ($screen =~ /^Screen (\d+):\s+(\S+)/){ + $dri_drivers{$1} = $2 if $2 !~ /^not\b/; + } + } + if ($graphics{'screens'}){ + # assign to the screen if it's found + foreach $screen (@{$graphics{'screens'}}){ + if (defined $dri_drivers{$screen->{'screen'}} ){ + $screen->{'dri-driver'} = $dri_drivers{$screen->{'screen'}}; + } + } + } + # now the display drivers + foreach $screen (sort keys %dri_drivers){ + if (!$graphics{'dri-drivers'} || + !(grep {$dri_drivers{$screen} eq $_} @{$graphics{'dri-drivers'}})){ + push (@{$graphics{'dri-drivers'}},$dri_drivers{$screen}); + } + } + print 'x dri driver: ', Data::Dumper::Dumper \%dri_drivers if $dbg[17]; + main::log_data('dump','%dri_drivers',\%dri_drivers) if $b_log; + eval $end if $b_log; +} + +sub xdpyinfo_data { + eval $start if $b_log; + my ($program) = @_; + my ($diagonal,$diagonal_m,$dpi) = ('','',''); + my ($screen_id,$xdpyinfo,@working); + my ($res_x,$res_y,$size_x,$size_x_i,$size_y,$size_y_i); + if (!$fake{'xdpyinfo'}){ + $xdpyinfo = main::grabber("$program $display_opt 2>/dev/null","\n",'strip','ref'); + } + else { + # my $file; + # $file = "$fake_data_dir/xdpyinfo/xdpyinfo-1-screen-2-in-inxi.txt"; + # $xdpyinfo = main::reader($file,'strip','ref'); + } + # @$xdpyinfo = map {s/^\s+//;$_} @$xdpyinfo if @$xdpyinfo; + # print join("\n",@$xdpyinfo), "\n"; + # X vendor and version detection. + # new method added since radeon and X.org and the disappearance of + # version : ...etc. Later on, the normal textual version string + # returned, e.g. like: X.Org version: 6.8.2 + # A failover mechanism is in place: if $version empty, release number parsed instead + foreach (@$xdpyinfo){ + @working = split(/:\s+/, $_); + next if (($graphics{'screens'} && $working[0] !~ /^(dimensions$|screen\s#)/) || !$working[0]); + # print "$_\n"; + if ($working[0] eq 'vendor string'){ + $working[1] =~ s/The\s|\sFoundation//g; + # some distros, like fedora, report themselves as the xorg vendor, + # so quick check here to make sure the vendor string includes Xorg in string + if ($working[1] !~ /x/i){ + $working[1] .= ' X.org'; + } + $graphics{'x-server'} = [[$working[1]]]; + } + elsif ($working[0] eq 'name of display'){ + $graphics{'display-id'} = $working[1]; + } + # this is the x protocol version + elsif ($working[0] eq 'version number'){ + $graphics{'x-protocol-version'} = $working[1]; + } + # not used, but might be good for something? + elsif ($working[0] eq 'vendor release number'){ + $graphics{'x-vendor-release'} = $working[1]; + } + # the real X.org version string + elsif ($working[0] eq 'X.Org version'){ + push(@{$graphics{'x-server'}->[0]},$working[1]); + } + elsif ($working[0] eq 'default screen number'){ + $graphics{'display-default-screen'} = $working[1]; + } + elsif ($working[0] eq 'number of screens'){ + $graphics{'display-screens'} = $working[1]; + } + elsif ($working[0] =~ /^screen #([0-9]+):/){ + $screen_id = $1; + } + elsif ($working[0] eq 'resolution'){ + $working[1] =~ s/^([0-9]+)x/$1/; + $graphics{'s-dpi'} = $working[1]; + } + # This is Screen, not monitor: dimensions: 2560x1024 pixels (677x270 millimeters) + elsif ($working[0] eq 'dimensions'){ + ($dpi,$res_x,$res_y,$size_x,$size_y) = (); + if ($working[1] =~ /([0-9]+)\s*x\s*([0-9]+)\s+pixels\s+\(([0-9]+)\s*x\s*([0-9]+)\s*millimeters\)/){ + $res_x = $1; + $res_y = $2; + $size_x = $3; + $size_y = $4; + # flip size x,y if don't roughly match res x/y ratio + if ($size_x && $size_y && $res_y){ + flip_size_x_y(\$size_x,\$size_y,\$res_x,\$res_y); + } + $size_x_i = ($size_x) ? sprintf("%.2f", ($size_x/25.4)) : 0; + $size_y_i = ($size_y) ? sprintf("%.2f", ($size_y/25.4)) : 0; + $dpi = ($res_x && $size_x) ? sprintf("%.0f", ($res_x*25.4/$size_x)) : ''; + $diagonal = ($size_x && $size_y) ? sprintf("%.2f", (sqrt($size_x**2 + $size_y**2)/25.4)) + 0 : ''; + $diagonal_m = ($size_x && $size_y) ? sprintf("%.0f", (sqrt($size_x**2 + $size_y**2))) : ''; + } + push(@{$graphics{'screens'}}, { + 'diagonal' => $diagonal, + 'diagonal-m' => $diagonal_m, + 'res-x' => $res_x, + 'res-y' => $res_y, + 'screen' => $screen_id, + 's-dpi' => $dpi, + 'size-x' => $size_x, + 'size-x-i' => $size_x_i, + 'size-y' => $size_y, + 'size-y-i' => $size_y_i, + 'source' => 'xdpyinfo', + }); + } + } + print 'Data: xdpyinfo: ', Data::Dumper::Dumper $graphics{'screens'} if $dbg[17]; + main::log_data('dump','$graphics{screens}',$graphics{'screens'}) if $b_log; + eval $end if $b_log; +} + +sub xrandr_data { + eval $end if $b_log; + my ($program) = @_; + my ($diagonal,$diagonal_m,$dpi,$monitor_id,$pos_x,$pos_y,$primary); + my ($res_x,$res_x_max,$res_y,$res_y_max); + my ($screen_id,$set_as,$size_x,$size_x_i,$size_y,$size_y_i); + my (@ids,%monitors,@xrandr,@xrandr_screens); + if (!$fake{'xrandr'}){ + # @xrandr = main::grabber("$program $display_opt 2>/dev/null",'','strip','arr'); + # note: --prop support added v 1.2, ~2009 in distros + @xrandr = qx($program --prop $display_opt 2>&1); + if ($? > 0){ + # we only want to rerun if unsupported option + if (grep {/unrecognized/} @xrandr){ + @xrandr = qx($program $display_opt 2>/dev/null); + } + else { + @xrandr = (); + } + } + chomp(@xrandr) if @xrandr; + } + else { + # my $file; + # $file = "$fake_data_dir/xrandr/xrandr-4-displays-1.txt"; + # $file = "$fake_data_dir/xrandr/xrandr-3-display-primary-issue.txt"; + # $file = "$fake_data_dir/xrandr/xrandr-test-1.txt"; + # $file = "$fake_data_dir/xrandr/xrandr-test-2.txt"; + # $file = "$fake_data_dir/xrandr/xrandr-1-screen-2-in-inxi.txt"; + # @xrandr = main::reader($file,'strip','arr'); + } + # $graphics{'dimensions'} = (\@dimensions); + # we get a bit more info from xrandr than xdpyinfo, but xrandr fails to handle + # multiple screens from different video cards + # $graphics{'screens'} = undef; + foreach (@xrandr){ + # note: no mm as with xdpyinfo + # Screen 0: minimum 320 x 200, current 2560 x 1024, maximum 8192 x 8192 + if (/^Screen ([0-9]+):/){ + $screen_id = $1; + # handle no xdpyinfo Screen data, multiple xscreens, etc + if (check_screens($screen_id) && + /:\s.*?current\s+(\d+)\s*x\s*(\d+),\smaximum\s+(\d+)\s*x\s*(\d+)/){ + $res_x = $1; + $res_y = $2; + $res_x_max = $3; + $res_y_max = $4; + push(@{$graphics{'screens'}}, { + 'diagonal' => undef, + 'diagonal-m' => undef, + 'res-x' => $res_x, + 'res-y' => $res_y, + 'screen' => $screen_id, + 's-dpi' => undef, + 'size-x' => undef, + 'size-x-i' => undef, + 'size-y' => undef, + 'size-y-i' => undef, + 'source' => 'xrandr', + }); + } + if (%monitors){ + push(@xrandr_screens,{%monitors}); + %monitors = (); + } + } + # HDMI-2 connected 1920x1200+1080+0 (normal left inverted right x axis y axis) 519mm x 324mm + # DP-1 connected primary 2560x1440+1080+1200 (normal left inverted right x axis y axis) 598mm x 336mm + # HDMI-1 connected 1080x1920+0+0 left (normal left inverted right x axis y axis) 160mm x 90mm + # disabled but connected: VGA-1 connected (normal left inverted right x axis y axis) + elsif (/^([\S]+)\s+connected\s(primary\s)?/){ + $monitor_id = $1; + $set_as = $2; + if (/^[^\s]+\s+connected\s(primary\s)?([0-9]+)\s*x\s*([0-9]+)\+([0-9]+)\+([0-9]+)(\s[^(]*\([^)]+\))?(\s([0-9]+)mm\sx\s([0-9]+)mm)?/){ + $res_x = $2; + $res_y = $3; + $pos_x = $4; + $pos_y = $5; + $size_x = $8; + $size_y = $9; + # flip size x,y if don't roughly match res x/y ratio + if ($size_x && $size_y && $res_y){ + flip_size_x_y(\$size_x,\$size_y,\$res_x,\$res_y); + } + $size_x_i = ($size_x) ? sprintf("%.2f", ($size_x/25.4)) + 0 : 0; + $size_y_i = ($size_y) ? sprintf("%.2f", ($size_y/25.4)) + 0 : 0; + $dpi = ($res_x && $size_x) ? sprintf("%.0f", $res_x * 25.4 / $size_x) : ''; + $diagonal = ($res_x && $size_x) ? sprintf("%.2f", (sqrt($size_x**2 + $size_y**2)/25.4)) + 0 : ''; + $diagonal_m = ($res_x && $size_x) ? sprintf("%.0f", (sqrt($size_x**2 + $size_y**2))) : ''; + } + else { + ($res_x,$res_y,$pos_x,$pos_y,$size_x,$size_x_i,$size_y,$size_y_i,$dpi,$diagonal,$diagonal_m) = () + } + undef $primary; + push(@ids,[$monitor_id]); + if ($set_as){ + $primary = $monitor_id; + $set_as =~ s/\s$//; + $b_primary = 1; + } + $monitors{$monitor_id} = { + 'screen' => $screen_id, + 'monitor' => $monitor_id, + 'pos-x' => $pos_x, + 'pos-y' => $pos_y, + 'primary' => $primary, + 'res-x' => $res_x, + 'res-y' => $res_y, + 'size-x' => $size_x, + 'size-x-i' => $size_x_i, + 'size-y' => $size_y, + 'size-y-i' => $size_y_i, + 'dpi' => $dpi, + 'diagonal' => $diagonal, + 'diagonal-m' => $diagonal_m, + 'position' => $set_as, + }; + # print "x:$size_x y:$size_y rx:$res_x ry:$res_y dpi:$dpi\n"; + ($res_x,$res_y,$size_x,$size_x_i,$size_y,$size_y_i,$set_as) = (0,0,0,0,0,0,0,0,undef); + } + elsif (/^([\S]+)\s+disconnected\s/){ + undef $monitor_id; + } + elsif ($monitor_id && %monitors) { + my @working = split(/\s+/,$_); + # this is the monitor current dimensions + # 5120x1440 59.98* 29.98 + # print Data::Dumper::Dumper \@working; + next if !$working[2]; + if ($working[2] =~ /\*/){ + # print "$working[1] :: $working[2]\n"; + $working[2] =~ s/\*|\+//g; + $working[2] = sprintf("%.0f",$working[2]); + $monitors{$monitor_id}->{'hz'} = $working[2]; + ($diagonal,$dpi) = ('',''); + # print Data::Dumper::Dumper \@monitors; + } + # \tCONNECTOR_ID: 52 + elsif ($working[1] eq 'CONNECTOR_ID:'){ + # print "$working[1] :: $working[2]\n"; + if (!$monitors{$monitor_id}->{'connector-id'}){ + push(@{$ids[$#ids]},$working[2]); + $monitors{$monitor_id}->{'connector-id'} = $working[2]; + } + } + } + } + if (%monitors){ + push(@xrandr_screens,{%monitors}); + } + my $i = 0; + my $layouts; + # corner cases, xrandr screens > xdpyinfo screen, no xdpyinfo counts + if ($graphics{'screens'} && (!defined $graphics{'display-screens'} || + $graphics{'display-screens'} < scalar @{$graphics{'screens'}})){ + $graphics{'display-screens'} = scalar @{$graphics{'screens'}}; + } + map_monitor_ids(\@ids) if @ids; + # print "xrandr_screens 1: " . Data::Dumper::Dumper \@xrandr_screens; + foreach my $main (@{$graphics{'screens'}}){ + # print "h: " . Data::Dumper::Dumper $main; + # print "h: " . Data::Dumper::Dumper @xrandr_screens; + # print $main->{'screen'}, "\n"; + foreach my $x_screen (@xrandr_screens){ + # print "d: " . Data::Dumper::Dumper $x_screen; + my @keys = sort keys %$x_screen; + if ($x_screen->{$keys[0]}{'screen'} eq $main->{'screen'} && + !defined $graphics{'screens'}->[$i]{'monitors'}){ + $graphics{'screens'}->[$i]{'monitors'} = $x_screen; + } + if ($extra > 1){ + if (!$layouts){ + $layouts = []; + set_monitor_layouts($layouts); + } + advanced_monitor_data($x_screen,$layouts); + } + if (!defined $main->{'size-x'}){ + $graphics{'screens'}->[$i]{'size-missing'} = main::message('tool-missing-basic','xdpyinfo'); + } + } + $i++; + } + undef $layouts; + # print "xrandr_screens 2: " . Data::Dumper::Dumper \@xrandr_screens; + print 'Data: xrandr: ', Data::Dumper::Dumper $graphics{'screens'} if $dbg[17]; + main::log_data('dump','$graphics{screens}',$graphics{'screens'}) if $b_log; + eval $end if $b_log; +} + +# Handle some strange corner cases with more robust testing +sub check_screens { + my ($id) = @_; + my $b_use; + # used: scalar @{$graphics{'screens'}} != (scalar @$xrandr_screens + 1) + # before but that test can fail in some cases. + # no screens set in xdpyinfo. If xrandr has > 1 xscreen, this would be false + if (!$graphics{'screens'}){ + $b_use = 1; + } + # verify that any xscreen set so far does not exist in $graphics{'screens'} + else { + my $b_detected; + foreach my $screen (@{$graphics{'screens'}}){ + if ($screen->{'screen'} eq $id){ + $b_detected = 1; + last; + } + } + $b_use = 1 if !$b_detected; + } + return $b_use; +} + +# Case where no xpdyinfo display server/version data exists, or to set Wayland +# Xwayland version, or Xvesa data. +sub display_server_data { + eval $start if $b_log; + my ($program); + # load the extra X paths, it's important that these are first, because + # later Xorg versions show error if run in console or ssh if the true path + # is not used. + @paths = (qw(/usr/lib /usr/lib/xorg /usr/lib/xorg-server /usr/libexec), @paths); + my (@data,$server,$version); + if (!$graphics{'x-server'} || !$graphics{'x-server'}->[0][1]){ + # IMPORTANT: both commands send version data to stderr! + if ($program = main::check_program('Xorg')){ + @data = main::grabber("$program -version 2>&1",'','strip'); + $server = 'X.org'; + } + elsif ($program = main::check_program('X')){ + @data = main::grabber("$program -version 2>&1",'','strip'); + $server = 'X.org'; + } + else { + tinyx_data(\$server,\$version); + } + # print join('^ ', @paths), " :: $program\n"; + # print Data::Dumper::Dumper \@data; + if ($data[0]){ + if ($data[0] =~ /X.org X server (\S+)/i){ + $version = $1; + } + elsif ($data[0] =~ /XFree86 Version (\S+)/i){ + $version = $1; + $server = 'XFree86'; + } + elsif ($data[0] =~ /X Window System Version (\S+)/i){ + $version = $1; + } + } + $graphics{'x-server'} = [[$server,$version]] if $server; + } + if ($program = main::check_program('Xwayland')){ + undef $version; + @data = main::grabber("$program -version 2>&1",'','strip'); + # Slackware Linux Project Xwayland Version 21.1.4 (12101004) + # The X.Org Foundation Xwayland Version 21.1.4 (12101004) + if (@data){ + $data[0] =~ /Xwayland Version (\S+)/; + $version = $1; + } + $graphics{'x-server'} = [] if !$graphics{'x-server'}; + push(@{$graphics{'x-server'}},['Xwayland',$version]); + } + # remove extra X paths from global @paths + @paths = grep { !/^\/usr\/lib|xorg|libexec/ } @paths; + eval $end if $b_log; +} + +# args: 0: $server; 1: $version - both by ref +sub tinyx_data { + eval $start if $b_log; + my ($server,$version) = @_; + # ordered by likelihood, Xmodesetting proposted by tinycore. Others were + # supported by DSL. Existed: Xigs Xipaq Xneomagic Xmga + my $tinies = 'vesa|fbdev|modesetting|chips|i810|igs|ipaq|mach64|mga|'; + $tinies .= 'neomagic|savage|sis530|trident|trio|ts300'; + # these run as a process, and sometimes also have screen resolution + if (my @result = (grep {/^(|\/\S+\/)X($tinies)\b/i} @ps_cmd)){ + if ($result[0] =~ /^(|\/\S+\/)X($tinies)\b/i){ + my $driver = $2; + my $vsize; + if ($result[0] =~ /\s-screen\s+(\d+(x\d+)+)\s/){ + $vsize = $1; + } + my $tinyx = $graphics{'tinyx'} = 'X' . $driver; + $$server = "TinyX $tinyx"; + $graphics{'display-driver'} = [$driver]; + # not all tinyx had -version, DSL did not. + if (my $program = main::check_program($tinyx)){ + $graphics{'xvesa'} = $program if $driver eq 'vesa'; + my @data = main::grabber("$program -version 2>&1",'','strip'); + if (@data && $data[0] =~ /$tinyx from tinyx (\S+)/i){ + $$version = $1; + } + } + # should never happen but just in case + if (!$graphics{'screens'}){ + # no-screens will store either res or tinyx res missing message + if ($vsize){ + $graphics{'no-screens'} = $vsize; + } + else { + if (-d '/sys/devices/platform/'){ + my @size = main::globber('/sys/devices/platform/*/graphics/*/virtual_size'); + if (@size && (my $vsize = main::reader($size[0],'strip',0))){ + $vsize =~ s/,/x/g; + $graphics{'no-screens'} = $vsize; + } + } + if (!$graphics{'no-screens'}){ + $graphics{'no-screens'} = main::message('screen-tinyx',$driver); + } + } + } + } + } + eval $end if $b_log; +} + +sub display_protocol { + eval $start if $b_log; + $graphics{'protocol'} = ''; + if ($ENV{'XDG_SESSION_TYPE'}){ + $graphics{'protocol'} = $ENV{'XDG_SESSION_TYPE'}; + } + if (!$graphics{'protocol'} && $ENV{'WAYLAND_DISPLAY'}){ + $graphics{'protocol'} = $ENV{'WAYLAND_DISPLAY'}; + } + # can show as wayland-0 + if ($graphics{'protocol'} && $graphics{'protocol'} =~ /wayland/i){ + $graphics{'protocol'} = 'wayland'; + } + # yes, I've seen this in 2019 distros, sigh + elsif ($graphics{'protocol'} eq 'tty'){ + $graphics{'protocol'} = ''; + } + # If no other source, get user session id, then grab session type. + # loginctl also results in the session id + # undef $graphics{'protocol'}; + if (!$graphics{'protocol'}){ + if (my $program = main::check_program('loginctl')){ + my $id = ''; + # $id = $ENV{'XDG_SESSION_ID'}; # returns tty session in console + my @data = main::grabber("$program --no-pager --no-legend 2>/dev/null",'','strip'); + foreach (@data){ + # some systems show empty or ??? for TTY field, but whoami should do ok + next if /(ttyv?\d|pts\/)/; # freebsd: ttyv3 + # in display, root doesn't show in the logins + next if $client{'whoami'} && $client{'whoami'} ne 'root' && !/\b$client{'whoami'}\b/; + $id = (split(/\s+/, $_))[0]; + # multiuser? too bad, we'll go for the first one that isn't a tty/pts + last; + } + if ($id){ + my $temp = (main::grabber("$program show-session $id -p Type --no-pager --no-legend 2>/dev/null"))[0]; + $temp =~ s/Type=// if $temp; + # ssh will not show /dev/ttyx so would have passed the first test + $graphics{'protocol'} = $temp if $temp && $temp ne 'tty'; + } + } + } + $graphics{'protocol'} = lc($graphics{'protocol'}) if $graphics{'protocol'}; + eval $end if $b_log; +} + +## DRIVER DATA ## +# for wayland display/monitor drivers, or if no display drivers found for x +sub gpu_drivers_sys { + eval $start if $b_log; + my ($id) = @_; + my ($driver); + my $drivers = []; + # we only want list of drivers for cards with a connected monitor, and inactive + # ports are already removed by the 'all' stage. + foreach my $port (keys %{$monitor_ids}){ + if (!$monitor_ids->{$port}{'drivers'} || + ($id ne 'all' && $id ne $port) || + !$monitor_ids->{$port}{'status'} || + $monitor_ids->{$port}{'status'} ne 'connected'){ + next; + } + else { + foreach $driver (@{$monitor_ids->{$port}{'drivers'}}){ + push(@$drivers,$driver); + } + } + } + if (@$drivers){ + @$drivers = sort(@$drivers); + main::uniq($drivers); + } + eval $end if $b_log; + return $drivers; +} + +sub display_drivers_x { + eval $start if $b_log; + my $driver_data = []; + # print 'x-log: ' . $system_files{'xorg-log'} . "\n"; + if (my $log = $system_files{'xorg-log'}){ + if ($fake{'xorg-log'}){ + # $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/Xorg.0-voyager-serena.log"; + # $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/loading-unload-failed-all41-mint.txt"; + # $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/loading-unload-failed-phd21-mint.txt"; + # $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/Xorg.0-gm10.log"; + # $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/xorg-multi-driver-1.log"; + } + my $x_log = main::reader($log,'','ref'); + # list is from sgfxi plus non-free drivers, plus ARM drivers. + # Don't use ati. It's just a wrapper for: r128, mach64, radeon + my $list = join('|', qw(amdgpu apm ark armsoc atimisc + chips cirrus cyrix etnaviv fbdev fbturbo fglrx geode glide glint + i128 i740 i810-dec100 i810e i810 i815 i830 i845 i855 i865 i915 i945 i965 + iftv igs imstt intel ipaq ivtv mach64 mesa mga m68k modesetting neomagic + newport nouveau nova nsc nvidia nv openchrome r128 radeonhd radeon rendition + s3virge s3 savage siliconmotion sisimedia sisusb sis sis530 sunbw2 suncg14 + suncg3 suncg6 sunffb sunleo suntcx tdfx tga trident trio ts300 tseng + unichrome v4l vboxvideo vesa vga via vmware vmwgfx voodoo)); + # $list = qr/$list/i; # qr/../i only added perl 5.14, fails on older perls + my ($b_use_dri,$dri,$driver,%drivers); + my ($alternate,$failed,$loaded,$unloaded); + my $pattern = 'Failed|Unload|Loading'; + # preferred source xdriinfo because it's current and accurate, but fallback here + if (!$graphics{'dri-drivers'}){ + $b_use_dri = 1; + $pattern .= '|DRI driver:'; + } + # $pattern = qr/$pattern/i; # qr/../i only added perl 5.14, fails on older perls + # it's much cheaper to grab the simple pattern match then do the expensive one + # in the main loop. + # @$x_log = grep {/Failed|Unload|Loading/} @$x_log; + foreach my $line (@$x_log){ + next if $line !~ /$pattern/i; + # print "$line\n"; + # note that in file names, driver is always lower case. Legacy _drv.o + if ($line =~ /\sLoading.*($list)_drv\.s?o$/i){ + $driver=lc($1); + # we get all the actually loaded drivers first, we will use this to compare the + # failed/unloaded, which have not always actually been truly loaded + $drivers{$driver}='loaded'; + } + # openbsd uses UnloadModule: + elsif ($line =~ /(Unloading\s|UnloadModule).*\"?($list)(_drv\.s?o)?\"?$/i){ + $driver=lc($2); + # we get all the actually loaded drivers first, we will use this to compare the + # failed/unloaded, which have not always actually been truly loaded + if (exists $drivers{$driver} && $drivers{$driver} ne 'alternate'){ + $drivers{$driver}='unloaded'; + } + } + # verify that the driver actually started the desktop, even with false failed messages + # which can occur. This is the driver that is actually driving the display. + # note that xorg will often load several modules, like modesetting,fbdev,nouveau + # NOTE: + # (II) UnloadModule: "nouveau" + # (II) Unloading nouveau + # (II) Failed to load module "nouveau" (already loaded, 0) + # (II) LoadModule: "modesetting" + elsif ($line =~ /Failed.*($list)\"?.*$/i){ + # Set driver to lower case because sometimes it will show as + # RADEON or NVIDIA in the actual x start + $driver=lc($1); + # we need to make sure that the driver has already been truly loaded, + # not just discussed + if (exists $drivers{$driver} && $drivers{$driver} ne 'alternate'){ + if ($line !~ /\(already loaded/){ + $drivers{$driver}='failed'; + } + # reset the previous line's 'unloaded' to 'loaded' as well + else { + $drivers{$driver}='loaded'; + } + } + elsif ($line =~ /module does not exist/){ + $drivers{$driver}='alternate'; + } + } + elsif ($b_use_dri && $line =~ /DRI driver:\s*(\S+)/i){ + $dri = $1; + if (!$graphics{'dri-drivers'} || + !(grep {$dri eq $_} @{$graphics{'dri-drivers'}})){ + push(@{$graphics{'dri-drivers'}},$dri); + } + } + } + # print 'drivers: ', Data::Dumper::Dumper \%drivers; + foreach (sort keys %drivers){ + if ($drivers{$_} eq 'loaded'){ + push(@$loaded,$_); + } + elsif ($drivers{$_} eq 'unloaded'){ + push(@$unloaded,$_); + } + elsif ($drivers{$_} eq 'failed'){ + push(@$failed,$_); + } + elsif ($drivers{$_} eq 'alternate'){ + push(@$alternate,$_); + } + } + if ($loaded || $unloaded || $failed || $alternate){ + $driver_data = [$loaded,$unloaded,$failed,$alternate]; + } + } + eval $end if $b_log; + # print 'source: ', Data::Dumper::Dumper $driver_data; + return $driver_data; +} + +sub set_mesa_drivers { + %mesa_drivers = ( + 'anv' => 'intel', + 'crocus' => 'intel', + 'etnaviv' => 'vivante', + 'freedreno' => 'qualcomm', + 'i915' => 'intel', + 'i965' => 'intel', + 'iris' => 'intel', + 'lima' => 'mali', + 'nouveau' => 'nvidia', + 'nova' => 'nvidia', + 'panfrost' => 'mali/bifrost', + 'r200' => 'amd', + 'r300' => 'amd', + 'r600' => 'amd', + 'radeonsi' => 'amd', + 'radv' => 'amd', + 'svga3d' => 'vmware', + 'v3d' => 'broadcom', + 'v3dv' => 'broadcom', + 'vc4' => 'broadcom', + ); +} + +## GPU DATA ## +sub set_amd_data { + $gpu_amd = [ + # no ids + {'arch' => 'Wonder', + 'ids' => '', + 'code' => 'Wonder', + 'process' => 'NEC 800nm', + 'years' => '1986-92', + }, + {'arch' => 'Mach', + 'ids' => '4158|4354|4358|4554|4654|4754|4755|4758|4c42|4c49|4c50|4c54|5354|' . + '5654|5655|5656', + 'code' => 'Mach64', + 'process' => 'TSMC 500-600nm', + 'years' => '1992-97', + }, + {'arch' => 'Rage-2', + 'ids' => '4756|4757|4759|475a|4c47', + 'code' => 'Rage-2', + 'process' => 'TSMC 500nm', + 'years' => '1996', + }, + {'arch' => 'Rage-3', + 'ids' => '4742|4744|4749|474d|474f|4750|4752', + 'code' => 'Rage-3', + 'process' => 'TSMC 350nm', + 'years' => '1997-99', + }, + {'arch' => 'Rage-4', + 'ids' => '474e|4753|4c46|4c4d|4c4e|4c52|4d46|5044|5046|5050|5052|5245|5246|' . + '524b|524c|534d|5446|5452', + 'code' => 'Rage-4', + 'process' => 'TSMC 250-350nm', + 'years' => '1998-99', + }, + # vendor 1014 IBM, subvendor: 1092 + # 0172|0173|0174|0184 + # {'arch' => 'IBM', + # 'code' => 'Fire GL', + # 'process' => 'IBM 156-250nm', + # 'years' => '1999-2001', + # }, + # rage 5 was game cube flipper chip +# rage 5 was game cube flipper chip 2000 + {'arch' => 'Rage-6', + 'ids' => '4137|4337|4437|4c59|5144|5159|515e', + 'code' => 'R100', + 'process' => 'TSMC 180nm', + 'years' => '2000-07', + }, + # |Radeon (7[3-9]{2}|8d{3}|9[5-9]d{2} + {'arch' => 'Rage-7', + 'ids' => '4136|4150|4152|4170|4172|4242|4336|4966|496e|4c57|4c58|4c66|4c6e|' . + '4e51|4f72|4f73|5148|514c|514d|5157|5834|5835|5940|5941|5944|5960|5961|5962|' . + '5964|5965|5b63|5b72|5b73|5c61|5c63|5d44|5d45|7100|7101|7102|7109|710a|710b|' . + '7120|7129|7140|7142|7143|7145|7146|7147|7149|714a|715f|7162|7163|7166|7167|' . + '7181|7183|7186|7187|718b|718c|718d|7193|7196|719f|71a0|71a1|71a3|71a7|71c0|' . + '71c1|71c2|71c3|71c5|71c6|71c7|71ce|71d5|71d6|71de|71e0|71e1|71e2|71e6|71e7|' . + '7240|7244|7248|7249|724b|7269|726b|7280|7288|7291|7293|72a0|72a8|72b1|72b3|' . + '7834|7835|791e', + 'code' => 'R200', + 'process' => 'TSMC 150nm', + 'years' => '2001-06', + }, + {'arch' => 'Rage-8', + 'ids' => '4144|4146|4147|4148|4151|4153|4154|4155|4157|4164|4165|4166|4168|' . + '4171|4173|4e44|4e45|4e46|4e47|4e48|4e49|4e4b|4e50|4e52|4e54|4e64|4e65|4e66|' . + '4e67|4e68|4e69|4e6a|4e71|5a41|5a42|5a61|5a62', + 'code' => 'R300', + 'process' => 'TSMC 130nm', + 'years' => '2002-07', + }, + {'arch' => 'Rage-9', + 'ids' => '3150|3151|3152|3154|3155|3171|3e50|3e54|3e70|4e4a|4e56|5460|5461|' . + '5462|5464|5657|5854|5874|5954|5955|5974|5975|5b60|5b62|5b64|5b65|5b66|5b70|' . + '5b74|5b75', + 'code' => 'Radeon IGP', + 'process' => 'TSMC 110nm', + 'years' => '2003-08', + }, + {'arch' => 'R400', + 'ids' => '4a49|4a4a|4a4b|4a4d|4a4e|4a4f|4a50|4a54|4a69|4a6a|4a6b|4a70|4a74|' . + '4b49|4b4b|4b4c|4b69|4b6b|4b6c|5549|554a|554b|554d|554e|554f|5550|5551|5569|' . + '556b|556d|556f|5571|564b|564f|5652|5653|5d48|5d49|5d4a|5d4d|5d4e|5d4f|5d50|' . + '5d52|5d57|5d6d|5d6f|5d72|5d77|5e48|5e49|5e4a|5e4b|5e4c|5e4d|5e4f|5e6b|5e6d|' . + '5f57|791f|793f|7941|7942|796e', + 'code' => 'R400', + 'process' => 'TSMC 55-130nm', + 'years' => '2004-08', + }, + {'arch' => 'R500', + 'ids' => '7104|710e|710f|7124|712e|712f|7152|7153|7172|7173|7188|718a|719b|' . + '71bb|71c4|71d2|71d4|71f2|7210|7211|724e|726e|940f|94c8|94c9|9511|9581|9583|' . + '958b|958d', + 'code' => 'R500', + 'process' => 'TSMC 90nm', + 'years' => '2005-07', + }, + # process: tsmc 55nm, 65nm, xbox 360s at 40nm + {'arch' => 'TeraScale', + 'ids' => '4346|4630|4631|9400|9401|9403|9405|940a|940b|9440|9441|9442|9443|' . + '9444|9446|944a|944b|944c|944e|9450|9452|9456|945a|9460|9462|946a|9480|9488|' . + '9489|9490|9491|9495|9498|949c|949e|949f|94a0|94a1|94a3|94b3|94b4|94c1|94c3|' . + '94c4|94c5|94c7|94cb|94cc|9500|9501|9504|9505|9506|9507|9508|9509|950f|9513|' . + '9515|9519|9540|954f|9552|9553|9555|9557|955f|9580|9586|9587|9588|9589|958a|' . + '958c|9591|9593|9595|9596|9597|9598|9599|95c0|95c2|95c4|95c5|95c6|95c9|95cc|' . + '95cd|95cf|9610|9611|9612|9613|9614|9615|9616|9710|9712|9713|9714|9715', + 'code' => 'R6xx/RV6xx/RV7xx', + 'process' => 'TSMC 55-65nm', + 'years' => '2005-13', + }, + {'arch' => 'TeraScale-2', + 'ids' => '6720|6738|6739|673e|6740|6741|6742|6743|6749|674a|6750|6751|6758|' . + '6759|675b|675d|675f|6760|6761|6763|6764|6765|6766|6767|6768|6770|6771|6772|' . + '6778|6779|677b|6840|6841|6842|6843|6880|6888|6889|688a|688c|688d|6898|6899|' . + '689b|689c|689d|689e|68a0|68a1|68a8|68a9|68b8|68b9|68ba|68be|68bf|68c0|68c1|' . + '68c7|68c8|68c9|68d8|68d9|68da|68de|68e0|68e1|68e4|68e5|68e8|68e9|68f1|68f2|' . + '68f8|68f9|68fa|68fe|9640|9641|9642|9643|9644|9645|9647|9648|9649|964a|964b|' . + '964c|964e|964f|9802|9803|9804|9805|9806|9807|9808|9809|980a|9925|9926', + 'code' => 'Evergreen', + 'process' => 'TSMC 32-40nm', + 'years' => '2009-15', + }, + {'arch' => 'TeraScale-3', + 'ids' => '6704|6707|6718|6719|671c|671d|671f|9900|9901|9903|9904|9905|9906|' . + '9907|9908|9909|990a|990b|990c|990d|990e|990f|9910|9913|9917|9918|9919|9990|' . + '9991|9992|9993|9994|9995|9996|9997|9998|9999|999a|999b|999c|999d|99a0|99a2|' . + '99a4', + 'code' => 'Northern Islands', + 'process' => 'TSMC 32nm', + 'years' => '2010-13', + }, + {'arch' => 'GCN-1', + 'ids' => '154c|6600|6601|6604|6605|6606|6607|6608|6609|6610|6611|6613|6617|' . + '6631|6660|6663|6664|6665|6666|6667|666f|6780|6784|6788|678a|6798|6799|679a|' . + '679b|679e|679f|6800|6801|6802|6806|6808|6809|6810|6811|6816|6817|6818|6819|' . + '6820|6821|6822|6823|6825|6826|6827|6828|6829|682a|682b|682c|682d|682f|6830|' . + '6831|6835|6837|683d|683f|684c', + 'code' => 'Southern Islands', + 'process' => 'TSMC 28nm', + 'years' => '2011-20', + }, + # process: both TSMC and GlobalFoundries + {'arch' => 'GCN-2', + 'ids' => '1304|1305|1306|1307|1309|130a|130b|130c|130d|130e|130f|1310|1311|' . + '1312|1313|1315|1316|1317|1318|131b|131c|131d|6640|6641|6646|6647|6649|664d|' . + '6650|6651|6658|665c|665d|665f|67a0|67a1|67a2|67a8|67a9|67aa|67b0|67b1|67b8|' . + '67b9|67be|9830|9831|9832|9833|9834|9835|9836|9837|9838|9839|983d|9850|9851|' . + '9852|9853|9854|9855|9856|9857|9858|9859|985a|985b|985c|985d|985e|985f|991e|' . + '9920|9922', + 'code' => 'Sea Islands', + 'process' => 'GF/TSMC 16-28nm', + 'years' => '2013-17', + }, + {'arch' => 'GCN-3', + 'ids' => '6900|6901|6902|6907|6920|6921|6929|692b|692f|6930|6938|6939|693b|' . + '7300|730f|9874|98c0|98e4', + 'code' => 'Volcanic Islands', + 'process' => 'TSMC 28nm', + 'years' => '2014-19', + }, + {'arch' => 'GCN-4', + 'ids' => '154e|1551|1552|1561|67c0|67c1|67c2|67c4|67c7|67ca|67cc|67cf|67d0|' . + '67d4|67d7|67df|67e0|67e1|67e3|67e8|67e9|67eb|67ef|67ff|694c|694e|694f|6980|' . + '6981|6984|6985|6986|6987|698f|6995|6997|699f|6fdf|9924|9925', + 'code' => 'Arctic Islands', + 'process' => 'GF 14nm', + 'years' => '2016-20', + }, + {'arch' => 'GCN-5.1', + 'ids' => '15d8|15dd|15df|15e7|1636|1638|164c|66a0|66a1|66a2|66a3|66a7|66af|' . + '69af', + 'code' => 'Vega-2', + 'process' => 'TSMC n7 (7nm)', + 'years' => '2018-22+', + }, + {'arch' => 'GCN-5', + 'ids' => '15d8|15d9|15dd|15e7|15ff|1636|1638|164c|66a0|66a1|66a2|66a3|66a4|' . + '66a7|66af|6860|6861|6862|6863|6864|6867|6868|6869|686a|686b|686c|686d|686e|' . + '687f|69a0|69a1|69a2|69a3|69af', + 'code' => 'Vega', + 'process' => 'GF 14nm', + 'years' => '2017-20', + }, + {'arch' => 'RDNA-1', + 'ids' => '13e9|13f9|13fe|1478|1479|1607|7310|7312|7318|7319|731a|731b|731e|' . + '731f|7340|7341|7343|7347|734f|7360|7362', + 'code' => 'Navi-1x', + 'process' => 'TSMC n7 (7nm)', + 'years' => '2019-20', + }, + {'arch' => 'RDNA-2', + 'ids' => '1435|1506|163f|164d|164e|1681|73a0|73a1|73a2|73a3|73a5|73ab|73ae|' . + '73af|73bf|73c0|73c1|73c3|73ce|73df|73e0|73e1|73e3|73ef|73ff|7420|7421|7422|' . + '7423|7424|743f', + 'code' => 'Navi-2x', + 'process' => 'TSMC n7 (7nm)', + 'years' => '2020-22', + }, + {'arch' => 'RDNA-3', + 'ids' => '73a8|73c4|73c5|73c8|7448|744c|745e|7460|7461|7470|7478|747e', + 'code' => 'Navi-3x', + 'process' => 'TSMC n5 (5nm)', + 'years' => '2022+', + }, + {'arch' => 'RDNA-3', + 'ids' => '73f0|7480|7481|7483|7487|7489|748b|749f', + 'code' => 'Navi-33',- + 'process' => 'TSMC n6 (6nm)', + 'years' => '2023+', + }, + {'arch' => 'RDNA-3', + 'ids' => '15bf|15c8|164f|1900|1901', + 'code' => 'Phoenix', + 'process' => 'TSMC n4 (4nm)', + 'years' => '2023+', + }, + {'arch' => 'CDNA-1', + 'ids' => '7388|738c|738e', + 'code' => 'Instinct-MI1xx', + 'process' => 'TSMC n7 (7nm)', + 'years' => '2020', + }, + {'arch' => 'CDNA-2', + 'ids' => '7408|740c|740f', + 'code' => 'Instinct-MI2xx', + 'process' => 'TSMC n6 (6nm)', + 'years' => '2021-22+', + }, + {'arch' => 'CDNA-3', + 'ids' => '74a0|74a1', + 'code' => 'Instinct-MI3xx', + 'process' => 'TSMC n5 (5nm)', + 'years' => '2023+', + }, + ]; +} + +sub set_intel_data { + $gpu_intel = [ + {'arch' => 'Gen-1', + 'ids' => '1132|7120|7121|7122|7123|7124|7125|7126|7128|712a', + 'code' => '', + 'process' => 'Intel 150nm', + 'years' => '1998-2002', + }, + # ill-fated standalone gfx card + {'arch' => 'i740', + 'ids' => '7800', + 'code' => '', + 'process' => 'Intel 150nm', + 'years' => '1998', + }, + {'arch' => 'Gen-2', + 'ids' => '2562|2572|3577|3582|358e', + 'code' => '', + 'process' => 'Intel 130nm', + 'years' => '2002-03', + }, + {'arch' => 'Gen-3', + 'ids' => '2582|2592|2780|2782|2792', + 'code' => 'Intel 130nm', + 'process' => '', + 'years' => '2004-05', + }, + {'arch' => 'Gen-3.5', + 'ids' => '2772|2776|27a2|27a6|27ae|2972|2973', + 'code' => '', + 'process' => 'Intel 90nm', + 'years' => '2005-06', + }, + {'arch' => 'Gen-4', + 'ids' => '2982|2983|2992|2993|29a2|29a3|29b2|29b3|29c2|29c3|29d2|29d3|2a02|' . + '2a03|2a12|2a13|2a42|2e02|2e12|2e22|2e32|2e42|2e92|a001|a011', + 'code' => '', + 'process' => 'Intel 65n', + 'years' => '2006-07', + }, + {'arch' => 'PowerVR SGX535', + 'ids' => '4100|8108|8109|a001|a002|a011|a012', + 'code' => '', + 'process' => 'Intel 45-130nm', + 'year' => '2008-10', + }, + {'arch' => 'Gen-5', + 'ids' => '2a41|2a42|2a43|2e02|2e03|2e12|2e13|2e22|2e23|2e32|2e33|2e42|2e43|' . + '2e92|2e93', + 'code' => '', + 'process' => 'Intel 45nm', + 'years' => '2008', + }, + {'arch' => 'PowerVR SGX545', + 'ids' => '0be0|0be1|0be2|0be3|0be4|0be5|0be6|0be7|0be8|0be9|0bea|0beb|0bec|' . + '0bed|0bee|0bef', + 'code' => '', + 'process' => 'Intel 65nm', + 'years' => '2008-10', + }, + {'arch' => 'Gen-5.75', + 'ids' => '0042|0046|004a|0402|0412|0416', + 'code' => '', + 'process' => 'Intel 45nm', + 'years' => '2010', + }, + {'arch' => 'Knights', + 'ids' => '', + 'code' => '', + 'process' => 'Intel 22nm', + 'years' => '2012-13', + }, + {'arch' => 'Gen-6', + 'ids' => '0102|0106|010a|010b|010e|0112|0116|0122|0126|08cf', + 'code' => 'Sandybridge', + 'process' => 'Intel 32nm', + 'years' => '2011', + }, + {'arch' => 'Gen-7.5', + 'ids' => '0402|0406|040a|040b|040e|0412|0416|041a|041b|041e|0422|0426|042a|' . + '042b|042e|0a02|0a06|0a0a|0a0b|0a0e|0a12|0a16|0a1a|0a1b|0a1e|0a22|0a26|0a2a|' . + '0a2b|0a2e|0c02|0c06|0c0a|0c0b|0c0e|0c12|0c16|0c1a|0c1b|0c1e|0c22|0c26|0c2a|' . + '0c2b|0c2e|0d02|0d06|0d0a|0d0b|0d0e|0d12|0d16|0d1a|0d1b|0d1e|0d22|0d26|0d2a|' . + '0d2b|0d2e', + 'code' => '', + 'process' => 'Intel 22nm', + 'years' => '2013', + }, + {'arch' => 'Gen-7', + 'ids' => '0152|0155|0156|0157|015a|015e|0162|0166|016a|0172|0176|0f30|0f31|' . + '0f32|0f33', + 'code' => '', + 'process' => 'Intel 22nm', + 'years' => '2012-13', + }, + {'arch' => 'Gen-8', + 'ids' => '1602|1606|160a|160b|160d|160e|1612|1616|161a|161b|161d|161e|1622|' . + '1626|162a|162b|162d|162e|1632|1636|163a|163b|163d|163e|22b0|22b1|22b2|22b3', + 'code' => '', + 'process' => 'Intel 14nm', + 'years' => '2014-15', + }, + {'arch' => 'Gen-9.5', + 'ids' => '3184|3185|3e90|3e91|3e92|3e93|3e94|3e96|3e98|3e99|3e9a|3e9b|3e9c|' . + '3ea0|3ea1|3ea2|3ea3|3ea4|3ea5|3ea6|3ea7|3ea8|3ea9|5902|5906|5908|590a|590b|' . + '590e|5912|5913|5915|5916|5917|591a|591b|591c|591d|591e|5921|5923|5926|5927|' . + '593b|87c0|87ca|9b21|9b41|9ba0|9ba2|9ba4|9ba5|9ba8|9baa|9bab|9bac|9bc0|9bc2|' . + '9bc4|9bc5|9bc6|9bc8|9bca|9bcb|9bcc|9be6|9bf6', + 'code' => '', + 'process' => 'Intel 14nm', + 'years' => '2016-20', + }, + {'arch' => 'Gen-9', + 'ids' => '0a84|1902|1906|190a|190b|190e|1912|1913|1915|1916|1917|191a|191b|' . + '191d|191e|1921|1923|1926|1927|192a|192b|192d|1932|193a|193b|193d|1a84|1a85|' . + '5a84|5a85', + 'code' => '', + 'process' => 'Intel 14n', + 'years' => '2015-16', + }, + # gen10 was cancelled., + {'arch' => 'Gen-11', + 'ids' => '0d16|0d26|0d36|4541|4551|4555|4557|4571|4e51|4e55|4e57|4e61|4e71|' . + '8a50|8a51|8a52|8a53|8a54|8a56|8a57|8a58|8a59|8a5a|8a5b|8a5c|8a5d|8a70|8a71|' . + '9840|9841', + 'code' => '', + 'process' => 'Intel 10nm', + 'years' => '2019-21', + }, + {'arch' => 'Gen-12.1', + 'ids' => '4626|4628|462a|4636|4638|463a|4680|4682|4688|468a|468b|4690|4692|' . + '4693|46a1|46a2|46a3|46b2|46b3|46c2|46c3|46d0|46d1|46d2|4905|4907|4908|4909|' . + '4c8a|4c8b|4c90|4c9a|9a40|9a49|9a59|9a60|9a68|9a70|9a78|9ac0|9ac9|9ad9|9af8|' . + 'a719|a720|a721|a780|a781|a782|a783|a788|a789|a78a|a78b|a7a8|a7a9', + 'code' => '', + 'process' => 'Intel 10nm', + 'years' => '2020-21', + }, + {'arch' => 'Gen-12.2', + 'ids' => '4626|46a0|46a1|46a6|46a8|46aa|46b0|46b1|46b6|46b8|46ba|46c0|46c1|' . + '46d3|46d4', + 'code' => '', + 'process' => 'Intel 10nm', + 'years' => '2021-22+', + }, + {'arch' => 'Gen-12.5', + 'ids' => '0bd5|0bda', + 'code' => '', + 'process' => 'Intel 10nm', + 'years' => '2021-23+', + }, + {'arch' => 'Gen-12.7', + 'ids' => '4f80|4f81|4f82|4f83|4f84|4f85|4f86|4f87|4f88|5690|5691|5692|5693|' . + '5694|5696|5697|5698|56a0|56a1|56a2|56a3|56a4|56a5|56a6|56a7|56a8|56a9|56b0|' . + '56b1|56b2|56b3|56ba|56bb|56bc|56bd|56be|56bf|56c0|56c1', + 'code' => 'Alchemist', + 'process' => 'TSMC n6 (7nm)', + 'years' => '2022+', + }, + {'arch' => 'Gen-13', + 'ids' => 'a70d|a719|a720|a721|a74d|a780|a781|a782|a783|a788|a789|a78a|a78b|' . + 'a7a0|a7a1|a7a8|a7a9|a7aa|a7ab|a7ac|a7ad', + 'code' => '', + 'process' => 'Intel 7 (10nm)', + 'years' => '2022+', + }, + {'arch' => 'Gen-13', + 'ids' => '7d40|7d41|7d45|7d51|7d55|7d60|7d67|7dd1|7dd5', + 'code' => '', + 'process' => 'Intel 4 (7nm+)', + 'years' => '2023+', + }, + {'arch' => 'Gen-14', + 'ids' => 'e202|e20b|e20c|e20d|e212', + 'code' => '', + 'process' => 'TSMC n4 (4nm)', + 'years' => '2024+', + }, + {'arch' => 'Gen-14', + 'ids' => '6420|64a0|64b0', + 'code' => '', + 'process' => 'TSMC n3 (3nm)', + 'years' => '2024+', + }, + {'arch' => 'Gen-15', + 'ids' => '7d41|7d51|7d67|7dd1', + 'code' => '', + 'process' => 'TSMC 3nm?', + 'years' => '2025+', + }, + + ]; +} + +sub set_loongson_data { + $gpu_loongson = [ + {'arch' => '?', + 'ids' => '7a25', + 'code' => '', + 'process' => '12-14nm (STM)', + 'years' => '2023+', + }, + ]; +} + +sub set_nv_data { + # this is vendor id: 12d2, nv1/riva/tnt type cards + # 0008|0009|0010|0018|0019 + # and these are vendor id: 10de for 73.14 + # 0020|0028|0029|002c|002d|00a0|0100|0101|0103|0150|0151|0152|0153 + # generic fallback if we don't have the actual EOL termination date + my $date = $self_date; + $date =~ s/-\d+$//; + my $status_current = main::message('nv-current',$date); + # load legacy data, note, if there are 2 or more arch in 1 legacy, it has 1 + # item per arch. kernel/last/xorg support either from nvidia or sgfxi + ## Legacy 71.86.xx + $gpu_nv = [ + {'arch' => 'Fahrenheit', + 'ids' => '0008|0009|0010|0018|0019|0020|0028|0029|002c|002d|00a0', + 'code' => 'NVx', + 'kernel' => '2.6.38', + 'legacy' => 1, + 'process' => 'TSMC 220-350nm', + 'release' => '71.86.15', + 'series' => '71.86.xx', + 'status' => main::message('nv-legacy-eol','2011-08-xx'), + 'xorg' => '1.7', + 'years' => '1998-2000', + }, + {'arch' => 'Celsius', + 'ids' => '0100|0101|0103|0150|0151|0152|0153', + 'code' => 'NV1x', + 'kernel' => '2.6.38', + 'legacy' => 1, + 'process' => 'TSMC 150-220nm', + 'release' => '71.86.15', + 'series' => '71.86.xx', + 'status' => main::message('nv-legacy-eol','2011-08-xx'), + 'xorg' => '1.7', + 'years' => '1999-2005', + }, + ## Legacy 96.43.xx + {'arch' => 'Celsius', + 'ids' => '0110|0111|0112|0113|01a0', + 'code' => 'NV1x', + 'kernel' => '3.6', + 'legacy' => 1, + 'process' => 'TSMC 150-220nm', + 'release' => '96.43.23', + 'series' => '96.43.xx', + 'status' => main::message('nv-legacy-eol','2012-09-xx'), + 'xorg' => '1.12', + 'years' => '1999-2005', + }, + {'arch' => 'Kelvin', + 'ids' => '0170|0171|0172|0173|0174|0175|0176|0177|0178|0179|017a|017c|017d|' . + '0181|0182|0183|0185|0188|018a|018b|018c|01f0|0200|0201|0202|0203|0250|0251|' . + '0253|0258|0259|025b|0280|0281|0282|0286|0288|0289|028c', + 'code' => 'NV2x', + 'kernel' => '3.6', + 'legacy' => 1, + 'process' => 'TSMC 150nm', + 'release' => '96.43.23', + 'series' => '96.43.xx', + 'status' => main::message('nv-legacy-eol','2012-09-xx'), + 'xorg' => '1.12', + 'years' => '2001-2003', + }, + ## Legacy 173.14.xx + # process: IBM 130, TSMC 130-150 + {'arch' => 'Rankine', + 'ids' => '00fa|00fb|00fc|00fd|00fe|0301|0302|0308|0309|0311|0312|0314|031a|' . + '031b|031c|0320|0321|0322|0323|0324|0325|0326|0327|0328|032a|032b|032c|032d|' . + '0330|0331|0332|0333|0334|0338|033f|0341|0342|0343|0344|0347|0348|034c|034e', + 'code' => 'NV3x', + 'kernel' => '3.12', + 'legacy' => 1, + 'process' => '130-150nm', + 'release' => '173.14.39', + 'series' => '173.14.xx', + 'status' => main::message('nv-legacy-eol','2013-12-xx'), + 'xorg' => '1.15', + 'years' => '2003-2005', + }, + ## Legacy 304.xx + # code: hard to get these, roughly MCP[567]x/NV4x/G7x + # process: IBM 130, TSMC 90-110 + {'arch' => 'Curie', + 'ids' => '0040|0041|0042|0043|0044|0045|0046|0047|0048|004e|0090|0091|0092|' . + '0093|0095|0098|0099|009d|00c0|00c1|00c2|00c3|00c8|00c9|00cc|00cd|00ce|00f1|' . + '00f2|00f3|00f4|00f5|00f6|00f8|00f9|0140|0141|0142|0143|0144|0145|0146|0147|' . + '0148|0149|014a|014c|014d|014e|014f|0160|0161|0162|0163|0164|0165|0166|0167|' . + '0168|0169|016a|01d0|01d1|01d2|01d3|01d6|01d7|01d8|01da|01db|01dc|01dd|01de|' . + '01df|0211|0212|0215|0218|0221|0222|0240|0241|0242|0244|0245|0247|0290|0291|' . + '0292|0293|0294|0295|0297|0298|0299|029a|029b|029c|029d|029e|029f|02e0|02e1|' . + '02e2|02e3|02e4|038b|0390|0391|0392|0393|0394|0395|0397|0398|0399|039c|039e|' . + '03d0|03d1|03d2|03d5|03d6|0531|0533|053a|053b|053e|07e0|07e1|07e2|07e3|07e5', + 'code' => '', + 'kernel' => '4.13', + 'legacy' => 1, + 'process' => '90-130nm', + 'release' => '304.137', + 'series' => '304.xx', + 'status' => main::message('nv-legacy-eol','2017-09-xx'), + 'xorg' => '1.19', + 'years' => '2003-2013', + }, + ## Legacy 340.xx + # these are both Tesla and Tesla 2.0 + # code: not clear, 8800/GT2xx/maybe G7x + # years: 2006-2010 Tesla 2007-2013 Tesla 2.0 + {'arch' => 'Tesla', + 'ids' => '0191|0193|0194|0197|019d|019e|0400|0401|0402|0403|0404|0405|0406|' . + '0407|0408|0409|040a|040b|040c|040d|040e|040f|0410|0420|0421|0422|0423|0424|' . + '0425|0426|0427|0428|0429|042a|042b|042c|042d|042e|042f|05e0|05e1|05e2|05e3|' . + '05e6|05e7|05ea|05eb|05ed|05f8|05f9|05fd|05fe|05ff|0600|0601|0602|0603|0604|' . + '0605|0606|0607|0608|0609|060a|060b|060c|060d|060f|0610|0611|0612|0613|0614|' . + '0615|0617|0618|0619|061a|061b|061c|061d|061e|061f|0621|0622|0623|0625|0626|' . + '0627|0628|062a|062b|062c|062d|062e|0630|0631|0632|0635|0637|0638|063a|0640|' . + '0641|0643|0644|0645|0646|0647|0648|0649|064a|064b|064c|0651|0652|0653|0654|' . + '0655|0656|0658|0659|065a|065b|065c|06e0|06e1|06e2|06e3|06e4|06e5|06e6|06e7|' . + '06e8|06e9|06ea|06eb|06ec|06ef|06f1|06f8|06f9|06fa|06fb|06fd|06ff|0840|0844|' . + '0845|0846|0847|0848|0849|084a|084b|084c|084d|084f|0860|0861|0862|0863|0864|' . + '0865|0866|0867|0868|0869|086a|086c|086d|086e|086f|0870|0871|0872|0873|0874|' . + '0876|087a|087d|087e|087f|08a0|08a2|08a3|08a4|08a5|0a20|0a22|0a23|0a26|0a27|' . + '0a28|0a29|0a2a|0a2b|0a2c|0a2d|0a32|0a34|0a35|0a38|0a3c|0a60|0a62|0a63|0a64|' . + '0a65|0a66|0a67|0a68|0a69|0a6a|0a6c|0a6e|0a6f|0a70|0a71|0a72|0a73|0a74|0a75|' . + '0a76|0a78|0a7a|0a7c|0ca0|0ca2|0ca3|0ca4|0ca5|0ca7|0ca8|0ca9|0cac|0caf|0cb0|' . + '0cb1|0cbc|10c0|10c3|10c5|10d8', + 'code' => '', + 'kernel' => '5.4', + 'legacy' => 1, + 'process' => '40-80nm', + 'release' => '340.108', + 'series' => '340.xx', + 'status' => main::message('nv-legacy-eol','2019-12-xx'), + 'xorg' => '1.20', + 'years' => '2006-2013', + }, + ## Legacy 367.xx + {'arch' => 'Kepler', + 'ids' => '0fef|0ff2|11bf', + 'code' => 'GKxxx', + 'kernel' => '5.4', + 'legacy' => 1, + 'process' => 'TSMC 28nm', + 'release' => '', + 'series' => '367.xx', + 'status' => main::message('nv-legacy-eol','2017'), + 'xorg' => '1.20', + 'years' => '2012-2018', + }, + ## Legacy 390.xx + # this is Fermi, Fermi 2.0 + {'arch' => 'Fermi', + 'ids' => '06c0|06c4|06ca|06cd|06d1|06d2|06d8|06d9|06da|06dc|06dd|06de|06df|' . + '0dc0|0dc4|0dc5|0dc6|0dcd|0dce|0dd1|0dd2|0dd3|0dd6|0dd8|0dda|0de0|0de1|0de2|' . + '0de3|0de4|0de5|0de7|0de8|0de9|0dea|0deb|0dec|0ded|0dee|0def|0df0|0df1|0df2|' . + '0df3|0df4|0df5|0df6|0df7|0df8|0df9|0dfa|0dfc|0e22|0e23|0e24|0e30|0e31|0e3a|' . + '0e3b|0f00|0f01|0f02|0f03|1040|1042|1048|1049|104a|104b|104c|1050|1051|1052|' . + '1054|1055|1056|1057|1058|1059|105a|105b|107c|107d|1080|1081|1082|1084|1086|' . + '1087|1088|1089|108b|1091|1094|1096|109a|109b|1140|1200|1201|1203|1205|1206|' . + '1207|1208|1210|1211|1212|1213|1241|1243|1244|1245|1246|1247|1248|1249|124b|' . + '124d|1251', + 'code' => 'GF1xx', + 'kernel' => '6.0', + 'legacy' => 1, + 'process' => '40/28nm', + 'release' => '390.157', + 'series' => '390.xx+', + 'status' => main::message('nv-legacy-eol','2022-11-22'), + 'xorg' => '1.21', + 'years' => '2010-2016', + }, + ## Legacy 470.xx + {'arch' => 'Fermi-2', + 'ids' => '0fec|1281|1289|128b|1295', + 'code' => 'GF119/GK208', + 'kernel' => '', + 'legacy' => 1, + 'process' => 'TSMC 28nm', + 'release' => '', + 'series' => '470.xx+', + 'status' => main::message('nv-legacy-active','2024-09-xx'), + 'xorg' => '', + 'years' => '2010-2016', + }, + # GT 720M and 805A/810A are the same cpu id. + # years: 2012-2018 Kepler 2013-2015 Kepler 2.0 + {'arch' => 'Kepler-2', + 'ids' => '0fc6|0fc8|0fc9|0fcd|0fce|0fd1|0fd2|0fd3|0fd4|0fd5|0fd8|0fd9|0fdf|' . + '0fe0|0fe1|0fe2|0fe3|0fe4|0fe9|0fea|0fed|0fee|0ff6|0ff8|0ff9|0ffa|0ffb|0ffc|' . + '0ffd|0ffe|0fff|1001|1004|1005|1007|1008|100a|100c|1021|1022|1023|1024|1026|' . + '1027|1028|1029|102a|102d|103a|103c|1180|1183|1184|1185|1187|1188|1189|118a|' . + '118e|118f|1193|1194|1195|1198|1199|119a|119d|119e|119f|11a0|11a1|11a2|11a3|' . + '11a7|11b4|11b6|11b7|11b8|11ba|11bc|11bd|11be|11c0|11c2|11c3|11c4|11c5|11c6|' . + '11c8|11cb|11e0|11e1|11e2|11e3|11fa|11fc|1280|1282|1284|1286|1287|1288|1290|' . + '1291|1292|1293|1295|1296|1298|1299|129a|12b9|12ba', + 'code' => 'GKxxx', + 'kernel' => '', + 'legacy' => 1, + 'process' => 'TSMC 28nm', + 'release' => '', + 'series' => '470.xx+', + 'status' => main::message('nv-legacy-active','2024-09-xx'), + 'xorg' => '', + 'years' => '2012-2018', + }, + ## Current Active Series + # load microarch data, as stuff goes legacy, these will form new legacy items. + {'arch' => 'Maxwell', + 'ids' => '1340|1341|1344|1346|1347|1348|1349|134b|134d|134e|134f|137a|137b|' . + '1380|1381|1382|1390|1391|1392|1393|1398|1399|139a|139b|139c|139d|13b0|13b1|' . + '13b2|13b3|13b4|13b6|13b9|13ba|13bb|13bc|13c0|13c2|13d7|13d8|13d9|13da|13f0|' . + '13f1|13f2|13f3|13f8|13f9|13fa|13fb|1401|1402|1406|1407|1427|1430|1431|1436|' . + '1617|1618|1619|161a|1667|174d|174e|179c|17c8|17f0|17f1|17fd|1c90|1d10|1d12', + 'code' => 'GMxxx', + 'kernel' => '', + 'legacy' => 0, + 'process' => 'TSMC 28nm', + 'release' => '', + 'series' => '550.xx+', + 'status' => main::message('nv-current-eol',$date,'2026-12-xx'), + 'xorg' => '', + 'years' => '2014-2019', + }, + {'arch' => 'Pascal', + 'ids' => '15f0|15f7|15f8|15f9|17c2|1b00|1b02|1b06|1b30|1b38|1b80|1b81|1b82|' . + '1b83|1b84|1b87|1ba0|1ba1|1ba2|1bb0|1bb1|1bb3|1bb4|1bb5|1bb6|1bb7|1bb8|1bb9|' . + '1bbb|1bc7|1be0|1be1|1c02|1c03|1c04|1c06|1c07|1c09|1c20|1c21|1c22|1c23|1c30|' . + '1c31|1c60|1c61|1c62|1c81|1c82|1c83|1c8c|1c8d|1c8f|1c90|1c91|1c92|1c94|1c96|' . + '1cb1|1cb2|1cb3|1cb6|1cba|1cbb|1cbc|1cbd|1cfa|1cfb|1d01|1d02|1d11|1d13|1d16|' . + '1d33|1d34|1d52', + 'code' => 'GP10x', + 'kernel' => '', + 'legacy' => 0, + 'process' => 'TSMC 16nm', + 'release' => '', + 'series' => '550.xx+', + 'status' => main::message('nv-current-eol',$date,'2026-12-xx'), + 'xorg' => '', + 'years' => '2016-2021', + }, + {'arch' => 'Volta', + 'ids' => '1d81|1db1|1db3|1db4|1db5|1db6|1db7|1db8|1dba|1df0|1df2|1df6|1fb0', + 'code' => 'GV1xx', + 'kernel' => '', + 'legacy' => 0, + 'process' => 'TSMC 12nm', + 'release' => '', + 'series' => '550.xx+', + 'status' => main::message('nv-current-eol',$date,'2026-12-xx'), + 'xorg' => '', + 'years' => '2017-2020', + }, + {'arch' => 'Turing', + 'ids' => '1e02|1e04|1e07|1e09|1e30|1e36|1e78|1e81|1e82|1e84|1e87|1e89|1e90|' . + '1e91|1e93|1eb0|1eb1|1eb5|1eb6|1ec2|1ec7|1ed0|1ed1|1ed3|1ef5|1f02|1f03|1f06|' . + '1f07|1f08|1f0a|1f0b|1f10|1f11|1f12|1f14|1f15|1f36|1f42|1f47|1f50|1f51|1f54|' . + '1f55|1f76|1f82|1f83|1f91|1f95|1f96|1f97|1f98|1f99|1f9c|1f9d|1f9f|1fa0|1fb0|' . + '1fb1|1fb2|1fb6|1fb7|1fb8|1fb9|1fba|1fbb|1fbc|1fdd|1ff0|1ff2|1ff9|2182|2184|' . + '2187|2188|2189|2191|2192|21c4|21d1|25a6|25a7|25a9|25aa|25ad|25ed|28b0|28b8|' . + '28f8', + 'code' => 'TUxxx', + 'kernel' => '', + 'legacy' => 0, + 'process' => 'TSMC 12nm FF', + 'release' => '', + 'series' => '550.xx+', + 'status' => main::message('nv-current-eol',$date,'2026-12-xx'), + 'xorg' => '', + 'years' => '2018-2022', + }, + {'arch' => 'Ampere', + 'ids' => '20b0|20b2|20b3|20b5|20b6|20b7|20bd|20f1|20f3|20f5|20f6|20fd|2203|' . + '2204|2206|2207|2208|220a|220d|2216|2230|2231|2232|2233|2235|2236|2237|2238|' . + '2414|2420|2438|2460|2482|2484|2486|2487|2488|2489|248a|249c|249d|24a0|24b0|' . + '24b1|24b6|24b7|24b8|24b9|24ba|24bb|24c7|24c9|24dc|24dd|24e0|24fa|2503|2504|' . + '2507|2508|2520|2521|2523|2531|2544|2560|2563|2571|2582|2584|25a0|25a2|25a5|' . + '25ab|25ac|25b0|25b2|25b6|25b8|25b9|25ba|25bb|25bc|25bd|25e0|25e2|25e5|25ec|' . + '25f9|25fa|25fb|2822|2838', + 'code' => 'GAxxx', + 'kernel' => '', + 'legacy' => 0, + 'process' => 'TSMC n7 (7nm)', + 'release' => '', + 'series' => '550.xx+', + 'status' => main::message('nv-current-eol',$date,'2026-12-xx'), + 'xorg' => '', + 'years' => '2020-2023', + }, + {'arch' => 'Hopper', + 'ids' => '2321|2322|2324|2329|2330|2331|2335|2339|233a|2342', + 'code' => 'GH1xx', + 'kernel' => '', + 'legacy' => 0, + 'process' => 'TSMC n4 (5nm)', + 'release' => '', + 'series' => '550.xx+', + 'status' => $status_current, + 'xorg' => '', + 'years' => '2022+', + }, + {'arch' => 'Lovelace', + 'ids' => '2684|2685|2689|26b1|26b2|26b3|26b5|26b9|26ba|2702|2704|2705|2709|' . + '2717|2730|2757|2770|2782|2783|2786|2788|27a0|27b0|27b1|27b2|27b6|27b8|27ba|' . + '27bb|27e0|27fb|2803|2805|2808|2820|2860|2882|28a0|28a1|28b0|28b9|28ba|28bb|' . + '28e0|28e1', + 'code' => 'AD1xx', + 'kernel' => '', + 'legacy' => 0, + 'process' => 'TSMC n4 (5nm)', + 'release' => '', + 'series' => '550.xx+', + 'status' => $status_current, + 'xorg' => '', + 'years' => '2022+', + }, + ], +} + +sub gpu_data { + eval $start if $b_log; + my ($v_id,$p_id,$name) = @_; + my ($gpu,$gpu_data,$b_nv); + if ($v_id eq '1002'){ + set_amd_data() if !$gpu_amd; + $gpu = $gpu_amd; + } + elsif ($v_id eq '8086'){ + set_intel_data() if !$gpu_intel; + $gpu = $gpu_intel; + } + elsif ($v_id eq '0014'){ + set_loongson_data() if !$gpu_loongson; + $gpu = $gpu_loongson; + } + else { + set_nv_data() if !$gpu_nv; + $gpu = $gpu_nv; + $b_nv = 1; + } + $gpu_data = get_gpu_data($gpu,$p_id,$name); + eval $end if $b_log; + return ($gpu_data,$b_nv); +} + +sub get_gpu_data { + eval $start if $b_log; + my ($gpu,$p_id,$name) = @_; + my ($info); + # Don't use reverse because if product ID is matched, we want that, not a looser + # regex match. Tried with reverse and led to false matches. + foreach my $item (reverse @$gpu){ + next if !$item->{'ids'} && (!$item->{'pattern'} || !$name); + if (($item->{'ids'} && $p_id =~ /^($item->{'ids'})$/) || + (!$item->{'ids'} && $item->{'pattern'} && + $name =~ /\b($item->{'pattern'})\b/)){ + $info = { + 'arch' => $item->{'arch'}, + 'code' => $item->{'code'}, + 'kernel' => $item->{'kernel'}, + 'legacy' => $item->{'legacy'}, + 'process' => $item->{'process'}, + 'release' => $item->{'release'}, + 'series' => $item->{'series'}, + 'status' => $item->{'status'}, + 'xorg' => $item->{'xorg'}, + 'years' => $item->{'years'}, + }; + last; + } + } + if (!$info){ + $info->{'status'} = main::message('unknown-device-id'); + } + main::log_data('dump','%info',$info) if $b_log; + print "Raw \$info data: ", Data::Dumper::Dumper $info if $dbg[49]; + eval $end if $b_log; + return $info; +} + +## MONITOR DATA ## +sub set_monitors_sys { + eval $start if $b_log; + my $pattern = '/sys/class/drm/card[0-9]/device/driver/module/drivers/*'; + my @cards_glob = main::globber($pattern); + $pattern = '/sys/class/drm/card*-*/{connector_id,edid,enabled,status,modes}'; + my @ports_glob = main::globber($pattern); + # print Data::Dumper::Dumper \@cards_glob; + # print Data::Dumper::Dumper \@ports_glob; + my ($card,%cards,@data,$file,$item,$path,$port); + foreach $file (@cards_glob){ + next if ! -e $file; + if ($file =~ m|^/sys/class/drm/(card\d+)/.+?/drivers/(\S+):(\S+)$|){ + push(@{$cards{$1}},[$2,$3]); + } + } + # print Data::Dumper::Dumper \%cards; + foreach $file (sort @ports_glob){ + next if ! -r $file; + $item = $file; + $item =~ s|(/.*/(card\d+)-([^/]+))/(.+)||; + $path = $1; + $card = $2; + $port = $3; + $item = $4; + next if !$1; + $monitor_ids = {} if !$monitor_ids; + $monitor_ids->{$port}{'monitor'} = $port; + if (!$monitor_ids->{$port}{'drivers'} && $cards{$card}){ + foreach my $info (@{$cards{$card}}){ + push(@{$monitor_ids->{$port}{'drivers'}},$info->[1]); + } + } + $monitor_ids->{$port}{'path'} = readlink($path); + $monitor_ids->{$port}{'path'} =~ s|^\.\./\.\.|/sys|; + if ($item eq 'status' || $item eq 'enabled'){ + # print "$file\n"; + $monitor_ids->{$port}{$item} = main::reader($file,'strip',0); + } + elsif ($item eq 'connector_id'){ + $monitor_ids->{$port}{'connector-id'} = main::reader($file,'strip',0); + } + # arm: U:1680x1050p-0 + elsif ($item eq 'modes'){ + @data = main::reader($file,'strip'); + next if !@data; + # modes has repeat values, probably because kernel doesn't show hz + main::uniq(\@data); + $monitor_ids->{$port}{'modes'} = [@data]; + } + elsif ($item eq 'edid'){ + next if -s $file; + monitor_edid_data($file,$port); + } + } + main::log_data('dump','$ports ref',$monitor_ids) if $b_log; + print 'monitor_sys_data(): ', Data::Dumper::Dumper $monitor_ids if $dbg[44]; + eval $end if $b_log; +} + +sub monitor_edid_data { + eval $start if $b_log; + my ($file,$port) = @_; + my (@data); + open my $fh, '<:raw', $file or return; # it failed, give up, we don't care why + my $edid_raw = do { local $/; <$fh> }; + return if !$edid_raw; + my $edid = ParseEDID::parse_edid($edid_raw,$dbg[47]); + main::log_data('dump','Parse::EDID',$edid) if $b_log; + print 'parse_edid(): ', Data::Dumper::Dumper $edid if $dbg[44]; + return if !$edid || ref $edid ne 'HASH' || !%$edid; + $monitor_ids->{$port}{'build-date'} = $edid->{'year'}; + if ($edid->{'color_characteristics'}){ + $monitor_ids->{$port}{'colors'} = $edid->{'color_characteristics'}; + } + if ($edid->{'gamma'}){ + $monitor_ids->{$port}{'gamma'} = ($edid->{'gamma'}/100 + 0); + } + if ($edid->{'monitor_name'} || $edid->{'manufacturer_name_nice'}){ + my $model = ''; + if ($edid->{'manufacturer_name_nice'}){ + $model = $edid->{'manufacturer_name_nice'}; + } + if ($edid->{'monitor_name'}){ + $model .= ' ' if $model; + $model .= $edid->{'monitor_name'}; + } + elsif ($model && $edid->{'product_code_h'}){ + $model .= ' ' . $edid->{'product_code_h'}; + } + $monitor_ids->{$port}{'model'} = main::remove_duplicates(main::clean($model)); + } + elsif ($edid->{'manufacturer_name'} && $edid->{'product_code_h'}){ + $monitor_ids->{$port}{'model-id'} = $edid->{'manufacturer_name'} . ' '; + $monitor_ids->{$port}{'model-id'} .= $edid->{'product_code_h'}; + } + # construct to match xorg values + if ($edid->{'manufacturer_name'} && $edid->{'product_code'}){ + my $id = $edid->{'manufacturer_name'} . sprintf('%x',$edid->{'product_code'}); + $monitor_ids->{$port}{$id} = ($edid->{'serial_number'}) ? $edid->{'serial_number'}: ''; + } + if ($edid->{'diagonal_size'}){ + $monitor_ids->{$port}{'diagonal-m'} = sprintf('%.0f',($edid->{'diagonal_size'}*25.4)) + 0; + $monitor_ids->{$port}{'diagonal'} = sprintf('%.1f',$edid->{'diagonal_size'}) + 0; + } + if ($edid->{'ratios'}){ + $monitor_ids->{$port}{'ratio'} = join(', ', @{$edid->{'ratios'}}); + } + if ($edid->{'detailed_timings'}){ + if ($edid->{'detailed_timings'}[0]{'horizontal_active'}){ + $monitor_ids->{$port}{'res-x'} = $edid->{'detailed_timings'}[0]{'horizontal_active'}; + } + if ($edid->{'detailed_timings'}[0]{'vertical_active'}){ + $monitor_ids->{$port}{'res-y'} = $edid->{'detailed_timings'}[0]{'vertical_active'}; + } + if ($edid->{'detailed_timings'}[0]{'horizontal_image_size'}){ + $monitor_ids->{$port}{'size-x'} = $edid->{'detailed_timings'}[0]{'horizontal_image_size'}; + $monitor_ids->{$port}{'size-x-i'} = $edid->{'detailed_timings'}[0]{'horizontal_image_size_i'}; + } + if ($edid->{'detailed_timings'}[0]{'vertical_image_size'}){ + $monitor_ids->{$port}{'size-y'} = $edid->{'detailed_timings'}[0]{'vertical_image_size'}; + $monitor_ids->{$port}{'size-y-i'} = $edid->{'detailed_timings'}[0]{'vertical_image_size_i'}; + } + if ($edid->{'detailed_timings'}[0]{'horizontal_dpi'}){ + $monitor_ids->{$port}{'dpi'} = sprintf('%.0f',$edid->{'detailed_timings'}[0]{'horizontal_dpi'}) + 0; + } + } + if ($edid->{'serial_number'} || $edid->{'serial_number2'}){ + # this looks much more like a real serial than the default: serial_number + if ($edid->{'serial_number2'} && @{$edid->{'serial_number2'}}){ + $monitor_ids->{$port}{'serial'} = main::clean_dmi($edid->{'serial_number2'}[0]); + } + elsif ($edid->{'serial_number'}){ + $monitor_ids->{$port}{'serial'} = main::clean_dmi($edid->{'serial_number'}); + } + } + # this will be an array reference of one or more edid errors + if ($edid->{'edid_errors'}){ + $monitor_ids->{$port}{'edid-errors'} = $edid->{'edid_errors'}; + } + # this will be an array reference of one or more edid warnings + if ($edid->{'edid_warnings'}){ + $monitor_ids->{$port}{'edid-warnings'} = $edid->{'edid_warnings'}; + } + eval $end if $b_log; +} + +sub advanced_monitor_data { + eval $start if $b_log; + my ($monitors,$layouts) = @_; + my (@horiz,@vert); + my $position = ''; + # then see if we can locate a default position primary monitor + foreach my $key (keys %$monitors){ + next if !defined $monitors->{$key}{'pos-x'} || !defined $monitors->{$key}{'pos-y'}; + # this is the only scenario we can guess at if no primary detected + if (!$b_primary && !$monitors->{$key}{'primary'} && + $monitors->{$key}{'pos-x'} == 0 && $monitors->{$key}{'pos-y'} == 0){ + $monitors->{$key}{'position'} = 'primary'; + $monitors->{$key}{'primary'} = $monitors->{$key}{'monitor'}; + } + if (!grep {$monitors->{$key}{'pos-x'} == $_} @horiz){ + push(@horiz,$monitors->{$key}{'pos-x'}); + } + if (!grep {$monitors->{$key}{'pos-y'} == $_} @vert){ + push(@vert,$monitors->{$key}{'pos-y'}); + } + } + # we need NUMERIC sort, because positions can be less than 1000! + @horiz = sort {$a <=> $b} @horiz; + @vert =sort {$a <=> $b} @vert; + my ($h,$v) = (scalar(@horiz),scalar(@vert)); + # print Data::Dumper::Dumper \@horiz; + # print Data::Dumper::Dumper \@vert; + # print Data::Dumper::Dumper $layouts; + # print 'mon advanced monitor_map: ', Data::Dumper::Dumper $monitor_map; + foreach my $key (keys %$monitors){ + # disabled monitor may not have pos-x/pos-y, so skip + if (@horiz && @vert && (scalar @horiz > 1 || scalar @vert > 1) && + defined $monitors->{$key}{'pos-x'} && defined $monitors->{$key}{'pos-y'}){ + $monitors->{$key}{'position'} ||= ''; + $position = ''; + $position = get_monitor_position($monitors->{$key},\@horiz,\@vert); + $position = $layouts->[$v][$h]{$position} if $layouts->[$v][$h]{$position}; + $monitors->{$key}{'position'} .= ',' if $monitors->{$key}{'position'}; + $monitors->{$key}{'position'} .= $position; + } + my $mon_mapped = ($monitor_map) ? $monitor_map->{$monitors->{$key}{'monitor'}} : undef; + # these are already set for monitor_ids, only need this for Xorg data. + if ($mon_mapped && $monitor_ids->{$mon_mapped}){ + # note: xorg drivers can be different than gpu drivers + $monitors->{$key}{'drivers'} = gpu_drivers_sys($mon_mapped); + $monitors->{$key}{'build-date'} = $monitor_ids->{$mon_mapped}{'build-date'}; + $monitors->{$key}{'colors'} = $monitor_ids->{$mon_mapped}{'colors'}; + $monitors->{$key}{'diagonal'} = $monitor_ids->{$mon_mapped}{'diagonal'}; + $monitors->{$key}{'diagonal-m'} = $monitor_ids->{$mon_mapped}{'diagonal-m'}; + $monitors->{$key}{'gamma'} = $monitor_ids->{$mon_mapped}{'gamma'}; + $monitors->{$key}{'modes'} = $monitor_ids->{$mon_mapped}{'modes'}; + $monitors->{$key}{'model'} = $monitor_ids->{$mon_mapped}{'model'}; + $monitors->{$key}{'color-characteristics'} = $monitor_ids->{$mon_mapped}{'color-characteristics'}; + if (!defined $monitors->{$key}{'size-x'} && $monitor_ids->{$mon_mapped}{'size-x'}){ + $monitors->{$key}{'size-x'} = $monitor_ids->{$mon_mapped}{'size-x'}; + $monitors->{$key}{'size-x-i'} = $monitor_ids->{$mon_mapped}{'size-x-i'}; + } + if (!defined $monitors->{$key}{'size-y'} && $monitor_ids->{$mon_mapped}{'size-y'}){ + $monitors->{$key}{'size-y'} = $monitor_ids->{$mon_mapped}{'size-y'}; + $monitors->{$key}{'size-y-i'} = $monitor_ids->{$mon_mapped}{'size-y-i'}; + } + if (!defined $monitors->{$key}{'dpi'} && $monitor_ids->{$mon_mapped}{'dpi'}){ + $monitors->{$key}{'dpi'} = $monitor_ids->{$mon_mapped}{'dpi'}; + } + if ($monitor_ids->{$mon_mapped}{'model-id'}){ + $monitors->{$key}{'model-id'} = $monitor_ids->{$mon_mapped}{'model-id'}; + } + if ($monitor_ids->{$mon_mapped}{'edid-errors'}){ + $monitors->{$key}{'edid-errors'} = $monitor_ids->{$mon_mapped}{'edid-errors'}; + } + if ($monitor_ids->{$mon_mapped}{'edid-warnings'}){ + $monitors->{$key}{'edid-warnings'} = $monitor_ids->{$mon_mapped}{'edid-warnings'}; + } + if ($monitor_ids->{$mon_mapped}{'enabled'} && + $monitor_ids->{$mon_mapped}{'enabled'} eq 'disabled'){ + $monitors->{$key}{'disabled'} = $monitor_ids->{$mon_mapped}{'enabled'}; + } + $monitors->{$key}{'ratio'} = $monitor_ids->{$mon_mapped}{'ratio'}; + $monitors->{$key}{'serial'} = $monitor_ids->{$mon_mapped}{'serial'}; + } + # now swap the drm id for the display server id if they don't match + if ($mon_mapped && $mon_mapped ne $monitors->{$key}{'monitor'}){ + $monitors->{$key}{'monitor-mapped'} = $monitors->{$key}{'monitor'}; + $monitors->{$key}{'monitor'} = $mon_mapped; + } + } + # not printing out primary if Screen has only 1 Monitor + if (scalar keys %$monitors == 1){ + my @keys = keys %$monitors; + $monitors->{$keys[0]}{'position'} = undef; + } + print Data::Dumper::Dumper $monitors if $dbg[45]; + eval $end if $b_log; +} + +# Clear out all disabled or not connected monitor ports +sub set_active_monitors { + eval $start if $b_log; + foreach my $key (keys %$monitor_ids){ + if (!$monitor_ids->{$key}{'status'} || + $monitor_ids->{$key}{'status'} ne 'connected'){ + delete $monitor_ids->{$key}; + } + } + # print 'active monitors: ', Data::Dumper::Dumper $monitor_ids; + eval $end if $b_log; +} + +sub get_monitor_position { + eval $start if $b_log; + my ($monitor,$horiz,$vert) = @_; + my ($i,$position) = (1,''); + foreach (@$vert){ + if ($_ == $monitor->{'pos-y'}){ + $position = $i . '-'; + last; + } + $i++; + } + $i = 1; + foreach (@$horiz){ + if ($_ == $monitor->{'pos-x'}){ + $position .= $i; + last; + } + $i++; + } + main::log_data('data','pos-raw: ' . $position) if $b_log; + eval $end if $b_log; + return $position; +} + +sub set_monitor_layouts { + my ($layouts) = @_; + $layouts->[1][2] = {'1-1' => 'left','1-2' => 'right'}; + $layouts->[1][3] = {'1-1' => 'left','1-2' => 'center','1-3' => 'right'}; + $layouts->[1][4] = {'1-1' => 'left','1-2' => 'center-l','1-3' => 'center-r', + '1-4' => 'right'}; + $layouts->[2][1] = {'1-1' => 'top','2-1' => 'bottom'}; + $layouts->[2][2] = {'1-1' => 'top-left','1-2' => 'top-right', + '2-1' => 'bottom-l','2-2' => 'bottom-r'}; + $layouts->[2][3] = {'1-1' => 'top-left','1-2' => 'top-center','1-3' => 'top-right', + '2-1' => 'bottom-l','2-2' => 'bottom-c','2-3' => 'bottom-r'}; + $layouts->[3][1] = {'1-1' => 'top','2-1' => 'middle','3-1' => 'bottom'}; + $layouts->[3][2] = {'1-1' => 'top-left','1-2' => 'top-right', + '2-1' => 'middle-l','2-2' => 'middle-r', + '3-1' => 'bottom-l','3-2' => 'bottom-r'}; + $layouts->[3][3] = {'1-1' => 'top-left','1-2' => 'top-center',,'1-3' => 'top-right', + '2-1' => 'middle-l','2-2' => 'middle-c','2-3' => 'middle-r', + '3-1' => 'bottom-l','3-2' => 'bottom-c','3-3' => 'bottom-r'}; +} + +# This is required to resolve the situation where some xorg drivers change +# the kernel ID for the port to something slightly different, amdgpu in particular. +# Note: connector_id if available from xrandr and /sys allow for matching. +sub map_monitor_ids { + eval $start if $b_log; + my ($display_ids) = @_; + return if !$monitor_ids; + my (@sys_ids,@unmatched_display,@unmatched_sys); + @$display_ids = sort {lc($a->[0]) cmp lc($b->[0])} @$display_ids; + foreach my $d_id (@$display_ids){ + push(@unmatched_display,$d_id->[0]); + } + foreach my $key (sort keys %$monitor_ids){ + if ($monitor_ids->{$key}{'status'} eq 'connected'){ + push(@sys_ids,[$key,$monitor_ids->{$key}{'connector-id'}]); + push(@unmatched_sys,$key); + } + } + # @sys_ids = ('DVI-I-1','eDP-1','VGA-1'); + main::log_data('dump','@sys_ids',\@sys_ids) if $b_log; + main::log_data('dump','$xrandr_ids ref',$display_ids) if $b_log; + print 'sys: ', Data::Dumper::Dumper \@sys_ids if $dbg[45]; + print 'display: ', Data::Dumper::Dumper $display_ids if $dbg[45]; + return if scalar @sys_ids != scalar @$display_ids; + $monitor_map = {}; + # known patterns: s: DP-1 d: DisplayPort-0; s: DP-1 d: DP1-1; s: DP-2 d: DP1-2; + # s: HDMI-A-2 d: HDMI-A-1; s: HDMI-A-2 d: HDMI-2; s: DVI-1 d: DVI1; s: HDMI-1 d: HDMI1 + # s: DVI-I-1 d: DVI0; s: VGA-1 d: VGA1; s: DP-1-1; d: DP-1-1; + # s: eDP-1 d: eDP-1-1 (yes, reversed from normal deviation!); s: eDP-1 d: eDP + # worst: s: DP-6 d: DP-2-3 (2 banks of 3 according to X); s: eDP-1 d: DP-4; + # s: DP-3 d: DP-1-1; s: DP-4 d: DP-1-2 + # s: DP-3 d: DP-4 [yes, +1, not -]; + my ($d_1,$d_2,$d_m,$s_1,$s_2,$s_m); + my $b_single = (scalar @sys_ids == 1) ? 1 : 0; + my $pattern = '([A-Z]+)(-[A-Z]-\d+-\d+|-[A-Z]-\d+|-?\d+-\d+|-?\d+|)'; + for (my $i=0; $i < scalar @$display_ids; $i++){ + print "s: $sys_ids[$i]->[0] d: $display_ids->[$i][0]\n" if $dbg[45]; + my $b_match; + # we're going for the connector match first + if ($display_ids->[$i][1]){ + # for off case where they did not sort to same order + foreach my $sys (@sys_ids){ + if (defined $sys->[1] && $sys->[1] == $display_ids->[$i][1]){ + $b_match = 1; + $monitor_map->{$display_ids->[$i][0]} = $sys->[0]; + @unmatched_display = grep {$_ ne $display_ids->[$i][0]} @unmatched_display; + @unmatched_sys = grep {$_ ne $sys->[0]} @unmatched_sys; + last; + } + } + } + # try 1: /^([A-Z]+)(-[AB]|-[ADI]|-[ADI]-\d+?|-\d+?)?(-)?(\d+)$/i + if (!$b_match && $display_ids->[$i][0] =~ /^$pattern$/i){ + $d_1 = $1; + $d_2 = ($2) ? $2 : ''; + $d_2 =~ /(\d+)?$/; + $d_m = ($1) ? $1 : 0; + $d_1 =~ s/^DisplayPort/DP/i; # amdgpu... + print " d1: $d_1 d2: $d_2 d3: $d_m\n" if $dbg[45]; + if ($sys_ids[$i]->[0] =~ /^$pattern$/i){ + $s_1 = $1; + $s_2 = ($2) ? $2 : ''; + $s_2 =~ /(\d+)?$/; + $s_m = ($1) ? $1 : 0; + $d_1 = $s_1 if uc($d_1) eq 'XWAYLAND'; + print " d1: $d_1 s1: $s_1 dm: $d_m sm: $s_m \n" if $dbg[45]; + if ($d_1 eq $s_1 && ($d_m == $s_m || $d_m == ($s_m - 1))){ + $monitor_map->{$display_ids->[$i][0]} = $sys_ids[$i]->[0]; + @unmatched_display = grep {$_ ne $display_ids->[$i][0]} @unmatched_display; + @unmatched_sys = grep {$_ ne $sys_ids[$i]->[0]} @unmatched_sys; + } + } + } + # in case of one unmatched, we'll dump this, and use the actual unmatched + if (!$b_match && !$monitor_map->{$display_ids->[$i][0]}){ + # we're not even going to try, if there's 1 sys and 1 display, just use it! + if ($b_single){ + $monitor_map->{$display_ids->[$i][0]} = $sys_ids[$i]->[0]; + (@unmatched_display,@unmatched_sys) = (); + } + else { + $monitor_map->{$display_ids->[$i][0]} = main::message('monitor-id'); + } + } + } + # we don't care at all what the pattern is, if there is 1 unmatched display + # out of 1 sys ids, we'll assume that is the one. This can only be assumed in + # cases where only 1 monitor was not matched, otherwise it's just a guess. + # obviously, if one of the matches was wrong, this will also be wrong, but + # thats' life when dealing with irrational data. DP is a particular problem. + if (scalar @unmatched_sys == 1){ + $monitor_map->{$unmatched_display[0]} = $unmatched_sys[0]; + } + main::log_data('dump','$monitor_map ref',$monitor_map) if $b_log; + print Data::Dumper::Dumper $monitor_map if $dbg[45]; + eval $end if $b_log; +} + +# Handle case of monitor on left or right edge, vertical that is. +# mm dimensiions are based on the default position of monitor as sold. +# very old systems may not have non 0 value for size x or y +# size, res x,y by reference +sub flip_size_x_y { + eval $start if $b_log; + my ($size_x,$size_y,$res_x,$res_y) = @_; + if ((($$res_x/$$res_y > 1 && $$size_x/$$size_y < 1) || + ($$res_x/$$res_y < 1 && $$size_x/$$size_y > 1))){ + ($$size_x,$$size_y) = ($$size_y,$$size_x); + } + eval $end if $b_log; +} + +## COMPOSITOR DATA ## +sub set_compositor_data { + eval $start if $b_log; + my $compositors = get_compositors(); + if (@$compositors){ + # these use different spelling or command for full data. + my %custom = ( + 'hyprland' => 'hyprctl', + ); + my @data; + foreach my $compositor (@$compositors){ + # gnome-shell is incredibly slow to return version + if (($extra > 1 || $graphics{'protocol'} eq 'wayland' || $b_android) && + (!$show{'system'} || $compositor ne 'gnome-shell')){ + my $comp_lc = lc($compositor); + $graphics{'compositors'} = [] if !$graphics{'compositors'}; + # if -S found wm/comp, this is already set so no need to run version again + # note: -Sxxx shows wm v:, but -Gxx OR WL shows comp + v. + if (!$comps{$comp_lc} || ($extra < 3 && !$comps{$comp_lc}->[1])){ + my $comp = ($custom{$comp_lc}) ? $custom{$comp_lc}: $compositor; + push(@{$graphics{'compositors'}},[ProgramData::full($comp)]); + } + else { + push(@{$graphics{'compositors'}},$comps{$comp_lc}); # already array ref + } + } + else { + $graphics{'compositors'} = [] if !$graphics{'compositors'}; + push(@{$graphics{'compositors'}},[(ProgramData::values($compositor))[3]]); + } + } + } + eval $end if $b_log; +} + +sub get_compositors { + eval $start if $b_log; + PsData::set_de_wm() if !$loaded{'ps-gui'}; + my $comps = []; + push(@$comps,@{$ps_data{'compositors-pure'}}) if @{$ps_data{'compositors-pure'}}; + push(@$comps,@{$ps_data{'de-wm-compositors'}}) if @{$ps_data{'de-wm-compositors'}}; + push(@$comps,@{$ps_data{'wm-compositors'}}) if @{$ps_data{'wm-compositors'}}; + @$comps = sort(@$comps) if @$comps; + main::log_data('dump','$comps:', $comps) if $b_log; + eval $end if $b_log; + return $comps; +} + +## UTILITIES ## +sub tty_data { + eval $start if $b_log; + my ($tty); + if ($size{'term-cols'}){ + $tty = "$size{'term-cols'}x$size{'term-lines'}"; + } + # this is broken + elsif ($b_irc && $client{'console-irc'}){ + ShellData::console_irc_tty() if !$loaded{'con-irc-tty'}; + my $tty_working = $client{'con-irc-tty'}; + if ($tty_working ne '' && (my $program = main::check_program('stty'))){ + my $tty_arg = ($bsd_type) ? '-f' : '-F'; + # handle vtnr integers, and tty ID with letters etc. + $tty_working = "tty$tty_working" if -e "/dev/tty$tty_working"; + $tty = (main::grabber("$program $tty_arg /dev/$tty_working size 2>/dev/null"))[0]; + if ($tty){ + my @temp = split(/\s+/, $tty); + $tty = "$temp[1]x$temp[0]"; + } + } + } + eval $end if $b_log; + return $tty; +} +} + +## LogicalItem ## +{ +package LogicalItem; + +sub get { + eval $start if $b_log; + my ($key1,$val1); + my $rows = []; + my $num = 0; + if ($bsd_type){ + $key1 = 'Message'; + $val1 = main::message('logical-data-bsd',$uname[0]); + push(@$rows,{main::key($num++,0,1,$key1) => $val1}); + } + else { + LsblkData::set() if !$loaded{'lsblk'}; + if ($fake{'logical'} || $alerts{'lvs'}->{'action'} eq 'use'){ + lvm_data() if !$loaded{'logical-data'}; + if (!@lvm){ + my $key = 'Message'; + # note: arch linux has a bug where lvs returns 0 if non root start + my $message = ($use{'logical-lvm'}) ? main::message('tool-permissions','lvs') : main::message('logical-data',''); + push(@$rows, { + main::key($num++,0,1,$key) => $message, + }); + } + else { + lvm_output($rows,process_lvm_data()); + } + } + elsif ($use{'logical-lvm'} && $alerts{'lvs'}->{'action'} eq 'permissions'){ + my $key = 'Message'; + push(@$rows, { + main::key($num++,0,1,$key) => $alerts{'lvs'}->{'message'}, + }); + } + elsif (@lsblk && !$use{'logical-lvm'} && ($alerts{'lvs'}->{'action'} eq 'permissions' || + $alerts{'lvs'}->{'action'} eq 'missing')){ + my $key = 'Message'; + push(@$rows, { + main::key($num++,0,1,$key) => main::message('logical-data',''), + }); + } + elsif ($alerts{'lvs'}->{'action'} ne 'use'){ + $key1 = $alerts{'lvs'}->{'action'}; + $val1 = $alerts{'lvs'}->{'message'}; + $key1 = ucfirst($key1); + push(@$rows, {main::key($num++,0,1,$key1) => $val1}); + } + if ($use{'logical-general'}){ + my $general_data = general_data(); + general_output($rows,$general_data) if @$general_data; + } + } + eval $end if $b_log; + return $rows; +} + +sub general_output { + eval $start if $b_log; + my ($rows,$general_data) = @_; + my ($size); + my ($j,$num) = (0,0); + # cryptsetup status luks-a00baac5-44ff-4b48-b303-3bedb1f623ce + foreach my $item (sort {$a->{'type'} cmp $b->{'type'}} @$general_data){ + $j = scalar @$rows; + $size = ($item->{'size'}) ? main::get_size($item->{'size'}, 'string') : 'N/A'; + push(@$rows,{ + main::key($num++,1,1,'Device') => $item->{'name'}, + }); + if ($b_admin){ + $item->{'name'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'maj-min')} = $item->{'maj-min'}; + } + $rows->[$j]{main::key($num++,0,2,'type')} = $item->{'type'}; + if ($extra > 0 && $item->{'dm'}){ + $rows->[$j]{main::key($num++,0,2,'dm')} = $item->{'dm'}; + } + $rows->[$j]{main::key($num++,0,2,'size')} = $size; + my $b_fake; + components_output('general',\$j,\$num,$rows,\@{$item->{'components'}},\$b_fake); + } + eval $end if $b_log; +} + +sub lvm_output { + eval $start if $b_log; + my ($rows,$lvm_data) = @_; + my ($size); + my ($j,$num) = (0,0); + foreach my $vg (sort keys %$lvm_data){ + $j = scalar @$rows; + # print Data::Dumper::Dumper $lvm_data->{$vg}; + $size = main::get_size($lvm_data->{$vg}{'vg-size'},'string','N/A'); + push(@$rows,{ + main::key($num++,1,1,'Device') => '', + main::key($num++,0,2,'VG') => $vg, + main::key($num++,0,2,'type') => uc($lvm_data->{$vg}{'vg-format'}), + main::key($num++,0,2,'size') => $size, + },); + $size = main::get_size($lvm_data->{$vg}{'vg-free'},'string','N/A'); + $rows->[$j]{main::key($num++,0,2,'free')} = $size; + foreach my $lv (sort keys %{$lvm_data->{$vg}{'lvs'}}){ + next if $extra < 2 && $lv =~ /^\[/; # it's an internal vg lv, raid meta/image + $j = scalar @$rows; + my $b_raid; + $size = main::get_size($lvm_data->{$vg}{'lvs'}{$lv}{'lv-size'},'string','N/A'); + $rows->[$j]{main::key($num++,1,2,'LV')} = $lv; + if ($b_admin && $lvm_data->{$vg}{'lvs'}{$lv}{'maj-min'}){ + $rows->[$j]{main::key($num++,0,3,'maj-min')} = $lvm_data->{$vg}{'lvs'}{$lv}{'maj-min'}; + } + $rows->[$j]{main::key($num++,0,3,'type')} = $lvm_data->{$vg}{'lvs'}{$lv}{'lv-type'}; + if ($extra > 0 && $lvm_data->{$vg}{'lvs'}{$lv}{'dm'}){ + $rows->[$j]{main::key($num++,0,3,'dm')} = $lvm_data->{$vg}{'lvs'}{$lv}{'dm'}; + } + $rows->[$j]{main::key($num++,0,3,'size')} = $size; + if ($extra > 1 && !($show{'raid'} || $show{'raid-basic'}) && $lvm_data->{$vg}{'lvs'}{$lv}{'raid'}){ + $j = scalar @$rows; + $rows->[$j]{main::key($num++,1,3,'RAID')} = ''; + $rows->[$j]{main::key($num++,0,4,'stripes')} = $lvm_data->{$vg}{'lvs'}{$lv}{'raid'}{'stripes'}; + $rows->[$j]{main::key($num++,0,4,'sync')} = $lvm_data->{$vg}{'lvs'}{$lv}{'raid'}{'sync'}; + my $copied = $lvm_data->{$vg}{'lvs'}{$lv}{'raid'}{'copied'}; + $copied = (defined $copied) ? ($copied + 0) . '%': 'N/A'; + $rows->[$j]{main::key($num++,0,4,'copied')} = $copied; + $rows->[$j]{main::key($num++,0,4,'mismatches')} = $lvm_data->{$vg}{'lvs'}{$lv}{'raid'}{'mismatches'}; + $b_raid = 1; + } + components_output('lvm',\$j,\$num,$rows,\@{$lvm_data->{$vg}{'lvs'}{$lv}{'components'}},\$b_raid); + } + } + eval $end if $b_log; +} + +sub components_output { + my ($type,$j,$num,$rows,$components,$b_raid) = @_; + my ($l1); + $$j = scalar @$rows if $$b_raid || $extra > 1; + $$b_raid = 0; + if ($type eq 'general'){ + ($l1) = (2); + } + elsif ($type eq 'lvm'){ + ($l1) = (3); + } + my $status = (!@$components) ? 'N/A': ''; + $rows->[$$j]{main::key($$num++,1,$l1,'Components')} = $status; + components_recursive_output($type,$j,$num,$rows,$components,0,'c','p'); +} + +sub components_recursive_output { + my ($type,$j,$num,$rows,$components,$indent,$c,$p) = @_; + my ($l,$m,$size) = (1,1,0); + my ($l2,$l3); + if ($type eq 'general'){ + ($l2,$l3) = (3+$indent,4+$indent) ; + } + elsif ($type eq 'lvm'){ + ($l2,$l3) = (4+$indent,5+$indent); + } + # print 'outside: ', scalar @$component, "\n", Data::Dumper::Dumper $component; + foreach my $component (@$components){ + # print "inside: -n", Data::Dumper::Dumper $component->[$i]; + $$j = scalar @$rows if $b_admin; + my $id; + if ($component->[0] =~ /^(bcache|dm-|md)[0-9]/){ + $id = $c .'-' . $m; + $m++; + } + else { + $id = $p . '-' . $l; + $l++; + } + $rows->[$$j]{main::key($$num++,1,$l2,$id)} = $component->[0]; + if ($extra > 1){ + if ($b_admin){ + $component->[1] ||= 'N/A'; + $rows->[$$j]{main::key($$num++,0,$l3,'maj-min')} = $component->[1]; + $rows->[$$j]{main::key($$num++,0,$l3,'mapped')} = $component->[3] if $component->[3]; + $size = main::get_size($component->[2],'string','N/A'); + $rows->[$$j]{main::key($$num++,0,$l3,'size')} = $size; + } + #next if !$component->[$i][4]; + for (my $i = 4; $i < scalar @$component; $i++){ + components_recursive_output($type,$j,$num,$rows,$component->[$i],$indent+1,$c.'c',$p.'p'); + } + } + } +} + +# Note: type dm is seen in only one dataset, but it's a start +sub general_data { + eval $start if $b_log; + my (@found,$parent,$parent_fs); + my $general_data = []; + PartitionData::set('proc') if !$loaded{'partition-data'}; + main::set_mapper() if !$loaded{'mapper'}; + foreach my $row (@lsblk){ + # bcache doesn't have mapped name: !$mapper{$row->{'name'}} || + next if !$row->{'parent'}; + $parent = LsblkData::get($row->{'parent'}); + next if !$parent->{'fs'}; + if ($row->{'type'} && (($row->{'type'} eq 'crypt' || + $row->{'type'} eq 'mpath' || $row->{'type'} eq 'multipath') || + ($row->{'type'} eq 'dm' && $row->{'name'} =~ /veracrypt/i) || + ($parent->{'fs'} eq 'bcache'))){ + my (@full_components,$mapped,$type); + $mapped = $mapper{$row->{'name'}} if %mapper; + next if grep(/^$row->{'name'}$/, @found); + push(@found,$row->{'name'}); + if ($parent->{'fs'} eq 'crypto_LUKS'){ + $type = 'LUKS'; + } + # note, testing name is random user string, and there is no other + # ID known, the parent FS is '', empty. + elsif ($row->{'type'} eq 'dm' && $row->{'name'} =~ /veracrypt/i){ + $type = 'VeraCrypt'; + } + elsif ($row->{'type'} eq 'crypt'){ + $type = 'Crypto'; + } + elsif ($parent->{'fs'} eq 'bcache'){ + $type = 'bcache'; + } + # probably only seen on older Redhat servers, LVM probably replaces + elsif ($row->{'type'} eq 'mpath' || $row->{'type'} eq 'multipath'){ + $type = 'MultiPath'; + } + elsif ($row->{'type'} eq 'crypt'){ + $type = 'Crypt'; + } + # my $name = ($use{'filter-uuid'}) ? "luks-$filter_string" : $row->{'name'}; + component_data($row->{'maj-min'},\@full_components); + # print "$row->{'name'}\n", Data::Dumper::Dumper \@full_components; + push(@$general_data, { + 'components' => \@full_components, + 'dm' => $mapped, + 'maj-min' => $row->{'maj-min'}, + 'name' => $row->{'name'}, + 'size' => $row->{'size'}, + 'type' => $type, + }); + } + } + main::log_data('dump','luks @$general_data', $general_data); + print Data::Dumper::Dumper $general_data if $dbg[23]; + eval $end if $b_log; + return $general_data; +} + +# Note: called for disk totals, raid, and logical +sub lvm_data { + eval $start if $b_log; + $loaded{'logical-data'} = 1; + my (@args,@data,%totals); + @args = qw(vg_name vg_fmt vg_size vg_free lv_name lv_layout lv_size + lv_kernel_major lv_kernel_minor segtype seg_count seg_start_pe seg_size_pe + stripes devices raid_mismatch_count raid_sync_action raid_write_behind + copy_percent); + my $num = 0; + PartitionData::set() if !$loaded{'partition-data'}; + main::set_mapper() if !$loaded{'mapper'}; + if ($fake{'logical'}){ + # my $file = "$fake_data_dir/raid-logical/lvm/lvs-test-1.txt"; + # @data = main::reader($file,'strip'); + } + else { + # lv_full_name: ar0-home; lv_dm_path: /dev/mapper/ar0-home + # seg_size: unit location on volume where segement starts + # 2>/dev/null -unit k ---separator ^: + my $cmd = $alerts{'lvs'}->{'path'}; + $cmd .= ' -aPv --unit k --separator "^:" --segments --noheadings -o '; + # $cmd .= ' -o +lv_size,pv_major,pv_minor 2>/dev/null'; + $cmd .= join(',', @args) . ' 2>/dev/null'; + @data = main::grabber($cmd,'','strip'); + main::log_data('dump','lvm @data', \@data) if $b_log; + print "command: $cmd\n" if $dbg[22]; + } + my $j = 0; + foreach (@data){ + my @line = split(/\^:/, $_); + next if $_ =~ /^Partial mode/i; # sometimes 2>/dev/null doesn't catch this + for (my $i = 0; $i < scalar @args; $i++){ + $line[$i] =~ s/k$// if $args[$i] =~ /_(free|size|used)$/; + $lvm[$j]->{$args[$i]} = $line[$i]; + } + if (!$totals{'vgs'}->{$lvm[$j]->{'vg_name'}}){ + $totals{'vgs'}->{$lvm[$j]->{'vg_name'}} = $lvm[$j]->{'vg_size'}; + $raw_logical[2] += $lvm[$j]->{'vg_free'} if $lvm[$j]->{'vg_free'}; + } + $j++; + } + # print Data::Dumper::Dumper \%totals, \@raw_logical; + main::log_data('dump','lvm @lvm', \@lvm) if $b_log; + print Data::Dumper::Dumper \@lvm if $dbg[22]; + eval $end if $b_log; +} + +sub process_lvm_data { + eval $start if $b_log; + my $processed = {}; + foreach my $item (@lvm){ + my (@components,@devices,$dm,$dm_tmp,$dm_mm,@full_components,$maj_min,%raid,@temp); + if (!$processed->{$item->{'vg_name'}}){ + $processed->{$item->{'vg_name'}}->{'vg-size'} = $item->{'vg_size'}; + $processed->{$item->{'vg_name'}}->{'vg-free'} = $item->{'vg_free'}; + $processed->{$item->{'vg_name'}}->{'vg-format'} = $item->{'vg_fmt'}; + } + if (!$processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}){ + $processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}{'lv-size'} = $item->{'lv_size'}; + $processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}{'lv-type'} = $item->{'segtype'}; + $maj_min = $item->{'lv_kernel_major'} . ':' . $item->{'lv_kernel_minor'}; + $processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}{'maj-min'} = $maj_min; + $dm_tmp = $item->{'vg_name'} . '-' . $item->{'lv_name'}; + $dm_tmp =~ s/\[|\]$//g; + $dm = $mapper{$dm_tmp} if %mapper; + $processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}{'dm'} = $dm; + if ($item->{'segtype'} && $item->{'segtype'} ne 'linear' && $item->{'segtype'} =~ /^raid/){ + $raid{'copied'} = $item->{'copy_percent'}; + $raid{'mismatches'} = $item->{'raid_mismatch_count'}; + $raid{'stripes'} = $item->{'stripes'}; + $raid{'sync'} = $item->{'raid_sync_action'}; + $raid{'type'} = $item->{'segtype'}; + $processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}{'raid'} = \%raid; + } + component_data($maj_min,\@full_components); + # print "$item->{'lv_name'}\n", Data::Dumper::Dumper \@full_components; + $processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}{'components'} = \@full_components; + } + } + main::log_data('dump','lvm %$processed', $processed) if $b_log; + print Data::Dumper::Dumper $processed if $dbg[23]; + eval $end if $b_log; + return $processed; +} + +sub component_data { + my ($maj_min,$full_components) = @_; + push(@$full_components, component_recursive_data($maj_min)); +} + +sub component_recursive_data { + eval $start if $b_log; + my ($maj_min) = @_; + my (@components,@devices); + @devices = main::globber("/sys/dev/block/$maj_min/slaves/*") if -e "/sys/dev/block/$maj_min/slaves"; + @devices = map {$_ =~ s|^/.*/||; $_;} @devices if @devices; + # return @devices if !$b_admin; + foreach my $device (@devices){ + my ($mapped,$mm2,$part); + $part = PartitionData::get($device) if @proc_partitions; + $mm2 = $part->[0] . ':' . $part->[1] if @$part; + if ($device =~ /^(bcache|dm-|md)[0-9]+$/){ + $mapped = $dmmapper{$device}; + $raw_logical[1] += $part->[2] if $mapped && $mapped =~ /_(cdata|cmeta)$/; + push(@components, [$device,$mm2,$part->[2],$mapped,[component_recursive_data($mm2)]]); + } + else { + push(@components,[$device,$mm2,$part->[2]]); + } + } + eval $end if $b_log; + return @components; +} +} + +## MachineItem ## +# public methods: get(), is_vm() +{ +my $b_vm; +package MachineItem; + +sub get { + eval $start if $b_log; + my (%soc_machine,$data,@rows,$key1,$val1,$which); + my $rows = []; + my $num = 0; + if ($bsd_type && $sysctl{'machine'} && !$force{'dmidecode'}){ + $data = machine_data_sysctl(); + if (%$data){ + machine_output($rows,$data); + } + elsif (!$key1){ + $key1 = 'Message'; + $val1 = main::message('machine-data-force-dmidecode',''); + } + } + elsif ($bsd_type || $force{'dmidecode'}){ + if (!$fake{'dmidecode'} && $alerts{'dmidecode'}->{'action'} ne 'use'){ + $key1 = $alerts{'dmidecode'}->{'action'}; + $val1 = $alerts{'dmidecode'}->{'message'}; + $key1 = ucfirst($key1); + } + else { + $data = machine_data_dmi(); + if (%$data){ + machine_output($rows,$data); + } + elsif (!$key1){ + $key1 = 'Message'; + $val1 = main::message('machine-data'); + } + } + } + elsif (!$fake{'elbrus'} && -d '/sys/class/dmi/id/'){ + $data = machine_data_sys(); + if (%$data){ + machine_output($rows,$data); + } + else { + $key1 = 'Message'; + if ($alerts{'dmidecode'}->{'action'} eq 'missing'){ + $val1 = main::message('machine-data-dmidecode'); + } + else { + $val1 = main::message('machine-data'); + } + } + } + elsif ($fake{'elbrus'} || $cpu_arch eq 'elbrus'){ + if ($fake{'elbrus'} || (my $program = main::check_program('fruid_print'))){ + $data = machine_data_fruid($program); + if (%$data){ + machine_output($rows,$data); + } + elsif (!$key1){ + $key1 = 'Message'; + $val1 = main::message('machine-data-fruid'); + } + } + } + elsif (!$bsd_type){ + # this uses /proc/cpuinfo so only GNU/Linux + if (%risc){ + $data = machine_data_soc(); + machine_soc_output($rows,$data) if %$data; + } + if (!$data || !%$data){ + $key1 = 'Message'; + $val1 = main::message('machine-data-force-dmidecode',''); + } + } + # if error case, null data, whatever + if ($key1){ + push(@$rows,{main::key($num++,0,1,$key1) => $val1,}); + } + eval $end if $b_log; + return $rows; +} + +sub is_vm { + return $b_vm; +} + +## keys for machine data are: +# bios_vendor; bios_version; bios_date; +# board_name; board_serial; board_sku; board_vendor; board_version; +# product_name; product_version; product_serial; product_sku; product_uuid; +# sys_vendor; +## with extra data: +# chassis_serial; chassis_type; chassis_vendor; chassis_version; +## unused: bios_rev; bios_romsize; firmware type +sub machine_output { + eval $start if $b_log; + my ($rows,$data) = @_; + my $firmware = 'BIOS'; + my $num = 0; + my $j = 0; + my ($b_chassis,$b_skip_chassis,$b_skip_system); + my ($bios_date,$bios_rev,$bios_romsize,$bios_vendor,$bios_version,$chassis_serial, + $chassis_type,$chassis_vendor,$chassis_version,$mobo_model,$mobo_serial,$mobo_vendor, + $mobo_version,$product_name,$product_serial,$product_version,$system_vendor); + # foreach my $key (keys %data){ + # print "$key: $data->{$key}\n"; + # } + if (!$data->{'sys_vendor'} || + ($data->{'board_vendor'} && $data->{'sys_vendor'} eq $data->{'board_vendor'} && + !$data->{'product_name'} && !$data->{'product_version'} && + !$data->{'product_serial'})){ + $b_skip_system = 1; + } + # The goal here is to not show laptop/mobile devices + # found a case of battery existing but having nothing in it on desktop mobo + # not all laptops show the first. /proc/acpi/battery is deprecated. + elsif (!glob('/proc/acpi/battery/*') && !glob('/sys/class/power_supply/*')){ + # ibm / ibm can be true; dell / quantum is false, so in other words, only do this + # in case where the vendor is the same and the version is the same and not null, + # otherwise the version information is going to be different in all cases I think + if (($data->{'sys_vendor'} && $data->{'board_vendor'} && + $data->{'sys_vendor'} eq $data->{'board_vendor'}) && + (($data->{'product_version'} && $data->{'board_version'} && + $data->{'product_version'} eq $data->{'board_version'}) || + (!$data->{'product_version'} && $data->{'product_name'} && $data->{'board_name'} && + $data->{'product_name'} eq $data->{'board_name'}))){ + $b_skip_system = 1; + } + } + $data->{'device'} ||= 'N/A'; + $j = scalar @$rows; + push(@$rows, { + main::key($num++,0,1,'Type') => ucfirst($data->{'device'}), + },); + if (!$b_skip_system){ + # this has already been tested for above so we know it's not null + $system_vendor = main::clean($data->{'sys_vendor'}); + $product_name = ($data->{'product_name'}) ? $data->{'product_name'}:'N/A'; + $product_version = ($data->{'product_version'}) ? $data->{'product_version'}:'N/A'; + $product_serial = main::filter($data->{'product_serial'}); + $rows->[$j]{main::key($num++,1,1,'System')} = $system_vendor; + $rows->[$j]{main::key($num++,1,2,'product')} = $product_name; + $rows->[$j]{main::key($num++,0,3,'v')} = $product_version; + $rows->[$j]{main::key($num++,0,3,'serial')} = $product_serial; + # no point in showing chassis if system isn't there, it's very unlikely that + # would be correct + if ($extra > 1){ + if ($data->{'board_version'} && $data->{'chassis_version'} && + $data->{'chassis_version'} eq $data->{'board_version'}){ + $b_skip_chassis = 1; + } + if (!$b_skip_chassis && $data->{'chassis_vendor'}){ + if ($data->{'chassis_vendor'} ne $data->{'sys_vendor'}){ + $chassis_vendor = $data->{'chassis_vendor'}; + } + # dmidecode can have these be the same + if ($data->{'chassis_type'} && $data->{'device'} ne $data->{'chassis_type'}){ + $chassis_type = $data->{'chassis_type'}; + } + if ($data->{'chassis_version'}){ + $chassis_version = $data->{'chassis_version'}; + $chassis_version =~ s/^v([0-9])/$1/i; + } + $chassis_serial = main::filter($data->{'chassis_serial'}); + $chassis_vendor ||= ''; + $chassis_type ||= ''; + $rows->[$j]{main::key($num++,1,1,'Chassis')} = $chassis_vendor; + if ($chassis_type){ + $rows->[$j]{main::key($num++,0,2,'type')} = $chassis_type; + } + if ($chassis_version){ + $rows->[$j]{main::key($num++,0,2,'v')} = $chassis_version; + } + $rows->[$j]{main::key($num++,0,2,'serial')} = $chassis_serial; + } + } + $j++; # start new row + } + if ($data->{'firmware'}){ + $firmware = $data->{'firmware'}; + } + $mobo_vendor = ($data->{'board_vendor'}) ? main::clean($data->{'board_vendor'}) : 'N/A'; + $mobo_model = ($data->{'board_name'}) ? $data->{'board_name'}: 'N/A'; + $mobo_version = ($data->{'board_version'})? $data->{'board_version'} : ''; + $mobo_serial = main::filter($data->{'board_serial'}); + $bios_vendor = ($data->{'bios_vendor'}) ? main::clean($data->{'bios_vendor'}) : 'N/A'; + if ($data->{'bios_version'}){ + $bios_version = $data->{'bios_version'}; + $bios_version =~ s/^v([0-9])/$1/i; + if ($data->{'bios_rev'}){ + $bios_rev = $data->{'bios_rev'}; + } + } + $bios_version ||= 'N/A'; + if ($data->{'bios_date'}){ + $bios_date = $data->{'bios_date'}; + } + $bios_date ||= 'N/A'; + if ($extra > 1 && $data->{'bios_romsize'}){ + $bios_romsize = $data->{'bios_romsize'}; + } + $rows->[$j]{main::key($num++,1,1,'Mobo')} = $mobo_vendor; + $rows->[$j]{main::key($num++,1,2,'model')} = $mobo_model; + if ($mobo_version){ + $rows->[$j]{main::key($num++,0,3,'v')} = $mobo_version; + } + $rows->[$j]{main::key($num++,0,3,'serial')} = $mobo_serial; + if ($extra > 1 && $data->{'product_sku'}){ + $rows->[$j]{main::key($num++,0,3,'part-nu')} = $data->{'product_sku'}; + } + if (($show{'uuid'} || $extra > 2) && + ($data->{'product_uuid'} || $data->{'board_uuid'})){ + my $uuid = ($data->{'product_uuid'}) ? $data->{'product_uuid'} : $data->{'board_uuid'}; + $uuid = main::filter($uuid,'filter-uuid'); + $rows->[$j]{main::key($num++,0,3,'uuid')} = $uuid; + } + if ($extra > 1 && $data->{'board_mfg_date'}){ + $rows->[$j]{main::key($num++,0,3,'mfg-date')} = $data->{'board_mfg_date'}; + } + $rows->[$j]{main::key($num++,1,1,$firmware)} = $bios_vendor; + $rows->[$j]{main::key($num++,0,2,'v')} = $bios_version; + if ($bios_rev){ + $rows->[$j]{main::key($num++,0,2,'rev')} = $bios_rev; + } + $rows->[$j]{main::key($num++,0,2,'date')} = $bios_date; + if ($bios_romsize){ + $rows->[$j]{main::key($num++,0,2,'rom size')} = $bios_romsize; + } + eval $end if $b_log; +} + +sub machine_soc_output { + my ($rows,$soc_machine) = @_; + my ($key); + my ($cont_sys,$ind_sys,$j,$num) = (1,1,0,0); + # print Data::Dumper::Dumper \%soc_machine; + # this is sketchy, /proc/device-tree/model may be similar to Hardware value from /proc/cpuinfo + # raspi: Hardware : BCM2835 model: Raspberry Pi Model B Rev 2 + if ($soc_machine->{'device'} || $soc_machine->{'model'}){ + $rows->[$j]{main::key($num++,0,1,'Type')} = uc($risc{'id'}); + my $system = 'System'; + if (defined $soc_machine->{'model'}){ + $rows->[$j]{main::key($num++,1,1,'System')} = $soc_machine->{'model'}; + $system = 'details'; + ($cont_sys,$ind_sys) = (0,2); + } + $soc_machine->{'device'} ||= 'N/A'; + $rows->[$j]{main::key($num++,$cont_sys,$ind_sys,$system)} = $soc_machine->{'device'}; + } + if ($soc_machine->{'mobo'}){ + $rows->[$j]{main::key($num++,1,1,'mobo')} = $soc_machine->{'mobo'}; + } + # we're going to print N/A for 0000 values sine the item was there. + if ($soc_machine->{'firmware'}){ + # most samples I've seen are like: 0000 + $soc_machine->{'firmware'} =~ s/^[0]+$//; + $soc_machine->{'firmware'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'rev')} = $soc_machine->{'firmware'}; + } + # sometimes has value like: 0000 + if (defined $soc_machine->{'serial'}){ + # most samples I've seen are like: 0000 + $soc_machine->{'serial'} =~ s/^[0]+$//; + $rows->[$j]{main::key($num++,0,2,'serial')} = main::filter($soc_machine->{'serial'}); + } + eval $end if $b_log; +} + +sub machine_data_fruid { + eval $start if $b_log; + my ($program) = @_; + my ($b_start,$file,@fruid); + my $data = {}; + if (!$fake{'elbrus'}){ + @fruid = main::grabber("$program 2>/dev/null",'','strip'); + } + else { + # $file = "$fake_data_dir/machine/elbrus/fruid/fruid-e801-1_full.txt"; + $file = "$fake_data_dir/machine/elbrus/fruid/fruid-e804-1_full.txt"; + @fruid = main::reader($file,'strip'); + } + foreach (@fruid){ + $b_start = 1 if /^Board info/; + next if !$b_start; + my @split = split(/\s*:\s+/,$_,2); + if ($split[0] eq 'Mfg. Date/Time'){ + $data->{'board_mfg_date'} = $split[1]; + $data->{'board_mfg_date'} =~ s/^(\d+:\d+)\s//; + } + elsif ($split[0] eq 'Board manufacturer'){ + $data->{'board_vendor'} = $split[1]; + } + elsif ($split[0] eq 'Board part number'){ + $data->{'product_sku'} = $split[1]; + } + elsif ($split[0] eq 'Board product name'){ + $data->{'board_name'} = $split[1]; + if ($split[1] =~ /(SWTX|^EL)/){ + $data->{'device'} = 'server'; + } + elsif ($split[1] =~ /(PC$)/){ + $data->{'device'} = 'desktop'; + } + } + elsif ($split[0] eq 'Board serial number'){ + $data->{'board_serial'} = $split[1]; + } + elsif ($split[0] eq 'Board product version'){ + $data->{'board_version'} = $split[1]; + } + } + if (%$data){ + $data->{'bios_vendor'} = 'MCST'; + $data->{'firmware'} = 'Boot'; + } + if ($dbg[28]){ + print 'fruid: $data: ', Data::Dumper::Dumper $data; + print 'fruid: @fruid: ', Data::Dumper::Dumper \@fruid; + } + if ($b_log){ + main::log_data('dump','@fruid',\@fruid); + main::log_data('dump','%data',$data); + } + if ($fake{'elbrus'} || -e '/proc/bootdata'){ + machine_data_bootdata($data); + } + eval $end if $b_log; + return $data; +} + +# Note: fruid should get device, extra data here uuid, mac +# Field names map to dmi/sys names. +# args: 0: $data hash ref; +sub machine_data_bootdata { + eval $start if $b_log; + my ($b_pairs,@bootdata,$file); + if (!$fake{'elbrus'}){ + @bootdata = main::reader('/proc/bootdata','strip'); + } + else { + # $file = "$fake_data_dir/machine/elbrus/bootdata/e2c3/desktop-e2c3.txt"; + # $file = "$fake_data_dir/machine/elbrus/bootdata/e4c/server-e4c-x4-1.txt"; + $file = "$fake_data_dir/machine/elbrus/bootdata/e4c/server-e4c-x4-2.txt"; + # $file = "$fake_data_dir/machine/elbrus/bootdata/e8c/desktop-e8c.txt"; + # $file = "$fake_data_dir/machine/elbrus/bootdata/e8c/server-e8c-x4-1.txt"; + # $file = "$fake_data_dir/machine/elbrus/bootdata/e8c/server-e8c-x4-2.txt"; + # $file = "$fake_data_dir/machine/elbrus/bootdata/e8c2/desktop-e8c2.txt"; + # $file = "$fake_data_dir/machine/elbrus/bootdata/e8c2/server-e8c2-4x.txt"; + # $file = "$fake_data_dir/machine/elbrus/bootdata/e8c2/server-e8c2.txt"; + # $file = "$fake_data_dir/machine/elbrus/bootdata/e16c/server-e16c-1.txt"; + # $file = "$fake_data_dir/machine/elbrus/bootdata/e16c/server-e16c-2.txt"; + # $file = "$fake_data_dir/machine/elbrus/bootdata/e16c/server-e16c-3.txt"; + @bootdata = main::reader($file,'strip'); + } + foreach (@bootdata){ + s/\s\s+/ /g; # spaces not consistent + my @line = split(/=/,$_,2); + # These only positive IDs, unreliable data source + if ($line[1]){ + $line[1] =~ s/'//g; + $line[0] = lc($line[0]); + if ($line[0] eq 'mb_type'){ + # unknown: unknown (0x0); + if ($line[1] =~ /([\/-]SWT|^EL)/){ + $_[0]->{'device'} = 'server'; + } + elsif ($line[1] =~ /([\/-]PC)/){ + $_[0]->{'device'} = 'desktop'; + } + } + elsif ($line[0] eq 'uuid'){ + $_[0]->{'product_uuid'} = $line[1]; + } + # fruid has mac address too, but in 0x.. form, this one is easier to read + elsif ($line[0] eq 'mac'){ + $_[0]->{'board_mac'} = $line[1]; + } + } + else { + if (/release-([\d\.A-Z-]+).*?\srevision\s([\d\.A-Z-]+)/i){ + $_[0]->{'bios_version'} = $1; + $_[0]->{'bios_rev'} = $2; + } + elsif (/built\son\s(\S+\s\d+\s\d+)\b/){ + $_[0]->{'bios_date'} = $1; + } + } + } + if ($dbg[28]){ + print 'bootdata: $data: ', Data::Dumper::Dumper $_[0]; + print 'bootdata: @bootdata: ', Data::Dumper::Dumper \@bootdata; + } + if ($b_log){ + main::log_data('dump','@bootdata',\@bootdata); + main::log_data('dump','%data', $_[0]); + eval $end; + } + eval $end if $b_log; +} + +sub machine_data_sys { + eval $start if $b_log; + my ($path,$vm); + my $data = {}; + my $sys_dir = '/sys/class/dmi/id/'; + my $sys_dir_alt = '/sys/devices/virtual/dmi/id/'; + my @sys_files = qw(bios_vendor bios_version bios_date + board_name board_serial board_vendor board_version chassis_type + product_name product_serial product_sku product_uuid product_version + sys_vendor + ); + if ($extra > 1){ + splice(@sys_files, 0, 0, qw(chassis_serial chassis_vendor chassis_version)); + } + $data->{'firmware'} = 'BIOS'; + # print Data::Dumper::Dumper \@sys_files; + if (!-d $sys_dir){ + if (-d $sys_dir_alt){ + $sys_dir = $sys_dir_alt; + } + else { + return 0; + } + } + if (-d '/sys/firmware/efi'){ + $data->{'firmware'} = 'UEFI'; + } + elsif (glob('/sys/firmware/acpi/tables/UEFI*')){ + $data->{'firmware'} = 'UEFI-[Legacy]'; + } + foreach (@sys_files){ + $path = "$sys_dir$_"; + if (-r $path){ + $data->{$_} = main::reader($path,'',0); + $data->{$_} = ($data->{$_}) ? main::clean_dmi($data->{$_}) : ''; + } + elsif (!$b_root && -e $path && !-r $path){ + $data->{$_} = main::message('root-required'); + } + else { + $data->{$_} = ''; + } + } + if ($data->{'chassis_type'}){ + if ($data->{'chassis_type'} == 1){ + $data->{'device'} = check_vm($data->{'sys_vendor'},$data->{'product_name'}); + $data->{'device'} ||= 'other-vm?'; + } + else { + $data->{'device'} = get_device_sys($data->{'chassis_type'}); + } + } + # print "sys:\n"; + # foreach (keys %data){ + # print "$_: $data->{$_}\n"; + # } + print Data::Dumper::Dumper $data if $dbg[28]; + main::log_data('dump','%data',$data) if $b_log; + eval $end if $b_log; + return $data; +} + +# This will create an alternate machine data source +# which will be used for alt ARM machine data in cases +# where no dmi data present, or by cpu data to guess at +# certain actions for arm only. +sub machine_data_soc { + eval $end if $b_log; + my $data = {}; + if (my $file = $system_files{'proc-cpuinfo'}){ + CpuItem::cpuinfo_data_grabber($file) if !$loaded{'cpuinfo'}; + # grabber sets keys to lower case to avoid error here + if ($cpuinfo_machine{'hardware'} || $cpuinfo_machine{'machine'}){ + $data->{'device'} = main::get_defined($cpuinfo_machine{'hardware'}, + $cpuinfo_machine{'machine'}); + $data->{'device'} = main::clean_arm($data->{'device'}); + $data->{'device'} = main::clean_dmi($data->{'device'}); + $data->{'device'} = main::clean($data->{'device'}); + } + if (defined $cpuinfo_machine{'system type'} || $cpuinfo_machine{'model'}){ + $data->{'model'} = main::get_defined($cpuinfo_machine{'system type'}, + $cpuinfo_machine{'model'}); + $data->{'model'} = main::clean_dmi($data->{'model'}); + $data->{'model'} = main::clean($data->{'model'}); + } + # seen with PowerMac PPC + if (defined $cpuinfo_machine{'motherboard'}){ + $data->{'mobo'} = $cpuinfo_machine{'motherboard'}; + } + if (defined $cpuinfo_machine{'revision'}){ + $data->{'firmware'} = $cpuinfo_machine{'revision'}; + } + if (defined $cpuinfo_machine{'serial'}){ + $data->{'serial'} = $cpuinfo_machine{'serial'}; + } + undef %cpuinfo_machine; # we're done with it, don't need it anymore + } + if (!$data->{'model'} && $b_android){ + main::set_build_prop() if !$loaded{'build-prop'}; + if ($build_prop{'product-manufacturer'} && $build_prop{'product-model'}){ + my $brand = ''; + if ($build_prop{'product-brand'} && + $build_prop{'product-brand'} ne $build_prop{'product-manufacturer'}){ + $brand = $build_prop{'product-brand'} . ' '; + } + $data->{'model'} = $brand . $build_prop{'product-manufacturer'} . ' ' . $build_prop{'product-model'}; + } + elsif ($build_prop{'product-device'}){ + $data->{'model'} = $build_prop{'product-device'}; + } + elsif ($build_prop{'product-name'}){ + $data->{'model'} = $build_prop{'product-name'}; + } + } + if (!$data->{'model'} && -r '/proc/device-tree/model'){ + my $model = main::reader('/proc/device-tree/model','',0); + main::log_data('data',"device-tree-model: $model") if $b_log; + if ($model){ + $model = main::clean_dmi($model); + $model = (split(/\x01|\x02|\x03|\x00/, $model))[0] if $model; + my $device_temp = main::clean_regex($data->{'device'}); + if (!$data->{'device'} || ($model && $model !~ /\Q$device_temp\E/i)){ + $model = main::clean_arm($model); + $data->{'model'} = $model; + } + } + } + if (!$data->{'serial'} && -f '/proc/device-tree/serial-number'){ + my $serial = main::reader('/proc/device-tree/serial-number','',0); + $serial = (split(/\x01|\x02|\x03|\x00/, $serial))[0] if $serial; + main::log_data('data',"device-tree-serial: $serial") if $b_log; + $data->{'serial'} = $serial if $serial; + } + print Data::Dumper::Dumper $data if $dbg[28]; + main::log_data('dump','%data',$data) if $b_log; + eval $end if $b_log; + return $data; +} + +# bios_date: 09/07/2010 +# bios_romsize: dmi only +# bios_vendor: American Megatrends Inc. +# bios_version: P1.70 +# bios_rev: 8.14: dmi only +# board_name: A770DE+ +# board_serial: +# board_vendor: ASRock +# board_version: +# chassis_serial: +# chassis_sku: +# chassis_type: 3 +# chassis_vendor: +# chassis_version: +# firmware: +# product_name: +# product_serial: +# product_sku: +# product_uuid: +# product_version: +# uuid: dmi/sysctl only, map to product_uuid +# sys_vendor: +sub machine_data_dmi { + eval $start if $b_log; + return if !@dmi; + my ($vm); + my $data = {}; + $data->{'firmware'} = 'BIOS'; + # dmi types: + # 0 bios; 1 system info; 2 board|base board info; 3 chassis info; + # 4 processor info, use to check for hypervisor + foreach my $row (@dmi){ + # bios/firmware + if ($row->[0] == 0){ + # skip first three row, we don't need that data + foreach my $item (@$row[3 .. $#$row]){ + if ($item !~ /^~/){ # skip the indented rows + my @value = split(/:\s+/, $item); + if ($value[0] eq 'Release Date'){ + $data->{'bios_date'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'Vendor'){ + $data->{'bios_vendor'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'Version'){ + $data->{'bios_version'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'ROM Size'){ + $data->{'bios_romsize'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'BIOS Revision'){ + $data->{'bios_rev'} = main::clean_dmi($value[1]) } + } + else { + if ($item eq '~UEFI is supported'){ + $data->{'firmware'} = 'UEFI';} + } + } + next; + } + # system information + elsif ($row->[0] == 1){ + # skip first three row, we don't need that data + foreach my $item (@$row[3 .. $#$row]){ + if ($item !~ /^~/){ # skip the indented rows + my @value = split(/:\s+/, $item); + if ($value[0] eq 'Product Name'){ + $data->{'product_name'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'Version'){ + $data->{'product_version'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'Serial Number'){ + $data->{'product_serial'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'Manufacturer'){ + $data->{'sys_vendor'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'SKU Number'){ + $data->{'product_sku'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'UUID'){ + $data->{'product_uuid'} = main::clean_dmi($value[1]) } + } + } + next; + } + # baseboard information + elsif ($row->[0] == 2){ + # skip first three row, we don't need that data + foreach my $item (@$row[3 .. $#$row]){ + if ($item !~ /^~/){ # skip the indented rows + my @value = split(/:\s+/, $item); + if ($value[0] eq 'Product Name'){ + $data->{'board_name'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'Serial Number'){ + $data->{'board_serial'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'Manufacturer'){ + $data->{'board_vendor'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'Version'){ + $data->{'board_version'} = main::clean_dmi($value[1]) } + } + } + next; + } + # chassis information + elsif ($row->[0] == 3){ + # skip first three row, we don't need that data + foreach my $item (@$row[3 .. $#$row]){ + if ($item !~ /^~/){ # skip the indented rows + my @value = split(/:\s+/, $item); + if ($value[0] eq 'Serial Number'){ + $data->{'chassis_serial'} = main::clean_dmi($value[1]) } + # not sure if this sku is same as system sku + elsif ($value[0] eq 'SKU Number'){ + $data->{'chassis_sku'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'Type'){ + $data->{'chassis_type'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'Manufacturer'){ + $data->{'chassis_vendor'} = main::clean_dmi($value[1]) } + elsif ($value[0] eq 'Version'){ + $data->{'chassis_version'} = main::clean_dmi($value[1]) } + } + } + if ($data->{'chassis_type'} && $data->{'chassis_type'} ne 'Other'){ + $data->{'device'} = $data->{'chassis_type'}; + } + next; + } + # this may catch some BSD and fringe Linux cases + # processor information: check for hypervisor + elsif ($row->[0] == 4){ + # skip first three row, we don't need that data + if (!$data->{'device'}){ + if (grep {/hypervisor/i} @$row){ + $data->{'device'} = 'virtual-machine'; + $b_vm = 1; + } + } + last; + } + elsif ($row->[0] > 4){ + last; + } + } + if (!$data->{'device'}){ + $data->{'device'} = check_vm($data->{'sys_vendor'},$data->{'product_name'}); + $data->{'device'} ||= 'other-vm?'; + } + # print "dmi:\n"; + # foreach (keys %data){ + # print "$_: $data->{$_}\n"; + # } + print Data::Dumper::Dumper $data if $dbg[28]; + main::log_data('dump','%data',$data) if $b_log; + eval $end if $b_log; + return $data; +} + +# As far as I know, only OpenBSD supports this method. +# it uses hw. info from sysctl -a and bios info from dmesg.boot +sub machine_data_sysctl { + eval $start if $b_log; + my ($product,$vendor,$vm); + my $data = {}; + # ^hw\.(vendor|product|version|serialno|uuid) + foreach (@{$sysctl{'machine'}}){ + next if !$_; + my @item = split(':', $_); + next if !$item[1]; + if ($item[0] eq 'hw.vendor' || $item[0] eq 'machdep.dmi.board-vendor'){ + $data->{'board_vendor'} = main::clean_dmi($item[1]); + } + elsif ($item[0] eq 'hw.product' || $item[0] eq 'machdep.dmi.board-product'){ + $data->{'board_name'} = main::clean_dmi($item[1]); + } + elsif ($item[0] eq 'hw.version' || $item[0] eq 'machdep.dmi.board-version'){ + $data->{'board_version'} = main::clean_dmi($item[1]); + } + elsif ($item[0] eq 'hw.serialno' || $item[0] eq 'machdep.dmi.board-serial'){ + $data->{'board_serial'} = main::clean_dmi($item[1]); + } + elsif ($item[0] eq 'hw.serial'){ + $data->{'board_serial'} = main::clean_dmi($item[1]); + } + elsif ($item[0] eq 'hw.uuid'){ + $data->{'board_uuid'} = main::clean_dmi($item[1]); + } + elsif ($item[0] eq 'machdep.dmi.system-vendor'){ + $data->{'sys_vendor'} = main::clean_dmi($item[1]); + } + elsif ($item[0] eq 'machdep.dmi.system-product'){ + $data->{'product_name'} = main::clean_dmi($item[1]); + } + elsif ($item[0] eq 'machdep.dmi.system-version'){ + $data->{'product_version'} = main::clean_dmi($item[1]); + } + elsif ($item[0] eq 'machdep.dmi.system-serial'){ + $data->{'product_serial'} = main::clean_dmi($item[1]); + } + elsif ($item[0] eq 'machdep.dmi.system-uuid'){ + $data->{'product_uuid'} = main::clean_dmi($item[1]); + } + # bios0:at mainbus0: AT/286+ BIOS, date 06/30/06, BIOS32 rev. 0 @ 0xf2030, SMBIOS rev. 2.4 @ 0xf0000 (47 entries) + # bios0:vendor Phoenix Technologies, LTD version "3.00" date 06/30/2006 + elsif ($item[0] =~ /^bios[0-9]/){ + if ($_ =~ /^^bios[0-9]:at\s.*?\srev\.\s([\S]+)\s@.*/){ + $data->{'bios_rev'} = $1; + $data->{'firmware'} = 'BIOS' if $_ =~ /BIOS/; + } + elsif ($item[1] =~ /^vendor\s(.*?)\sversion\s(.*?)\sdate\s([\S]+)/){ + $data->{'bios_vendor'} = $1; + $data->{'bios_version'} = $2; + $data->{'bios_date'} = $3; + $data->{'bios_version'} =~ s/^v//i if $data->{'bios_version'} && $data->{'bios_version'} !~ /vi/i; + } + } + elsif ($item[0] eq 'machdep.dmi.bios-vendor'){ + $data->{'bios_vendor'} = main::clean_dmi($item[1]); + } + elsif ($item[0] eq 'machdep.dmi.bios-version'){ + $data->{'bios_version'} = main::clean_dmi($item[1]); + } + elsif ($item[0] eq 'machdep.dmi.bios-date'){ + $data->{'bios_date'} = main::clean_dmi($item[1]); + } + } + if ($data->{'board_vendor'} || $data->{'sys_vendor'} || $data->{'board_name'} || $data->{'product_name'}){ + $vendor = $data->{'sys_vendor'}; + $vendor = $data->{'board_vendor'} if !$vendor; + $product = $data->{'product_name'}; + $product = $data->{'board_name'} if !$product; + } + # detections can be from other sources. + $data->{'device'} = check_vm($vendor,$product); + print Data::Dumper::Dumper $data if $dbg[28]; + main::log_data('dump','%data',$data) if $b_log; + eval $end if $b_log; + return $data; +} + +sub get_device_sys { + eval $start if $b_log; + my ($chasis_id) = @_; + my ($device) = (''); + my @chassis; + # See inxi-resources MACHINE DATA for data sources + $chassis[2] = 'unknown'; + $chassis[3] = 'desktop'; + $chassis[4] = 'desktop'; + # 5 - pizza box was a 1 U desktop enclosure, but some old laptops also id this way + $chassis[5] = 'pizza-box'; + $chassis[6] = 'desktop'; + $chassis[7] = 'desktop'; + $chassis[8] = 'portable'; + $chassis[9] = 'laptop'; + # note: lenovo T420 shows as 10, notebook, but it's not a notebook + $chassis[10] = 'laptop'; + $chassis[11] = 'portable'; + $chassis[12] = 'docking-station'; + # note: 13 is all-in-one which we take as a mac type system + $chassis[13] = 'desktop'; + $chassis[14] = 'notebook'; + $chassis[15] = 'desktop'; + $chassis[16] = 'laptop'; + $chassis[17] = 'server'; + $chassis[18] = 'expansion-chassis'; + $chassis[19] = 'sub-chassis'; + $chassis[20] = 'bus-expansion'; + $chassis[21] = 'peripheral'; + $chassis[22] = 'RAID'; + $chassis[23] = 'server'; + $chassis[24] = 'desktop'; + $chassis[25] = 'multimount-chassis'; # blade? + $chassis[26] = 'compact-PCI'; + $chassis[27] = 'blade'; + $chassis[28] = 'blade'; + $chassis[29] = 'blade-enclosure'; + $chassis[30] = 'tablet'; + $chassis[31] = 'convertible'; + $chassis[32] = 'detachable'; + $chassis[33] = 'IoT-gateway'; + $chassis[34] = 'embedded-pc'; + $chassis[35] = 'mini-pc'; + $chassis[36] = 'stick-pc'; + $device = $chassis[$chasis_id] if $chassis[$chasis_id]; + eval $end if $b_log; + return $device; +} + +sub check_vm { + eval $start if $b_log; + my ($manufacturer,$product_name) = @_; + $manufacturer ||= ''; + $product_name ||= ''; + my $vm; + if (my $program = main::check_program('systemd-detect-virt')){ + my $vm_test = (main::grabber("$program 2>/dev/null"))[0]; + if ($vm_test){ + # kvm vbox reports as oracle, usually, unless they change it + if (lc($vm_test) eq 'oracle'){ + $vm = 'virtualbox'; + } + elsif ($vm_test ne 'none'){ + $vm = $vm_test; + } + } + } + if (!$vm || lc($vm) eq 'bochs'){ + if (-e '/proc/vz'){$vm = 'openvz'} + elsif (-e '/proc/xen'){$vm = 'xen'} + elsif (-e '/dev/vzfs'){$vm = 'virtuozzo'} + elsif (my $program = main::check_program('lsmod')){ + my @vm_data = main::grabber("$program 2>/dev/null"); + if (@vm_data){ + if (grep {/kqemu/i} @vm_data){$vm = 'kqemu'} + elsif (grep {/kvm|qumranet/i} @vm_data){$vm = 'kvm'} + elsif (grep {/qemu/i} @vm_data){$vm = 'qemu'} + } + } + } + # this will catch many Linux systems and some BSDs + if (!$vm || lc($vm) eq 'bochs'){ + # $device_vm is '' if nothing detected + my @vm_data = ($device_vm); + push(@vm_data,@{$dboot{'machine-vm'}}) if $dboot{'machine-vm'}; + if (-e '/dev/disk/by-id'){ + my @dev = glob('/dev/disk/by-id/*'); + push(@vm_data,@dev); + } + if (grep {/innotek|vbox|virtualbox/i} @vm_data){ + $vm = 'virtualbox'; + } + elsif (grep {/vmware/i} @vm_data){ + $vm = 'vmware'; + } + # needs to be first, because contains virtio;qumranet, grabber only gets + # first instance then stops, so make sure patterns are right. + elsif (grep {/(openbsd[\s-]vmm)/i} @vm_data){ + $vm = 'vmm'; + } + elsif (grep {/(\bhvm\b)/i} @vm_data){ + $vm = 'hvm'; + } + elsif (grep {/(qemu)/i} @vm_data){ + $vm = 'qemu'; + } + elsif (grep {/(\bkvm\b|qumranet|virtio)/i} @vm_data){ + $vm = 'kvm'; + } + elsif (grep {/Virtual HD|Microsoft.*Virtual Machine/i} @vm_data){ + $vm = 'hyper-v'; + } + if (!$vm && (my $file = $system_files{'proc-cpuinfo'})){ + my @info = main::reader($file); + $vm = 'virtual-machine' if grep {/^flags.*hypervisor/} @info; + } + # this may be wrong, confirm it + if (!$vm && -e '/dev/vda' || -e '/dev/vdb' || -e '/dev/xvda' || -e '/dev/xvdb'){ + $vm = 'virtual-machine'; + } + } + if (!$vm && $product_name){ + if ($product_name eq 'VMware'){ + $vm = 'vmware'; + } + elsif ($product_name eq 'VirtualBox'){ + $vm = 'virtualbox'; + } + elsif ($product_name eq 'KVM'){ + $vm = 'kvm'; + } + elsif ($product_name eq 'Bochs'){ + $vm = 'qemu'; + } + } + if (!$vm && $manufacturer && $manufacturer eq 'Xen'){ + $vm = 'xen'; + } + $b_vm = 1 if $vm; + eval $end if $b_log; + return $vm; +} +} + +## NetworkItem ## +{ +package NetworkItem; +my ($b_ip_run,@ifs_found); + +sub get { + eval $start if $b_log; + my $rows = []; + my $num = 0; + if (%risc && !$use{'soc-network'} && !$use{'pci-tool'}){ + # do nothing, but keep the test conditions to force + # the non arm case to always run + } + else { + device_output($rows); + } + # note: raspberry pi uses usb networking only + if (!@$rows){ + if (%risc){ + my $key = 'Message'; + @$rows = ({ + main::key($num++,0,1,$key) => main::message('risc-pci',$risc{'id'}) + }); + } + else { + my $key = 'Message'; + my $message = ''; + my $type = 'pci-card-data'; + # for some reason, this was in device_output too redundantly + if ($pci_tool && $alerts{$pci_tool}->{'action'} eq 'permissions'){ + $type = 'pci-card-data-root'; + } + elsif (!$bsd_type && !%risc && !$pci_tool && + $alerts{'lspci'}->{'action'} && + $alerts{'lspci'}->{'action'} eq 'missing'){ + $message = $alerts{'lspci'}->{'message'}; + } + $message = main::message($type,'') if !$message; + @$rows = ({ + main::key($num++,0,1,$key) => $message + }); + } + } + usb_output($rows); + if ($show{'network-advanced'}){ + # @ifs_found = (); + # shift @ifs_found; + # pop @ifs_found; + if (!$bsd_type){ + advanced_data_sys($rows,'check','',0,'','',''); + } + else { + advanced_data_bsd($rows,'check'); + } + if ($b_admin){ + info_data($rows); + } + } + if ($show{'ip'}){ + wan_ip($rows); + } + eval $end if $b_log; + return $rows; +} + +sub device_output { + eval $start if $b_log; + return if !$devices{'network'}; + my $rows = $_[0]; + my ($b_wifi,%holder); + my ($j,$num) = (0,1); + foreach my $row (@{$devices{'network'}}){ + $num = 1; + # print "$row->[0] $row->[3]\n"; + # print "$row->[0] $row->[3]\n"; + $j = scalar @$rows; + my $driver = $row->[9]; + my $chip_id = main::get_chip_id($row->[5],$row->[6]); + # working around a virtuo bug same chip id is used on two nics + if (!defined $holder{$chip_id}){ + $holder{$chip_id} = 0; + } + else { + $holder{$chip_id}++; + } + # first check if it's a known wifi id'ed card, if so, no print of duplex/speed + $b_wifi = check_wifi($row->[4]); + my $device = $row->[4]; + $device = ($device) ? main::clean_pci($device,'output') : 'N/A'; + #$device ||= 'N/A'; + $driver ||= 'N/A'; + push(@$rows, { + main::key($num++,1,1,'Device') => $device, + },); + if ($extra > 0 && $use{'pci-tool'} && $row->[12]){ + my $item = main::get_pci_vendor($row->[4],$row->[12]); + $rows->[$j]{main::key($num++,0,2,'vendor')} = $item if $item; + } + if ($row->[1] eq '0680'){ + $rows->[$j]{main::key($num++,0,2,'type')} = 'network bridge'; + } + $rows->[$j]{main::key($num++,1,2,'driver')} = $driver; + my $bus_id = 'N/A'; + # note: for arm/mips we want to see the single item bus id, why not? + # note: we can have bus id: 0002 / 0 which is valid, but 0 / 0 is invalid + if (defined $row->[2] && $row->[2] ne '0' && defined $row->[3]){ + $bus_id = "$row->[2].$row->[3]"} + elsif (defined $row->[2] && $row->[2] ne '0'){ + $bus_id = $row->[2]} + elsif (defined $row->[3] && $row->[3] ne '0'){ + $bus_id = $row->[3]} + if ($extra > 0){ + if ($row->[9] && !$bsd_type){ + my $version = main::get_module_version($row->[9]); + $version ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'v')} = $version; + } + if ($b_admin && $row->[10]){ + $row->[10] = main::get_driver_modules($row->[9],$row->[10]); + $rows->[$j]{main::key($num++,0,3,'modules')} = $row->[10] if $row->[10]; + } + $row->[8] ||= 'N/A'; + if ($extra > 1 && $bus_id ne 'N/A'){ + main::get_pcie_data($bus_id,$j,$rows,\$num); + } + # as far as I know, wifi has no port, but in case it does in future, use it + if (!$b_wifi || ($b_wifi && $row->[8] ne 'N/A')){ + $rows->[$j]{main::key($num++,0,2,'port')} = $row->[8]; + } + $rows->[$j]{main::key($num++,0,2,'bus-ID')} = $bus_id; + } + if ($extra > 1){ + $rows->[$j]{main::key($num++,0,2,'chip-ID')} = $chip_id; + } + if ($extra > 2 && $row->[1]){ + $rows->[$j]{main::key($num++,0,2,'class-ID')} = $row->[1]; + } + if (!$bsd_type && $extra > 0 && $bus_id ne 'N/A' && $bus_id =~ /\.0$/){ + my $temp = main::get_device_temp($bus_id); + if ($temp){ + $rows->[$j]{main::key($num++,0,2,'temp')} = $temp . ' C'; + } + } + if ($show{'network-advanced'}){ + my @data; + if (!$bsd_type){ + advanced_data_sys($rows,$row->[5],$row->[6],$holder{$chip_id},$b_wifi,'',$bus_id); + } + else { + if (defined $row->[9] && defined $row->[11]){ + advanced_data_bsd($rows,"$row->[9]$row->[11]",$b_wifi); + } + } + } + # print "$row->[0]\n"; + } + # @rows = (); + eval $end if $b_log; +} + +sub usb_output { + eval $start if $b_log; + return if !$usb{'network'}; + my $rows = $_[0]; + my (@temp2,$b_wifi,$driver,$path,$path_id,$product,$type); + my ($j,$num) = (0,1); + foreach my $row (@{$usb{'network'}}){ + $num = 1; + ($driver,$path,$path_id,$product,$type) = ('','','','',''); + $product = main::clean($row->[13]) if $row->[13]; + $driver = $row->[15] if $row->[15]; + $path = $row->[3] if $row->[3]; + $path_id = $row->[2] if $row->[2]; + $type = $row->[14] if $row->[14]; + $driver ||= 'N/A'; + $j = scalar @$rows; + push(@$rows, { + main::key($num++,1,1,'Device') => $product, + main::key($num++,0,2,'driver') => $driver, + main::key($num++,1,2,'type') => 'USB', + },); + $b_wifi = check_wifi($product); + if ($extra > 0){ + if ($extra > 1){ + $row->[8] ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'rev')} = $row->[8]; + if ($row->[17]){ + $rows->[$j]{main::key($num++,0,3,'speed')} = $row->[17]; + } + if ($row->[24]){ + $rows->[$j]{main::key($num++,0,3,'lanes')} = $row->[24]; + } + if ($b_admin && $row->[22]){ + $rows->[$j]{main::key($num++,0,3,'mode')} = $row->[22]; + } + } + $rows->[$j]{main::key($num++,0,2,'bus-ID')} = "$path_id:$row->[1]"; + if ($extra > 1){ + $row->[7] ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'chip-ID')} = $row->[7]; + } + if ($extra > 2){ + if (defined $row->[5] && $row->[5] ne ''){ + $rows->[$j]{main::key($num++,0,2,'class-ID')} = "$row->[4]$row->[5]"; + } + if ($row->[16]){ + $rows->[$j]{main::key($num++,0,2,'serial')} = main::filter($row->[16]); + } + } + } + if ($show{'network-advanced'}){ + if (!$bsd_type){ + my (@temp,$vendor,$chip); + @temp = split(':', $row->[7]) if $row->[7]; + ($vendor,$chip) = ($temp[0],$temp[1]) if @temp; + advanced_data_sys($rows,$vendor,$chip,0,$b_wifi,$path,''); + } + # NOTE: we need the driver + driver nu, like wlp0 to get a match, + else { + $driver .= $row->[21] if defined $row->[21]; + advanced_data_bsd($rows,$driver,$b_wifi); + } + } + } + eval $end if $b_log; +} + +sub advanced_data_sys { + eval $start if $b_log; + return if ! -d '/sys/class/net'; + my ($rows,$vendor,$chip,$count,$b_wifi,$path_usb,$bus_id) = @_; + my ($cont_if,$ind_if,$j,$num) = (2,3,0,0); + my $key = 'IF'; + my ($b_check,$b_usb,$if,$path,@paths); + # ntoe: we've already gotten the base path, now we + # we just need to get the IF path, which is one level in: + # usb1/1-1/1-1:1.0/net/enp0s20f0u1/ + if ($path_usb){ + $b_usb = 1; + @paths = main::globber("${path_usb}*/net/*"); + } + else { + @paths = main::globber('/sys/class/net/*'); + } + @paths = grep {!/\/lo$/} @paths; + # push(@paths,'/sys/class/net/ppp0'); # fake IF if needed to match test data + if ($count > 0 && $count < scalar @paths){ + @paths = splice(@paths, $count, scalar @paths); + } + if ($vendor eq 'check'){ + $b_check = 1; + $key = 'IF-ID'; + ($cont_if,$ind_if) = (1,2); + } + # print join('; ', @paths), $count, "\n"; + foreach (@paths){ + my ($data1,$data2,$duplex,$mac,$speed,$state); + $j = scalar @$rows; + # for usb, we already know where we are + if (!$b_usb){ + # pi mmcnr has pcitool and also these vendor/device paths. + if (!%risc || $use{'pci-tool'}){ + $path = "$_/device/vendor"; + $data1 = main::reader($path,'',0) if -r $path; + $data1 =~ s/^0x// if $data1; + $path = "$_/device/device"; + $data2 = main::reader($path,'',0) if -r $path; + $data2 =~ s/^0x// if $data2; + # this is a fix for a redhat bug in virtio + $data2 = (defined $data2 && $data2 eq '0001' && defined $chip && $chip eq '1000') ? '1000' : $data2; + } + # there are cases where arm devices have a small pci bus + # or, with mmcnr devices, will show device/vendor info in data1/2 + # which won't match with the path IDs + if (%risc && $chip && Cwd::abs_path($_) =~ /\b$chip\b/){ + $data1 = $vendor; + $data2 = $chip; + } + } + # print "d1:$data1 v:$vendor d2:$data2 c:$chip bus_id: $bus_id\n"; + # print Cwd::abs_path($_), "\n" if $bus_id; + if ($b_usb || $b_check || ($data1 && $data2 && $data1 eq $vendor && $data2 eq $chip && + (%risc || check_bus_id($_,$bus_id)))){ + $if = $_; + $if =~ s/^\/.+\///; + # print "top: if: $if ifs: @ifs_found\n"; + next if ($b_check && grep {/$if/} @ifs_found); + $path = "$_/duplex"; + $duplex = main::reader($path,'',0) if -r $path; + $duplex ||= 'N/A'; + $path = "$_/address"; + $mac = main::reader($path,'',0) if -r $path; + $mac = main::filter($mac); + $path = "$_/speed"; + $speed = main::reader($path,'',0) if -r $path; + $speed ||= 'N/A'; + $path = "$_/operstate"; + $state = main::reader($path,'',0) if -r $path; + $state ||= 'N/A'; + # print "$speed \n"; + push(@$rows,{ + main::key($num++,1,$cont_if,$key) => $if, + main::key($num++,0,$ind_if,'state') => $state + }); + # my $j = scalar @row - 1; + push(@ifs_found, $if) if (!$b_check && (! grep {/$if/} @ifs_found)); + # print "push: if: $if ifs: @ifs_found\n"; + # no print out for wifi since it doesn't have duplex/speed data available + # note that some cards show 'unknown' for state, so only testing explicitly + # for 'down' string in that to skip showing speed/duplex + # /sys/class/net/$if/wireless : not always there, but worth a try: wlan/wl/ww/wlp + $b_wifi = 1 if !$b_wifi && (-e "$_$if/wireless" || $if =~ /^(wl|ww)/); + if (!$b_wifi && $state ne 'down' && $state ne 'no'){ + # make sure the value is strictly numeric before appending Mbps + $speed = (main::is_int($speed)) ? "$speed Mbps" : $speed; + $rows->[$j]{main::key($num++,0,$ind_if,'speed')} = $speed; + $rows->[$j]{main::key($num++,0,$ind_if,'duplex')} = $duplex; + } + $rows->[$j]{main::key($num++,0,$ind_if,'mac')} = $mac; + # if ($b_check){ + # push(@rows,@row); + # } + # else { + # @rows = @row; + # } + if ($show{'ip'}){ + if_ip($rows,$key,$if); + } + last if !$b_check; + } + } + eval $end if $b_log; +} + +sub advanced_data_bsd { + eval $start if $b_log; + return if ! @ifs_bsd; + my ($rows,$if,$b_wifi) = @_; + my ($data,$working_if); + my ($b_check,$state,$speed,$duplex,$mac); + my ($cont_if,$ind_if,$j,$num) = (2,3,0,0); + my $key = 'IF'; + if ($if eq 'check'){ + $b_check = 1; + $key = 'IF-ID'; + ($cont_if,$ind_if) = (1,2); + } + foreach my $item (@ifs_bsd){ + if (ref $item ne 'ARRAY'){ + $working_if = $item; + # print "$working_if\n"; + next; + } + else { + $data = $item; + } + if ($b_check || $working_if eq $if){ + $if = $working_if if $b_check; + # print "top1: if: $if ifs: wif: $working_if @ifs_found\n"; + next if ($b_check && grep {/$if/} @ifs_found); + # print "top2: if: $if wif: $working_if ifs: @ifs_found\n"; + # print Data::Dumper::Dumper $data; + # ($state,$speed,$duplex,$mac) + $duplex = $data->[2]; + $duplex ||= 'N/A'; + $mac = main::filter($data->[3]); + $speed = $data->[1]; + $speed ||= 'N/A'; + $state = $data->[0]; + $state ||= 'N/A'; + $j = scalar @$rows; + # print "$speed \n"; + push(@$rows, { + main::key($num++,1,$cont_if,$key) => $if, + main::key($num++,0,$ind_if,'state') => $state, + }); + push(@ifs_found, $if) if (!$b_check && (!grep {/$if/} @ifs_found)); + # print "push: if: $if ifs: @ifs_found\n"; + # no print out for wifi since it doesn't have duplex/speed data available + # note that some cards show 'unknown' for state, so only testing explicitly + # for 'down' string in that to skip showing speed/duplex + if (!$b_wifi && $state ne 'down' && $state ne 'no network'){ + # make sure the value is strictly numeric before appending Mbps + $speed = (main::is_int($speed)) ? "$speed Mbps" : $speed; + $rows->[$j]{main::key($num++,0,$ind_if,'speed')} = $speed; + $rows->[$j]{main::key($num++,0,$ind_if,'duplex')} = $duplex; + } + $rows->[$j]{main::key($num++,0,$ind_if,'mac')} = $mac; + if ($show{'ip'} && $if){ + if_ip($rows,$key,$if); + } + } + } + eval $end if $b_log; +} + +## Result values: +# 0: ipv +# 1: ip +# 2: broadcast, if found +# 3: scope, if found +# 4: scope IF, if different from IF +sub if_ip { + eval $start if $b_log; + my ($rows,$type,$if) = @_; + my ($working_if); + my ($cont_ip,$ind_ip,$if_cnt) = (3,4,0); + my ($j,$num) = (0,0); + $b_ip_run = 1; + if ($type eq 'IF-ID'){ + ($cont_ip,$ind_ip) = (2,3); + } + OUTER: + foreach my $item (@ifs){ + if (ref $item ne 'ARRAY'){ + $working_if = $item; + # print "if:$if wif:$working_if\n"; + next; + } + if ($working_if eq $if){ + $if_cnt = 0; + # print "if $if item:\n", Data::Dumper::Dumper $item; + foreach my $data2 (@$item){ + $j = scalar @$rows; + $num = 1; + $if_cnt++; + if ($limit > 0 && $if_cnt > $limit){ + push(@$rows, { + main::key($num++,0,$cont_ip,'Message') => main::message('output-limit',scalar @$item), + }); + last OUTER; + } + # print "$data2->[0] $data2->[1]\n"; + my ($ipv,$ip,$broadcast,$scope,$scope_id); + $ipv = ($data2->[0])? $data2->[0]: 'N/A'; + $ip = main::filter($data2->[1]); + $scope = ($data2->[3])? $data2->[3]: 'N/A'; + # note: where is this ever set to 'all'? Old test condition? + if ($if ne 'all'){ + if (defined $data2->[4] && $working_if ne $data2->[4]){ + # scope global temporary deprecated dynamic + # scope global dynamic + # scope global temporary deprecated dynamic + # scope site temporary deprecated dynamic + # scope global dynamic noprefixroute enx403cfc00ac68 + # scope global eth0 + # scope link + # scope site dynamic + # scope link + # trim off if at end of multi word string if found + $data2->[4] =~ s/\s$if$// if $data2->[4] =~ /[^\s]+\s$if$/; + my $key = ($data2->[4] =~ /deprecated|dynamic|temporary|noprefixroute/) ? 'type' : 'virtual'; + push(@$rows, { + main::key($num++,1,$cont_ip,"IP v$ipv") => $ip, + main::key($num++,0,$ind_ip,$key) => $data2->[4], + main::key($num++,0,$ind_ip,'scope') => $scope, + }); + } + else { + push(@$rows, { + main::key($num++,1,$cont_ip,"IP v$ipv") => $ip, + main::key($num++,0,$ind_ip,'scope') => $scope, + }); + } + } + else { + push(@$rows, { + main::key($num++,1,($cont_ip - 1),'IF') => $if, + main::key($num++,1,$cont_ip,"IP v$ipv") => $ip, + main::key($num++,0,$ind_ip,'scope') => $scope, + }); + } + if ($extra > 1 && $data2->[2]){ + $broadcast = main::filter($data2->[2]); + $rows->[$j]{main::key($num++,0,$ind_ip,'broadcast')} = $broadcast; + } + } + } + } + eval $end if $b_log; +} + +sub info_data { + eval $start if $b_log; + my ($rows) = @_; + my $j = scalar @$rows; + my $num = 0; + my $services; + PsData::set_network(); + if (@{$ps_data{'network-services'}}){ + main::make_list_value($ps_data{'network-services'},\$services,',','sort'); + } + else { + $services = main::message('network-services'); + } + push(@$rows,{ + main::key($num++,1,1,'Info') => '', + main::key($num++,0,2,'services') => $services, + }); + eval $end if $b_log; +} + +# Get ip using downloader to stdout. This is a clean, text only IP output url, +# single line only, ending in the ip address. May have to modify this in the future +# to handle ipv4 and ipv6 addresses but should not be necessary. +# ip=$(echo 2001:0db8:85a3:0000:0000:8a2e:0370:7334 | gawk --re-interval ' +# ip=$(wget -q -O - $WAN_IP_URL | gawk --re-interval ' +# this generates a direct dns based ipv4 ip address, but if opendns.com goes down, +# the fall backs will still work. +# note: consistently slower than domain based: +# dig +short +time=1 +tries=1 myip.opendns.com. A @208.67.222.222 +sub wan_ip { + eval $start if $b_log; + my $rows = $_[0]; + my ($b_dig,$b_html,$ip,$ua); + my $num = 0; + # time: 0.06 - 0.07 seconds + # Cisco opendns.com may be terminating supporting this one, sometimes works, sometimes not: + # use -4/6 to force ipv 4 or 6, but generally we want the 'natural' native ip returned. + # dig +short +time=1 +tries=1 myip.opendns.com @resolver1.opendns.com :: 0.021s + # Works but is slow: + # dig +short @ns1-1.akamaitech.net ANY whoami.akamai.net :: 0.156s + # This one can take forever, and sometimes requires explicit -4 or -6 + # dig -4 TXT +short o-o.myaddr.l.google.com @ns1.google.com :: 0.026s; 1.087ss + if (!$force{'no-dig'} && (my $program = main::check_program('dig'))){ + $ip = (main::grabber("$program +short +time=1 +tries=1 \@ns1-1.akamaitech.net ANY whoami.akamai.net 2>/dev/null"))[0]; + $ip =~ s/"//g if $ip; # some return IP in quotes, when using TXT + $b_dig = 1; + } + if (!$ip && !$force{'no-html-wan'}){ + # if dig failed or is not installed, set downloader data if unset + if (!defined $dl{'no-ssl'}){ + main::set_downloader(); + } + # note: tests: akamai: 0.015 - 0.025 icanhazip.com: 0.020 0.030 + # smxi: 0.230, so ~10x slower. Dig is not as fast as you'd expect + # dig: 0.167s 0.156s + # leaving smxi as last test because I know it will always be up. + # --wan-ip-url replaces values with user supplied arg + # 0.020s: http://whatismyip.akamai.com/ + # 0.136s: https://get.geojs.io/v1/ip + # 0.024s: http://icanhazip.com/ + # 0.027s: ifconfig.io + # 0.230s: https://smxi.org/opt/ip.php + # 0.023s: https://api.ipify.org :: NOTE: hangs, widely variable times, don't use + my @urls = (!$wan_url) ? qw(http://whatismyip.akamai.com/ + http://icanhazip.com/ https://smxi.org/opt/ip.php) : ($wan_url); + foreach (@urls){ + last if !$dl{'dl'}; + $ua = 'ip' if $_ =~ /smxi/; + $ip = main::download_file('stdout',$_,'',$ua); + if ($ip){ + # print "$_\n"; + chomp($ip); + $ip = (split(/\s+/, $ip))[-1]; + last; + } + } + $b_html = 1; + } + if ($ip && $use{'filter'}){ + $ip = $filter_string; + } + if (!$ip){ + # true case trips + if (!$b_dig){ + $ip = main::message('IP-no-dig', 'WAN IP'); + } + elsif ($b_dig && !$b_html){ + $ip = main::message('IP-dig', 'WAN IP'); + } + else { + $ip = main::message('IP', 'WAN IP'); + } + } + push(@$rows, { + main::key($num++,0,1,'WAN IP') => $ip, + }); + eval $end if $b_log; +} + +sub check_bus_id { + eval $start if $b_log; + my ($path,$bus_id) = @_; + my ($b_valid); + if ($bus_id){ + # legacy, not link, but uevent has path: + # PHYSDEVPATH=/devices/pci0000:00/0000:00:0a.1/0000:05:00.0 + if (Cwd::abs_path($path) =~ /$bus_id\// || + (-r "$path/uevent" && -s "$path/uevent" && + (grep {/$bus_id/} main::reader("$path/uevent")))){ + $b_valid = 1; + } + } + eval $end if $b_log; + return $b_valid; +} + +sub check_wifi { + my ($item) = @_; + my $b_wifi = ($item =~ /wireless|wi-?fi|wlan|802\.11|centrino/i) ? 1 : 0; + return $b_wifi; +} +} + +## OpticalItem ## +{ +package OpticalItem; + +sub get { + eval $start if $b_log; + my $rows = $_[0]; + my $rows_start = scalar @$rows; + my ($data,$val1); + my $num = 0; + if ($bsd_type){ + $val1 = main::message('optical-data-bsd'); + if ($dboot{'optical'}){ + $data = drive_data_bsd(); + drive_output($rows,$data) if %$data; + } + else{ + my $file = $system_files{'dmesg-boot'}; + if ($file && ! -r $file){ + $val1 = main::message('dmesg-boot-permissions'); + } + elsif (!$file){ + $val1 = main::message('dmesg-boot-missing'); + } + } + } + else { + $val1 = main::message('optical-data'); + $data = drive_data_linux(); + drive_output($rows,$data) if %$data; + } + # if none of the above increased the row count, show the error message + if ($rows_start == scalar @$rows){ + push(@$rows,{main::key($num++,0,1,'Message') => $val1}); + } + eval $end if $b_log; + return $rows; +} + +sub drive_output { + eval $start if $b_log; + my ($rows,$drives) = @_; + my $num = 0; + my $j = 0; + # build floppy if any + foreach my $key (sort keys %$drives){ + if ($drives->{$key}{'type'} eq 'floppy'){ + push(@$rows, { + main::key($num++,0,1,ucfirst($drives->{$key}{'type'})) => "/dev/$key", + }); + delete $drives->{$key}; + } + } + foreach my $key (sort keys %$drives){ + $j = scalar @$rows; + $num = 1; + my $vendor = $drives->{$key}{'vendor'}; + $vendor ||= 'N/A'; + my $model = $drives->{$key}{'model'}; + $model ||= 'N/A'; + push(@$rows, { + main::key($num++,1,1,ucfirst($drives->{$key}{'type'})) => "/dev/$key", + main::key($num++,0,2,'vendor') => $vendor, + main::key($num++,0,2,'model') => $model, + }); + if ($extra > 0){ + my $rev = $drives->{$key}{'rev'}; + $rev ||= 'N/A'; + $rows->[$j]{ main::key($num++,0,2,'rev')} = $rev; + } + if ($extra > 1 && $drives->{$key}{'serial'}){ + $rows->[$j]{ main::key($num++,0,2,'serial')} = main::filter($drives->{$key}{'serial'}); + } + my $links = (@{$drives->{$key}{'links'}}) ? join(',', sort @{$drives->{$key}{'links'}}) : 'N/A' ; + $rows->[$j]{ main::key($num++,0,2,'dev-links')} = $links; + if ($show{'optical'}){ + $j = scalar @$rows; + my $speed = $drives->{$key}{'speed'}; + $speed ||= 'N/A'; + my ($audio,$multisession) = ('',''); + if (defined $drives->{$key}{'multisession'}){ + $multisession = ($drives->{$key}{'multisession'} == 1) ? 'yes' : 'no' ; + } + $multisession ||= 'N/A'; + if (defined $drives->{$key}{'audio'}){ + $audio = ($drives->{$key}{'audio'} == 1) ? 'yes' : 'no' ; + } + $audio ||= 'N/A'; + my $dvd = 'N/A'; + my (@rw,$rws); + if (defined $drives->{$key}{'dvd'}){ + $dvd = ($drives->{$key}{'dvd'} == 1) ? 'yes' : 'no' ; + } + if ($drives->{$key}{'cdr'}){ + push(@rw, 'cd-r'); + } + if ($drives->{$key}{'cdrw'}){ + push(@rw, 'cd-rw'); + } + if ($drives->{$key}{'dvdr'}){ + push(@rw, 'dvd-r'); + } + if ($drives->{$key}{'dvdram'}){ + push(@rw, 'dvd-ram'); + } + $rws = (@rw) ? join(',', @rw) : 'none' ; + push(@$rows, { + main::key($num++,1,2,'Features') => '', + main::key($num++,0,3,'speed') => $speed, + main::key($num++,0,3,'multisession') => $multisession, + main::key($num++,0,3,'audio') => $audio, + main::key($num++,0,3,'dvd') => $dvd, + main::key($num++,0,3,'rw') => $rws, + }); + if ($extra > 0){ + my $state = $drives->{$key}{'state'}; + $state ||= 'N/A'; + $rows->[$j]{ main::key($num++,0,3,'state')} = $state; + } + } + } + # print Data::Dumper::Dumper $drives; + eval $end if $b_log; +} + +sub drive_data_bsd { + eval $start if $b_log; + my (@rows,@temp); + my $drives = {}; + my ($count,$i,$working) = (0,0,''); + foreach (@{$dboot{'optical'}}){ + $_ =~ s/(cd[0-9]+)\(([^:]+):([0-9]+):([0-9]+)\):/$1:$2-$3.$4,/; + my @row = split(/:\s*/, $_); + next if ! defined $row[1]; + if ($working ne $row[0]){ + # print "$id_holder $row[0]\n"; + $working = $row[0]; + } + # no dots, note: ada2: 2861588MB BUT: ada2: 600.000MB/s + if (!exists $drives->{$working}){ + $drives->{$working}{'links'} = []; + $drives->{$working}{'model'} = ''; + $drives->{$working}{'rev'} = ''; + $drives->{$working}{'state'} = ''; + $drives->{$working}{'vendor'} = ''; + $drives->{$working}{'temp'} = ''; + $drives->{$working}{'type'} = ($working =~ /^cd/) ? 'optical' : 'unknown'; + } + # print "$_\n"; + if ($bsd_type !~ /^(net|open)bsd$/){ + if ($row[1] && $row[1] =~ /^<([^>]+)>/){ + $drives->{$working}{'model'} = $1; + $count = ($drives->{$working}{'model'} =~ tr/ //); + if ($count && $count > 1){ + @temp = split(/\s+/, $drives->{$working}{'model'}); + $drives->{$working}{'vendor'} = $temp[0]; + my $index = ($#temp > 2) ? ($#temp - 1): $#temp; + $drives->{$working}{'model'} = join(' ', @temp[1..$index]); + $drives->{$working}{'rev'} = $temp[-1] if $count > 2; + } + if ($show{'optical'}){ + if (/\bDVD\b/){ + $drives->{$working}{'dvd'} = 1; + } + if (/\bRW\b/){ + $drives->{$working}{'cdrw'} = 1; + $drives->{$working}{'dvdr'} = 1 if $drives->{$working}{'dvd'}; + } + } + } + if ($row[1] && $row[1] =~ /^Serial/){ + @temp = split(/\s+/,$row[1]); + $drives->{$working}{'serial'} = $temp[-1]; + } + if ($show{'optical'}){ + if ($row[1] =~ /^([0-9\.]+[MGTP][B]?\/s)/){ + $drives->{$working}{'speed'} = $1; + $drives->{$working}{'speed'} =~ s/\.[0-9]+//; + } + if (/\bDVD[-]?RAM\b/){ + $drives->{$working}{'cdr'} = 1; + $drives->{$working}{'dvdram'} = 1; + } + if ($row[2] && $row[2] =~ /,\s(.*)$/){ + $drives->{$working}{'state'} = $1; + $drives->{$working}{'state'} =~ s/\s+-\s+/, /; + } + } + } + else { + if ($row[2] && $row[2] =~ /<([^>]+)>/){ + $drives->{$working}{'model'} = $1; + $count = ($drives->{$working}{'model'} =~ tr/,//); + # print "c: $count $row[2]\n"; + if ($count && $count > 1){ + @temp = split(/,\s*/, $drives->{$working}{'model'}); + $drives->{$working}{'vendor'} = $temp[0]; + $drives->{$working}{'model'} = $temp[1]; + $drives->{$working}{'rev'} = $temp[2]; + } + if ($show{'optical'}){ + if (/\bDVD\b/){ + $drives->{$working}{'dvd'} = 1; + } + if (/\bRW\b/){ + $drives->{$working}{'cdrw'} = 1; + $drives->{$working}{'dvdr'} = 1 if $drives->{$working}{'dvd'}; + } + if (/\bDVD[-]?RAM\b/){ + $drives->{$working}{'cdr'} = 1; + $drives->{$working}{'dvdram'} = 1; + } + } + } + if ($show{'optical'}){ + # print "$row[1]\n"; + if (($row[1] =~ tr/,//) > 1){ + @temp = split(/,\s*/, $row[1]); + $drives->{$working}{'speed'} = $temp[2]; + } + } + } + } + main::log_data('dump','%$drives',$drives) if $b_log; + # print Data::Dumper::Dumper $drives; + eval $end if $b_log; + return $drives; +} + +sub drive_data_linux { + eval $start if $b_log; + my (@data,@info,@rows); + my $drives = {}; + @data = main::globber('/dev/dvd* /dev/cdr* /dev/scd* /dev/sr* /dev/fd[0-9]'); + # Newer kernel is NOT linking all optical drives. Some, but not all. + # Get the actual disk dev location, first try default which is easier to run, + # need to preserve line breaks + foreach (@data){ + my $working = readlink($_); + $working = ($working) ? $working: $_; + next if $working =~ /random/; + # possible fix: puppy has these in /mnt not /dev they say + $working =~ s/\/(dev|media|mnt)\///; + $_ =~ s/\/(dev|media|mnt)\///; + if (!defined $drives->{$working}){ + my @temp = ($_ ne $working) ? ($_) : (); + $drives->{$working}{'links'} = \@temp; + $drives->{$working}{'type'} = ($working =~ /^fd/) ? 'floppy' : 'optical' ; + } + else { + push(@{$drives->{$working}{'links'}}, $_) if $_ ne $working; + } + # print "$working\n"; + } + if ($show{'optical'} && -e '/proc/sys/dev/cdrom/info'){ + @info = main::reader('/proc/sys/dev/cdrom/info','strip'); + } + # print join('; ', @data), "\n"; + foreach my $key (keys %$drives){ + next if $drives->{$key}{'type'} eq 'floppy'; + my $device = "/sys/block/$key/device"; + if (-d $device){ + if (-r "$device/vendor"){ + $drives->{$key}{'vendor'} = main::reader("$device/vendor",'',0); + $drives->{$key}{'vendor'} = main::clean($drives->{$key}{'vendor'}); + $drives->{$key}{'state'} = main::reader("$device/state",'',0); + $drives->{$key}{'model'} = main::reader("$device/model",'',0); + $drives->{$key}{'model'} = main::clean($drives->{$key}{'model'}); + $drives->{$key}{'rev'} = main::reader("$device/rev",'',0); + } + } + elsif (-r "/proc/ide/$key/model"){ + $drives->{$key}{'vendor'} = main::reader("/proc/ide/$key/model",'',0); + $drives->{$key}{'vendor'} = main::clean($drives->{$key}{'vendor'}); + } + if ($show{'optical'} && @info){ + my $index = 0; + foreach my $item (@info){ + next if $item =~ /^\s*$/; + my @split = split(/\s+/, $item); + if ($item =~ /^drive name:/){ + foreach my $id (@split){ + last if ($id eq $key); + $index++; + } + last if !$index; # index will be > 0 if it was found + } + elsif ($item =~/^drive speed:/){ + $drives->{$key}{'speed'} = $split[$index]; + } + elsif ($item =~/^Can read multisession:/){ + $drives->{$key}{'multisession'}=$split[$index+1]; + } + elsif ($item =~/^Can read MCN:/){ + $drives->{$key}{'mcn'}=$split[$index+1]; + } + elsif ($item =~/^Can play audio:/){ + $drives->{$key}{'audio'}=$split[$index+1]; + } + elsif ($item =~/^Can write CD-R:/){ + $drives->{$key}{'cdr'}=$split[$index+1]; + } + elsif ($item =~/^Can write CD-RW:/){ + $drives->{$key}{'cdrw'}=$split[$index+1]; + } + elsif ($item =~/^Can read DVD:/){ + $drives->{$key}{'dvd'}=$split[$index+1]; + } + elsif ($item =~/^Can write DVD-R:/){ + $drives->{$key}{'dvdr'}=$split[$index+1]; + } + elsif ($item =~/^Can write DVD-RAM:/){ + $drives->{$key}{'dvdram'}=$split[$index+1]; + } + } + } + } + main::log_data('dump','%$drives',$drives) if $b_log; + # print Data::Dumper::Dumper $drives; + eval $end if $b_log; + return $drives; +} +} + +## PartitionItem ## +{ +# these will be globally accessible via PartitionItem::filters() +my ($fs_exclude,$fs_skip,$part_filter); +package PartitionItem; + +sub get { + eval $start if $b_log; + my ($key1,$val1); + my $rows = []; + my $num = 0; + set_partitions() if !$loaded{'set-partitions'}; + # Fails in corner case with zram but no other mounted filesystems + if (!@partitions){ + $key1 = 'Message'; + #$val1 = ($bsd_type && $bsd_type eq 'darwin') ? + # main::message('darwin-feature') : main::message('partition-data'); + $val1 = main::message('partition-data'); + @$rows = ({main::key($num++,0,1,$key1) => $val1,}); + } + else { + create_output($rows); + } + eval $end if $b_log; + return $rows; +} + +sub create_output { + eval $start if $b_log; + my $rows = $_[0]; + my $num = 0; + my $j = 0; + my ($dev,$dev_type,$fs,$percent,$raw_size,$size,$used); + # alpha sort for non numerics + if ($show{'partition-sort'} !~ /^(percent-used|size|used)$/){ + @partitions = sort { $a->{$show{'partition-sort'}} cmp $b->{$show{'partition-sort'}} } @partitions; + } + else { + @partitions = sort { $a->{$show{'partition-sort'}} <=> $b->{$show{'partition-sort'}} } @partitions; + } + my $fs_skip = get_filters('fs-skip'); + foreach my $row (@partitions){ + $num = 1; + next if $row->{'type'} eq 'secondary' && $show{'partition'}; + next if $show{'swap'} && $row->{'fs'} && $row->{'fs'} eq 'swap'; + next if $row->{'swap-type'} && $row->{'swap-type'} ne 'partition'; + if (!$row->{'hidden'}){ + $size = ($row->{'size'}) ? main::get_size($row->{'size'},'string') : 'N/A'; + $used = main::get_size($row->{'used'},'string','N/A'); # used can be 0 + $percent = (defined $row->{'percent-used'}) ? ' (' . $row->{'percent-used'} . '%)' : ''; + } + else { + $percent = ''; + $used = $size = (!$b_root) ? main::message('root-required') : main::message('partition-hidden'); + } + $fs = ($row->{'fs'}) ? lc($row->{'fs'}): 'N/A'; + $dev_type = ($row->{'dev-type'}) ? $row->{'dev-type'} : 'dev'; + $row->{'dev-base'} = '/dev/' . $row->{'dev-base'} if $dev_type eq 'dev' && $row->{'dev-base'}; + $dev = ($row->{'dev-base'}) ? $row->{'dev-base'} : 'N/A'; + $row->{'id'} =~ s|/home/[^/]+/(.*)|/home/$filter_string/$1| if $use{'filter'}; + $j = scalar @$rows; + push(@$rows, { + main::key($num++,1,1,'ID') => $row->{'id'}, + }); + if (($b_admin || $row->{'hidden'}) && $row->{'raw-size'}){ + # It's an error! permissions or missing tool + $raw_size = ($row->{'raw-size'}) ? main::get_size($row->{'raw-size'},'string') : 'N/A'; + $rows->[$j]{main::key($num++,0,2,'raw-size')} = $raw_size; + } + if ($b_admin && $row->{'raw-available'} && $size ne 'N/A'){ + $size .= ' (' . $row->{'raw-available'} . '%)'; + } + $rows->[$j]{main::key($num++,0,2,'size')} = $size; + $rows->[$j]{main::key($num++,0,2,'used')} = $used . $percent; + $rows->[$j]{main::key($num++,0,2,'fs')} = $fs; + if ($b_admin && $fs eq 'swap' && defined $row->{'swappiness'}){ + $rows->[$j]{main::key($num++,0,2,'swappiness')} = $row->{'swappiness'}; + } + if ($b_admin && $fs eq 'swap' && defined $row->{'cache-pressure'}){ + $rows->[$j]{main::key($num++,0,2,'cache-pressure')} = $row->{'cache-pressure'}; + } + if ($extra > 1 && $fs eq 'swap' && defined $row->{'priority'}){ + $rows->[$j]{main::key($num++,0,2,'priority')} = $row->{'priority'}; + } + if ($b_admin && $row->{'block-size'}){ + $rows->[$j]{main::key($num++,0,2,'block-size')} = $row->{'block-size'} . ' B';; + # $rows->[$j]{main::key($num++,0,2,'physical')} = $row->{'block-size'} . ' B'; + # $rows->[$j]{main::key($num++,0,2,'logical')} = $row->{'block-logical'} . ' B'; + } + $rows->[$j]{main::key($num++,1,2,$dev_type)} = $dev; + if ($b_admin && $row->{'maj-min'}){ + $rows->[$j]{main::key($num++,0,3,'maj-min')} = $row->{'maj-min'}; + } + if ($extra > 0 && $row->{'dev-mapped'}){ + $rows->[$j]{main::key($num++,0,3,'mapped')} = $row->{'dev-mapped'}; + } + # add fs known to not use label/uuid here + if (($show{'label'} || $show{'uuid'}) && $dev_type eq 'dev' && + $fs !~ /^$fs_skip$/){ + if ($show{'label'}){ + if ($use{'filter-label'}){ + main::filter_partition('part', \$row->{'label'}, ''); + } + $row->{'label'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'label')} = $row->{'label'}; + } + if ($show{'uuid'}){ + if ($use{'filter-uuid'}){ + main::filter_partition('part', \$row->{'uuid'}, ''); + } + $row->{'uuid'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'uuid')} = $row->{'uuid'}; + } + } + } + # Corner case, no partitions, but zram swap. + if (!@$rows){ + @$rows = ({main::key($num++,0,1,'Message') => main::message('partition-data')}); + } + eval $end if $b_log; +} + +sub set_partitions { + eval $start if $b_log; + # return if $bsd_type && $bsd_type eq 'darwin'; # darwin has mutated output + my (@data,@rows,@mount,@partitions_working,$part,@working); + my ($back_size,$back_used,$b_fs,$cols) = (4,3,1,6); + my ($b_dfp,$b_fake_map,$b_load,$b_logical,$b_space,); + my ($block_size,$blockdev,$dev_base,$dev_mapped,$dev_type,$fs,$id,$label, + $maj_min,$percent_used,$raw_size,$replace,$size_available,$size,$test, + $type,$uuid,$used); + $loaded{'set-partitions'} = 1; + if ($b_admin){ + # For partition block size + $blockdev = $alerts{'blockdev'}->{'path'} if $alerts{'blockdev'}->{'path'}; + } + # For raw partition sizes, maj_min + if ($bsd_type){ + DiskDataBSD::set() if !$loaded{'disk-data-bsd'}; + } + else { + PartitionData::set() if !$loaded{'partition-data'}; + LsblkData::set() if !$loaded{'lsblk'}; + } + # set @labels, @uuid + if (!$bsd_type){ + set_label_uuid() if !$loaded{'label-uuid'}; + } + # Most current OS support -T and -k, but -P means different things + # in freebsd. However since most use is from linux, we make that default + # android 7 no -T support + if (!$fake{'partitions'}){ + if (@partitions_working = main::grabber("df -P -T -k 2>/dev/null")){ + main::set_mapper() if !$loaded{'mapper'} && !$bsd_type; + $b_dfp = 1; + } + elsif (@partitions_working = main::grabber("df -T -k 2>/dev/null")){ + # Fine, it worked, could be bsd or linux + } + # Busybox supports -k and -P, older openbsd, darwin, solaris don't have -P + else { + if (@partitions_working = main::grabber("df -k -P 2>/dev/null")){ + $b_dfp = 1; + } + else { + @partitions_working = main::grabber("df -k 2>/dev/null"); + } + $b_fs = 0; + if (my $path = main::check_program('mount')){ + @mount = main::grabber("$path 2>/dev/null"); + } + } + } + else { + my $file; + # $file = "$fake_data_dir/block-devices/df/df-kTP-cygwin-1.txt"; + # $file = "$fake_data_dir/block-devices/df/df-kT-wrapped-1.txt"; + # @partitions_working = main::reader($file); + } + # NOTE: add push(@partitions_working,'data') here to emulate item; match unmounted + # print Data::Dumper::Dumper \@partitions_working; + # Determine positions + if (@partitions_working){ + my $row1 = shift @partitions_working; + $row1 =~ s/Mounted on/Mounted-on/i; + my @temp = split(/\s+/,$row1); + $cols = $#temp; + } + # NOTE: using -P fixes line wraps, otherwise look for hangs and reconnect + if (!$b_dfp){ + my $holder = ''; + my @part_temp; + foreach (@partitions_working){ + my @columns= split(/\s+/,$_); + if ($#columns < $cols){ + $holder = join('^^',@columns[0..$#columns]); + next; + } + if ($holder){ # reconnect hanging lines + $_ = $holder . ' ' . $_; + $holder = ''; + } + push(@part_temp,$_); + } + @partitions_working = @part_temp; + } + if (!$bsd_type){ + # New kernels/df have rootfs and / repeated, creating two entries for the + # same partition so check for two string endings of / then slice out the + # rootfs one, I could check for it before slicing it out, but doing that + # would require the same action twice re code execution. + my $roots = 0; + foreach (@partitions_working){ + $roots++ if /\s\/$/; + } + @partitions_working = grep {!/^rootfs/} @partitions_working if $roots > 1; + } + else { + # turns out freebsd uses this junk too + $b_fake_map = 1; + # darwin k: Filesystem 1024-blocks Used Available Capacity iused ifree %iused Mounted on + # linux kT: Filesystem Type 1K-blocks Used Available Use% Mounted on + # freebsd kT: Filesystem Type 1024-blocks Used Avail Capacity Mounted on + if ($bsd_type eq 'darwin'){ + ($back_size,$back_used) = (7,6); + } + } + my $filters = get_filters('partition'); + # These are local, not remote, iso, or overlay types: + my $fuse_fs = 'adb|apfs(-?fuse)?|archive(mount)?|gphoto|gv|gzip|ifuse|'; + $fuse_fs .= '[^\.]*mtp|ntfs-?3g|[^\.]*ptp|vdfuse|vram|wim(mount)?|xb|xml'; + # Just the common ones desktops might have + my $remote_fs = 'curlftp|gmail|g(oogle-?)?drive|pnfs|\bnfs|rclone|'; + $remote_fs .= 's3fs|smb|ssh|vboxsf'; + # push @partitions_working, '//mafreebox.freebox.fr/Disque dur cifs 239216096 206434016 20607496 91% /freebox/Disque dur'; + # push @partitions_working, '//mafreebox.freebox.fr/AllPG cifs 436616192 316339304 120276888 73% /freebox/AllPG'; + # push(@partitions_working,'/dev/loop0p1 iso9660 3424256 3424256 0 100% /media/jason/d-live nf 11.3.0 gn 6555 9555 amd64'); + # push(@partitions_working,'drvfs 9p 511881212 115074772 396806440 23% /mnt/c'); + # push(@partitions_working,'drivers 9p 511881212 115074772 396806440 23% /usr/lib/wsl/drivers'); + foreach (@partitions_working){ + ($dev_base,$dev_mapped,$dev_type,$fs,$id,$label, + $maj_min,$type,$uuid) = ('','','','','','','','',''); + ($b_load,$b_space,$block_size,$percent_used,$raw_size,$size_available, + $size,$used) = (0,0,0,0,0,0,0,0); + undef $part; + # apple crap, maybe also freebsd? + $_ =~ s/^map\s+([\S]+)/map:\/$1/ if $b_fake_map; + # handle spaces in remote filesystem names + # busybox df shows KM, sigh; note: GoogleDrive Hogne: fuse.rclone 15728640 316339304 120276888 73% + if (/^(.*?)(\s[\S]+)\s+[a-z][a-z0-9\.]+(\s+[0-9]+){3}\s+[0-9]+%\s/){ + $replace = $test = "$1$2"; + if ($test =~ /\s/){ # paranoid test, but better safe than sorry + $b_space = 1; + $replace =~ s/\s/^^/g; + # print ":$replace:\n"; + $_ =~ s/^$test/$replace/; + # print "$_\n"; + } + } + my @row = split(/\s+/, $_); + # print Data::Dumper::Dumper \@row; + $row[0] =~ s/\^\^/ /g if $b_space; # reset spaces in > 1 word fs name + # autofs is a bsd thing, has size 0 + if ($row[0] =~ /^$filters$/ || $row[0] =~ /^ROOT/i || + ($b_fs && ($row[2] == 0 || $row[1] =~ /^(autofs|devtmpfs|iso9660|tmpfs)$/))){ + next; + } + # print "row 0:", $row[0],"\n"; + # cygwin C:\cygwin passes this test so has to be handled later + if ($row[0] =~ /^\/dev\/|:\/|\/\//){ + # this could point to by-label or by-uuid so get that first. In theory, abs_path should + # drill down to get the real path, but it isn't always working. + if ($row[0] eq '/dev/root'){ + $row[0] = get_root(); + } + # sometimes paths are set using /dev/disk/by-[label|uuid] so we need to get the /dev/xxx path + if ($row[0] =~ /by-label|by-uuid/){ + $row[0] = Cwd::abs_path($row[0]); + } + elsif ($row[0] =~ /mapper\// && %mapper){ + $dev_mapped = $row[0]; + $dev_mapped =~ s|^/.*/||; + $row[0] = $mapper{$dev_mapped} if $mapper{$dev_mapped}; + } + elsif ($row[0] =~ /\/dm-[0-9]+$/ && %dmmapper){ + my $temp = $row[0]; + $temp =~ s|^/.*/||; + $dev_mapped = $dmmapper{$temp}; + } + elsif ($bsd_type && $row[0] =~ m|^/dev/gpt[^/]*/|){ + my $temp1 = $row[0]; + $temp1 =~ s|^/dev/||; + my $temp2 = GlabelData::get($temp1); + if ($temp2 && $temp2 ne $temp1){ + $dev_mapped = $row[0]; + $row[0] = $temp2; + } + } + $dev_base = $row[0]; + $dev_base =~ s|^/.*/||; + $part = LsblkData::get($dev_base) if @lsblk; + $maj_min = get_maj_min($dev_base) if @proc_partitions; + } + # this handles zfs type devices/partitions, which do not start with / but contain / + # note: Main/jails/transmission_1 path can be > 1 deep + # Main zfs 3678031340 8156 3678023184 0% /mnt/Main + if (!$dev_base && ($row[0] =~ /^([^\/]+\/)(.+)/ || + ($row[0] =~ /^[^\/]+$/ && $row[1] =~ /^(btrfs|hammer[2-9]?|zfs)$/)) || + ($windows{'wsl'} && $row[0] eq 'drivers')){ + $dev_base = $row[0]; + $dev_type = 'logical'; + } + # this handles yet another fredforfaen special case where a mounted drive + # has the search string in its name, includes / (| + if ($row[-1] =~ m%^/(|boot|boot/efi|home|opt|tmp|usr|usr/home|var|var/log|var/tmp)$% || + ($b_android && $row[-1] =~ /^\/(cache|data|firmware|system)$/)){ + $b_load = 1; + # note, older df in bsd do not have file system column + $type = 'main'; + } + # $cols in case where mount point has space in name, we only care about the first part + elsif ($row[$cols] !~ m%^\/(|boot|boot/efi|home|opt|tmp|usr|usr/home|var|var/log|var/tmp)$% && + $row[$cols] !~ /^filesystem/ && + !($b_android && $row[$cols] =~ /^\/(cache|data|firmware|system)$/)){ + $b_load = 1; + $type = 'secondary'; + } + if ($b_load){ + if (!$bsd_type){ + if ($b_fs){ + $fs = ($part->{'fs'}) ? $part->{'fs'} : $row[1]; + } + else { + $fs = get_mounts_fs($row[0],\@mount); + } + if ($show{'label'}){ + if ($part->{'label'}){ + $label = $part->{'label'}; + } + elsif (@labels){ + $label = get_label($row[0]); + } + } + if ($show{'uuid'}){ + if ($part->{'uuid'}){ + $uuid = $part->{'uuid'}; + } + elsif (@uuids){ + $uuid = get_uuid($row[0]); + } + } + } + else { + $fs = ($b_fs) ? $row[1]: get_mounts_fs($row[0],\@mount); + } + # assuming that all null/nullfs are parts of a logical fs + $b_logical = 1 if $fs && $fs =~ /^(btrfs|hammer|null|zfs)/; + $id = join(' ', @row[$cols .. $#row]); + $size = $row[$cols - $back_size]; + if ($b_admin && -e "/sys/block/"){ + @working = admin_data($blockdev,$dev_base,$size); + $raw_size = $working[0]; + $size_available = $working[1]; + $block_size = $working[2]; + } + if (!$dev_type){ + # C:/cygwin64, D: + if ($windows{'cygwin'} && $row[0] =~ /^[A-Z]+:/){ + $dev_type = 'windows'; + $dev_base = $row[0] if !$dev_base; + # looks weird if D:, yes, I know, windows uses \, but cygwin doesn't + $dev_base .= '/' if $dev_base =~ /:$/; + } + elsif ($windows{'wsl'} && $row[0] =~ /^(drvfs)/){ + $dev_type = 'windows'; + if ($id =~ m|^/mnt/([a-z])$|){ + $dev_base = uc($1) . ':'; + } + $dev_base = $row[0] if !$dev_base; + } + # need data set, this could maybe be converted to use + # dev-mapped and abspath but not without testing + elsif ($dev_base =~ /^map:\/(.*)/){ + $dev_type = 'mapped'; + $dev_base = $1; + } + # note: possible: sshfs path: beta:data/; remote: fuse.rclone + elsif ($dev_base =~ /^\/\/|:\// || ($fs && $fs =~ /($remote_fs)/i)){ + $dev_type = 'remote'; + $dev_base = $row[0] if !$dev_base; # only trips in fs test case + } + # a slice bsd system, zfs can't be detected this easily + elsif ($b_logical && $fs && $fs =~ /^null(fs)?$/){ + $dev_type = 'logical'; + $dev_base = $row[0] if !$dev_base; + } + elsif (!$dev_base){ + if ($fs && $fs =~ /^(fuse[\._-]?)?($fuse_fs)(fs)?/i){ + $dev_base = $2; + $dev_type = 'fuse'; + } + # Check dm-crypt, that may be real partition type, but no data. + # We've hit something inxi doesn't know about, or error has occured + else { + $dev_type = 'source'; + $dev_base = main::message('unknown-dev'); + } + } + else { + $dev_type = 'dev'; + } + } + if ($bsd_type && $dev_type eq 'dev' && $row[0] && + ($b_admin || $show{'label'} || $show{'uuid'})){ + my $temp = DiskDataBSD::get($row[0]); + $block_size = $temp->{'logical-block-size'}; + $label = $temp->{'label'}; + $uuid = $temp->{'uuid'}; + } + $used = $row[$cols - $back_used]; + $percent_used = sprintf("%.1f", ($used/$size)*100) if ($size && main::is_numeric($size)); + push(@partitions,{ + 'block-size' => $block_size, + 'dev-base' => $dev_base, + 'dev-mapped' => $dev_mapped, + 'dev-type' => $dev_type, + 'fs' => $fs, + 'id' => $id, + 'label' => $label, + 'maj-min' => $maj_min, + 'percent-used' => $percent_used, + 'raw-available' => $size_available, + 'raw-size' => $raw_size, + 'size' => $size, + 'type' => $type, + 'used' => $used, + 'uuid' => $uuid, + }); + } + } + swap_data() if !$loaded{'set-swap'}; + push(@partitions,@swaps); + print Data::Dumper::Dumper \@partitions if $dbg[16]; + if (!$bsd_type && @lsblk){ + check_partition_data();# updates @partitions + } + main::log_data('dump','@partitions',\@partitions) if $b_log; + print Data::Dumper::Dumper \@partitions if $dbg[16]; + eval $end if $b_log; +} + +sub swap_data { + eval $start if $b_log; + $loaded{'set-swap'} = 1; + my (@data,@working); + my ($block_size,$cache_pressure,$dev_base,$dev_mapped,$dev_type,$label, + $maj_min,$mount,$path,$pattern1,$pattern2,$percent_used,$priority, + $size,$swap_type,$swappiness,$used,$uuid,$zram_comp,$zram_mcs, + $zswap_enabled,$zram_comp_avail,$zswap_comp,$zswap_mpp); + my ($s,$j,$size_id,$used_id) = (1,0,2,3); + if (!$bsd_type){ + # faster, avoid subshell, same as swapon -s + if (-r '/proc/swaps'){ + @working = main::reader("/proc/swaps"); + } + elsif ($path = main::check_program('swapon')){ + # note: while -s is deprecated, --show --bytes is not supported + # on older systems + @working = main::grabber("$path -s 2>/dev/null"); + } + if ($b_admin){ + swap_advanced_data(\$swappiness,\$cache_pressure,\$zswap_enabled, + \$zswap_comp,\$zswap_mpp); + } + if (($show{'label'} || $show{'uuid'}) && !$loaded{'label-uuid'}){ + set_label_uuid(); + } + $pattern1 = 'partition|file|ram'; + $pattern2 = '[^\s].*[^\s]'; + } + else { + if ($path = main::check_program('swapctl')){ + # output in in KB blocks$mount + @working = main::grabber("$path -l -k 2>/dev/null"); + } + ($size_id,$used_id) = (1,2); + $pattern1 = '[0-9]+'; + $pattern2 = '[^\s]+'; + } + # now add the swap partition data, don't want to show swap files, just partitions, + # though this can include /dev/ramzswap0. Note: you can also use /proc/swaps for this + # data, it's the same exact output as swapon -s + foreach my $line (@working){ + #next if ! /^\/dev/ || /^\/dev\/(ramzwap|zram)/; + next if $line =~ /^(Device|Filename|no swap)/; + ($block_size,$dev_base,$dev_mapped,$dev_type,$label,$maj_min,$mount, + $swap_type,$uuid) = ('','','','','','','','partition',''); + ($priority,$zram_comp_avail,$zram_comp,$zram_mcs) = (); + @data = split(/\s+/, $line); + # /dev/zramX; ramzswapX == compcache, legacy version of zram. + # /run/initramfs/dev/zram0; /dev/ramzswap0 + if ($line =~ /^\/(dev|run).*?\/((compcache|ramzwap|zram)\d+)/i){ + $dev_base = $2; + $swap_type = 'zram'; + $dev_type = 'dev'; + if ($b_admin){ + zram_data($dev_base,\$zram_comp,\$zram_comp_avail,\$zram_mcs); + } + } + elsif ($data[1] && $data[1] eq 'ram'){ + $swap_type = 'ram'; + } + elsif ($line =~ m|^/dev|){ + $swap_type = 'partition'; + $dev_base = $data[0]; + $dev_base =~ s|^/dev/||; + if (!$bsd_type){ + if ($dev_base =~ /^dm-/ && %dmmapper){ + $dev_mapped = $dmmapper{$dev_base}; + } + if ($show{'label'} && @labels){ + $label = get_label($data[0]); + } + if ($show{'uuid'} && @uuids){ + $uuid = get_uuid($data[0]); + } + } + else { + my $part_id = $dev_base; + if ($dev_base =~ m|^gpt[^/]*/|){ + my $temp = GlabelData::get($dev_base); + if ($temp && $temp ne $dev_base){ + $dev_mapped = '/dev/' . $dev_base; + $part_id = $dev_base = $temp; + $mount = '/dev/' . $temp; + } + } + if ($show{'label'} || $show{'uuid'}){ + my $temp = DiskDataBSD::get($part_id); + $block_size = $temp->{'logical-block-size'}; + $label = $temp->{'label'}; + $uuid = $temp->{'uuid'}; + } + } + $dev_type = 'dev'; + $maj_min = get_maj_min($dev_base) if @proc_partitions; + } + elsif ($data[1] && $data[1] eq 'file' || m|^/|){ + $swap_type = 'file'; + } + $priority = $data[-1] if !$bsd_type; + # swpaon -s: /dev/sdb1 partition 16383996 109608 -2 + # swapctl -l -k: /dev/label/swap0.eli 524284 154092 + # users could have space in swapfile name + if (!$mount && $line =~ /^($pattern2)\s+($pattern1)\s+/){ + $mount = main::trimmer($1); + } + $size = $data[$size_id]; + $used = $data[$used_id]; + $percent_used = sprintf("%.1f", ($used/$size)*100); + push(@swaps, { + 'block-size' => $block_size, + 'cache-pressure' => $cache_pressure, + 'dev-base' => $dev_base, + 'dev-mapped' => $dev_mapped, + 'dev-type' => $dev_type, + 'fs' => 'swap', + 'id' => "swap-$s", + 'label' => $label, + 'maj-min' => $maj_min, + 'mount' => $mount, + 'percent-used' => $percent_used, + 'priority' => $priority, + 'size' => $size, + 'swappiness' => $swappiness, + 'type' => 'main', + 'swap-type' => $swap_type, + 'used' => $used, + 'uuid' => $uuid, + 'zram-comp' => $zram_comp, + 'zram-comp-avail' => $zram_comp_avail, + 'zram-max-comp-streams' => $zram_mcs, + 'zswap-enabled' => $zswap_enabled, + 'zswap-compressor' => $zswap_comp, + 'zswap-max-pool-percent' => $zswap_mpp, + }); + $s++; + } + main::log_data('dump','@swaps',\@swaps) if $b_log; + print Data::Dumper::Dumper \@swaps if $dbg[15];; + eval $end if $b_log; +} + +# Alll by ref: 0: $swappiness; 1: $cache_pressure; 2: $zswap_enabled; +# 3: $zswap_comp; 4: $zswap_mpp +sub swap_advanced_data { + eval $start if $b_log; + if (-r '/proc/sys/vm/swappiness'){ + ${$_[0]} = main::reader('/proc/sys/vm/swappiness','',0); + if (defined ${$_[0]}){ + ${$_[0]} .= (${$_[0]} == 60) ? ' (default)' : ' (default 60)' ; + } + } + if (-r '/proc/sys/vm/vfs_cache_pressure'){ + ${$_[1]} = main::reader('/proc/sys/vm/vfs_cache_pressure','',0); + if (defined ${$_[1]}){ + ${$_[1]} .= (${$_[1]}== 100) ? ' (default)' : ' (default 100)' ; + } + } + if (-r '/sys/module/zswap/parameters/enabled'){ + ${$_[2]} = main::reader('/sys/module/zswap/parameters/enabled','',0); + if (${$_[2]} =~ /^(Y|yes|true|1)$/){ + ${$_[2]} = 'yes'; + } + elsif (${$_[2]} =~ /^(N|no|false|0)$/){ + ${$_[2]} = 'no'; + } + else { + ${$_[2]} = 'unset'; + } + } + if (-r '/sys/module/zswap/parameters/compressor'){ + ${$_[3]} = main::reader('/sys/module/zswap/parameters/compressor','',0); + } + if (-r '/sys/module/zswap/parameters/max_pool_percent'){ + ${$_[4]} = main::reader('/sys/module/zswap/parameters/max_pool_percent','',0); + } + eval $end if $b_log; +} + +# 0: device id [zram0]; by ref: 1: $zram_comp; 2: $zram_comp_avail; 3: $zram_mcs; +sub zram_data { + if (-r "/sys/block/$_[0]/comp_algorithm"){ + ${$_[2]} = main::reader("/sys/block/$_[0]/comp_algorithm",'',0); + # current is in [..] in list + if (${$_[2]} =~ /\[(\S+)\]/){ + ${$_[1]} = $1; + # dump the active one, and leave the available + ${$_[2]} =~ s/\[${$_[1]}\]//; + ${$_[2]} =~ s/^\s+|\s+$//g; + ${$_[2]} =~ s/\s+/,/g; + } + } + if (-r "/sys/block/$_[0]/max_comp_streams"){ + ${$_[3]} = main::reader("/sys/block/$_[0]/max_comp_streams",'',0); + } +} + +# Handle cases of hidden file systems +sub check_partition_data { + eval $start if $b_log; + my ($b_found,$dev_mapped,$temp); + my $filters = get_filters('partition'); + foreach my $row (@lsblk){ + $b_found = 0; + $dev_mapped = ''; + if (!$row->{'name'} || !$row->{'mount'} || !$row->{'type'} || + ($row->{'fs'} && $row->{'fs'} =~ /^$filters$/) || + ($row->{'type'} =~ /^(disk|loop|rom)$/)){ + next; + } + # unmap so we can match name to dev-base + if (%mapper && $mapper{$row->{'name'}}){ + $dev_mapped = $row->{'name'}; + $row->{'name'} = $mapper{$row->{'name'}}; + } + # print "$row->{'name'} $row->{'mount'}\n"; + foreach my $row2 (@partitions){ + # print "1: n:$row->{'name'} m:$row->{'mount'} db:$row2->{'dev-base'} id:$row2->{'id'}\n"; + next if !$row2->{'id'}; + # note: for swap mount point is [SWAP] in @lsblk, but swap-x in @partitions + if ($row->{'mount'} eq $row2->{'id'} || $row->{'name'} eq $row2->{'dev-base'}){ + $b_found = 1; + last; + } + # print "m:$row->{'mount'} id:$row2->{'id'}\n"; + } + if (!$b_found){ + # print "found: n:$row->{'name'} m:$row->{'mount'}\n"; + $temp = { + 'block-logical' => $row->{'block-logical'}, + 'dev-base' => $row->{'name'}, + 'dev-mapped' => $dev_mapped, + 'fs' => $row->{'fs'}, + 'id' => $row->{'mount'}, + 'hidden' => 1, + 'label' => $row->{'label'}, + 'maj-min' => $row->{'maj-min'}, + 'percent-used' => 0, + 'raw-size' => $row->{'size'}, + 'size' => 0, + 'type' => 'secondary', + 'used' => 0, + 'uuid' => $row->{'uuid'}, + }; + push(@partitions,$temp); + main::log_data('dump','lsblk check: @temp',$temp) if $b_log; + } + } + eval $end if $b_log; +} + +# fs-exclude: Excludes fs size from disk used total; +# fs-skip: do not display label/uuid fields from partition/unmounted/swap. +# partition: do not use this partition in -p output. +# args: 0: [fs-exclude|fs-skip|partition] +sub get_filters { + set_filters() if !$fs_exclude; + if ($_[0] eq 'fs-exclude'){ + return $fs_exclude; + } + elsif ($_[0] eq 'fs-skip'){ + return $fs_skip; + } + elsif ($_[0] eq 'partition'){ + return $part_filter; + } +} + +# See docs/inxi-partitions.txt FILE SYSTEMS for specific fs info. +# The filter string must match /^[regex]$/ exactly. +sub set_filters { + # Notes: appimage/flatpak mount?; astreamfs reads remote http urls; + # avfs == fuse; cgmfs,vramfs in ram, like devfs, sysfs; gfs = googlefs; + # hdfs == hadoop; ifs == integrated fs; pvfs == orangefs; smb == cifs; + # null == hammer fs slice; kfs/kosmosfs == CloudStore; + # snap mounts with squashfs; swap is set in swap_data(); vdfs != vdfuse; + # vramfs == like zram except gpu ram; + # Some can be fuse mounts: fuse.sshfs. + # Distributed/Remote: 9p, (open-)?afs, alluxio, astreamfs, beegfs, + # cephfs, cfs, chironfs, cifs, cloudstore, dfs, davfs, dce, + # gdrivefs, gfarm, gfs\d{0,2}, gitfs, glusterfs, gmailfs, gpfs, + # hdfs, httpdirfs, hubicfuse, ipfs, juice, k(osmos)?fs, .*lafs, lizardfs, + # lustre, magma, mapr, moosefs, nfs[34], objective, ocfs\d{0,2}, onefs, + # orangefs, panfs, pnfs, pvfs\d{0,2}, rclone, restic, rozofs, s3fs, scality, + # sfs, sheepdogfs, spfs, sshfs, smbfs, v9fs, vboxsf, vdfs, vmfs, wekafs, + # xtreemfs + # Stackable/Union: aufs, e?cryptfs, encfs, erofs, gocryptfs, ifs, lofs, + # mergerfs, mhddfs, overla(id|y)(fs)?, squashfs, unionfs; + # ISO/Archive: archive(mount)?, atlas, avfs. borg, erofs, fuse-archive, + # fuseiso, gzipfs, iso9660, lofs, vdfuse, wimmountfs, xbfuse + # FUSE: adbfs, apfs-fuse, atomfs, gvfs, gvfs-mtp, ifuse, jmtpfs, mtpfs, ptpfs, + # puzzlefs, simple-mtpfs, vramfs, xmlfs + # System fs: cgmfs, configfs, debugfs, devfs, devtmpfs, efivarfs, fdescfs, + # hugetlbfs, kernfs, linprocfs, linsysfs, lxcfs, procfs, ptyfs, run, + # securityfs, shm, swap, sys, sysfs, tmpfs, tracefs, type, udev, vartmp + # System dir: /dev, /dev/(block/)?loop[0-9]+, /run(/.*)?, /sys/.* + + ## These are global, all filters use these. ISO, encrypted/stacked + my @all = qw%au av e?crypt enc ero gocrypt i (fuse-?)?iso iso9660 lo merger + mhdd overla(id|y) splitview(-?fuse)? squash union vboxsf xbfuse%; + ## These are fuse/archive/distributed/remote/clustered mostly + my @exclude = (@all,qw%9p (open-?)?a adb archive(mount)? astream atlas atom + beeg borg c ceph chiron ci cloudstore curlftp d dav dce + g gdrive gfarm git gluster gmail gocrypt google-drive-ocaml gp gphoto gv gzip + hd httpd hubic ip juice k(osmos)? .*la lizard lustre magma mapr moose .*mtp + null p?n objective oc one orange pan .*ptp puzzle pv rclone restic rozo + s s3 scality sheepdog sp ssh smb v9 vd vm vram weka wim(mount)? xb xml + xtreem%); + # Various RAM based system FS + my @partition = (@all,qw%cgroup.* cgm config debug dev devtmp efivar fdesc + hugetlb kern linproc linsys lxc none proc pty run security shm swap sys + tmp trace type udev vartmp%); + my $begin = '(fuse(blk)?[\._-]?)?('; + my $end = ')([\._-]?fuse)?(fs)?\d{0,2}'; + $fs_exclude = $begin . join('|',@exclude) . $end; + $fs_skip = $begin . join('|',@exclude,'f') . $end; # apfs?; BSD ffs has no u/l + $part_filter = '((' . join('|',@partition) . ')(fs)?|'; + $part_filter .= '\/dev|\/dev\/(block\/)?loop[0-9]+|\/run(\/.*)?|\/sys\/.*)'; + # print "$part_filter\n"; +} + +sub get_mounts_fs { + eval $start if $b_log; + my ($item,$mount) = @_; + $item =~ s/map:\/(\S+)/map $1/ if $bsd_type && $bsd_type eq 'darwin'; + return 'N/A' if ! @$mount; + my ($fs) = (''); + # linux: /dev/sdb6 on /var/www/m type ext4 (rw,relatime,data=ordered) + # /dev/sda3 on /root.dev/ugw type ext3 (rw,relatime,errors=continue,user_xattr,acl,barrier=1,data=journal) + # bsd: /dev/ada0s1a on / (ufs, local, soft-updates) + # bsd 2: /dev/wd0g on /home type ffs (local, nodev, nosuid) + foreach (@$mount){ + if ($_ =~ /^$item\s+on.*?\s+type\s+([\S]+)\s+\([^\)]+\)/){ + $fs = $1; + last; + } + elsif ($_ =~ /^$item\s+on.*?\s+\(([^,\s\)]+?)[,\s]*.*\)/){ + $fs = $1; + last; + } + } + eval $end if $b_log; + main::log_data('data',"fs: $fs") if $b_log; + return $fs; +} + +sub set_label_uuid { + eval $start if $b_log; + $loaded{'label-uuid'} = 1; + if ($show{'unmounted'} || $show{'label'} || $show{'swap'} || $show{'uuid'}){ + if (-d '/dev/disk/by-label'){ + @labels = main::globber('/dev/disk/by-label/*'); + } + if (-d '/dev/disk/by-uuid'){ + @uuids = main::globber('/dev/disk/by-uuid/*'); + } + main::log_data('dump', '@labels', \@labels) if $b_log; + main::log_data('dump', '@uuids', \@uuids) if $b_log; + } + eval $end if $b_log; +} + +# args: 0: blockdev full path (part only); 1: block id; 2: size (part only) +sub admin_data { + eval $start if $b_log; + my ($blockdev,$id,$size) = @_; + # 0: calc block 1: available percent 2: disk physical block size/partition block size; + my @sizes = (0,0,0); + my ($block_size,$percent,$size_raw) = (0,0,0); + foreach my $row (@proc_partitions){ + if ($row->[-1] eq $id){ + $size_raw = $row->[2]; + last; + } + } + # get the fs block size + $block_size = (main::grabber("$blockdev --getbsz /dev/$id 2>/dev/null"))[0] if $blockdev; + if (!$size_raw){ + $size_raw = 'N/A'; + } + else { + $percent = sprintf("%.2f", ($size/$size_raw) * 100) if $size && $size_raw; + } + # print "$id size: $size %: $percent p-b: $block_size raw: $size_raw\n"; + @sizes = ($size_raw,$percent,$block_size); + main::log_data('dump','@sizes',\@sizes) if $b_log; + eval $end if $b_log; + return @sizes; +} + +sub get_maj_min { + eval $start if $b_log; + my ($id) = @_; + my ($maj_min,@working); + foreach my $row (@proc_partitions){ + if ($id eq $row->[-1]){ + $maj_min = $row->[0] . ':' . $row->[1]; + last; + } + } + eval $end if $b_log; + return $maj_min; +} + +sub get_label { + eval $start if $b_log; + my ($item) = @_; + my $label = ''; + foreach (@labels){ + if ($item eq Cwd::abs_path($_)){ + $label = $_; + $label =~ s/\/dev\/disk\/by-label\///; + $label =~ s/\\x20/ /g; + $label =~ s%\\x2f%/%g; + last; + } + } + $label ||= 'N/A'; + eval $end if $b_log; + return $label; +} + +sub get_root { + eval $start if $b_log; + my ($path) = ('/dev/root'); + # note: the path may be a symbolic link to by-label/by-uuid but not + # sure how far in abs_path resolves the path. + my $temp = Cwd::abs_path($path); + $path = $temp if $temp; + # note: it's a kernel config option to have /dev/root be a sym link + # or not, if it isn't, path will remain /dev/root, if so, then try mount + if ($path eq '/dev/root' && (my $program = main::check_program('mount'))){ + my @data = main::grabber("$program 2>/dev/null"); + # /dev/sda2 on / type ext4 (rw,noatime,data=ordered) + foreach (@data){ + if (/^([\S]+)\son\s\/\s/){ + $path = $1; + # note: we'll be handing off any uuid/label paths to the next + # check tools after get_root() above, so don't trim those. + $path =~ s/.*\/// if $path !~ /by-uuid|by-label/; + last; + } + } + } + eval $end if $b_log; + return $path; +} + +sub get_uuid { + eval $start if $b_log; + my ($item) = @_; + my $uuid = ''; + foreach (@uuids){ + if ($item eq Cwd::abs_path($_)){ + $uuid = $_; + $uuid =~ s/\/dev\/disk\/by-uuid\///; + last; + } + } + $uuid ||= 'N/A'; + eval $end if $b_log; + return $uuid; +} +} + +## ProcessItem ## +{ +package ProcessItem; +# header: +# 0: CMD +# 1: PID +# 2: %CPU +# 3: %MEM +# 4: RSS +my $header; + +sub get { + eval $start if $b_log; + my $num = 0; + my $rows = []; + if (@ps_aux){ + $header = $ps_data{'header'}; # will always be set if @ps_aux + if ($show{'ps-cpu'}){ + cpu_processes($rows); + } + if ($show{'ps-mem'}){ + mem_processes($rows); + } + } + else { + my $key = 'Message'; + push(@$rows, { + main::key($num++,0,1,$key) => main::message('ps-data-null','') + }); + } + eval $end if $b_log; + return $rows; +} + +sub cpu_processes { + eval $start if $b_log; + my $rows = $_[0]; + my ($j,$num,$cpu,$cpu_mem,$mem,$pid) = (0,0,'','','',''); + my (@ps_rows); + my $count = ($b_irc)? 5 : $ps_count; + if (defined $header->[2]){ + @ps_rows = sort { + my @a = split(/\s+/, $a); + my @b = split(/\s+/, $b); + $b[$header->[2]] <=> $a[$header->[2]] + } @ps_aux; + } + else { + @ps_rows = @ps_aux; + } + @ps_rows = splice(@ps_rows,0,$count); + $j = scalar @ps_rows; + # if there's a count limit, for irc, etc, only use that much of the data + my $throttled = throttled($ps_count,$count); + push(@$rows,{ + main::key($num++,1,1,'CPU top') => "$count$throttled" . ' of ' . scalar @ps_aux + }); + my $i = 1; + foreach (@ps_rows){ + $num = 1; + $j = scalar @$rows; + my @row = split(/\s+/, $_); + my $command = process_starter( + scalar @row, + $row[$header->[0]], + $row[$header->[0] + 1] + ); + $cpu = (defined $header->[2]) ? $row[$header->[2]] . '%': 'N/A'; + push(@$rows,{ + main::key($num++,1,2,$i++) => '', + main::key($num++,0,3,'cpu') => $cpu, + main::key($num++,1,3,'command') => $command->[0], + }); + if ($command->[1]){ + $rows->[$j]{main::key($num++,0,4,'started-by')} = $command->[1]; + } + $pid = (defined $header->[1])? $row[$header->[1]] : 'N/A'; + $rows->[$j]{main::key($num++,0,3,'pid')} = $pid; + if ($extra > 0 && defined $header->[4]){ + my $decimals = ($row[$header->[4]]/1024 > 10) ? 1 : 2; + $mem = (defined $row[$header->[4]]) ? sprintf("%.${decimals}f", $row[$header->[4]]/1024) . ' MiB' : 'N/A'; + $mem .= ' (' . $row[$header->[3]] . '%)'; + $rows->[$j]{main::key($num++,0,3,'mem')} = $mem; + } + # print Data::Dumper::Dumper \@processes, "i: $i; j: $j "; + } + eval $end if $b_log; +} + +sub mem_processes { + eval $start if $b_log; + my $rows = $_[0]; + my ($j,$num,$cpu,$cpu_mem,$mem,$pid) = (0,0,'','','',''); + my (@data,$memory,@ps_rows); + my $count = ($b_irc)? 5 : $ps_count; + if (defined $header->[4]){ + @ps_rows = sort { + my @a = split(/\s+/, $a); + my @b = split(/\s+/, $b); + $b[$header->[4]] <=> $a[$header->[4]] + } @ps_aux; + } + else { + @ps_rows = @ps_aux; + } + @ps_rows = splice(@ps_rows,0,$count); + # print Data::Dumper::Dumper \@rows; + if (!$loaded{'memory'}){ + my $row = {}; + main::MemoryData::row('process',$row,\$num,1); + push(@$rows,$row); + $num = 0; + } + $j = scalar @$rows; + my $throttled = throttled($ps_count,$count); + push(@$rows, { + main::key($num++,1,1,'Memory top') => "$count$throttled" . ' of ' . scalar @ps_aux + }); + my $i = 1; + foreach (@ps_rows){ + $num = 1; + $j = scalar @$rows; + my @row = split(/\s+/, $_); + if (defined $header->[4]){ + my $decimals = ($row[$header->[4]]/1024 > 10) ? 1 : 2; + $mem = (main::is_int($row[$header->[4]])) ? + sprintf("%.${decimals}f", $row[$header->[4]]/1024) . ' MiB' : 'N/A'; + $mem .= " (" . $row[$header->[3]] . "%)"; + } + else { + $mem = 'N/A'; + } + my $command = process_starter(scalar @row, $row[$header->[0]],$row[$header->[0] + 1]); + push(@$rows,{ + main::key($num++,1,2,$i++) => '', + main::key($num++,0,3,'mem') => $mem, + main::key($num++,1,3,'command') => $command->[0], + }); + if ($command->[1]){ + $rows->[$j]{main::key($num++,0,4,'started-by')} = $command->[1]; + } + $pid = (defined $header->[1])? $row[$header->[1]] : 'N/A'; + $rows->[$j]{main::key($num++,0,3,'pid')} = $pid; + if ($extra > 0 && defined $header->[2]){ + $cpu = $row[$header->[2]] . '%'; + $rows->[$j]{main::key($num++,0,3,'cpu')} = $cpu; + } + # print Data::Dumper::Dumper \@processes, "i: $i; j: $j "; + } + eval $end if $b_log; +} + +sub process_starter { + my ($count, $row10, $row11) = @_; + my $return = []; + # note: [migration/0] would clear with a simple basename + if ($count > ($header->[0] + 1) && + $row11 =~ /^\// && $row11 !~ /^\/(tmp|temp)/){ + $row11 =~ s/^\/.*\///; + $return->[0] = $row11; + $row10 =~ s/^\/.*\///; + $return->[1] = $row10; + } + else { + $row10 =~ s/^\/.*\///; + $return->[0] = $row10; + $return->[1] = ''; + } + return $return; +} + +# args: 0: $ps_count; 1: $count +sub throttled { + return ($_[1] < $_[0]) ? " (throttled from $_[0])" : ''; +} +} + +## RaidItem ## +{ +package RaidItem; + +sub get { + eval $start if $b_log; + my ($hardware_raid,$key1,$val1); + my $num = 0; + my $rows = []; + $hardware_raid = hw_data() if $use{'hardware-raid'} || $fake{'raid-hw'}; + raid_data() if !$loaded{'raid'}; + # print 'get btrfs: ', Data::Dumper::Dumper \@btrfs_raid; + # print 'get lvm: ', Data::Dumper::Dumper \@lvm_raid; + # print 'get md: ', Data::Dumper::Dumper \@md_raid; + # print 'get zfs: ', Data::Dumper::Dumper \@zfs_raid; + if (!@btrfs_raid && !@lvm_raid && !@md_raid && !@zfs_raid && !@soft_raid && + !$hardware_raid){ + if ($show{'raid-forced'}){ + $key1 = 'Message'; + $val1 = main::message('raid-data'); + } + } + else { + if ($hardware_raid){ + hw_output($rows,$hardware_raid); + } + if (@btrfs_raid){ + btrfs_output($rows); + } + if (@lvm_raid){ + lvm_output($rows); + } + if (@md_raid){ + md_output($rows); + } + if (@soft_raid){ + soft_output($rows); + } + if (@zfs_raid){ + zfs_output($rows); + } + } + if (!@$rows && $key1){ + @$rows = ({main::key($num++,0,1,$key1) => $val1,}); + } + eval $end if $b_log; + return $rows; +} + +sub hw_output { + eval $start if $b_log; + my ($rows,$hardware_raid) = @_; + my ($j,$num) = (0,0); + foreach my $row (@$hardware_raid){ + $num = 1; + my $device = ($row->{'device'}) ? $row->{'device'}: 'N/A'; + my $driver = ($row->{'driver'}) ? $row->{'driver'}: 'N/A'; + push(@$rows, { + main::key($num++,1,1,'Hardware') => $device, + }); + $j = scalar @$rows - 1; + $rows->[$j]{main::key($num++,0,2,'vendor')} = $row->{'vendor'} if $row->{'vendor'}; + $rows->[$j]{main::key($num++,1,2,'driver')} = $driver; + if ($extra > 0){ + $row->{'driver-version'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'v')} = $row->{'driver-version'}; + if ($extra > 2){ + my $port= ($row->{'port'}) ? $row->{'port'}: 'N/A' ; + $rows->[$j]{main::key($num++,0,2,'port')} = $port; + } + my $bus_id = (defined $row->{'bus-id'} && defined $row->{'sub-id'}) ? "$row->{'bus-id'}.$row->{'sub-id'}": 'N/A' ; + $rows->[$j]{main::key($num++,0,2,'bus-ID')} = $bus_id; + } + if ($extra > 1){ + my $chip_id = main::get_chip_id($row->{'vendor-id'},$row->{'chip-id'}); + $rows->[$j]{main::key($num++,0,2,'chip-ID')} = $chip_id; + } + if ($extra > 2){ + $row->{'rev'} = 'N/A' if !defined $row->{'rev'}; # could be 0 + $rows->[$j]{main::key($num++,0,2,'rev')} = $row->{'rev'}; + $rows->[$j]{main::key($num++,0,2,'class-ID')} = $row->{'class-id'} if $row->{'class-id'}; + } + } + eval $end if $b_log; + # print Data::Dumper::Dumper $rows; +} + +sub btrfs_output { + eval $start if $b_log; + my $rows = $_[0]; + my (@components,@good); + my ($size); + my ($j,$num) = (0,0); + foreach my $row (sort {$a->{'id'} cmp $b->{'id'}} @btrfs_raid){ + $j = scalar @$rows; + $rows->[$j]{main::key($num++,1,2,'Components')} = ''; + my $b_bump; + components_output('lvm','Online',$rows,\@good,\$j,\$num,\$b_bump); + components_output('lvm','Meta',$rows,\@components,\$j,\$num,\$b_bump); + } + eval $end if $b_log; + # print Data::Dumper::Dumper $rows; +} + +sub lvm_output { + eval $start if $b_log; + my $rows = $_[0]; + my (@components,@good,@components_meta); + my ($size); + my ($j,$num) = (0,0); + foreach my $row (sort {$a->{'id'} cmp $b->{'id'}} @lvm_raid){ + $j = scalar @$rows; + push(@$rows, { + main::key($num++,1,1,'Device') => $row->{'id'}, + }); + if ($b_admin && $row->{'maj-min'}){ + $rows->[$j]{main::key($num++,0,2,'maj-min')} = $row->{'maj-min'}; + } + $rows->[$j]{main::key($num++,0,2,'type')} = $row->{'type'}; + $rows->[$j]{main::key($num++,0,2,'level')} = $row->{'level'}; + $size = ($row->{'size'}) ? main::get_size($row->{'size'},'string'): 'N/A'; + $rows->[$j]{main::key($num++,0,2,'size')} = $size; + if ($row->{'raid-sync'}){ + $rows->[$j]{main::key($num++,0,2,'sync')} = $row->{'raid-sync'}; + } + if ($extra > 0){ + $j = scalar @$rows; + $num = 1; + $rows->[$j]{main::key($num++,1,2,'Info')} = ''; + if (defined $row->{'stripes'}){ + $rows->[$j]{main::key($num++,0,3,'stripes')} = $row->{'stripes'}; + } + if (defined $row->{'raid-mismatches'} && ($extra > 1 || $row->{'raid-mismatches'} > 0)){ + $rows->[$j]{main::key($num++,0,3,'mismatches')} = $row->{'raid-mismatches'}; + } + if (defined $row->{'copy-percent'} && ($extra > 1 || $row->{'copy-percent'} < 100)){ + $rows->[$j]{main::key($num++,0,3,'copied')} = ($row->{'copy-percent'} + 0) . '%'; + } + if ($row->{'vg'}){ + $rows->[$j]{main::key($num++,1,3,'v-group')} = $row->{'vg'}; + } + $size = ($row->{'vg-size'}) ? main::get_size($row->{'vg-size'},'string') : 'N/A'; + $rows->[$j]{main::key($num++,0,4,'vg-size')} = $size; + $size = ($row->{'vg-free'}) ? main::get_size($row->{'vg-free'},'string') : 'N/A'; + $rows->[$j]{main::key($num++,0,4,'vg-free')} = $size; + } + @components = (ref $row->{'components'} eq 'ARRAY') ? @{$row->{'components'}} : (); + @good = (); + @components_meta = (); + foreach my $item (sort { $a->[0] cmp $b->[0]} @components){ + if ($item->[4] =~ /_rmeta/){ + push(@components_meta, $item); + } + else { + push(@good, $item); + } + } + $j = scalar @$rows; + $rows->[$j]{main::key($num++,1,2,'Components')} = ''; + my $b_bump; + components_output('lvm','Online',$rows,\@good,\$j,\$num,\$b_bump); + components_output('lvm','Meta',$rows,\@components_meta,\$j,\$num,\$b_bump); + } + eval $end if $b_log; + # print Data::Dumper::Dumper $rows; +} + +sub md_output { + eval $start if $b_log; + my $rows = $_[0]; + my (@components,@good,@failed,@inactive,@spare,@temp); + my ($blocks,$chunk,$level,$report,$size,$status); + my ($j,$num) = (0,0); + # print Data::Dumper::Dumper \@md_raid; + if ($extra > 2 && $md_raid[0]->{'supported-levels'}){ + push(@$rows, { + main::key($num++,0,1,'Supported mdraid levels') => $md_raid[0]->{'supported-levels'}, + }); + } + foreach my $row (sort {$a->{'id'} cmp $b->{'id'}} @md_raid){ + $j = scalar @$rows; + next if !%$row; + $num = 1; + $level = (defined $row->{'level'}) ? $row->{'level'} : 'linear'; + push(@$rows, { + main::key($num++,1,1,'Device') => $row->{'id'}, + }); + if ($b_admin && $row->{'maj-min'}){ + $rows->[$j]{main::key($num++,0,2,'maj-min')} = $row->{'maj-min'}; + } + $rows->[$j]{main::key($num++,0,2,'type')} = $row->{'type'}; + $rows->[$j]{main::key($num++,0,2,'level')} = $level; + $rows->[$j]{main::key($num++,0,2,'status')} = $row->{'status'}; + if ($row->{'details'}{'state'}){ + $rows->[$j]{main::key($num++,0,2,'state')} = $row->{'details'}{'state'}; + } + if ($row->{'size'}){ + $size = main::get_size($row->{'size'},'string'); + } + else { + $size = (!$b_root && !@lsblk) ? main::message('root-required'): 'N/A'; + } + $rows->[$j]{main::key($num++,0,2,'size')} = $size; + $report = ($row->{'report'}) ? $row->{'report'}: ''; + $report .= " $row->{'u-data'}" if $report; + $report ||= 'N/A'; + if ($extra == 0){ + # print "here 0\n"; + $rows->[$j]{main::key($num++,0,2,'report')} = $report; + } + if ($extra > 0){ + $j = scalar @$rows; + $num = 1; + $rows->[$j]{main::key($num++,1,2,'Info')} = ''; + #$rows->[$j]{main::key($num++,0,3,'raid')} = $raid; + $rows->[$j]{main::key($num++,0,3,'report')} = $report; + $blocks = ($row->{'blocks'}) ? $row->{'blocks'} : 'N/A'; + $rows->[$j]{main::key($num++,0,3,'blocks')} = $blocks; + $chunk = ($row->{'chunk-size'}) ? $row->{'chunk-size'} : 'N/A'; + $rows->[$j]{main::key($num++,0,3,'chunk-size')} = $chunk; + if ($extra > 1){ + if ($row->{'bitmap'}){ + $rows->[$j]{main::key($num++,0,3,'bitmap')} = $row->{'bitmap'}; + } + if ($row->{'super-block'}){ + $rows->[$j]{main::key($num++,0,3,'super-blocks')} = $row->{'super-block'}; + } + if ($row->{'algorithm'}){ + $rows->[$j]{main::key($num++,0,3,'algorithm')} = $row->{'algorithm'}; + } + } + } + @components = (ref $row->{'components'} eq 'ARRAY') ? @{$row->{'components'}} : (); + @good = (); + @failed = (); + @inactive = (); + @spare = (); + # @spare = split(/\s+/, $row->{'unused'}) if $row->{'unused'}; + # print Data::Dumper::Dumper \@components; + foreach my $item (sort { $a->[1] <=> $b->[1]} @components){ + if (defined $item->[2] && $item->[2] =~ /^(F)$/){ + push(@failed,$item); + } + elsif (defined $item->[2] && $item->[2] =~ /(S)$/){ + push(@spare,$item); + } + elsif ($row->{'status'} && $row->{'status'} eq 'inactive'){ + push(@inactive,$item); + } + else { + push(@good,$item); + } + } + $j = scalar @$rows; + $rows->[$j]{main::key($num++,1,2,'Components')} = ''; + my $b_bump; + components_output('mdraid','Online',$rows,\@good,\$j,\$num,\$b_bump); + components_output('mdraid','Failed',$rows,\@failed,\$j,\$num,\$b_bump); + components_output('mdraid','Inactive',$rows,\@inactive,\$j,\$num,\$b_bump); + components_output('mdraid','Spare',$rows,\@spare,\$j,\$num,\$b_bump); + if ($row->{'recovery-percent'}){ + $j = scalar @$rows; + $num = 1; + my $percent = $row->{'recovery-percent'}; + if ($extra > 1 && $row->{'progress-bar'}){ + $percent .= " $row->{'progress-bar'}" + } + $rows->[$j]{main::key($num++,1,2,'Recovering')} = $percent; + my $finish = ($row->{'recovery-finish'})?$row->{'recovery-finish'} : 'N/A'; + $rows->[$j]{main::key($num++,0,3,'time-remaining')} = $finish; + if ($extra > 0){ + if ($row->{'sectors-recovered'}){ + $rows->[$j]{main::key($num++,0,3,'sectors')} = $row->{'sectors-recovered'}; + } + } + if ($extra > 1 && $row->{'recovery-speed'}){ + $rows->[$j]{main::key($num++,0,3,'speed')} = $row->{'recovery-speed'}; + } + } + } + eval $end if $b_log; + # print Data::Dumper::Dumper $rows; +} + +sub soft_output { + eval $start if $b_log; + my $rows = $_[0]; + my (@components,@good,@failed,@offline,@rebuild,@temp); + my ($size); + my ($j,$num) = (0,0); + if (@soft_raid && $alerts{'bioctl'}->{'action'} eq 'permissions'){ + push(@$rows,{ + main::key($num++,1,1,'Message') => main::message('root-item-incomplete','softraid'), + }); + } + # print Data::Dumper::Dumper \@soft_raid; + foreach my $row (sort {$a->{'id'} cmp $b->{'id'}} @soft_raid){ + $j = scalar @$rows; + next if !%$row; + $num = 1; + push(@$rows, { + main::key($num++,1,1,'Device') => $row->{'id'}, + }); + $row->{'level'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'type')} = $row->{'type'}; + $rows->[$j]{main::key($num++,0,2,'level')} = $row->{'level'}; + $rows->[$j]{main::key($num++,0,2,'status')} = $row->{'status'}; + if ($row->{'state'}){ + $rows->[$j]{main::key($num++,0,2,'state')} = $row->{'state'}; + } + if ($row->{'size'}){ + $size = main::get_size($row->{'size'},'string'); + } + $size ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'size')} = $size; + @components = (ref $row->{'components'} eq 'ARRAY') ? @{$row->{'components'}} : (); + @good = (); + @failed = (); + @offline = (); + @rebuild = (); + foreach my $item (sort { $a->[1] <=> $b->[1]} @components){ + if (defined $item->[2] && $item->[2] eq 'failed'){ + push(@failed,$item); + } + elsif (defined $item->[2] && $item->[2] eq 'offline'){ + push(@offline,$item); + } + elsif (defined $item->[2] && $item->[2] eq 'rebuild'){ + push(@rebuild,$item); + } + else { + push(@good,$item); + } + } + $j = scalar @$rows; + $rows->[$j]{main::key($num++,1,2,'Components')} = ''; + my $b_bump; + components_output('softraid','Online',$rows,\@good,\$j,\$num,\$b_bump); + components_output('softraid','Failed',$rows,\@failed,\$j,\$num,\$b_bump); + components_output('softraid','Rebuild',$rows,\@rebuild,\$j,\$num,\$b_bump); + components_output('softraid','Offline',$rows,\@offline,\$j,\$num,\$b_bump); + } + eval $end if $b_log; + # print Data::Dumper::Dumper $rows; +} + +sub zfs_output { + eval $start if $b_log; + my $rows = $_[0]; + my (@arrays,@arrays_holder,@components,@good,@failed,@spare); + my ($allocated,$available,$level,$size,$status); + my ($b_row_1_sizes); + my ($j,$num) = (0,0); + # print Data::Dumper::Dumper \@zfs_raid; + foreach my $row (sort {$a->{'id'} cmp $b->{'id'}} @zfs_raid){ + $j = scalar @$rows; + $b_row_1_sizes = 0; + next if !%$row; + $num = 1; + push(@$rows, { + main::key($num++,1,1,'Device') => $row->{'id'}, + main::key($num++,0,2,'type') => $row->{'type'}, + main::key($num++,0,2,'status') => $row->{'status'}, + }); + $size = ($row->{'raw-size'}) ? main::get_size($row->{'raw-size'},'string') : ''; + $available = main::get_size($row->{'raw-free'},'string',''); # could be zero free + if ($extra > 2){ + $allocated = ($row->{'raw-allocated'}) ? main::get_size($row->{'raw-allocated'},'string') : ''; + } + @arrays = @{$row->{'arrays'}}; + @arrays = grep {defined $_} @arrays; + @arrays_holder = @arrays; + my $count = scalar @arrays; + if (!defined $arrays[0]->{'level'}){ + $level = 'linear'; + $rows->[$j]{main::key($num++,0,2,'level')} = $level; + } + elsif ($count < 2 && $arrays[0]->{'level'}){ + $rows->[$j]{main::key($num++,0,2,'level')} = $arrays[0]->{'level'}; + } + if ($size || $available || $allocated){ + $rows->[$j]{main::key($num++,1,2,'raw')} = ''; + if ($size){ + # print "here 0\n"; + $rows->[$j]{main::key($num++,0,3,'size')} = $size; + $size = ''; + $b_row_1_sizes = 1; + } + if ($available){ + $rows->[$j]{main::key($num++,0,3,'free')} = $available; + $available = ''; + $b_row_1_sizes = 1; + } + if ($allocated){ + $rows->[$j]{main::key($num++,0,3,'allocated')} = $allocated; + $allocated = ''; + } + } + if ($row->{'zfs-size'}){ + $rows->[$j]{main::key($num++,1,2,'zfs-fs')} = ''; + $rows->[$j]{main::key($num++,0,3,'size')} = main::get_size($row->{'zfs-size'},'string'); + $rows->[$j]{main::key($num++,0,3,'free')} = main::get_size($row->{'zfs-free'},'string'); + } + foreach my $row2 (@arrays){ + if ($count > 1){ + $j = scalar @$rows; + $num = 1; + $size = ($row2->{'raw-size'}) ? main::get_size($row2->{'raw-size'},'string') : 'N/A'; + $available = ($row2->{'raw-free'}) ? main::get_size($row2->{'raw-free'},'string') : 'N/A'; + $level = (defined $row2->{'level'}) ? $row2->{'level'}: 'linear'; + $status = ($row2->{'status'}) ? $row2->{'status'}: 'N/A'; + push(@$rows, { + main::key($num++,1,2,'Array') => $level, + main::key($num++,0,3,'status') => $status, + main::key($num++,1,3,'raw') => '', + main::key($num++,0,4,'size') => $size, + main::key($num++,0,4,'free') => $available, + }); + } + # items like cache may have one component, with a size on that component + elsif (!$b_row_1_sizes){ + # print "here $count\n"; + $size = ($row2->{'raw-size'}) ? main::get_size($row2->{'raw-size'},'string') : 'N/A'; + $available = ($row2->{'raw-free'}) ? main::get_size($row2->{'raw-free'},'string') : 'N/A'; + $rows->[$j]{main::key($num++,1,2,'raw')} = ''; + $rows->[$j]{main::key($num++,0,3,'size')} = $size; + $rows->[$j]{main::key($num++,0,3,'free')} = $available; + if ($extra > 2){ + $allocated = ($row2->{'raw-allocated'}) ? main::get_size($row2->{'raw-allocated'},'string') : ''; + if ($allocated){ + $rows->[$j]{main::key($num++,0,3,'allocated')} = $allocated; + } + } + } + @components = (ref $row2->{'components'} eq 'ARRAY') ? @{$row2->{'components'}} : (); + @failed = (); + @spare = (); + @good = (); + # @spare = split(/\s+/, $row->{'unused'}) if $row->{'unused'}; + foreach my $item (sort { $a->[0] cmp $b->[0]} @components){ + if (defined $item->[3] && $item->[3] =~ /^(DEGRADED|FAULTED|UNAVAIL)$/){ + push(@failed, $item); + } + elsif (defined $item->[3] && $item->[3] =~ /(AVAIL|OFFLINE|REMOVED)$/){ + push(@spare, $item); + } + # note: spares in use show: INUSE but technically it's still a spare, + # but since it's in use, consider it online. + else { + push(@good, $item); + } + } + $j = scalar @$rows; + $rows->[$j]{main::key($num++,1,3,'Components')} = ''; + my $b_bump; + components_output('zfs','Online',$rows,\@good,\$j,\$num,\$b_bump); + components_output('zfs','Failed',$rows,\@failed,\$j,\$num,\$b_bump); + components_output('zfs','Available',$rows,\@spare,\$j,\$num,\$b_bump); + } + } + eval $end if $b_log; + # print Data::Dumper::Dumper $rows; +} + +# Most key stuff passed by ref, and is changed on the fly +sub components_output { + eval $start if $b_log; + my ($type,$item,$rows,$array,$j,$num,$b_bump) = @_; + return if !@$array && $item ne 'Online'; + my ($extra1,$extra2,$f1,$f2,$f3,$f4,$f5,$k,$k1,$key1,$l1,$l2,$l3); + if ($type eq 'btrfs'){ + + } + elsif ($type eq 'lvm'){ + ($f1,$f2,$f3,$f4,$f5,$l1,$l2,$l3) = (1,2,3,4,5,3,4,5); + $k = 1; + $extra1 = 'mapped'; + $extra2 = 'dev'; + } + elsif ($type eq 'mdraid'){ + ($f1,$f2,$f3,$f4,$k1,$l1,$l2,$l3) = (3,4,5,6,1,3,4,5); + $extra1 = 'mapped'; + $k = 1 if $item eq 'Inactive'; + } + elsif ($type eq 'softraid'){ + ($f1,$f2,$f3,$f4,$k1,$l1,$l2,$l3) = (1,10,10,3,5,3,4,5); + $extra1 = 'device'; + $k = 1; + } + elsif ($type eq 'zfs'){ + ($f1,$f2,$f3,$l1,$l2,$l3) = (1,2,3,4,5,6); + $k = 1; + } + # print "item: $item\n"; + $$j++ if $$b_bump; + $$b_bump = 0; + my $good = ($item eq 'Online' && !@$array) ? 'N/A' : ''; + $rows->[$$j]{main::key($$num++,1,$l1,$item)} = $good; + #$$j++ if $b_admin; + # print Data::Dumper::Dumper $array; + foreach my $device (@$array){ + next if ref $device ne 'ARRAY'; + # if ($b_admin && $device->[$f1] && $device->[$f2]){ + if ($b_admin){ + $$j++; + $$b_bump = 1; + $$num = 1; + } + $key1 = (defined $k1 && defined $device->[$k1]) ? $device->[$k1] : $k++; + $rows->[$$j]{main::key($$num++,1,$l2,$key1)} = $device->[0]; + if ($b_admin && $device->[$f2]){ + $rows->[$$j]{main::key($$num++,0,$l3,'maj-min')} = $device->[$f2]; + } + if ($b_admin && $device->[$f1]){ + my $size = main::get_size($device->[$f1],'string'); + $rows->[$$j]{main::key($$num++,0,$l3,'size')} = $size; + } + if ($b_admin && $device->[$f3]){ + $rows->[$$j]{main::key($$num++,0,$l3,'state')} = $device->[$f3]; + } + if ($b_admin && $extra1 && $device->[$f4]){ + $rows->[$$j]{main::key($$num++,0,$l3,$extra1)} = $device->[$f4]; + } + if ($b_admin && $extra2 && $device->[$f5]){ + $rows->[$$j]{main::key($$num++,0,$l3,$extra2)} = $device->[$f5]; + } + } + eval $end if $b_log; +} + +sub raid_data { + eval $start if $b_log; + LsblkData::set() if !$bsd_type && !$loaded{'lsblk'}; + main::set_mapper() if !$bsd_type && !$loaded{'mapper'}; + PartitionData::set() if !$bsd_type && !$loaded{'partition-data'}; + my (@data); + $loaded{'raid'} = 1; + if ($fake{'raid-btrfs'} || + ($alerts{'btrfs'}->{'action'} && $alerts{'btrfs'}->{'action'} eq 'use')){ + @btrfs_raid = btrfs_data(); + } + if ($fake{'raid-lvm'} || + ($alerts{'lvs'}->{'action'} && $alerts{'lvs'}->{'action'} eq 'use')){ + @lvm_raid = lvm_data(); + } + if ($fake{'raid-md'} || (my $file = $system_files{'proc-mdstat'})){ + @md_raid = md_data($file); + } + if ($fake{'raid-soft'} || $sysctl{'softraid'}){ + DiskDataBSD::set() if !$loaded{'disk-data-bsd'}; + @soft_raid = soft_data(); + } + if ($fake{'raid-zfs'} || (my $path = main::check_program('zpool'))){ + DiskDataBSD::set() if $bsd_type && !$loaded{'disk-data-bsd'}; + @zfs_raid = zfs_data($path); + } + eval $end if $b_log; +} + +# 0: type +# 1: type_id +# 2: bus_id +# 3: sub_id +# 4: device +# 5: vendor_id +# 6: chip_id +# 7: rev +# 8: port +# 9: driver +# 10: modules +sub hw_data { + eval $start if $b_log; + return if !$devices{'hwraid'}; + my ($driver,$vendor,$hardware_raid); + foreach my $working (@{$devices{'hwraid'}}){ + $driver = ($working->[9]) ? lc($working->[9]): ''; + $driver =~ s/-/_/g if $driver; + my $driver_version = ($driver) ? main::get_module_version($driver): ''; + if ($extra > 2 && $use{'pci-tool'} && $working->[11]){ + $vendor = main::get_pci_vendor($working->[4],$working->[11]); + } + push(@$hardware_raid, { + 'class-id' => $working->[1], + 'bus-id' => $working->[2], + 'chip-id' => $working->[6], + 'device' => $working->[4], + 'driver' => $driver, + 'driver-version' => $driver_version, + 'port' => $working->[8], + 'rev' => $working->[7], + 'sub-id' => $working->[3], + 'vendor-id' => $working->[5], + 'vendor' => $vendor, + }); + } + # print Data::Dumper::Dumper $hardware_raid; + main::log_data('dump','@$hardware_raid',$hardware_raid) if $b_log; + eval $end if $b_log; + return $hardware_raid; +} + +# Placeholder, if they ever get useful tools +sub btrfs_data { + eval $start if $b_log; + my (@btraid,@working); + if ($fake{'raid-btrfs'}){ + + } + else { + + } + print Data::Dumper::Dumper \@working if $dbg[37]; + print Data::Dumper::Dumper \@btraid if $dbg[37]; + main::log_data('dump','@lvraid',\@btraid) if $b_log; + eval $end if $b_log; + return @btraid; +} + +sub lvm_data { + eval $start if $b_log; + LogicalItem::lvm_data() if !$loaded{'logical-data'}; + return if !@lvm; + my (@lvraid,$maj_min,$vg_used,@working); + foreach my $item (@lvm){ + next if $item->{'segtype'} && $item->{'segtype'} !~ /^raid/; + my (@components,$dev,$maj_min,$vg_used); + # print Data::Dumper::Dumper $item; + if ($item->{'lv_kernel_major'} . ':' . $item->{'lv_kernel_minor'}){ + $maj_min = $item->{'lv_kernel_major'} . ':' . $item->{'lv_kernel_minor'}; + } + if (defined $item->{'vg_free'} && defined $item->{'vg_size'}){ + $vg_used = ($item->{'vg_size'} - $item->{'vg_free'}); + } + $raw_logical[0] += $item->{'lv_size'} if $item->{'lv_size'}; + @working = main::globber("/sys/dev/block/$maj_min/slaves/*") if $maj_min; + @working = map {$_ =~ s|^/.*/||; $_;} @working if @working; + foreach my $part (@working){ + my ($dev,$maj_min,$mapped,$size); + if (@proc_partitions){ + my $info = PartitionData::get($part); + $maj_min = $info->[0] . ':' . $info->[1] if defined $info->[1]; + $size = $info->[2]; + $raw_logical[1] += $size if $part =~ /^dm-/ && $size; + my @data = main::globber("/sys/dev/block/$maj_min/slaves/*") if $maj_min; + @data = map {$_ =~ s|^/.*/||; $_;} @data if @data; + $dev = join(',', @data) if @data; + } + $mapped = $dmmapper{$part} if %dmmapper; + push(@components, [$part,$size,$maj_min,undef,$mapped,$dev],); + } + if ($item->{'segtype'}){ + if ($item->{'segtype'} eq 'raid1'){$item->{'segtype'} = 'mirror';} + else {$item->{'segtype'} =~ s/^raid([0-9]+)/raid-$1/;} + } + push(@lvraid, { + 'components' => \@components, + 'copy-percent' => $item->{'copy_percent'}, + 'id' => $item->{'lv_name'}, + 'level' => $item->{'segtype'}, + 'maj-min' => $maj_min, + 'raid-mismatches' => $item->{'raid_mismatch_count'}, + 'raid-sync' => $item->{'raid_sync_action'}, + 'size' => $item->{'lv_size'}, + 'stripes' => $item->{'stripes'}, + 'type' => $item->{'vg_fmt'}, + 'vg' => $item->{'vg_name'}, + 'vg-free' => $item->{'vg_free'}, + 'vg-size' => $item->{'vg_size'}, + 'vg-used' => $vg_used, + }); + } + print Data::Dumper::Dumper \@lvraid if $dbg[37]; + main::log_data('dump','@lvraid',\@lvraid) if $b_log; + eval $end if $b_log; + return @lvraid; +} + +sub md_data { + eval $start if $b_log; + my ($mdstat) = @_; + my $j = 0; + if ($fake{'raid-md'}){ + #$mdstat = "$fake_data_dir/raid-logical/md/md-4-device-1.txt"; + #$mdstat = "$fake_data_dir/raid-logical/md/md-rebuild-1.txt"; + #$mdstat = "$fake_data_dir/raid-logical/md/md-2-mirror-fserver2-1.txt"; + #$mdstat = "$fake_data_dir/raid-logical/md/md-2-raid10-abucodonosor.txt"; + #$mdstat = "$fake_data_dir/raid-logical/md/md-2-raid10-ant.txt"; + #$mdstat = "$fake_data_dir/raid-logical/md/md-inactive-weird-syntax.txt"; + #$mdstat = "$fake_data_dir/raid-logical/md/md-inactive-active-syntax.txt"; + #$mdstat = "$fake_data_dir/raid-logical/md/md-inactive-active-spare-syntax.txt"; + } + my @working = main::reader($mdstat,'strip'); + # print Data::Dumper::Dumper \@working; + my (@mdraid,@temp,$b_found,$system,$unused); + # NOTE: a system with empty mdstat will not show these values + if ($working[0] && $working[0] =~ /^Personalities/){ + $system = (split(/:\s*/, $working[0]))[1]; + $system =~ s/\[|\]//g if $system; + shift @working; + } + if ($working[-1] && $working[-1] =~ /^unused\sdevices/){ + $unused = (split(/:\s*/, $working[-1]))[1]; + $unused =~ s/<|>|none//g if $unused; + pop @working; + } + foreach (@working){ + $_ =~ s/\s*:\s*/:/; + # print "$_\n"; + # md0 : active raid1 sdb1[2] sda1[0] + # md126 : active (auto-read-only) raid1 sdq1[0] + # md127 : inactive sda0 + # md1 : inactive sda1[0] sdd1[3] sdc1[2] sdb1[1] + # if (/^(md[0-9]+)\s*:\s*([^\s]+)(\s\([^)]+\))?\s([^\s]+)\s(.*)/){ + if (/^(md[0-9]+)\s*:\s*([\S]+)(\s\([^)]+\))?/){ + my ($component_string,$details,$device,$id,$level,$maj_min,$part,$size,$status); + my (@components); + $id = $1; + $status = $2; + if (/^(md[0-9]+)\s*:\s*([\S]+)(\s\([^)]+\))?\s((faulty|linear|multipath|raid)[\S]*)\s(.*)/){ + $level = $4; + $component_string = $6; + $level =~ s/^raid1$/mirror/; + $level =~ s/^raid/raid-/; + $level = 'mirror' if $level eq '1'; + } + elsif (/^(md[0-9]+)\s*:\s*([\S]+)(\s\([^)]+\))?\s(.*)/){ + $component_string = $4; + $level = 'N/A'; + } + @temp = (); + # cascade of tests, light to cpu intense + if ((!$maj_min || !$size) && @proc_partitions){ + $part = PartitionData::get($id); + if (@$part){ + $maj_min = $part->[0] . ':' . $part->[1]; + $size = $part->[2]; + } + } + if ((!$maj_min || !$size) && @lsblk){ + $device = LsblkData::get($id) if @lsblk; + $maj_min = $device->{'maj-min'} if $device->{'maj-min'}; + $size = $device->{'size'} if $device->{'size'}; + } + if ((!$size || $b_admin) && $alerts{'mdadm'}->{'action'} eq 'use'){ + $details = md_details($id); + $size = $details->{'size'} if $details->{'size'}; + } + $raw_logical[0] += $size if $size; + # remember, these include the [x] id, so remove that for disk/unmounted + foreach my $component (split(/\s+/, $component_string)){ + my (%data,$maj_min,$name,$number,$info,$mapped,$part_size,$state); + if ($component =~ /([\S]+)\[([0-9]+)\]\(?([SF])?\)?/){ + ($name,$number,$info) = ($1,$2,$3); + } + elsif ($component =~ /([\S]+)/){ + $name = $1; + } + next if !$name; + if ($details->{'devices'} && ref $details->{'devices'} eq 'HASH'){ + $maj_min = $details->{'devices'}{$name}{'maj-min'}; + $state = $details->{'devices'}{$name}{'state'}; + } + if ((!$maj_min || !$part_size) && @proc_partitions){ + $part = PartitionData::get($name); + if (@$part){ + $maj_min = $part->[0] . ':' . $part->[1] if !$maj_min; + $part_size = $part->[2] if !$part_size; + } + } + if ((!$maj_min || !$part_size) && @lsblk){ + %data= LsblkData::get($name); + $maj_min = $data{'maj-min'} if !$maj_min; + $part_size = $data{'size'}if !$part_size; + } + $mapped = $dmmapper{$name} if %dmmapper; + $raw_logical[1] += $part_size if $part_size; + $state = $info if !$state && $info; + push(@components,[$name,$number,$info,$part_size,$maj_min,$state,$mapped]); + } + # print "$component_string\n"; + $j = scalar @mdraid; + push(@mdraid, { + 'chunk-size' => $details->{'chunk-size'}, # if we got it, great, if not, further down + 'components' => \@components, + 'details' => $details, + 'id' => $id, + 'level' => $level, + 'maj-min' => $maj_min, + 'size' => $size, + 'status' => $status, + 'type' => 'mdraid', + }); + } + # print "$_\n"; + if ($_ =~ /^([0-9]+)\sblocks/){ + $mdraid[$j]->{'blocks'} = $1; + } + if ($_ =~ /super\s([0-9\.]+)\s/){ + $mdraid[$j]->{'super-block'} = $1; + } + if ($_ =~ /algorithm\s([0-9\.]+)\s/){ + $mdraid[$j]->{'algorithm'} = $1; + } + if ($_ =~ /\[([0-9]+\/[0-9]+)\]\s\[([U_]+)\]/){ + $mdraid[$j]->{'report'} = $1; + $mdraid[$j]->{'u-data'} = $2; + } + if ($_ =~ /resync=([\S]+)/){ + $mdraid[$j]->{'resync'} = $1; + } + if ($_ =~ /([0-9]+[km])\schunk/i){ + $mdraid[$j]->{'chunk-size'} = $1; + } + if ($_ =~ /(\[[=]*>[\.]*\]).*(resync|recovery)\s*=\s*([0-9\.]+%)?(\s\(([0-9\/]+)\))?/){ + $mdraid[$j]->{'progress-bar'} = $1; + $mdraid[$j]->{'recovery-percent'} = $3 if $3; + $mdraid[$j]->{'sectors-recovered'} = $5 if $5; + } + if ($_ =~ /finish\s*=\s*([\S]+)\s+speed\s*=\s*([\S]+)/){ + $mdraid[$j]->{'recovery-finish'} = $1; + $mdraid[$j]->{'recovery-speed'} = $2; + } + # print 'mdraid loop: ', Data::Dumper::Dumper \@mdraid; + } + if (@mdraid){ + $mdraid[0]->{'supported-levels'} = $system if $system; + $mdraid[0]->{'unused'} = $unused if $unused; + } + print Data::Dumper::Dumper \@mdraid if $dbg[37]; + eval $end if $b_log; + return @mdraid; +} + +sub md_details { + eval $start if $b_log; + my ($id) = @_; + my (@working); + my $details = {}; + my $cmd = $alerts{'mdadm'}->{'path'} . " --detail /dev/$id 2>/dev/null"; + my @data = main::grabber($cmd,'','strip'); + main::log_data('dump',"$id raw: \@data",\@data) if $b_log; + foreach (@data){ + @working = split(/\s*:\s*/, $_, 2); + if (scalar @working == 2){ + if ($working[0] eq 'Array Size' && $working[1] =~ /^([0-9]+)\s\(/){ + $details->{'size'} = $1; + } + elsif ($working[0] eq 'Active Devices'){ + $details->{'c-active'} = $working[1]; + } + elsif ($working[0] eq 'Chunk Size'){ + $details->{'chunk-size'} = $working[1]; + } + elsif ($working[0] eq 'Failed Devices'){ + $details->{'c-failed'} = $working[1]; + } + elsif ($working[0] eq 'Raid Devices'){ + $details->{'c-raid'} = $working[1]; + } + elsif ($working[0] eq 'Spare Devices'){ + $details->{'c-spare'} = $working[1]; + } + elsif ($working[0] eq 'State'){ + $details->{'state'} = $working[1]; + } + elsif ($working[0] eq 'Total Devices'){ + $details->{'c-total'} = $working[1]; + } + elsif ($working[0] eq 'Used Dev Size' && $working[1] =~ /^([0-9]+)\s\(/){ + $details->{'dev-size'} = $1; + } + elsif ($working[0] eq 'UUID'){ + $details->{'uuid'} = $working[1]; + } + elsif ($working[0] eq 'Working Devices'){ + $details->{'c-working'} = $working[1]; + } + } + # end component data lines + else { + @working = split(/\s+/,$_); + # 0 8 80 0 active sync /dev/sdf + # 2 8 128 - spare /dev/sdi + next if !@working || $working[0] eq 'Number' || scalar @working < 6; + $working[-1] =~ s|^/dev/(mapper/)?||; + $details->{'devices'}{$working[-1]} = { + 'maj-min' => $working[1] . ':' . $working[2], + 'number' => $working[0], + 'raid-device' => $working[3], + 'state' => join(' ', @working[4..($#working - 1)]), + }; + } + } + # print Data::Dumper::Dumper $details; + main::log_data('dump',$id . ': %$details',$details) if $b_log; + eval $end if $b_log; + return $details; +} + +sub soft_data { + eval $start if $b_log; + my ($cmd,$id,$state,$status,@data,@softraid,@working); + # already been set in DiskDataBSD but we know the device exists + foreach my $device (@{$sysctl{'softraid'}}){ + if ($device =~ /\.drive[\d]+:([\S]+)\s\(([a-z0-9]+)\)[,\s]+(\S+)/){ + my ($level,$size,@components); + $id = $2; + $status = $1; + $state = $3; + if ($alerts{'bioctl'}->{'action'} eq 'use'){ + $cmd = $alerts{'bioctl'}->{'path'} . " $id 2>/dev/null"; + @data = main::grabber($cmd,'','strip'); + main::log_data('dump','softraid @data',\@data) if $b_log; + shift @data if @data; # get rid of headers + foreach my $row (@data){ + @working = split(/\s+/,$row); + next if !defined $working[0]; + if ($working[0] =~ /^softraid/){ + if ($working[3] && main::is_numeric($working[3])){ + $size = $working[3]/1024;# it's in bytes + $raw_logical[0] += $size; + } + $status = lc($working[2]) if $working[2]; + $state = lc(join(' ', @working[6..$#working])) if $working[6]; + $level = lc($working[5]) if $working[5]; + } + elsif ($working[0] =~ /^[\d]{1,2}$/){ + my ($c_id,$c_device,$c_size,$c_status); + if ($working[2] && main::is_numeric($working[2])){ + $c_size = $working[2]/1024;# it's in bytes + $raw_logical[1] += $c_size; + } + $c_status = lc($working[1]) if $working[1]; + if ($working[3] && $working[3] =~ /^([\d:\.]+)$/){ + $c_device = $1; + } + if ($working[5] && $working[5] =~ /<([^>]+)>/){ + $c_id = $1; + } + # when offline, there will be no $c_id, but we want to show device + if (!$c_id && $c_device){ + $c_id = $c_device; + } + push(@components,[$c_id,$c_size,$c_status,$c_device]) if $c_id; + } + } + } + push(@softraid, { + 'components' => \@components, + 'id' => $id, + 'level' => $level, + 'size' => $size, + 'state' => $state, + 'status' => $status, + 'type' => 'softraid', + }); + } + } + print Data::Dumper::Dumper \@softraid if $dbg[37]; + main::log_data('dump','@softraid',\@softraid) if $b_log; + eval $end if $b_log; + return @softraid; +} + +sub zfs_data { + eval $start if $b_log; + my ($zpool) = @_; + my (@data,@zfs); + my ($allocated,$free,$size,$size_holder,$status,$zfs_used,$zfs_avail, + $zfs_size); + my $b_v = 1; + my ($i,$j,$k) = (0,0,0); + if ($fake{'raid-zfs'}){ + my $file; + # $file = "$fake_data_dir/raid-logical/zfs/zpool-list-1-mirror-main-solestar.txt"; + # $file = "$fake_data_dir/raid-logical/zfs/zpool-list-2-mirror-main-solestar.txt"; + # $file = "$fake_data_dir/raid-logical/zfs/zpool-list-v-tank-1.txt"; + # $file = "$fake_data_dir/raid-logical/zfs/zpool-list-v-gojev-1.txt"; + # $file = "$fake_data_dir/raid-logical/zfs/zpool-list-v-w-spares-1.txt"; + $file = "$fake_data_dir/raid-logical/zfs/zpool-list-v-freebsd-linear-1.txt"; + @data = main::reader($file);$zpool = ''; + } + else { + @data = main::grabber("$zpool list -v 2>/dev/null"); + } + # bsd sed does not support inserting a true \n so use this trick + # some zfs does not have -v + if (!@data){ + @data = main::grabber("$zpool list 2>/dev/null"); + $b_v = 0; + } + my $zfs_path = main::check_program('zfs'); + # print 'zpool @data: ', Data::Dumper::Dumper \@data; + main::log_data('dump','@data',\@data) if $b_log; + if (!@data){ + main::log_data('data','no zpool list data') if $b_log; + eval $end if $b_log; + return (); + } + my ($status_i) = (0); + # NAME SIZE ALLOC FREE EXPANDSZ FRAG CAP DEDUP HEALTH ALTROOT + my $test = shift @data; # get rid of first header line + if ($test){ + foreach (split(/\s+/, $test)){ + last if $_ eq 'HEALTH'; + $status_i++; + } + } + foreach (@data){ + my @row = split(/\s+/, $_); + if (/^[\S]+/){ + $i = 0; + $size = ($row[1] && $row[1] ne '-') ? main::translate_size($row[1]): ''; + $allocated = ($row[2] && $row[2] ne '-')? main::translate_size($row[2]): ''; + $free = ($row[3] && $row[3] ne '-')? main::translate_size($row[3]): ''; + ($zfs_used,$zfs_avail) = zfs_fs_sizes($zfs_path,$row[0]) if $zfs_path; + if (defined $zfs_used && defined $zfs_avail){ + $zfs_size = $zfs_used + $zfs_avail; + $raw_logical[0] += $zfs_size; + } + else { + # must be BEFORE '$size_holder =' because only used if hits a new device + # AND unassigned via raid/mirror arrays. Corner case for > 1 device systems. + $raw_logical[0] += $size_holder if $size_holder; + $size_holder = $size; + } + $status = (defined $row[$status_i] && $row[$status_i] ne '') ? $row[$status_i]: 'no-status'; + $j = scalar @zfs; + push(@zfs, { + 'id' => $row[0], + 'arrays' => ([],), + 'raw-allocated' => $allocated, + 'raw-free' => $free, + 'raw-size' => $size, + 'zfs-free' => $zfs_avail, + 'zfs-size' => $zfs_size, + 'status' => $status, + 'type' => 'zfs', + }); + } + # print Data::Dumper::Dumper \@zfs; + # raid level is the second item in the output, unless it is not, sometimes it is absent + elsif ($row[1] =~ /raid|mirror/){ + $row[1] =~ s/^raid1/mirror/; + #$row[1] =~ s/^raid/raid-/; # need to match in zpool status + $k = scalar @{$zfs[$j]->{'arrays'}}; + $zfs[$j]->{'arrays'}[$k]{'level'} = $row[1]; + $i = 0; + $size = ($row[2] && $row[2] ne '-') ? main::translate_size($row[2]) : ''; + if (!defined $zfs_used || !defined $zfs_avail){ + $size_holder = 0; + $raw_logical[0] += $size if $size; + } + $zfs[$j]->{'arrays'}[$k]{'raw-allocated'} = ($row[3] && $row[3] ne '-') ? main::translate_size($row[3]) : ''; + $zfs[$j]->{'arrays'}[$k]{'raw-free'} = ($row[4] && $row[4] ne '-') ? main::translate_size($row[4]) : ''; + $zfs[$j]->{'arrays'}[$k]{'raw-size'} = $size; + } + # https://blogs.oracle.com/eschrock/entry/zfs_hot_spares + elsif ($row[1] =~ /spares?/){ + next; + } + # A member of a raid array: + # ada2 - - - - - - + # A single device not in an array: + # ada0s2 25.9G 14.6G 11.3G - 0% 56% + # gptid/3838f796-5c46-11e6-a931-d05099ac4dc2 - - - - - - + # A single device not in an array: + # ada0p4 5G 3.88G 633M - - 49% 86.3% - ONLINE + # Using /dev/disk/by-id: + # ata-VBOX_HARDDISK_VB5b6350cd-06618d58 + # Using /dev/disk/by-partuuid: + # ec399377-c03c-e844-a876-8c8b044124b8 - - - - - - ONLINE + # Spare in use: + # /home/fred/zvol/hdd-2-3 - - - - - - - - INUSE + elsif ($row[1] =~ /^(sd[a-z]+|[a-z0-9]+[0-9]+|([\S]+)\/.*|(ata|mmc|nvme|pci|scsi|wwn)-\S+|[a-f0-9]{4,}(-[a-f0-9]{4,}){3,})$/ && + ($row[2] eq '-' || $row[2] =~ /^[0-9\.]+[MGTPE]$/)){ + shift @row if !$row[0]; # get rid of empty first column + # print Data::Dumper::Dumper \@row; + # print 'status-i: ', $row[$status_i], ' row0: ', $row[0], "\n"; + my ($maj_min,$real,$part_size,$state,$working); + #print "r1:$row[1]",' :: ', Cwd::abs_path('/dev/disk/by-id/'.$row[1]), "\n"; + if ($row[0] =~ /^(sd[a-z]+|[a-z0-9]+[0-9]+|([\S]+)\/.*|(ata|mmc|nvme|pci|scsi|wwn)-\S+|[a-f0-9]{4,}(-[a-f0-9]{4,}){3,})$/){ + $working = $1; # note: the negative case can never happen + } + # We only care about non ONLINE states for components + if ($status_i && $row[$status_i] && + $row[$status_i] =~ /^(DEGRADED|FAULTED|INUSE|OFFLINE)$/){ + $state = $1; + } + if ($bsd_type){ + if ($working =~ /[\S]+\//){ + my $temp = GlabelData::get($working); + $working = $temp if $temp; + } + } + elsif (!$bsd_type){ + if ($row[0] =~ /^(ata|mmc|nvme|scsi|wwn)-/ && + -e "/dev/disk/by-id/$row[0]" && ($real = Cwd::abs_path('/dev/disk/by-id/'.$row[0]))){ + $real =~ s|/dev/||; + $working = $real; + } + elsif ($row[0] =~ /^(pci)-/ && + -e "/dev/disk/by-path/$row[0]" && ($real = Cwd::abs_path('/dev/disk/by-path/'.$row[0]))){ + $real =~ s|/dev/||; + $working = $real; + } + elsif ($row[0] =~ /^[a-f0-9]{4,}(-[a-f0-9]{4,}){3,}$/ && + -e "/dev/disk/by-partuuid/$row[0]" && ($real = Cwd::abs_path('/dev/disk/by-partuuid/'.$row[0]))){ + $real =~ s|/dev/||; + $working = $real; + } + } + # kind of a hack, things like cache may not show size/free + # data since they have no array row, but they might show it in + # component row: + # ada0s2 25.9G 19.6G 6.25G - 0% 75% + # ec399377-c03c-e844-a876-8c8b044124b8 1.88G 397M 1.49G - - 0% 20.7% - ONLINE + # keys were size/allocated/free but those keys don't exist, assume failed to add raw- + if (!$zfs[$j]->{'raw-size'} && $row[1] && $row[1] ne '-'){ + $size = ($row[1]) ? main::translate_size($row[1]): ''; + $size_holder = 0; + $zfs[$j]->{'arrays'}[$k]{'raw-size'} = $size; + $raw_logical[0] += $size if $size; + } + if (!$zfs[$j]->{'raw-allocated'} && $row[2] && $row[2] ne '-'){ + $allocated = ($row[2]) ? main::translate_size($row[2]) : ''; + $zfs[$j]->{'arrays'}[$k]{'raw-allocated'} = $allocated; + } + if (!$zfs[$j]->{'raw-free'} && $row[3] && $row[3] ne '-'){ + $free = ($row[3]) ? main::translate_size($row[3]) : ''; + $zfs[$j]->{'arrays'}[$k]{'raw-free'} = $free; + } + if ((!$maj_min || !$part_size) && $working && @proc_partitions){ + my $part = PartitionData::get($working); + if (@$part){ + $maj_min = $part->[0] . ':' . $part->[1]; + $part_size = $part->[2]; + } + } + if ((!$maj_min || !$part_size) && $working && @lsblk){ + my $data= LsblkData::get($working); + $maj_min = $data->{'maj-min'}; + $part_size = $data->{'size'}; + } + if (!$part_size && $bsd_type && $working){ + my $temp = DiskDataBSD::get($working); + $part_size = $temp->{'size'} if $temp->{'size'}; + } + # with linear zfs, can show full partition size data + if (!$part_size && $working && $row[1] && $row[1] ne '-'){ + $part_size = main::translate_size($row[1]); + } + $raw_logical[1] += $part_size if $part_size; + $zfs[$j]->{'arrays'}[$k]{'components'}[$i] = [$working,$part_size,$maj_min,$state]; + $i++; + } + } + $raw_logical[0] += $size_holder if $size_holder; + # print Data::Dumper::Dumper \@zfs; + # clear out undefined arrrays values + $j = 0; + foreach my $row (@zfs){ + my @arrays = (ref $row->{'arrays'} eq 'ARRAY') ? @{$row->{'arrays'}} : (); + @arrays = grep {defined $_} @arrays; + $zfs[$j]->{'arrays'} = \@arrays; + $j++; + } + @zfs = zfs_status($zpool,\@zfs); + print Data::Dumper::Dumper \@zfs if $dbg[37]; + eval $end if $b_log; + return @zfs; +} + +sub zfs_fs_sizes { + my ($path,$id) = @_; + eval $start if $b_log; + my @data; + my @result = main::grabber("$path list -pH $id 2>/dev/null",'','strip'); + main::log_data('dump','zfs list @result',\@result) if $b_log; + print Data::Dumper::Dumper \@result if $dbg[37]; + # some zfs devices do not have zfs data, lake spare storage devices + if (@result){ + my @working = split(/\s+/,$result[0]); + $data[0] = $working[1]/1024 if $working[1]; + $data[1] = $working[2]/1024 if $working[2]; + } + elsif ($b_log || $dbg[37]) { + @result = main::grabber("$path list -pH $id 2>&1",'','strip'); + main::log_data('dump','zfs list w/error @result',\@result) if $b_log; + print '@result w/error: ', Data::Dumper::Dumper \@result if $dbg[37]; + } + eval $end if $b_log; + return @data; +} + +sub zfs_status { + eval $start if $b_log; + my ($zpool,$zfs) = @_; + my ($cmd,$level,$status,@pool_status,@temp); + my ($i,$j,$k,$l) = (0,0,0,0); + foreach my $row (@$zfs){ + $i = 0; + $k = 0; + if ($fake{'raid-zfs'}){ + my $file; + # $file = "$fake_data_dir/raid-logical/zfs/zpool-status-1-mirror-main-solestar.txt"; + # $file = "$fake_data_dir/raid-logical/zfs/zpool-status-2-mirror-main-solestar.txt"; + # $file = "$fake_data_dir/raid-logical/zfs/zpool-status-tank-1.txt"; + #@pool_status = main::reader($file,'strip'); + } + else { + $cmd = "$zpool status $row->{'id'} 2>/dev/null"; + @pool_status = main::grabber($cmd,"\n",'strip'); + } + main::log_data('cmd',$cmd) if $b_log; + # @arrays = (ref $row->{'arrays'} eq 'ARRAY') ? @{$row->{'arrays'}} : (); + # print "$row->{'id'} rs:$row->{'status'}\n"; + $status = ($row->{'status'} && $row->{'status'} eq 'no-status') ? check_zfs_status($row->{'id'},\@pool_status): $row->{'status'}; + $zfs->[$j]{'status'} = $status if $status; + #@arrays = grep {defined $_} @arrays; + # print "$row->{id} $#arrays\n"; + # print Data::Dumper::Dumper \@arrays; + foreach my $array (@{$row->{'arrays'}}){ + # print 'ref: ', ref $array, "\n"; + #next if ref $array ne 'HASH'; + my @components = (ref $array->{'components'} eq 'ARRAY') ? @{$array->{'components'}} : (); + $l = 0; + # zpool status: mirror-0 ONLINE 2 0 0 + $level = ($array->{'level'}) ? "$array->{'level'}-$i": $array->{'level'}; + $status = ($level) ? check_zfs_status($level,\@pool_status): ''; + $zfs->[$j]{'arrays'}[$k]{'status'} = $status; + # print "$level i:$i j:$j k:$k $status\n"; + foreach my $component (@components){ + my @temp = split('~', $component); + $status = ($temp[0]) ? check_zfs_status($temp[0],\@pool_status): ''; + $zfs->[$j]{'arrays'}[$k]{'components'}[$l] .= $status if $status; + $l++; + } + $k++; + # haven't seen a raid5/6 type array yet, zfs uses z1,z2,and z3 + $i++ if $array->{'level'}; # && $array->{'level'} eq 'mirror'; + } + $j++; + } + eval $end if $b_log; + return @$zfs; +} + +sub check_zfs_status { + eval $start if $b_log; + my ($item,$pool_status) = @_; + my ($status) = (''); + foreach (@$pool_status){ + my @temp = split(/\s+/, $_); + if ($temp[0] eq $item){ + last if !$temp[1]; + $status = $temp[1]; + last; + } + } + eval $end if $b_log; + return $status; +} +} + +## RamItem ## +{ +package RamItem; +my ($speed_maps,$vendors,$vendor_ids); +my $ram_total = 0; +sub get { + my ($key1,$val1); + my ($ram,$rows) = ([],[]); + my $num = 0; + if ($bsd_type && !$force{'dmidecode'} && ($dboot{'ram'} || $fake{'dboot'})){ + dboot_data($ram); + if (@$ram){ + ram_output($rows,$ram,'dboot'); + } + else { + $key1 = 'message'; + $val1 = main::message('ram-data-dmidecode'); + push(@$rows, { + main::key($num++,1,1,'RAM Report') => '', + main::key($num++,0,2,$key1) => $val1, + }); + } + } + elsif (!$fake{'udevadm'} && !$force{'udevadm'} && ($fake{'dmidecode'} || + $alerts{'dmidecode'}->{'action'} eq 'use')){ + dmidecode_data($ram); + if (@$ram){ + ram_output($rows,$ram,'dmidecode'); + } + else { + $key1 = 'message'; + $val1 = main::message('ram-data','dmidecode'); + push(@$rows, { + main::key($num++,1,1,'RAM Report') => '', + main::key($num++,0,2,$key1) => $val1, + }); + } + } + elsif ($fake{'udevadm'} || $alerts{'udevadm'}->{'action'} eq 'use'){ + udevadm_data($ram); + if (@$ram){ + ram_output($rows,$ram,'udevadm'); + } + else { + $key1 = 'message'; + my ($n,$v) = ProgramData::full('udevadm'); # v will be null/numeric start + $v =~ s/^(\d+)([^\d].*)?/$1/ if $v; + if ($v && $v < 249){ + $val1 = main::message('ram-udevadm-version',$v); + } + else { + $val1 = main::message('ram-data','udevadm'); + } + push(@$rows, { + main::key($num++,1,1,'RAM Report') => '', + main::key($num++,0,2,$key1) => $val1, + }); + } + } + if (!$key1 && !@$ram) { + $key1 = $alerts{'dmidecode'}->{'action'}; + $val1 = $alerts{'dmidecode'}->{'message'}; + push(@$rows, { + main::key($num++,1,1,'RAM Report') => '', + main::key($num++,0,2,$key1) => $val1, + }); + } + # we want the real installed RAM total if detected so add this after. + if (!$loaded{'memory'}){ + $num = 0; + my $system_ram = {}; + MemoryData::row('ram',$system_ram,\$num,1); + unshift(@$rows,$system_ram); + } + ($vendors,$vendor_ids) = (); + eval $end if $b_log; + return $rows; +} + +sub ram_total { + return $ram_total; +} + +sub ram_output { + eval $start if $b_log; + my ($rows,$ram,$source) = @_; + return if !@$ram; + my $num = 0; + my $j = 0; + my $arrays = {}; + set_arrays_data($ram,$arrays); + my ($b_non_system); + if ($source eq 'dboot'){ + push(@$rows, { + main::key($num++,0,1,'Message') => main::message('ram-data-complete'), + }); + } + # really only volts are inaccurate, possibly configured speed? Servers have + # very poor data quality, so always show for udevadm and high slot counts + # don't need t show for risc since if not dmi data, not running ram_output() + if (!$show{'ram-short'} && $source eq 'udevadm' && + ($extra > 1 || ($arrays->{'slots'} && $arrays->{'slots'} > 4))){ + my $message; + if (!$b_root){ + $message = main::message('ram-udevadm'); + } + elsif ($b_root && $alerts{'dmidecode'}->{'action'} eq 'missing'){ + $message = main::message('ram-udevadm-root'); + } + if ($message){ + push(@$rows, { + main::key($num++,1,1,'Message') => $message, + }); + } + } + if (scalar @$ram > 1 || $show{'ram-short'}){ + arrays_output($rows,$ram,$arrays); + if ($show{'ram-short'}){ + eval $end if $b_log; + return 0; + } + } + foreach my $item (@$ram){ + $j = scalar @$rows; + $num = 1; + $b_non_system = ($item->{'use'} && lc($item->{'use'}) ne 'system memory') ? 1: 0; + push(@$rows, { + main::key($num++,1,1,'Array') => '', + main::key($num++,1,2,'capacity') => process_size($item->{'capacity'}), + }); + if ($item->{'cap-qualifier'}){ + $rows->[$j]{main::key($num++,0,3,'note')} = $item->{'cap-qualifier'}; + } + # show if > 1 array otherwise shows in System RAM line. + if (scalar @$ram > 1){ + $rows->[$j]{main::key($num++,0,2,'installed')} = process_size($item->{'used-capacity'}); + } + $rows->[$j]{main::key($num++,0,2,'use')} = $item->{'use'} if $b_non_system; + $rows->[$j]{main::key($num++,1,2,'slots')} = $item->{'slots'}; + if ($item->{'slots-qualifier'}){ + $rows->[$j]{main::key($num++,0,3,'note')} = $item->{'slots-qualifier'}; + } + $rows->[$j]{main::key($num++,0,2,'modules')} = $item->{'slots-active'}; + $item->{'eec'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'EC')} = $item->{'eec'}; + if ($extra > 0 && (!$b_non_system || + (main::is_numeric($item->{'max-module-size'}) && + $item->{'max-module-size'} > 10))){ + $rows->[$j]{main::key($num++,1,2,'max-module-size')} = process_size($item->{'max-module-size'}); + if ($item->{'mod-qualifier'}){ + $rows->[$j]{main::key($num++,0,3,'note')} = $item->{'mod-qualifier'}; + } + } + if ($extra > 1 && $item->{'voltage'}){ + $rows->[$j]{main::key($num++,0,2,'voltage')} = $item->{'voltage'}; + } + foreach my $entry ($item->{'modules'}){ + next if ref $entry ne 'ARRAY'; + # print Data::Dumper::Dumper $entry; + foreach my $mod (@$entry){ + $num = 1; + $j = scalar @$rows; + # Multi array setups will start index at next from previous array + next if ref $mod ne 'HASH'; + next if ($show{'ram-modules'} && $mod->{'size'} =~ /\D/); + $mod->{'locator'} ||= 'N/A'; + push(@$rows, { + main::key($num++,1,2,'Device') => $mod->{'locator'}, + }); + # This will contain the no module string + if ($mod->{'size'} =~ /\D/){ + $rows->[$j]{main::key($num++,0,3,'type')} = lc($mod->{'size'}); + next; + } + if ($extra > 1 && $mod->{'type'}){ + $rows->[$j]{main::key($num++,0,3,'info')} = $mod->{'type'}; + } + $mod->{'device-type'} ||= 'N/A'; + $rows->[$j]{main::key($num++,1,3,'type')} = $mod->{'device-type'}; + if ($extra > 2 && $mod->{'device-type'} ne 'N/A'){ + $mod->{'device-type-detail'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,4,'detail')} = $mod->{'device-type-detail'}; + } + $rows->[$j]{main::key($num++,0,3,'size')} = process_size($mod->{'size'}); + if ($mod->{'speed'} && $mod->{'configured-clock-speed'} && + $mod->{'speed'} ne $mod->{'configured-clock-speed'}){ + $rows->[$j]{main::key($num++,1,3,'speed')} = ''; + $rows->[$j]{main::key($num++,0,4,'spec')} = $mod->{'speed'}; + if ($mod->{'speed-note'}){ + $rows->[$j]{main::key($num++,0,4,'note')} = $mod->{'speed-note'}; + } + $rows->[$j]{main::key($num++,0,4,'actual')} = $mod->{'configured-clock-speed'}; + if ($mod->{'configured-note'}){ + $rows->[$j]{main::key($num++,0,5,'note')} = $mod->{'configured-note'}; + } + } + else { + if (!$mod->{'speed'} && $mod->{'configured-clock-speed'}){ + if ($mod->{'configured-clock-speed'}){ + $mod->{'speed'} = $mod->{'configured-clock-speed'}; + if ($mod->{'configured-note'}){ + $mod->{'speed-note'} = $mod->{'configured-note'}; + } + } + } + # Rare instances, dmi type 6, no speed, dboot also no speed + $mod->{'speed'} ||= 'N/A'; + $rows->[$j]{main::key($num++,1,3,'speed')} = $mod->{'speed'}; + if ($mod->{'speed-note'}){ + $rows->[$j]{main::key($num++,0,4,'note')} = $mod->{'speed-note'}; + } + } + # Handle cases where -xx or -xxx and no voltage data (common) or voltages + # are all the same. + if ($extra > 1){ + if (($mod->{'voltage-config'} || $mod->{'voltage-max'} || + $mod->{'voltage-min'}) && ($b_admin || ( + ($mod->{'voltage-config'} && $mod->{'voltage-max'} && + $mod->{'voltage-config'} ne $mod->{'voltage-max'}) || + ($mod->{'voltage-config'} && $mod->{'voltage-min'} && + $mod->{'voltage-config'} ne $mod->{'voltage-min'}) || + ($mod->{'voltage-min'} && $mod->{'voltage-max'} && + $mod->{'voltage-max'} ne $mod->{'voltage-min'}) + ))){ + $rows->[$j]{main::key($num++,1,3,'volts')} = ''; + if ($mod->{'voltage-note'}){ + $rows->[$j]{main::key($num++,0,4,'note')} = $mod->{'voltage-note'}; + } + if ($mod->{'voltage-config'}){ + $rows->[$j]{main::key($num++,0,4,'curr')} = $mod->{'voltage-config'}; + } + if ($mod->{'voltage-min'}){ + $rows->[$j]{main::key($num++,0,4,'min')} = $mod->{'voltage-min'}; + } + if ($mod->{'voltage-max'}){ + $rows->[$j]{main::key($num++,0,4,'max')} = $mod->{'voltage-max'}; + } + } + else { + $mod->{'voltage-config'} ||= 'N/A'; + $rows->[$j]{main::key($num++,1,3,'volts')} = $mod->{'voltage-config'}; + if ($mod->{'voltage-note'}){ + $rows->[$j]{main::key($num++,0,4,'note')} = $mod->{'voltage-note'}; + } + } + } + if ($source ne 'dboot'){ + if ($extra > 2){ + if (!$mod->{'data-width'} && !$mod->{'total-width'}){ + $rows->[$j]{main::key($num++,0,3,'width')} = 'N/A'; + } + else { + $rows->[$j]{main::key($num++,1,3,'width (bits)')} = ''; + $mod->{'data-width'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,4,'data')} = $mod->{'data-width'}; + $mod->{'total-width'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,4,'total')} = $mod->{'total-width'}; + } + } + if ($extra > 1){ + $mod->{'manufacturer'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'manufacturer')} = $mod->{'manufacturer'}; + $mod->{'part-number'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,3,'part-no')} = $mod->{'part-number'}; + } + if ($b_admin && $mod->{'firmware'}){ + $rows->[$j]{main::key($num++,0,3,'firmware')} = $mod->{'firmware'}; + } + if ($extra > 2){ + $mod->{'serial'} = main::filter($mod->{'serial'}); + $rows->[$j]{main::key($num++,0,3,'serial')} = $mod->{'serial'}; + } + } + } + } + } + eval $end if $b_log; +} + +# args: 0: $rows ref; 1: $ram ref; +sub arrays_output { + eval $end if $b_log; + my ($rows,$ram,$arrays) = @_; + my $num = 1; + $arrays->{'arrays'} ||= 'N/A'; + $arrays->{'capacity'} ||= 'N/A'; + $arrays->{'used-capacity'} ||= 'N/A'; + $arrays->{'eec'} ||= 'N/A'; + $arrays->{'slots'} ||= 'N/A'; + $arrays->{'slots-active'} ||= 'N/A'; + $arrays->{'device-type'} ||= 'N/A'; + push(@$rows, { + main::key($num++,1,1,'Report') => '', + main::key($num++,1,2,'arrays') => $arrays->{'arrays'}, + main::key($num++,1,2,'capacity') => process_size($arrays->{'capacity'}), + main::key($num++,0,3,'installed') => process_size($arrays->{'used-capacity'}), + main::key($num++,1,2,'slots') => $arrays->{'slots'}, + main::key($num++,0,3,'active') => $arrays->{'slots-active'}, + main::key($num++,0,2,'type') => $arrays->{'device-type'}, + main::key($num++,0,2,'eec') => $arrays->{'eec'}, + }); + eval $end if $b_log; +} + +sub set_arrays_data { + my ($ram,$arrays) = @_; + $arrays->{'arrays'} = 0; + $arrays->{'capacity'} = 0; + $arrays->{'used-capacity'} = 0; + $arrays->{'slots'} = 0; + $arrays->{'slots-active'} = 0; + foreach my $array (@$ram){ + $arrays->{'arrays'}++; + $arrays->{'capacity'} += $array->{'capacity'} if $array->{'capacity'}; + $arrays->{'used-capacity'} += $array->{'used-capacity'} if $array->{'used-capacity'}; + $arrays->{'eec'} = $array->{'eec'} if !$arrays->{'eec'} && $array->{'eec'}; + $arrays->{'slots'} += $array->{'slots'} if $array->{'slots'}; + $arrays->{'slots-active'} += $array->{'slots-active'} if $array->{'slots-active'}; + $arrays->{'device-type'} = $array->{'device-type'} if !$arrays->{'device-type'} && $array->{'device-type'}; + } +} + +# args: 0: $ram ref; +sub dboot_data { + eval $start if $b_log; + my $ram = $_[0]; + my $est = main::message('note-est'); + my ($arr,$derived_module_size,$subtract) = (0,0,0); + my ($holder,@slots_active); + foreach (@{$dboot{'ram'}}){ + my ($addr,$detail,$device_detail,$ecc,$iic,$locator,$size,$speed,$type); + # Note: seen a netbsd with multiline spdmem0/1 etc but not consistent, don't use + if (/^(spdmem([\d]+)):at iic([\d]+)(\saddr 0x([0-9a-f]+))?/){ + $iic = $3; + $locator = $1; + $holder = $iic if !defined $holder; # prime for first use + # Note: seen iic2 as only device + if ($iic != $holder){ + if ($ram->[$arr] && $ram->[$arr]{'slots-16'}){ + $subtract += $ram->[$arr]{'slots-16'}; + } + $holder = $iic; + # Then since we are on a new iic device, assume new ram array. + # This needs more data to confirm this guess. + $arr++; + $slots_active[$arr] = 0; + } + if ($5){ + $addr = hex($5); + } + if (/(non?[\s-]parity)/i){ + $device_detail = $1; + $ecc = 'None'; + } + elsif (/EEC/i){ + $device_detail = 'EEC'; + $ecc = 'EEC'; + } + # Possible: PC2700CL2.5 PC3-10600 + if (/\b(PC([2-9]?-|)\d{4,})[^\d]/){ + $speed = $1; + $speed =~ s/PC/PC-/ if $speed =~ /^PC\d{4}/; + my $temp = speed_mapper($speed); + if ($temp ne $speed){ + $detail = $speed; + $speed = $temp; + } + } + # We want to avoid netbsd trying to complete @ram without real data. + if (/:(\d+[MGT])B?\s(DDR[0-9]*)\b/){ + $size = main::translate_size($1); # mbfix: /1024 + $type = $2; + if ($addr){ + $ram->[$arr]{'slots-16'} = $addr - 80 + 1 - $subtract; + $locator = 'Slot-' . $ram->[$arr]{'slots-16'}; + } + $slots_active[$arr]++; + $derived_module_size = $size if $size > $derived_module_size; + $ram->[$arr]{'derived-module-size'} = $derived_module_size; + $ram->[$arr]{'device-count-found'}++; + $ram->[$arr]{'eec'} = $ecc if !$ram->[$arr]{'eec'} && $ecc; + # Build up actual capacity found for override tests + $ram->[$arr]{'max-capacity-16'} += $size; + $ram->[$arr]{'max-cap-qualifier'} = $est; + $ram->[$arr]{'slots-16'}++ if !$addr; + $ram->[$arr]{'slots-active'} = $slots_active[$arr]; + $ram->[$arr]{'slots-qualifier'} = $est; + $ram->[$arr]{'type'} = $type; + $ram->[$arr]{'used-capacity'} += $size; + if (!$ram->[$arr]{'device-type'} && $type){ + $ram->[$arr]{'device-type'} = $type; + } + push(@{$ram->[$arr]{'modules'}},{ + 'device-type' => $type, + 'device-type-detail' => $detail, + 'locator' => $locator, + 'size' => $size, + 'speed' => $speed, + }); + } + } + } + for (my $i = 0; $i++ ;scalar @$ram){ + next if ref $ram->[$i] ne 'HASH'; + # 1 slot is possible, but 3 is very unlikely due to dual channel ddr + if ($ram->[$i]{'slots'} && $ram->[$i]{'slots'} > 2 && $ram->[$i]{'slots'} % 2 == 1){ + $ram->[$i]{'slots'}++; + } + } + print 'dboot pre process_data: ', Data::Dumper::Dumper $ram if $dbg[36]; + main::log_data('dump','@$ram',$ram) if $b_log; + process_data($ram) if @$ram; + main::log_data('dump','@$ram',$ram) if $b_log; + print 'dboot post process_data: ', Data::Dumper::Dumper $ram if $dbg[36]; + eval $end if $b_log; +} + +# args: 0: $ram ref; +sub dmidecode_data { + eval $start if $b_log; + my $ram = $_[0]; + my ($b_5,$handle,@slots_active,@temp); + my ($derived_module_size,$max_cap_5,$max_cap_16,$max_module_size) = (0,0,0,0); + my ($i,$j,$k) = (0,0,0); + my $check = main::message('note-check'); + # print Data::Dumper::Dumper \@dmi; + foreach my $entry (@dmi){ + ## Note: do NOT reset these values, that causes failures + # ($derived_module_size,$max_cap_5,$max_cap_16,$max_module_size) = (0,0,0,0); + if ($entry->[0] == 5){ + $slots_active[$k] = 0; + foreach my $item (@$entry){ + @temp = split(/:\s*/, $item, 2); + next if !$temp[1]; + if ($temp[0] eq 'Maximum Memory Module Size'){ + $max_module_size = calculate_size($temp[1],$max_module_size); + $ram->[$k]{'max-module-size'} = $max_module_size; + } + elsif ($temp[0] eq 'Maximum Total Memory Size'){ + $max_cap_5 = calculate_size($temp[1],$max_cap_5); + $ram->[$k]{'max-capacity-5'} = $max_cap_5; + } + elsif ($temp[0] eq 'Memory Module Voltage'){ + $temp[1] =~ s/\s*V.*$//; # seen: 5.0 V 3.3 V + $ram->[$k]{'voltage'} = $temp[1]; + } + elsif ($temp[0] eq 'Associated Memory Slots'){ + $ram->[$k]{'slots-5'} = $temp[1]; + } + elsif ($temp[0] eq 'Error Detecting Method'){ + $temp[1] ||= 'None'; + $ram->[$k]{'eec'} = $temp[1] if !$ram->[$k]{'eec'} && $temp[1]; + } + } + $ram->[$k]{'modules'} = []; + # print Data::Dumper::Dumper \@ram; + $b_5 = 1; + } + elsif ($entry->[0] == 6){ + my ($size,$speed,$type) = (0,0,0); + my ($bank_locator,$device_type,$locator,$main_locator) = ('','','',''); + foreach my $item (@$entry){ + @temp = split(/:\s*/, $item, 2); + next if !$temp[1]; + if ($temp[0] eq 'Installed Size'){ + # Get module size + $size = calculate_size($temp[1],0); + # Using this causes issues, really only works for 16 + # if ($size =~ /^[0-9][0-9]+$/){ + # $ram->[$k]{'device-count-found'}++; + # $ram->[$k]{'used-capacity'} += $size; + # } + # Get data after module size + $temp[1] =~ s/ Connection\)?//; + $temp[1] =~ s/^[0-9]+\s*[KkMGTP]B\s*\(?//; + $type = lc($temp[1]); + $slots_active[$k]++; + } + elsif ($temp[0] eq 'Current Speed'){ + $speed = main::clean_dmi($temp[1]); + } + elsif ($temp[0] eq 'Locator' || $temp[0] eq 'Socket Designation'){ + $temp[1] =~ s/D?RAM slot #?/Slot/i; # can be with or without # + $locator = $temp[1]; + } + elsif ($temp[0] eq 'Bank Locator'){ + $bank_locator = $temp[1]; + } + elsif ($temp[0] eq 'Type'){ + $device_type = main::clean_dmi($temp[1]); + } + } + # Because of the wide range of bank/slot type data, we will just use + # the one that seems most likely to be right. Some have: + # 'Bank: SO DIMM 0 slot: J6A' so we dump the useless data and use the + # one most likely to be visibly correct + if ($bank_locator =~ /DIMM/){ + $main_locator = $bank_locator; + } + else { + $main_locator = $locator; + } + $ram->[$k]{'modules'}[$j] = { + 'slots-active' => $slots_active[$k], + 'device-type' => $device_type, + 'locator' => $main_locator, + 'size' => $size, + 'speed' => $speed, + 'type' => $type, + }; + if (!$ram->[$k]{'device-type'} && $device_type){ + $ram->[$k]{'device-type'} = $device_type; + } + # print Data::Dumper::Dumper \@ram; + $j++; + } + elsif ($entry->[0] == 16){ + $handle = $entry->[1]; + $ram->[$handle] = $ram->[$k] if $ram->[$k]; + $ram->[$k] = undef; + $slots_active[$handle] = 0; + # ($derived_module_size,$max_cap_16) = (0,0); + foreach my $item (@$entry){ + @temp = split(/:\s*/, $item, 2); + next if !$temp[1]; + if ($temp[0] eq 'Maximum Capacity'){ + $max_cap_16 = calculate_size($temp[1],$max_cap_16); + $ram->[$handle]{'max-capacity-16'} = $max_cap_16; + } + # Note: these 3 have cleaned data in DmiData, so replace stuff manually + elsif ($temp[0] eq 'Location'){ + $temp[1] =~ s/\sOr\sMotherboard//; + $temp[1] ||= 'System Board'; + $ram->[$handle]{'location'} = $temp[1]; + } + elsif ($temp[0] eq 'Use'){ + $temp[1] ||= 'System Memory'; + $ram->[$handle]{'use'} = $temp[1]; + } + elsif ($temp[0] eq 'Error Correction Type'){ + # seen + if ($temp[1] && lc($temp[1]) ne 'none'){ + $temp[1] = main::clean_dmi($temp[1]); + } + $temp[1] ||= 'None'; + if (!$ram->[$handle]{'eec'} && $temp[1]){ + $ram->[$handle]{'eec'} = $temp[1]; + } + } + elsif ($temp[0] eq 'Number Of Devices'){ + $ram->[$handle]{'slots-16'} = $temp[1]; + } + # print "0: $temp[0]\n"; + } + $ram->[$handle]{'derived-module-size'} = 0; + $ram->[$handle]{'device-count-found'} = 0; + $ram->[$handle]{'used-capacity'} = 0; + # print "s16: $ram->[$handle]{'slots-16'}\n"; + } + elsif ($entry->[0] == 17){ + my ($bank_locator,$configured_speed,$configured_note, + $data_width) = ('','','',''); + my ($device_type,$device_type_detail,$firmware,$form_factor,$locator, + $main_locator) = ('','','','','',''); + my ($manufacturer,$vendor_id,$part_number,$serial,$speed,$speed_note, + $total_width) = ('','','','','','',''); + my ($voltage_config,$voltage_max,$voltage_min); + my ($device_size,$i_data,$i_total,$working_size) = (0,0,0,0); + foreach my $item (@$entry){ + @temp = split(/:\s*/, $item, 2); + next if !$temp[1]; + if ($temp[0] eq 'Array Handle'){ + $handle = hex($temp[1]); + } + # These two can have 'none' or 'unknown' value + elsif ($temp[0] eq 'Data Width'){ + $data_width = main::clean_dmi($temp[1]); + $data_width =~ s/[\s_-]?bits// if $data_width; + } + elsif ($temp[0] eq 'Total Width'){ + $total_width = main::clean_dmi($temp[1]); + $total_width =~ s/[\s_-]?bits// if $total_width; + } + # Do not try to guess from installed modules, only use this to correct + # type 5 data + elsif ($temp[0] eq 'Size'){ + # we want any non real size data to be preserved + if ($temp[1] =~ /^[0-9]+\s*[KkMTPG]i?B/){ + $derived_module_size = calculate_size($temp[1],$derived_module_size); + $working_size = calculate_size($temp[1],0); + $device_size = $working_size; + $slots_active[$handle]++; + } + else { + $device_size = ($temp[1] =~ /no module/i) ? main::message('ram-no-module') : $temp[1]; + } + } + elsif ($temp[0] eq 'Locator'){ + $temp[1] =~ s/D?RAM slot #?/Slot/i; + $locator = $temp[1]; + } + elsif ($temp[0] eq 'Bank Locator'){ + $bank_locator = $temp[1]; + } + elsif ($temp[0] eq 'Form Factor'){ + $form_factor = $temp[1]; + } + # these two can have 'none' or 'unknown' value + elsif ($temp[0] eq 'Type'){ + $device_type = main::clean_dmi($temp[1]); + } + elsif ($temp[0] eq 'Type Detail'){ + $device_type_detail = main::clean_dmi($temp[1]); + } + elsif ($temp[0] eq 'Speed'){ + my ($working,$unit); + $temp[1] = main::clean_dmi($temp[1]); + if ($temp[1] && $temp[1] =~ /^(\d+)\s*([GM]\S+)/){ + $working = $1; + $unit = $2; + my $result = process_speed($unit,$working,$device_type,$check); + ($speed,$speed_note) = @$result; + } + else { + $speed = $temp[1]; + } + } + # This is the actual speed the system booted at, speed is hardcoded + # clock speed means MHz, memory speed MT/S + elsif ($temp[0] eq 'Configured Clock Speed' || + $temp[0] eq 'Configured Memory Speed'){ + my ($working,$unit); + $temp[1] = main::clean_dmi($temp[1]); + if ($temp[1] && $temp[1] =~ /^(\d+)\s*([GM]\S+)/){ + $working = $1; + $unit = $2; + my $result = process_speed($unit,$working,$device_type,$check); + ($configured_speed,$configured_note) = @$result; + } + else { + $speed = $temp[1]; + } + } + elsif ($temp[0] eq 'Firmware Version'){ + $temp[1] = main::clean_dmi($temp[1]); + $firmware = $temp[1]; + } + elsif ($temp[0] eq 'Manufacturer'){ + $temp[1] = main::clean_dmi($temp[1]); + $manufacturer = $temp[1]; + } + elsif ($temp[0] eq 'Part Number'){ + $part_number = main::clean_unset($temp[1],'^[0]+$|.*Module.*|PartNum.*'); + } + elsif ($temp[0] eq 'Serial Number'){ + $serial = main::clean_unset($temp[1],'^[0]+$|SerNum.*'); + } + elsif ($temp[0] eq 'Configured Voltage'){ + if ($temp[1] =~ /^([\d\.]+)/){ + $voltage_config = $1; + } + } + elsif ($temp[0] eq 'Maximum Voltage'){ + if ($temp[1] =~ /^([\d\.]+)/){ + $voltage_max = $1; + } + } + elsif ($temp[0] eq 'Minimum Voltage'){ + if ($temp[1] =~ /^([\d\.]+)/){ + $voltage_min = $1; + } + } + } + # locator data is not great or super reliable, so do our best + $main_locator = process_locator($locator,$bank_locator); + if ($working_size =~ /^[0-9][0-9]+$/){ + $ram->[$handle]{'device-count-found'}++; + # build up actual capacity found for override tests + $ram->[$handle]{'used-capacity'} += $working_size; + } + # Sometimes the data is just wrong, they reverse total/data. data I + # believe is used for the actual memory bus width, total is some synthetic + # thing, sometimes missing. Note that we do not want a regular string + # comparison, because 128 bit memory buses are in our future, and + # 128 bits < 64 bits with string compare. + $data_width =~ /(^[0-9]+).*/; + $i_data = $1; + $total_width =~ /(^[0-9]+).*/; + $i_total = $1; + if ($i_data && $i_total && $i_data > $i_total){ + my $temp_width = $data_width; + $data_width = $total_width; + $total_width = $temp_width; + } + ($manufacturer,$vendor_id,$part_number) = process_manufacturer( + $manufacturer,$part_number); + if (!$ram->[$handle]{'device-type'} && $device_type){ + $ram->[$handle]{'device-type'} = $device_type; + } + $ram->[$handle]{'derived-module-size'} = $derived_module_size; + $ram->[$handle]{'slots-active'} = $slots_active[$handle]; + $ram->[$handle]{'modules'}[$i]{'configured-clock-speed'} = $configured_speed; + $ram->[$handle]{'modules'}[$i]{'configured-note'} = $configured_note if $configured_note; + $ram->[$handle]{'modules'}[$i]{'data-width'} = $data_width; + $ram->[$handle]{'modules'}[$i]{'size'} = $device_size; + $ram->[$handle]{'modules'}[$i]{'device-type'} = $device_type; + $ram->[$handle]{'modules'}[$i]{'device-type-detail'} = lc($device_type_detail); + $ram->[$handle]{'modules'}[$i]{'firmware'} = $firmware; + $ram->[$handle]{'modules'}[$i]{'form-factor'} = $form_factor; + $ram->[$handle]{'modules'}[$i]{'locator'} = $main_locator; + $ram->[$handle]{'modules'}[$i]{'manufacturer'} = $manufacturer; + $ram->[$handle]{'modules'}[$i]{'vendor-id'} = $vendor_id; + $ram->[$handle]{'modules'}[$i]{'part-number'} = $part_number; + $ram->[$handle]{'modules'}[$i]{'serial'} = $serial; + $ram->[$handle]{'modules'}[$i]{'speed'} = $speed; + $ram->[$handle]{'modules'}[$i]{'speed-note'} = $speed_note if $speed_note; + $ram->[$handle]{'modules'}[$i]{'total-width'} = $total_width; + $ram->[$handle]{'modules'}[$i]{'voltage-config'} = $voltage_config; + $ram->[$handle]{'modules'}[$i]{'voltage-max'} = $voltage_max; + $ram->[$handle]{'modules'}[$i]{'voltage-min'} = $voltage_min; + $i++ + } + elsif ($entry->[0] < 17){ + next; + } + elsif ($entry->[0] > 17){ + last; + } + } + print 'dmidecode pre process_data: ', Data::Dumper::Dumper $ram if $dbg[36]; + main::log_data('dump','pre @$ram',$ram) if $b_log; + process_data($ram) if @$ram; + main::log_data('dump','post @$ram',$ram) if $b_log; + print 'dmidecode post process_data: ', Data::Dumper::Dumper $ram if $dbg[36]; + eval $end if $b_log; +} + +# this contains a subset of dmi RAM data generated I believe at boot +# args: 0: $ram ref; +sub udevadm_data { + eval $start if $b_log; + my $ram = $_[0]; + my ($b_arr_nu,$b_arr_set,$d_holder,@data,$key,@temp); + my ($a,$i) = (0,0); + my %array_ids; + if ($fake{'udevadm'}){ + my $file; + # $file = "$fake_data_dir/ram/udevadm/udevadm-dmi-1-array-2-slot-1.txt"; + # $file = "$fake_data_dir/ram/udevadm/udevadm-dmi-1-array-2-slot-2-barebones.txt"; + # $file = "$fake_data_dir/ram/udevadm/udevadm-dmi-1-array-2-slot-3-errors.txt"; + # $file = "$fake_data_dir/ram/udevadm/udevadm-dmi-1-array-4-slot-1.txt"; + # $file = "$fake_data_dir/ram/udevadm/udevadm-dmi-1-array-4-slot-2-volts.txt"; + # $file = "$fake_data_dir/ram/udevadm/udevadm-dmi-1-array-16-slot-1.txt"; + # $file = "$fake_data_dir/ram/udevadm/udevadm-dmi-1-array-16-slot-2.txt"; + $file = "$fake_data_dir/ram/udevadm/udevadm-dmi-2-array-24-slot-1.txt"; + # $file = "$fake_data_dir/ram/udevadm/udevadm-dmi-4-array-12-slot-1.txt"; + @data = main::reader($file,'strip'); + } + else { + my $cmd = $alerts{'udevadm'}->{'path'} . ' info -p /devices/virtual/dmi/id 2>/dev/null'; + @data = main::grabber($cmd,'','strip'); + } + if (@data){ + @data = map {s/^\S: //;$_ if /^MEMORY/;} @data; + # unknown if > 1 array output possible, do not sort in case they just stack it + @data = grep {/^ME/} @data; + } + main::log_data('dump','@data',\@data) if $b_log; + print Data::Dumper::Dumper \@data if $dbg[36]; + foreach my $line (@data){ + @temp = split(/=/,$line,2); + # there should be array numbering at least, but there isn't, not yet anyway + if ($temp[0] =~ /^MEMORY_ARRAY_((\d+)_)?(\S+)/){ + $key = $3; + if ($2){ + $b_arr_nu = 1; + $a = $2; + } + # this _should_ be first item, hoping > 1 arrays is stacked in order + if ($key eq 'LOCATION'){ + $temp[1] =~ s/\sOr\sMotherboard//; + $temp[1] ||= 'System Board'; + $a++ if !$b_arr_nu && $b_arr_set; + $ram->[$a]{'location'} = $temp[1]; + $b_arr_set = 1; + } + elsif ($key eq 'EC_TYPE'){ + if ($temp[1] && lc($temp[1]) ne 'none'){ + $temp[1] = main::clean_dmi($temp[1]); # seen + } + $temp[1] ||= 'None'; + if (!$ram->[$a]{'eec'} && $temp[1]){ + $ram->[$a]{'eec'} = $temp[1]; + } + } + elsif ($key eq 'MAX_CAPACITY'){ + # in bytes + $temp[1] = $temp[1]/1024 if $temp[1] =~ /^\d+$/; + $ram->[$a]{'max-capacity-16'} = $temp[1]; + } + elsif ($key eq 'NUM_DEVICES'){ + $ram->[$a]{'slots-16'} = $temp[1]; + } + elsif ($key eq 'USE'){ + $temp[1] ||= 'System Memory'; + $ram->[$a]{'use'} = $temp[1]; + } + } + elsif ($temp[0] =~ /^MEMORY_DEVICE_(\d+)_(\S+)$/){ + $key = $2; + if (!defined $d_holder){ + $d_holder = $1; + } + if ($d_holder ne $1){ + $i++; + $d_holder = $1; + } + if ($key eq 'ASSET_TAG'){ + $temp[1] = main::clean_dmi($temp[1]); + $ram->[$a]{'modules'}[$i]{'asset-tag'} = $temp[1] if $temp[1] ; + } + # only way to detect > 1 array systems is NODE[x] string. + elsif ($key eq 'BANK_LOCATOR'){ + $ram->[$a]{'modules'}[$i]{'bank-locator'} = $temp[1]; + # this is VERY unreliable, but better than nothing. Update if needed and + # new data sources available. + if ($temp[1] =~ /Node[\s_-]?(\d+)/i){ + $ram->[$a]{'modules'}[$i]{'array-id'} = $1; + $array_ids{$1} = 1 if !defined $array_ids{$1}; + } + } + elsif ($key eq 'CONFIGURED_SPEED_GTS'){ + $ram->[$a]{'modules'}[$i]{'configured-clock-speed'} = $temp[1]; + $ram->[$a]{'modules'}[$i]{'speed-unit'} = 'GT/s'; + } + elsif ($key eq 'CONFIGURED_SPEED_MTS'){ + $ram->[$a]{'modules'}[$i]{'configured-clock-speed'} = $temp[1]; + $ram->[$a]{'modules'}[$i]{'speed-unit'} = 'MT/s'; + } + elsif ($key eq 'CONFIGURED_VOLTAGE'){ + if ($temp[1] =~ /^([\d\.]+)/){ + $ram->[$a]{'modules'}[$i]{'voltage-config'} = $1; + } + } + elsif ($key eq 'DATA_WIDTH'){ + $temp[1] = main::clean_dmi($temp[1]); + if ($temp[1]){ + $temp[1] =~ s/[\s_-]?bits//; + $temp[1] =~ /(^[0-9]+).*/; + $ram->[$a]{'modules'}[$i]{'data-width'} = $1; + } + } + elsif ($key eq 'FIRMWARE_VERSION'){ + $ram->[$a]{'modules'}[$i]{'firmware'} = main::clean_dmi($temp[1]); + } + elsif ($key eq 'FORM_FACTOR'){ + $ram->[$a]{'modules'}[$i]{'form-factor'} = main::clean_dmi($temp[1]); + } + elsif ($key eq 'LOCATOR'){ + $ram->[$a]{'modules'}[$i]{'locator'} = $temp[1]; + } + elsif ($key eq 'MANUFACTURER'){ + $temp[1] = main::clean_dmi($temp[1]); + $ram->[$a]{'modules'}[$i]{'manufacturer'} = $temp[1]; + } + elsif ($key eq 'MAXIMUM_VOLTAGE'){ + if ($temp[1] =~ /^([\d\.]+)/){ + $ram->[$a]{'modules'}[$i]{'voltage-max'} = $1; + } + } + elsif ($key eq 'MINIMUM_VOLTAGE'){ + if ($temp[1] =~ /^([\d\.]+)/){ + $ram->[$a]{'modules'}[$i]{'voltage-min'} = $1; + } + } + elsif ($key eq 'PART_NUMBER'){ + $ram->[$a]{'modules'}[$i]{'part-number'} = main::clean_unset($temp[1],'^[0]+$|.*Module.*|PartNum.*'); + } + elsif ($key eq 'PRESENT'){ + $ram->[$a]{'modules'}[$i]{'present'} = $temp[1]; # 0/1 + } + elsif ($key eq 'RANK'){ + $ram->[$a]{'modules'}[$i]{'rank'} = $temp[1]; + } + elsif ($key eq 'SERIAL_NUMBER'){ + $ram->[$a]{'modules'}[$i]{'serial'} = main::clean_unset($temp[1],'^[0]+$|SerNum.*'); + } + # only seems to appear if occupied, handle no value in process + elsif ($key eq 'SIZE'){ + if ($temp[1] =~ /^\d+$/){ + $temp[1] = $temp[1]/1024; + $ram->[$a]{'modules'}[$i]{'size'} = $temp[1]; + } + } + # maybe with DDR6 or 7? + elsif ($key eq 'SPEED_GTS'){ + $ram->[$a]{'modules'}[$i]{'speed'} = $temp[1]; + $ram->[$a]{'modules'}[$i]{'speed-unit'} = 'GT/s'; + } + elsif ($key eq 'SPEED_MTS'){ + $ram->[$a]{'modules'}[$i]{'speed'} = $temp[1]; + $ram->[$a]{'modules'}[$i]{'speed-unit'} = 'MT/s'; + } + elsif ($key eq 'TOTAL_WIDTH'){ + $temp[1] = main::clean_dmi($temp[1]); + if ($temp[1]){ + $temp[1] =~ s/[\s_-]?bits//; + $temp[1] =~ /(^[0-9]+).*/; + $ram->[$a]{'modules'}[$i]{'total-width'} = $1; + } + } + elsif ($key eq 'TYPE'){ + $ram->[$a]{'modules'}[$i]{'device-type'} = main::clean_dmi($temp[1]); + if (!$ram->[$a]{'device-type'} && $ram->[$a]{'modules'}[$i]{'device-type'}){ + $ram->[$a]{'device-type'} = $ram->[$a]{'modules'}[$i]{'device-type'}; + } + } + elsif ($key eq 'TYPE_DETAIL'){ + $ram->[$a]{'modules'}[$i]{'device-type-detail'} = lc(main::clean_dmi($temp[1])); + } + } + } + print 'udevadm pre process_data: ', Data::Dumper::Dumper $ram if $dbg[36]; + main::log_data('dump','pre @$ram',$ram) if $b_log; + # bad quality output, for > 1 arrays, shows 1 array, > 1 nodes. + if (scalar @$ram == 1 && %array_ids && scalar keys %array_ids > 1){ + udevadm_create_arrays($ram); + } + if (@$ram){ + udevadm_data_process($ram); + } + process_data($ram) if @$ram; + main::log_data('dump','post @$ram',$ram) if $b_log; + print 'udevadm post process_data: ', Data::Dumper::Dumper $ram if $dbg[36]; + eval $end if $b_log; +} + +# args: 0: $ram ref; +sub udevadm_create_arrays { + eval $start if $b_log; + my $ram = $_[0]; + my ($id,%working); + # rebuild the single array into set of arrays + my $arr = shift @$ram; + foreach my $module (@{$arr->{'modules'}}){ + $id = $module->{'array-id'}; + push(@{$working{$id}->{'modules'}},$module); + } + # print Data::Dumper::Dumper \%working; + my $i = 0; + foreach my $key (sort {$a <=> $b} keys %working){ + $ram->[$i]{'modules'} = $working{$key}->{'modules'}; + foreach my $key2 (%$arr){ + next if $key2 eq 'modules' || $key2 eq 'slots-16'; + $ram->[$i]{$key2} = $arr->{$key2}; + } + $ram->[$i]{'slots-16'} = scalar @{$working{$key}->{'modules'}}; + $i++; + } + # print Data::Dumper::Dumper $ram; + eval $end if $b_log; +} + +# See comments on dmidecode_data modules for logic used here +# args: 0: $ram ref; +sub udevadm_data_process { + eval $start if $b_log; + my $ram = $_[0]; + my ($derived_module_size) = (0); + my $check = main::message('note-check'); + # print 'post udev create: ', Data::Dumper::Dumper $ram; + for (my $a=0; $a < scalar @$ram; $a++){ + # set the working data + $ram->[$a]{'derived-module-size'} = 0; + $ram->[$a]{'device-count-found'} = 0; + $ram->[$a]{'used-capacity'} = 0; + $ram->[$a]{'eec'} ||= 'None'; + $ram->[$a]{'use'} ||= 'System Memory'; + for (my $i=0; $i < scalar @{$ram->[$a]{'modules'}}; $i++){ + if ($ram->[$a]{'modules'}[$i]{'size'}){ + $derived_module_size = calculate_size($ram->[$a]{'modules'}[$i]{'size'}.'KiB',$derived_module_size); + $ram->[$a]{'device-count-found'}++; + $ram->[$a]{'slots-active'}++; + $ram->[$a]{'used-capacity'} += $ram->[$a]{'modules'}[$i]{'size'}; + } + elsif (!$ram->[$a]{'modules'}[$i]{'size'}){ + $ram->[$a]{'modules'}[$i]{'size'} = main::message('ram-no-module'); + } + # sometimes all upper case, no idea why + if ($ram->[$a]{'modules'}[$i]{'manufacturer'} || + $ram->[$a]{'modules'}[$i]{'part-number'}){ + ($ram->[$a]{'modules'}[$i]{'manufacturer'}, + $ram->[$a]{'modules'}[$i]{'vendor-id'}, + $ram->[$a]{'modules'}[$i]{'part-number'}) = process_manufacturer( + $ram->[$a]{'modules'}[$i]{'manufacturer'}, + $ram->[$a]{'modules'}[$i]{'part-number'}); + } + # these are sometimes reversed + if ($ram->[$a]{'modules'}[$i]{'data-width'} && + $ram->[$a]{'modules'}[$i]{'total-width'} && + $ram->[$a]{'modules'}[$i]{'data-width'} > $ram->[$a]{'modules'}[$i]{'total-width'}){ + my $temp = $ram->[$a]{'modules'}[$i]{'data-width'}; + $ram->[$a]{'modules'}[$i]{'data-width'} = $ram->[$a]{'modules'}[$i]{'total-width'}; + $ram->[$a]{'modules'}[$i]{'total-width'} = $temp; + } + if ($ram->[$a]{'modules'}[$i]{'speed'}){ + my $result = process_speed($ram->[$a]{'modules'}[$i]{'speed-unit'}, + $ram->[$a]{'modules'}[$i]{'speed'}, + $ram->[$a]{'modules'}[$i]{'device-type'},$check); + $ram->[$a]{'modules'}[$i]{'speed'} = $result->[0]; + $ram->[$a]{'modules'}[$i]{'speed-note'} = $result->[1]; + } + if ($ram->[$a]{'modules'}[$i]{'configured-clock-speed'}){ + my $result = process_speed($ram->[$a]{'modules'}[$i]{'speed-unit'}, + $ram->[$a]{'modules'}[$i]{'configured-clock-speed'}, + $ram->[$a]{'modules'}[$i]{'device-type'},$check); + $ram->[$a]{'modules'}[$i]{'configured-clock-speed'} = $result->[0]; + $ram->[$a]{'modules'}[$i]{'configured-note'} = $result->[1]; + } + # odd case were all value 1, which is almost certainly wrong + if ($ram->[$a]{'modules'}[$i]{'voltage-min'} && + $ram->[$a]{'modules'}[$i]{'voltage-max'} && + $ram->[$a]{'modules'}[$i]{'voltage-config'} && + $ram->[$a]{'modules'}[$i]{'voltage-min'} eq '1' && + $ram->[$a]{'modules'}[$i]{'voltage-max'} eq '1' && + $ram->[$a]{'modules'}[$i]{'voltage-config'} eq '1'){ + $ram->[$a]{'modules'}[$i]{'voltage-note'} = $check; + } + if ($ram->[$a]{'modules'}[$i]{'locator'} && + $ram->[$a]{'modules'}[$i]{'bank-locator'}){ + $ram->[$a]{'modules'}[$i]{'locator'} = process_locator( + $ram->[$a]{'modules'}[$i]{'locator'},$ram->[$a]{'modules'}[$i]{'bank-locator'}); + } + } + $ram->[$a]{'derived-module-size'} = $derived_module_size if $derived_module_size; + } + eval $end if $b_log; +} + +sub process_data { + eval $start if $b_log; + my $ram = $_[0]; + my @result; + my $b_debug = 0; + my $check = main::message('note-check'); + my $est = main::message('note-est'); + foreach my $item (@$ram){ + # Because we use the actual array handle as the index, there will be many + # undefined keys. + next if ! defined $item; + my ($max_cap,$max_mod_size) = (0,0); + my ($alt_cap,$est_cap,$est_mod,$est_slots,$unit) = (0,'','','',''); + $max_cap = $item->{'max-capacity-16'}; + $max_cap ||= 0; + # Make sure they are integers not string if empty. + $item->{'slots-5'} ||= 0; + $item->{'slots-16'} ||= 0; + $item->{'slots-active'} ||= 0; + $item->{'device-count-found'} ||= 0; + $item->{'max-capacity-5'} ||= 0; + $item->{'max-module-size'} ||= 0; + $item->{'used-capacity'} ||= 0; + # $item->{'max-module-size'} = 0;# debugger + # 1: If max cap 1 is null, and max cap 2 not null, use 2 + if ($b_debug){ + print "1: mms: $item->{'max-module-size'} :dms: $item->{'derived-module-size'} "; + print ":mc: $max_cap :uc: $item->{'used-capacity'}\n"; + print "1a: s5: $item->{'slots-5'} s16: $item->{'slots-16'}\n"; + } + if (!$max_cap && $item->{'max-capacity-5'}){ + $max_cap = $item->{'max-capacity-5'}; + } + if ($b_debug){ + print "2: mms: $item->{'max-module-size'} :dms: $item->{'derived-module-size'} "; + print ":mc: $max_cap :uc: $item->{'used-capacity'}\n"; + } + # 2: Now check to see if actually found module sizes are > than listed + # max module, replace if > + if ($item->{'max-module-size'} && $item->{'derived-module-size'} && + $item->{'derived-module-size'} > $item->{'max-module-size'}){ + $item->{'max-module-size'} = $item->{'derived-module-size'}; + $est_mod = $est; + } + if ($b_debug){ + print "3: dcf: $item->{'device-count-found'} :dms: $item->{'derived-module-size'} "; + print ":mc: $max_cap :uc: $item->{'used-capacity'}\n"; + } + # Note: some cases memory capacity == max module size, so one stick will + # fill it but I think only with cases of 2 slots does this happen, so + # if > 2, use the count of slots. + if ($max_cap && ($item->{'device-count-found'} || $item->{'slots-16'})){ + # First check that actual memory found is not greater than listed max cap, + # or checking to see module count * max mod size is not > used capacity + if ($item->{'used-capacity'} && $item->{'max-capacity-16'}){ + if ($item->{'used-capacity'} > $max_cap){ + if ($item->{'max-module-size'} && + $item->{'used-capacity'} < ($item->{'slots-16'} * $item->{'max-module-size'})){ + $max_cap = $item->{'slots-16'} * $item->{'max-module-size'}; + $est_cap = $est; + print "A\n" if $b_debug; + } + elsif ($item->{'derived-module-size'} && + $item->{'used-capacity'} < ($item->{'slots-16'} * $item->{'derived-module-size'})){ + $max_cap = $item->{'slots-16'} * $item->{'derived-module-size'}; + $est_cap = $est; + print "B\n" if $b_debug; + } + else { + $max_cap = $item->{'used-capacity'}; + $est_cap = $est; + print "C\n" if $b_debug; + } + } + } + # Note that second case will never really activate except on virtual + # machines and maybe mobile devices. + if (!$est_cap){ + # Do not do this for only single modules found, max mod size can be + # equal to the array size. + if ($item->{'slots-16'} > 1 && $item->{'device-count-found'} > 1 && + $max_cap < ($item->{'derived-module-size'} * $item->{'slots-16'})){ + $max_cap = $item->{'derived-module-size'} * $item->{'slots-16'}; + $est_cap = $est; + print "D\n" if $b_debug; + } + elsif ($item->{'device-count-found'} > 0 && + $max_cap < ($item->{'derived-module-size'} * $item->{'device-count-found'})){ + $max_cap = $item->{'derived-module-size'} * $item->{'device-count-found'}; + $est_cap = $est; + print "E\n" if $b_debug; + } + # Handle cases where we have type 5 data: mms x device count equals + # type 5 max caphowever do not use it if cap / devices equals the + # derived module size. + elsif ($item->{'max-module-size'} > 0 && + ($item->{'max-module-size'} * $item->{'slots-16'}) == $item->{'max-capacity-5'} && + $item->{'max-capacity-5'} != $item->{'max-capacity-16'} && + $item->{'derived-module-size'} != ($item->{'max-capacity-16'}/$item->{'slots-16'})){ + $max_cap = $item->{'max-capacity-5'}; + $est_cap = $est; + print "F\n" if $b_debug; + } + + } + if ($b_debug){ + print "4: mms: $item->{'max-module-size'} :dms: $item->{'derived-module-size'} "; + print ":mc: $max_cap :uc: $item->{'used-capacity'}\n"; + } + # Some cases of type 5 have too big module max size, just dump the data + # then since we cannot know if it is valid or not, and a guess can be + # wrong easily. + if ($item->{'max-module-size'} && $max_cap && $item->{'max-module-size'} > $max_cap){ + $item->{'max-module-size'} = 0; + } + if ($b_debug){ + print "5: dms: $item->{'derived-module-size'} :s16: $item->{'slots-16'} :mc: $max_cap\n"; + } + # Now prep for rebuilding the ram array data. + if (!$item->{'max-module-size'}){ + # ie: 2x4gB + if (!$est_cap && $item->{'derived-module-size'} > 0 && + $max_cap > ($item->{'derived-module-size'} * $item->{'slots-16'} * 4)){ + $est_cap = $check; + print "G\n" if $b_debug; + } + if ($max_cap && ($item->{'slots-16'} || $item->{'slots-5'})){ + my $slots = 0; + if ($item->{'slots-16'} && $item->{'slots-16'} >= $item->{'slots-5'}){ + $slots = $item->{'slots-16'}; + } + elsif ($item->{'slots-5'} && $item->{'slots-5'} > $item->{'slots-16'}){ + $slots = $item->{'slots-5'}; + } + # print "slots: $slots\n" if $b_debug; + if ($item->{'derived-module-size'} * $slots > $max_cap){ + $item->{'max-module-size'} = $item->{'derived-module-size'}; + print "H\n" if $b_debug; + } + else { + $item->{'max-module-size'} = sprintf("%.f",$max_cap/$slots); + print "J\n" if $b_debug; + } + $est_mod = $est; + } + } + # Case where listed max cap is too big for actual slots x max cap, eg: + # listed max cap, 8gb, max mod 2gb, slots 2 + else { + if (!$est_cap && $item->{'max-module-size'} > 0){ + if ($max_cap > ($item->{'max-module-size'} * $item->{'slots-16'})){ + $est_cap = $check; + print "K\n" if $b_debug; + } + } + } + } + # No slots found due to legacy dmi probably. Note, too many logic errors + # happen if we just set a general slots above, so safest to do it here + $item->{'slots-16'} = $item->{'slots-5'} if $item->{'slots-5'} && !$item->{'slots-16'}; + if (!$item->{'slots-16'} && $item->{'modules'} && ref $item->{'modules'} eq 'ARRAY'){ + $est_slots = $check; + $item->{'slots-16'} = scalar @{$item->{'modules'}}; + print "L\n" if $b_debug; + } + # Only bsds using dmesg data + elsif ($item->{'slots-qualifier'}){ + $est_slots = $item->{'slots-qualifier'}; + $est_cap = $est; + } + $ram_total += $item->{'used-capacity'}; + push(@result, { + 'capacity' => $max_cap, + 'cap-qualifier' => $est_cap, + 'device-type' => $item->{'device-type'}, + 'eec' => $item->{'eec'}, + 'location' => $item->{'location'}, + 'max-module-size' => $item->{'max-module-size'}, + 'mod-qualifier' => $est_mod, + 'modules' => $item->{'modules'}, + 'slots' => $item->{'slots-16'}, + 'slots-active' => $item->{'slots-active'}, + 'slots-qualifier' => $est_slots, + 'use' => $item->{'use'}, + 'used-capacity' => $item->{'used-capacity'}, + 'voltage-config' => $item->{'voltage-config'}, + 'voltage-max' => $item->{'voltage-max'}, + 'voltage-min' => $item->{'voltage-min'}, + }); + } + @$ram = @result; + eval $end if $b_log; +} + +## RAM UTILITIES ## + +# arg: 0: size string; 1: working size. If calculated result > $size, uses new +# value. If $data not valid, returns 0. +sub calculate_size { + eval $start if $b_log; + my ($data, $size) = @_; + # Technically k is KiB, K is KB but can't trust that. + if ($data =~ /^([0-9]+\s*[kKGMTP])i?B/){ + my $working = $1; + # This converts it to KiB + my $working_size = main::translate_size($working); + # print "ws-a: $working_size s-1: $size\n"; + if (main::is_numeric($working_size) && $working_size > $size){ + $size = $working_size; + } + # print "ws-b: $working_size s-2: $size\n"; + } + else { + $size = 0; + } + # print "d-2: $data s-3: $size\n"; + eval $end if $b_log; + return $size; +} + +# Because of the wide range of bank/slot type data, we will just use the +# one that seems most likely to be right. Some have: +# 'Bank: SO DIMM 0 slot: J6A' so we dump the useless data and use the one +# most likely to be visibly correct. +# Some systems show only DIMM 1 etc for locator with > 1 channels. +# args: 0: locator; 1: bank-locator +sub process_locator { + eval $start if $b_log; + my ($locator,$bank_locator) = @_; + my $main_locator; + if ($bank_locator && $bank_locator =~ /DIMM/){ + $main_locator = $bank_locator; + } + else { + # some systems show only DIMM 1 etc for locator with > 1 channels. + if ($locator && $locator =~ /^DIMM[\s_-]?\d+$/ && + $bank_locator && $bank_locator =~ /Channel[\s_-]?([A-Z]+)/i){ + $main_locator = "Channel-$1 $locator"; + } + else { + $main_locator = $locator; + } + } + eval $end if $b_log; + return $main_locator; +} + +# args: 0: manufacturer; 1: part number +sub process_manufacturer { + eval $start if $b_log; + my ($manufacturer,$part_number) = @_; + my $vendor_id; + if ($manufacturer){ + if ($manufacturer =~ /^([a-f0-9]{4})$/i){ + $vendor_id = lc($1); + $manufacturer = ''; + } + elsif ($manufacturer =~ /^[A-Z]+$/){ + $manufacturer = ucfirst(lc($manufacturer)); + } + } + if (!$manufacturer){ + if ($part_number){ + my $result = ram_vendor($part_number); + $manufacturer = $result->[0] if $result->[0]; + $part_number = $result->[1] if $result->[1]; + } + if (!$manufacturer && $vendor_id){ + set_ram_vendor_ids() if !$vendor_ids; + if ($vendor_ids->{$vendor_id}){ + $manufacturer = $vendor_ids->{$vendor_id}; + } + else { + $manufacturer = $vendor_id; + } + } + } + eval $end if $b_log; + return ($manufacturer,$vendor_id,$part_number); +} + +# args: 0: size in KiB +sub process_size { + eval $start if $b_log; + my ($size) = @_; + my ($b_trim,$unit) = (0,''); + # print "size0: $size\n"; + return 'N/A' if !$size; + # we're going to preserve the bad data for output + return $size if !main::is_numeric($size); + # print "size: $size\n"; + # We only want max 2 decimal places, and only when it's a unit > 1 GiB. + $b_trim = 1 if $size > 1024**2; + ($size,$unit) = main::get_size($size); + $size = sprintf("%.2f",$size) if $b_trim; + $size =~ s/\.[0]+$//; + $size = "$size $unit"; + eval $end if $b_log; + return $size; +} + +# args: 0: speed unit; 1: speed (numeric); 2: device tyep; 3: check string +sub process_speed { + eval $start if $b_log; + my ($unit,$speed,$device_type,$check) = @_; + my ($speed_note,$speed_orig); + if ($unit eq 'MHz' && $device_type && $device_type =~ /ddr/i && $speed){ + $speed_orig = " ($speed $unit)"; + $speed = ($speed * 2); + $unit = 'MT/s'; + } + # Seen cases of 1 MT/s, 61690 MT/s, not sure why, bug. Crucial is shipping + # 5100 MT/s now, and 6666 has been hit, so speeds can hit 10k. DDR6 hits + # 12.8k-17k, DDR7?. If GT/s assume valid and working + if ($speed && $unit && $unit eq 'MT/s'){ + if ($speed < 50 || $speed > 30000){ + $speed_note = $check; + } + } + $speed .= " $unit"; + $speed .= $speed_orig if $speed_orig; + eval $end if $b_log; + return [$speed,$speed_note]; +} + +# BSD: Map string to speed, in MT/s +sub set_speed_maps { + $speed_maps = { + # DDR1 + 'PC-1600' => 200, + 'PC-2100' => 266, + 'PC-2400' => 300, + 'PC-2700' => 333, + 'PC-3200' => 400, + # DDR2 + 'PC2-3200' => 400, + 'PC2-4200' => 533, + 'PC2-5300' => 667, + 'PC2-6400' => 800, + 'PC2-8000' => 1000, + 'PC2-8500' => 1066, + # DDR3 + 'PC3-6400' => 800, + 'PC3-8500' => 1066, + 'PC3-10600' => 1333, + 'PC3-12800' => 1600, + 'PC3-14900 ' => 1866, + 'PC3-17000' => 2133, + # DDR4 + 'PC4-12800' => 1600, + 'PC4-14900' => 1866, + 'PC4-17000' => 2133, + 'PC4-19200' => 2400, + 'PC4-21300' => 2666, + 'PC4-21333' => 2666, + 'PC4-23400' => 2933, + 'PC4-23466' => 2933, + 'PC4-24000' => 3000, + 'PC4-25600' => 3200, + 'PC4-28800' => 3600, + 'PC4-32000' => 4000, + 'PC4-35200' => 4400, + # DDR5 + 'PC5-32000' => 4000, + 'PC5-35200' => 4400, + 'PC5-38400' => 4800, + 'PC5-41600' => 5200, + 'PC5-44800' => 5600, + 'PC5-48000' => 6000, + 'PC5-49600' => 6200, + 'PC5-51200' => 6400, + 'PC5-54400' => 6800, + 'PC5-57600' => 7200, + 'PC5-60800' => 7600, + 'PC5-64000' => 8000, + # DDR6, coming... + # 'PC6-xxxxx' => 12800, + # 'PC6-xxxxx' => 17000, # overclocked + }; +} + +# args: 0: pc type string; +sub speed_mapper { + eval $start if $b_log; + set_speed_maps if !$speed_maps; + eval $end if $b_log; + return ($speed_maps->{$_[0]}) ? $speed_maps->{$_[0]} . ' MT/s' : $_[0]; +} + +## START RAM VENDOR ## +sub set_ram_vendors { + $vendors = [ + # A-Data xpg: AX4U; AX\d{4} for axiom + ['^(A[DX]\dU|AVD|A[\s-]?Data)','A[\s-]?Data','A-Data',''], + ['^(A[\s-]?Tech)','A[\s-]?Tech','A-Tech',''], # Don't know part nu + ['^(AX[\d]{4}|Axiom)','Axiom','Axiom',''], + ['^(BD\d|Black[s-]?Diamond)','Black[s-]?Diamond','Black Diamond',''], + ['^(-BN$|Brute[s-]?Networks)','Brute[s-]?Networks','Brute Networks',''], + ['^(CM|Corsair)','Corsair','Corsair',''], + ['^(CT\d|BL|Crucial)','Crucial','Crucial',''], + ['^(CY|Cypress)','Cypress','Cypress',''], + ['^(SNP|Dell)','Dell','Dell',''], + ['^(PE[\d]{4}|Edge)','Edge','Edge',''], + ['^(Elpida|EB)','^Elpida','Elpida',''], + ['^(GVT|Galvantech)','Galvantech','Galvantech',''], + # If we get more G starters, make rules tighter + ['^(G[A-Z]|Geil)','Geil','Geil',''], + # Note: FA- but make loose FA + ['^(F4|G[\s\.-]?Skill)','G[\s\.-]?Skill','G.Skill',''], + ['^(GJN)','GJN','GJN',''], + ['^(HP)','','HP',''], # no IDs found + ['^(HX|HyperX)','HyperX','HyperX',''], + # Qimonda spun out of Infineon, same ids + # ['^(HYS]|Qimonda)','Qimonda','Qimonda',''], + ['^(HY|Infineon)','Infineon','Infineon',''],#HY[A-Z]\d + ['^(KSM|KVR|Kingston)','Kingston','Kingston',''], + ['^(LuminouTek)','LuminouTek','LuminouTek',''], + ['^(MT|Micron)','Micron','Micron',''], + # Seen: 992069 991434 997110S + ['^(M[BLERS][A-Z][1-7]|99[0-9]{3}|Mushkin)','Mushkin','Mushkin',''], + ['^(OCZ)','^OCZ\b','OCZ',''], + ['^([MN]D\d|OLOy)','OLOy','OLOy',''], + ['^(M[ERS]\d|Nemix)','Nemix','Nemix',''], + # Before patriot just in case + ['^(MN\d|PNY)','PNY\s','PNY',''], + ['^(P[A-Z]|Patriot)','Patriot','Patriot',''], + ['^RAMOS','^RAMOS','RAmos',''], + ['^(K[1-6][ABLT]|K\d|M[\d]{3}[A-Z]|Samsung)','Samsung','Samsung',''], + ['^(SP|Silicon[\s-]?Power)','Silicon[\s-]?Power','Silicon Power',''], + ['^(STK|Simtek)','Simtek','Simtek',''], + ['^(Simmtronics|Gamex)','^Simmtronics','Simmtronics',''], + ['^(HM[ACT]|SK[\s-]?Hynix)','SK[\s-]?Hynix','SK-Hynix',''], + # TED TTZD TLRD TDZAD TF4D4 TPD4 TXKD4 seen: HMT but could by skh + #['^(T(ED|D[PZ]|F\d|LZ|P[DR]T[CZ]|XK)|Team[\s-]?Group)','Team[\s-]?Group','TeamGroup',''], + ['^(T[^\dR]|Team[\s-]?Group)','Team[\s-]?Group','TeamGroup',''], + ['^(TR\d|JM\d|Transcend)','Transcend','Transcend',''], + ['^(VK\d|Vaseky)','Vaseky','Vaseky',''], + ['^(Yangtze|Zhitai|YMTC)','(Yangtze(\s*Memory)?|YMTC)','YMTC',''], + ]; +} + +# Note: many of these are pci ids, not confirmed valid for ram +sub set_ram_vendor_ids { + $vendor_ids = { + '01f4' => 'Transcend',# confirmed + '02fe' => 'Elpida',# confirmed + '0314' => 'Mushkin',# confirmed + '0420' => 'Chips and Technologies', + '1014' => 'IBM', + '1099' => 'Samsung', + '10c3' => 'Samsung', + '11e2' => 'Samsung', + '1249' => 'Samsung', + '144d' => 'Samsung', + '15d1' => 'Infineon', + '167d' => 'Samsung', + '196e' => 'PNY', + '1b1c' => 'Corsair', + '1b85' => 'OCZ', + '1c5c' => 'SK-Hynix', + '1cc1' => 'A-Data', + '1e49' => 'YMTC',# Yangtze Memory confirmed + '0215' => 'Corsair',# confirmed + '2646' => 'Kingston', + '2c00' => 'Micron',# confirmed + '5105' => 'Qimonda',# confirmed + '802c' => 'Micron',# confirmed + '80ad' => 'SK-Hynix',# confirmed + '80ce' => 'Samsung',# confirmed + '8551' => 'Qimonda',# confirmed + '8564' => 'Transcend', + '859b' => 'Crucial', # confirmed + 'ad00' => 'SK-Hynix',# confirmed + 'c0a9' => 'Crucial', + 'ce00' => 'Samsung',# confirmed + # '' => '', + } +} +## END RAM VENDOR ## + +sub ram_vendor { + eval $start if $b_log; + my ($id) = $_[0]; + set_ram_vendors() if !$vendors; + my ($vendor); + foreach my $row (@$vendors){ + if ($id =~ /$row->[0]/i){ + $vendor = $row->[2]; + # Usually we want to assign N/A at output phase, maybe do this logic there? + if ($row->[1]){ + if ($id !~ m/$row->[1]$/i){ + $id =~ s/$row->[1]//i; + } + else { + $id = 'N/A'; + } + } + $id =~ s/^[\/\[\s_-]+|[\/\s_-]+$//g; + $id =~ s/\s\s/ /g; + last; + } + } + eval $end if $b_log; + return [$vendor,$id]; +} +} + +## RepoItem ## +{ +package RepoItem; +# easier to keep these package global, but undef after done +my (@dbg_files,$debugger_dir,%repo_keys); +my $num = 0; + +sub get { + eval $start if $b_log; + ($debugger_dir) = @_; + my $rows = []; + if ($extra > 0 && !$loaded{'package-data'}){ + my $packages = PackageData::get('main',\$num); + for (keys %$packages){ + $rows->[0]{$_} = $packages->{$_}; + } + } + my $rows_start = scalar @$rows; # to test if we found more rows after + $num = 0; + if ($bsd_type){ + get_repos_bsd($rows); + } + else { + get_repos_linux($rows); + } + if ($debugger_dir){ + @$rows = @dbg_files; + undef @dbg_files; + undef $debugger_dir; + undef %repo_keys; + } + else { + if ($rows_start == scalar @$rows){ + my $pm_missing; + if ($bsd_type){ + $pm_missing = main::message('repo-data-bsd',$uname[0]); + } + else { + $pm_missing = main::message('repo-data'); + } + push(@$rows,{main::key($num++,0,1,'Alert') => $pm_missing}); + } + } + eval $end if $b_log; + return $rows; +} + +sub get_repos_linux { + eval $start if $b_log; + my $rows = $_[0]; + my (@content,$data,@data2,@data3,@files,$pm_query,$repo,@repos); + my ($key,$path); + my $apk = '/etc/apk/repositories'; + my $apt = '/etc/apt/sources.list'; + my $apt_termux = '/data/data/com.termux/files/usr' . $apt; + $apt = $apt_termux if -e $apt_termux; # for android termux + my $cards = '/etc/cards.conf'; + my $dnf_conf = '/etc/dnf/dnf.conf'; + my $dnf_repo_dir = '/etc/dnf.repos.d/'; + my $eopkg_dir = '/var/lib/eopkg/'; + my $netpkg = '/etc/netpkg.conf'; + my $netpkg_dir = '/etc/netpkg.d'; + my $nix = '/etc/nix/nix.conf'; + my $pacman = '/etc/pacman.conf'; + my $pacman_g2 = '/etc/pacman-g2.conf'; + my $pisi_dir = '/etc/pisi/'; + my $portage_dir = '/etc/portage/repos.conf/'; + my $portage_gentoo_dir = '/etc/portage-gentoo/repos.conf/'; + my $sbopkg = '/etc/sbopkg/sbopkg.conf'; + my $sboui_backend = '/etc/sboui/sboui-backend.conf'; + my $scratchpkg = '/etc/scratchpkg.repo'; + my $slackpkg = '/etc/slackpkg/mirrors'; + my $slackpkg_plus = '/etc/slackpkg/slackpkgplus.conf'; + my $slapt_get = '/etc/slapt-get/'; + my $slpkg = '/etc/slpkg/repositories.toml'; + my $t2_src = '/usr/src/t2-src'; + my $tazpkg = '/etc/slitaz/tazpkg.conf'; + my $tazpkg_mirror = '/var/lib/tazpkg/mirror'; + my $tce_app = '/usr/bin/tce'; + my $tce_file = '/opt/tcemirror'; + my $tce_file2 = '/opt/localmirrors'; + my $yum_conf = '/etc/yum.conf'; + my $yum_repo_dir = '/etc/yum.repos.d/'; + my $xbps_dir_1 = '/etc/xbps.d/'; + my $xbps_dir_2 = '/usr/share/xbps.d/'; + my $zypp_repo_dir = '/etc/zypp/repos.d/'; + my $b_test = 0; + ## apt: Debian, *buntus + derived (deb files);AltLinux, PCLinuxOS (rpm files) + # Sometimes some yum/rpm repos may create apt repos here as well + if (-f $apt || -d "$apt.d"){ + my ($apt_arch,$apt_comp,$apt_suites,$apt_types,@apt_urls,@apt_working, + $b_apt_enabled,$file,$string); + my $counter = 0; + @files = main::globber("$apt.d/*.list"); + push(@files, $apt); + # prefilter list for logging + @files = grep {-f $_} @files; # may not have $apt file. + main::log_data('data',"apt repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log; + foreach (sort @files){ + # altlinux/pclinuxos use rpms in apt files, -r to be on safe side + if (-r $_){ + $data = repo_builder($_,'apt','^\s*(deb|rpm)'); + push(@$rows,@$data); + } + } + # @files = main::globber("$fake_data_dir/repo/apt/*.sources"); + @files = main::globber("$apt.d/*.sources"); + # prefilter list for logging, sometimes globber returns non-prsent files. + @files = grep {-f $_} @files; + # @files = ("$fake_data_dir/repo/apt/deb822-u193-3.sources", + # "$fake_data_dir/repo/apt/deb822-u193-3.sourcesdeb822-u193-4-signed-by.sources"); + main::log_data('data',"apt deb822 repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log; + foreach $file (@files){ + # critical: whitespace is the separator, no logical ordering of + # field names exists within each entry. + @data2 = main::reader($file); + # print Data::Dumper::Dumper \@data2; + if (@data2){ + @data2 = map {s/^\s*$/~/;$_} @data2; + push(@data2, '~'); + } + push(@dbg_files, $file) if $debugger_dir; + # print "$file\n"; + @apt_urls = (); + @apt_working = (); + $b_apt_enabled = 1; + foreach my $row (@data2){ + # NOTE: the syntax of deb822 must be considered a bug, it's sloppy beyond belief. + # deb822 supports line folding which starts with space + # BUT: you can start a URIs: block of urls with a space, sigh. + next if $row =~ /^\s+/ && $row !~ /^\s+[^#]+:\//; + # strip out line space starters now that it's safe + $row =~ s/^\s+//; + # print "$row\n"; + if ($row eq '~'){ + if (@apt_working && $b_apt_enabled){ + # print "1: url builder\n"; + foreach $repo (@apt_working){ + $string = $apt_types; + $string .= ' [arch=' . $apt_arch . ']' if $apt_arch; + $string .= ' ' . $repo; + $string .= ' ' . $apt_suites if $apt_suites ; + $string .= ' ' . $apt_comp if $apt_comp; + # print "s1:$string\n"; + push(@data3, $string); + } + # print join("\n",@data3),"\n"; + push(@apt_urls,@data3); + } + @data3 = (); + @apt_working = (); + $apt_arch = ''; + $apt_comp = ''; + $apt_suites = ''; + $apt_types = ''; + $b_apt_enabled = 1; + } + elsif ($row =~ /^Types:\s*(.*)/i){ + # print "1:$1\n"; + $apt_types = $1; + } + elsif ($row =~ /^Enabled:\s*(.*)/i){ + $b_apt_enabled = ($1 =~ /\b(disable|false|off|no|without)\b/i) ? 0: 1; + } + elsif ($row =~ /^[^#]+:\//){ + my $url = $row; + $url =~ s/^URIs:\s*//i; + push(@apt_working, $url) if $url; + } + elsif ($row =~ /^Suites:\s*(.*)/i){ + $apt_suites = $1; + } + elsif ($row =~ /^Components:\s*(.*)/i){ + $apt_comp = $1; + } + elsif ($row =~ /^Architectures:\s*(.*)/i){ + $apt_arch = $1; + } + } + if (@apt_urls){ + $key = repo_data('active','apt'); + clean_url(\@apt_urls); + } + else { + $key = repo_data('missing','apt'); + } + push(@$rows, + {main::key($num++,1,1,$key) => $file}, + [@apt_urls], + ); + } + @files = (); + } + ## pacman, pacman-g2: Arch + derived, Frugalware + if (-f $pacman || -f $pacman_g2){ + $repo = 'pacman'; + if (-f $pacman_g2){ + $pacman = $pacman_g2; + $repo = 'pacman-g2'; + } + @files = main::reader($pacman,'strip'); + if (@files){ + @repos = grep {/^\s*Server/i} @files; + @files = grep {/^\s*Include/i} @files; + } + if (@files){ + @files = map { + my @working = split(/\s+=\s+/, $_); + $working[1]; + } @files; + } + @files = sort @files; + main::uniq(\@files); + unshift(@files, $pacman) if @repos; + foreach (@files){ + if (-f $_){ + $data = repo_builder($_,$repo,'^\s*Server','\s*=\s*',1); + push(@$rows,@$data); + } + else { + # set it so the debugger knows the file wasn't there + push(@dbg_files, $_) if $debugger_dir; + push(@$rows, + {main::key($num++,1,1,'File listed in') => $pacman}, + [("$_ does not seem to exist.")], + ); + } + } + if (!@$rows){ + push(@$rows, + {main::key($num++,0,1,repo_data('missing','files')) => $pacman }, + ); + } + } + ## netpkg: Zenwalk, Slackware + if (-f $netpkg){ + my @data2 = ($netpkg); + if (-d $netpkg_dir){ + @data3 = main::globber("$netpkg_dir/*"); + @data3 = grep {!/\/local$/} @data3 if @data3; # package directory + push(@data2,@data3) if @data3; + } + foreach my $file (@data2){ + $data = repo_builder($file,'netpkg','^URL\s*=','\s*=\s*',1); + push(@$rows,@$data); + } + } + ## sbopkg, sboui, slackpkg, slackpkg+, slapt_get, slpkg: Slackware + derived + # $slpkg = "$fake_data_dir/repo/slackware/slpkg-2.toml"; + # $slpkg = "$fake_data_dir/repo/slackware/slpkg-new-format-1.toml"; + # $sbopkg = "$fake_data_dir/repo/slackware/sbopkg-2.conf"; + # $sboui_backend = "$fake_data_dir/repo/slackware/sboui-backend-1.conf"; + if (-f $slackpkg || -f $slackpkg_plus || -d $slapt_get || -f $slpkg || + -f $sbopkg || -f $sboui_backend){ + if (-f $sbopkg){ + my $sbo_root = '/root/.sbopkg.conf'; + # $sbo_root = "$fake_data_dir/repo/slackware/sbopkg-root-1.conf"; + @files = ($sbopkg); + # /root not readable as user, unless it is, so just check if readable + push(@files,$sbo_root) if -r $sbo_root; + my ($branch,$name); + # SRC_REPO repo URL not used, not what we think + foreach my $file (@files){ + foreach my $row (main::reader($file,'strip')){ + if ($row =~ /^REPO_NAME=(\S\{REPO_NAME:-)?(.*?)\}?$/){ + $name = $2; + } + elsif ($row =~ /^REPO_BRANCH=(\S\{REPO_BRANCH:-)?(.*?)\}?$/){ + $branch = $2; + } + } + } + # First found overridden by next, so we don't care where the value came + # from. We do care if 1 file and not root however, since might be wrong. + if ($branch && $name){ + if ($b_root || scalar @files == 2){ + $key = repo_data('active','sbopkg'); + } + else { + $key = repo_data('active-permissions','sbopkg'); + } + @content = ("$name ~ $branch"); + } + else { + $key = repo_data('missing','sbopkg'); + } + my @data = ( + {main::key($num++,1,1,$key) => join(', ',@files)}, + [@content], + ); + push(@$rows,@data); + (@content,@files) = (); + } + if (-f $sboui_backend){ + my ($branch,$repo); + # Note: sboui also has a sboui.conf file, with the package_manager string + # but that is too hard to handle clearly in output so leaving aside. + foreach my $row (main::reader($sboui_backend,'strip')){ + if ($row =~ /^REPO\s*=\s*["']?(\S+?)["']?\s*$/){ + $repo = $1; + } + elsif ($row =~ /^BRANCH\s*=\s*["']?(\S+?)["']?\s*$/){ + $branch = $1; + } + } + if ($repo){ + $key = repo_data('active','sboui'); + $branch = 'current' if !$branch || $repo =~ /ponce/i; + @content = ("SBo $branch ~ $repo"); # we want SBo name to show + } + else { + $key = repo_data('missing','sboui'); + } + my @data = ( + {main::key($num++,1,1,$key) => $sboui_backend}, + [@content], + ); + push(@$rows,@data); + @content = (); + } + if (-f $slackpkg){ + $data = repo_builder($slackpkg,'slackpkg','^[[:space:]]*[^#]+'); + push(@$rows,@$data); + } + if (-d $slapt_get){ + @data2 = main::globber("${slapt_get}*"); + @data2 = grep {!/pubring/} @data2 if @data2; + foreach my $file (@data2){ + $data = repo_builder($file,'slaptget','^\s*SOURCE','\s*=\s*',1); + push(@$rows,@$data); + } + } + if (-f $slackpkg_plus){ + push(@dbg_files, $slackpkg_plus) if $debugger_dir; + my (@repoplus_list,$active_repos); + foreach my $row (main::reader($slackpkg_plus,'strip')){ + @data2 = split(/\s*=\s*/, $row); + @data2 = map { $_ =~ s/^\s+|\s+$//g ; $_ } @data2; + last if $data2[0] =~ /^SLACKPKGPLUS/i && $data2[1] eq 'off'; + # REPOPLUS=(slackpkgplus restricted alienbob ktown multilib slacky) + if ($data2[0] =~ /^REPOPLUS/i){ + @repoplus_list = split(/\s+/, $data2[1]); + @repoplus_list = map {s/\(|\)//g; $_} @repoplus_list; + $active_repos = join('|',@repoplus_list); + + } + # MIRRORPLUS['multilib']=http://taper.alienbase.nl/mirrors/people/alien/multilib/14.1/ + if ($active_repos && $data2[0] =~ /^MIRRORPLUS/i){ + $data2[0] =~ s/MIRRORPLUS\[\'|\'\]//ig; + if ($data2[0] =~ /$active_repos/){ + push(@content,"$data2[0] ~ $data2[1]"); + } + } + } + if (!@content){ + $key = repo_data('missing','slackpkg+'); + } + else { + clean_url(\@content); + $key = repo_data('active','slackpkg+'); + } + my @data = ( + {main::key($num++,1,1,$key) => $slackpkg_plus}, + [@content], + ); + push(@$rows,@data); + @content = (); + } + if (-f $slpkg){ + my ($b_legacy,$b_new,$name,%repos); + @data2 = main::reader($slpkg,'strip'); + # print Data::Dumper::Dumper \@data2; + # old: "https://download.salixos.org/x86_64/slackware-15.0/" + # old, new syntax: ["https://slac...nl/people/alien/sbrepos/", "15.0/", "x86_64/"] + # newest: each block starts with name, eg: [DEFAULT], [ALIEN] + foreach (@data2){ + $_ = lc($_); + # first legacy line should be [REPO...] + if (!$b_legacy && !$b_new && /\[repositories\]/){ + $b_legacy = 1; + next; + } + # otherwise [...] is repo name + if (!$b_legacy && /^\[(\S+)\]/){ + $name = $1; + $b_new = 1; + next; + } + my ($key,$value) = split(/\s*=\s*/,$_); + next if !$key || !defined $value; + $value =~ s/^\[?["']|["']\]?$//g; + if ($b_legacy){ + next if $key !~ /^(\S+?)_(repo(|_name|_mirror))$/; + $name = $1; + $key = $2; + if ($key eq 'repo'){ + $repos{$name}->{'active'} = $value;} + elsif ($key eq 'repo_mirror'){ + # map new form to a real url + $value =~ s/['"],\s*['"]//g; + $repos{$name}->{'repo'} = $value;} + } + elsif ($b_new){ + if ($key eq 'repo' && $name eq 'default'){ + $repos{'default'} = $value; + $name = ''; + next;} + elsif ($key eq 'enable'){ + $repos{$name}{'active'} = $value;} + elsif ($key eq 'mirror'){ + $repos{$name}{'repo'} = $value;} + } + } + # print Data::Dumper::Dumper \%repos; + if (%repos){ + foreach my $item (sort keys %repos){ + next if ref $repos{$item} ne 'HASH'; + if (!$repos{$item}->{'active'} || + $repos{$item}->{'active'} =~ /^(true|1|yes)$/i){ + my $default = ($repos{'default'} && $item eq $repos{'default'}) ? ' (default)' : ''; + push(@content,$item . $default . ' ~ ' . $repos{$item}->{'repo'}); + } + } + } + if (!@content){ + $key = repo_data('missing','slpkg'); + } + else { + # Special case, sbo and ponce true, dump sbo, they conflict. + # slpkg does this internally so no other way to handle. + if (grep {/^ponce ~/} @content){ + @content = grep {!/sbo ~/} @content; + } + clean_url(\@content); + $key = repo_data('active','slpkg'); + } + push(@$rows, + {main::key($num++,1,1,$key) => $slpkg}, + [@content], + ); + (@content,@data2,@data3) = (); + } + } + ## dnf, yum, zypp: Redhat, Suse + derived (rpm based) + if (-f $dnf_conf ||-d $dnf_repo_dir|| -d $yum_repo_dir || -f $yum_conf || + -d $zypp_repo_dir){ + @files = (); + push(@files, $dnf_conf) if -f $dnf_conf; + push(@files, main::globber("$dnf_repo_dir*.repo")) if -d $dnf_repo_dir; + push(@files, $yum_conf) if -f $yum_conf; + push(@files, main::globber("$yum_repo_dir*.repo")) if -d $yum_repo_dir; + if (-d $zypp_repo_dir){ + push(@files, main::globber("$zypp_repo_dir*.repo")); + main::log_data('data',"zypp repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log; + } + # push(@files, "$fake_data_dir/repo/yum/rpmfusion-nonfree-1.repo"); + if (@files){ + foreach (sort @files){ + @data2 = main::reader($_); + push(@dbg_files, $_) if $debugger_dir; + if (/yum/){ + $repo = 'yum'; + } + elsif (/dnf/){ + $repo = 'dnf'; + } + elsif(/zypp/){ + $repo = 'zypp'; + } + my ($enabled,$url,$title) = (undef,'',''); + foreach my $line (@data2){ + # this is a hack, assuming that each item has these fields listed, we collect the 3 + # items one by one, then when the url/enabled fields are set, we print it out and + # reset the data. Not elegant but it works. Note that if enabled was not present + # we assume it is enabled then, and print the line, reset the variables. This will + # miss the last item, so it is printed if found in END + if ($line =~ /^\[(.+)\]/){ + my $temp = $1; + if ($url && $title && defined $enabled){ + if ($enabled > 0){ + push(@content, "$title ~ $url"); + } + ($enabled,$url,$title) = (undef,'',''); + } + $title = $temp; + } + # Note: it looks like enabled comes before url + elsif ($line =~ /^(metalink|mirrorlist|baseurl)\s*=\s*(.*)/i){ + $url = $2; + } + # note: enabled = 1. enabled = 0 means disabled + elsif ($line =~ /^enabled\s*=\s*(0|1|No|Yes|True|False)/i){ + $enabled = $1; + $enabled =~ s/(No|False)/0/i; + $enabled =~ s/(Yes|True)/1/i; + } + # print out the line if all 3 values are found, otherwise if a new + # repoTitle is hit above, it will print out the line there instead + if ($url && $title && defined $enabled){ + if ($enabled > 0){ + push(@content, "$title ~ $url"); + } + ($enabled,$url,$title) = (0,'',''); + } + } + # print the last one if there is data for it + if ($url && $title && $enabled){ + push(@content, "$title ~ $url"); + } + if (!@content){ + $key = repo_data('missing',$repo); + } + else { + clean_url(\@content); + $key = repo_data('active',$repo); + } + push(@$rows, + {main::key($num++,1,1,$key) => $_}, + [@content], + ); + @content = (); + } + } + # print Data::Dumper::Dumper \@$rows; + } + # emerge, portage: Gentoo + derived + if ((-d $portage_dir || -d $portage_gentoo_dir) && main::check_program('emerge')){ + @files = (main::globber("$portage_dir*.conf"),main::globber("$portage_gentoo_dir*.conf")); + $repo = 'portage'; + if (@files){ + foreach (sort @files){ + @data2 = main::reader($_); + push(@dbg_files, $_) if $debugger_dir; + my ($enabled,$url,$title) = (undef,'',''); + foreach my $line (@data2){ + # this is a hack, assuming that each item has these fields listed, we collect the 3 + # items one by one, then when the url/enabled fields are set, we print it out and + # reset the data. Not elegant but it works. Note that if enabled was not present + # we assume it is enabled then, and print the line, reset the variables. This will + # miss the last item, so it is printed if found in END + if ($line =~ /^\[(.+)\]/){ + my $temp = $1; + if ($url && $title && defined $enabled){ + if ($enabled > 0){ + push(@content, "$title ~ $url"); + } + ($enabled,$url,$title) = (undef,'',''); + } + $title = $temp; + } + elsif ($line =~ /^(sync-uri)\s*=\s*(.*)/i){ + $url = $2; + } + # note: enabled = 1. enabled = 0 means disabled + elsif ($line =~ /^auto-sync\s*=\s*(0|1|No|Yes|True|False)/i){ + $enabled = $1; + $enabled =~ s/(No|False)/0/i; + $enabled =~ s/(Yes|True)/1/i; + } + # print out the line if all 3 values are found, otherwise if a new + # repoTitle is hit above, it will print out the line there instead + if ($url && $title && defined $enabled){ + if ($enabled > 0){ + push(@content, "$title ~ $url"); + } + ($enabled,$url,$title) = (undef,'',''); + } + } + # print the last one if there is data for it + if ($url && $title && $enabled){ + push(@content, "$title ~ $url"); + } + if (! @content){ + $key = repo_data('missing','portage'); + } + else { + clean_url(\@content); + $key = repo_data('active','portage'); + } + push(@$rows, + {main::key($num++,1,1,$key) => $_}, + [@content], + ); + @content = (); + } + } + } + ## apk: Alpine, Chimera + if (-f $apk || -d "$apk.d"){ + @files = main::globber("$apk.d/*.list"); + push(@files, $apk); + # prefilter list for logging + @files = grep {-f $_} @files; # may not have $apk file. + main::log_data('data',"apk repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log; + foreach (sort @files){ + # -r to be on safe side + if (-r $_){ + $data = repo_builder($_,'apk','^\s*[^#]+'); + push(@$rows,@$data); + } + } + } + ## scratchpkg: Venom + if (-f $scratchpkg){ + $data = repo_builder($scratchpkg,'scratchpkg','^[[:space:]]*[^#]+'); + push(@$rows,@$data); + } + # cards: Nutyx + if (-f $cards){ + @data3 = main::reader($cards,'clean'); + push(@dbg_files, $cards) if $debugger_dir; + foreach (@data3){ + if ($_ =~ /^dir\s+\/[^\|]+\/([^\/\|]+)\s*(\|\s*((http|ftp).*))?/){ + my $type = ($3) ? $3: 'local'; + push(@content, "$1 ~ $type"); + } + } + if (!@content){ + $key = repo_data('missing','cards'); + } + else { + clean_url(\@content); + $key = repo_data('active','cards'); + } + push(@$rows, + {main::key($num++,1,1,$key) => $cards}, + [@content], + ); + @content = (); + } + ## tazpkg: Slitaz + if (-e $tazpkg || -e $tazpkg_mirror){ + $data = repo_builder($tazpkg_mirror,'tazpkg','^\s*[^#]+'); + push(@$rows,@$data); + } + ## tce: TinyCore + if (-e $tce_app || -f $tce_file || -f $tce_file2){ + if (-f $tce_file){ + $data = repo_builder($tce_file,'tce','^\s*[^#]+'); + push(@$rows,@$data); + } + if (-f $tce_file2){ + $data = repo_builder($tce_file2,'tce','^\s*[^#]+'); + push(@$rows,@$data); + } + } + ## T2 Emerge + if (-d $t2_src){ + if ($path = main::check_program('svn')){ + @data2 = main::grabber("$path info $t2_src 2>/dev/null","\n",'strip'); + main::writer("$debugger_dir/system-repo-data-t2-svn.txt",\@data2) if $debugger_dir; + if (@data2){ + $repo = main::awk(\@data2,'URL:',2); + push(@content,$repo) if $repo; + } + } + if (!@content){ + $key = repo_data('missing','t2-emerge'); + } + else { + clean_url(\@content); + $key = repo_data('active','t2-emerge'); + $pm_query = ''; + } + push(@$rows, + {main::key($num++,1,1,$key) => $t2_src}, + [@content], + ); + (@content,$pm_query,$repo) = (); + } + ## xbps: Void + if (-d $xbps_dir_1 || -d $xbps_dir_2){ + @files = main::globber("$xbps_dir_1*.conf"); + push(@files,main::globber("$xbps_dir_2*.conf")) if -d $xbps_dir_2; + main::log_data('data',"xbps repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log; + foreach (sort @files){ + if (-r $_){ + $data = repo_builder($_,'xbps','^\s*repository\s*=','\s*=\s*',1); + push(@$rows,@$data); + } + } + } + ## urpmq: Mandriva, Mageia + if ($path = main::check_program('urpmq')){ + @data2 = main::grabber("$path --list-media active --list-url 2>/dev/null","\n",'strip'); + main::writer("$debugger_dir/system-repo-data-urpmq.txt",\@data2) if $debugger_dir; + # my $file = "$ENV{HOME}/bin/scripts/inxi/data/repo/urpmq/system-mrmazda-1.txt"; + # @data2 = main::reader($file,'strip'); + # Now we need to create the structure: repo info: repo path. We do that by + # looping through the lines of the output and then putting it back into the + # : format print repos expects to see. Note this structure in the + # data, so store first line and make start of line then when it's an http + # line, add it, and create the full line collection. + # Contrib ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/contrib/release + # Contrib Updates ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/contrib/updates + # Non-free ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/non-free/release + # Non-free Updates ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/non-free/updates + # Nonfree Updates (Local19) /mnt/data/mirrors/mageia/distrib/cauldron/x86_64/media/nonfree/updates + foreach (@data2){ + # Need to dump leading/trailing spaces and clear out color codes for irc output + $_ =~ s/\x1B\[([0-9]{1,2}(;[0-9]{1,2})?)?[m|K]//g; + $_ =~ s/\e\[([0-9];)?[0-9]+m//g; + # urpmq output is the same each line, repo name space repo url, can be: + # rsync://, ftp://, file://, http:// OR repo is locally mounted on /var FS in some cases + if (/(.+)\s(\S+:\/\/.+|\/var\/\S+)/){ + # pack the repo url + push(@content, $1 . ' ~ ' . $2); + } + } + if (!@content){ + $key = repo_data('missing','urpm'); + $pm_query = main::message('pm-no-repos','urpmq'); + } + else { + clean_url(\@content); + $key = repo_data('active','urpm'); + $pm_query = ''; + } + push(@$rows, + {main::key($num++,1,1,$key) => $pm_query}, + [@content], + ); + @content = (); + } + # pisi: Pardus, Solus + if ((-d $pisi_dir && ($path = main::check_program('pisi'))) || + (-d $eopkg_dir && ($path = main::check_program('eopkg')))){ + # $path = 'eopkg'; + my $which = ($path =~ /pisi$/) ? 'pisi': 'eopkg'; + my $cmd = ($which eq 'pisi') ? "$path list-repo" : "$path lr"; + # my $file = "$ENV{HOME}/bin/scripts/inxi/data/repo/solus/eopkg-2.txt"; + # @data2 = main::reader($file,'strip'); + @data2 = main::grabber("$cmd 2>/dev/null","\n",'strip'); + push(@data2,'END') if @data2; + main::writer("$debugger_dir/system-repo-data-$which.txt",\@data2) if $debugger_dir; + # Now we need to create the structure: repo info: repo path + # We do that by looping through the lines of the output and then putting it + # back into the : format print repos expects to see. Note this + # structure in the data, so store first line and make start of line then + # when it's an http line, add it, and create the full line collection. + # Pardus-2009.1 [Aktiv] + # http://packages.pardus.org.tr/pardus-2009.1/pisi-index.xml.bz2 + # Contrib [Aktiv] + # http://packages.pardus.org.tr/contrib-2009/pisi-index.xml.bz2 + # Solus [inactive] + # https://packages.solus-project.com/shannon/eopkg-index.xml.xz + foreach (@data2){ + next if /^\s*$/; + # need to dump leading/trailing spaces and clear out color codes for irc output + if ($_ ne 'END'){ + $_ =~ s/\x1B\[([0-9]{1,2}(;[0-9]{1,2})?)?[m|K]//g; + $_ =~ s/\e\[([0-9];)?[0-9]+m//g; + if (/^\/|:\/\// && $repo){ + push(@content, $repo . ' ~ ' . $_); + $repo = ''; + } + # Local [inactive] Unstable [active] + elsif (/^(.*)\s\[([\S]+)\]/){ + $repo = $1; + $repo = ($2 =~ /^activ/) ? $repo : ''; + } + } + } + if (!@content){ + $key = repo_data('missing',$which); + $pm_query = main::message('pm-no-repos',$which); + } + else { + clean_url(\@content); + $key = repo_data('active',$which); + $pm_query = ''; + } + push(@$rows, + {main::key($num++,1,1,$key) => $pm_query}, + [@content], + ); + (@content,$repo) = (); + } + ## nix: General pm for Linux/Unix + if (-f $nix && ($path = main::check_program('nix-channel'))){ + @content = main::grabber("$path --list 2>/dev/null","\n",'strip'); + main::writer("$debugger_dir/system-repo-data-nix.txt",\@content) if $debugger_dir; + if (!@content){ + $key = repo_data('missing','nix'); + } + else { + clean_url(\@content); + $key = repo_data('active','nix'); + } + my $user = ($ENV{'USER'}) ? $ENV{'USER'}: 'N/A'; + push(@$rows, + {main::key($num++,1,1,$key) => $user}, + [@content], + ); + @content = (); + + } + # print Dumper $rows; + eval $end if $b_log; +} + +sub get_repos_bsd { + eval $start if $b_log; + my $rows = $_[0]; + my (@content,$data,@data2,@data3,@files); + my ($key); + my $bsd_pkg = '/usr/local/etc/pkg/repos/'; + my $freebsd = '/etc/freebsd-update.conf'; + my $freebsd_pkg = '/etc/pkg/FreeBSD.conf'; + my $ghostbsd_pkg = '/etc/pkg/GhostBSD.conf'; + my $hardenedbsd_pkg = '/etc/pkg/HardenedBSD.conf'; + my $mports = '/usr/mports/Makefile'; + my $netbsd = '/usr/pkg/etc/pkgin/repositories.conf'; + my $openbsd = '/etc/pkg.conf'; + my $openbsd2 = '/etc/installurl'; + my $portsnap = '/etc/portsnap.conf'; + if (-f $portsnap || -f $freebsd || -d $bsd_pkg || + -f $ghostbsd_pkg || -f $hardenedbsd_pkg){ + if (-f $portsnap){ + $data = repo_builder($portsnap,'portsnap','^\s*SERVERNAME','\s*=\s*',1); + push(@$rows,@$data); + } + if (-f $freebsd){ + $data = repo_builder($freebsd,'freebsd','^\s*ServerName','\s+',1); + push(@$rows,@$data); + } + if (-d $bsd_pkg || -f $freebsd_pkg || -f $ghostbsd_pkg || -f $hardenedbsd_pkg){ + @files = main::globber('/usr/local/etc/pkg/repos/*.conf'); + push(@files, $freebsd_pkg) if -f $freebsd_pkg; + push(@files, $ghostbsd_pkg) if -f $ghostbsd_pkg; + push(@files, $hardenedbsd_pkg) if -f $hardenedbsd_pkg; + if (@files){ + my ($url); + foreach (@files){ + push(@dbg_files, $_) if $debugger_dir; + # these will be result sets separated by an empty line + # first dump all lines that start with # + @content = main::reader($_,'strip'); + # then do some clean up on the lines + @content = map { $_ =~ s/{|}|,|\*//g; $_;} @content if @content; + # get all rows not starting with a # and starting with a non space character + my $url = ''; + foreach my $line (@content){ + if ($line !~ /^\s*$/){ + my @data2 = split(/\s*:\s*/, $line); + @data2 = map { $_ =~ s/^\s+|\s+$//g; $_;} @data2; + if ($data2[0] eq 'url'){ + $url = "$data2[1]:$data2[2]"; + $url =~ s/"|,//g; + } + # print "url:$url\n" if $url; + if ($data2[0] eq 'enabled'){ + if ($url && $data2[1] =~ /^(1|true|yes)$/i){ + push(@data3, "$url"); + } + $url = ''; + } + } + } + if (!@data3){ + $key = repo_data('missing','bsd-package'); + } + else { + clean_url(\@data3); + $key = repo_data('active','bsd-package'); + } + push(@$rows, + {main::key($num++,1,1,$key) => $_}, + [@data3], + ); + @data3 = (); + } + } + } + } + if (-f $openbsd || -f $openbsd2){ + if (-f $openbsd){ + $data = repo_builder($openbsd,'openbsd','^installpath','\s*=\s*',1); + push(@$rows,@$data); + } + if (-f $openbsd2){ + $data = repo_builder($openbsd2,'openbsd','^(http|ftp)','',1); + push(@$rows,@$data); + } + } + if (-f $netbsd){ + # not an empty row, and not a row starting with # + $data = repo_builder($netbsd,'netbsd','^\s*[^#]+$'); + push(@$rows,@$data); + } + # I don't think this is right, have to find out, for midnightbsd + # if (-f $mports){ + # @data = main::reader($mports,'strip'); + # main::writer("$debugger_dir/system-repo-data-mports.txt",\@data) if $debugger_dir; + # for (@data){ + # if (!/^MASTER_SITE_INDEX/){ + # next; + # } + # else { + # push(@data3,(split(/=\s*/,$_))[1]); + # } + # last if /^INDEX/; + # } + # if (!@data3){ + # $key = repo_data('missing','mports'); + # } + # else { + # clean_url(\@data3); + # $key = repo_data('active','mports'); + # } + # push(@$rows, + # {main::key($num++,1,1,$key) => $mports}, + # [@data3], + # ); + # @data3 = (); + # } + # BSDs do not default always to having repo files, so show correct error + # mesage in that case + if (!@$rows){ + if ($bsd_type eq 'freebsd'){ + $key = repo_data('missing','freebsd-files'); + } + elsif ($bsd_type eq 'openbsd'){ + $key = repo_data('missing','openbsd-files'); + } + elsif ($bsd_type eq 'netbsd'){ + $key = repo_data('missing','netbsd-files'); + } + else { + $key = repo_data('missing','bsd-files'); + } + push(@$rows, + {main::key($num++,0,1,'Message') => $key}, + [()], + ); + } + eval $start if $b_log; +} + +sub set_repo_keys { + eval $start if $b_log; + %repo_keys = ( + 'apk-active' => 'APK repo', + 'apk-missing' => 'No active APK repos in', + 'apt-active' => 'Active apt repos in', + 'apt-missing' => 'No active apt repos in', + 'bsd-files-missing' => 'No pkg server files found', + 'bsd-package-active' => 'Enabled pkg servers in', + 'bsd-package-missing' => 'No enabled BSD pkg servers in', + 'cards-active' => 'Active CARDS collections in', + 'cards-missing' => 'No active CARDS collections in', + 'dnf-active' => 'Active dnf repos in', + 'dnf-missing' => 'No active dnf repos in', + 'eopkg-active' => 'Active eopkg repos', + 'eopkg-missing' => 'No active eopkg repos found', + 'files-missing' => 'No repo files found in', + 'freebsd-active' => 'FreeBSD update server', + 'freebsd-files-missing' => 'No FreeBSD update server files found', + 'freebsd-missing' => 'No FreeBSD update servers in', + 'freebsd-pkg-active' => 'FreeBSD default pkg server', + 'freebsd-pkg-missing' => 'No FreeBSD default pkg server in', + 'mports-active' => 'mports servers', + 'mports-missing' => 'No mports servers found', + 'netbsd-active' => 'NetBSD pkg servers', + 'netbsd-files-missing' => 'No NetBSD pkg server files found', + 'netbsd-missing' => 'No NetBSD pkg servers in', + 'netpkg-active' => 'Active netpkg repos in', + 'netpkg-missing' => 'No active netpkg repos in', + 'nix-active' => 'Active nix channels for user', + 'nix-missing' => 'No nix channels found for user', + 'openbsd-active' => 'OpenBSD pkg mirror', + 'openbsd-files-missing' => 'No OpenBSD pkg mirror files found', + 'openbsd-missing' => 'No OpenBSD pkg mirrors in', + 'pacman-active' => 'Active pacman repo servers in', + 'pacman-missing' => 'No active pacman repos in', + 'pacman-g2-active' => 'Active pacman-g2 repo servers in', + 'pacman-g2-missing' => 'No active pacman-g2 repos in', + 'pisi-active' => 'Active pisi repos', + 'pisi-missing' => 'No active pisi repos found', + 'portage-active' => 'Enabled portage sources in', + 'portage-missing' => 'No enabled portage sources in', + 'portsnap-active' => 'Ports server', + 'portsnap-missing' => 'No ports servers in', + 'sbopkg-active' => 'Active sbopkg repo', + 'sbopkg-active-permissions' => 'Active sbopkg repo (confirm with root)', + 'sbopkg-missing' => 'No sbopkg repo', + 'sboui-active' => 'Active sboui repo', + 'sboui-missing' => 'No sboui repo', + 'scratchpkg-active' => 'scratchpkg repos in', + 'scratchpkg-missing' => 'No active scratchpkg repos in', + 'slackpkg-active' => 'slackpkg mirror in', + 'slackpkg-missing' => 'No slackpkg mirror set in', + 'slackpkg+-active' => 'slackpkg+ repos in', + 'slackpkg+-missing' => 'No active slackpkg+ repos in', + 'slaptget-active' => 'slapt-get repos in', + 'slaptget-missing' => 'No active slapt-get repos in', + 'slpkg-active' => 'Active slpkg repos in', + 'slpkg-missing' => 'No active slpkg repos in', + 't2-emerge-active' => 'Active T2 Emerge URL in', + 't2-emerge-missing' => 'No active T2 Emerge URLs in', + 'tazpkg-active' => 'tazpkg mirrors in', + 'tazpkg-missing' => 'No tazpkg mirrors in', + 'tce-active' => 'tce mirrors in', + 'tce-missing' => 'No tce mirrors in', + 'urpm-active' => 'Active urpm repos', + 'urpm-missing' => 'No active urpm repos found', + 'xbps-active' => 'Active xbps repos in', + 'xbps-missing' => 'No active xbps repos in', + 'yum-active' => 'Active yum repos in', + 'yum-missing' => 'No active yum repos in', + 'zypp-active' => 'Active zypp repos in', + 'zypp-missing' => 'No active zypp repos in', + ); + eval $end if $b_log; +} + +sub repo_data { + eval $start if $b_log; + my ($status,$type) = @_; + set_repo_keys() if !%repo_keys; + eval $end if $b_log; + return $repo_keys{$type . '-' . $status}; +} + +# Args: 0: repo file; 1: pm type; 2: repo line search, 3: split; 4: count +sub repo_builder { + eval $start if $b_log; + my ($file,$type,$search,$split,$count) = @_; + my (@content,$key); + push(@dbg_files, $file) if $debugger_dir; + if (-r $file){ + @content = main::reader($file); + @content = grep {/$search/i && !/^\s*$/} @content if @content; + clean_data(\@content) if @content; + } + if ($split && @content){ + @content = map { + my @inner = split(/$split/, $_); + $inner[$count]; + } @content; + } + if (!@content){ + $key = repo_data('missing',$type); + } + else { + $key = repo_data('active',$type); + clean_url(\@content); + } + eval $end if $b_log; + return [ + {main::key($num++,1,1,$key) => $file}, + [@content], + ]; +} + +sub clean_data { + # basics: trim white space, get rid of double spaces; trim comments at + # ends of repo values + @{$_[0]} = map { + $_ =~ s/\s\s+/ /g; + $_ =~ s/^\s+|\s+$//g; + $_ =~ s/\[\s+/[/g; # [ signed-by + $_ =~ s/\s+\]/]/g; + $_ =~ s/^(.*\/.*) #.*/$1/; + $_;} @{$_[0]}; +} + +# Clean if irc +sub clean_url { + @{$_[0]} = map {$_ =~ s/:\//: \//; $_} @{$_[0]} if $b_irc; + # trim comments at ends of repo values + @{$_[0]} = map {$_ =~ s/^(.*\/.*) #.*/$1/; $_} @{$_[0]}; +} + +sub file_path { + my ($filename,$dir) = @_; + my ($working); + $working = $filename; + $working =~ s/^\///; + $working =~ s/\//-/g; + $working = "$dir/file-repo-$working.txt"; + return $working; +} +} + +## SensorItem ## +{ +package SensorItem; +my $gpu_data = []; +my $sensors_raw = {}; +my $max_fan = 15000; + +sub get { + eval $start if $b_log; + my ($b_data,$b_ipmi,$b_no_lm,$b_no_sys); + my ($message_type,$program,$val1,$sensors); + my ($key1,$num,$rows) = ('Message',0,[]); + my $source = 'sensors'; # will trip some type output if ipmi + another type + # we're allowing 1 or 2 ipmi tools, first the gnu one, then the + # almost certain to be present in BSDs + if ($fake{'ipmi'} || (main::globber('/dev/ipmi**') && + (($program = main::check_program('ipmi-sensors')) || + ($program = main::check_program('ipmitool'))))){ + if ($fake{'ipmi'} || $b_root){ + $sensors = ipmi_data($program); + $b_data = sensors_output($rows,'ipmi',$sensors); + if (!$b_data){ + $val1 = main::message('sensor-data-ipmi'); + push(@$rows,{ + main::key($num++,1,1,'Src') => 'ipmi', + main::key($num++,0,1,$key1) => $val1, + }); + } + } + else { + $key1 = 'Permissions'; + $val1 = main::message('sensor-data-ipmi-root'); + push(@$rows,{ + main::key($num++,1,1,'Src') => 'ipmi', + main::key($num++,0,2,$key1) => $val1, + }); + } + $b_ipmi = 1; + } + $b_data = 0; + if ($bsd_type){ + if ($sysctl{'sensor'}){ + $sensors = sysctl_data(); + $source = 'sysctl' if $b_ipmi; + $b_data = sensors_output($rows,$source,$sensors); + if (!$b_data){ + $source = 'sysctl'; + $val1 = main::message('sensor-data-bsd',$uname[0]); + } + } + else { + if ($bsd_type =~ /^(free|open)bsd/){ + $source = 'sysctl'; + $val1 = main::message('sensor-data-bsd-ok'); + } + else { + $source = 'N/A'; + $val1 = main::message('sensor-data-bsd-unsupported'); + } + } + } + else { + if (!$force{'sensors-sys'} && + ($fake{'sensors'} || $alerts{'sensors'}->{'action'} eq 'use')){ + load_lm_sensors(); + $sensors = linux_sensors_data(); + $source = 'lm-sensors' if $b_ipmi; # trips per sensor type output + $b_data = sensors_output($rows,$source,$sensors); + # print "here 1\n"; + $b_no_lm = 1 if !$b_data; + } + # given recency of full /sys data, we want to prefer lm-sensors for a long time + # and use /sys as a fallback. This will handle servers, which often do not + # have lm-sensors installed, but do have /sys hwmon data. + if (!$b_data && -d '/sys/class/hwmon'){ + load_sys_data(); + $sensors = linux_sensors_data(); + $source = '/sys'; # trips per sensor type output + $b_data = sensors_output($rows,$source,$sensors); + # print "here 2\n"; + $b_no_sys = 1 if !$b_data; + } + if (!$b_data){ + if ($b_no_lm || $b_no_sys){ + if ($b_no_lm && $b_no_sys){ + $source = 'lm-sensors+/sys'; + $val1 = main::message('sensor-data-sys-lm'); + } + elsif ($b_no_lm){ + $source = 'lm-sensors'; + $val1 = main::message('sensor-data-lm-sensors'); + } + else { + $val1 = main::message('sensor-data-sys'); + } + } + elsif (!$fake{'sensors'} && $alerts{'sensors'}->{'action'} ne 'use'){ + # print "here 3\n"; + $source = 'lm-sensors'; + $key1 = $alerts{'sensors'}->{'action'}; + $key1 = ucfirst($key1); + $val1 = $alerts{'sensors'}->{'message'}; + } + else { + $source = 'N/A'; + $val1 = main::message('sensors-data-linux'); + } + } + } + if (!$b_data){ + push(@$rows,{ + main::key($num++,1,1,'Src') => $source, + main::key($num++,0,2,$key1) => $val1, + }); + } + eval $end if $b_log; + return $rows; +} + +sub sensors_output { + eval $start if $b_log; + my ($rows,$source,$sensors) = @_; + my ($b_result,@fan_default,@fan_main); + my $fan_number = 0; + my $num = 0; + my $j = scalar @$rows; + if (!$loaded{'gpu-data'} && + ($source eq 'sensors' || $source eq 'lm-sensors' || $source eq '/sys')){ + gpu_sensor_data(); + } + # gpu sensors data might be present even if standard sensors data wasn't + return if !%$sensors && !@$gpu_data; + $b_result = 1; ## need to trip data found conditions + my $temp_unit = (defined $sensors->{'temp-unit'}) ? " $sensors->{'temp-unit'}": ''; + my $cpu_temp = (defined $sensors->{'cpu-temp'}) ? $sensors->{'cpu-temp'} . $temp_unit: 'N/A'; + my $mobo_temp = (defined $sensors->{'mobo-temp'}) ? $sensors->{'mobo-temp'} . $temp_unit: 'N/A'; + my $cpu1_key = ($sensors->{'cpu2-temp'}) ? 'cpu-1': 'cpu'; + my ($l1,$l2,$l3) = (1,2,3); + if ($source ne 'sensors'){ + $rows->[$j]{main::key($num++,1,1,'Src')} = $source; + ($l1,$l2,$l3) = (2,3,4); + } + $rows->[$j]{main::key($num++,1,$l1,'System Temperatures')} = ''; + $rows->[$j]{main::key($num++,0,$l2,$cpu1_key)} = $cpu_temp; + if ($sensors->{'cpu2-temp'}){ + $rows->[$j]{main::key($num++,0,$l2,'cpu-2')} = $sensors->{'cpu2-temp'} . $temp_unit; + } + if ($sensors->{'cpu3-temp'}){ + $rows->[$j]{main::key($num++,0,$l2,'cpu-3')} = $sensors->{'cpu3-temp'} . $temp_unit; + } + if ($sensors->{'cpu4-temp'}){ + $rows->[$j]{main::key($num++,0,$l2,'cpu-4')} = $sensors->{'cpu4-temp'} . $temp_unit; + } + if (defined $sensors->{'pch-temp'}){ + my $pch_temp = $sensors->{'pch-temp'} . $temp_unit; + $rows->[$j]{main::key($num++,0,$l2,'pch')} = $pch_temp; + } + $rows->[$j]{main::key($num++,0,$l2,'mobo')} = $mobo_temp; + if (defined $sensors->{'sodimm-temp'}){ + my $sodimm_temp = $sensors->{'sodimm-temp'} . $temp_unit; + $rows->[$j]{main::key($num++,0,$l2,'sodimm')} = $sodimm_temp; + } + if (defined $sensors->{'psu-temp'}){ + my $psu_temp = $sensors->{'psu-temp'} . $temp_unit; + $rows->[$j]{main::key($num++,0,$l2,'psu')} = $psu_temp; + } + if (defined $sensors->{'ambient-temp'}){ + my $ambient_temp = $sensors->{'ambient-temp'} . $temp_unit; + $rows->[$j]{main::key($num++,0,$l2,'ambient')} = $ambient_temp; + } + if (scalar @$gpu_data == 1 && defined $gpu_data->[0]{'temp'}){ + my $gpu_temp = $gpu_data->[0]{'temp'}; + my $gpu_type = $gpu_data->[0]{'type'}; + my $gpu_unit = (defined $gpu_data->[0]{'temp-unit'} && $gpu_temp) ? " $gpu_data->[0]{'temp-unit'}" : ' C'; + $rows->[$j]{main::key($num++,1,$l2,'gpu')} = $gpu_type; + $rows->[$j]{main::key($num++,0,$l3,'temp')} = $gpu_temp . $gpu_unit; + if ($extra > 1 && $gpu_data->[0]{'temp-mem'}){ + $rows->[$j]{main::key($num++,0,$l3,'mem')} = $gpu_data->[0]{'temp-mem'} . $gpu_unit; + } + } + $j = scalar @$rows; + @fan_main = @{$sensors->{'fan-main'}} if $sensors->{'fan-main'}; + @fan_default = @{$sensors->{'fan-default'}} if $sensors->{'fan-default'}; + my $fan_def = (!@fan_main && !@fan_default) ? 'N/A' : ''; + $rows->[$j]{main::key($num++,1,$l1,'Fan Speeds (rpm)')} = $fan_def; + my $b_cpu = 0; + for (my $i = 0; $i < scalar @fan_main; $i++){ + next if $i == 0;# starts at 1, not 0 + if (defined $fan_main[$i]){ + if ($i == 1 || ($i == 2 && !$b_cpu)){ + $rows->[$j]{main::key($num++,0,$l2,'cpu')} = $fan_main[$i]; + $b_cpu = 1; + } + elsif ($i == 2 && $b_cpu){ + $rows->[$j]{main::key($num++,0,$l2,'mobo')} = $fan_main[$i]; + } + elsif ($i == 3){ + $rows->[$j]{main::key($num++,0,$l2,'psu')} = $fan_main[$i]; + } + elsif ($i == 4){ + $rows->[$j]{main::key($num++,0,$l2,'sodimm')} = $fan_main[$i]; + } + elsif ($i > 4){ + $fan_number = $i - 4; + $rows->[$j]{main::key($num++,0,$l2,"case-$fan_number")} = $fan_main[$i]; + } + } + } + for (my $i = 0; $i < scalar @fan_default; $i++){ + next if $i == 0;# starts at 1, not 0 + if (defined $fan_default[$i]){ + $rows->[$j]{main::key($num++,0,$l2,"fan-$i")} = $fan_default[$i]; + } + } + $rows->[$j]{main::key($num++,0,$l2,'psu')} = $sensors->{'fan-psu'} if defined $sensors->{'fan-psu'}; + $rows->[$j]{main::key($num++,0,$l2,'psu-1')} = $sensors->{'fan-psu1'} if defined $sensors->{'fan-psu1'}; + $rows->[$j]{main::key($num++,0,$l2,'psu-2')} = $sensors->{'fan-psu2'} if defined $sensors->{'fan-psu2'}; + # note: so far, only nvidia-settings returns speed, and that's in percent + if (scalar @$gpu_data == 1 && defined $gpu_data->[0]{'fan-speed'}){ + my $gpu_fan = $gpu_data->[0]{'fan-speed'} . $gpu_data->[0]{'speed-unit'}; + my $gpu_type = $gpu_data->[0]{'type'}; + $rows->[$j]{main::key($num++,1,$l2,'gpu')} = $gpu_type; + $rows->[$j]{main::key($num++,0,$l3,'fan')} = $gpu_fan; + } + if (scalar @$gpu_data > 1){ + $j = scalar @$rows; + $rows->[$j]{main::key($num++,1,$l1,'GPU')} = ''; + my $gpu_unit = (defined $gpu_data->[0]{'temp-unit'}) ? " $gpu_data->[0]{'temp-unit'}" : ' C'; + foreach my $info (@$gpu_data){ + # speed unit is either '' or % + my $gpu_fan = (defined $info->{'fan-speed'}) ? $info->{'fan-speed'} . $info->{'speed-unit'}: undef; + my $gpu_type = $info->{'type'}; + my $gpu_temp = (defined $info->{'temp'}) ? $info->{'temp'} . $gpu_unit: 'N/A'; + $rows->[$j]{main::key($num++,1,$l2,'device')} = $gpu_type; + if (defined $info->{'screen'}){ + $rows->[$j]{main::key($num++,0,$l3,'screen')} = $info->{'screen'}; + } + $rows->[$j]{main::key($num++,0,$l3,'temp')} = $gpu_temp; + if ($extra > 1 && $info->{'temp-mem'}){ + $rows->[$j]{main::key($num++,0,$l3,'mem')} = $info->{'temp-mem'} . $gpu_unit; + } + if (defined $gpu_fan){ + $rows->[$j]{main::key($num++,0,$l3,'fan')} = $gpu_fan; + } + if ($extra > 2 && $info->{'watts'}){ + $rows->[$j]{main::key($num++,0,$l3,'watts')} = $info->{'watts'}; + } + if ($extra > 2 && $info->{'volts-gpu'}){ + $rows->[$j]{main::key($num++,0,$l3,$info->{'volts-gpu'}[1])} = $info->{'volts-gpu'}[0]; + } + } + } + if ($extra > 0 && ($source eq 'ipmi' || + ($sensors->{'volts-12'} || $sensors->{'volts-5'} || $sensors->{'volts-3.3'} || + $sensors->{'volts-vbat'}))){ + $j = scalar @$rows; + $sensors->{'volts-12'} ||= 'N/A'; + $sensors->{'volts-5'} ||= 'N/A'; + $sensors->{'volts-3.3'} ||= 'N/A'; + $sensors->{'volts-vbat'} ||= 'N/A'; + $rows->[$j]{main::key($num++,1,$l1,'Power')} = ''; + $rows->[$j]{main::key($num++,0,$l2,'12v')} = $sensors->{'volts-12'}; + $rows->[$j]{main::key($num++,0,$l2,'5v')} = $sensors->{'volts-5'}; + $rows->[$j]{main::key($num++,0,$l2,'3.3v')} = $sensors->{'volts-3.3'}; + $rows->[$j]{main::key($num++,0,$l2,'vbat')} = $sensors->{'volts-vbat'}; + if ($extra > 1 && $source eq 'ipmi'){ + $sensors->{'volts-dimm-p1'} ||= 'N/A'; + $sensors->{'volts-dimm-p2'} ||= 'N/A'; + if ($sensors->{'volts-dimm-p1'}){ + $rows->[$j]{main::key($num++,0,$l2,'dimm-p1')} = $sensors->{'volts-dimm-p1'}; + } + if ($sensors->{'volts-dimm-p2'}){ + $rows->[$j]{main::key($num++,0,$l2,'dimm-p2')} = $sensors->{'volts-dimm-p2'}; + } + if ($sensors->{'volts-soc-p1'}){ + $rows->[$j]{main::key($num++,0,$l2,'soc-p1')} = $sensors->{'volts-soc-p1'}; + } + if ($sensors->{'volts-soc-p2'}){ + $rows->[$j]{main::key($num++,0,$l2,'soc-p2')} = $sensors->{'volts-soc-p2'}; + } + } + if (scalar @$gpu_data == 1 && $extra > 2 && + ($gpu_data->[0]{'watts'} || $gpu_data->[0]{'volts-gpu'})){ + $rows->[$j]{main::key($num++,1,$l2,'gpu')} = $gpu_data->[0]{'type'}; + if ($gpu_data->[0]{'watts'}){ + $rows->[$j]{main::key($num++,0,$l3,'watts')} = $gpu_data->[0]{'watts'}; + } + if ($gpu_data->[0]{'volts-gpu'}){ + $rows->[$j]{main::key($num++,0,$l3,$gpu_data->[0]{'volts-gpu'}[1])} = $gpu_data->[0]{'volts-gpu'}[0]; + } + } + } + eval $end if $b_log; + return $b_result; +} + +sub ipmi_data { + eval $start if $b_log; + my ($program) = @_; + my ($b_cpu_0,$cmd,$file,@data,$fan_working,@row,$speed,$sys_fan_nu,$temp_working, + $working_unit); + my ($b_ipmitool,$i_key,$i_value,$i_unit); + my $sensors = {}; + if ($fake{'ipmi'}){ + ## ipmitool ## + # $file = "$fake_data_dir/sensors/ipmitool/ipmitool-sensors-archerseven-1.txt";$program='ipmitool'; + # $file = "$fake_data_dir/sensorsipmitool/ipmitool-sensors-epyc-1.txt";$program='ipmitool'; + # $file = "$fake_data_dir/sensorsipmitool/ipmitool-sensors-RK016013.txt";$program='ipmitool'; + # $file = "$fake_data_dir/sensorsipmitool/ipmitool-sensors-freebsd-offsite-backup.txt"; + # $file = "$fake_data_dir/sensorsipmitool/ipmitool-sensor-shom-1.txt";$program='ipmitool'; + # $file = "$fake_data_dir/sensorsipmitool/ipmitool-sensor-shom-2.txt";$program='ipmitool'; + # $file = "$fake_data_dir/sensorsipmitool/ipmitool-sensor-tyan-1.txt";$program='ipmitool'; + # ($b_ipmitool,$i_key,$i_value,$i_unit) = (1,0,1,2); # ipmitool sensors + ## ipmi-sensors ## + # $file = "$fake_data_dir/sensorsipmitool/ipmi-sensors-epyc-1.txt";$program='ipmi-sensors'; + # $file = "$fake_data_dir/sensorsipmitool/ipmi-sensors-lathander.txt";$program='ipmi-sensors'; + # $file = "$fake_data_dir/sensorsipmitool/ipmi-sensors-zwerg.txt";$program='ipmi-sensors'; + # $file = "$fake_data_dir/sensorsipmitool/ipmi-sensors-arm-server-1.txt";$program='ipmi-sensors'; + # ($b_ipmitool,$i_key,$i_value,$i_unit) = (0,1,3,4); # ipmi-sensors + # @data = main::reader($file); + } + else { + if ($program =~ /ipmi-sensors$/){ + $cmd = $program; + ($b_ipmitool,$i_key,$i_value,$i_unit) = (0,1,3,4); + } + else { # ipmitool + $cmd = "$program sensor"; # note: 'sensor' NOT 'sensors' !! + ($b_ipmitool,$i_key,$i_value,$i_unit) = (1,0,1,2); + } + @data = main::grabber("$cmd 2>/dev/null"); + } + # print join("\n", @data), "\n"; + # shouldn't need to log, but saw a case with debugger ipmi data, but none here apparently + main::log_data('dump','ipmi @data',\@data) if $b_log; + return $sensors if !@data; + foreach (@data){ + next if /^\s*$/; + # print "$_\n"; + @row = split(/\s*\|\s*/, $_); + # print "$row[$i_value]\n"; + next if !main::is_numeric($row[$i_value]); + # print "$row[$i_key] - $row[$i_value]\n"; + if (!$sensors->{'mobo-temp'} && $row[$i_key] =~ /^(MB[\s_-]?TEMP[0-9]|System[\s_-]?Temp|System[\s_-]?Board([\s_-]?Temp)?)$/i){ + $sensors->{'mobo-temp'} = int($row[$i_value]); + $working_unit = $row[$i_unit]; + $working_unit =~ s/degrees\s// if $b_ipmitool; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + elsif ($row[$i_key] =~ /^(System[\s_-]?)?(Ambient)([\s_-]?Temp)?$/i){ + $sensors->{'ambient-temp'} = int($row[$i_value]); + $working_unit = $row[$i_unit]; + $working_unit =~ s/degrees\s// if $b_ipmitool; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + # Platform Control Hub (PCH), it is the X370 chip on the Crosshair VI Hero. + # VRM: voltage regulator module + # NOTE: CPU0_TEMP CPU1_TEMP is possible, unfortunately; CPU Temp Interf + elsif (!$sensors->{'cpu-temp'} && $row[$i_key] =~ /^CPU[\s_-]?([01])?([\s_](below[\s_]Tmax|Temp))?$/i){ + $b_cpu_0 = 1 if defined $1 && $1 == 0; + $sensors->{'cpu-temp'} = int($row[$i_value]); + $working_unit = $row[$i_unit]; + $working_unit =~ s/degrees\s// if $b_ipmitool; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + elsif ($row[$i_key] =~ /^CPU[\s_-]?([1-4])([\s_](below[\s_]Tmax|Temp))?$/i){ + $temp_working = $1; + $temp_working++ if $b_cpu_0; + $sensors->{"cpu${temp_working}-temp"} = int($row[$i_value]); + $working_unit = $row[$i_unit]; + $working_unit =~ s/degrees\s// if $b_ipmitool; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + # for temp1/2 only use temp1/2 if they are null or greater than the last ones + elsif ($row[$i_key] =~ /^(MB[\s_-]?TEMP1|Temp[\s_]1)$/i){ + $temp_working = int($row[$i_value]); + $working_unit = $row[$i_unit]; + $working_unit =~ s/degrees\s// if $b_ipmitool; + if (!$sensors->{'temp1'} || (defined $temp_working && $temp_working > 0)){ + $sensors->{'temp1'} = $temp_working; + } + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + elsif ($row[$i_key] =~ /^(MB[_]?TEMP2|Temp[\s_]2)$/i){ + $temp_working = int($row[$i_value]); + $working_unit = $row[$i_unit]; + $working_unit =~ s/degrees\s// if $b_ipmitool; + if (!$sensors->{'temp2'} || (defined $temp_working && $temp_working > 0)){ + $sensors->{'temp2'} = $temp_working; + } + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + # temp3 is only used as an absolute override for systems with all 3 present + elsif ($row[$i_key] =~ /^(MB[_]?TEMP3|Temp[\s_]3)$/i){ + $temp_working = int($row[$i_value]); + $working_unit = $row[$i_unit]; + $working_unit =~ s/degrees\s// if $b_ipmitool; + if (!$sensors->{'temp3'} || (defined $temp_working && $temp_working > 0)){ + $sensors->{'temp3'} = $temp_working; + } + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + elsif (!$sensors->{'sodimm-temp'} && ($row[$i_key] =~ /^(DIMM[-_]([A-Z][0-9]+[-_])?[A-Z]?[0-9]+[A-Z]?)$/i || + $row[$i_key] =~ /^DIMM\s?[0-9]+ (Area|Temp).*/)){ + $sensors->{'sodimm-temp'} = int($row[$i_value]); + $working_unit = $row[$i_unit]; + $working_unit =~ s/degrees\s// if $b_ipmitool; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + # note: can be cpu fan:, cpu fan speed:, etc. + elsif ($row[$i_key] =~ /^(CPU|Processor)[\s_]Fan/i || + $row[$i_key] =~ /^SYS\.[0-9][\s_]?\(CPU\s?0\)$/i){ + $speed = int($row[$i_value]); + $sensors->{'fan-main'}->[1] = $speed if $speed < $max_fan; + } + # note that the counters are dynamically set for fan numbers here + # otherwise you could overwrite eg aux fan2 with case fan2 in theory + # note: cpu/mobo/ps are 1/2/3 + # SYS.3(Front 2) + # $row[$i_key] =~ /^(SYS[\.])([0-9])\s?\((Front|Rear).+\)$/i + elsif ($row[$i_key] =~ /^(SYS[\s_])?FAN[\s_]?([0-9A-F]+)/i){ + $sys_fan_nu = hex($2); + $fan_working = int($row[$i_value]); + next if $fan_working > $max_fan; + $sensors->{'fan-default'} = () if !$sensors->{'fan-default'}; + if ($sys_fan_nu =~ /^([0-9]+)$/){ + # add to array if array index does not exist OR if number is > existing number + if (defined $sensors->{'fan-default'}->[$sys_fan_nu]){ + if ($fan_working >= $sensors->{'fan-default'}->[$sys_fan_nu]){ + $sensors->{'fan-default'}->[$sys_fan_nu] = $fan_working; + } + } + else { + $sensors->{'fan-default'}->[$sys_fan_nu] = $fan_working; + } + } + } + elsif ($row[$i_key] =~ /^(FAN PSU|PSU FAN)$/i){ + $speed = int($row[$i_value]); + $sensors->{'fan-psu'} = $speed if $speed < $max_fan; + } + elsif ($row[$i_key] =~ /^(FAN PSU1|PSU1 FAN)$/i){ + $speed = int($row[$i_value]); + $sensors->{'fan-psu-1'} = $speed if $speed < $max_fan; + } + elsif ($row[$i_key] =~ /^(FAN PSU2|PSU2 FAN)$/i){ + $speed = int($row[$i_value]); + $sensors->{'fan-psu-2'} = $speed if $speed < $max_fan; + } + if ($extra > 0){ + if ($row[$i_key] =~ /^((.+\s|P[_]?)?\+?12V|PSU[12]_VOUT)$/i){ + $sensors->{'volts-12'} = $row[$i_value]; + } + elsif ($row[$i_key] =~ /^(.+\s5V|P5V|5VCC|5V( PG)?|5V_SB)$/i){ + $sensors->{'volts-5'} = $row[$i_value]; + } + elsif ($row[$i_key] =~ /^(.+\s3\.3V|P3V3|3\.3VCC|3\.3V( PG)?|3V3_SB)$/i){ + $sensors->{'volts-3.3'} = $row[$i_value]; + } + elsif ($row[$i_key] =~ /^((P_)?VBAT|CMOS Battery|BATT 3.0V)$/i){ + $sensors->{'volts-vbat'} = $row[$i_value]; + } + # NOTE: VDimmP1ABC VDimmP1DEF + elsif (!$sensors->{'volts-dimm-p1'} && $row[$i_key] =~ /^(P1_VMEM|VDimmP1|MEM RSR A PG|DIMM_VR1_VOLT)/i){ + $sensors->{'volts-dimm-p1'} = $row[$i_value]; + } + elsif (!$sensors->{'volts-dimm-p2'} && $row[$i_key] =~ /^(P2_VMEM|VDimmP2|MEM RSR B PG|DIMM_VR2_VOLT)/i){ + $sensors->{'volts-dimm-p2'} = $row[$i_value]; + } + elsif (!$sensors->{'volts-soc-p1'} && $row[$i_key] =~ /^(P1_SOC_RUN$)/i){ + $sensors->{'volts-soc-p1'} = $row[$i_value]; + } + elsif (!$sensors->{'volts-soc-p2'} && $row[$i_key] =~ /^(P2_SOC_RUN$)/i){ + $sensors->{'volts-soc-p2'} = $row[$i_value]; + } + } + } + print Data::Dumper::Dumper $sensors if $dbg[31]; + process_data($sensors) if %$sensors; + main::log_data('dump','ipmi: %$sensors',$sensors) if $b_log; + eval $end if $b_log; + print Data::Dumper::Dumper $sensors if $dbg[31]; + return $sensors; +} + +sub linux_sensors_data { + eval $start if $b_log; + my $sensors = {}; + my ($sys_fan_nu) = (0); + my ($adapter,$fan_working,$temp_working,$working_unit) = ('','','','',''); + foreach $adapter (keys %{$sensors_raw->{'main'}}){ + next if !$adapter || ref $sensors_raw->{'main'}{$adapter} ne 'ARRAY'; + # not sure why hwmon is excluded, forgot to add info in comments + if ((@sensors_use && !(grep {/$adapter/} @sensors_use)) || + (@sensors_exclude && (grep {/$adapter/} @sensors_exclude))){ + next; + } + foreach (@{$sensors_raw->{'main'}{$adapter}}){ + my @working = split(':', $_); + next if !$working[0]; + # print "$working[0]:$working[1]\n"; + # There are some guesses here, but with more sensors samples it will get closer. + # note: using arrays starting at 1 for all fan arrays to make it easier overall + # we have to be sure we are working with the actual real string before assigning + # data to real variables and arrays. Extracting C/F degree unit as well to use + # when constructing temp items for array. + # note that because of charset issues, no "°" degree sign used, but it is required + # in testing regex to avoid error. It might be because I got that data from a forum post, + # note directly via debugger. + if ($_ =~ /^T?(AMBIENT|M\/B|MB|Motherboard|SIO|SYS).*:([0-9\.]+)[\s°]*(C|F)/i){ + # avoid SYSTIN: 118 C + if (main::is_numeric($2) && $2 < 90){ + $sensors->{'mobo-temp'} = $2; + $working_unit = $3; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + } + # issue 58 msi/asus show wrong for CPUTIN so overwrite it if PECI 0 is present + # http://www.spinics.net/lists/lm-sensors/msg37308.html + # NOTE: had: ^CPU.*\+([0-9]+): but that misses: CPUTIN and anything not with + in starter + # However, "CPUTIN is not a reliable measurement because it measures difference to Tjmax, + # which is the maximum CPU temperature reported as critical temperature by coretemp" + # NOTE: I've seen an inexplicable case where: CPU:52.0°C fails to match with [\s°] but + # does match with: [\s°]*. I can't account for this, but that's why the * is there + # Tdie is a new k10temp-pci syntax for real cpu die temp. Tctl is cpu control value, + # NOT the real cpu die temp: UNLESS tctl and tdie are equal, sigh.. + elsif ($_ =~ /^(Chip 0.*?|T?CPU.*|Tdie.*):([0-9\.]+)[\s°]*(C|F)/i){ + $temp_working = $2; + $working_unit = $3; + if (!$sensors->{'cpu-temp'} || + (defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'cpu-temp'})){ + $sensors->{'cpu-temp'} = $temp_working; + } + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + elsif ($_ =~ /^(Tctl.*):([0-9\.]+)[\s°]*(C|F)/i){ + $temp_working = $2; + $working_unit = $3; + if (!$sensors->{'tctl-temp'} || + (defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'tctl-temp'})){ + $sensors->{'tctl-temp'} = $temp_working; + } + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + elsif ($_ =~ /^PECI\sAgent\s0.*:([0-9\.]+)[\s°]*(C|F)/i){ + $sensors->{'cpu-peci-temp'} = $1; + $working_unit = $2; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + elsif ($_ =~ /^T?(P\/S|Power).*:([0-9\.]+)[\s°]*(C|F)/i){ + $sensors->{'psu-temp'} = $2; + $working_unit = $3; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + elsif ($_ =~ /^T?(dimm|mem|sodimm).*?:([0-9\.]+)[\s°]*(C|F)/i){ + $sensors->{'sodimm-temp'} = $1; + $working_unit = $2; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + # for temp1/2 only use temp1/2 if they are null or greater than the last ones + elsif ($_ =~ /^temp1:([0-9\.]+)[\s°]*(C|F)/i){ + $temp_working = $1; + $working_unit = $2; + if (!$sensors->{'temp1'} || + (defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'temp1'})){ + $sensors->{'temp1'} = $temp_working; + } + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + elsif ($_ =~ /^temp2:([0-9\.]+)[\s°]*(C|F)/i){ + $temp_working = $1; + $working_unit = $2; + if (!$sensors->{'temp2'} || + (defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'temp2'})){ + $sensors->{'temp2'} = $temp_working; + } + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + # temp3 is only used as an absolute override for systems with all 3 present + elsif ($_ =~ /^temp3:([0-9\.]+)[\s°]*(C|F)/i){ + $temp_working = $1; + $working_unit = $2; + if (!$sensors->{'temp3'} || + (defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'temp3'})){ + $sensors->{'temp3'} = $temp_working; + } + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + # final fallback if all else fails, funtoo user showed sensors putting + # temp on wrapped second line, not handled + elsif ($_ =~ /^T?(core0|core 0|Physical id 0)(.*):([0-9\.]+)[\s°]*(C|F)/i){ + $temp_working = $3; + $working_unit = $4; + if (!$sensors->{'core-0-temp'} || + (defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'core-0-temp'})){ + $sensors->{'core-0-temp'} = $temp_working; + } + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; + } + # note: can be cpu fan:, cpu fan speed:, etc. + elsif (!defined $sensors->{'fan-main'}->[1] && $_ =~ /^F?(CPU|Processor).*:([0-9]+)[\s]RPM/i){ + $sensors->{'fan-main'}->[1] = $2 if $2 < $max_fan; + } + elsif (!defined $sensors->{'fan-main'}->[2] && $_ =~ /^F?(M\/B|MB|SYS|Motherboard).*:([0-9]+)[\s]RPM/i){ + $sensors->{'fan-main'}->[2] = $2 if $2 < $max_fan; + } + elsif (!defined $sensors->{'fan-main'}->[3] && $_ =~ /F?(Power|P\/S|POWER).*:([0-9]+)[\s]RPM/i){ + $sensors->{'fan-main'}->[3] = $2 if $2 < $max_fan; + } + elsif (!defined $sensors->{'fan-main'}->[4] && $_ =~ /F?(dimm|mem|sodimm).*:([0-9]+)[\s]RPM/i){ + $sensors->{'fan-main'}->[4] = $2 if $2 < $max_fan; + } + # note that the counters are dynamically set for fan numbers here + # otherwise you could overwrite eg aux fan2 with case fan2 in theory + # note: cpu/mobo/ps/sodimm are 1/2/3/4 + elsif ($_ =~ /^F?(AUX|CASE|CHASSIS|FRONT|REAR).*:([0-9]+)[\s]RPM/i){ + next if $2 > $max_fan; + $temp_working = $2; + for (my $i = 5; $i < 30; $i++){ + next if defined $sensors->{'fan-main'}->[$i]; + if (!defined $sensors->{'fan-main'}->[$i]){ + $sensors->{'fan-main'}->[$i] = $temp_working; + last; + } + } + } + # in rare cases syntax is like: fan1: xxx RPM + elsif ($_ =~ /^FAN(1)?:([0-9]+)[\s]RPM/i){ + $sensors->{'fan-default'}->[1] = $2 if $2 < $max_fan; + } + elsif ($_ =~ /^FAN([2-9]|1[0-9]).*:([0-9]+)[\s]RPM/i){ + next if $2 > $max_fan; + $fan_working = $2; + $sys_fan_nu = $1; + if ($sys_fan_nu =~ /^([0-9]+)$/){ + # add to array if array index does not exist OR if number is > existing number + if (defined $sensors->{'fan-default'}->[$sys_fan_nu]){ + if ($fan_working >= $sensors->{'fan-default'}->[$sys_fan_nu]){ + $sensors->{'fan-default'}->[$sys_fan_nu] = $fan_working; + } + } + else { + $sensors->{'fan-default'}->[$sys_fan_nu] = $fan_working; + } + } + } + if ($extra > 0){ + if ($_ =~ /^[+]?(12 Volt|12V|V\+?12).*:([0-9\.]+)\sV/i){ + $sensors->{'volts-12'} = $2; + } + # note: 5VSB is a field name + elsif ($_ =~ /^[+]?(5 Volt|5V|V\+?5):([0-9\.]+)\sV/i){ + $sensors->{'volts-5'} = $2; + } + elsif ($_ =~ /^[+]?(3\.3 Volt|3\.3V|V\+?3\.3).*:([0-9\.]+)\sV/i){ + $sensors->{'volts-3.3'} = $2; + } + elsif ($_ =~ /^(Vbat).*:([0-9\.]+)\sV/i){ + $sensors->{'volts-vbat'} = $2; + } + elsif ($_ =~ /^v(dimm|mem|sodimm).*:([0-9\.]+)\sV/i){ + $sensors->{'volts-mem'} = $2; + } + } + } + } + foreach $adapter (keys %{$sensors_raw->{'pch'}}){ + next if !$adapter || ref $sensors_raw->{'pch'}{$adapter} ne 'ARRAY'; + if ((@sensors_use && !(grep {/$adapter/} @sensors_use)) || + (@sensors_exclude && (grep {/$adapter/} @sensors_exclude))){ + next; + } + $temp_working = ''; + foreach (@{$sensors_raw->{'pch'}{$adapter}}){ + if ($_ =~ /^[^:]+:([0-9\.]+)[\s°]*(C|F)/i){ + $temp_working = $1; + $working_unit = $2; + if (!$sensors->{'pch-temp'} || + (defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'pch-temp'})){ + $sensors->{'pch-temp'} = $temp_working; + } + if (!$sensors->{'temp-unit'} && $working_unit){ + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit); + } + } + } + } + print Data::Dumper::Dumper $sensors if $dbg[31]; + process_data($sensors) if %$sensors; + main::log_data('dump','lm-sensors: %sensors',$sensors) if $b_log; + print Data::Dumper::Dumper $sensors if $dbg[31]; + eval $end if $b_log; + return $sensors; +} + +sub load_lm_sensors { + eval $start if $b_log; + my (@sensors_data,@values); + my ($adapter,$holder,$type) = ('','',''); + if ($fake{'sensors'}){ + # my $file; + # $file = "$fake_data_dir/sensors/lm-sensors/amdgpu-w-fan-speed-stretch-k10.txt"; + # $file = "$fake_data_dir/sensors/lm-sensors/peci-tin-geggo.txt"; + # $file = "$fake_data_dir/sensors/lm-sensors/sensors-w-other-biker.txt"; + # $file = "$fake_data_dir/sensors/lm-sensors/sensors-asus-chassis-1.txt"; + # $file = "$fake_data_dir/sensors/lm-sensors/sensors-devnull-1.txt"; + # $file = "$fake_data_dir/sensors/lm-sensors/sensors-jammin1.txt"; + # $file = "$fake_data_dir/sensors/lm-sensors/sensors-mx-incorrect-1.txt"; + # $file = "$fake_data_dir/sensors/lm-sensors/sensors-maximus-arch-1.txt"; + # $file = "$fake_data_dir/sensors/lm-sensors/kernel-58-sensors-ant-1.txt"; + # $file = "$fake_data_dir/sensors/lm-sensors/sensors-zenpower-nvme-2.txt"; + # $file = "$fake_data_dir/sensors/lm-sensors/sensors-pch-intel-1.txt"; + # $file = "$fake_data_dir/sensors/slm-sensors/ensors-ppc-sr71.txt"; + # $file = "$fake_data_dir/sensors/lm-sensors/sensors-coretemp-acpitz-1.txt"; + # $file = "$fake_data_dir/sensors/lm-sensors/sensors-applesmc-1.txt"; + # @sensors_data = main::reader($file); + } + else { + # only way to get sensor array data? Unless using sensors -j, but can't assume json + @sensors_data = main::grabber($alerts{'sensors'}->{'path'} . ' 2>/dev/null'); + } + # print join("\n", @sensors_data), "\n"; + if (@sensors_data){ + @sensors_data = map {$_ =~ s/\s*:\s*\+?/:/;$_} @sensors_data; + push(@sensors_data, 'END'); + } + # print Data::Dumper::Dumper \@sensors_data; + foreach (@sensors_data){ + # print 'st:', $_, "\n"; + next if /^\s*$/; + $_ = main::trimmer($_); + if (@values && $adapter && (/^Adapter/ || $_ eq 'END')){ + # note: drivetemp: known, but many others could exist + if ($adapter =~ /^(drive|nvme)/){ + $type = 'disk'; + } + elsif ($adapter =~ /^(BAT)/){ + $type = 'bat'; + } + # intel on die io controller, like southbridge/northbridge used to be + elsif ($adapter =~ /^(pch[_-])/){ + $type = 'pch'; + } + elsif ($adapter =~ /^(.*hwmon)-/){ + $type = 'hwmon'; + } + # ath/iwl: wifi; enp/eno/eth/i350bb: lan nic + elsif ($adapter =~ /^(ath|i350bb|iwl|en[op][0-9]|eth)[\S]+-/){ + $type = 'network'; + } + # put last just in case some other sensor type above had intel in name + elsif ($adapter =~ /^(amdgpu|intel|nova|nouveau|radeon)-/){ + $type = 'gpu'; + } + elsif ($adapter =~ /^(acpitz)-/ && $adapter !~ /^(acpitz-virtual)-/ ){ + $type = 'acpitz'; + } + else { + $type = 'main'; + } + $sensors_raw->{$type}{$adapter} = [@values]; + @values = (); + $adapter = ''; + } + if (/^Adapter/){ + $adapter = $holder; + } + elsif (/\S:\S/){ + push(@values, $_); + } + else { + $holder = $_; + } + } + print 'lm sensors: ' , Data::Dumper::Dumper $sensors_raw if $dbg[18]; + main::log_data('dump','lm-sensors data: %$sensors_raw',$sensors_raw) if $b_log; + eval $end if $b_log; +} + +sub load_sys_data { + eval $start if $b_log; + my ($device,$mon,$name,$label,$unit,$value,@values,%hwmons); + my ($j,$holder,$sensor,$type) = (0,'','',''); + my $glob = '/sys/class/hwmon/hwmon*/'; + $glob .= '{name,device,{curr,fan,in,power,temp}*_{input,label}}'; + my @hwmon = main::globber($glob); + # print Data::Dumper::Dumper \@sensors_data; + @hwmon = sort @hwmon; + push(@hwmon,'END'); + foreach my $item (@hwmon){ + next if ! -e $item; + $item =~ m|/sys/class/hwmon/(hwmon\d+)/|; + $mon = $1; + $mon =~ s/hwmon(\d)$/hwmon0$1/ if $mon =~ /hwmon\d$/; + # if it's a new hwmon, dump all previous data to avoid carry-over + if (!defined $hwmons{$mon}){ + $sensor = ''; + $holder = ''; + $j = 0; + } + if ($item =~ m/([^\/]+)_input$/){ + $sensor = $1; + $value = main::reader($item,'strip',0);; + } + # add the label to the just created _input item, if valid + elsif ($item =~ m/([^\/]+)_label$/){ + print "3: mon: $mon id: $sensor holder: $holder file: $item\n" if $dbg[51]; + # if this doesn't match, something unexpected happened, like no _input for + # _label item. Seen that, real. + next if !$holder || $1 ne $holder; + if (defined $hwmons{$mon}->{'sensors'}[$j]{'id'}){ + $sensor = $1; + $hwmons{$mon}->{'sensors'}[$j]{'label'} = main::reader($item,'strip',0); + } + } + if ($sensor && ($sensor ne $holder || $item eq 'END')){ + print "2: mon: $mon id: $sensor holder: $holder file: $item\n" if $dbg[51]; + # add the item, we'll add label after if it's located since it will be next + # in loop due to sort order. + if ($value){ + push(@{$hwmons{$mon}->{'sensors'}},{ + 'id' => $sensor, + 'value' => $value, + }); + $j = $#{$hwmons{$mon}->{'sensors'}}; + } + $holder = $sensor; + ($sensor,$value) = ('',undef,undef); + } + print "1: mon: $mon id: $sensor holder: $holder file: $item\n" if $dbg[51]; + # print "$item\n"; + if ($item =~ /name$/){ + $name = main::reader($item,'strip',0); + if ($name =~ /^(drive|nvme)/){ + $type = 'disk'; + } + elsif ($name =~ /^(BAT)/i){ + $type = 'bat'; + } + # intel on die io controller, like southbridge/northbridge used to be + elsif ($name =~ /^(pch)/){ + $type = 'pch'; + } + elsif ($name =~ /^(.*hwmon)/){ + $type = 'hwmon'; + } + # ath/iwl: wifi; enp/eno/eth/i350bb: lan nic + elsif ($name =~ /^(ath|i350|iwl|en[op][0-9]|eth)[\S]/){ + $type = 'network'; + } + # put last just in case some other sensor type above had intel in name + elsif ($name =~ /^(amdgpu|intel|nova|nouveau|radeon)/){ + $type = 'gpu'; + } + # not confirmed in /sys that name will be acpitz-virtual, verify + elsif ($name =~ /^(acpitz)/ && $name !~ /^(acpitz-virtual)/ ){ + $type = 'acpitz'; + } + else { + $type = 'main'; + } + $hwmons{$mon}->{'name'} = $name; + $hwmons{$mon}->{'type'} = $type; + } + elsif ($item =~ /device$/){ + $device = readlink($item); + print "device: $device\n" if $dbg[51]; + $device =~ s|^.*/||; + $hwmons{$mon}->{'device'} = $device; + } + } + print '/sys/class/hwmon raw: ', Data::Dumper::Dumper \%hwmons if $dbg[18]; + main::log_data('dump','/sys data raw: %hwmons',\%hwmons) if $b_log; + # $sensors_raw->{$type}{$adapter} = [@values]; + foreach my $hwmon (sort keys %hwmons){ + my $adapter = $hwmons{$hwmon}->{'name'}; + $hwmons{$hwmon}->{'device'} =~ s/^0000://; + $adapter .= '-' . $hwmons{$hwmon}->{'device'}; + ($unit,$value,@values) = (); + foreach my $item (@{$hwmons{$hwmon}->{'sensors'}}){ + next if !defined $item->{'id'}; + my $name = ($item->{'label'}) ? $item->{'label'}: $item->{'id'}; + if ($item->{'id'} =~ /^temp/){ + $unit = 'C'; + $value = sprintf('%0.1f',$item->{'value'}/1000); + } + elsif ($item->{'id'} =~ /^fan/){ + $unit = 'rpm'; + $value = $item->{'value'}; + } + # note: many sensors require further math on value, so these will be wrong + # in many cases since this is not running the math on the results like + # lm-sensors will do if sensors are detected and loaded and configured. + elsif ($item->{'id'} =~ /^in\d/){ + if ($item->{'value'} >= 1000){ + $unit = 'V'; + $value = sprintf('%0.2f',$item->{'value'}/1000) + 0; + if ($hwmons{$hwmon}->{'type'} eq 'main' && $name =~ /^in\d/){ + if ($value >= 10 && $value <= 14){ + $name = '12V'; + } + elsif ($value >= 4 && $value <= 6){ + $name = '5V'; + } + # vbat can be 3, 3.3, but so can 3.3V board + } + } + else { + $unit = 'mV'; + $value = $item->{'value'}; + } + } + elsif ($item->{'id'} =~ /^power/){ + $unit = 'W'; + $value = sprintf('%0.1f',$item->{'value'}/1000); + } + if (defined $value && defined $unit){ + my $string = $name . ':' . $value . " $unit"; + push(@values,$string); + } + } + # if ($hwmons{$hwmon}->{'type'} eq 'acpitz' && $hwmons{$hwmon}->{'device'}){ + # my $tz ='/sys/class/thermal/' . $hwmons{$hwmon}->{'device'} . '/type'; + # if (-e $tz){ + # my $tz_type = main::reader($tz,'strip',0),"\n"; + # } + # } + if (@values){ + $sensors_raw->{$hwmons{$hwmon}->{'type'}}{$adapter} = [@values]; + } + } + print '/sys/class/hwmon processed: ' , Data::Dumper::Dumper $sensors_raw if $dbg[18]; + main::log_data('dump','/sys data: %$sensors_raw',$sensors_raw) if $b_log; + eval $end if $b_log; +} + +# bsds sysctl may have hw.sensors data +sub sysctl_data { + eval $start if $b_log; + my (@data); + my $sensors = {}; + # assume always starts at 0, can't do dynamic because freebsd shows tz1 first + my $add = 1; + print Data::Dumper::Dumper $sysctl{'sensor'} if $dbg[18];; + foreach (@{$sysctl{'sensor'}}){ + my ($sensor,$type,$number,$value); + if (/^hw\.sensors\.([a-z]+)([0-9]+)\.(cpu|temp|fan|volt)([0-9])/){ + $sensor = $1; + $type = $3; + $number = $4; + # hw.sensors.cpu0.temp0:47.00 degC + # hw.sensors.acpitz0.temp0:43.00 degC + $type = 'cpu' if $sensor eq 'cpu'; + } + elsif (/^hw\.sensors\.(acpi)\.(thermal)\.(tz)([0-9]+)\.(temperature)/){ + $sensor = $1 . $3; # eg acpitz + $type = ($5 eq 'temperature') ? 'temp': $5; + $number = $4; + } + elsif (/^dev\.(cpu)\.([0-9]+)\.(temperature)/){ + $sensor = $1; + $type = $3; + $number = $2; + $type = 'cpu' if $sensor eq 'cpu'; + } + if ($sensor && $type){ + if ($sensor && ((@sensors_use && !(grep {/$sensor/} @sensors_use)) || + (@sensors_exclude && (grep {/$sensor/} @sensors_exclude)))){ + next; + } + my $working = (split(':\s*', $_))[1]; + if (defined $working && $working =~ /^([0-9\.]+)\s?((deg)?([CF]))?\b/){ + $value = $1 ; + $sensors->{'temp-unit'} = $4 if $4 && !$sensors->{'temp-unit'}; + } + else { + next; + } + $number += $add; + if ($type eq 'cpu' && !defined $sensors->{'cpu-temp'}){ + $sensors->{'cpu-temp'} = $value; + } + elsif ($type eq 'temp' && !defined $sensors->{'temp' . $number}){ + $sensors->{'temp' . $number} = $value; + } + elsif ($type eq 'fan' && !defined $sensors->{'fan-main'}->[$number]){ + $sensors->{'fan-main'}->[$number] = $value if $value < $max_fan; + } + elsif ($type eq 'volt'){ + if ($working =~ /\+3\.3V/i){ + $sensors->{'volts-3.3'} = $value; + } + elsif ($working =~ /\+5V/i){ + $sensors->{'volts-5'} = $value; + } + elsif ($working =~ /\+12V/i){ + $sensors->{'volts-12'} = $value; + } + elsif ($working =~ /VBAT/i){ + $sensors->{'volts-vbat'} = $value; + } + } + } + } + process_data($sensors) if %$sensors; + main::log_data('dump','%$sensors',$sensors) if $b_log; + print Data::Dumper::Dumper $sensors if $dbg[31];; + eval $end if $b_log; + return $sensors; +} + +sub set_temp_unit { + my ($sensors,$working) = @_; + my $return_unit = ''; + if (!$sensors && $working){ + $return_unit = $working; + } + elsif ($sensors){ + $return_unit = $sensors; + } + return $return_unit; +} + +sub process_data { + eval $start if $b_log; + my ($sensors) = @_; + my ($cpu_temp,$cpu2_temp,$cpu3_temp,$cpu4_temp,$mobo_temp,$pch_temp,$psu_temp); + my ($fan_type,$i,$j,$index_count_fan_default,$index_count_fan_main) = (0,0,0,0,0); + my $temp_diff = 20; # for C, handled for F after that is determined + my (@fan_main,@fan_default); + # kernel/sensors only show Tctl if Tctl == Tdie temp, sigh... + if (!$sensors->{'cpu-temp'} && $sensors->{'tctl-temp'}){ + $sensors->{'cpu-temp'} = $sensors->{'tctl-temp'}; + undef $sensors->{'tctl-temp'}; + } + # first we need to handle the case where we have to determine which temp/fan to use for cpu and mobo: + # note, for rare cases of weird cool cpus, user can override in their prefs and force the assignment + # this is wrong for systems with > 2 tempX readings, but the logic is too complex with 3 variables + # so have to accept that it will be wrong in some cases, particularly for motherboard temp readings. + if ($sensors->{'temp1'} && $sensors->{'temp2'}){ + if ($sensors_cpu_nu){ + $fan_type = $sensors_cpu_nu; + } + else { + # first some fringe cases with cooler cpu than mobo: assume which is cpu temp based on fan speed + # but only if other fan speed is 0. + if ($sensors->{'temp1'} >= $sensors->{'temp2'} && + defined $fan_default[1] && defined $fan_default[2] && $fan_default[1] == 0 && $fan_default[2] > 0){ + $fan_type = 2; + } + elsif ($sensors->{'temp2'} >= $sensors->{'temp1'} && + defined $fan_default[1] && defined $fan_default[2] && $fan_default[2] == 0 && $fan_default[1] > 0){ + $fan_type = 1; + } + # then handle the standard case if these fringe cases are false + elsif ($sensors->{'temp1'} >= $sensors->{'temp2'}){ + $fan_type = 1; + } + else { + $fan_type = 2; + } + } + } + # need a case for no temps at all reported, like with old intels + elsif (!$sensors->{'temp2'} && !$sensors->{'cpu-temp'}){ + if (!$sensors->{'temp1'} && !$sensors->{'mobo-temp'}){ + $fan_type = 1; + } + elsif ($sensors->{'temp1'} && !$sensors->{'mobo-temp'}){ + $fan_type = 1; + } + elsif ($sensors->{'temp1'} && $sensors->{'mobo-temp'}){ + $fan_type = 1; + } + } + # convert the diff number for F, it needs to be bigger that is + if ($sensors->{'temp-unit'} && $sensors->{'temp-unit'} eq "F"){ + $temp_diff = $temp_diff * 1.8 + } + if ($sensors->{'cpu-temp'}){ + # specific hack to handle broken CPUTIN temps with PECI + if ($sensors->{'cpu-peci-temp'} && ($sensors->{'cpu-temp'} - $sensors->{'cpu-peci-temp'}) > $temp_diff){ + $cpu_temp = $sensors->{'cpu-peci-temp'}; + } + # then get the real cpu temp, best guess is hottest is real, though only within narrowed diff range + else { + $cpu_temp = $sensors->{'cpu-temp'}; + } + } + else { + if ($fan_type){ + # there are some weird scenarios + if ($fan_type == 1){ + if ($sensors->{'temp1'} && $sensors->{'temp2'} && $sensors->{'temp2'} > $sensors->{'temp1'}){ + $cpu_temp = $sensors->{'temp2'}; + } + else { + $cpu_temp = $sensors->{'temp1'}; + } + } + else { + if ($sensors->{'temp1'} && $sensors->{'temp2'} && $sensors->{'temp1'} > $sensors->{'temp2'}){ + $cpu_temp = $sensors->{'temp1'}; + } + else { + $cpu_temp = $sensors->{'temp2'}; + } + } + } + else { + $cpu_temp = $sensors->{'temp1'}; # can be null, that is ok + } + if ($cpu_temp){ + # using $sensors->{'temp3'} is just not reliable enough, more errors caused than fixed imo + # if ($sensors->{'temp3'} && $sensors->{'temp3'} > $cpu_temp){ + # $cpu_temp = $sensors->{'temp3'}; + # } + # there are some absurdly wrong $sensors->{'temp1'}: acpitz-virtual-0 $sensors->{'temp1'}: +13.8°C + if ($sensors->{'core-0-temp'} && ($sensors->{'core-0-temp'} - $cpu_temp) > $temp_diff){ + $cpu_temp = $sensors->{'core-0-temp'}; + } + } + } + # if all else fails, use core0/peci temp if present and cpu is null + if (!$cpu_temp){ + if ($sensors->{'core-0-temp'}){ + $cpu_temp = $sensors->{'core-0-temp'}; + } + # note that peci temp is known to be colder than the actual system + # sometimes so it is the last fallback we want to use even though in theory + # it is more accurate, but fact suggests theory wrong. + elsif ($sensors->{'cpu-peci-temp'}){ + $cpu_temp = $sensors->{'cpu-peci-temp'}; + } + } + # then the real mobo temp + if ($sensors->{'mobo-temp'}){ + $mobo_temp = $sensors->{'mobo-temp'}; + } + elsif ($fan_type){ + if ($fan_type == 1){ + if ($sensors->{'temp1'} && $sensors->{'temp2'} && $sensors->{'temp2'} > $sensors->{'temp1'}){ + $mobo_temp = $sensors->{'temp1'}; + } + else { + $mobo_temp = $sensors->{'temp2'}; + } + } + else { + if ($sensors->{'temp1'} && $sensors->{'temp2'} && $sensors->{'temp1'} > $sensors->{'temp2'}){ + $mobo_temp = $sensors->{'temp2'}; + } + else { + $mobo_temp = $sensors->{'temp1'}; + } + } + ## NOTE: not safe to assume $sensors->{'temp3'} is the mobo temp, sad to say + # if ($sensors->{'temp1'} && $sensors->{'temp2'} && $sensors->{'temp3'} && $sensors->{'temp3'} < $mobo_temp){ + # $mobo_temp = $sensors->{'temp3'}; + # } + } + # in case with cpu-temp AND temp1 and not temp 2, or temp 2 only, fan type: 0 + else { + if ($sensors->{'cpu-temp'} && $sensors->{'temp1'} && + $sensors->{'cpu-temp'} > $sensors->{'temp1'}){ + $mobo_temp = $sensors->{'temp1'}; + } + elsif ($sensors->{'temp2'}){ + $mobo_temp = $sensors->{'temp2'}; + } + } + @fan_main = @{$sensors->{'fan-main'}} if $sensors->{'fan-main'}; + $index_count_fan_main = (@fan_main) ? scalar @fan_main : 0; + @fan_default = @{$sensors->{'fan-default'}} if $sensors->{'fan-default'}; + $index_count_fan_default = (@fan_default) ? scalar @fan_default : 0; + # then set the cpu fan speed + if (!$fan_main[1]){ + # note, you cannot test for $fan_default[1] or [2] != "" + # because that creates an array item in gawk just by the test itself + if ($fan_type == 1 && defined $fan_default[1]){ + $fan_main[1] = $fan_default[1]; + $fan_default[1] = undef; + } + elsif ($fan_type == 2 && defined $fan_default[2]){ + $fan_main[1] = $fan_default[2]; + $fan_default[2] = undef; + } + } + # clear out any duplicates. Primary fan real trumps fan working always if same speed + for ($i = 1; $i <= $index_count_fan_main; $i++){ + if (defined $fan_main[$i] && $fan_main[$i]){ + for ($j = 1; $j <= $index_count_fan_default; $j++){ + if (defined $fan_default[$j] && $fan_main[$i] == $fan_default[$j]){ + $fan_default[$j] = undef; + } + } + } + } + # now see if you can find the fast little mobo fan, > 5000 rpm and put it as mobo + # note that gawk is returning true for some test cases when $fan_default[j] < 5000 + # which has to be a gawk bug, unless there is something really weird with arrays + # note: 500 > $fan_default[j] < 1000 is the exact trigger, and if you manually + # assign that value below, the > 5000 test works again, and a print of the value + # shows the proper value, so the corruption might be internal in awk. + # Note: gensub is the culprit I think, assigning type string for range 501-1000 but + # type integer for all others, this triggers true for > + for ($j = 1; $j <= $index_count_fan_default; $j++){ + if (defined $fan_default[$j] && $fan_default[$j] > 5000 && !$fan_main[2]){ + $fan_main[2] = $fan_default[$j]; + $fan_default[$j] = undef; + # then add one if required for output + if ($index_count_fan_main < 2){ + $index_count_fan_main = 2; + } + } + } + # if they are ALL null, print error message. psFan is not used in output currently + if (!$cpu_temp && !$mobo_temp && !$fan_main[1] && !$fan_main[2] && !$fan_main[1] && !@fan_default){ + %$sensors = (); + } + else { + my ($ambient_temp,$psu_fan,$psu1_fan,$psu2_fan,$psu_temp,$sodimm_temp, + $v_12,$v_5,$v_3_3,$v_dimm_p1,$v_dimm_p2,$v_soc_p1,$v_soc_p2,$v_vbat); + $psu_temp = $sensors->{'psu-temp'} if $sensors->{'psu-temp'}; + # sodimm fan is fan_main[4] + $sodimm_temp = $sensors->{'sodimm-temp'} if $sensors->{'sodimm-temp'}; + $cpu2_temp = $sensors->{'cpu2-temp'} if $sensors->{'cpu2-temp'}; + $cpu3_temp = $sensors->{'cpu3-temp'} if $sensors->{'cpu3-temp'}; + $cpu4_temp = $sensors->{'cpu4-temp'} if $sensors->{'cpu4-temp'}; + $ambient_temp = $sensors->{'ambient-temp'} if $sensors->{'ambient-temp'}; + $pch_temp = $sensors->{'pch-temp'} if $sensors->{'pch-temp'}; + $psu_fan = $sensors->{'fan-psu'} if $sensors->{'fan-psu'}; + $psu1_fan = $sensors->{'fan-psu-1'} if $sensors->{'fan-psu-1'}; + $psu2_fan = $sensors->{'fan-psu-2'} if $sensors->{'fan-psu-2'}; + # so far only for ipmi, sensors data is junk for volts + if ($extra > 0 && ($sensors->{'volts-12'} || $sensors->{'volts-5'} || + $sensors->{'volts-3.3'} || $sensors->{'volts-vbat'})){ + $v_12 = $sensors->{'volts-12'} if $sensors->{'volts-12'}; + $v_5 = $sensors->{'volts-5'} if $sensors->{'volts-5'}; + $v_3_3 = $sensors->{'volts-3.3'} if $sensors->{'volts-3.3'}; + $v_vbat = $sensors->{'volts-vbat'} if $sensors->{'volts-vbat'}; + $v_dimm_p1 = $sensors->{'volts-dimm-p1'} if $sensors->{'volts-dimm-p1'}; + $v_dimm_p2 = $sensors->{'volts-dimm-p2'} if $sensors->{'volts-dimm-p2'}; + $v_soc_p1 = $sensors->{'volts-soc-p1'} if $sensors->{'volts-soc-p1'}; + $v_soc_p2 = $sensors->{'volts-soc-p2'} if $sensors->{'volts-soc-p2'}; + } + %$sensors = ( + 'ambient-temp' => $ambient_temp, + 'cpu-temp' => $cpu_temp, + 'cpu2-temp' => $cpu2_temp, + 'cpu3-temp' => $cpu3_temp, + 'cpu4-temp' => $cpu4_temp, + 'mobo-temp' => $mobo_temp, + 'pch-temp' => $pch_temp, + 'psu-temp' => $psu_temp, + 'temp-unit' => $sensors->{'temp-unit'}, + 'fan-main' => \@fan_main, + 'fan-default' => \@fan_default, + 'fan-psu' => $psu_fan, + 'fan-psu1' => $psu1_fan, + 'fan-psu2' => $psu2_fan, + ); + if ($psu_temp){ + $sensors->{'psu-temp'} = $psu_temp; + } + if ($sodimm_temp){ + $sensors->{'sodimm-temp'} = $sodimm_temp; + } + if ($extra > 0 && ($v_12 || $v_5 || $v_3_3 || $v_vbat)){ + $sensors->{'volts-12'} = $v_12; + $sensors->{'volts-5'} = $v_5; + $sensors->{'volts-3.3'} = $v_3_3; + $sensors->{'volts-vbat'} = $v_vbat; + $sensors->{'volts-dimm-p1'} = $v_dimm_p1; + $sensors->{'volts-dimm-p2'} = $v_dimm_p2; + $sensors->{'volts-soc-p1'} = $v_soc_p1; + $sensors->{'volts-soc-p2'} = $v_soc_p2; + } + } + eval $end if $b_log; +} + +sub gpu_sensor_data { + eval $start if $b_log; + my ($cmd,@data,@data2,$path,@screens,$temp); + my $j = 0; + $loaded{'gpu-data'} = 1; + if ($path = main::check_program('nvidia-settings')){ + # first get the number of screens. This only work if you are in X + if ($b_display){ + @data = main::grabber("$path -q screens 2>/dev/null"); + foreach (@data){ + if (/(:[0-9]\.[0-9])/){ + push(@screens, $1); + } + } + } + # do a guess, this will work for most users, it's better than nothing for out of X + else { + $screens[0] = ':0.0'; + } + # now we'll get the gpu temp for each screen discovered. The print out function + # will handle removing screen data for single gpu systems. -t shows only data we want + # GPUCurrentClockFreqs: 520,600 + # GPUCurrentFanSpeed: 50 0-100, not rpm, percent I think + # VideoRam: 1048576 + # CUDACores: 16 + # PCIECurrentLinkWidth: 16 + # PCIECurrentLinkSpeed: 5000 + # RefreshRate: 60.02 Hz [oer screen] + # ViewPortOut=1280x1024+0+0}, DPY-1: nvidia-auto-select @1280x1024 +1280+0 {ViewPortIn=1280x1024, + # ViewPortOut=1280x1024+0+0} + # ThermalSensorReading: 50 + # PCIID: 4318,2661 - the pci stuff doesn't appear to work + # PCIBus: 2 + # PCIDevice: 0 + # Irq: 30 + foreach my $screen (@screens){ + my $screen2 = $screen; + $screen2 =~ s/\.[0-9]$//; + $cmd = '-q GPUCoreTemp -q VideoRam -q GPUCurrentClockFreqs -q PCIECurrentLinkWidth '; + $cmd .= '-q Irq -q PCIBus -q PCIDevice -q GPUCurrentFanSpeed'; + $cmd = "$path -c $screen2 $cmd 2>/dev/null"; + @data = main::grabber($cmd); + main::log_data('cmd',$cmd) if $b_log; + push(@data,@data2); + $j = scalar @$gpu_data; + foreach my $item (@data){ + if ($item =~ /^\s*Attribute\s\'([^']+)\'\s.*:\s*([\S]+)\.$/){ + my $attribute = $1; + my $value = $2; + $gpu_data->[$j]{'type'} = 'nvidia'; + $gpu_data->[$j]{'speed-unit'} = '%'; + $gpu_data->[$j]{'screen'} = $screen; + if (!$gpu_data->[$j]{'temp'} && $attribute eq 'GPUCoreTemp'){ + $gpu_data->[$j]{'temp'} = $value; + } + elsif (!$gpu_data->[$j]{'ram'} && $attribute eq 'VideoRam'){ + $gpu_data->[$j]{'ram'} = $value; + } + elsif (!$gpu_data->[$j]{'clock'} && $attribute eq 'GPUCurrentClockFreqs'){ + $gpu_data->[$j]{'clock'} = $value; + } + elsif (!$gpu_data->[$j]{'bus'} && $attribute eq 'PCIBus'){ + $gpu_data->[$j]{'bus'} = $value; + } + elsif (!$gpu_data->[$j]{'bus-id'} && $attribute eq 'PCIDevice'){ + $gpu_data->[$j]{'bus-id'} = $value; + } + elsif (!$gpu_data->[$j]{'fan-speed'} && $attribute eq 'GPUCurrentFanSpeed'){ + $gpu_data->[$j]{'fan-speed'} = $value; + } + } + } + } + } + if ($path = main::check_program('aticonfig')){ + # aticonfig --adapter=0 --od-gettemperature + @data = main::grabber("$path --adapter=all --od-gettemperature 2>/dev/null"); + foreach (@data){ + if (/Sensor [^0-9]*([0-9\.]+) /){ + $j = scalar @$gpu_data; + my $value = $1; + $gpu_data->[$j]{'type'} = 'amd'; + $gpu_data->[$j]{'temp'} = $value; + } + } + } + if ($sensors_raw->{'gpu'}){ + # my ($b_found,$holder) = (0,''); + foreach my $adapter (keys %{$sensors_raw->{'gpu'}}){ + $j = scalar @$gpu_data; + $gpu_data->[$j]{'type'} = $adapter; + $gpu_data->[$j]{'type'} =~ s/^(amdgpu|intel|nouveau|nova|radeon)-.*/$1/; + # print "ad: $adapter\n"; + foreach (@{$sensors_raw->{'gpu'}{$adapter}}){ + # print "val: $_\n"; + if (/^[^:]*mem[^:]*:([0-9\.]+).*\b(C|F)\b/i){ + $gpu_data->[$j]{'temp-mem'} = $1; + $gpu_data->[$j]{'unit'} = $2; + # print "temp: $_\n"; + } + elsif (/^[^:]+:([0-9\.]+).*\b(C|F)\b/i){ + $gpu_data->[$j]{'temp'} = $1; + $gpu_data->[$j]{'unit'} = $2; + # print "temp: $_\n"; + } + # speeds can be in percents or rpms, so need the 'fan' in regex + elsif (/^.*?fan.*?:([0-9\.]+).*(RPM)?/i){ + $gpu_data->[$j]{'fan-speed'} = $1; + # NOTE: we test for nvidia %, everything else stays with nothing + $gpu_data->[$j]{'speed-unit'} = ''; + } + elsif (/^[^:]+:([0-9\.]+)\s+W\s/i){ + $gpu_data->[$j]{'watts'} = $1; + } + elsif (/^[^:]+:([0-9\.]+)\s+(m?V)\s/i){ + $gpu_data->[$j]{'volts-gpu'} = [$1,$2]; + } + } + } + } + main::log_data('dump','sensors output: video: @$gpu_data',$gpu_data) if $b_log; + print 'gpu_data: ', Data::Dumper::Dumper $gpu_data if $dbg[18]; + eval $end if $b_log; +} +} + +## SlotItem ## +{ +package SlotItem; +my ($sys_slots); + +sub get { + eval $start if $b_log; + my ($data,$key1,$val1); + my $rows = []; + my $num = 0; + if ($fake{'dmidecode'} || ($alerts{'dmidecode'}->{'action'} eq 'use' && + (!%risc || $use{'slot-tool'}))){ + if ($b_admin && -e '/sys/devices/pci0000:00'){ + slot_data_sys(); + } + $data = slot_data_dmi(); + slot_output($rows,$data) if @$data; + if (!@$rows){ + my $key = 'Message'; + push(@$rows, { + main::key($num++,0,1,$key) => main::message('pci-slot-data','') + }); + } + } + elsif (%risc && !$use{'slot-tool'}){ + $key1 = 'Message'; + $val1 = main::message('risc-pci',$risc{'id'}); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); + } + elsif ($alerts{'dmidecode'}->{'action'} ne 'use'){ + $key1 = $alerts{'dmidecode'}->{'action'}; + $val1 = $alerts{'dmidecode'}->{'message'}; + $key1 = ucfirst($key1); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); + } + eval $end if $b_log; + return $rows; +} + +sub slot_output { + eval $start if $b_log; + my ($rows,$data) = @_; + my $num = 1; + foreach my $slot_data (@$data){ + next if !$slot_data || ref $slot_data ne 'HASH'; + $num = 1; + my $j = scalar @$rows; + $slot_data->{'id'} = 'N/A' if !defined $slot_data->{'id'}; # can be 0 + $slot_data->{'pci'} ||= 'N/A'; + push(@$rows, { + main::key($num++,1,1,'Slot') => $slot_data->{'id'}, + main::key($num++,0,2,'type') => $slot_data->{'pci'}, + },); + # PCIe only + if ($extra > 1 && $slot_data->{'gen'}){ + $rows->[$j]{main::key($num++,0,2,'gen')} = $slot_data->{'gen'}; + } + if ($slot_data->{'lanes-phys'} && $slot_data->{'lanes-active'} && + $slot_data->{'lanes-phys'} ne $slot_data->{'lanes-active'}){ + $rows->[$j]{main::key($num++,1,2,'lanes')} = ''; + $rows->[$j]{main::key($num++,0,3,'phys')} = $slot_data->{'lanes-phys'}; + $rows->[$j]{main::key($num++,0,3,'active')} = $slot_data->{'lanes-active'}; + } + elsif ($slot_data->{'lanes-phys'}){ + $rows->[$j]{main::key($num++,0,2,'lanes')} = $slot_data->{'lanes-phys'}; + } + # Non PCIe only + if ($extra > 1 && $slot_data->{'bits'}){ + $rows->[$j]{main::key($num++,0,2,'bits')} = $slot_data->{'bits'}; + } + # PCI-X and PCI only + if ($extra > 1 && $slot_data->{'mhz'}){ + $rows->[$j]{main::key($num++,0,2,'MHz')} = $slot_data->{'mhz'}; + } + $rows->[$j]{main::key($num++,0,2,'status')} = $slot_data->{'usage'}; + if ($slot_data->{'extra'}){ + $rows->[$j]{main::key($num++,0,2,'info')} = join(', ', @{$slot_data->{'extra'}}); + } + if ($extra > 1){ + $slot_data->{'length'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'length')} = $slot_data->{'length'}; + if ($slot_data->{'cpu'}){ + $rows->[$j]{main::key($num++,0,2,'cpu')} = $slot_data->{'cpu'}; + } + if ($slot_data->{'volts'}){ + $rows->[$j]{main::key($num++,0,2,'volts')} = $slot_data->{'volts'}; + } + } + if ($extra > 0){ + $slot_data->{'bus_address'} ||= 'N/A'; + $rows->[$j]{main::key($num++,1,2,'bus-ID')} = $slot_data->{'bus_address'}; + if ($b_admin && $slot_data->{'children'}){ + children_output($rows,$j,\$num,$slot_data->{'children'},3); + } + } + } + eval $end if $b_log; +} +sub children_output { + my ($rows,$j,$num,$children,$ind) = @_; + my $cnt = 0; + $rows->[$j]{main::key($$num++,1,$ind,'children')} = ''; + $ind++; + foreach my $id (sort keys %{$children}){ + $cnt++; + $rows->[$j]{main::key($$num++,1,$ind,$cnt)} = $id; + if ($children->{$id}{'class-id'} && $children->{$id}{'class-id-sub'}){ + my $class = $children->{$id}{'class-id'} . $children->{$id}{'class-id-sub'}; + $rows->[$j]{main::key($$num++,0,($ind + 1),'class-ID')} = $class; + if ($children->{$id}{'class'}){ + $rows->[$j]{main::key($$num++,0,($ind + 1),'type')} = $children->{$id}{'class'}; + } + } + if ($children->{$id}{'children'}){ + children_output($rows,$j,$num,$children->{$id}{'children'},$ind + 1); + } + } +} + +sub slot_data_dmi { + eval $start if $b_log; + my $i = 0; + my $slots = []; + foreach my $slot_data (@dmi){ + next if $slot_data->[0] != 9; + my (%data,@extra); + # skip first two row, we don't need that data + foreach my $item (@$slot_data[2 .. $#$slot_data]){ + if ($item !~ /^~/){ # skip the indented rows + my @value = split(/:\s+/, $item, 2); + if ($value[0] eq 'Type'){ + $data{'type'} = $value[1]; + } + if ($value[0] eq 'Designation'){ + $data{'designation'} = $value[1]; + } + if ($value[0] eq 'Current Usage'){ + $data{'usage'} = lc($value[1]); + } + if ($value[0] eq 'ID'){ + $data{'id'} = $value[1]; + } + if ($value[0] eq 'Length'){ + $data{'length'} = lc($value[1]); + } + if ($value[0] eq 'Bus Address'){ + $value[1] =~ s/^0000://; + $data{'bus_address'} = $value[1]; + if ($b_admin && $sys_slots){ + $data{'children'} = slot_children($data{'bus_address'},$sys_slots); + } + } + } + elsif ($item =~ /^~([\d.]+)[\s-]?V is provided/){ + $data{'volts'} = $1; + } + } + if ($data{'type'} eq 'Other' && $data{'designation'}){ + $data{'type'} = $data{'designation'}; + undef $data{'designation'}; + } + foreach my $string (($data{'type'},$data{'designation'})){ + next if !$string; + print "st: $string\n" if $dbg[48]; + $string =~ s/(PCI[\s_-]?Express|Pci[_-]?e)/PCIe /ig; + $string =~ s/PCI[\s_-]?X/PCIX /ig; + $string =~ s/Mini[\s_-]?PCI/MiniPCI /ig; + $string =~ s/Media[\s_-]?Card/MediaCard/ig; + $string =~ s/Express[\s_-]?Card/ExpressCard/ig; + $string =~ s/Card[\s_-]?Bus/CardBus/ig; + $string =~ s/PCMCIA/PCMCIA /ig; + if (!$data{'pci'} && $string =~ /(AGP|ISA|MiniPCI|PCIe|PCIX|PCMCIA|PCI)/){ + $data{'pci'} = $1; + # print "pci: $data{'pci'}\n"; + } + if ($string =~ /(MiniPCI|PCMCIA)/){ + $data{'pci'} = $1; + # print "pci: $data{'pci'}\n"; + } + # legacy format: PCIE#3-x8 + if (!$data{'lanes-phys'} && $string =~ /(^x|#\d+-x)(\d+)/){ + $data{'lanes-phys'} = $2; + } + if (!$data{'lanes-active'} && $string =~ /^x\d+ .*? x(\d+)/){ + $data{'lanes-active'} = $1; + } + # legacy format, seens with PCI-X/PCIe mobos: PCIX#2-100MHz, PCIE#3-x8 + if (!defined $data{'id'} && $string =~ /(#|PCI)(\d+)\b/){ + $data{'id'} = $2; + } + if (!defined $data{'id'} && $string =~ /SLOT[\s-]?(\d+)\b/i){ + $data{'id'} = $1; + } + if ($string =~ s/\bJ-?(\S+)\b//){ + push(@extra,'J' . $1) if ! grep {$_ eq 'J' . $1} @extra; + } + if ($string =~ s/\bM\.?2\b//){ + push(@extra,'M.2') if ! grep {$_ eq 'M.2'} @extra; + } + if ($string =~ /(ExpressCard|MediaCard|CardBus)/){ + push(@extra,$1) if ! grep {$_ eq $1} @extra; + } + if (!$data{'cpu'} && $string =~ s/CPU-?(\d+)\b//){ + $data{'cpu'} = $1; + } + if (!$data{'gen'} && $data{'pci'} && $data{'pci'} eq 'PCIe' && + $string =~ /PCIe[\s_-]*([\d.]+)/){ + $data{'gen'} = $1 + 0; + } + if (!$data{'mhz'} && $data{'pci'} && $string =~ /(\d+)[\s_-]?MHz/){ + $data{'mhz'} = $1; + } + if (!$data{'bits'} && $data{'pci'} && $string =~ /\b(\d+)[\s_-]?bit/){ + $data{'bits'} = $1; + } + $i++; + } + if (!$data{'pci'} && $data{'type'} && + $data{'type'} =~ /(ExpressCard|MediaCard|CardBus)/){ + $data{'pci'} = $1; + @extra = grep {$_ ne $data{'pci'}} @extra; + } + $data{'extra'} = [@extra] if @extra; + push(@$slots,{%data}) if %data; + } + print '@$slots: ', Data::Dumper::Dumper $slots if $dbg[48]; + main::log_data('dump','@$slots final',$slots) if $b_log; + eval $end if $b_log; + return $slots; +} + +sub slot_data_sys { + eval $start if $b_log; + my $path = '/sys/devices/pci0000:*/00*'; + my @data = main::globber($path); + my ($full,$id); + foreach $full (@data){ + $id = $full; + $id =~ s/^.*\/\S+:([0-9a-f]{2}:[0-9a-f]{2}\.[0-9a-f]+)$/$1/; + $sys_slots->{$id} = slot_data_recursive($full); + } + print 'sys_slots: ', Data::Dumper::Dumper $sys_slots if $dbg[49]; + main::log_data('dump','$sys_slots',$sys_slots) if $b_log; + eval $end if $b_log; +} + +sub slot_data_recursive { + eval $start if $b_log; + my $path = shift @_; + my $info = {}; + my $id = $path; + $id =~ s/^.*\/\S+:(\S{2}:\S{2}\.\S+)$/$1/; + my ($content,$id2,@files); + # @files = main::globber("$full/{class,current_link_speed,current_link_width,max_link_speed,max_link_width,00*}"); + if (-e "$path/class" && ($content = main::reader("$path/class",'strip',0))){ + if ($content =~ /^0x(\S{2})(\S{2})/){ + $info->{'class-id'} = $1; + $info->{'class-id-sub'} = $2; + $info->{'class'} = DeviceData::pci_class($1); + if ($info->{'class-id'} eq '06'){ + my @files = main::globber("$path/00*:[0-9a-f][0-9a-f]:[0-9a-f][0-9a-f].[0-9a-f]"); + foreach my $item (@files){ + $id = $item; + $id =~ s/^.*\/[0-9a-f]+:([0-9a-f]{2}:[0-9a-f]{2}\.[0-9a-f]+)$/$1/; + $info->{'children'}{$id} = slot_data_recursive($item); + } + } + } + } + if (-e "$path/current_link_speed" && + ($content = main::reader("$path/current_link_speed",'strip',0))){ + $content =~ s/\sPCIe//i; + $info->{'current-link-speed'} = main::clean_dmi($content); + } + if (-e "$path/current_link_width" && + ($content = main::reader("$path/current_link_width",'strip',0))){ + $info->{'current-link-width'} = $content; + } + eval $end if $b_log; + return $info; +} + +sub slot_children { + eval $start if $b_log; + my ($bus_id,$slots) = @_; + my $children = slot_children_recursive($bus_id,$slots); + # $children->{'0a:00.0'}{'children'} = {'3423' => { + # 'class' => 'test','class-id' => '05','class-id-sub' => '10'}}; + print $bus_id, ' children: ', Data::Dumper::Dumper $children if $dbg[49]; + main::log_data('dump','$children',$children) if $b_log; + eval $end if $b_log; + return $children; +} + +sub slot_children_recursive { + my ($bus_id,$slots) = @_; + my $children; + foreach my $key (keys %{$slots}){ + if ($slots->{$bus_id}){ + $children = $slots->{$bus_id}{'children'} if $slots->{$bus_id}{'children'}; + last; + } + elsif ($slots->{$key}{'children'}){ + slot_children_recursive($bus_id,$slots->{$key}{'children'}); + } + } + return $children; +} +} + +## SwapItem ## +{ +package SwapItem; + +sub get { + eval $start if $b_log; + my $rows = []; + my $num = 0; + create_output($rows); + if (!@$rows){ + @$rows = ({main::key($num++,0,1,'Alert') => main::message('swap-data')}); + } + eval $end if $b_log; + return $rows; +} + +sub create_output { + eval $start if $b_log; + my $rows = $_[0]; + my $num = 0; + my $j = 0; + my (@rows,$dev,$percent,$raw_size,$size,$used); + PartitionData::set() if !$bsd_type && !$loaded{'partition-data'}; + DiskDataBSD::set() if $bsd_type && !$loaded{'disk-data-bsd'}; + main::set_mapper() if !$loaded{'mapper'}; + PartitionItem::swap_data() if !$loaded{'set-swap'}; + foreach my $row (@swaps){ + $num = 1; + $size = ($row->{'size'}) ? main::get_size($row->{'size'},'string') : 'N/A'; + $used = main::get_size($row->{'used'},'string','N/A'); # used can be 0 + $percent = (defined $row->{'percent-used'}) ? ' (' . $row->{'percent-used'} . '%)' : ''; + $dev = ($row->{'swap-type'} eq 'file') ? 'file' : 'dev'; + $row->{'swap-type'} = ($row->{'swap-type'}) ? $row->{'swap-type'} : 'N/A'; + if ($b_admin && !$bsd_type && $j == 0){ + $j = scalar @rows; + if (defined $row->{'swappiness'} || defined $row->{'cache-pressure'}){ + $rows->[$j]{main::key($num++,1,1,'Kernel')} = ''; + if (defined $row->{'swappiness'}){ + $rows->[$j]{main::key($num++,0,2,'swappiness')} = $row->{'swappiness'}; + } + if (defined $row->{'cache-pressure'}){ + $rows->[$j]{main::key($num++,0,2,'cache-pressure')} = $row->{'cache-pressure'}; + } + $row->{'zswap-enabled'} ||= 'N/A'; + $rows->[$j]{main::key($num++,1,2,'zswap')} = $row->{'zswap-enabled'}; + if ($row->{'zswap-enabled'} eq 'yes'){ + if (defined $row->{'zswap-compressor'}){ + $rows->[$j]{main::key($num++,0,1,'compressor')} = $row->{'zswap-compressor'}; + } + if (defined $row->{'zswap-max-pool-percent'}){ + $rows->[$j]{main::key($num++,0,1,'max-pool')} = $row->{'zswap-max-pool-percent'} . '%'; + } + } + } + else { + $rows->[$j]{main::key($num++,0,1,'Message')} = main::message('swap-admin'); + } + } + $j = scalar @$rows; + push(@$rows, { + main::key($num++,1,1,'ID') => $row->{'id'}, + main::key($num++,0,2,'type') => $row->{'swap-type'}, + }); + # not used for swap as far as I know + if ($b_admin && $row->{'raw-size'}){ + # It's an error! permissions or missing tool + $raw_size = main::get_size($row->{'raw-size'},'string'); + $rows->[$j]{main::key($num++,0,2,'raw-size')} = $raw_size; + } + # not used for swap as far as I know + if ($b_admin && $row->{'raw-available'} && $size ne 'N/A'){ + $size .= ' (' . $row->{'raw-available'} . '%)'; + } + $rows->[$j]{main::key($num++,0,2,'size')} = $size; + $rows->[$j]{main::key($num++,0,2,'used')} = $used . $percent; + # not used for swap as far as I know + if ($b_admin && $row->{'block-size'}){ + $rows->[$j]{main::key($num++,0,2,'block-size')} = $row->{'block-size'} . ' B';; + #$rows->[$j]{main::key($num++,0,2,'physical')} = $row->{'block-size'} . ' B'; + #$rows->[$j]{main::key($num++,0,2,'logical')} = $row->{'block-logical'} . ' B'; + } + if ($extra > 1 && defined $row->{'priority'}){ + $rows->[$j]{main::key($num++,0,2,'priority')} = $row->{'priority'}; + } + if ($b_admin && $row->{'swap-type'} eq 'zram'){ + if ($row->{'zram-comp'}){ + $rows->[$j]{main::key($num++,1,2,'comp')} = $row->{'zram-comp'}; + if ($row->{'zram-comp-avail'}){ + $rows->[$j]{main::key($num++,0,3,'avail')} = $row->{'zram-comp-avail'}; + } + } + if ($row->{'zram-max-comp-streams'}){ + $rows->[$j]{main::key($num++,0,3,'max-streams')} = $row->{'zram-max-comp-streams'}; + } + } + if ($row->{'mount'} && $use{'filter'}){ + $row->{'mount'} =~ s|/home/[^/]+/(.*)|/home/$filter_string/$1|; + } + $rows->[$j]{main::key($num++,1,2,$dev)} = ($row->{'mount'}) ? $row->{'mount'} : 'N/A'; + if ($b_admin && $row->{'maj-min'}){ + $rows->[$j]{main::key($num++,0,3,'maj-min')} = $row->{'maj-min'}; + } + if ($extra > 0 && $row->{'dev-mapped'}){ + $rows->[$j]{main::key($num++,0,3,'mapped')} = $row->{'dev-mapped'}; + } + if ($show{'label'} && ($row->{'label'} || $row->{'swap-type'} eq 'partition')){ + if ($use{'filter-label'}){ + main::filter_partition('part', \$row->{'label'}, ''); + } + $row->{'label'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'label')} = $row->{'label'}; + } + if ($show{'uuid'} && ($row->{'uuid'} || $row->{'swap-type'} eq 'partition')){ + if ($use{'filter-uuid'}){ + main::filter_partition('part', \$row->{'uuid'}, ''); + } + $row->{'uuid'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'uuid')} = $row->{'uuid'}; + } + } + eval $end if $b_log; +} +} + +## UnmountedItem ## +{ +package UnmountedItem; + +sub get { + eval $start if $b_log; + my ($data,$key1,$val1); + my $rows = []; + my $num = 0; + if ($bsd_type){ + DiskDataBSD::set() if !$loaded{'disk-data-bsd'}; + if (%disks_bsd && ($alerts{'disklabel'}->{'action'} eq 'use' || + $alerts{'gpart'}->{'action'} eq 'use')){ + $data = bsd_data(); + if (!@$data){ + $key1 = 'Message'; + $val1 = main::message('unmounted-data'); + } + else { + create_output($rows,$data); + } + } + else { + if ($alerts{'disklabel'}->{'action'} eq 'permissions'){ + $key1 = 'Message'; + $val1 = $alerts{'disklabel'}->{'message'}; + } + else { + $key1 = 'Message'; + $val1 = main::message('unmounted-data-bsd',$uname[0]); + } + } + } + else { + if ($system_files{'proc-partitions'}){ + $data = proc_data(); + if (!@$data){ + $key1 = 'Message'; + $val1 = main::message('unmounted-data'); + } + else { + create_output($rows,$data); + } + } + else { + $key1 = 'Message'; + $val1 = main::message('unmounted-file'); + } + } + if (!@$rows && $key1){ + @$rows = ({main::key($num++,0,1,$key1) => $val1}); + } + eval $end if $b_log; + return $rows; +} + +sub create_output { + eval $start if $b_log; + my ($rows,$unmounted) = @_; + my ($fs); + my ($j,$num) = (0,0); + @$unmounted = sort { $a->{'dev-base'} cmp $b->{'dev-base'} } @$unmounted; + my $fs_skip = PartitionItem::get_filters('fs-skip'); + foreach my $row (@$unmounted){ + $num = 1; + my $size = ($row->{'size'}) ? main::get_size($row->{'size'},'string') : 'N/A'; + if ($row->{'fs'}){ + $fs = lc($row->{'fs'}); + } + else { + if ($bsd_type){ + $fs = 'N/A'; + } + elsif (main::check_program('file')){ + $fs = ($b_root) ? 'N/A' : main::message('root-required'); + } + else { + $fs = main::message('tool-missing-basic','file'); + } + } + $j = scalar @$rows; + push(@$rows, { + main::key($num++,1,1,'ID') => "/dev/$row->{'dev-base'}", + }); + if ($b_admin && $row->{'maj-min'}){ + $rows->[$j]{main::key($num++,0,2,'maj-min')} = $row->{'maj-min'}; + } + if ($extra > 0 && $row->{'dev-mapped'}){ + $rows->[$j]{main::key($num++,0,2,'mapped')} = $row->{'dev-mapped'}; + } + $row->{'label'} ||= 'N/A'; + $row->{'uuid'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'size')} = $size; + $rows->[$j]{main::key($num++,0,2,'fs')} = $fs; + # don't show for fs known to not have label/uuid + if (($show{'label'} || $show{'uuid'}) && $fs !~ /^$fs_skip$/){ + if ($show{'label'}){ + if ($use{'filter-label'}){ + main::filter_partition('part', \$row->{'label'}, ''); + } + $row->{'label'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'label')} = $row->{'label'}; + } + if ($show{'uuid'}){ + if ($use{'filter-uuid'}){ + main::filter_partition('part', \$row->{'uuid'}, ''); + } + $row->{'uuid'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'uuid')} = $row->{'uuid'}; + } + } + } + eval $end if $b_log; +} + +sub proc_data { + eval $start if $b_log; + my ($dev_mapped,$fs,$label,$maj_min,$size,$uuid,$part); + my $unmounted = []; + # last filters to make sure these are dumped + my @filters = ('scd[0-9]+','sr[0-9]+','cdrom[0-9]*','cdrw[0-9]*', + 'dvd[0-9]*','dvdrw[0-9]*','fd[0-9]','ram[0-9]*'); + my $num = 0; + # set labels, uuid, gpart + PartitionItem::set_partitions() if !$loaded{'set-partitions'}; + RaidItem::raid_data() if !$loaded{'raid'}; + my $mounted = get_mounted(); + # NOTE: add push(@$mounted,'data') here to emulate item, match partition data + # print join("\n",(@filters,@$mounted)),"\n"; + foreach my $row (@proc_partitions){ + ($dev_mapped,$fs,$label,$maj_min,$uuid,$size) = ('','','','','',''); + # note that size 1 means it is a logical extended partition container + # lvm might have dm-1 type syntax + # need to exclude loop type file systems, squashfs for example + # NOTE: nvme needs special treatment because the main device is: nvme0n1 + # note: $working[2] != 1 is wrong, it's not related + # note: for zfs using /dev/sda no partitions, previous rule would have removed + # the unmounted report because sdb was found in sdb1, but match of eg sdb1 and sdb12 + # makes this a problem, so using zfs_member test instead to filter out zfs members. + # For zfs using entire disk, ie, sda, in that case, all partitions sda1 sda9 (8BiB) + # belong to zfs, and aren't unmmounted, so if sda and partition sda9, + # remove from list. this only works for sdxx drives, but is better than no fix + # This logic may also end up working for btrfs partitions, and maybe hammer? + # In arm/android seen /dev/block/mmcblk0p12 + # @filters test separate since it contains regex list, @$mounted can contain + # regex special characters like GDRIVE{6Cm8i}: + # print "mount: $row->[-1]\n"; + if ($row->[-1] !~ /^(nvme[0-9]+n|mmcblk|mtdblk|mtdblock)[0-9]+$/ && + $row->[-1] =~ /[a-z][0-9]+$|dm-[0-9]+$/ && + $row->[-1] !~ /\bloop/ && + !(grep {$row->[-1] =~ /$_$/} @filters) && + !(grep {$row->[-1] =~ /\Q$_\E$/} @$mounted) && + !(grep {$_ =~ /(block\/)?$row->[-1]$/} @$mounted) && + !(grep {$_ =~ /^sd[a-z]+$/ && $row->[-1] =~ /^\Q$_\E[0-9]+/} @$mounted)){ + $dev_mapped = $dmmapper{$row->[-1]} if $dmmapper{$row->[-1]}; + if (@lsblk){ + my $id = ($dev_mapped) ? $dev_mapped: $row->[-1]; + $part = LsblkData::get($id); + if (%$part){ + $fs = $part->{'fs'}; + $label = $part->{'label'}; + $maj_min = $part->{'maj-min'}; + $uuid = $part->{'uuid'}; + $size = $part->{'size'} if $part->{'size'} && !$row->[2]; + } + } + $size ||= $row->[2]; + $fs = unmounted_filesystem($row->[-1]) if !$fs; + # seen: (zfs|lvm2|linux_raid)_member; crypto_luks + # note: lvm, raid members are never mounted. luks member is never mounted. + next if $fs && $fs =~ /(bcache|crypto|luks|_member)$/i; + # these components of lvm raid will show as partitions byt are reserved private lvm member + # See man lvm for all current reserved private volume names + next if $dev_mapped && $dev_mapped =~ /_([ctv]data|corig|[mr]image|mlog|[crt]meta|pmspare|pvmove|vorigin)(_[0-9]+)?$/; + if (!$bsd_type){ + $label = PartitionItem::get_label("/dev/$row->[-1]") if !$label; + $uuid = PartitionItem::get_uuid("/dev/$row->[-1]") if !$uuid; + } + else { + my @temp = GpartData::get($row->[-1]); + $label = $temp[1] if $temp[1]; + $uuid = $temp[2] if $temp[2]; + } + $maj_min = "$row->[0]:$row->[1]" if !$maj_min; + push(@$unmounted, { + 'dev-base' => $row->[-1], + 'dev-mapped' => $dev_mapped, + 'fs' => $fs, + 'label' => $label, + 'maj-min' => $maj_min, + 'size' => $size, + 'uuid' => $uuid, + }); + } + } + print Data::Dumper::Dumper $unmounted if $dbg[35]; + main::log_data('dump','@$unmounted',$unmounted) if $b_log; + eval $end if $b_log; + return $unmounted; +} + +sub bsd_data { + eval $start if $b_log; + my ($fs,$label,$size,$uuid,%part); + my $unmounted = []; + PartitionItem::set_partitions() if !$loaded{'set-partitions'}; + RaidItem::raid_data() if !$loaded{'raid'}; + my $mounted = get_mounted(); + foreach my $id (sort keys %disks_bsd){ + next if !$disks_bsd{$id}->{'partitions'}; + foreach my $part (sort keys %{$disks_bsd{$id}->{'partitions'}}){ + if (!(grep {$_ =~ /$part$/} @$mounted)){ + $fs = $disks_bsd{$id}->{'partitions'}{$part}{'fs'}; + next if $fs && $fs =~ /(raid|_member)$/i; + $label = $disks_bsd{$id}->{'partitions'}{$part}{'label'}; + $size = $disks_bsd{$id}->{'partitions'}{$part}{'size'}; + $uuid = $disks_bsd{$id}->{'partitions'}{$part}{'uuid'}; + # $fs = unmounted_filesystem($part) if !$fs; + push(@$unmounted, { + 'dev-base' => $part, + 'dev-mapped' => '', + 'fs' => $fs, + 'label' => $label, + 'maj-min' => '', + 'size' => $size, + 'uuid' => $uuid, + }); + } + } + } + print Data::Dumper::Dumper $unmounted if $dbg[35]; + main::log_data('dump','@$unmounted',$unmounted) if $b_log; + eval $end if $b_log; + return $unmounted; +} + +sub get_mounted { + eval $start if $b_log; + my (@arrays); + my $mounted = []; + foreach my $row (@partitions){ + push(@$mounted, $row->{'dev-base'}) if $row->{'dev-base'}; + } + # print Data::Dumper::Dumper \@zfs_raid; + foreach my $row ((@btrfs_raid,@lvm_raid,@md_raid,@soft_raid,@zfs_raid)){ + # we want to not show md0 etc in unmounted report + push(@$mounted, $row->{'id'}) if $row->{'id'}; + # print Data::Dumper::Dumper $row; + # row->arrays->components: zfs; row->components: lvm,mdraid,softraid + if ($row->{'arrays'} && ref $row->{'arrays'} eq 'ARRAY'){ + push(@arrays,@{$row->{'arrays'}}); + } + elsif ($row->{'components'} && ref $row->{'components'} eq 'ARRAY'){ + push(@arrays,$row); + } + @arrays = grep {defined $_} @arrays; + # print Data::Dumper::Dumper \@arrays; + foreach my $item (@arrays){ + # print Data::Dumper::Dumper $item; + my @components = (ref $item->{'components'} eq 'ARRAY') ? @{$item->{'components'}} : (); + foreach my $component (@components){ + # md has ~, not zfs,lvm,softraid + my $temp = (split('~', $component->[0]))[0]; + push(@$mounted, $temp); + } + } + } + eval $end if $b_log; + return $mounted; +} + +# bsds do not seem to return any useful data so only for linux +sub unmounted_filesystem { + eval $start if $b_log; + my ($item) = @_; + my ($data,%part); + my ($file,$fs,$path) = ('','',''); + if ($path = main::check_program('file')){ + $file = $path; + } + # order matters in this test! + my @filesystems = ('ext2','ext3','ext4','ext5','ext','ntfs', + 'fat32','fat16','FAT\s\(.*\)','vfat','fatx','tfat','exfat','swap','btrfs', + 'ffs','hammer','hfs\+','hfs\splus','hfs\sextended\sversion\s[1-9]','hfsj', + 'hfs','apfs','jfs','nss','reiserfs','reiser4','ufs2','ufs','xfs','zfs'); + if ($file){ + # this will fail if regular user and no sudo present, but that's fine, it will just return null + # note the hack that simply slices out the first line if > 1 items found in string + # also, if grub/lilo is on partition boot sector, no file system data is available + $data = (main::grabber("$sudoas$file -s /dev/$item 2>/dev/null"))[0]; + if ($data){ + foreach (@filesystems){ + if ($data =~ /($_)[\s,]/i){ + $fs = $1; + $fs = main::trimmer($fs); + last; + } + } + } + } + main::log_data('data',"fs: $fs") if $b_log; + eval $end if $b_log; + return $fs; +} +} + +## UsbItem ## +{ +package UsbItem; + +sub get { + eval $start if $b_log; + my ($key1,$val1); + my $rows = []; + my $num = 0; + if (!$usb{'main'} && $alerts{'lsusb'}->{'action'} ne 'use' && + $alerts{'usbdevs'}->{'action'} ne 'use' && + $alerts{'usbconfig'}->{'action'} ne 'use'){ + if ($os eq 'linux'){ + $key1 = $alerts{'lsusb'}->{'action'}; + $val1 = $alerts{'lsusb'}->{'message'}; + } + else { + # note: usbdevs only has 'missing', usbconfig has missing/permissions + # both have platform, but irrelevant since testing for linux here + if ($alerts{'usbdevs'}->{'action'} eq 'missing' && + $alerts{'usbconfig'}->{'action'} eq 'missing'){ + $key1 = $alerts{'usbdevs'}->{'action'}; + $val1 = main::message('tools-missing-bsd','usbdevs/usbconfig'); + } + elsif ($alerts{'usbconfig'}->{'action'} eq 'permissions'){ + $key1 = $alerts{'usbconfig'}->{'action'}; + $val1 = $alerts{'usbconfig'}->{'message'}; + } + # elsif ($alerts{'lsusb'}->{'action'} eq 'missing'){ + # $key1 = $alerts{'lsusb'}->{'action'}; + # $val1 = $alerts{'lsusb'}->{'message'}; + # } + } + $key1 = ucfirst($key1); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); + } + else { + usb_output($rows); + if (!@$rows){ + my $key = 'Message'; + @$rows = ({ + main::key($num++,0,1,$key) => main::message('usb-data','') + }); + } + } + eval $end if $b_log; + return $rows; +} + +sub usb_output { + eval $start if $b_log; + return if !$usb{'main'}; + my $rows = $_[0]; + my ($b_hub,$bus_id,$chip_id,$driver,$ind_rc,$ind_sc,$path_id,$ports,$product, + $rev,$serial,$speed_si,$type); + my $num = 0; + my $j = 0; + # note: the data has been presorted in UsbData: + # bus alpah id, so we don't need to worry about the order + foreach my $id (@{$usb{'main'}}){ + $j = scalar @$rows; + ($b_hub,$ind_rc,$ind_sc,$num) = (0,4,3,1); + ($driver,$path_id,$ports,$product,$rev,$serial,$speed_si, + $type) = ('','','','','','','','',''); + $rev = $id->[8] if $id->[8]; + $product = main::clean($id->[13]) if $id->[13]; + $serial = main::filter($id->[16]) if $id->[16]; + $product ||= 'N/A'; + $rev ||= 'N/A'; + $path_id = $id->[2] if $id->[2]; + $bus_id = "$path_id:$id->[1]"; + # it's a hub + if ($id->[4] eq '09'){ + $ports = $id->[10] if $id->[10]; + $ports ||= 'N/A'; + # print "pt0:$protocol\n"; + push(@$rows, { + main::key($num++,1,1,'Hub') => $bus_id, + main::key($num++,0,2,'info') => $product, + main::key($num++,0,2,'ports') => $ports, + },); + $b_hub = 1; + $ind_rc =3; + $ind_sc =2; + } + # it's a device + else { + $type = $id->[14] if $id->[14]; + $driver = $id->[15] if $id->[15]; + $type ||= 'N/A'; + $driver ||= 'N/A'; + # print "pt3:$class:$product\n"; + $rows->[$j]{main::key($num++,1,2,'Device')} = $bus_id; + $rows->[$j]{main::key($num++,0,3,'info')} = $product; + $rows->[$j]{main::key($num++,0,3,'type')} = $type; + if ($extra > 0){ + $rows->[$j]{main::key($num++,0,3,'driver')} = $driver; + } + if ($extra > 2 && $id->[9]){ + $rows->[$j]{main::key($num++,0,3,'interfaces')} = $id->[9]; + } + } + # for either hub or device + $rows->[$j]{main::key($num++,1,$ind_sc,'rev')} = $rev; + if ($extra > 0){ + $speed_si = ($id->[17]) ? $id->[17] : 'N/A'; + $speed_si .= " ($id->[25])" if ($b_admin && $id->[25]); + $rows->[$j]{main::key($num++,0,$ind_rc,'speed')} = $speed_si; + if ($extra > 1){ + if ($id->[24]){ + if ($id->[23] == $id->[24]){ + $rows->[$j]{main::key($num++,0,$ind_rc,'lanes')} = $id->[24]; + } + else { + $rows->[$j]{main::key($num++,1,$ind_rc,'lanes')} = ''; + $rows->[$j]{main::key($num++,0,($ind_rc+1),'rx')} = $id->[23]; + $rows->[$j]{main::key($num++,0,($ind_rc+1),'tx')} = $id->[24]; + } + } + } + # 22 is only available if 23 and 24 are present as well + if ($b_admin && $id->[22]){ + $rows->[$j]{main::key($num++,0,$ind_rc,'mode')} = $id->[22]; + } + if ($extra > 2 && $id->[19] && $id->[19] ne '0mA'){ + $rows->[$j]{main::key($num++,0,$ind_sc,'power')} = $id->[19]; + } + $chip_id = $id->[7]; + $chip_id ||= 'N/A'; + $rows->[$j]{main::key($num++,0,$ind_sc,'chip-ID')} = $chip_id; + if ($extra > 2 && defined $id->[5] && $id->[5] ne ''){ + my $id = sprintf("%02s",$id->[4]) . sprintf("%02s", $id->[5]); + $rows->[$j]{main::key($num++,0,$ind_sc,'class-ID')} = $id; + } + if (!$b_hub && $extra > 2){ + if ($serial){ + $rows->[$j]{main::key($num++,0,$ind_sc,'serial')} = main::filter($serial); + } + } + } + } + # print Data::Dumper::Dumper \@rows; + eval $end if $b_log; +} +} + +## WeatherItem ## +# add metric / imperial (us) switch +{ +package WeatherItem; + +sub get { + eval $start if $b_log; + my $rows = []; + my $num = 0; + my $location = []; + location_data($location); + # print Data::Dumper::Dumper $location;exit; + if (!$location->[0]){ + @$rows = ({ + main::key($num++,0,1,'Message') => main::message('weather-null','current location') + }); + } + else { + my $weather = get_weather($location); + if ($weather->{'error'}){ + @$rows = ({ + main::key($num++,0,1,'Message') => main::message('weather-error',$weather->{'error'}) + }); + } + elsif (!$weather->{'weather'}){ + @$rows = ({ + main::key($num++,0,1,'Message') => main::message('weather-null','weather data') + }); + } + else { + weather_output($rows,$location,$weather); + } + } + if (!@$rows){ + @$rows = ({ + main::key($num++,0,1,'Message') => main::message('weather-null','weather data') + }); + } + eval $end if $b_log; + return $rows; +} + +sub weather_output { + eval $start if $b_log; + my ($rows,$location,$weather) = @_; + my ($j,$num) = (0,0); + my ($value); + my ($conditions) = ('NA'); + $conditions = "$weather->{'weather'}"; + my $temp = process_unit( + $weather->{'temp'}, + $weather->{'temp-c'},'C', + $weather->{'temp-f'},'F'); + $j = scalar @$rows; + push(@$rows, { + main::key($num++,1,1,'Report') => '', + main::key($num++,0,2,'temperature') => $temp, + main::key($num++,0,2,'conditions') => $conditions, + },); + if ($extra > 0){ + my $pressure = process_unit( + $weather->{'pressure'}, + $weather->{'pressure-mb'},'mb', + $weather->{'pressure-in'},'in'); + my $wind = process_wind( + $weather->{'wind'}, + $weather->{'wind-direction'}, + $weather->{'wind-mph'}, + $weather->{'wind-ms'}, + $weather->{'wind-gust-mph'}, + $weather->{'wind-gust-ms'}); + $rows->[$j]{main::key($num++,0,2,'wind')} = $wind; + if ($extra > 1){ + if (defined $weather->{'cloud-cover'}){ + $rows->[$j]{main::key($num++,0,2,'cloud cover')} = $weather->{'cloud-cover'} . '%'; + } + if ($weather->{'precip-1h-mm'} && defined $weather->{'precip-1h-in'}){ + $value = process_unit('',$weather->{'precip-1h-mm'},'mm', + $weather->{'precip-1h-in'},'in'); + $rows->[$j]{main::key($num++,0,2,'precipitation')} = $value; + } + if ($weather->{'rain-1h-mm'} && defined $weather->{'rain-1h-in'}){ + $value = process_unit('',$weather->{'rain-1h-mm'},'mm', + $weather->{'rain-1h-in'},'in'); + $rows->[$j]{main::key($num++,0,2,'rain')} = $value; + } + if ($weather->{'snow-1h-mm'} && defined $weather->{'snow-1h-in'}){ + $value = process_unit('',$weather->{'snow-1h-mm'},'mm', + $weather->{'snow-1h-in'},'in'); + $rows->[$j]{main::key($num++,0,2,'snow')} = $value; + } + } + $rows->[$j]{main::key($num++,0,2,'humidity')} = $weather->{'humidity'} . '%'; + if ($extra > 1){ + if ($weather->{'dewpoint'} || (defined $weather->{'dewpoint-c'} && + defined $weather->{'dewpoint-f'})){ + $value = process_unit( + $weather->{'dewpoint'}, + $weather->{'dewpoint-c'}, + 'C', + $weather->{'dewpoint-f'}, + 'F'); + $rows->[$j]{main::key($num++,0,2,'dew point')} = $value; + } + } + $rows->[$j]{main::key($num++,0,2,'pressure')} = $pressure; + } + if ($extra > 1){ + if ($weather->{'heat-index'} || (defined $weather->{'heat-index-c'} && + defined $weather->{'heat-index-f'})){ + $value = process_unit( + $weather->{'heat-index'}, + $weather->{'heat-index-c'},'C', + $weather->{'heat-index-f'},'F'); + $rows->[$j]{main::key($num++,0,2,'heat index')} = $value; + } + if ($weather->{'windchill'} || (defined $weather->{'windchill-c'} && + defined $weather->{'windchill-f'})){ + $value = process_unit( + $weather->{'windchill'}, + $weather->{'windchill-c'},'C', + $weather->{'windchill-f'},'F'); + $rows->[$j]{main::key($num++,0,2,'wind chill')} = $value; + } + if ($extra > 2){ + if ($weather->{'forecast'}){ + $j = scalar @$rows; + push(@$rows, { + main::key($num++,1,1,'Forecast') => $weather->{'forecast'}, + },); + } + } + } + $j = scalar @$rows; + if ($extra > 2 && !$use{'filter'}){ + complete_location( + $location, + $weather->{'city'}, + $weather->{'state'}, + $weather->{'country'}); + } + push(@$rows, { + main::key($num++,1,1,'Locale') => $location->[1], + },); + if ($extra > 2 && !$use{'filter'} && ($weather->{'elevation-m'} || + $weather->{'elevation-ft'})){ + $rows->[$j]{main::key($num++,0,2,'altitude')} = process_elevation( + $weather->{'elevation-m'}, + $weather->{'elevation-ft'}); + } + $rows->[$j]{main::key($num++,0,2,'current time')} = $weather->{'date-time'},; + if ($extra > 2){ + $weather->{'observation-time-local'} = 'N/A' if !$weather->{'observation-time-local'}; + $rows->[$j]{main::key($num++,0,2,'observation time')} = $weather->{'observation-time-local'}; + if ($weather->{'sunrise'}){ + $rows->[$j]{main::key($num++,0,2,'sunrise')} = $weather->{'sunrise'}; + } + if ($weather->{'sunset'}){ + $rows->[$j]{main::key($num++,0,2,'sunset')} = $weather->{'sunset'}; + } + if ($weather->{'moonphase'}){ + $value = $weather->{'moonphase'} . '%'; + $value .= ($weather->{'moonphase-graphic'}) ? ' ' . $weather->{'moonphase-graphic'} :''; + $rows->[$j]{main::key($num++,0,2,'moonphase')} = $value; + } + } + if ($weather->{'api-source'}){ + $rows->[$j]{main::key($num++,0,1,'Source')} = $weather->{'api-source'}; + } + eval $end if $b_log; +} + +sub process_elevation { + eval $start if $b_log; + my ($meters,$feet) = @_; + my ($result,$i_unit,$m_unit) = ('','ft','m'); + $feet = sprintf("%.0f", 3.28 * $meters) if defined $meters && !$feet; + $meters = sprintf("%.1f", $feet/3.28) if defined $feet && !$meters; + $meters = sprintf("%.0f", $meters) if $meters; + if (defined $meters && $weather_unit eq 'mi'){ + $result = "$meters $m_unit ($feet $i_unit)"; + } + elsif (defined $meters && $weather_unit eq 'im'){ + $result = "$feet $i_unit ($meters $m_unit)"; + } + elsif (defined $meters && $weather_unit eq 'm'){ + $result = "$meters $m_unit"; + } + elsif (defined $feet && $weather_unit eq 'i'){ + $result = "$feet $i_unit"; + } + else { + $result = 'N/A'; + } + eval $end if $b_log; + return $result; +} + +sub process_unit { + eval $start if $b_log; + my ($primary,$metric,$m_unit,$imperial,$i_unit) = @_; + my $result = ''; + if (defined $metric && defined $imperial && $weather_unit eq 'mi'){ + $result = "$metric $m_unit ($imperial $i_unit)"; + } + elsif (defined $metric && defined $imperial && $weather_unit eq 'im'){ + $result = "$imperial $i_unit ($metric $m_unit)"; + } + elsif (defined $metric && $weather_unit eq 'm'){ + $result = "$metric $m_unit"; + } + elsif (defined $imperial && $weather_unit eq 'i'){ + $result = "$imperial $i_unit"; + } + elsif ($primary){ + $result = $primary; + } + else { + $result = 'N/A'; + } + eval $end if $b_log; + return $result; +} + +sub process_wind { + eval $start if $b_log; + my ($primary,$direction,$mph,$ms,$gust_mph,$gust_ms) = @_; + my ($result,$gust_kmh,$kmh,$i_unit,$m_unit,$km_unit) = ('','','','mph','m/s','km/h'); + # get rid of possible gust values if they are the same as wind values + $gust_mph = undef if $gust_mph && $mph && $mph eq $gust_mph; + $gust_ms = undef if $gust_ms && $ms && $ms eq $gust_ms; + # calculate and round, order matters so that rounding only happens after math done + $ms = 0.44704 * $mph if defined $mph && !defined $ms; + $mph = $ms * 2.23694 if defined $ms && !defined $mph; + $kmh = sprintf("%.0f", 18*$ms/5) if defined $ms; + $ms = sprintf("%.1f", $ms) if defined $ms; # very low mph speeds yield 0, which is wrong + $mph = sprintf("%.0f", $mph) if defined $mph; + $gust_ms = 0.44704 * $gust_mph if $gust_mph && !$gust_ms; + $gust_kmh = 18 * $gust_ms / 5 if $gust_ms; + $gust_mph = $gust_ms * 2.23694 if $gust_ms && !$gust_mph; + $gust_mph = sprintf("%.0f", $gust_mph) if $gust_mph; + $gust_kmh = sprintf("%.0f", $gust_kmh) if $gust_kmh; + $gust_ms = sprintf("%.0f", $gust_ms) if $gust_ms; + if (!defined $mph && $primary){ + $result = $primary; + } + elsif (defined $mph && defined $direction){ + if ($weather_unit eq 'mi'){ + $result = "from $direction at $ms $m_unit ($kmh $km_unit, $mph $i_unit)"; + } + elsif ($weather_unit eq 'im'){ + $result = "from $direction at $mph $i_unit ($ms $m_unit, $kmh $km_unit)"; + } + elsif ($weather_unit eq 'm'){ + $result = "from $direction at $ms $m_unit ($kmh $km_unit)"; + } + elsif ($weather_unit eq 'i'){ + $result = "from $direction at $mph $i_unit"; + } + if ($gust_mph){ + if ($weather_unit eq 'mi'){ + $result .= ". Gusting to $ms $m_unit ($kmh $km_unit, $mph $i_unit)"; + } + elsif ($weather_unit eq 'im'){ + $result .= ". Gusting to $mph $i_unit ($ms $m_unit, $kmh $km_unit)"; + } + elsif ($weather_unit eq 'm'){ + $result .= ". Gusting to $ms $m_unit ($kmh $km_unit)"; + } + elsif ($weather_unit eq 'i'){ + $result .= ". Gusting to $mph $i_unit"; + } + } + } + elsif ($primary){ + $result = $primary; + } + else { + $result = 'N/A'; + } + eval $end if $b_log; + return $result; +} + +sub get_weather { + eval $start if $b_log; + my ($location) = @_; + my $now = POSIX::strftime "%Y%m%d%H%M", localtime; + my ($date_time,$freshness,$tz,$weather_data); + my $weather = {}; + my $loc_name = lc($location->[0]); + $loc_name =~ s/-\/|\s|,/-/g; + $loc_name =~ s/--/-/g; + my $file_cached = "$user_data_dir/weather-$loc_name-$weather_source.txt"; + if (-r $file_cached){ + @$weather_data = main::reader($file_cached); + $freshness = (split(/\^\^/, $weather_data->[0]))[1]; + # print "$now:$freshness\n"; + } + if (!$freshness || $freshness < ($now - 60)){ + $weather_data = download_weather($now,$file_cached,$location); + } + # print join("\n", @weather_data), "\n"; + # NOTE: because temps can be 0, we can't do if value tests + foreach (@$weather_data){ + my @working = split(/\s*\^\^\s*/, $_); + next if ! defined $working[1] || $working[1] eq ''; + if ($working[0] eq 'api_source'){ + $weather->{'api-source'} = $working[1]; + } + elsif ($working[0] eq 'city'){ + $weather->{'city'} = $working[1]; + } + elsif ($working[0] eq 'cloud_cover'){ + $weather->{'cloud-cover'} = $working[1]; + } + elsif ($working[0] eq 'country'){ + $weather->{'country'} = $working[1]; + } + elsif ($working[0] eq 'dewpoint_string'){ + $weather->{'dewpoint'} = $working[1]; + $working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/; + $weather->{'dewpoint-c'} = $2;; + $weather->{'dewpoint-f'} = $1;; + } + elsif ($working[0] eq 'dewpoint_c'){ + $weather->{'dewpoint-c'} = $working[1]; + } + elsif ($working[0] eq 'dewpoint_f'){ + $weather->{'dewpoint-f'} = $working[1]; + } + # WU: there are two elevations, we want the first one + elsif (!$weather->{'elevation-m'} && $working[0] eq 'elevation'){ + # note: bug in source data uses ft for meters, not 100% of time, but usually + $weather->{'elevation-m'} = $working[1]; + $weather->{'elevation-m'} =~ s/\s*(ft|m).*$//; + } + elsif ($working[0] eq 'error'){ + $weather->{'error'} = $working[1]; + } + elsif ($working[0] eq 'forecast'){ + $weather->{'forecast'} = $working[1]; + } + elsif ($working[0] eq 'heat_index_string'){ + $weather->{'heat-index'} = $working[1]; + $working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/; + $weather->{'heat-index-c'} = $2;; + $weather->{'heat-index-f'} = $1; + } + elsif ($working[0] eq 'heat_index_c'){ + $weather->{'heat-index-c'} = $working[1]; + } + elsif ($working[0] eq 'heat_index_f'){ + $weather->{'heat-index-f'} = $working[1]; + } + elsif ($working[0] eq 'relative_humidity'){ + $working[1] =~ s/%$//; + $weather->{'humidity'} = $working[1]; + } + elsif ($working[0] eq 'local_time'){ + $weather->{'local-time'} = $working[1]; + } + elsif ($working[0] eq 'local_epoch'){ + $weather->{'local-epoch'} = $working[1]; + } + elsif ($working[0] eq 'moonphase'){ + $weather->{'moonphase'} = $working[1]; + } + elsif ($working[0] eq 'moonphase_graphic'){ + $weather->{'moonphase-graphic'} = $working[1]; + } + elsif ($working[0] eq 'observation_time_rfc822'){ + $weather->{'observation-time-rfc822'} = $working[1]; + } + elsif ($working[0] eq 'observation_epoch'){ + $weather->{'observation-epoch'} = $working[1]; + } + elsif ($working[0] eq 'observation_time'){ + $weather->{'observation-time-local'} = $working[1]; + $weather->{'observation-time-local'} =~ s/Last Updated on //; + } + elsif ($working[0] eq 'precip_mm'){ + $weather->{'precip-1h-mm'} = $working[1]; + } + elsif ($working[0] eq 'precip_in'){ + $weather->{'precip-1h-in'} = $working[1]; + } + elsif ($working[0] eq 'pressure_string'){ + $weather->{'pressure'} = $working[1]; + } + elsif ($working[0] eq 'pressure_mb'){ + $weather->{'pressure-mb'} = $working[1]; + } + elsif ($working[0] eq 'pressure_in'){ + $weather->{'pressure-in'} = $working[1]; + } + elsif ($working[0] eq 'rain_1h_mm'){ + $weather->{'rain-1h-mm'} = $working[1]; + } + elsif ($working[0] eq 'rain_1h_in'){ + $weather->{'rain-1h-in'} = $working[1]; + } + elsif ($working[0] eq 'snow_1h_mm'){ + $weather->{'snow-1h-mm'} = $working[1]; + } + elsif ($working[0] eq 'snow_1h_in'){ + $weather->{'snow-1h-in'} = $working[1]; + } + elsif ($working[0] eq 'state_name'){ + $weather->{'state'} = $working[1]; + } + elsif ($working[0] eq 'sunrise'){ + if ($working[1]){ + if ($working[1] !~ /^[0-9]+$/){ + $weather->{'sunrise'} = $working[1]; + } + # trying to figure out remote time from UTC is too hard + elsif (!$show{'weather-location'}){ + $weather->{'sunrise'} = POSIX::strftime "%T", localtime($working[1]); + } + } + } + elsif ($working[0] eq 'sunset'){ + if ($working[1]){ + if ($working[1] !~ /^[0-9]+$/){ + $weather->{'sunset'} = $working[1]; + } + # trying to figure out remote time from UTC is too hard + elsif (!$show{'weather-location'}){ + $weather->{'sunset'} = POSIX::strftime "%T", localtime($working[1]); + } + } + } + elsif ($working[0] eq 'temperature_string'){ + $weather->{'temp'} = $working[1]; + $working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/; + $weather->{'temp-c'} = $2;; + $weather->{'temp-f'} = $1; + # $weather->{'temp'} =~ s/\sF/\xB0 F/; # B0 + # $weather->{'temp'} =~ s/\sF/\x{2109}/; + # $weather->{'temp'} =~ s/\sC/\x{2103}/; + } + elsif ($working[0] eq 'temp_f'){ + $weather->{'temp-f'} = $working[1]; + } + elsif ($working[0] eq 'temp_c'){ + $weather->{'temp-c'} = $working[1]; + } + elsif ($working[0] eq 'timezone'){ + $weather->{'timezone'} = $working[1]; + } + elsif ($working[0] eq 'visibility'){ + $weather->{'visibility'} = $working[1]; + } + elsif ($working[0] eq 'visibility_km'){ + $weather->{'visibility-km'} = $working[1]; + } + elsif ($working[0] eq 'visibility_mi'){ + $weather->{'visibility-mi'} = $working[1]; + } + elsif ($working[0] eq 'weather'){ + $weather->{'weather'} = $working[1]; + } + elsif ($working[0] eq 'wind_degrees'){ + $weather->{'wind-degrees'} = $working[1]; + } + elsif ($working[0] eq 'wind_dir'){ + $weather->{'wind-direction'} = $working[1]; + } + elsif ($working[0] eq 'wind_mph'){ + $weather->{'wind-mph'} = $working[1]; + } + elsif ($working[0] eq 'wind_gust_mph'){ + $weather->{'wind-gust-mph'} = $working[1]; + } + elsif ($working[0] eq 'wind_gust_ms'){ + $weather->{'wind-gust-ms'} = $working[1]; + } + elsif ($working[0] eq 'wind_ms'){ + $weather->{'wind-ms'} = $working[1]; + } + elsif ($working[0] eq 'wind_string'){ + $weather->{'wind'} = $working[1]; + } + elsif ($working[0] eq 'windchill_string'){ + $weather->{'windchill'} = $working[1]; + $working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/; + $weather->{'windchill-c'} = $2; + $weather->{'windchill-f'} = $1; + } + elsif ($working[0] eq 'windchill_c'){ + $weather->{'windchill-c'} = $working[1]; + } + elsif ($working[0] eq 'windchill_f'){ + $weather->{'windchill_f'} = $working[1]; + } + } + if ($show{'weather-location'}){ + if ($weather->{'observation-time-local'} && + $weather->{'observation-time-local'} =~ /^(.*)\s([a-z_]+\/[a-z_]+)$/i){ + $tz = $2; + } + if (!$tz && $weather->{'timezone'}){ + $tz = $weather->{'timezone'}; + $weather->{'observation-time-local'} .= ' (' . $weather->{'timezone'} . ')' if $weather->{'observation-time-local'}; + } + # very clever trick, just make the system think it's in the + # remote timezone for this local block only + local $ENV{'TZ'} = $tz if $tz; + $date_time = POSIX::strftime "%c", localtime(); + $date_time = test_locale_date($date_time,'',''); + $weather->{'date-time'} = $date_time; + # only wu has rfc822 value, and we want the original observation time then + if ($weather->{'observation-epoch'} && $tz){ + $date_time = POSIX::strftime "%Y-%m-%d %T ($tz %z)", localtime($weather->{'observation-epoch'}); + $date_time = test_locale_date($date_time,$show{'weather-location'},$weather->{'observation-epoch'}); + $weather->{'observation-time-local'} = $date_time; + } + } + else { + $date_time = POSIX::strftime "%c", localtime(); + $date_time = test_locale_date($date_time,'',''); + $tz = ($location->[2]) ? " ($location->[2])" : ''; + $weather->{'date-time'} = $date_time . $tz; + } + # we get the wrong time using epoch for remote -W location + if (!$show{'weather-location'} && $weather->{'observation-epoch'}){ + $date_time = POSIX::strftime "%c", localtime($weather->{'observation-epoch'}); + $date_time = test_locale_date($date_time,$show{'weather-location'},$weather->{'observation-epoch'}); + $weather->{'observation-time-local'} = $date_time; + } + eval $end if $b_log; + return $weather; +} + +sub download_weather { + eval $start if $b_log; + my ($now,$file_cached,$location) = @_; + my ($temp,$ua,$url); + my $weather = []; + $url = "https://smxi.org/opt/xr2.php?loc=$location->[0]&src=$weather_source"; + $ua = 'weather'; + if ($fake{'weather'}){ + # my $file2 = "$fake_data_dir/weather/weather-1.xml"; + # my $file2 = "$fake_data_dir/weather/feed-oslo-1.xml"; + # local $/; + # my $file = "$fake_data_dir/weather/weather-1.xml"; + # open(my $fh, '<', $file) or die "can't open $file: $!"; + # $temp = <$fh>; + } + else { + $temp = main::download_file('stdout',$url,'',$ua); + } + @$weather = split('\n', $temp) if $temp; + unshift(@$weather, "timestamp^^$now"); + main::writer($file_cached,$weather); + # print "$file_cached: download/cleaned\n"; + eval $end if $b_log; + return $weather; +} + +# Rsolve wide character issue, if detected, switch to iso +# date format, we won't try to be too clever here. +sub test_locale_date { + my ($date_time,$location,$epoch) = @_; + # $date_time .= 'дек'; + # print "1: $date_time\n"; + if ($date_time =~ m/[^\x00-\x7f]/){ + if (!$location && $epoch){ + $date_time = POSIX::strftime "%Y-%m-%d %H:%M:%S", localtime($epoch); + } + else { + $date_time = POSIX::strftime "%Y-%m-%d %H:%M:%S", localtime(); + } + } + $date_time =~ s/\s+$//; + # print "2: $date_time\n"; + return $date_time; +} + +## Location Data ## +sub location_data { + eval $start if $b_log; + my $location = $_[0]; + if ($show{'weather-location'}){ + my $location_string; + $location_string = $show{'weather-location'}; + $location_string =~ s/\+/ /g; + if ($location_string =~ /,/){ + my @temp = split(',', $location_string); + my $sep = ''; + my $string = ''; + foreach (@temp){ + $_ = ucfirst($_); + $string .= $sep . $_; + $sep = ', '; + } + $location_string = $string; + } + $location_string = main::filter($location_string); + @$location = ($show{'weather-location'},$location_string,''); + } + else { + get_location($location); + } + eval $end if $b_log; +} + +sub get_location { + eval $start if $b_log; + my $location = $_[0]; + my ($city,$country,$freshness,%loc,$loc_arg,$loc_string,@loc_data,$state); + my $now = POSIX::strftime "%Y%m%d%H%M", localtime; + my $file_cached = "$user_data_dir/location-main.txt"; + if (-r $file_cached){ + @loc_data = main::reader($file_cached); + $freshness = (split(/\^\^/, $loc_data[0]))[1]; + } + if (!$freshness || $freshness < $now - 90){ + my $temp; + my $url = "http://geoip.ubuntu.com/lookup"; + # { + # local $/; + # my $file = "$fake_data_dir/weather/location-1.xml"; + # open(my $fh, '<', $file) or die "can't open $file: $!"; + # $temp = <$fh>; + # } + $temp = main::download_file('stdout',$url); + @loc_data = split('\n', $temp); + @loc_data = map { + s/<\?.*//; + s/<\/[^>]+>/\n/g; + s/>/^^/g; + s/[1] && $location->[1] =~ /[0-9+-]/ && $city){ + $location->[1] = $country . ', ' . $location->[1] if $country && $location->[1] !~ m|$country|i; + $location->[1] = $state . ', ' . $location->[1] if $state && $location->[1] !~ m|$state|i; + $location->[1] = $city . ', ' . $location->[1] if $city && $location->[1] !~ m|$city|i; + } + eval $end if $b_log; +} +} + +#### ------------------------------------------------------------------- +#### ITEM UTILITIES +#### ------------------------------------------------------------------- + +# android only, for distro / OS id and machine data +sub set_build_prop { + eval $start if $b_log; + my $path = '/system/build.prop'; + $loaded{'build-prop'} = 1; + return if ! -r $path; + my @data = reader($path,'strip'); + foreach (@data){ + my @working = split('=', $_); + next if $working[0] !~ /^ro\.(build|product)/; + if ($working[0] eq 'ro.build.date.utc'){ + $build_prop{'build-date'} = strftime "%F", gmtime($working[1]); + } + # ldgacy, replaced by ro.product.device + elsif ($working[0] eq 'ro.build.product'){ + $build_prop{'build-product'} = $working[1]; + } + # this can be brand, company, android, it varies, but we don't want android value + elsif ($working[0] eq 'ro.build.user'){ + $build_prop{'build-user'} = $working[1] if $working[1] !~ /android/i; + } + elsif ($working[0] eq 'ro.build.version.release'){ + $build_prop{'build-version'} = $working[1]; + } + elsif ($working[0] eq 'ro.product.board'){ + $build_prop{'product-board'} = $working[1]; + } + elsif ($working[0] eq 'ro.product.brand'){ + $build_prop{'product-brand'} = $working[1]; + } + elsif ($working[0] eq 'ro.product.device'){ + $build_prop{'product-device'} = $working[1]; + } + elsif ($working[0] eq 'ro.product.manufacturer'){ + $build_prop{'product-manufacturer'} = $working[1]; + } + elsif ($working[0] eq 'ro.product.model'){ + $build_prop{'product-model'} = $working[1]; + } + elsif ($working[0] eq 'ro.product.name'){ + $build_prop{'product-name'} = $working[1]; + } + elsif ($working[0] eq 'ro.product.screensize'){ + $build_prop{'product-screensize'} = $working[1]; + } + } + log_data('dump','%build_prop',\%build_prop) if $b_log; + print Dumper \%build_prop if $dbg[20]; + eval $end if $b_log; +} + +# Return all detected compiler versions +# args: 0: compiler +sub get_compiler_data { + eval $start if $b_log; + my $compiler = $_[0]; + my $compiler_version; + my $compilers = []; + # NOTE: see %program_values for regex used for different gcc syntax + if (my $program = check_program($compiler)){ + (my $name,$compiler_version) = ProgramData::full($compiler,$program); + } + if ($extra > 1){ + # glob /usr/bin,/usr/local/bin for ccs, strip out all non numeric values + if (my @temp = globber("/usr/{local/,}bin/${compiler}{-,}[0-9]*")){ + # usually: gcc-11, sometimes: gcc-11.2.0, gcc-2.8, gcc48 [FreeBSD] + foreach (@temp){ + if (/\/${compiler}-?(\d+\.\d+|\d+)(\.\d+)?/){ + # freebsd uses /usr/local/bin/gcc48, gcc34 for old gccs. Why? + my $working = ($bsd_type && $1 >= 30) ? $1/10 : $1; + if (!$compiler_version || $compiler_version !~ /^$working\b/){ + push(@$compilers, $working); + } + } + } + @$compilers = sort {$a <=> $b} @$compilers if @$compilers; + } + } + unshift(@$compilers, $compiler_version) if $compiler_version; + log_data('dump','@$compilers',$compilers) if $b_log; + print "$compiler\n", Data::Dumper::Dumper $compilers if $dbg[62]; + eval $end if $b_log; + return $compilers; +} + +sub set_dboot_data { + eval $start if $b_log; + $loaded{'dboot'} = 1; + my ($file,@db_data,@dm_data,@temp); + my ($counter) = (0); + if (!$fake{'dboot'}){ + $file = $system_files{'dmesg-boot'}; + } + else { + # $file = "$fake_data_dir/bsd/dmesg-boot/bsd-disks-diabolus.txt"; + # $file = "$fake_data_dir/bsd/dmesg-boot/freebsd-disks-solestar.txt"; + # $file = "$fake_data_dir/bsd/dmesg-boot/freebsd-enceladus-1.txt"; + ## matches: toshiba: openbsd-5.6-sysctl-2.txt + # $file = "$fake_data_dir/bsd/dmesg-boot/openbsd-5.6-dmesg.boot-1.txt"; + ## matches: compaq: openbsd-5.6-sysctl-1.txt" + # $file = "$fake_data_dir/bsd/dmesg-boot/openbsd-dmesg.boot-1.txt"; + # $file = "$fake_data_dir/bsd/dmesg-boot/openbsd-6.8-battery-sensors-1.txt"; + } + if ($file){ + return if ! -r $file; + @db_data = reader($file); + # sometimes > 1 sessions stored, dump old ones + for (@db_data){ + if (/^(Dragonfly|OpenBSD|NetBSD|FreeBSD is a registered trademark|Copyright.*Midnight)/){ + $counter++; + undef @temp if $counter > 1; + } + push(@temp,$_); + } + @db_data = @temp; + undef @temp; + my @dm_data = grabber('dmesg 2>/dev/null'); + # clear out for netbsd, only 1 space following or lines won't match + @dm_data = map {$_ =~ s/^\[[^\]]+\]\s//;$_} @dm_data; + $counter = 0; + # dump previous sessions, and also everything roughly before dmesg.boot + # ends, it does't need to be perfect, we just only want the actual post + # boot data + for (@dm_data){ + if (/^(Dragonfly|OpenBSD|NetBSD|FreeBSD is a registered trademark|Copyright.*Midnight)/ || + /^(smbus[0-9]:|Security policy loaded|root on)/){ + $counter++; + undef @temp if $counter > 1; + } + push(@temp,$_); + } + @dm_data = @temp; + undef @temp; + push(@db_data,'~~~~~',@dm_data); + # uniq(\@db_data); # get rid of duplicate lines + # some dmesg repeats, so we need to dump the second and > iterations + # replace all indented items with ~ so we can id them easily while + # processing note that if user, may get error of read permissions + # for some weird reason, real mem and avail mem are use a '=' separator, + # who knows why, the others are ':' + foreach (@db_data){ + $_ =~ s/\s*=\s*|:\s*/:/; + $_ =~ s/\"//g; + $_ =~ s/^\s+/~/; + $_ =~ s/\s\s/ /g; + $_ =~ s/^(\S+)\sat\s/$1:at /; # ada0 at ahcich0 + push(@{$dboot{'main'}}, $_); + if ($use{'bsd-battery'} && /^acpi(bat|cmb)/){ + push(@{$sysctl{'battery'}}, $_); + } + # ~Debug Features 0:<2 CTX BKPTs,4 Watchpoints,6 Breakpoints,PMUv3,Debugv8> + elsif ($use{'bsd-cpu'} && + (!/^~(Debug|Memory)/ && /(^cpu[0-9]+:|Features|^~*Origin:\s*)/)){ + push(@{$dboot{'cpu'}}, $_); + } + # FreeBSD: 'da*' is a USB device 'ada*' is a SATA device 'mmcsd*' is an SD card + # OpenBSD: 'sd' is usb device, 'wd' normal drive. OpenBSD uses sd for nvme drives + # but also has the nvme data: + # nvme1 at pci6 dev 0 function 0 vendor "Phison", unknown product 0x5012 rev 0x01: msix, NVMe 1.3 + # nvme1: OWC Aura P12 1.0TB, firmware ECFM22.6, serial 2003100010208 + # scsibus2 at nvme1: 2 targets, initiator 0 + # sd1 at scsibus2 targ 1 lun 0: + # sd1: 915715MB, 4096 bytes/sector, 234423126 sectors + elsif ($use{'bsd-disk'} && + /^(ad|ada|da|mmcblk|mmcsd|nvme([0-9]+n)?|sd|wd)[0-9]+(:|\sat\s|.*?\sdetached$)/){ + $_ =~ s/^\(//; + push (@{$dboot{'disk'}},$_); + } + if ($use{'bsd-machine'} && /^bios[0-9]:(at|vendor)/){ + push(@{$sysctl{'machine'}}, $_); + } + elsif ($use{'bsd-machine'} && !$dboot{'machine-vm'} && + /(\bhvm\b|innotek|\bkvm\b|microsoft.*virtual machine|openbsd[\s-]vmm|qemu|qumranet|vbox|virtio|virtualbox|vmware)/i){ + push(@{$dboot{'machine-vm'}}, $_); + } + elsif ($use{'bsd-optical'} && /^(cd)[0-9]+(\([^)]+\))?(:|\sat\s)/){ + push(@{$dboot{'optical'}},$_); + } + elsif ($use{'bsd-pci'} && /^(pci[0-9]+:at|\S+:at pci)/){ + push(@{$dboot{'pci'}},$_); + } + elsif ($use{'bsd-ram'} && /(^spdmem)/){ + push(@{$dboot{'ram'}}, $_); + } + } + log_data('dump','$dboot{main}',$dboot{'main'}) if $b_log; + print Dumper $dboot{'main'} if $dbg[11]; + + if ($dboot{'main'} && $b_log){ + log_data('dump','$dboot{cpu}',$dboot{'cpu'}); + log_data('dump','$dboot{disk}',$dboot{'disk'}); + log_data('dump','$dboot{machine-vm}',$dboot{'machine-vm'}); + log_data('dump','$dboot{optical}',$dboot{'optical'}); + log_data('dump','$dboot{ram}',$dboot{'ram'}); + log_data('dump','$dboot{usb}',$dboot{'usb'}); + log_data('dump','$sysctl{battery}',$sysctl{'battery'}); + log_data('dump','$sysctl{machine}',$sysctl{'machine'}); + } + if ($dboot{'main'} && $dbg[11]){ + print("cpu:\n", Dumper $dboot{'cpu'}); + print("disk:\n", Dumper $dboot{'disk'}); + print("machine vm:\n", Dumper $dboot{'machine-vm'}); + print("optical:\n", Dumper $dboot{'optical'}); + print("ram:\n", Dumper $dboot{'ram'}); + print("usb:\n", Dumper $dboot{'usb'}); + print("sys battery:\n", Dumper $sysctl{'battery'}); + print("sys machine:\n", Dumper $sysctl{'machine'}); + } + # this should help get rid of dmesg usb mounts not present + # note if you take out one, put in another, it will always show the first + # one, I think. Not great. Not using this means all drives attached + # current session are shown, using it, possibly wrong drive shown, which is bad + # not using this for now: && (my @disks = grep {/^hw\.disknames/} @{$dboot{'disk'}} + if ($dboot{'disk'}){ + # hw.disknames:sd0:,sd1:3242432,sd2: + #$disks[0] =~ s/(^hw\.disknames:|:[^,]*)//g; + #@disks = split(',',$disks[0]) if $disks[0]; + my ($id,$value,%dboot_disks,@disks_live,@temp); + # first, since openbsd has this, let's use it + foreach (@{$dboot{'disk'}}){ + if (!@disks_live && /^hw\.disknames/){ + $_ =~ s/(^hw\.disknames:|:[^,]*)//g; + @disks_live = split(/[,\s]/,$_) if $_; + } + else { + push(@temp,$_); + } + } + @{$dboot{'disk'}} = @temp if @temp; + foreach my $row (@temp){ + $row =~ /^([^:\s]+)[:\s]+(.+)/; + $id = $1; + $value = $2; + push(@{$dboot_disks{$id}},$value); + # get rid of detached or non present drives + if ((@disks_live && !(grep {$id =~ /^$_/} @disks_live)) || + $value =~ /\b(destroyed|detached)$/){ + delete $dboot_disks{$id}; + } + } + $dboot{'disk'} = \%dboot_disks; + log_data('dump','post: $dboot{disk}',$dboot{'disk'}) if $b_log; + print("post: disk:\n",Dumper $dboot{'disk'}) if $dbg[11]; + } + if ($use{'bsd-pci'} && $dboot{'pci'}){ + my $bus_id = 0; + foreach (@{$dboot{'pci'}}){ + if (/^pci[0-9]+:at.*?bus\s([0-9]+)/){ + $bus_id = $1; + next; + } + elsif (/:at pci[0-9]+\sdev/){ + $_ =~ s/^(\S+):at.*?dev\s([0-9]+)\sfunction\s([0-9]+)\s/$bus_id:$2:$3:$1:/; + push(@temp,$_); + } + } + $dboot{'pci'} = [@temp]; + log_data('dump','$dboot{pci}',$dboot{'pci'}) if $b_log; + print("pci:\n",Dumper $dboot{'pci'}) if $dbg[11]; + } + } + eval $end if $b_log; +} + +## DesktopData ## +# returns array: +# 0: desktop name +# 1: version +# 2: toolkit +# 3: toolkit version +# 4: de/wm components: panels, docks, menus, etc +# 5: wm +# 6: wm version +# 7: tools: screensavers/lockers: running +# 8: tools: screensavers/lockers: all not running, installed +# 9: de advanced data type [eg. kde frameworks] +# 10: de advanced data version +{ +package DesktopData; +my ($b_dbg_de,$desktop_session,$gdmsession,$kde_full_session, +$kde_session_version,$tk_test,$xdg_desktop,@data,%xprop); +my $desktop = []; + +sub get { + eval $start if $b_log; + $b_dbg_de = 1 if $dbg[63] || $b_log; + PsData::set_de_wm() if !$loaded{'ps-gui'}; + set_env_data(); + # the order of these tests matters, go from most to least common + de_kde_tde_data(); + de_env_data() if !@$desktop; + if (!@$desktop){ + # NOTE: Always add to set_prop the search term if you add an item!! + set_xprop() if !$loaded{'xprop'}; + de_gnome_based_data(); + } + de_xfce_data() if !@$desktop; + de_enlightenment_based_data() if !@$desktop; + de_misc_data() if !@$desktop; + # last try, get it from ps data + de_ps_data() if !@$desktop; + if ($extra > 2 && @$desktop){ + components_data(); # bars, docks, menu, panels, trays etc + tools_data(); # screensavers, lockers + } + if ($b_display && !$force{'display'} && $extra > 1){ + wm_data(); + } + # we want tk, but no previous methods got it + if ($extra > 1 && !$desktop->[3] && $tk_test){ + if ($tk_test eq 'gtk'){ + tk_gtk_data();} + elsif ($tk_test eq 'qt'){ + tk_qt_data();} + else { + tk_misc_data();} + } + # try to avoid repeat version calls for wm/compostors + if ($show{'graphic'} && @$desktop){ + $comps{lc($desktop->[0])} = [$desktop->[0],$desktop->[1]] if $desktop->[0]; + $comps{lc($desktop->[5])} = [$desktop->[5],$desktop->[6]] if $desktop->[5]; + } + if ($b_log){ + main::log_data('dump','@$desktop', $desktop); + main::log_data('dump','%comps', \%comps); + } + if ($dbg[59]){ + print '$desktop: ', Data::Dumper::Dumper $desktop; + print '%comps: ', Data::Dumper::Dumper \%comps; + } + eval $end if $b_log; + return $desktop; +} + +## DE SPECIFIC IDS ## + +# ENLIGHTENMENT/MOKSHA # +sub de_enlightenment_based_data { + eval $start if $b_log; + # print 'de evn xprop: ', Data::Dumper::Dumper \%xprop; + my ($v_src,$program); + # earlier moksha fully ID as enlightenment + if ($xdg_desktop eq 'moksha' || $gdmsession eq 'moksha' || + ($xprop{'moksha'} && + (main::check_program('enlightenment') || main::check_program('moksha')))){ + # ENLIGHTENMENT_VERSION(STRING) = "Moksha 0.2.0.15989" + # note: toolkit: EFL + # later releases have -version + if ($v_src = main::check_program('moksha')){ + ($desktop->[0],$desktop->[1]) = ProgramData::full('moksha',$v_src); + } + # Earlier: no -v or --version but version is in xprop -root + if (!$desktop->[1] && $xprop{'moksha'}){ + $v_src = 'xprop'; + $desktop->[1] = main::awk($xprop{'moksha'}->{'lines'}, + '(enlightenment|moksha)_version',2,'\s+=\s+'); + $desktop->[1] =~ s/"?(moksha|enlightenment)\s([^"]+)"?/$2/ if $desktop->[1]; + } + $desktop->[0] ||= 'Moksha'; + } + elsif ($xdg_desktop eq 'enlightenment' || $gdmsession eq 'enlightenment' || + ($xprop{'enlightenment'} && main::check_program('enlightenment'))){ + # no -v or --version but version is in xprop -root + # ENLIGHTENMENT_VERSION(STRING) = "Enlightenment 0.16.999.49898" + $desktop->[0] = 'Enlightenment'; + if ($xprop{'enlightenment'}){ + $v_src = 'xprop'; + $desktop->[1] = main::awk($xprop{'enlightenment'}->{'lines'}, + '(enlightenment|moksha)_version',2,'\s+=\s+'); + $desktop->[1] =~ s/"?(moksha|enlightenment)\s([^"]+)"?/$2/ if $desktop->[1]; + } + } + if ($desktop->[0]){ + if ($extra > 1 && ($program = main::check_program('efl-version'))){ + ($desktop->[2],$desktop->[3]) = ProgramData::full('efl-version',$program); + } + $desktop->[2] ||= 'EFL' if $extra > 1; + main::feature_debugger('de ' . $desktop->[0] . ' v_src,program,desktop', + [$v_src,$program,$desktop],$dbg[63]) if $b_dbg_de; + } + eval $end if $b_log; +} + +# GNOME/CINNAMON/MATE # +sub de_gnome_based_data { + eval $start if $b_log; + # add more as discovered + return if $xdg_desktop eq 'xfce' || $gdmsession eq 'xfce'; + my ($program,$value,@version_data); + # note that cinnamon split from gnome, and and can now be id'ed via xprop, + # but it will still trigger the next gnome true case, so this needs to go + # before gnome test eventually this needs to be better organized so all the + # xprop tests are in the same section, but this is good enough for now. + # NOTE: was checking for 'muffin' but that's not part of cinnamon + if ($xdg_desktop eq 'cinnamon' || $gdmsession eq 'cinnamon' || + (($xprop{'muffin'} || $xprop{'mutter'}) && + (main::check_program('muffin') || main::check_program('cinnamon-session')))){ + ($desktop->[0],$desktop->[1]) = ProgramData::full('cinnamon','cinnamon',0); + $tk_test = 'gtk'; + $desktop->[0] ||= 'Cinnamon'; + main::feature_debugger('gnome test 1 $desktop',$desktop,$dbg[63]) if $b_dbg_de; + } + elsif ($xdg_desktop eq 'mate' || $gdmsession eq 'mate' || $xprop{'marco'}){ + # NOTE: mate-about and mate-sesssion vary which has the higher number, neither + # consistently corresponds to the actual MATE version, so check both. + my %versions = ('mate-about' => '','mate-session' => ''); + foreach my $key (keys %versions){ + if ($program = main::check_program($key)){ + ($desktop->[0],$versions{$key}) = ProgramData::full($key,$program,0); + } + } + # no consistent rule about which version is higher, so just compare them and take highest + $desktop->[1] = main::compare_versions($versions{'mate-about'},$versions{'mate-session'}); + # $tk_test = 'gtk'; + $desktop->[0] ||= 'MATE'; + main::feature_debugger('gnome test 2 $desktop',$desktop,$dbg[63]) if $b_dbg_de; + } + # See sub for logic and comments + elsif (check_gnome()){ + if (main::check_program('gnome-about')){ + ($desktop->[0],$desktop->[1]) = ProgramData::full('gnome-about'); + } + elsif (main::check_program('gnome-shell')){ + ($desktop->[0],$desktop->[1]) = ProgramData::full('gnome','gnome-shell'); + } + $tk_test = 'gtk'; + $desktop->[0] ||= 'GNOME'; + main::feature_debugger('gnome test 3 $desktop $desktop',$desktop, + $dbg[63]) if $b_dbg_de; + } + eval $end if $b_log; +} + +# Note, GNOME_DESKTOP_SESSION_ID is deprecated so we'll see how that works out +# https://bugzilla.gnome.org/show_bug.cgi?id=542880. +# NOTE: manjaro is leaving XDG data null, which forces the manual check for gnome, sigh... +# some gnome programs can trigger a false xprop gnome ID +# _GNOME_BACKGROUND_REPRESENTATIVE_COLORS(STRING) = "rgb(23,31,35)" +sub check_gnome { + eval $start if $b_log; + my ($b_gnome,$detection) = (0,''); + if ($xdg_desktop && $xdg_desktop =~ /gnome/){ + $detection = 'xdg_current_desktop'; + $b_gnome = 1; + } + # should work as long as string contains gnome, eg: peppermint:gnome + # filtered explicitly in set_env_data + elsif ($xdg_desktop && $xdg_desktop !~ /gnome/){ + $detection = 'xdg_current_desktop'; + } + # possible values: lightdm-xsession, only positive match tests will work + elsif ($gdmsession && $gdmsession eq 'gnome'){ + $detection = 'gdmsession'; + $b_gnome = 1; + } + # risky: Debian: $DESKTOP_SESSION = lightdm-xsession; Manjaro/Arch = xfce + # note that mate/cinnamon would already have been caught so no need to add + # explicit tests for them + elsif ($desktop_session && $desktop_session eq 'gnome'){ + $detection = 'desktop_session'; + $b_gnome = 1; + } + # possible value: this-is-deprecated, but I believe only gnome based desktops + # set this variable, so it doesn't matter what it contains + elsif ($ENV{'GNOME_DESKTOP_SESSION_ID'}){ + $detection = 'gnome_destkop_session_id'; + $b_gnome = 1; + } + # maybe use ^_gnome_session instead? try it for a while + elsif ($xprop{'gnome_session'} && main::check_program('gnome-shell')){ + $detection = 'xprop-root'; + $b_gnome = 1; + } + if ($b_dbg_de && $b_gnome){ + main::feature_debugger('gnome $detection','detect-type: ' . $detection,$dbg[63]); + } + main::log_data('data','$detection:$b_gnome>>' . $detection . ":$b_gnome") if $b_log; + eval $end if $b_log; + return $b_gnome; +} + +# KDE/TRINITY # +sub de_kde_tde_data { + eval $start if $b_log; + my ($kded,$kded_name,$program,$tk_src,$v_data,$v_src); + # we can't rely on 3 using kded3, it could be kded + if ($kde_session_version && ($program = main::check_program('kded' . $kde_session_version))){ + $kded = $program; + $kded_name = 'kded' . $kde_session_version; + } + elsif ($program = main::check_program('kded')){ + $kded = $program; + $kded_name = 'kded'; + } + # note: if TDM is used to start kde, can pass ps tde test + if ($desktop_session eq 'trinity' || $xdg_desktop eq 'trinity' || + (!$desktop_session && !$xdg_desktop && @{$ps_data{'de-ps-detect'}} && + (grep {/^tde/} @{$ps_data{'de-ps-detect'}}))){ + # 14.2 moved kdesktop to location not in PATH in some distros, so either of these will fail + if (($program = main::check_program('kdesktop')) || + ($program = main::check_program('twin'))){ + ($desktop->[0],$desktop->[1],$v_data) = ProgramData::full('kdesktop-trinity',$program,0,'raw'); + } + if ($extra > 1 && $v_data && @$v_data){ + ($desktop->[2],$desktop->[3]) = item_from_version($v_data,['^Qt:',2,'Qt']); + } + $desktop->[0] ||= 'Trinity'; + $desktop->[2] ||= 'Qt' if $extra > 1; + main::feature_debugger('kde trinity $program,$v_data,$desktop', + [$program,$v_data,$desktop],$dbg[63]) if $b_dbg_de; + } + # works on 4, assume 5 will id the same, why not, no need to update in future + # KDE_SESSION_VERSION is the integer version of the desktop + # NOTE: as of plasma 5, the tool: about-distro MAY be available, that will show + # actual desktop data, so once that's in debian/ubuntu, if it gets in, add that test + elsif ($desktop_session eq 'kde-plasma' || $desktop_session eq 'plasma' || + $xdg_desktop eq 'kde' || $kde_session_version){ + # KDE <= 4 + if ($kde_session_version && $kde_session_version <= 4){ + if ($program = main::check_program($kded_name)){ + ($desktop->[0],$desktop->[1],$v_data) = ProgramData::full($kded_name,$program,0,'raw'); + if ($extra > 1 && $v_data && @$v_data){ + ($desktop->[2],$desktop->[3]) = item_from_version($v_data,['^Qt:',2,'Qt']); + } + } + $desktop->[0] ||= 'KDE'; + $desktop->[2] ||= 'Qt' if $extra > 1; + main::feature_debugger('kde 4 program,v_data,$desktop', + [$program,$v_data,$desktop],$dbg[63]) if $b_dbg_de; + } + # KDE >= 5 + else { + # no qt data, just the kde version as of 5, not in kde4 + my $fw_src; + if (!$desktop->[0] && + ($v_src = $program = main::check_program("plasmashell"))){ + ($desktop->[0],$desktop->[1]) = ProgramData::full('plasmashell',$program); + } + # kwin through version 4 showed full kde/qt data, 5 only shows plasma version + if (!$desktop->[0] && + ($v_src = $program = main::check_program("kwin"))){ + ($desktop->[0],$desktop->[1]) = ProgramData::full('kwin-kde',$program); + } + $desktop->[0] = 'KDE Plasma'; + if (!$desktop->[1]){ + $desktop->[1] = ($kde_session_version) ? + $kde_session_version : main::message('unknown-desktop-version'); + } + # NOTE: this command string is almost certain to change, and break, with next + # major plasma desktop, ie, 6. + # qdbus org.kde.plasmashell /MainApplication org.qtproject.Qt.QCoreApplication.applicationVersion + # kde 4: kwin,kded4 (KDE:); kde5: kf5-config (KDE Frameworks:) + # Qt: 5.4.2 + # KDE Frameworks: 5.11.0 + # kf5-config: 1.0 + # for QT, and Frameworks if we use it. Frameworks v is NOT same as KDE v. + if ($extra > 1){ + if ($tk_src = $program = main::check_program("kf$kde_session_version-config")){ + ($desktop->[2],$desktop->[3],$v_data) = ProgramData::full( + "kf-config-qt",$program,0,'raw'); + } + if (!$desktop->[3] && (!$v_data || !@$v_data) && + ($tk_src = $program = main::check_program("kf-config"))){ + ($desktop->[2],$desktop->[3],$v_data) = ProgramData::full( + "kf-config-qt",$program,0,'raw'); + } + $desktop->[2] ||= 'Qt'; + if ($b_admin){ + if ($v_data && @$v_data){ + $fw_src = $tk_src; + ($desktop->[9],$desktop->[10]) = item_from_version($v_data, + ['^KDE Frameworks:',3,'frameworks']); + } + # This has Frameworks version as of kde 5 + if ($kded && !$desktop->[10]){ + $fw_src = $kded; + ($desktop->[9],$desktop->[10]) = ProgramData::full($kded_name . '-frameworks',$kded); + } + } + } + main::feature_debugger('kde >= 5 v_src,tk_src,fw_src,v_data,$desktop', + [$v_src,$tk_src,$fw_src,$v_data,$desktop],$dbg[63]) if $b_dbg_de; + } + } + # KDE_FULL_SESSION property is only available since KDE 3.5.5. This will only + # trigger for KDE 3.5, since above conditions catch >= 4 + elsif ($kde_full_session eq 'true'){ + # this is going to be bad data since new kdedX is different version from kde + ($desktop->[0],$desktop->[1],$v_data) = ProgramData::full($kded_name,$kded,0,'raw'); + $desktop->[1] ||= '3.5'; + if ($extra > 1 && $v_data && @$v_data){ + ($desktop->[2],$desktop->[3]) = item_from_version($v_data,['^Qt:',2,'Qt']); + + } + $desktop->[2] ||= 'Qt' if $extra > 1; + main::feature_debugger('kde 3.5 de+qt $desktop',$desktop,$dbg[63]) if $b_dbg_de; + } + eval $end if $b_log; +} + +# XFCE # +# Not strictly dependent on xprop data, which is not necessarily always present +sub de_xfce_data { + eval $start if $b_log; + my ($program,$v_data); + # print 'de-xfce-env: ', Data::Dumper::Dumper \%xprop; + # String: "This is xfdesktop version 4.2.12" + # alternate: xfce4-about --version > xfce4-about 4.10.0 (Xfce 4.10) + # note: some distros/wm (e.g. bunsen) set $xdg_desktop to xfce to solve some + # other issues so but are OpenBox. Not inxi issue. + # $xdg_desktop can be /usr/bin/startxfce4 + # print "xdg_d: $xdg_desktop gdms: $gdmsession\n"; + if ($xdg_desktop eq 'xfce' || $gdmsession eq 'xfce' || + (($xprop{'xfdesktop'} || $xprop{'xfce'}) && main::check_program('xfdesktop'))){ + ($desktop->[0],$desktop->[1],$v_data) = ProgramData::full('xfdesktop','',0,'raw'); + if (!$desktop->[1]){ + my $version = '4'; # just assume it's 4, we tried + if ($program = main::check_program('xfce4-panel')){ + $version = '4'; + } + # talk to xfce to see what id they will be using for xfce 5 + elsif ($program = main::check_program('xfce5-panel')){ + $version = '5'; + } + # they might get rid of number, we'll see + elsif ($program = main::check_program('xfce-panel')){ + $version = ''; + } + # xfce4-panel does not show built with gtk [version] + # this returns an error message to stdout in x, which breaks the version + # xfce4-panel --version out of x fails to get display, so no data + # out of x this kicks out an error: xfce4-panel: Cannot open display + ($desktop->[0],$desktop->[1]) = ProgramData::full("xfce${version}-panel",$program); + } + $desktop->[0] ||= 'Xfce'; + $desktop->[1] ||= ''; # xfce isn't going to be 4 forever + if ($extra > 1 && $v_data && @$v_data){ + ($desktop->[2],$desktop->[3]) = item_from_version($v_data,['^Built with GTK',4,'Gtk']); + } + main::feature_debugger('xfce $program,$desktop',[$program,$desktop], + $dbg[63]) if $b_dbg_de; + } + eval $end if $b_log; +} + +## GENERAL DE TESTS ## +sub de_env_data { + eval $start if $b_log; + if (!$desktop->[0]){ + my $v_data; + # 0: 0/1 regex/eq; 1: env var search; 2: PD full; 3: [PD version cmd]; + # 4: tk; 5: ps search; + # 6: [toolkits data sourced from full version [search,position,print]] + my @desktops =( + [1,'unity','unity','',''], + [0,'budgie','budgie-desktop','','gtk'], + [1,'cosmic','cosmic-session','','iced'], + # debian package: lxde-core. + # NOTE: some distros fail to set XDG data for root, ps may get it + [1,'lxde','lxpanel','','gtk-na',',^lxsession$'], # no gtk v data, not same as system + [1,'razor','razor-session','','qt','^razor-session$'], + # BAD: lxqt-about opens dialogue, sigh. + # Checked, lxqt-panel does show same version as lxqt-about/session + [1,'lxqt','lxqt-panel','','qt','^lxqt-session$',['Qt',2,'Qt']], + [0,'^(razor|lxqt)$','lxqt-variant','','qt','^(razor-session|lxqt-session)$'], + [1,'fvwm-crystal','fvwm-crystal','fvwm',''], + [1,'hyprland','hyprctl','',''], + [1,'blackbox','blackbox','',''], + # note, X-Cinnamon value strikes me as highly likely to change, so just + # search for the last part + [1,'nscde','nscde','',''],# has to go before cde + [0,'cde','cde','','motif'], + [0,'cinnamon','cinnamon','','gtk'], + # these so far have no cli version data + [1,'deepin','deepin','','qt'], # version comes from file read + [1,'draco','draco','','qt'], + [1,'leftwm','leftwm','',''], + [1,'mlvwm','mlvwm','',''], + [0,'^(motif\s?window|mwm)','mwm','','motif'], + [1,'pantheon','pantheon','','gtk'], + [1,'penrose','penrose','',''],# unknown, just guessing + [1,'lumina','lumina-desktop','','qt'], + [0,'manokwari','manokwari','','gtk'], + [1,'ukui','ukui-session','','qt'], + [0,'wmaker|windowmaker','windowmaker','wmaker',''], + ); + foreach my $item (@desktops){ + # Check if in xdg_desktop OR desktop_session OR if in $item->[5] and in ps_gui + if ((($item->[0] && + ($xdg_desktop eq $item->[1] || $desktop_session eq $item->[1])) || + (!$item->[0] && + ($xdg_desktop =~ /$item->[1]/ || $desktop_session =~ /$item->[1]/))) || + ($item->[5] && + @{$ps_data{'de-ps-detect'}} && (grep {/$item->[5]/} @{$ps_data{'de-ps-detect'}}))){ + ($desktop->[0],$desktop->[1],$v_data) = ProgramData::full($item->[2],$item->[3],0,$item->[6]); + if ($extra > 1){ + if ($item->[6] && $v_data && @$v_data){ + ($desktop->[2],$desktop->[3]) = item_from_version($v_data,$item->[6]); + } + $tk_test = $item->[4] if !$desktop->[3]; + } + main::feature_debugger('env de-wm',$desktop,$dbg[63]) if $b_dbg_de; + last; + } + } + } + eval $end if $b_log; +} + +# These require data from xprop. +sub de_misc_data { + eval $start if $b_log; + # print 'de evn xprop: ', Data::Dumper::Dumper \%xprop; + # the sequence here matters, some desktops like icewm, razor, let you set different + # wm, so we want to get the main controlling desktop first, then fall back to the wm + # detections. de_ps_data() and wm_data() will handle alternate wm detections. + if (%xprop){ + # order matters! These are the primary xprop detected de/wm + my $program; + my @desktops = qw(icewm i3 mwm windowmaker wm2 herbstluftwm fluxbox blackbox + openbox amiwm); + foreach my $de (@desktops){ + if ($xprop{$de} && + (($program = main::check_program($xprop{$de}->{'name'})) || + ($xprop{$de}->{'vname'} && ($program = main::check_program($xprop{$de}->{'vname'}))))){ + ($desktop->[0],$desktop->[1]) = ProgramData::full($xprop{$de}->{'name'},$program); + main::feature_debugger('de misc $program,$desktop', + [$program,$desktop],$dbg[63]) if $b_dbg_de; + last; + } + } + } + # need to check starts line because it's so short + eval $end if $b_log; +} + +sub de_ps_data { + eval $start if $b_log; + my ($v_data,@working); + # The sequence here matters, some desktops like icewm, razor, let you set different + # wm, so we want to get the main controlling desktop first + # icewm and any other that permits alternate wm to be used need to go first + push(@working,@{$ps_data{'wm-parent'}}) if @{$ps_data{'wm-parent'}}; + push(@working,@{$ps_data{'wm-compositors'}}) if @{$ps_data{'wm-compositors'}}; + push(@working,@{$ps_data{'wm-main'}}) if @{$ps_data{'wm-main'}}; + if (@working){ + # order matters, these have alternate search patterns from default name + # 0: check program; 1: ps_gui search; 2: PD full; 3: [PD version cmd] + my @wms =( + ['WindowMaker','(WindowMaker|wmaker)','wmaker',''], + ['cwm','(openbsd-)?cwm','cwm',''], + ['flwm','flwm(_topside)?','flwm',''], + ['fvwm-crystal','fvwm.*-crystal\S*','fvwm-crystal','fvwm'], + ['hyprland','[Hh]yprland','hyprctl',''], + ['xfdesktop','xfdesktop','xfdesktop','',['^Built with GTK',4,'Gtk']], + ); + # note: use my $item to avoid bizarre return from program_data to ps_gui write + foreach my $item (@wms){ + # no need to use check program with short list of ps_gui + # print "1: $item->[1]\n"; + if (grep {/^$item->[1]$/i} @working){ + # print "2: $item->[1]\n"; + ($desktop->[0],$desktop->[1],$v_data) = ProgramData::full($item->[2],$item->[3],0,$item->[4]); + if ($extra > 1 && $item->[4] && $v_data && @$v_data){ + ($desktop->[2],$desktop->[3]) = item_from_version($v_data,$item->[4]); + } + main::feature_debugger('ps de test 1 $desktop', + $desktop,$dbg[63]) if $b_dbg_de; + last; + } + } + if (!$desktop->[0]){ + # we're relying on the stack order to get primary before secondary wm + my $de = shift(@working); + ($desktop->[0],$desktop->[1]) = ProgramData::full($de); + main::feature_debugger('ps de test 2 $desktop', + $desktop,$dbg[63]) if $b_dbg_de; + } + } + eval $end if $b_log; +} + +## TOOLKIT DATA ## +# NOTE: used to use a super slow method here, but gtk-launch returns +# the gtk version I believe +sub tk_gtk_data { + eval $start if $b_log; + if (main::check_program('gtk-launch')){ + ($desktop->[2],$desktop->[3]) = ProgramData::full('gtk-launch'); + main::feature_debugger('gtk $desktop 2,3', + [$desktop->[2],$desktop->[3]],$dbg[63]) if $b_dbg_de; + } + eval $end if $b_log; +} + +# This handles stray toolkits that won't get versions, yet anyway. +sub tk_misc_data { + eval $start if $b_log; + if ($tk_test eq 'gtk-na'){ + $desktop->[2] = 'Gtk'; + } + else { + $desktop->[2] = ucfirst($tk_test); + } + eval $end if $b_log; +} + +# Note ideally most of these are handled by item_from_version, but these will +# handle as fallback detections as those are updated, if possible. +sub tk_qt_data { + eval $start if $b_log; + my $program; + my $kde_version = $kde_session_version; + if (!$kde_version){ + if ($program = main::check_program("kded6")){ + $kde_version = 6;} + elsif ($program = main::check_program("kded5")){ + $kde_version = 5;} + elsif ($program = main::check_program("kded4")){ + $kde_version = 4;} + elsif ($program = main::check_program("kded")){ + $kde_version = '';} + } + # alternate: qt4-default, qt4-qmake or qt5-default, qt5-qmake + # often this exists, is executable, but actually is nothing, shows error + if (!$desktop->[3] && ($program = main::check_program('qmake'))){ + ($desktop->[2],$desktop->[3]) = ProgramData::full('qmake-qt',$program); + } + if (!$desktop->[3] && ($program = main::check_program('qtdiag'))){ + ($desktop->[2],$desktop->[3]) = ProgramData::full('qtdiag-qt',$program); + } + if (!$desktop->[3] && ($program = main::check_program("kf$kde_version-config"))){ + ($desktop->[2],$desktop->[3]) = ProgramData::full('kf-config-qt',$program); + } + # note: qt 5 does not show qt version in kded5, sigh + if (!$desktop->[3] && ($program = main::check_program("kded$kde_version"))){ + ($desktop->[2],$desktop->[3]) = ProgramData::full('kded-qt',$program); + } + if ($b_dbg_de && ($desktop->[2] || $desktop->[3])){ + main::feature_debugger('qt $program,qt,v $desktop 2,3', + [$program,$desktop->[2],$desktop->[3]],$dbg[63]); + } + eval $end if $b_log; +} + +## WM DATA ## +sub wm_data { + eval $start if $b_log; + my $b_wm; + if (!$force{'wmctrl'}){ + set_xprop() if !$loaded{'xprop'}; + wm_ps_xprop_data(\$b_wm); + } + # note, some wm, like cinnamon muffin, do not appear in ps aux, but do in wmctrl + if (((!$b_wm && !$desktop->[5]) || $force{'wmctrl'}) && + (my $program = main::check_program('wmctrl'))){ + wm_wmctrl_data($program); + } + eval $end if $b_log; +} + +# args: 0: $b_wm ref +sub wm_ps_xprop_data { + eval $start if $b_log; + my $b_wm = $_[0]; + my @wms; + # order matters, see above logic + push(@wms,@{$ps_data{'de-wm-compositors'}}) if @{$ps_data{'de-wm-compositors'}}; + push(@wms,@{$ps_data{'wm-compositors'}}) if @{$ps_data{'wm-compositors'}}; + push(@wms,@{$ps_data{'wm-main'}}) if @{$ps_data{'wm-main'}}; + # eg: blackbox parent of icewm, icewm parent of blackbox + push(@wms,@{$ps_data{'wm-parent'}}) if @{$ps_data{'wm-parent'}}; + # leave off parent since that would always be primary + foreach my $wm (@wms){ + if ($wm eq 'windowmaker'){ + $wm = 'wmaker';} + wm_version('manual',$wm,$b_wm); + if ($desktop->[5]){ + main::feature_debugger('ps wm,v $desktop 5,6', + [$desktop->[5],$desktop->[6]],$dbg[63]) if $b_dbg_de; + last; + } + } + # xprop is set only if not kde/gnome/cinnamon/mate/budgie/lx. Issues with + # fluxbox blackbox_pid false detection, so run this as fallback. + if (!$desktop->[5] && %xprop){ + # print "wm ps xprop: ", Data::Dumper::Dumper \%xprop; + # KWIN_RUNNING, note: the actual xprop filters handle position and _ type syntax + # don't use i3, it's not unique enough in this test, can trigger false positive + @wms = qw(amiwm blackbox bspwm compiz kwin_x11 kwinft kwin + marco motif muffin mutter openbox herbstluftwm twin ukwm wm2 windowmaker); + my $working; + foreach my $wm (@wms){ + last if $desktop->[0] && $wm eq lc($desktop->[0]); # catch odd stuff like wmaker + if ($xprop{$wm}){ + $working = $wm; + if ($working eq 'mutter' && $desktop->[0] && lc($desktop->[0]) eq 'cinnamon'){ + $working = 'muffin'; + } + $working = $xprop{$wm}->{'vname'} if $xprop{$wm}->{'vname'}; + wm_version('manual',$working,$b_wm); + main::feature_debugger('xprop wm,v $desktop 5,6', + [$desktop->[5],$desktop->[6]],$dbg[63]) if $b_dbg_de; + last; + } + } + } + eval $end if $b_log; +} + +sub wm_wmctrl_data { + eval $start if $b_log; + my ($program) = @_; + my $cmd = "$program -m 2>/dev/null"; + my @data = main::grabber($cmd,'','strip'); + main::log_data('dump','@data',\@data) if $b_log; + $desktop->[5] = main::awk(\@data,'^Name',2,'\s*:\s*'); + # qtile,scrotwm,spectrwm have an odd fake wmctrl wm for irrelevant reasons + # inxi doesn't support lg3d, if support added update this, but assume bad + if ($desktop->[5] && ($desktop->[5] eq 'N/A' || + ($desktop->[0] && $desktop->[5] eq 'LG3D'))){ + $desktop->[5] = ''; + } + if ($desktop->[5]){ + # variants: gnome shell; + # IceWM 1.3.8 (Linux 3.2.0-4-amd64/i686) ; Metacity (Marco) ; Xfwm4 + $desktop->[5] =~ s/\d+\.\d\S+|[\[\(].*\d+\.\d.*[\)\]]//g; + $desktop->[5] = main::trimmer($desktop->[5]); + # change Metacity (Marco) to marco + if ($desktop->[5] =~ /marco/i){ + $desktop->[5] = 'marco';} + elsif ($desktop->[5] =~ /muffin/i){ + $desktop->[5] = 'muffin';} + elsif (lc($desktop->[5]) eq 'gnome shell'){ + $desktop->[5] = 'gnome-shell';} + elsif ($desktop_session eq 'trinity' && lc($desktop->[5]) eq 'kwin'){ + $desktop->[5] = 'Twin';} + wm_version('wmctrl',$desktop->[5]); + main::feature_debugger('wmctrl wm,v $desktop 5,6', + [$desktop->[5],$desktop->[6]],$dbg[63]) if $b_dbg_de; + } + eval $end if $b_log; +} + +# args: 0: manual/wmctrl; 1: wm; 2: $b_wm ref +sub wm_version { + eval $start if $b_log; + my ($type,$wm,$b_wm) = @_; + # we don't want the gnome-shell version, and the others have no --version + # we also don't want to run --version again on stuff we already have tested + if (!$wm || ($desktop->[0] && lc($desktop->[0]) eq lc($wm))){ + # we don't want to run wmctrl if we got a matching de/wm set + $$b_wm = 1 if $wm; + return; + } + elsif ($wm && $wm =~ /^(budgie-wm|gnome-shell)$/){ + $desktop->[5] = $wm; + return; + } + my $temp = (split(/\s+/, $wm))[0]; + if ($temp){ + $temp = (split(/\s+/, $temp))[0]; + $temp = lc($temp); + $temp = 'wmaker' if $temp eq 'windowmaker'; + my @data = ProgramData::full($temp,$temp,3); + return if !$data[0]; + # print Data::Dumper::Dumper \@data; + $desktop->[5] = $data[0] if $type eq 'manual'; + $desktop->[6] = $data[1] if $data[1]; + } + eval $end if $b_log; +} + +## PARTS/TOOLS DATA ## +sub components_data { + eval $start if $b_log; + if (@{$ps_data{'components-active'}}){ + main::make_list_value($ps_data{'components-active'},\$desktop->[4],',','sort'); + } + eval $end if $b_log; +} + +sub tools_data { + eval $start if $b_log; + # these are running/active + if (@{$ps_data{'tools-active'}}){ + main::make_list_value($ps_data{'tools-active'},\$desktop->[7],',','sort'); + } + # now check if any are available but not running/services + if ($b_admin){ + my %test; + my $installed = []; + if ($desktop->[7]){ + foreach my $tool (@{$ps_data{'tools-active'}}){ + $test{$tool} = 1; + } + } + foreach my $item (@{$ps_data{'tools-test'}}){ + next if $test{$item}; + if (main::check_program($item)){ + push(@$installed,$item); + } + } + if (@$installed){ + main::make_list_value($installed,\$desktop->[8],',','sort'); + } + } + eval $end if $b_log; +} + +## UTILITIES ## + +# args: 0: raw $version data ref; 1: [search regex, split pos, print name] +# returns item print name, version +sub item_from_version { + eval $start if $b_log; + my ($item,$version); + if (!$_[0] || !$_[1] || ref $_[0] ne 'ARRAY'){ + eval $end if $b_log; + return; + } + foreach my $line (@{$_[0]}){ + # print "line: $line\n"; + if ($line =~ /${$_[1]}[0]/){ + my @data = split(/\s+/,$line); + # print 'ifv main: ', Data::Dumper::Dumper \@data; + ($item,$version) = (${$_[1]}[2],$data[${$_[1]}[1] - 1]); + last; + } + } + $version =~ s/[,_\.-]$//g if $version; # trim off gunk + eval $end if $b_log; + return ($item,$version); +} + +# note: for tests, all values are lowercased. +sub set_env_data { + # NOTE $XDG_CURRENT_DESKTOP envvar is not reliable, but it shows certain desktops better. + # most desktops are not using it as of 2014-01-13 (KDE, UNITY, LXDE. Not Gnome) + $desktop_session = ($ENV{'DESKTOP_SESSION'}) ? clean_env($ENV{'DESKTOP_SESSION'}) : ''; + $xdg_desktop = ($ENV{'XDG_CURRENT_DESKTOP'}) ? clean_env($ENV{'XDG_CURRENT_DESKTOP'}) : ''; + $kde_full_session = ($ENV{'KDE_FULL_SESSION'}) ? clean_env($ENV{'KDE_FULL_SESSION'}) : ''; + $kde_session_version = ($ENV{'KDE_SESSION_VERSION'}) ? $ENV{'KDE_SESSION_VERSION'} : ''; + # for fallback to fallback protections re false gnome id + $gdmsession = ($ENV{'GDMSESSION'}) ? clean_env($ENV{'GDMSESSION'}) : ''; + main::feature_debugger('desktop-scalars', + ['$desktop_session: ' . $desktop_session, + '$xdg_desktop: ' . $xdg_desktop, + '$kde_full_session: ' . $kde_full_session, + '$kde_session_version: ' . $kde_session_version, + '$gdmsession: ' . $gdmsession],$dbg[63]) if $b_dbg_de; +} + +# Note: an ubuntu regresssion replaces or adds 'ubuntu' string to +# real value. Since ubuntu is the only distro I know that does this, +# will add more distro type filters as/if we come across them +# args: 0: +sub clean_env { + $_[0] = lc(main::trimmer($_[0])); + $_[0] =~ s/\b(arch|debian|fedora|manjaro|mint|opensuse|ubuntu):?\s*//i; + return $_[0]; +} + +sub set_xprop { + eval $start if $b_log; + $loaded{'xprop'} = 1; + my $data; + if (my $program = main::check_program('xprop')){ + $data = main::grabber("xprop -root $display_opt 2>/dev/null",'','strip','ref'); + if ( @$data){ + my $pattern = '_(MIT|QT_DESKTOP|WIN|XROOTPMAP)_|_NET_(CLIENT|SUPPORTED)|'; + $pattern .= '(AT_SPI|ESETROOT|GDK_VISUALS|GNOME_SM|PULSE|RESOURCE_|XKLAVIER'; + @$data = grep {!/^($pattern))/} @$data; + } + if ($data && @$data){ + $_ = lc for @$data; + # Add wm / de as required, but only add what is really tested for above + # index: 0: PD full name; 1: xprop search; 2: PD version name + my @info = ( + ['amiwm','^amiwm',''], + # leads to false IDs since other wm have this too + # ['blackbox','blackbox_pid',''], # fluxbox, forked from blackbox, has this + ['bspwm','bspwm',''], + ['compiz','compiz',''], + ['enlightenment','enlightenment',''], # gets version from line + ['gnome-session','^_gnome_session',''], + ['herbstluftwm','herbstluftwm',''], + ['i3','^i3_',''], + ['icewm','icewm',''], + ['kde','^kde_','kwin'], + ['kwin','^kwin_',''], + ['marco','_marco',''], + ['moksha','moksha',''], # gets version from line + # cde's dtwm is based on mwm, leads to bad ID, look for them with env/ps + # ['motif','^_motif_wm','mwm'], + ['muffin','_muffin',''], + ['mutter','_mutter',''], + ['openbox','openbox_pid',''], # lxde, lxqt, razor _may_ have this + ['ukwm','^_ukwm',''], + ['windowmaker','^_?windowmaker','wmaker'], + ['wm2','^_wm2',''], + # XFDESKTOP_IMAGE_FILE; XFCE_DESKTOP + ['xfce','^xfce','xfdesktop'], + ['xfdesktop','^xfdesktop',''], + ); + foreach my $item (@info){ + foreach my $line (@$data){ + if ($line =~ /$item->[1]/){ + $xprop{$item->[0]} = { + 'name' => $item->[0], + 'vname' => $item->[2], + } if !$xprop{$item->[0]}; + # we can have > 1 results for each search, and we want those lines + push(@{$xprop{$item->[0]}->{'lines'}},$line); + } + } + } + } + } + main::feature_debugger('xprop data: working, results', + [$data,\%xprop],$dbg[63]) if $b_dbg_de; + eval $end if $b_log; +} +} + +## DeviceData ## +# creates arrays: $devices{'audio'}; $devices{'graphics'}; $devices{'hwraid'}; +# $devices{'network'}; $devices{'timer'} and local @devices for logging/debugging +# 0: type +# 1: type_id +# 2: bus_id +# 3: sub_id +# 4: device +# 5: vendor_id +# 6: chip_id +# 7: rev +# 8: port +# 9: driver +# 10: modules +# 11: driver_nu [bsd, like: em0 - driver em; nu 0. Used to match IF in -n +# 12: subsystem/vendor +# 13: subsystem vendor_id:chip id +# 14: soc handle +# 15: serial number +{ +package DeviceData; +my (@bluetooth,@devices,@files,@full_names,@pcis,@temp,@temp2,@temp3,%lspci_n); +my ($b_bt_check,$b_lspci_n); +my ($busid,$busid_nu,$chip_id,$content,$device,$driver,$driver_nu,$file, +$handle,$modules,$port,$rev,$serial,$temp,$type,$type_id,$vendor,$vendor_id); + +sub set { + eval $start if $b_log; + ${$_[0]} = 1; # set check by reference + if ($use{'pci'}){ + if (!$bsd_type){ + if ($alerts{'lspci'}->{'action'} eq 'use'){ + lspci_data(); + } + # ! -d '/proc/bus/pci' + # this is sketchy, a sbc won't have pci, but a non sbc arm may have it, so + # build up both and see what happens + if (%risc){ + soc_data(); + } + } + else { + # if (1 == 1){ + if ($alerts{'pciconf'}->{'action'} eq 'use'){ + pciconf_data(); + } + elsif ($alerts{'pcidump'}->{'action'} eq 'use'){ + pcidump_data(); + } + elsif ($alerts{'pcictl'}->{'action'} eq 'use'){ + pcictl_data(); + } + } + if ($dbg[9]){ + print Data::Dumper::Dumper $devices{'audio'}; + print Data::Dumper::Dumper $devices{'bluetooth'}; + print Data::Dumper::Dumper $devices{'graphics'}; + print Data::Dumper::Dumper $devices{'network'}; + print Data::Dumper::Dumper $devices{'hwraid'}; + print Data::Dumper::Dumper $devices{'timer'}; + print "vm: $device_vm\n"; + } + if ($b_log){ + main::log_data('dump','$devices{audio}',$devices{'audio'}); + main::log_data('dump','$devices{bluetooth}',$devices{'bluetooth'}); + main::log_data('dump','$devices{graphics}',$devices{'graphics'}); + main::log_data('dump','$devices{hwraid}',$devices{'hwraid'}); + main::log_data('dump','$devices{network}',$devices{'network'}); + main::log_data('dump','$devices{timer}',$devices{'timer'}); + } + } + undef @devices; + eval $end if $b_log; +} + +sub lspci_data { + eval $start if $b_log; + my ($busid_full,$subsystem,$subsystem_id); + my $data = pci_grabber('lspci'); + # print Data::Dumper::Dumper $data; + foreach (@$data){ + # print "$_\n"; + if ($device){ + if ($_ eq '~'){ + @temp = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id, + $rev,$port,$driver,$modules,$driver_nu,$subsystem,$subsystem_id); + assign_data('pci',\@temp); + $device = ''; + # print "$busid $device_id r:$rev p: $port\n$type\n$device\n"; + } + elsif ($_ =~ /^Subsystem.*\[([a-f0-9]{4}:[a-f0-9]{4})\]/){ + $subsystem_id = $1; + $subsystem = (split(/^Subsystem:\s*/, $_))[1]; + $subsystem =~ s/(\s?\[[^\]]+\])+$//g; + $subsystem = main::clean($subsystem); + $subsystem = main::clean_pci($subsystem,'pci'); + $subsystem = main::clean_pci_subsystem($subsystem); + # print "ss:$subsystem\n"; + } + elsif ($_ =~ /^I\/O\sports/){ + $port = (split(/\s+/, $_))[3]; + # print "p:$port\n"; + } + elsif ($_ =~ /^Kernel\sdriver\sin\suse/){ + $driver = (split(/:\s*/, $_))[1]; + } + elsif ($_ =~ /^Kernel\smodules/i){ + $modules = (split(/:\s*/, $_))[1]; + } + } + # note: arm servers can have more complicated patterns + # 0002:01:02.0 Ethernet controller [0200]: Cavium, Inc. THUNDERX Network Interface Controller virtual function [177d:a034] (rev 08) + # seen cases of lspci trimming too long lines like this: + # 01:00.0 Display controller [0380]: Advanced Micro Devices, Inc. [AMD/ATI] Topaz XT [Radeon R7 M260/M265 / M340/M360 / M440/M445 / 530/535 / 620/625 Mobile] [10... (rev c3) (prog-if 00 [Normal decode]) + # \s(.*)\s\[([0-9a-f]{4}):([0-9a-f]{4})\](\s\(rev\s([^\)]+)\))? + elsif ($_ =~ /^((([0-9a-f]{2,4}:)?[0-9a-f]{2}:[0-9a-f]{2})[.:]([0-9a-f]+))\s+/){ + $busid_full = $1; + $busid = $2; + $busid_nu = hex($4); + ($chip_id,$rev,$type,$type_id,$vendor_id) = ('','','','',''); + $_ =~ s/^\Q$busid_full\E\s+//; + # old systems didn't use [...] but type will get caught in lspci_n check + if ($_ =~ /^(([^\[]+?)\s+\[([a-f0-9]{4})\]:\s+)/){ + $type = $2; + $type_id = $3; + $_ =~ s/^\Q$1\E//; + $type = lc($type); + $type = main::clean_pci($type,'pci'); + $type =~ s/\s+$//; + } + # trim off end prog-if and rev items + if ($_ =~ /(\s+\(prog[^\)]+\))/){ + $_ =~ s/\Q$1\E//; + } + if ($_ =~ /(\s+\(rev\s+[^\)]+\))/){ + $rev = $2; + $_ =~ s/\Q$1\E//; + } + # get rid of anything in parentheses at end in case other variants show + # up, which they probably will. + if ($_ =~ /((\s+\([^\)]+\))+)$/){ + $_ =~ s/\Q$1\E//; + } + if ($_ =~ /(\s+\[([0-9a-f]{4}):([0-9a-f]{4})\])$/){ + $vendor_id = $2; + $chip_id = $3; + $_ =~ s/\Q$1\E//; + } + # lspci -nnv string trunctation bug + elsif ($_ =~ /(\s+\[[^\]]*\.\.\.)$/){ + $_ =~ s/\Q$1\E//; + } + $device = $_; + # cases of corrupted string set to '' + $device = main::clean($device); + # corrupted lspci truncation bug; and ancient lspci, 2.4 kernels + if (!$vendor_id){ + my $temp = lspci_n_data($busid_full); + if (@$temp){ + $type_id = $temp->[0] if !$type_id; + $vendor_id = $temp->[1]; + $chip_id = $temp->[2]; + $rev = $temp->[3] if !$rev && $temp->[3]; + } + } + $use{'hardware-raid'} = 1 if $type_id eq '0104'; + ($driver,$driver_nu,$modules,$port,$subsystem,$subsystem_id) = ('','','','','',''); + } + } + print Data::Dumper::Dumper \@devices if $dbg[4]; + main::log_data('dump','lspci @devices',\@devices) if $b_log; + eval $end if $b_log; +} + +# args: 0: busID +# returns if valid busID: (classID,vendorID,productID,revNu) +# almost never used, only in case of lspci -nnv line truncation bug +sub lspci_n_data { + eval $start if $b_log; + my ($bus_id) = @_; + if (!$b_lspci_n){ + $b_lspci_n = 1; + my (@data); + if ($fake{'lspci'}){ + # my $file = "$fake_data_dir/pci/lspci/steve-mint-topaz-lspci-n.txt"; + # my $file = "$fake_data_dir/pci/lspci/ben81-hwraid-lspci-n.txt"; + # @data = main::reader($file,'strip'); + } + else { + @data = main::grabber($alerts{'lspci'}->{'path'} . ' -n 2>/dev/null','','strip'); + } + foreach (@data){ + if (/^([a-f0-9:\.]+)\s+([a-f0-9]{4}):\s+([a-f0-9]{4}):([a-f0-9]{4})(\s+\(rev\s+([0-9a-z\.]+)\))?/){ + my $rev = (defined $6) ? $6 : ''; + $lspci_n{$1} = [$2,$3,$4,$rev]; + } + } + print Data::Dumper::Dumper \%lspci_n if $dbg[4]; + main::log_data('dump','%lspci_n',\%lspci_n) if $b_log; + } + my $return = ($lspci_n{$bus_id}) ? $lspci_n{$bus_id}: []; + print Data::Dumper::Dumper $return if $dbg[50]; + main::log_data('dump','@$return') if $b_log; + eval $end if $b_log; + return $return; +} + +# em0@pci0:6:0:0: class=0x020000 card=0x10d315d9 chip=0x10d38086 rev=0x00 hdr=0x00 +# vendor = 'Intel Corporation' +# device = 'Intel 82574L Gigabit Ethernet Controller (82574L)' +# class = network +# subclass = ethernet +sub pciconf_data { + eval $start if $b_log; + my $data = pci_grabber('pciconf'); + foreach (@$data){ + if ($driver){ + if ($_ eq '~'){ + $vendor = main::clean($vendor); + $device = main::clean($device); + # handle possible regex in device name, like [ConnectX-3] + # and which could make matches fail + my $device_temp = main::clean_regex($device); + if ($vendor && $device){ + if (main::clean_regex($vendor) !~ /\Q$device_temp\E/i){ + $device = "$vendor $device"; + } + } + elsif (!$device){ + $device = $vendor; + } + @temp = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id, + $rev,$port,$driver,$modules,$driver_nu); + assign_data('pci',\@temp); + $driver = ''; + # print "$busid $device_id r:$rev p: $port\n$type\n$device\n"; + } + elsif ($_ =~ /^vendor/){ + $vendor = (split(/\s+=\s+/, $_))[1]; + # print "p:$port\n"; + } + elsif ($_ =~ /^device/){ + $device = (split(/\s+=\s+/, $_))[1]; + } + elsif ($_ =~ /^class/i){ + $type = (split(/\s+=\s+/, $_))[1]; + } + } + # pre freebsd 13, note chip is product+vendor + # atapci0@pci0:0:1:1: class=0x01018a card=0x00000000 chip=0x71118086 rev=0x01 hdr=0x00 + # freebsd 13 + # isab0@pci0:0:1:0: class=0x060100 rev=0x00 hdr=0x00 vendor=0x8086 device=0x7000 subvendor=0x0000 subdevice=0x0000 + if (/^([^@]+)\@pci([0-9]{1,3}:[0-9]{1,3}:[0-9]{1,3}):([0-9]{1,3}):/){ + $driver = $1; + $busid = $2; + $busid_nu = $3; + $driver = $1; + $driver =~ s/([0-9]+)$//; + $driver_nu = $1; + # we don't use the sub sub class part of the class id, just first 4 + if (/\bclass=0x([\S]{4})\S*\b/){ + $type_id = $1; + } + if (/\brev=0x([\S]+)\b/){ + $rev = $1; + } + if (/\bvendor=0x([\S]+)\b/){ + $vendor_id = $1; + } + if (/\bdevice=0x([\S]+)\b/){ + $chip_id = $1; + } + # yes, they did it backwards, product+vendor id + if (/\bchip=0x([a-f0-9]{4})([a-f0-9]{4})\b/){ + $chip_id = $1; + $vendor_id = $2; + } + ($device,$type,$vendor) = ('','',''); + } + } + print Data::Dumper::Dumper \@devices if $dbg[4]; + main::log_data('dump','pciconf @devices',\@devices) if $b_log; + eval $end if $b_log; +} + +sub pcidump_data { + eval $start if $b_log; + my $data = pci_grabber('pcidump'); + main::set_dboot_data() if !$loaded{'dboot'}; + foreach (@$data){ + if ($_ eq '~' && $busid && $device){ + @temp = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id, + $rev,$port,$driver,$modules,$driver_nu,'','','',$serial); + assign_data('pci',\@temp); + ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id, + $rev,$port,$driver,$modules,$driver_nu,$serial) = (); + next; + } + if ($_ =~ /^([0-9a-f:]+):([0-9]+):\s([^:]+)$/i){ + $busid = $1; + $busid_nu = $2; + ($driver,$driver_nu) = pcidump_driver("$busid:$busid_nu") if $dboot{'pci'}; + $device = main::clean($3); + } + elsif ($_ =~ /^0x[\S]{4}:\s+Vendor ID:\s+([0-9a-f]{4}),?\s+Product ID:\s+([0-9a-f]{4})/){ + $vendor_id = $1; + $chip_id = $2; + } + elsif ($_ =~ /^0x[\S]{4}:\s+Class:\s+([0-9a-f]{2})(\s[^,]+)?,?\s+Subclass:\s+([0-9a-f]{2})(\s+[^,]+)?,?(\s+Interface: ([0-9a-f]+),?\s+Revision: ([0-9a-f]+))?/){ + $type = pci_class($1); + $type_id = "$1$3"; + } + elsif (/^Serial Number:\s*(\S+)/){ + $serial = $1; + } + } + print Data::Dumper::Dumper \@devices if $dbg[4]; + main::log_data('dump','pcidump @devices',\@devices) if $b_log; + eval $end if $b_log; +} + +sub pcidump_driver { + eval $start if $b_log; + my $bus_id = $_[0]; + my ($driver,$nu); + for (@{$dboot{'pci'}}){ + if (/^$bus_id:([^0-9]+)([0-9]+):/){ + $driver = $1; + $nu = $2; + last; + } + } + eval $end if $b_log; + return ($driver,$nu); +} + +sub pcictl_data { + eval $start if $b_log; + my $data = pci_grabber('pcictl'); + my $data2 = pci_grabber('pcictl-n'); + foreach (@$data){ + if ($_ eq '~' && $busid && $device){ + @temp = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id, + $rev,$port,$driver,$modules,$driver_nu); + assign_data('pci',\@temp); + ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id, + $rev,$port,$driver,$modules,$driver_nu) = (); + next; + } + # it's too fragile to get these in one matching so match, trim, next match + if (/\s+\[([^\]0-9]+)([0-9]+)\]$/){ + $driver = $1; + $driver_nu = $2; + $_ =~ s/\s+\[[^\]]+\]$//; + } + if (/\s+\(.*?(revision 0x([^\)]+))?\)/){ + $rev = $2 if $2; + $_ =~ s/\s+\([^\)]+?\)$//; + } + if ($_ =~ /^([0-9a-f:]+):([0-9]+):\s+([^.]+?)$/i){ + $busid = $1; + $busid_nu = $2; + $device = main::clean($3); + my $working = (grep {/^${busid}:${busid_nu}:\s/} @$data2)[0]; + if ($working && + $working =~ /^${busid}:${busid_nu}:\s+0x([0-9a-f]{4})([0-9a-f]{4})\s+\(0x([0-9a-f]{2})([0-9a-f]{2})[0-9a-f]+\)/){ + $vendor_id = $1; + $chip_id = $2; + $type = pci_class($3); + $type_id = "$3$4"; + } + } + } + print Data::Dumper::Dumper \@devices if $dbg[4]; + main::log_data('dump','pcidump @devices',\@devices) if $b_log; + eval $end if $b_log; +} + +sub pci_grabber { + eval $start if $b_log; + my ($program) = @_; + my ($args,$path,$pattern,$data); + my $working = []; + if ($program eq 'lspci'){ + # 2.2.8 lspci did not support -k, added in 2.2.9, but -v turned on -k + $args = ' -nnv'; + $path = $alerts{'lspci'}->{'path'}; + $pattern = q/^[0-9a-f]+:/; # i only added perl 5.14, don't use qr/ + } + elsif ($program eq 'pciconf'){ + $args = ' -lv'; + $path = $alerts{'pciconf'}->{'path'}; + $pattern = q/^([^@]+)\@pci/; # i only added perl 5.14, don't use qr/ + } + elsif ($program eq 'pcidump'){ + $args = ' -v'; + $path = $alerts{'pcidump'}->{'path'}; + $pattern = q/^[0-9a-f]+:/; # i only added perl 5.14, don't use qr/ + } + elsif ($program eq 'pcictl'){ + $args = ' pci0 list -N'; + $path = $alerts{'pcictl'}->{'path'}; + $pattern = q/^[0-9a-f:]+:/; # i only added perl 5.14, don't use qr/ + } + elsif ($program eq 'pcictl-n'){ + $args = ' pci0 list -n'; + $path = $alerts{'pcictl'}->{'path'}; + $pattern = q/^[0-9a-f:]+:/; # i only added perl 5.14, don't use + } + if ($fake{'lspci'} || $fake{'pciconf'} || $fake{'pcictl'} || $fake{'pcidump'}){ + # my $file = "$fake_data_dir/pci/pciconf/pci-freebsd-8.2-2"; + # my $file = "$fake_data_dir/pci/pcidump/pci-openbsd-6.1-vm.txt"; + # my $file = "$fake_data_dir/pci/pcictl/pci-netbsd-9.1-vm.txt"; + # my $file = "$fake_data_dir/pci/lspci/racermach-1-knnv.txt"; + # my $file = "$fake_data_dir/pci/lspci/rk016013-knnv.txt"; + # my $file = "$fake_data_dir/pci/lspci/kot--book-lspci-nnv.txt"; + # my $file = "$fake_data_dir/pci/lspci/steve-mint-topaz-lspci-nnkv.txt"; + # my $file = "$fake_data_dir/pci/lspci/ben81-hwraid-lspci-nnv.txt"; + # my $file = "$fake_data_dir/pci/lspci/gx78b-lspci-nnv.txt"; + # $data = main::reader($file,'strip','ref'); + } + else { + $data = main::grabber("$path $args 2>/dev/null",'','strip','ref'); + } + if (@$data){ + $use{'pci-tool'} = 1 if scalar @$data > 10; + foreach (@$data){ + # this is the group separator and assign trigger + if ($_ =~ /$pattern/i){ + push(@$working, '~'); + } + push(@$working, $_); + } + push(@$working, '~'); + } + print Data::Dumper::Dumper $working if $dbg[30]; + eval $end if $b_log; + return $working; +} + +sub soc_data { + eval $start if $b_log; + soc_devices_files(); + soc_devices(); + soc_devicetree(); + print Data::Dumper::Dumper \@devices if $dbg[4]; + main::log_data('dump','soc @devices',\@devices) if $b_log; + eval $end if $b_log; +} + +# 1: /sys/devices/platform/soc/1c30000.ethernet/uevent:["DRIVER=dwmac-sun8i", "OF_NAME=ethernet", +# "OF_FULLNAME=/soc/ethernet@1c30000", "OF_COMPATIBLE_0=allwinner,sun8i-h3-emac", +# "OF_COMPATIBLE_N=1", "OF_ALIAS_0=ethernet0", # "MODALIAS=of:NethernetTCallwinner,sun8i-h3-emac"] +# 2: /sys/devices/platform/soc:audio/uevent:["DRIVER=bcm2835_audio", "OF_NAME=audio", "OF_FULLNAME=/soc/audio", +# "OF_COMPATIBLE_0=brcm,bcm2835-audio", "OF_COMPATIBLE_N=1", "MODALIAS=of:NaudioTCbrcm,bcm2835-audio"] +# 3: /sys/devices/platform/soc:fb/uevent:["DRIVER=bcm2708_fb", "OF_NAME=fb", "OF_FULLNAME=/soc/fb", +# "OF_COMPATIBLE_0=brcm,bcm2708-fb", "OF_COMPATIBLE_N=1", "MODALIAS=of:NfbTCbrcm,bcm2708-fb"] +# 4: /sys/devices/platform/soc/1c40000.gpu/uevent:["OF_NAME=gpu", "OF_FULLNAME=/soc/gpu@1c40000", +# "OF_COMPATIBLE_0=allwinner,sun8i-h3-mali", "OF_COMPATIBLE_1=allwinner,sun7i-a20-mali", +# "OF_COMPATIBLE_2=arm,mali-400", "OF_COMPATIBLE_N=3", +# "MODALIAS=of:NgpuTCallwinner,sun8i-h3-maliCallwinner,sun7i-a20-maliCarm,mali-400"] +# 5: /sys/devices/platform/soc/soc:internal-regs/d0018180.gpio/uevent +# 6: /sys/devices/soc.0/1180000001800.mdio/8001180000001800:05/uevent +# ["DRIVER=AR8035", "OF_NAME=ethernet-phy" +# 7: /sys/devices/soc.0/1c30000.eth/uevent +# 8: /sys/devices/wlan.26/uevent [from pine64] +# 9: /sys/devices/platform/audio/uevent:["DRIVER=bcm2835_AUD0", "OF_NAME=audio" +# 10: /sys/devices/vio/71000002/uevent:["DRIVER=ibmveth", "OF_NAME=l-lan" +# 11: /sys/devices/platform/soc:/soc:i2c-hdmi:/i2c-2/2-0050/uevent:['OF_NAME=hdmiddc' +# 12: /sys/devices/platform/soc:/soc:i2c-hdmi:/uevent:['DRIVER=i2c-gpio', 'OF_NAME=i2c-hdmi' +# 13: /sys/devices/platform/scb/fd580000.ethernet/uevent +# 14: /sys/devices/platform/soc/fe300000.mmcnr/mmc_host/mmc1/mmc1:0001/mmc1:0001:1/uevent (wifi, pi 3,4) +# 15: Pi BT: /sys/devices/platform/soc/fe201000.serial/uevent +# 16: Pi BT: /sys/devices/platform/soc/fe201000.serial/tty/ttyAMA0/hci0 +sub soc_devices_files { + eval $start if $b_log; + if (-d '/sys/devices/platform/'){ + @files = main::globber('/sys/devices/platform/soc*/*/uevent'); + @temp2 = main::globber('/sys/devices/platform/soc*/*/*/uevent'); + push(@files,@temp2) if @temp2; + if (-e '/sys/devices/platform/scb'){ + @temp2 = main::globber('/sys/devices/platform/scb/*/uevent'); + push(@files,@temp2) if @temp2; + @temp2 = main::globber('/sys/devices/platform/scb/*/*/uevent'); + push(@files,@temp2) if @temp2; + } + @temp2 = main::globber('/sys/devices/platform/*/uevent'); + push(@files,@temp2) if @temp2; + } + if (main::globber('/sys/devices/soc*')){ + @temp2 = main::globber('/sys/devices/soc*/*/uevent'); + push(@files,@temp2) if @temp2; + @temp2 = main::globber('/sys/devices/soc*/*/*/uevent'); + push(@files,@temp2) if @temp2; + } + @temp2 = main::globber('/sys/devices/*/uevent'); # see case 8 + push(@files,@temp2) if @temp2; + @temp2 = main::globber('/sys/devices/*/*/uevent'); # see case 10 + push(@files,@temp2) if @temp2; + undef @temp2; + # not sure why, but even as root/sudo, /subsystem|driver/uevent are unreadable with -r test true + @files = grep {!/\/(subsystem|driver)\//} @files if @files; + main::uniq(\@files); + eval $end if $b_log; +} + +sub soc_devices { + eval $start if $b_log; + my (@working); + set_bluetooth() if !$b_bt_check; + foreach $file (@files){ + next if -z $file; + $chip_id = $file; + # variants: /soc/20100000.ethernet/ /soc/soc:audio/ /soc:/ /soc@0/ /soc:/12cb0000.i2c:/ + # mips: /sys/devices/soc.0/1180000001800.mdio/8001180000001800:07/ + # ppc: /sys/devices/vio/71000002/ + $chip_id =~ /\/sys\/devices\/(platform\/)?(soc[^\/]*\/)?([^\/]+\/)?([^\/]+\/)?([^\/\.:]+)([\.:])?([^\/:]+)?:?\/uevent$/; + $chip_id = $5; + $temp = $7; + @working = main::reader($file, 'strip') if -r $file; + ($device,$driver,$handle,$type,$vendor_id) = (); + foreach my $data (@working){ + @temp2 = split('=', $data); + if ($temp2[0] eq 'DRIVER'){ + $driver = $temp2[1]; + $driver =~ s/-/_/g if $driver; # kernel uses _, not - in module names + } + elsif ($temp2[0] eq 'OF_NAME'){ + $type = $temp2[1]; + } + # we'll use these paths to test in device tree pci completer + elsif ($temp2[0] eq 'OF_FULLNAME' && $temp2[1]){ + # we don't want the short names like /soc, /led and so on + push(@full_names, $temp2[1]) if (() = $temp2[1] =~ /\//g) > 1; + $handle = (split('@', $temp2[1]))[-1] if $temp2[1] =~ /@/; + } + elsif ($temp2[0] eq 'OF_COMPATIBLE_0'){ + @temp3 = split(',', $temp2[1]); + $device = $temp3[-1]; + $vendor_id = $temp3[0]; + } + } + # it's worthless, we can't use it + next if ! defined $type; + $type_id = $type; + if (@bluetooth && $type eq 'serial'){ + my $file_temp = $file; + $file_temp =~ s/uevent$//; + $type = 'bluetooth' if grep {/$file_temp/} @bluetooth; + } + $chip_id = '' if ! defined $chip_id; + $vendor_id = '' if ! defined $vendor_id; + $driver = '' if ! defined $driver; + $handle = '' if ! defined $handle; + $busid = (defined $temp && main::is_int($temp)) ? $temp: 0; + $type = soc_type($type,$vendor_id,$driver); + ($busid_nu,$modules,$port,$rev) = (0,'','',''); + @temp3 = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id,$rev, + $port,$driver,$modules,'','','',$handle); + assign_data('soc',\@temp3); + main::log_data('dump','soc devices: @devices @temp3',\@temp3) if $b_log; + } + eval $end if $b_log; +} + +sub soc_devicetree { + eval $start if $b_log; + # now we want to fill in stuff that was not in /sys/devices/ + if (-d '/sys/firmware/devicetree/base/soc'){ + @files = main::globber('/sys/firmware/devicetree/base/soc/*/compatible'); + my $test = (@full_names) ? join('|', sort @full_names) : 'xxxxxx'; + set_bluetooth() if !$b_bt_check; + foreach $file (@files){ + if ($file !~ m%$test%){ + ($handle,$content,$device,$type,$type_id,$vendor_id) = ('','','','','',''); + $content = main::reader($file, 'strip',0) if -r $file; + $file =~ m%soc/([^@]+)@([^/]+)/compatible$%; + $type = $1; + next if !$type || !$content; + $handle = $2 if $2; + $type_id = $type; + if (@bluetooth && $type eq 'serial'){ + my $file_temp = $file; + $file_temp =~ s/uevent$//; + $type = 'bluetooth' if grep {/$file_temp/} @bluetooth; + } + if ($content){ + @temp3 = split(',', $content); + $vendor_id = $temp3[0]; + $device = $temp3[-1]; + # strip off those weird device tree special characters + $device =~ s/\x01|\x02|\x03|\x00//g; + } + $type = soc_type($type,$vendor_id,''); + @temp3 = ($type,$type_id,0,0,$device,$vendor_id,'soc','','','','','','','',$handle); + assign_data('soc',\@temp3); + main::log_data('dump','devicetree: @devices @temp3',\@temp3) if $b_log; + } + } + } + eval $end if $b_log; +} + +sub set_bluetooth { + # special case of pi bt on ttyAMA0 + $b_bt_check = 1; + @bluetooth = main::globber('/sys/class/bluetooth/*') if -e '/sys/class/bluetooth'; + @bluetooth = map {$_ = Cwd::abs_path($_);$_} @bluetooth if @bluetooth; + @bluetooth = grep {!/usb/} @bluetooth if @bluetooth; # we only want non usb bt + main::log_data('dump','soc bt: @bluetooth', \@bluetooth) if $b_log; +} + +sub assign_data { + my ($tool,$data) = @_; + if (check_graphics($data->[0],$data->[1])){ + push(@{$devices{'graphics'}},[@$data]); + $use{'soc-gfx'} = 1 if $tool eq 'soc'; + } + # for hdmi, we need gfx/audio both + if (check_audio($data->[0],$data->[1])){ + push(@{$devices{'audio'}},[@$data]); + $use{'soc-audio'} = 1 if $tool eq 'soc'; + } + if (check_bluetooth($data->[0],$data->[1])){ + push(@{$devices{'bluetooth'}},[@$data]); + $use{'soc-bluetooth'} = 1 if $tool eq 'soc'; + } + elsif (check_hwraid($data->[0],$data->[1])){ + push(@{$devices{'hwraid'}},[@$data]); + $use{'soc-hwraid'} = 1 if $tool eq 'soc'; + } + elsif (check_network($data->[0],$data->[1])){ + push(@{$devices{'network'}},[@$data]); + $use{'soc-network'} = 1 if $tool eq 'soc'; + } + elsif (check_timer($data->[0],$data->[1])){ + push(@{$devices{'timer'}},[@$data]); + $use{'soc-timer'} = 1 if $tool eq 'soc'; + } + # not used at this point, -M comes before ANG + # $device_vm = check_vm($data[4]) if ((!$risc{'ppc'} && !$risc{'mips'}) && !$device_vm); + push(@devices,[@$data]); +} + +# Note: for SOC these have been converted in soc_type() +sub check_audio { + if (($_[1] && length($_[1]) == 4 && $_[1] =~ /^04/) || + ($_[0] && $_[0] =~ /^(audio|hdmi|multimedia|sound)$/i)){ + return 1; + } + else {return 0} +} + +sub check_bluetooth { + if (($_[1] && length($_[1]) == 4 && $_[1] eq '0d11') || + ($_[0] && $_[0] =~ /^(bluetooth)$/i)){ + return 1; + } + else {return 0} +} + +sub check_graphics { + # note: multimedia class 04 is video if 0400. 'tv' is risky I think + if (($_[1] && length($_[1]) == 4 && ($_[1] =~ /^03/ || $_[1] eq '0400' || + $_[1] eq '0d80')) || + ($_[0] && $_[0] =~ /^(vga|display|hdmi|3d|video|tv|television)$/i)){ + return 1; + } + else {return 0} +} + +sub check_hwraid { + return 1 if ($_[1] && $_[1] eq '0104'); +} + +# NOTE: class 06 subclass 80 +# https://www-s.acm.illinois.edu/sigops/2007/roll_your_own/7.c.1.html +# 0d20: 802.11a 0d21: 802.11b 0d80: other wireless +sub check_network { + if (($_[1] && length($_[1]) == 4 && ($_[1] =~/^02/ || $_[1] =~ /^0d2/ || $_[1] eq '0680')) || + ($_[0] && $_[0] =~ /^(ethernet|network|wifi|wlan)$/i)){ + return 1; + } + else {return 0} +} + +sub check_timer { + return 1 if ($_[0] && $_[0] eq 'timer'); +} + +sub check_vm { + if ($_[0] && $_[0] =~ /(innotek|vbox|virtualbox|vmware|qemu)/i){ + return $1 + } + else {return ''} +} + +sub soc_type { + my ($type,$info,$driver) = @_; + # I2S or i2s. I2C is i2 controller |[iI]2[Ss]. note: odroid hdmi item is sound only + # snd_soc_dummy. simple-audio-amplifier driver: speaker_amp + if (($driver && $driver =~ /codec/) || ($info && $info =~ /codec/) || + ($type && $type =~ /codec/)){ + $type = 'codec'; + } + elsif (($driver && $driver =~ /dummy/i) || ($info && $info =~ /dummy/i)){ + $type = 'dummy'; + } + # rome_vreg reg_fixed_voltage regulator-fixed wlan_en_vreg + elsif (($driver && $driver =~ /\bv?reg(ulat|_)|voltage/i) || + ($info && $info =~ /_v?reg|\bv?reg(ulat|_)|voltage/i)){ + $type = 'regulator'; + } + elsif ($type =~ /^(daudio|.*hifi.*|.*sound[_-]card|.*dac[0-9]?)$/i || + ($info && $info !~ /amp/i && $info =~ /(sound|audio)/i) || + ($driver && $driver =~ /(audio|snd|sound)/i)){ + $type = 'audio'; + } + # no need for bluetooth since that's only found in pi, handled above + elsif ($type =~ /^((meson-?)?fb|disp|display(-[^\s]+)?|gpu|.*mali|vpu)$/i){ + $type = 'display'; + } + # includes ethernet-phy, meson-eth + elsif ($type =~ /^(([^\s]+-)?eth|ethernet(-[^\s]+)?|lan|l-lan)$/i){ + $type = 'ethernet'; + } + elsif ($type =~ /^(.*wlan.*|.*wifi.*|.*mmcnr.*)$/i){ + $type = 'wifi'; + } + # needs to catch variants like hdmi-tx but not hdmi-connector + elsif ($type =~ /^(.*hdmi(-?tx)?)$/i){ + $type = 'hdmi'; + } + elsif ($type =~ /^timer$/i){ + $type = 'timer'; + } + return $type; +} + +sub pci_class { + eval $start if $b_log; + my ($id) = @_; + $id = lc($id); + my %classes = ( + '00' => 'unclassified', + '01' => 'mass-storage', + '02' => 'network', + '03' => 'display', + '04' => 'audio', + '05' => 'memory', + '06' => 'bridge', + '07' => 'communication', + '08' => 'peripheral', + '09' => 'input', + '0a' => 'docking', + '0b' => 'processor', + '0c' => 'serialbus', + '0d' => 'wireless', + '0e' => 'intelligent', + '0f' => 'satellite', + '10' => 'encryption', + '11' => 'signal-processing', + '12' => 'processing-accelerators', + '13' => 'non-essential-instrumentation', + # 14 - fe reserved + '40' => 'coprocessor', + 'ff' => 'unassigned', + ); + my $type = (defined $classes{$id}) ? $classes{$id}: 'unhandled'; + eval $end if $b_log; + return $type; +} +} + +# if > 1, returns first found, not going to be too granular with this yet. +sub get_device_temp { + eval $start if $b_log; + my $bus_id = $_[0]; + my $glob = "/sys/devices/pci*/*/*:$bus_id/hwmon/hwmon*/temp*_input"; + my @files = main::globber($glob); + my $temp; + foreach my $file (@files){ + $temp = main::reader($file,'strip',0); + if ($temp){ + $temp = sprintf('%0.1f',$temp/1000); + last; + } + } + eval $end if $b_log; + return $temp; +} + +## DiskDataBSD ## +# handles disks and partition extra data for disks bsd, raid-zfs, +# partitions, swap, unmounted +# glabel: partID, logical/physical-block-size, uuid, label, size +# disklabel: partID, block-size, fs, size +{ +package DiskDataBSD; + +# Sets initial pure dboot data, and fills it in with +# disklabel/gpart partition and advanced data +sub set { + eval $start if $b_log; + $loaded{'disk-data-bsd'} = 1; + set_dboot_disks(); + if ($use{'bsd-partition'}){ + if ($alerts{'gpart'}->{'action'} eq 'use'){ + set_gpart_data(); + } + elsif ($alerts{'disklabel'}->{'action'} eq 'use'){ + set_disklabel_data(); + } + } + eval $end if $b_log; +} + +sub get { + eval $start if $b_log; + my $id = $_[0]; + return if !$id || !%disks_bsd; + $id =~ s|^/dev/||; + my $data = {}; + # this handles mainly zfs, which can be either disk or part + if ($disks_bsd{$id}){ + $data = $disks_bsd{$id}; + delete $data->{'partitions'} if $data->{'partitions'}; + } + else { + OUTER: foreach my $key (keys %disks_bsd){ + if ($disks_bsd{$key}->{'partitions'}){ + foreach my $part (keys %{$disks_bsd{$key}->{'partitions'}}){ + if ($part eq $id){ + $data = $disks_bsd{$key}->{'partitions'}{$part}; + last OUTER; + } + } + } + } + } + eval $end if $b_log; + return $data; +} + +sub set_dboot_disks { + eval $start if $b_log; + my ($working,@temp); + foreach my $id (sort keys %{$dboot{'disk'}}){ + next if !@{$dboot{'disk'}->{$id}}; + foreach (@{$dboot{'disk'}->{$id}}){ + my @row = split(/:\s*/, $_); + next if !$row[0]; + # no dots, note: ada2: 2861588MB BUT: ada2: 600.000MB/s + # print "$_ i: $i\n"; + # openbsd/netbsd matches will often work + if ($row[0] =~ /(^|,\s*)([0-9\.]+\s*[MGTPE])i?B?[,.\s]+([0-9]+)\ssectors$|^{'block-physical'} = POSIX::ceil(($working/$3)*1024) if $3; + $disks_bsd{$id}->{'size'} = $working; + } + # don't set both, if smartctl installed, we want to use its data so having + # only one of logical/physical will trip use of smartctl values + if ($row[0] =~ /[\s,]+([0-9]+)\sbytes?[\s\/]sect/){ + #$disks_bsd{$id}->{'block-logical'} = $1; + $disks_bsd{$id}->{'block-physical'} = $1; + } + if ($row[1]){ + if ($row[1] =~ /<([^>]+)>/){ + $disks_bsd{$id}->{'model'} = $1 if $1; + $disks_bsd{$id}->{'type'} = 'removable' if $_ =~ /removable/; + # + my $count = ($disks_bsd{$id}->{'model'} =~ tr/,//); + if ($count && $count > 1){ + @temp = split(/,\s*/, $disks_bsd{$id}->{'model'}); + $disks_bsd{$id}->{'model'} = $temp[1]; + } + } + if ($row[1] =~ /\bserial\.(\S*)/){ + $disks_bsd{$id}->{'serial'} = $1; + } + } + if (!$disks_bsd{$id}->{'serial'} && $row[0] =~ /^Serial\sNumber\s(.*)/){ + $disks_bsd{$id}->{'serial'} = $1; + } + # mmcsd0:32GB at mmc0 50.0MHz/4bit/65535-block + if (!$disks_bsd{$id}->{'serial'} && $row[0] =~ /(\s(SN|s\/n)\s(\S+))[>\s]/){ + $disks_bsd{$id}->{'serial'} = $3; + # strip out the SN/MFG so it won't show in model + $row[0] =~ s/$1//; + $row[0] =~ s/\sMFG\s[^>]+//; + } + # these were mainly FreeBSD/Dragonfly matches + if (!$disks_bsd{$id}->{'size'} && $row[0] =~ /^([0-9]+\s*[KMGTPE])i?B?[\s,]/){ + $working = main::translate_size($1); + $disks_bsd{$id}->{'size'} = $working; + } + if ($row[0] =~ /(device$|^([0-9\.]+\s*[KMGT]B\s+)?<)/){ + $row[0] =~ s/\bdevice$//g; + $row[0] =~ /<([^>]*)>(\s(.*))?/; + $disks_bsd{$id}->{'model'} = $1 if $1; + $disks_bsd{$id}->{'spec'} = $3 if $3; + } + if ($row[0] =~ /^([0-9\.]+[MG][B]?\/s)/){ + $disks_bsd{$id}->{'speed'} = $1; + $disks_bsd{$id}->{'speed'} =~ s/\.[0-9]+// if $disks_bsd{$id}->{'speed'}; + } + $disks_bsd{$id}->{'model'} = main::clean_disk($disks_bsd{$id}->{'model'}); + if (!$disks_bsd{$id}->{'serial'} && $show{'disk'} && $extra > 1 && + $alerts{'bioctl'}->{'action'} eq 'use'){ + $disks_bsd{$id}->{'serial'} = bioctl_data($id); + } + } + } + print 'dboot disk: ', Data::Dumper::Dumper \%disks_bsd if $dbg[34]; + main::log_data('dump','%disks_bsd',\%disks_bsd) if $b_log; + eval $end if $b_log; +} + +sub bioctl_data { + eval $start if $b_log; + my $id = $_[0]; + my $serial; + my $working = (main::grabber($alerts{'bioctl'}->{'path'} . " $id 2>&1",'','strip'))[0]; + if ($working){ + if ($working =~ /permission/i){ + $alerts{'bioctl'}->{'action'} = 'permissions'; + } + elsif ($working =~ /serial[\s-]?(number|n[ou]\.?)?\s+(\S+)$/i){ + $serial = $2; + } + } + eval $end if $b_log; + return $serial; +} + +sub set_disklabel_data { + eval $start if $b_log; + my ($cmd,@data,@working); + # see docs/inxi-data.txt for fs info + my %fs = ( + '4.2bsd' => 'ffs', + '4.4lfs' => 'lfs', + ); + foreach my $id (keys %disks_bsd){ + $cmd = "$alerts{'disklabel'}->{'path'} $id 2>&1"; + @data = main::grabber($cmd,'','strip'); + main::log_data('dump','disklabel @data', \@data) if $b_log; + if (scalar @data < 4 && (grep {/permission/i} @data)){ + $alerts{'disklabel'}->{'action'} = 'permissions'; + $alerts{'disklabel'}->{'message'} = main::message('root-feature'); + last; + } + else { + my ($b_part,$duid,$part_id,$bytes_sector) = (); + if ($extra > 2 && $show{'disk'} && $alerts{'fdisk'}->{'action'} eq 'use'){ + $disks_bsd{$id}->{'partition-table'} = fdisk_data($id); + } + foreach my $row (@data){ + if ($row =~ /^\d+\spartitions:/){ + $b_part = 1; + next; + } + if (!$b_part){ + @working = split(/:\s*/, $row); + if ($working[0] eq 'bytes/sector'){ + $disks_bsd{$id}->{'block-physical'} = $working[1]; + $bytes_sector = $working[1]; + } + elsif ($working[0] eq 'duid'){ + $working[1] =~ s/^0+$//; # dump duid if all 0s + $disks_bsd{$id}->{'duid'} = $working[1]; + } + elsif ($working[0] eq 'label'){ + $disks_bsd{$id}->{'dlabel'} = $working[1]; + } + } + # part: size [bytes*sector] offset fstype [fsize bsize cpg]# mount + # d: 8388608 18838976 4.2BSD 2048 16384 12960 # /tmp + else { + @working = split(/:?\s+#?\s*/, $row); + # netbsd: disklabel: super block size 0 AFTER partitions started! + # note: 'unused' fs type is NOT unused space, it's often the entire disk!! + if (($working[0] && $working[0] eq 'disklabel') || + ($working[3] && $working[3] =~ /ISO9660|unused/i) || + (!$working[1] || !main::is_numeric($working[1]))){ + next; + } + $part_id = $id . $working[0]; + $working[1] = $working[1]*$bytes_sector/1024 if $working[1]; + $disks_bsd{$id}->{'partitions'}{$part_id}{'size'} = $working[1]; + if ($working[3]){ # fs + $working[3] = lc($working[3]); + $working[3] = $fs{$working[3]} if $fs{$working[3]}; #translate + } + $disks_bsd{$id}->{'partitions'}{$part_id}{'fs'} = $working[3]; + # OpenBSD: mount point; NetBSD: (Cyl. 0 - 45852*) + if ($working[7] && $working[7] =~ m|^/|){ + $disks_bsd{$id}->{'partitions'}{$part_id}{'mount'} = $working[7]; + } + $disks_bsd{$id}->{'partitions'}{$part_id}{'uuid'} = ''; + $disks_bsd{$id}->{'partitions'}{$part_id}{'label'} = ''; + } + } + } + } + print 'disklabel: ', Data::Dumper::Dumper \%disks_bsd if $dbg[34]; + main::log_data('dump', '%disks_bsd', \%disks_bsd) if $b_log; + eval $end if $b_log; +} + +sub fdisk_data { + eval $start if $b_log; + my $id = $_[0]; + my ($scheme); + my @data = main::grabber($alerts{'fdisk'}->{'path'} . " -v $id 2>&1",'','strip'); + foreach (@data){ + if (/permission/i){ + $alerts{'fdisk'}->{'action'} = 'permissions'; + last; + } + elsif (/^(GUID|MBR):/){ + $scheme = ($1 eq 'GUID') ? 'GPT' : $1; + last; + } + } + eval $start if $b_log; + return $scheme; +} + +# 2021-03: openbsd: n/a; dragonfly: no 'list'; freebsd: yes +sub set_gpart_data { + eval $start if $b_log; + my @data = main::grabber($alerts{'gpart'}->{'path'} . " list 2>/dev/null",'','strip'); + main::log_data('dump', 'gpart: @data', \@data) if $b_log; + my ($b_cd,$id,$part_id,$type); + for (@data){ + my @working = split(/\s*:\s*/, $_); + if ($working[0] eq 'Geom name'){ + $id = $working[1]; + # [1. Name|Geom name]: iso9660/FVBE + $b_cd = ($id =~ /iso9660/i) ? 1: 0; + next; + } + elsif ($working[0] eq 'scheme'){ + $disks_bsd{$id}->{'scheme'} = $working[1]; + next; + } + elsif ($working[0] eq 'Consumers'){ + $type = 'disk'; + next; + } + elsif ($working[0] eq 'Providers'){ + $type = 'part'; + next; + } + if (!$b_cd && $type && $type eq 'part'){ + if ($working[0] =~ /^[0-9]+\.\s*Name/){ + $part_id = $working[1]; + } + # eg: label:(null) - we want to show null + elsif ($working[0] eq 'label'){ + $working[1] =~ s/\(|\)//g; + $disks_bsd{$id}->{'partitions'}{$part_id}{'label'} = $working[1]; + } + elsif ($working[0] eq 'Mediasize'){ + $working[1] =~ s/\s+\(.*$//; # trim off the (2.4G) + # gpart shows in bytes, not KiB. For the time being... + $disks_bsd{$id}->{'partitions'}{$part_id}{'size'} = $working[1]/1024 if $working[1]; + } + elsif ($working[0] eq 'rawuuid'){ + $working[1] =~ s/\(|\)//g; + $disks_bsd{$id}->{'partitions'}{$part_id}{'uuid'} = $working[1]; + } + elsif ($working[0] eq 'Sectorsize'){ + $disks_bsd{$id}->{'partitions'}{$part_id}{'physical-block-size'} = $working[1]; + } + elsif ($working[0] eq 'Stripesize'){ + $disks_bsd{$id}->{'partitions'}{$part_id}{'logical-block-size'} = $working[1]; + } + elsif ($working[0] eq 'type'){ + $working[1] =~ s/\(|\)//g; + $disks_bsd{$id}->{'partitions'}{$part_id}{'fs'} = $working[1]; + } + } + # really strange results happen if no dboot disks were found and it's zfs! + elsif (!$b_cd && $type && $type eq 'disk' && $disks_bsd{$id}->{'size'}){ + # need to see raid, may be > 1 Consumers + if ($working[0] =~ /^[0-9]+\.\s*Name/){ + $id = $working[1]; + } + elsif ($working[0] eq 'Mediasize'){ + $working[1] =~ s/\s+\(.*$//; # trim off the (2.4G) + # gpart shows in bytes, not KiB. For the time being... + $disks_bsd{$id}->{'size'} = $working[1]/1024 if $working[1]; + } + elsif ($working[0] eq 'Sectorsize'){ + $disks_bsd{$id}->{'block-physical'} = $working[1]; + } + } + } + print 'gpart: ', Data::Dumper::Dumper \%disks_bsd if $dbg[34]; + main::log_data('dump', '%disks_bsd', \%disks_bsd) if $b_log; + eval $end if $b_log; +} +} + +## DmData ## +# Public method: get() +# returns hash ref of array of arrays for dm/lm +# hash: dm, lm +# 0: dm/lm print name +# 1: dm/lm version +# 2: dm/lm status +{ +package DmData; +my ($found,@glob); + +sub get { + eval $start if $b_log; + set_glob(); + $found = {}; + get_dm_lm('dm'); + if (!$found->{'dm'}){ + test_ps_dm() + } + get_dm_lm('lm') if !$found->{'dm'}; + print 'dm data: ', Data::Dumper::Dumper $found if $dbg[60]; + main::log_data('dump','display manager: %$found',$found) if $b_log; + eval $end if $b_log; + return $found; +} + +sub set_glob { + eval $start if $b_log; + my $pattern = ''; + if (-d '/run'){ + $pattern .= '/run'; + } + # in most linux, /var/run is a sym link to /run, so no need to check it twice + if (-d '/var/run' && ! -l '/var/run'){ + $pattern .= ',' if $pattern; + $pattern .= '/var/run'; + } + if (-d '/var/run/rc.d'){ + $pattern .= ',' if $pattern; + $pattern .= '/var/run/rc.d'; + } + if ($pattern){ + $pattern = '{' . $pattern . '}/*'; + # for dm.pid type file or dm directory names, like greetd-684.sock + @glob = main::globber($pattern); + main::uniq(\@glob) if @glob; + } + print '@glob: ', Data::Dumper::Dumper \@glob if $dbg[60]; + main::log_data('dump','dm @glob:',\@glob) if $b_log; + eval $end if $b_log; +} + +# args: 0: dm/lm, first test for dms, then if no dms, test for lms +sub get_dm_lm { + eval $start if $b_log; + my $type = $_[0]; + my (@dms,@glob_working,@temp); + # See: docs/inxi-desktops-wm.txt for Display/login manager info. + # Guessing on cdm, qingy. pcdm uses vt, PCDM-vt9.pid + # Add Ly in case they add run file/directory. + if ($type eq 'dm'){ + @dms = qw(brzdm cdm emptty entranced gdm gdm3 kdm kdm3 kdmctl ldm lemurs + lightdm loginx lxdm ly mdm mlogind nodm pcdm qingy sddm slim slimski tdm + udm wdm x3dm xdm xdmctl xenodm); + } + # greetd frontends: agreety cosmic-greeter dlm gtkgreet qtgreet tuigreet + # wlgreet + # slick, elephant greeters for lightdm so aren't really lm + else { + @dms = qw(elogind greetd qtgreet seatd tbsm); + } + # print Data::Dumper::Dumper \@glob; + # used to test for .pid/lock type file or directory, now just see if the + # search name exists in run and call it good since test would always be true + # if directory existed previously anyway. + if (@glob){ + my $search = join('|',@dms); + @glob_working = grep {/\/($search)\b/} @glob; + if (@glob_working){ + foreach my $item (@glob_working){ + my @id = grep {$item =~ /\/$_\b/} @dms; + push(@temp,@id) if @id; + } + # note: there were issues with duplicated dm's, using uniq will handle those + main::uniq(\@temp) if @temp; + } + } + @dms = @temp; + my @dm_info; + # print Data::Dumper::Dumper \@dms; + # we know the files or directories exist so no need for further checks here + foreach my $dm (@dms){ + @dm_info = (); + ($dm_info[0],$dm_info[1]) = ProgramData::full($dm,'',3); + if (scalar @dms > 1 && (my $temp = ServiceData::get('status',$dm))){ + $dm_info[2] = main::message('stopped') if $temp && $temp =~ /stopped|disabled/; + } + push(@{$found->{$type}},[@dm_info]); + } + eval $end if $b_log; +} + +sub test_ps_dm { + eval $start if $b_log; + PsData::set_dm(); + if (@{$ps_data{'dm-active'}}){ + my @dm_info; + # ly does not have a run/pid file + if (grep {$_ eq 'ly'} @{$ps_data{'dm-active'}}){ + ($dm_info[0],$dm_info[1]) = ProgramData::full('ly','ly',3); + $found->{'dm'}[0] = [@dm_info]; + } + elsif (grep {/startx$/} @{$ps_data{'dm-active'}}){ + $found->{'dm'}[0] = ['startx']; + } + elsif (grep {$_ eq 'xinit'} @{$ps_data{'dm-active'}}){ + $found->{'dm'}[0] = ['xinit']; + } + } + eval $end if $b_log; +} +} + +## DistroData ## +{ +package DistroData; +my ($id_src,@osr,@working); +my ($etc_issue,$lc_issue,$os_release) = ('','','/etc/os-release'); +my $distro = { +'base' => '', +'base-files' => [], +'base-method' => [], +'file' => '', +'files' => [], +'id' => '', +'method' => [], +'name' => '', +}; + +sub get { + eval $start if $b_log; + if ($dbg[66] || $b_log){ + $distro->{'dbg'} = 1; + } + if ($bsd_type){ + get_distro_bsd(); + } + else { + get_distro_linux(); + } + eval $end if $b_log; + return $distro; +} + +## BSD ## +sub get_distro_bsd { + eval $start if $b_log; + # used to parse /System/Library/CoreServices/SystemVersion.plist for Darwin + # but dumping that since it broke, just using standard BSD uname 0 2 name. + if (!$distro->{'name'}){ + my $bsd_type_osr = 'dragonfly'; + if (-r $os_release){ + @osr = main::reader($os_release); + push(@{$distro->{'files'}},$os_release) if $distro->{'dbg'}; + if (@osr && $bsd_type =~ /($bsd_type_osr)/ && (grep {/($bsd_type_osr)/i} @osr)){ + $distro->{'name'} = get_osr(); + $distro->{'id'} = lc($1); + push(@{$distro->{'method'}},$os_release); + } + } + } + if (!$distro->{'name'}){ + my $bsd_type_version = 'truenas'; + my ($version_file,$version_info) = ('/etc/version',''); + if (-r $version_file){ + $version_info = main::reader($version_file,'strip'); + push(@{$distro->{'files'}},$version_file) if $distro->{'dbg'}; + if ($version_info && $version_info =~ /($bsd_type_version)/i){ + $distro->{'name'} = $version_info; + $distro->{'id'} = lc($1); + push(@{$distro->{'method'}},$version_file); + } + } + } + if (!$distro->{'name'}){ + # seen a case without osx file, or was it permissions? + # this covers all the other bsds anyway, no problem. + $distro->{'name'} = "$uname[0] $uname[2]"; + $distro->{'id'} = lc($uname[0]); + push(@{$distro->{'method'}},'uname 0, 2'); + } + if ($distro->{'name'} && + (-e '/etc/pkg/GhostBSD.conf' || -e '/usr/local/etc/pkg/repos/GhostBSD.conf') && + $distro->{'name'} =~ /freebsd/i){ + my $version = (main::grabber("pkg query '%v' os-generic-userland-base 2>/dev/null"))[0]; + # only swap if we get result from the query + if ($version){ + $distro->{'base'} = $distro->{'name'}; + $distro->{'name'} = "GhostBSD $version"; + push(@{$distro->{'method'}},'pkg query'); + } + } + if ($distro->{'dbg'}){ + dbg_distro_files('BSD',$distro->{'files'}); + main::feature_debugger('name: $distro: pre-base [bsd]',$distro); + } + system_base_bsd() if $extra > 0; + eval $end if $b_log; +} + +sub system_base_bsd { + eval $start if $b_log; + # ghostbsd is handled in main bsd section + if (lc($uname[1]) eq 'nomadbsd' && $distro->{'id'} eq 'freebsd'){ + $distro->{'base'} = $distro->{'name'}; + $distro->{'name'} = $uname[1]; + push(@{$distro->{'method-base'}},'uname 1'); + } + elsif (-f '/etc/pkg/HardenedBSD.conf' && $distro->{'id'} eq 'freebsd'){ + $distro->{'base'} = $distro->{'name'}; + $distro->{'name'} = 'HardenedBSD'; + push(@{$distro->{'method-base'}},'/etc/pkg/HardenedBSD.conf'); + } + elsif ($distro->{'id'} =~ /^(truenas)$/){ + $distro->{'base'} = "$uname[0] $uname[2]"; + push(@{$distro->{'method-base'}},'uname 0 + 2'); + } + main::feature_debugger('system-base: $distro [bsd]',$distro) if $distro->{'dbg'}; + eval $end if $b_log; +} + +# GNU/LINUX ## +sub get_distro_linux { + # NOTE: increasingly no distro release files are present, so this logic is + # deprecated, but still works often. + # order matters! + my @derived = qw(antix-version aptosid-version bodhibuilder.conf kanotix-version + knoppix-version pclinuxos-release mandrake-release manjaro-release mx-version + pardus-release porteus-version q4os_version sabayon-release + siduction-version sidux-version slax-version slint-version slitaz-release + solusos-release turbolinux-release zenwalk-version); + my $derived_str = join('|', @derived); + # if t2 ever adds a standard distro file name, add here. Ideally it adds os-release + my @primary = qw(altlinux-release arch-release gentoo-release redhat-release + slackware-version SuSE-release); + my $primary_str = join('|', @primary); + my $exclude_str = 'debian_version|devuan_version|ubuntu_version'; + # note, pclinuxos has all these mandrake/mandriva files, careful! + my $lsb_good_str = 'mandrake-release|mandriva-release|mandrakelinux-release|'; + $lsb_good_str .= 'manjaro-release'; + my $osr_good_str = 'altlinux-release|arch-release|mageia-release|'; + $osr_good_str .= 'pclinuxos-release|rpi-issue|SuSE-release'; + # We need these empirically verified one by one as they appear, but always remember + # that stuff changes, legacy, deprecated, but these ideally are going to be right + my $osr_good = 'antergos|chakra|fedora|guix|mageia|manjaro|oracle|pclinuxos|'; + $osr_good .= 'porteux|raspberry pi os|slint|zorin'; + # Force use of pretty name because that's only location of derived distro name + # devuan should catch many devuans spins, which often put their names in pretty + my $osr_pretty = 'devuan|slackel|zinc'; + my $dist_file_no_name = 'slitaz'; # these may not have the distro name in the file + my ($issue,$lsb_release) = ('/etc/issue','/etc/lsb-release'); + # Note: OpenSuse Tumbleweed 2018-05 has made /etc/issue created by sym link to /run/issue + # and then made that resulting file 700 permissions, which is obviously a mistake + $etc_issue = main::reader($issue,'strip',0) if -r $issue; + # debian issue can end with weird escapes like \n \l + # antergos: Antergos Linux \r (\l) + main::clean_characters(\$etc_issue) if $etc_issue; + # Note: always exceptions, so wild card after release/version: + # /etc/lsb-release-crunchbang + # Wait to handle since crunchbang file is one of the few in the world that + # uses this method + @{$distro->{'files'}} = main::globber('/etc/{*[-_]{[rR]elease,[vV]ersion}*,VERSION,issue}'); + @osr = main::reader($os_release) if -r $os_release; + # a few with custom distro file locations + if (-r '/etc/bodhibuilder.conf'){ + push(@{$distro->{'files'}}, '/etc/bodhibuilder.conf'); # legacy + } + if (-f '/etc/bodhi/info'){ + $lsb_release = '/etc/bodhi/info'; + $distro->{'file'} = $lsb_release; + $distro->{'issue-skip'} = 1; + push(@{$distro->{'files'}}, $lsb_release); + } + # their issue is full of ascii art, and they use irregular distro file name + elsif (-d '/usr/src/t2-src' && -s '/etc/VERSION'){ + $distro->{'file'} = '/etc/VERSION'; + push(@{$distro->{'files'}}, $distro->{'file'}); + $distro->{'issue-skip'} = 1; + } + $distro->{'issue'} = $issue if -f $issue; + $distro->{'lsb'} = $lsb_release if -f $lsb_release; + if (!$distro->{'issue-skip'} && $etc_issue){ + $lc_issue = lc($etc_issue); + if ($lc_issue =~ /(antergos|grml|linux lite|openmediavault)/){ + $distro->{'id'} = $1; + $distro->{'issue-skip'} = 1; + } + # This raspbian detection fails for raspberry pi os + elsif ($lc_issue =~ /(raspbian|peppermint)/){ + $distro->{'id'} = $1; + $distro->{'file'} = $os_release if @osr; + } + # Note: wrong fix, applies to both raspbian and raspberry pi os + # assumption here is that r pi os fixes this before stable release + elsif ($lc_issue =~ /^debian/ && -e '/etc/apt/sources.list.d/raspi.list' && + (grep {/[^#]+raspberrypi\.org/} main::reader('/etc/apt/sources.list.d/raspi.list'))){ + $distro->{'id'} = 'raspios' ; + } + } + # Note that antergos changed this around # 2018-05, and now lists + # antergos in os-release, sigh... We want these distros to use os-release + # if it contains their names. Last check below + if (@osr){ + if (grep {/($osr_good)/i} @osr){ + $distro->{'file'} = $os_release; + } + elsif (grep {/($osr_pretty)/i} @osr){ + $distro->{'osr-pretty'} = 1; + $distro->{'file'} = $os_release; + } + } + if (grep {/armbian/} @{$distro->{'files'}}){ + $distro->{'id'} = 'armbian' ; + } + $distro->{'file-for-0'} = $distro->{'file'}; + dbg_distro_files('Linux',$distro->{'files'}) if $distro->{'dbg'}; + if (!$distro->{'file'}){ + if (scalar @{$distro->{'files'}} == 1){ + $distro->{'file'} = $distro->{'files'}[0]; + } + elsif (scalar @{$distro->{'files'}} > 1){ + # Special case, to force manjaro/antergos which also have arch-release + # manjaro should use lsb, which has the full info, arch uses os release + # antergos should use /etc/issue. We've already checked os-release above + if ($distro->{'id'} eq 'antergos' || + (grep {/antergos|chakra|manjaro/} @{$distro->{'files'}})){ + @{$distro->{'files'}} = grep {!/arch-release/} @{$distro->{'files'}}; + } + my $dist_files_str = join('|', @{$distro->{'files'}}); + foreach my $file ((@derived,@primary)){ + if ("/etc/$file" =~ /($dist_files_str)$/){ + # These is for only those distro's with self named release/version files + # because Mint does not use such, it must be done as below + # Force use of os-release file in cases where there might be conflict + # between lsb-release rules and os-release priorities. + if (@osr && $file =~ /($osr_good_str)$/){ + $distro->{'file'} = $os_release; + } + # Now lets see if the distro file is in the known-good working-lsb-list + # if so, use lsb-release, if not, then just use the found file + elsif ($distro->{'lsb'} && $file =~ /$lsb_good_str/){ + $distro->{'file'} = $lsb_release; + } + else { + $distro->{'file'} = "/etc/$file"; + } + last; + } + } + } + } + $distro->{'file-for-1'} = $distro->{'file'}; + # first test for the legacy antiX distro id file + if (-r '/etc/antiX'){ + @working = main::reader('/etc/antiX'); + $distro->{'name'} = main::awk(\@working,'antix.*\.iso') if @working; + main::clean_characters(\$distro->{'name'}) if $distro->{'name'}; + push(@{$distro->{'method'}},'file: /etc/antiX'); + } + # This handles case where only one release/version file was found, and it's lsb-release. + # This would never apply for ubuntu or debian, which will filter down to the following + # conditions. In general if there's a specific distro release file available, that's to + # be preferred, but this is a good backup. + elsif ($distro->{'file'} && $distro->{'lsb'} && + ($distro->{'file'} =~ /\/etc\/($lsb_good_str)$/ || $distro->{'file'} eq $lsb_release)){ + # print "df: $distro->{'file'} lf: $lsb_release\n"; + $distro->{'name'} = get_lsb($lsb_release); + push(@{$distro->{'method'}},'get_lsb(): primary'); + } + elsif ($distro->{'file'} && $distro->{'file'} eq $os_release){ + $distro->{'name'} = get_osr(); + $distro->{'osr-skip'} = 1; + push(@{$distro->{'method'}},'get_osr(): primary'); + } + # If distro id file was found and it's not in the exluded primary distro file list, read it + elsif ($distro->{'file'} && -s $distro->{'file'} && $distro->{'file'} !~ /\/etc\/($exclude_str)$/){ + # New opensuse uses os-release, but older ones may have a similar syntax, so just use + # the first line + if ($distro->{'file'} eq '/etc/SuSE-release'){ + # Leaving off extra data since all new suse have it, in os-release, this file has + # line breaks, like os-release but in case we want it, it's: + # CODENAME = Mantis | VERSION = 12.2 + # For now, just take first occurrence, which should be the first line, which does + # not use a variable type format + @working = main::reader($distro->{'file'}); + $distro->{'name'} = main::awk(\@working,'suse'); + push(@{$distro->{'method'}}, 'custom: suse-release'); + } + elsif ($distro->{'file'} eq '/etc/bodhibuilder.conf'){ + @working = main::reader($distro->{'file'}); + $distro->{'name'} = main::awk(\@working,'^LIVECDLABEL',2,'\s*=\s*'); + $distro->{'name'} =~ s/"//g if $distro->{'name'}; + push(@{$distro->{'method'}},'custom: /etc/bodhibuilder'); + } + else { + $distro->{'name'} = main::reader($distro->{'file'},'',0); + # only contains version number. Why? who knows. + if ($distro->{'file'} eq '/etc/q4os_version' && $distro->{'name'} !~ /q4os/i){ + $distro->{'name'} = "Q4OS $distro->{'name'}" ; + } + push(@{$distro->{'method'}},'default: distro file'); + } + main::clean_characters(\$distro->{'name'}) if $distro->{'name'}; + } + # Otherwise try the default debian/ubuntu/distro /etc/issue file + elsif ($distro->{'issue'}){ + if (!$distro->{'id'} && $lc_issue && $lc_issue =~ /(mint|lmde)/){ + $distro->{'id'} = $1; + $distro->{'issue-skip'} = 1; + } + # os-release/lsb gives more manageable and accurate output than issue, + # but mint should use issue for now. Antergos uses arch os-release, but issue shows them + if (!$distro->{'issue-skip'} && @osr){ + $distro->{'name'} = get_osr(); + $distro->{'osr-skip'} = 1; + push(@{$distro->{'method'}},'get_osr(): w/issue'); + } + elsif (!$distro->{'issue-skip'} && $distro->{'lsb'}){ + $distro->{'name'} = get_lsb(); + push(@{$distro->{'method'}},'get_lsb(): w/issue'); + } + elsif ($etc_issue){ + if (-d '/etc/guix' && $lc_issue =~ /^this is the gnu system\./){ + # No standard paths or files for os data, use pm version + ($distro->{'name'},my $version) = ProgramData::full('guix'); + $distro->{'name'} .= " $version" if $version; + $distro->{'issue-skip'} = 1; + push(@{$distro->{'method'}},'issue-id; from program version'); + } + else { + # make sure it has letters in name! + if (($lc_issue =~ tr/[a-z]/[a-z]/) > 3){ + $distro->{'name'} = $etc_issue; + push(@{$distro->{'method'}},'issue: source'); + } + else { + push(@{$distro->{'method'}},'issue: invalid distro value'); + } + # This handles an arch bug where /etc/arch-release is empty and /etc/issue + # is corrupted only older arch installs that have not been updated should + # have this fallback required, new ones use os-release + if ($distro->{'name'} =~ /arch linux/i){ + $distro->{'name'} = 'Arch Linux'; + } + } + } + } + # A final check. If a long value, before assigning the debugger output, if os-release + # exists then let's use that if it wasn't tried already. Maybe that will be better. + # not handling the corrupt data, maybe later if needed. 10 + distro: (8) + string + if ($distro->{'name'} && length($distro->{'name'}) > 60){ + if (!$distro->{'osr-skip'} && @osr){ + $distro->{'name'} = get_osr(); + $distro->{'osr-skip'} = 1; + push(@{$distro->{'method'}},'get_osr(): bad name'); + } + } + # Test for /etc/lsb-release as a backup in case of failure, in cases + # where > one version/release file were found but the above resulted + # in null distro value. + if (!$distro->{'name'} && $windows{'cygwin'}){ + $distro->{'name'} = $uname[0]; # like so: CYGWIN_NT-10.0-19043 + $distro->{'osr-skip'} = 1; + push(@{$distro->{'method'}},'uname 0: cygwin'); + } + if (!$distro->{'name'}){ + if (!$distro->{'osr-skip'} && @osr){ + $distro->{'name'} = get_osr(); + $distro->{'osr-skip'} = 1; + push(@{$distro->{'method'}},'get_osr(): final'); + } + elsif ($distro->{'lsb'}){ + $distro->{'name'} = get_lsb(); + push(@{$distro->{'method'}},'get_lsb(): final'); + } + } + # Now some final null tries + if (!$distro->{'name'}){ + # If the file was null but present, which can happen in some cases, then use + # the file name itself to set the distro value. Why say unknown if we have + # a pretty good idea, after all? + if ($distro->{'file'}){ + $distro->{'file'} =~ s/\/etc\/|[-_]|release|version//g; + $distro->{'name'} = $distro->{'file'}; + push(@{$distro->{'method'}},'use: distro file name'); + } + } + main::feature_debugger('name: $distro: pre-base [linux]',$distro) if $distro->{'dbg'}; + system_base_linux() if $extra > 0; + # Some last customized changes, double check if possible to verify still valid + if ($distro->{'name'}){ + if ($distro->{'id'} eq 'armbian'){ + $distro->{'name'} =~ s/Debian/Armbian/; + push(@{$distro->{'method'}},'custom: armbian name adjust'); + } + elsif ($distro->{'id'} eq 'raspios'){ + $distro->{'base'} = $distro->{'name'}; + push(@{$distro->{'base-method'}},'custom: pi base from name'); + # No need to repeat the debian version info if base: + if ($extra == 0){ + $distro->{'name'} =~ s/Debian\s*GNU\/Linux/Raspberry Pi OS/; + } + else { + $distro->{'name'} = 'Raspberry Pi OS'; + } + push(@{$distro->{'method'}},'custom: pi name adjust'); + } + # check for spins, relies on xdg directory name + elsif ($distro->{'name'} =~ /^(Ubuntu)/i){ + my $base = $1; + my $temp = distro_spin($distro->{'name'}); + if ($temp ne $distro->{'name'}){ + if (!$distro->{'base'} && $extra > 0){ + $distro->{'base'} = $base; + push(@{$distro->{'base-method'}},'use: name'); + } + $distro->{'name'} = $temp; + push(@{$distro->{'method'}},'use: distro_spin()'); + } + } + elsif (-d '/etc/salixtools/' && $distro->{'name'} =~ /Slackware/i){ + $distro->{'name'} =~ s/Slackware/Salix/; + push(@{$distro->{'method'}},'manual: name swap'); + } + elsif ($distro->{'file'} =~ /($dist_file_no_name)/ && $distro->{'name'} =~ /^[\d\.]+$/){ + $distro->{'file'} =~ s/\/etc\/|[-_]|release|version//g; + $distro->{'name'} = ucfirst($distro->{'file'}) . ' ' . $distro->{'name'}; + push(@{$distro->{'method'}},'use: file name'); + } + } + else { + # android fallback, sometimes requires root, sometimes doesn't + android_info() if $b_android; + } + ## Finally, if all else has failed, give up + $distro->{'name'} ||= 'unknown'; + if ($extra > 0 && $distro->{'name'} && $distro->{'base'}){ + check_base(); + } + main::feature_debugger('name: $distro: final [linux]',$distro) if $distro->{'dbg'}; + eval $end if $b_log; +} + +sub android_info { + eval $start if $b_log; + main::set_build_prop() if !$loaded{'build-prop'};; + $distro->{'name'} = 'Android'; + $distro->{'name'} .= ' ' . $build_prop{'build-version'} if $build_prop{'build-version'}; + $distro->{'name'} .= ' ' . $build_prop{'build-date'} if $build_prop{'build-date'}; + if (!$show{'machine'}){ + if ($build_prop{'product-manufacturer'} && $build_prop{'product-model'}){ + $distro->{'name'} .= ' (' . $build_prop{'product-manufacturer'} . ' ' . $build_prop{'product-model'} . ')'; + } + elsif ($build_prop{'product-device'}){ + $distro->{'name'} .= ' (' . $build_prop{'product-device'} . ')'; + } + elsif ($build_prop{'product-name'}){ + $distro->{'name'} .= ' (' . $build_prop{'product-name'} . ')'; + } + } + eval $end if $b_log; +} + +sub system_base_linux { + eval $start if $b_log; + $distro->{'osr-pretty'} = 0; # reset: if we want to use osr pretty, detect here. + # Need data on these Arch derived: CachyOS; can be ArchLab/Labs + my $base_distro_arch = 'anarchy|antergos|apricity'; + $base_distro_arch .= '|arch(bang|craft|ex|lab|man|strike)|arco|artix'; + $base_distro_arch .= '|blackarch|bluestar|bridge|cachyos|chakra|condres|ctlos'; + # note: arch linux derived distro page claims kaos as arch derived but it is NOT + $base_distro_arch .= '|endeavour|feliz|garuda|hyperbola|linhes|liri'; + $base_distro_arch .= '|mabox|magpie|manjaro|mysys2|namib|netrunner\s?rolling|ninja'; + $base_distro_arch .= '|obarun|parabola|porteus|puppyrus-?a'; + $base_distro_arch .= '|reborn|revenge|salient|snal|steamos'; + $base_distro_arch .= '|talkingarch|theshell|ubos|velt|xero'; + my $base_file_debian_version = 'sidux'; + # detect debian steamos before arch steamos + my $base_osr_debian_version = '\belive|blankon|lmde|neptune|nitrux|parrot|'; + $base_osr_debian_version .= 'pureos|rescatux|septor|solyd|sparky|steamos|tails'; + my $base_osr_devuan_version = 'crowz|dowse|etertics|\bexe\b|fluxuan|gnuinos|'; + $base_osr_devuan_version .= 'gobmis|heads|miyo|refracta|\bstar\b|virage'; + # osr has base ids + my $base_default = 'antix-version|bodhi|mx-version'; + # base only found in issue + my $base_issue = 'bunsen'; + # synthesize, no direct data available + my $base_manual = 'deepin|kali'; + # osr base, distro id in list of distro files + my $base_osr = 'aptosid|bodhi|grml|q4os|siduction|slax|zenwalk'; + # osr base, distro id in issue + my $base_osr_issue = 'grml|linux lite|openmediavault'; + # same as rhel re VERSION_ID but likely only ID_LIKE=fedora + my $base_osr_fedora = 'amahi|asahi|audinux|clearos|fx64|montana|nobara|qubes|'; + $base_osr_fedora .= 'risios|ultramarine|vortexbox'; + # osr has distro name but has fedora centos redhat ID_LIKE and VERSION_ID same + # fedora not handled will fall to RHEL if contains centos string + my $base_osr_redhat = 'almalinux|centos|eurolinux|oracle|puias|rocky|'; + $base_osr_redhat .= 'scientific|springdale'; + # osr has distro name but has ubuntu (or debian) ID_LIKE/UBUNTU_CODENAME + my $base_osr_ubuntu = 'feren|mint|neon|nitrux|pop!?_os|tuxedo|zinc|zorin'; + my $base_upstream_lsb = '/etc/upstream-release/lsb-release'; + my $base_upstream_osr = '/etc/upstream-release/os-release'; + # These id as themselves, but system base is version file. Slackware mostly. + my %base_version = ( + 'porteux|salix|slackel|slint' => '/etc/slackware-version', + ); + # First: try, some distros have upstream-release, elementary, new mint + # and anyone else who uses this method for fallback ID + if (-r $base_upstream_osr){ + my @osr_working = main::reader($base_upstream_osr); + push(@{$distro->{'base-files'}},$base_upstream_osr) if $distro->{'dbg'}; + if (@osr_working){ + my @osr_temp = @osr; + @osr = @osr_working; + $distro->{'base'} = get_osr(); + @osr = @osr_temp if !$distro->{'base'}; + push(@{$distro->{'base-method'}},'get_osr(): upstream osr'); + } + } + # note: ultramarine trips this one but uses os-release field names, sigh, ignore + elsif (-r $base_upstream_lsb){ + $distro->{'base'} = get_lsb($base_upstream_lsb); + push(@{$distro->{'base-files'}},$base_upstream_lsb) if $distro->{'dbg'}; + push(@{$distro->{'base-method'}},'get_lsb(): upstream lsb'); + } + dbg_distro_files('Linux base',$distro->{'base-files'}) if $distro->{'dbg'}; + # probably no need for these @osr greps, just grep $distro->{'name'} instead? + if (!$distro->{'base'} && @osr){ + if ($etc_issue && (grep {/($base_issue)/i} @osr)){ + $distro->{'base'} = $etc_issue; + push(@{$distro->{'base-method'}},'file: /etc/issue'); + } + # more tests added here for other ubuntu derived distros + elsif (@{$distro->{'files'}} && (grep {/($base_default)/} @{$distro->{'files'}})){ + $distro->{'base-type'} = 'default'; + } + # must go before base_osr_arch,ubuntu tests. For steamos, use fallback arch + elsif (grep {/($base_osr_debian_version)/i} @osr){ + $distro->{'base'} = debian_id('debian'); + push(@{$distro->{'base-method'}},'use: debian_id(debian)'); + } + elsif (grep {/($base_osr_devuan_version)/i} @osr){ + $distro->{'base'} = debian_id('devuan'); + push(@{$distro->{'base-method'}},'use: debian_id(devuan)'); + } + elsif (grep {/($base_osr_fedora)/i} @osr){ + $distro->{'base-type'} = 'fedora'; + } + elsif (grep {/($base_osr_redhat)/i} @osr){ + $distro->{'base-type'} = 'rhel'; + } + elsif (grep {/($base_osr_ubuntu)/i} @osr){ + $distro->{'base-type'} = 'ubuntu'; + } + elsif ((($distro->{'id'} && $distro->{'id'} =~ /($base_osr_issue)/) || + (@{$distro->{'files'}} && (grep {/($base_osr)/} @{$distro->{'files'}}))) && + !(grep {/($base_osr)/i} @osr)){ + $distro->{'base'} = get_osr(); + push(@{$distro->{'base-method'}},'get_osr(): issue match'); + } + if (!$distro->{'base'} && $distro->{'base-type'}){ + $distro->{'base'} = get_osr($distro->{'base-type'}); + push(@{$distro->{'base-method'}},'get_osr(): base-type'); + } + } + if (!$distro->{'base'} && @{$distro->{'files'}} && + (grep {/($base_file_debian_version)/i} @{$distro->{'files'}})){ + $distro->{'base'} = debian_id('debian'); + push(@{$distro->{'base-method'}},'debian_id(debian): base_file_debian_version'); + } + if (!$distro->{'base'} && $lc_issue && $lc_issue =~ /($base_manual)/){ + my $id = $1; + my %manual = ( + # 'blankon' => 'Debian unstable', # use /etc/debian_version + 'deepin' => 'Debian unstable', + 'kali' => 'Debian testing', + ); + $distro->{'base'} = $manual{$id}; + push(@{$distro->{'base-method'}},'manual: /etc/issue match'); + } + if (!$distro->{'base'} && $distro->{'name'}){ + if ($distro->{'name'} =~ /^($base_distro_arch)/i){ + $distro->{'base'} = 'Arch Linux'; + push(@{$distro->{'base-method'}},'name-match: assign arch'); + } + elsif ($distro->{'name'} =~ /^peppermint/i){ + my $type = (-f '/etc/devuan_version') ? 'devuan': 'debian'; + $distro->{'base'} = debian_id($type); + push(@{$distro->{'base-method'}},'debian_id(): type'); + } + } + if (!$distro->{'base'} && $distro->{'name'}){ + foreach my $key (keys %base_version){ + if (-r $base_version{$key} && $distro->{'name'} =~ /($key)/i){ + $distro->{'base'} = main::reader($base_version{$key},'strip',0); + main::clean_characters(\$distro->{'base'}) if $distro->{'base'}; + push(@{$distro->{'base-method'}},"base_version: file: $key"); + last; + } + } + } + if (!$distro->{'base'} && $distro->{'name'} && -d '/etc/salixtools/' && + $distro->{'name'} =~ /Slackware/i){ + $distro->{'base'} = $distro->{'name'}; + push(@{$distro->{'base-method'}},'custom: salix'); + } + main::feature_debugger('$distro: base [linux]',$distro) if $distro->{'dbg'}; + eval $end if $b_log; +} + +## PROCESS OS/LSB RELEASE ## +# Note: corner case when parsing the bodhi distro file +# args: 0: file name +sub get_lsb { + eval $start if $b_log; + my ($lsb_file) = @_; + $lsb_file ||= '/etc/lsb-release'; + my ($dist_lsb,$id,$release,$codename,$description) = ('','','','',''); + my ($dist_id,$dist_release,$dist_code,$dist_desc) = ('DISTRIB_ID', + 'DISTRIB_RELEASE','DISTRIB_CODENAME','DISTRIB_DESCRIPTION'); + if ($lsb_file eq '/etc/bodhi/info'){ + $id = 'Bodhi Linux'; + # note: No ID field, hard code + ($dist_id,$dist_release,$dist_code,$dist_desc) = ('ID','RELEASE', + 'CODENAME','DESCRIPTION'); + } + my @content = main::reader($lsb_file); + main::log_data('dump','@content',\@content) if $b_log; + @content = map {s/,|\*|\\||\"|[:\47]|^\s+|\s+$|n\/a//ig; $_} @content if @content; + foreach (@content){ + next if /^\s*$/; + my @working = split(/\s*=\s*/, $_); + next if !$working[0]; + if ($working[0] eq $dist_id && $working[1]){ + if ($working[1] =~ /^Manjaro/i){ + $id = 'Manjaro Linux'; + } + # in the old days, arch used lsb_release + # elsif ($working[1] =~ /^Arch$/i){ + # $id = 'Arch Linux'; + # } + else { + $id = $working[1]; + } + } + elsif ($working[0] eq $dist_release && $working[1]){ + $release = $working[1]; + } + elsif ($working[0] eq $dist_code && $working[1]){ + $codename = $working[1]; + } + # sometimes some distros cannot do their lsb-release files correctly, + # so here is one last chance to get it right. + elsif ($working[0] eq $dist_desc && $working[1]){ + $description = $working[1]; + } + } + if (!$id && !$release && !$codename && $description){ + $dist_lsb = $description; + } + else { + # avoid duplicates + $dist_lsb = $id; + $dist_lsb .= " $release" if $release && $dist_lsb !~ /$release/; + # eg: release: 9 codename: mga9 + if ($codename && $dist_lsb !~ /$codename/i && + (!$release || $codename !~ /$release/)){ + $dist_lsb .= " $codename"; + } + $dist_lsb =~ s/^\s+|\s\s+|\s+$//g; # get rid of double and trailing spaces + } + eval $end if $b_log; + return $dist_lsb; +} + +sub get_osr { + eval $start if $b_log; + my ($base_type) = @_; + my ($base_id,$base_name,$base_version,$dist_osr,$name,$name_lc,$name_pretty, + $version_codename,$version_name,$version_id) = ('','','','','','','','','',''); + my @content = @osr; + main::log_data('dump','@content',\@content) if $b_log; + @content = map {s/\\||\"|[:\47]|^\s+|\s+$|n\/a//ig; $_} @content if @content; + foreach (@content){ + next if /^\s*$/; + my @working = split(/\s*=\s*/, $_); + next if !$working[0]; + if ($working[0] eq 'PRETTY_NAME' && $working[1]){ + $name_pretty = $working[1]; + } + elsif ($working[0] eq 'NAME' && $working[1]){ + $name = $working[1]; + $name_lc = lc($name); + } + elsif ($working[0] eq 'VERSION_CODENAME' && $working[1]){ + $version_codename = $working[1]; + } + elsif ($working[0] eq 'VERSION' && $working[1]){ + $version_name = $working[1]; + $version_name =~ s/,//g; + } + elsif ($working[0] eq 'VERSION_ID' && $working[1]){ + $version_id = $working[1]; + } + # for mint/zorin, other ubuntu base system base + if ($base_type){ + if ($working[0] eq 'ID_LIKE' && $working[1]){ + if ($base_type eq 'ubuntu'){ + # feren,popos shows debian, feren ID ubuntu + $working[1] =~ s/^(debian|ubuntu\sdebian|debian\subuntu)/ubuntu/; + $base_name = ucfirst($working[1]); + } + elsif ($base_type eq 'fedora' && $working[1] =~ /fedora/i){ + $base_name = 'Fedora'; + $base_version = $version_id if $version_id; + } + # oracle ID_LIKE="fedora". Why? who knows. + elsif ($base_type eq 'rhel' && $working[1] =~ /rhel|fedora/i){ + $base_name = 'RHEL'; + $base_version = $version_id if $version_id; + } + elsif ($base_type eq 'arch' && $working[1] =~ /$base_type/i){ + $base_name = 'Arch Linux'; + } + else { + $base_name = ucfirst($working[1]); + } + } + elsif ($base_type eq 'ubuntu' && $working[0] eq 'UBUNTU_CODENAME' && $working[1]){ + $base_version = ucfirst($working[1]); + } + elsif ($base_type eq 'debian' && $working[0] eq 'DEBIAN_CODENAME' && $working[1]){ + $base_version = $working[1]; + } + } + } + # NOTE: tumbleweed has pretty name but pretty name does not have version id + # arco shows only the release name, like kirk, in pretty name. Too many distros + # are doing pretty name wrong, and just putting in the NAME value there + if (!$base_type){ + if ((!$distro->{'osr-pretty'} || !$name_pretty) && $name && $version_name){ + $dist_osr = $name; + $dist_osr = 'Arco Linux' if $name_lc =~ /^arco/; + if ($version_id && $version_name !~ /$version_id/){ + $dist_osr .= ' ' . $version_id; + } + $dist_osr .= " $version_name"; + } + elsif ($name_pretty && ($name_pretty !~ /tumbleweed/i && $name_lc ne 'arcolinux')){ + $dist_osr = $name_pretty; + } + elsif ($name){ + $dist_osr = $name; + if ($version_id){ + $dist_osr .= ' ' . $version_id; + } + } + if ($version_codename && $dist_osr !~ /$version_codename/i){ + my @temp = split(/\s*[\/\s]\s*/, $version_codename); + foreach (@temp){ + if ($dist_osr !~ /\b$_\b/i){ + $dist_osr .= " $_"; + } + } + } + } + # note: mint has varying formats here, some have ubuntu as name, 17 and earlier + else { + # incoherent feren use of version, id, etc + if ($base_type eq 'ubuntu' && !$base_version && $version_codename && + $name =~ /feren/i){ + $base_version = ucfirst($version_codename); + $distro->{'name'} =~ s/ $version_codename//; + } + # mint 17 used ubuntu os-release, so won't have $base_version, steamos holo + if ($base_name && ($base_type eq 'fedora' || $base_type eq 'rhel')){ + $dist_osr = $base_name; + $dist_osr .= ' ' . $version_id if $version_id; + } + elsif ($base_name && $base_type eq 'arch'){ + $dist_osr = $base_name; + } + elsif ($base_name && $base_version){ + $base_id = ubuntu_id($base_version) if $base_type eq 'ubuntu' && $base_version; + $base_id = '' if $base_id && "$base_name$base_version" =~ /$base_id/; + $base_id .= ' ' if $base_id; + $dist_osr = "$base_name $base_id$base_version"; + } + elsif ($base_type eq 'default' && ($name_pretty || ($name && $version_name))){ + $dist_osr = ($name && $version_name) ? "$name $version_name" : $name_pretty; + } + # LMDE 2 has only limited data in os-release, no _LIKE values. 3 has like and debian_codename + elsif ($base_type eq 'ubuntu' && $name_lc =~ /^(debian|ubuntu)/ && + ($name_pretty || ($name && $version_name))){ + $dist_osr = ($name && $version_name) ? "$name $version_name": $name_pretty; + } + elsif ($base_type eq 'debian' && $base_version){ + $dist_osr = debian_id('debian',$base_version); + } + # not used yet + elsif ($base_type eq 'devuan' && $base_version){ + $dist_osr = debian_id('devuan',$base_version); + } + } + eval $end if $b_log; + return $dist_osr; +} + +## ID MATCHING TABLES ## +# args: 0: distro string +# note: relies on /etc/xdg/xdg-[distro-id] which is an ubuntu thing but could +# work if other distros use that for spins. Xebian does but not official spin. +sub distro_spin { + my $name = $_[0]; + eval $start if $b_log; + my @spins = ( + # 0: distro name; 1: xdg search; 2: env search; 3: print name; 4: System Base + ['budgie','budgie','','Ubuntu Budgie','Ubuntu'], + ['cinnamon','cinnamon','','Ubuntu Cinnamon','Ubuntu'], + ['edubuntu','edubuntu','edubuntu','Edubuntu','Ubuntu'], + # ['icebox','icebox','icebox','Debian Icebox','Debian'], + ['kubuntu','kubuntu|plasma','kubuntu','Kubuntu','Ubuntu'], + ['kylin','kylin','kylin','Ubuntu Kylin','Ubuntu'], + ['lubuntu','lubuntu','lubuntu','Lubuntu','Ubuntu'], + ['mate','mate','','Ubuntu MATE','Ubuntu'], + ['studio','studio','studio','Ubuntu Studio','Ubuntu'], + ['unity','unity','','Ubuntu Unity','Ubuntu'], + # ['xebian','xebian','','Xebian','Debian'], + ['xubuntu','xubuntu','xubuntu','Xubuntu','Ubuntu'], + ); + my $tests = 'budgie,cinna,edub,plasma,kubu,kylin,lubu,mate,studio,unity,xebi,xubu'; + $tests = join(':',main::globber("/etc/xdg/xdg-*{$tests}*")); + # xdg is poor since only works in gui. Some of these also in DESKTOP_SESSION + foreach my $spin (@spins){ + if ($name !~ /$spin->[0]/i && ( + ($spin->[2] && $ENV{'DESKTOP_SESSION'} && + $ENV{'DESKTOP_SESSION'} =~ /$spin->[2]/i) || + ($ENV{'XDG_CONFIG_DIRS'} && $ENV{'XDG_CONFIG_DIRS'} =~ /$spin->[1]/i) || + ($tests && $tests =~ /$spin->[1]/i))){ + $name =~ s/\b$spin->[4]/$spin->[3]/i; + last; + } + } + eval $end if $b_log; + return $name; +} + +# args: 0: $type [debian|devuan]; 1: optional: debian codename +sub debian_id { + eval $start if $b_log; + my ($type,$codename) = @_; + my ($id,$file_value,%releases,$version); + if (-r "/etc/${type}_version"){ + $file_value = main::reader("/etc/${type}_version",'strip',0); + } + return if !$file_value && !$codename; + if ($type eq 'debian'){ + $id = 'Debian'; + # note, 3.0, woody, 3.1, sarge, but after it's integer per version + %releases = ( + '4' => 'etch', + '5' => 'lenny', + '6' => 'squeeze', + '7' => 'wheezy', + '8' => 'jessie', + '9' => 'stretch', + '10' => 'buster', + '11' => 'bullseye', + '12' => 'bookworm', + '13' => 'trixie', + '14' => 'forky', + ); + } + else { + $id = 'Devuan'; + %releases = ( + '1' => 'jesse', # jesse + '2' => 'ascii', # stretch + '3' => 'beowolf', # buster + '4' => 'chimaera', # bullseye + '5' => 'daedalus', # bookworm + '6' => 'excalibur',# trixie + '7' => 'freia', # forky + # '' => 'ceres/daedalus', # sid/unstable + ); + } + # debian often numeric, devuan usually not + # like trixie/sid; daedalus; ceres/daedalus; 12.0 + if (main::is_numeric($file_value)){ + $version = $file_value . ' ' . $releases{int($file_value)}; + } + else { + my %releases_r = reverse %releases; + if ($codename){ + $version = ($releases_r{$codename}) ? "$releases_r{$codename} $codename": $codename; + } + elsif ($releases_r{$file_value}) { + $version = "$releases_r{$file_value} $file_value"; + } + else { + $version = $file_value; + } + } + if ($version){ + my @temp = split(/\s*[\/\s]\s*/, $version); + foreach (@temp){ + if ($distro->{'name'} !~ /\b$_\b/i){ + $id .= " $_"; + } + } + } + eval $end if $b_log; + return $id; +} + +# Note, these are only for matching distro/mint derived names. +# Update list as new names become available. While first Mint was 2006-08, +# this method depends on /etc/os-release which was introduced 2012-02. +# Mint is using UBUNTU_CODENAME without ID data. +sub ubuntu_id { + eval $start if $b_log; + my ($codename) = @_; + $codename = lc($codename); + my ($id) = (''); + # xx.04, xx.10 + my %codenames = ( + # '??' => '26.04', + # '??' => '25.10', + # '??' => '25.04', + # '??' => '24.10', + 'noble' => '24.04 LTS', + 'mantic' => '23.10', + 'lunar' => '23.04', + 'kinetic' => '22.10', + 'jammy' => '22.04 LTS', + 'impish' => '21.10', + 'hirsute' => '21.04', + 'groovy' => '20.10', + 'focal' => '20.04 LTS', + 'eoan' => '19.10', + 'disco' => '19.04', + 'cosmic' => '18.10', + 'bionic' => '18.04 LTS', + 'artful' => '17.10', + 'zesty' => '17.04', + 'yakkety' => '16.10', + 'xenial' => '16.04 LTS', + 'wily' => '15.10', + 'vivid' => '15.04', + 'utopic' => '14.10', + 'trusty' => '14.04 LTS ', + 'saucy' => '13.10', + 'raring' => '13.04', + 'quantal' => '12.10', + 'precise' => '12.04 LTS ', + # 'natty' => '11.04','oneiric' => '11.10', + # 'lucid' => '10.04','maverick' => '10.10', + # 'jaunty' => '9.04','karmic' => '9.10', + # 'hardy' => '8.04','intrepid' => '8.10', + # 'feisty' => '7.04','gutsy' => '7.10', + # 'dapper' => '6.06','edgy' => '6.10', + # 'hoary' => '5.04','breezy' => '5.10', + # 'warty' => '4.10', # warty was the first ubuntu release + ); + $id = $codenames{$codename} if defined $codenames{$codename}; + eval $end if $b_log; + return $id; +} + +## UTILITIES ## +sub check_base { + if (lc($distro->{'name'}) eq lc($distro->{'base'})){ + $distro->{'base'} = ''; + } + else { + my @name = split(/\s+/,$distro->{'name'}); + my @working; + foreach my $word (@name){ + if ($distro->{'base'} !~ /\b\Q$word\E\b/i || $word =~ /^[\d\.]+$/){ + push(@working,$word); + } + } + $distro->{'name'} = join(' ',@working) if @working; + } +} + +# args: 0: info; 1: list of globbed distro files +sub dbg_distro_files { + my ($info,$files) = @_; + my $contents = {}; + foreach my $file (@$files){ + $contents->{$file} = (-r $file ) ? main::reader($file,'','ref') : main::message('file-unreadable'); + } + main::feature_debugger($info . ' raw distro files:',$contents); +} +} + +## DmidecodeData ## +{ +package DmidecodeData; + +# Note, all actual tests have already been run in check_tools so if we +# got here, we're good. +sub set { + eval $start if $b_log; + ${$_[0]} = 1; # set check boolean by reference + if ($fake{'dmidecode'} || $alerts{'dmidecode'}->{'action'} eq 'use'){ + generate_data(); + } + eval $end if $b_log; +} + +sub generate_data { + eval $start if $b_log; + my ($content,@data,@working,$type,$handle); + if ($fake{'dmidecode'}){ + my $file; + # $file = "$fake_data_dir/dmidecode/pci-freebsd-8.2-2"; + # $file = "$fake_data_dir/dmidecode/dmidecode-loki-1.txt"; + # $file = "$fake_data_dir/dmidecode/dmidecode-t41-1.txt"; + # $file = "$fake_data_dir/dmidecode/dmidecode-mint-20180106.txt"; + # $file = "$fake_data_dir/dmidecode/dmidecode-vmware-ram-1.txt"; + # $file = "$fake_data_dir/dmidecode/dmidecode-tyan-4408.txt"; + # $file = "$fake_data_dir/ram/dmidecode-speed-configured-1.txt"; + # $file = "$fake_data_dir/ram/dmidecode-speed-configured-2.txt"; + # $file = "$fake_data_dir/ram/00srv-dmidecode-mushkin-1.txt"; + # $file = "$fake_data_dir/dmidecode/dmidecode-slots-pcix-pcie-1.txt"; + # $file = "$fake_data_dir/dmidecode/dmidecode-Microknopix-pci-vga-types-5-6-16-17.txt"; + # open(my $fh, '<', $file) or die "can't open $file: $!"; + # chomp(@data = <$fh>); + } + else { + $content = qx($alerts{'dmidecode'}->{'path'} 2>/dev/null); + @data = split('\n', $content); + } + # we don't need the opener lines of dmidecode output + # but we do want to preserve the indentation. Empty lines + # won't matter, they will be skipped, so no need to handle them. + # some dmidecodes do not use empty line separators + splice(@data, 0, 5) if @data; + my $j = 0; + my $b_skip = 1; + foreach (@data){ + if (!/^Hand/){ + next if $b_skip; + if (/^[^\s]/){ + $_ = lc($_); + $_ =~ s/\s(information)//; + push(@working, $_); + } + elsif (/^\t/){ + $_ =~ s/^\t\t/~/; + $_ =~ s/^\t|\s+$//g; + push(@working, $_); + } + } + elsif (/^Handle\s(0x[0-9A-Fa-f]+).*DMI\stype\s([0-9]+),.*/){ + $j = scalar @dmi; + $handle = hex($1); + $type = $2; + $use{'slot-tool'} = 1 if $type && $type == 9; + $b_skip = ($type > 126) ? 1 : 0; + next if $b_skip; + # we don't need 32, system boot, or 127, end of table + if (@working){ + if ($working[0] != 32 && $working[0] < 127){ + $dmi[$j] = ( + [@working], + ); + } + } + @working = ($type,$handle); + } + } + if (@working && $working[0] != 32 && $working[0] != 127){ + $j = scalar @dmi; + $dmi[$j] = \@working; + } + # last by not least, sort it by dmi type, now we don't have to worry + # about random dmi type ordering in the data, which happens. Also sort + # by handle, as secondary sort. + @dmi = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @dmi; + main::log_data('dump','@dmi',\@dmi) if $b_log; + print Data::Dumper::Dumper \@dmi if $dbg[2]; + eval $end if $b_log; +} +} + +# args: 0: driver; 1: modules, comma separated, return only modules +# which do not equal the driver string itself. Sometimes the module +# name is different from the driver name, even though it's the same thing. +sub get_driver_modules { + eval $start if $b_log; + my ($driver,$modules) = @_; + return if !$modules; + my @mods = split(/,\s+/, $modules); + if ($driver){ + @mods = grep {!/^$driver$/} @mods; + my $join = (length(join(',', @mods)) > 40) ? ', ' : ','; + $modules = join($join, @mods); + } + log_data('data','$modules',$modules) if $b_log; + eval $end if $b_log; + return $modules; +} + +## GlabelData ## +# public methods: get() +# Used to partitions, swap, RAID ZFS gptid path standard name, like ada0p1 +{ +package GlabelData; + +# gptid/c5e940f1-5ce2-11e6-9eeb-d05099ac4dc2 N/A ada0p1 +# gpt/efiesp N/A ada0p2 +sub get { + eval $start if $b_log; + my $gptid = $_[0]; + set() if !$loaded{'glabel'}; + return if !@glabel || !$gptid; + my $dev_id = ''; + foreach (@glabel){ + my @temp = split(/\s+/, $_); + my $gptid_trimmed = $gptid; + # slice off s[0-9] from end in case they use slice syntax + $gptid_trimmed =~ s/s[0-9]+$//; + if (defined $temp[0] && ($temp[0] eq $gptid || $temp[0] eq $gptid_trimmed)){ + $dev_id = $temp[2]; + last; + } + } + $dev_id ||= $gptid; # no match? return full string + eval $end if $b_log; + return $dev_id; +} + +sub set { + eval $start if $b_log; + $loaded{'glabel'} = 1; + if (my $path = main::check_program('glabel')){ + @glabel = main::grabber("$path status 2>/dev/null",'','strip'); + } + main::log_data('dump','@glabel:with Headers',\@glabel) if $b_log; + # get rid of first header line + shift @glabel; + eval $end if $b_log; +} +} + +sub get_hostname { + eval $start if $b_log; + my $hostname = ''; + if ($ENV{'HOSTNAME'}){ + $hostname = $ENV{'HOSTNAME'}; + } + elsif (!$bsd_type && -r "/proc/sys/kernel/hostname"){ + $hostname = reader('/proc/sys/kernel/hostname','',0); + } + # puppy removed this from core modules, sigh + # this is faster than subshell of hostname + elsif (check_perl_module('Sys::Hostname')){ + Sys::Hostname->import; + $hostname = Sys::Hostname::hostname(); + } + elsif (my $program = check_program('hostname')){ + $hostname = (grabber("$program 2>/dev/null"))[0]; + } + $hostname ||= 'N/A'; + eval $end if $b_log; + return $hostname; +} + +## InitData ## +{ +package InitData; +my ($init,$init_version,$program) = ('','',''); + +sub get { + eval $start if $b_log; + my $runlevel = get_runlevel(); + my $default = ($extra > 1) ? get_runlevel_default() : ''; + my ($rc,$rc_version) = ('',''); + my $comm = (-r '/proc/1/comm') ? main::reader('/proc/1/comm','',0) : ''; + my $link = readlink('/sbin/init'); + # this test is pretty solid, if pid 1 is owned by systemd, it is systemd + # otherwise that is 'init', which covers the rest of the init systems. + # more data may be needed for other init systems. + # Some systemd cases no /proc/1/comm exists however :( + if (($comm && $comm =~ /systemd/) || -e '/run/systemd/units'){ + $init = 'systemd'; + if ($program = main::check_program('systemd')){ + ($init,$init_version) = ProgramData::full('systemd',$program); + } + if (!$init_version && ($program = main::check_program('systemctl'))){ + ($init,$init_version) = ProgramData::full('systemd',$program); + } + if ($runlevel && $runlevel =~ /^\d$/){ + my $target = ''; + if ($runlevel == 1){ + $target = 'rescue';} + elsif ($runlevel > 1 && $runlevel < 5){ + $target = 'multi-user';} + elsif ($runlevel == 5){ + $target = 'graphical';} + $runlevel = "$target ($runlevel)" if $target; + } + } + if (!$init && $comm){ + # not verified + if ($comm =~ /^31init/){ + $init = '31init'; + # no version, this is a 31 line C program + } + elsif ($comm =~ /epoch/){ + ($init,$init_version) = ProgramData::full('epoch'); + } + # if they fix dinit to show /proc/1/comm == dinit + elsif ($comm =~ /^dinit/){ + ($init,$init_version) = ProgramData::full('dinit'); + } + elsif ($comm =~ /finit/){ + ($init,$init_version) = ProgramData::full('finit'); + } + # not verified + elsif ($comm =~ /^hummingbird/){ + $init = 'Hummingbird'; + # no version data known. Complete if more info found. + } + # nosh can map service manager to systemctl, service, rcctl, at least. + elsif ($comm =~ /^nosh/){ + $init = 'nosh'; + } + # missing data: note, runit can install as a dependency without being the + # init system: http://smarden.org/runit/sv.8.html + # NOTE: the proc test won't work on bsds, so if runit is used on bsds we + # will need more data + elsif ($comm =~ /runit/){ + $init = 'runit'; + # no version data as of 2022-10-26 + } + elsif ($comm =~ /^s6/){ + $init = 's6'; + # no version data as of 2022-10-26 + } + elsif ($comm =~ /shepherd/){ + ($init,$init_version) = ProgramData::full('shepherd'); + } + # fallback for some inits that link to /sbin/init + elsif ($comm eq 'init'){ + # shows /sbin/dinit-init but may change + if (-e '/sbin/dinit' && $link && $link =~ /dinit/){ + ($init,$init_version) = ProgramData::full('dinit'); + } + elsif (-e '/sbin/openrc-init' && $link && $link =~ /openrc/){ + ($init,$init_version) = openrc_data(); + } + } + } + if (!$init){ + # openwrt/busybox /sbin/init hangs on --version command + if (-e '/sbin/init' && $link && $link =~ /busybox/){ + ($init,$init_version) = ProgramData::full('busybox','/sbin/init'); + } + # risky since we don't know which init it is. $comm == 'init' + # output: /sbin/init --version: init (upstart 1.1); init (upstart 0.6.3) + elsif (!%risc && !$link && main::globber('/{usr/lib,sbin,var/log}/upstart*') && + ($init_version = ProgramData::version('init', 'upstart', '3','--version'))){ + $init = 'Upstart'; + } + # surely more positive way to detect active + elsif (main::check_program('launchctl')){ + $init = 'launchd'; + } + # could be nosh or runit as well for BSDs, not handled yet + elsif (-f '/etc/inittab'){ + $init = 'SysVinit'; + if (main::check_program('strings')){ + my @data = main::grabber('strings /sbin/init 2>/dev/null'); + $init_version = main::awk(\@data,'^version\s+[0-9]',2); + } + } + elsif (-f '/etc/ttys'){ + $init = 'init (BSD)'; + } + } + if ((grep { /openrc/ } main::globber('/run/*openrc*')) || (grep {/openrc/} @ps_cmd)){ + if (!$init || $init ne 'OpenRC'){ + ($rc,$rc_version) = openrc_data(); + } + if (-r '/run/openrc/softlevel'){ + $runlevel = main::reader('/run/openrc/softlevel','',0); + } + elsif (-r '/var/run/openrc/softlevel'){ + $runlevel = main::reader('/var/run/openrc/softlevel','',0); + } + elsif ($program = main::check_program('rc-status')){ + $runlevel = (main::grabber("$program -r 2>/dev/null"))[0]; + } + } + eval $end if $b_log; + return { + 'init-type' => $init, + 'init-version' => $init_version, + 'rc-type' => $rc, + 'rc-version' => $rc_version, + 'runlevel' => $runlevel, + 'default' => $default, + }; +} + +sub openrc_data { + eval $start if $b_log; + my @result; + # /sbin/openrc --version: openrc (OpenRC) 0.13 + if ($program = main::check_program('openrc')){ + @result = ProgramData::full('openrc',$program); + } + # /sbin/rc --version: rc (OpenRC) 0.11.8 (Gentoo Linux) + elsif ($program = main::check_program('rc')){ + @result = ProgramData::full('rc',$program); + } + $result[0] ||= 'OpenRC'; + eval $end if $b_log; + return @result; +} + +# Check? /var/run/nologin for bsds? +sub get_runlevel { + eval $start if $b_log; + my $runlevel = ''; + if ($program = main::check_program('runlevel')){ + # variants: N 5; 3 5; unknown + $runlevel = (main::grabber("$program 2>/dev/null"))[0]; + $runlevel = undef if $runlevel && lc($runlevel) eq 'unknown'; + $runlevel =~ s/^(\S\s)?(\d)$/$2/ if $runlevel; + # print_line($runlevel . ";;"); + } + eval $end if $b_log; + return $runlevel; +} + +# Note: it appears that at least as of 2014-01-13, /etc/inittab is going +# to be used for default runlevel in upstart/sysvinit. systemd default is +# not always set so check to see if it's linked. +sub get_runlevel_default { + eval $start if $b_log; + my @data; + my $default = ''; + if ($program = main::check_program('systemctl')){ + # note: systemd systems do not necessarily have this link created + my $systemd = '/etc/systemd/system/default.target'; + # faster to read than run + if (-e $systemd){ + $default = readlink($systemd); + $default =~ s/(.*\/|\.target$)//g if $default; + } + if (!$default){ + $default = (main::grabber("$program get-default 2>/dev/null"))[0]; + $default =~ s/\.target$// if $default; + } + } + if (!$default){ + # http://askubuntu.com/questions/86483/how-can-i-see-or-change-default-run-level + # note that technically default can be changed at boot but for inxi purposes + # that does not matter, we just want to know the system default + my $upstart = '/etc/init/rc-sysinit.conf'; + my $inittab = '/etc/inittab'; + if (-r $upstart){ + # env DEFAULT_RUNLEVEL=2 + @data = main::reader($upstart); + $default = main::awk(\@data,'^env\s+DEFAULT_RUNLEVEL',2,'='); + } + # handle weird cases where null but inittab exists + if (!$default && -r $inittab){ + @data = main::reader($inittab); + $default = main::awk(\@data,'^id.*initdefault',2,':'); + } + } + eval $end if $b_log; + return $default; +} +} + +## IpData ## +{ +package IpData; + +sub set { + eval $start if $b_log; + if ($force{'ip'} || + (!$force{'ifconfig'} && $alerts{'ip'}->{'action'} eq 'use')){ + set_ip_addr(); + } + elsif ($force{'ifconfig'} || $alerts{'ifconfig'}->{'action'} eq 'use'){ + set_ifconfig(); + } + eval $end if $b_log; +} + +sub set_ip_addr { + eval $start if $b_log; + my ($b_skip,$broadcast,$if,$if_id,$ip,$scope,$type); + my (@data,@ips,@temp); + if ($fake{'ip-if'}){ + # my $file = "$fake_data_dir/if/scope-ipaddr-1.txt"; + # my $file = "$fake_data_dir/network/ip-addr-blue-advance.txt"; + # my $file = "$fake_data_dir/network/ppoe/ppoe-ip-address-1.txt"; + # my $file = "$fake_data_dir/network/ppoe/ppoe-ip-addr-2.txt"; + # my $file = "$fake_data_dir/network/ppoe/ppoe-ip-addr-3.txt"; + # @data = main::reader($file,'strip') or die $!; + } + else { + @data = main::grabber($alerts{'ip'}->{'path'} . " addr 2>/dev/null",'\n','strip'); + } + foreach (@data){ + if (/^[0-9]/){ + # print "$_\n"; + if (@ips){ + # print "$if\n"; + push(@ifs,($if,[@ips])); + @ips = (); + } + @temp = split(/:\s+/, $_); + $if = $temp[1]; + if ($if eq 'lo'){ + $b_skip = 1; + $if = ''; + next; + } + ($b_skip,@temp) = (); + } + elsif (!$b_skip && /^inet/){ + # print "$_\n"; + ($broadcast,$ip,$scope,$if_id,$type) = (); + @temp = split(/\s+/, $_); + $ip = $temp[1]; + $type = ($temp[0] eq 'inet') ? 4 : 6 ; + if ($temp[2] eq 'brd'){ + $broadcast = $temp[3]; + } + if (/scope\s([^\s]+)(\s(.+))?/){ + $scope = $1; + $if_id = $3; + } + push(@ips,[$type,$ip,$broadcast,$scope,$if_id]); + # print Data::Dumper::Dumper \@ips; + } + } + if (@ips){ + push(@ifs,($if,[@ips])); + } + main::log_data('dump','@ifs',\@ifs) if $b_log; + print 'ip addr: ', Data::Dumper::Dumper \@ifs if $dbg[3]; + eval $end if $b_log; +} + +sub set_ifconfig { + eval $start if $b_log; + my ($b_skip,$broadcast,$duplex,$if,$if_id,$ip,$mac,$scope,$speed,$state,$type); + my (@data,@ips,@ips_bsd,@temp); + # whitespace matters!! Don't use strip + if ($fake{'ip-if'}){ + # my $file = "$fake_data_dir/network/ppoe/ppoe-ifconfig-all-1.txt"; + # my $file = "$fake_data_dir/network/vps-ifconfig-1.txt"; + # @data = main::reader($file) or die $!; + } + else { + @data = main::grabber($alerts{'ifconfig'}->{'path'} . " 2>/dev/null",'\n',''); + } + foreach (@data){ + if (/^[\S]/i){ + # print "$_\n"; + if (@ips){ + # print "here\n"; + push(@ifs,($if,[@ips])); + @ips = (); + } + if ($mac){ + push(@ifs_bsd,($if,[$state,$speed,$duplex,$mac])); + ($state,$speed,$duplex,$mac,$if_id) = ('','','','',''); + } + $if = (split(/\s+/, $_))[0]; + $if =~ s/:$//; # em0: flags=8843 + $if_id = $if; + $if = (split(':', $if))[0] if $if; + if ($if =~ /^lo/){ + $b_skip = 1; + $if = ''; + $if_id = ''; + next; + } + $b_skip = 0; + } + elsif (!$b_skip && $bsd_type && /^\s+(address|ether|media|status|lladdr)/){ + $_ =~ s/^\s+//; + # freebsd 7.3: media: Ethernet 100baseTX + # Freebsd 8.2/12.2: media: Ethernet autoselect (1000baseT ) + # Netbsd 9.1: media: Ethernet autoselect (1000baseT full-duplex) + # openbsd: media: Ethernet autoselect (1000baseT full-duplex) + if (/^media/){ + if ($_ =~ /[\s\(]([1-9][^\(\s]+)?\s<([^>]+)>/){ + $speed = $1 if $1; + $duplex = $2; + } + if (!$duplex && $_ =~ /\s\(([\S]+)\s([^\s<]+)\)/){ + $speed = $1; + $duplex = $2; + } + if (!$speed && $_ =~ /\s\(([1-9][\S]+)\s/){ + $speed = $1; + } + } + # lladdr openbsd/address netbsd/ether freebsd + elsif (!$mac && /^(address|ether|lladdr)/){ + $mac = (split(/\s+/, $_))[1]; + } + elsif (/^status:\s*(.*)/){ + $state = $1; + } + } + elsif (!$b_skip && /^\s+inet/){ + # print "$_\n"; + $_ =~ s/^\s+//; + $_ =~ s/addr:\s/addr:/; + @temp = split(/\s+/, $_); + ($broadcast,$ip,$scope,$type) = ('','','',''); + $ip = $temp[1]; + # fe80::225:90ff:fe13:77ce%em0 +# $ip =~ s/^addr:|%([\S]+)//; + if ($1 && $1 ne $if_id){ + $if_id = $1; + } + $type = ($temp[0] eq 'inet') ? 4 : 6 ; + if (/(Bcast:|broadcast\s)([\S]+)/){ + $broadcast = $2; + } + if (/(scopeid\s[^<]+<|Scope:|scopeid\s)([^>]+)[>]?/){ + $scope = $2; + } + $scope = 'link' if $ip =~ /^fe80/; + push(@ips,[$type,$ip,$broadcast,$scope,$if_id]); + # print Data::Dumper::Dumper \@ips; + } + } + if (@ips){ + push(@ifs,($if,[@ips])); + } + if ($mac){ + push(@ifs_bsd,($if,[$state,$speed,$duplex,$mac])); + ($state,$speed,$duplex,$mac) = ('','','',''); + } + print 'ifconfig: ', Data::Dumper::Dumper \@ifs if $dbg[3]; + print 'ifconfig bsd: ', Data::Dumper::Dumper \@ifs_bsd if $dbg[3]; + main::log_data('dump','@ifs',\@ifs) if $b_log; + main::log_data('dump','@ifs_bsd',\@ifs_bsd) if $b_log; + eval $end if $b_log; +} +} + +sub get_kernel_bits { + eval $start if $b_log; + my $bits = ''; + if (my $program = check_program('getconf')){ + # what happens with future > 64 bit kernels? we'll see in the future! + if ($bits = (grabber("$program _POSIX_V6_LP64_OFF64 2>/dev/null"))[0]){ + if ($bits =~ /^(-1|undefined)$/i){ + $bits = 32; + } + # no docs for true state, 1 is usually true, but probably can be others + else { + $bits = 64; + } + } + # returns long bits if we got nothing on first test + $bits = (grabber("$program LONG_BIT 2>/dev/null"))[0] if !$bits; + } + # fallback test + if (!$bits && $bits_sys){ + $bits = $bits_sys; + } + $bits ||= 'N/A'; + eval $end if $b_log; + return $bits; +} + +# arg: 0: $cs_curr, by ref; 1: $cs_avail, by ref. +sub get_kernel_clocksource { + eval $start if $b_log; + if (-r '/sys/devices/system/clocksource/clocksource0/current_clocksource'){ + ${$_[0]} = reader('/sys/devices/system/clocksource/clocksource0/current_clocksource','',0); + if ($b_admin && + -r '/sys/devices/system/clocksource/clocksource0/available_clocksource'){ + ${$_[1]} = reader('/sys/devices/system/clocksource/clocksource0/available_clocksource','',0); + if (${$_[0]} && ${$_[1]}){ + my @temp = split(/\s+/,${$_[1]}); + @temp = grep {$_ ne ${$_[0]}} @temp; + ${$_[1]} = join(',', @temp); + } + } + } + eval $end if $b_log; +} + +## KernelCompiler ## +{ +package KernelCompiler; + +sub get { + eval $start if $b_log; + my $compiler = []; # we want an array ref to return if not set + if (my $file = $system_files{'proc-version'}){ + version_proc($compiler,$file); + } + elsif ($bsd_type){ + version_bsd($compiler); + } + eval $end if $b_log; + return $compiler; +} + +# args: 0: compiler by ref +sub version_bsd { + eval $start if $b_log; + my $compiler = $_[0]; + if ($alerts{'sysctl'}->{'action'} && $alerts{'sysctl'}->{'action'} eq 'use'){ + if ($sysctl{'kernel'}){ + my @working; + foreach (@{$sysctl{'kernel'}}){ + # Not every line will have a : separator though the processor should make + # most have it. This appears to be 10.x late feature add, I don't see it + # on earlier BSDs + if (/^kern.compiler_version/){ + @working = split(/:\s*/, $_); + $working[1] =~ /.*(clang|gcc|zigcc)\sversion\s([\S]+)\s.*/; + @$compiler = ($1,$2); + last; + } + } + } + # OpenBSD doesn't show compiler data in sysctl or dboot but it's going to + # be Clang until way into the future, and it will be the installed version. + if (ref $compiler ne 'ARRAY' || !@$compiler){ + if (my $path = main::check_program('clang')){ + ($compiler->[0],$compiler->[1]) = ProgramData::full('clang',$path); + } + } + } + main::log_data('dump','@$compiler',$compiler) if $b_log; + eval $end if $b_log; +} + +# args: 0: compiler by ref; 1: proc file name +sub version_proc { + eval $start if $b_log; + my ($compiler,$file) = @_; + if (my $result = main::reader($file,'',0)){ + my $version; + if ($fake{'compiler'}){ + # $result = $result =~ /\*(gcc|clang)\*eval\*/; + # $result='Linux version 5.4.0-rc1 (sourav@archlinux-pc) (clang version 9.0.0 (tags/RELEASE_900/final)) #1 SMP PREEMPT Sun Oct 6 18:02:41 IST 2019'; + # $result='Linux version 5.8.3-fw1 (fst@x86_64.frugalware.org) ( OpenMandriva 11.0.0-0.20200819.1 clang version 11.0.0 (/builddir/build/BUILD/llvm-project-release-11.x/clang 2a0076812cf106fcc34376d9d967dc5f2847693a), LLD 11.0.0)'; + # $result='Linux version 5.8.0-18-generic (buildd@lgw01-amd64-057) (gcc (Ubuntu 10.2.0-5ubuntu2) 10.2.0, GNU ld (GNU Binutils for Ubuntu) 2.35) #19-Ubuntu SMP Wed Aug 26 15:26:32 UTC 2020'; + # $result='Linux version 5.8.9-fw1 (fst@x86_64.frugalware.org) (gcc (Frugalware Linux) 9.2.1 20200215, GNU ld (GNU Binutils) 2.35) #1 SMP PREEMPT Tue Sep 15 16:38:57 CEST 2020'; + # $result='Linux version 5.8.0-2-amd64 (debian-kernel@lists.debian.org) (gcc-10 (Debian 10.2.0-9) 10.2.0, GNU ld (GNU Binutils for Debian) 2.35) #1 SMP Debian 5.8.10-1 (2020-09-19)'; + # $result='Linux version 5.9.0-5-amd64 (debian-kernel@lists.debian.org) (gcc-10 (Debian 10.2.1-1) 10.2.1 20201207, GNU ld (GNU Binutils for Debian) 2.35.1) #1 SMP Debian 5.9.15-1 (2020-12-17)'; + # $result='Linux version 2.6.1 (GNU 0.9 GNU-Mach 1.8+git20201007-486/Hurd-0.9 i686-AT386)'; + # $result='NetBSD version 9.1 (netbsd@localhost) (gcc version 7.5.0) NetBSD 9.1 (GENERIC) #0: Sun Oct 18 19:24:30 UTC 2020'; + #$result='Linux version 6.0.8-0-generic (chimera@chimera) (clang version 15.0.4, LLD 15.0.4) #1 SMP PREEMPT_DYNAMIC Fri Nov 11 13:45:29 UTC 2022'; + # 2023 ubuntu, sigh.. + # $result='Linux version 6.5.8-1-liquorix-amd64 (steven@liquorix.net) (gcc (Debian 13.2.0-4) 13.2.0, GNU ld (GNU Binutils for Debian) 2.41) #1 ZEN SMP PREEMPT liquorix 6.5-9.1~trixie (2023-10-19)'; + # $result='Linux version 6.5.0-9-generic (buildd@bos03-amd64-043) (x86_64-linux-gnu-gcc-13 (Ubuntu 13.2.0-4ubuntu3) 13.2.0, GNU ld (GNU Binutils for Ubuntu) 2.41) #9-Ubuntu SMP PREEMPT_DYNAMIC Sat Oct 7 01:35:40 UTC 2023'; + # $result='Linux version 6.5.13-un-def-alt1 (builder@localhost.localdomain) (gcc-13 (GCC) 13.2.1 20230817 (ALT Sisyphus 13.2.1-alt2), GNU ld (GNU Binutils) 2.41.0.20230826) #1 SMP PREEMPT_DYNAMIC Wed Nov 29 15:54:38 UTC 2023'; + } + # Note: zigcc is only theoretical, but someone is going to try it! + # cleanest, old style: 'clang version 9.0.0 (' | 'gcc version 7.5.0' + if ($result =~ /(gcc|clang|zigcc).*?version\s([^,\s\)]+)/){ + @$compiler = ($1,$2); + } + # new styles: compiler + stuff + x.y.z. Ignores modifiers to number: -4, -ubuntu + elsif ($result =~ /(gcc|clang|zigcc).*?\s(\d+(\.\d+){2,4})[)\s,_-]/){ + @$compiler = ($1,$2); + } + # failed, let's at least try for compiler type + elsif ($result =~ /(gcc|clang|zigcc)/){ + @$compiler = ($1,'N/A'); + } + } + main::log_data('dump','@$compiler',$compiler) if $b_log; + eval $end if $b_log; +} +} + +sub get_kernel_data { + eval $start if $b_log; + my ($ksplice) = (''); + my $kernel = []; + # Linux; yawn; 4.9.0-3.1-liquorix-686-pae; #1 ZEN SMP PREEMPT liquorix 4.9-4 (2017-01-14); i686 + # FreeBSD; siwi.pair.com; 8.2-STABLE; FreeBSD 8.2-STABLE #0: Tue May 31 14:36:14 EDT 2016 erik5@iddhi.pair.com:/usr/obj/usr/src/sys/82PAIRx-AMD64; amd64 + if (@uname){ + $kernel->[0] = $uname[2]; + if ((my $program = check_program('uptrack-uname')) && $kernel->[0]){ + $ksplice = qx($program -rm); + $ksplice = trimmer($ksplice); + $kernel->[0] = $ksplice . ' (ksplice)' if $ksplice; + } + $kernel->[1] = $uname[-1]; + } + # we want these to have values to save validation checks for output + $kernel->[0] ||= 'N/A'; + $kernel->[1] ||= 'N/A'; + log_data('data',"kernel: " . join('; ', $kernel) . " ksplice: $ksplice") if $b_log; + log_data('dump','perl @uname', \@uname) if $b_log; + eval $end if $b_log; + return $kernel; +} + +## KernelParameters ## +{ +package KernelParameters; + +sub get { + eval $start if $b_log; + my ($parameters); + if (my $file = $system_files{'proc-cmdline'}){ + $parameters = parameters_linux($file); + } + elsif ($bsd_type){ + $parameters = parameters_bsd(); + } + eval $end if $b_log; + return $parameters; +} + +sub parameters_linux { + eval $start if $b_log; + my ($file) = @_; + # unrooted android may have file only root readable + my $line = main::reader($file,'',0) if -r $file; + $line =~ s/\s\s+/ /g; + eval $end if $b_log; + return $line; +} + +sub parameters_bsd { + eval $start if $b_log; + my ($parameters); + eval $end if $b_log; + return $parameters; +} +} + +## LsblkData ## +# public methods: set(), get() +{ +package LsblkData; + +# args: 0: partition name +sub get { + eval $start if $b_log; + my $item = $_[0]; + return if !@lsblk; + my $result; + foreach my $device (@lsblk){ + if ($device->{'name'} eq $item){ + $result = $device; + last; + } + } + eval $start if $b_log; + return ($result) ? $result : {}; +} + +sub set { + eval $start if $b_log; + $loaded{'lsblk'} = 1; + if ($alerts{'lsblk'} && $alerts{'lsblk'}->{'path'}){ + # check to see if lsblk removes : - separators from accepted input syntax + my $cmd = $alerts{'lsblk'}->{'path'} . ' -bP --output NAME,TYPE,RM,FSTYPE,'; + $cmd .= 'SIZE,LABEL,UUID,SERIAL,MOUNTPOINT,PHY-SEC,LOG-SEC,PARTFLAGS,'; + $cmd .= 'MAJ:MIN,PKNAME 2>/dev/null'; + print "cmd: $cmd\n" if $dbg[32]; + my @working = main::grabber($cmd); + print Data::Dumper::Dumper \@working if $dbg[32]; + # note: lsblk 2.37 changeed - and : to _ in the output. + my $pattern = 'NAME="([^"]*)"\s+TYPE="([^"]*)"\s+RM="([^"]*)"\s+'; + $pattern .= 'FSTYPE="([^"]*)"\s+SIZE="([^"]*)"\s+LABEL="([^"]*)"\s+'; + $pattern .= 'UUID="([^"]*)"\s+SERIAL="([^"]*)"\s+MOUNTPOINT="([^"]*)"\s+'; + $pattern .= 'PHY[_-]SEC="([^"]*)"\s+LOG[_-]SEC="([^"]*)"\s+'; + $pattern .= 'PARTFLAGS="([^"]*)"\s+MAJ[:_-]MIN="([^"]*)"\s+PKNAME="([^"]*)"'; + foreach (@working){ + if (/$pattern/){ + my $size = ($5) ? $5/1024: 0; + # some versions of lsblk do not return serial, fs, uuid, or label + push(@lsblk, { + 'name' => $1, + 'type' => $2, + 'rm' => $3, + 'fs' => $4, + 'size' => $size, + 'label' => $6, + 'uuid' => $7, + 'serial' => $8, + 'mount' => $9, + 'block-physical' => $10, + 'block-logical' => $11, + 'partition-flags' => $12, + 'maj-min' => $13, + 'parent' => $14, + }); + # must be below assignments!! otherwise the result of the match replaces values + # note: for bcache and luks, the device that has that fs is the parent!! + if ($show{'logical'}){ + $use{'logical-lvm'} = 1 if !$use{'logical-lvm'} && $2 && $2 eq 'lvm'; + if (!$use{'logical-general'} && (($4 && + ($4 eq 'crypto_LUKS' || $4 eq 'bcache')) || + ($2 && ($2 eq 'dm' && $1 =~ /veracrypt/i) || $2 eq 'crypto' || + $2 eq 'mpath' || $2 eq 'multipath'))){ + $use{'logical-general'} = 1; + } + } + } + } + } + print Data::Dumper::Dumper \@lsblk if $dbg[32]; + main::log_data('dump','@lsblk',\@lsblk) if $b_log; + eval $end if $b_log; +} +} + +sub set_mapper { + eval $start if $b_log; + $loaded{'mapper'} = 1; + return if ! -d '/dev/mapper'; + foreach ((globber('/dev/mapper/*'))){ + my ($key,$value) = ($_,Cwd::abs_path("$_")); + next if !$value; + $key =~ s|^/.*/||; + $value =~ s|^/.*/||; + $mapper{$key} = $value; + } + %dmmapper = reverse %mapper if %mapper; + eval $end if $b_log; +} + +## MemoryData ## +{ +package MemoryData; + +sub get { + eval $start if $b_log; + my ($type) = @_; + $loaded{'memory'} = 1; + my ($memory); + # netbsd 8.0 uses meminfo, but it uses it in a weird way + if (!$force{'vmstat'} && (!$bsd_type || ($force{'meminfo'} && $bsd_type)) && + (my $file = $system_files{'proc-meminfo'})){ + $memory = linux_data($type,$file); + } + else { + $memory = bsd_data($type); + } + eval $end if $b_log; + return $memory; +} + +# $memory: +# 0: available (not reserved or iGPU) +# 1: used (of available) +# 2: used % +# 3: gpu (raspberry pi only) +# Linux only, but could be extended if anyone wants to do the work for BSDs +# 4: array ref: sys_memory [total, blocks, block-size, count factor] +# 5: array ref: proc/iomem [total, reserved, gpu] +# +# args: 0: source, the caller; 1: $row hash ref; 2: $num ref; 3: indent +sub row { + eval $start if $b_log; + my ($source,$row,$num,$indent) = @_; + $loaded{'memory'} = 1; + my ($available,$gpu_ram,$note,$total,$used); + my $memory = get('full'); + if ($memory){ + # print Data::Dumper::Dumper $memory; + if ($memory->[3]){ + $gpu_ram = $memory->[3]; + } + elsif ($memory->[5] && $memory->[5][2]){ + $gpu_ram = $memory->[5][2]; + } + # Great, we have the real RAM data. + if ($show{'ram'} && ($total = RamItem::ram_total())){ + $total = main::get_size($total,'string'); + } + elsif ($memory->[4] || $memory->[5]){ + process_total($memory,\$total,\$note); + } + if ($gpu_ram){ + $gpu_ram = main::get_size($gpu_ram,'string'); + } + $available = main::get_size($memory->[0],'string') if $memory->[0]; + $used = main::get_size($memory->[1],'string') if $memory->[1]; + $used .= " ($memory->[2]%)" if $memory->[2]; + } + my $field = ($source eq 'info') ? 'Memory' : 'System RAM'; + $available ||= 'N/A'; + $total ||= 'N/A'; + $used ||= 'N/A'; + $row->{main::key($$num++,1,$indent,$field)} = ''; + $row->{main::key($$num++,1,$indent+1,'total')} = $total; + $row->{main::key($$num++,0,$indent+2,'note')} = $note if $note; + $row->{main::key($$num++,0,$indent+1,'available')} = $available; + $row->{main::key($$num++,0,$indent+1,'used')} = $used; + $row->{main::key($$num++,0,$indent+1,'igpu')} = $gpu_ram if $gpu_ram; + eval $end if $b_log; +} + +## LINUX DATA ## +sub linux_data { + eval $start if $b_log; + my ($type,$file) = @_; + my ($available,$buffers,$cached,$free,$gpu,$not_used,$total_avail) = (0,0,0,0,0,0,0); + my ($iomem,$memory,$sys_memory,$total); + my @data = main::reader($file); + # Note: units kB should mean 1000x8 bits, but actually means KiB! Confusing + foreach (@data){ + # Not actual total, it's total physical minus reserved/kernel/system. + if ($_ =~ /^MemTotal:/){ + $total_avail = main::get_piece($_,2); + } + elsif ($_ =~ /^MemFree:/){ + $free = main::get_piece($_,2); + } + elsif ($_ =~ /^Buffers:/){ + $buffers = main::get_piece($_,2); + } + elsif ($_ =~ /^Cached:/){ + $cached = main::get_piece($_,2); + } + elsif ($_ =~ /^MemAvailable:/){ + $available = main::get_piece($_,2); + } + } + $gpu = gpu_ram_arm() if $risc{'arm'}; + if ($type ne 'short' && ($fake{'sys-mem'} || -d '/sys/devices/system/memory')){ + sys_memory(\$sys_memory); + } + if ($type ne 'short' && ($fake{'iomem'} || ($b_root && -r '/proc/iomem'))){ + proc_iomem(\$iomem); + } + # $gpu = main::translate_size('128M'); + # $total_avail += $gpu; # not using because this ram is not available to system + if ($available){ + $not_used = $available; + } + # Seen fringe cases, where total - free+buff+cach < 0 + # The idea is that the OS must be using 10MiB of ram or more + elsif (($total_avail - ($free + $buffers + $cached)) > 10000){ + $not_used = ($free + $buffers + $cached); + } + # Netbsd goes < 0, but it's wrong, so dump the cache + elsif (($total_avail - ($free + $buffers)) > 10000){ + $not_used = ($free + $buffers); + } + else { + $not_used = $free; + } + my $used = ($total_avail - $not_used); + my $percent = ($used && $total_avail) ? sprintf("%.1f", ($used/$total_avail)*100) : ''; + if ($type eq 'short'){ + $memory = short_data($total_avail,$used,$percent); + } + else { + # raw return in KiB + $memory = [$total_avail,$used,$percent,$gpu,$sys_memory,$iomem]; + } + # print "$total_avail, $used, $percent, $gpu\n"; + # print Data::Dumper::Dumper $memory; + main::log_data('data',"memory ref: $memory") if $b_log; + eval $end if $b_log; + return $memory; +} + +# All values 0 if not root, but it is readable. +# See inxi-perl/dev/code-snippets.pl for original attempt, with pci/reserved +# args: 0: $iomem by ref +sub proc_iomem { + eval $start if $b_log; + my $file = '/proc/iomem'; + my ($buffer,$gpu,$pci,$reserved,$rom,$system) = (0,0,0,0,0,0); + my $b_reserved; + no warnings 'portable'; + if ($fake{'iomem'}){ + # $file = "$fake_data_dir/memory/proc-iomem-128gb-1.txt"; + # $file = "$fake_data_dira/memory/proc-iomem-544mb-igpu.txt"; + # $file = "$fake_data_dir/memory/proc-iomem-64mb-vram-stolen.txt"; + # $file = "$fake_data_dir/memory/proc-iomem-rh-1-matrox.txt"; + # $file = "$fake_data_dir/memory/proc-iomem-2-vram.txt"; + # $file = "$fake_data_dir/memory/proc-iomem-512mb-1.txt"; + # $file = "$fake_data_dir/memory/proc-iomem-518mb-reserved-1.txt"; + # $file = "$fake_data_dir/memory/proc-iomem-512mb-2-onboardgpu-active.txt"; + # $file = "$fake_data_dir/memory/proc-iomem-512mb-system-1.txt"; + # $file = "$fake_data_dir/memory/proc-iomem-257.18gb-system-1.txt"; + # $file = "$fake_data_dir/memory/proc-iomem-192gb-system-1.txt"; + $file = "$fake_data_dir/memory/proc-iomem-1012mb-igpu.txt"; + } + foreach ((main::reader($file),'EOF')){ + if ($dbg[54]){ + if (/^\s*([0-9a-f]+)-([^\s]+) : /){ + print $_,"\n",' size: '; + print main::get_size(((hex($2) - hex($1) + 1)/1024),'string'), "\n"; + } + } + # Get everythign solidly System RAM + if (/^([0-9a-f]+)-([^\s]+) : (System RAM)$/i){ + $system += hex($2) - hex($1) + 1; + } + elsif (/^([0-9a-f]+)-([^\s]+) : (Ram buffer)$/i){ + $buffer += hex($2) - hex($1) + 1; + } + # Sometimes primary Reserved block contains PCI and other non RAM devices, + # but also can contain non RAM addresses, maybe NVMe? + elsif (/^([0-9a-f]+)-([^\s]+) : (Reserved)$/i){ + $reserved += hex($2) - hex($1) + 1; + } + # Legacy System ROM not in a Reserved block, primary item. + elsif (/^\s*([0-9a-f]+)-([^\s]+) : (System ROM)$/i){ + $rom += hex($2) - hex($1) + 1; + } + elsif (/^([0-9a-f]+)-([^\s]+) : (ACPI Tables)$/i){ + $rom += hex($2) - hex($1) + 1; + } + # Incomplete because sometimes Reserved blocks contain PCI etc devices + elsif (/^([0-9a-f]+)-([^\s]+) : (PCI .*)$/){ + $pci += hex($2) - hex($1) + 1; + } + # Graphics stolen memory/Video RAM area, but legacy had inside PCI blocks, + # not reserved, or as primary. That behavior seems to have changed. + if (/^\s*([0-9a-f]+)-([^\s]+) : (?:(Video RAM|Graphics).*)$/i){ + $gpu += hex($2) - hex($1) + 1; + } + } + if ($dbg[54] || $b_log){ + my $d = ['iomem:','System: ' . main::get_size(($system/1024),'string'), + 'Reserved: ' . main::get_size(($reserved/1024),'string'), + 'Buffer: ' . main::get_size(($buffer/1024),'string'), + 'iGPU: ' . main::get_size(($gpu/1024),'string'), + 'ROM: ' . main::get_size(($rom/1024),'string'), + 'System+iGPU+buffer+rom: ' . main::get_size((($system+$gpu+$buffer+$rom)/1024),'string'), + ' Raw GiB: ' . ($system+$gpu+$buffer+$rom)/1024**3, + 'System+reserved: ' . main::get_size((($system+$reserved)/1024),'string'), + ' Raw GiB: ' . ($system+$reserved)/1024**3, + 'System+reserved+buffer: ' . main::get_size((($system+$reserved+$buffer)/1024),'string'), + ' Raw GiB: ' . ($system+$reserved+$buffer)/1024**3, + 'Reserved-iGPU: ' . main::get_size((($reserved-$gpu)/1024),'string'), + 'PCI Bus: ' . main::get_size(($pci/1024),'string')]; + main::log_data('dump','$d iomem',$d) if $b_log; + print "\n",join("\n",@$d),"\n\n" if $dbg[54]; + } + if ($gpu || $system || $reserved){ + # This combination seems to provide the bwest overall result + $system += $gpu + $rom + $buffer; + ${$_[0]} = [$system/1024,$reserved/1024,$gpu/1024]; + } + main::log_data('dump','$iomem',$_[0]) if $b_log; + print 'proc/iomem: ', Data::Dumper::Dumper $_[0] if $dbg[53]; + eval $end if $b_log; +} + +# Note: seen case where actual 128 GiB, result here 130, 65x2GiB. Also cases +# where blocks under expected total, this may be related to active onboard gpu. +sub sys_memory { + eval $start if $b_log; + return if !$fake{'sys-mem'} && ! -r '/sys/devices/system/memory/block_size_bytes'; + my ($count,$factor,$size,$total) = (0,1,0,0); + # state = off,online; online = 1/0 + foreach my $online (main::globber('/sys/devices/system/memory/memory*/online')){ + $count++ if main::reader($online,'',0); # content 1/0, so will read as t/f + } + if ($count){ + $size = main::reader('/sys/devices/system/memory/block_size_bytes','',0); + if ($size){ + $size = hex($size)/1024; # back to integer KiB + $total = $count * $size; + } + } + if ($fake{'sys-mem'}){ + # ($total,$count,$size) = (,,); # + # ($total,$count,$size) = (4194304,32,131072); # 4gb + # ($total,$count,$size) = (7864320,60,131072); # 7.5 gb, -4 blocks + # ($total,$count,$size) = (136314880,65,2097152); # 130 gb, +1 block + # ($total,$count,$size) = (8126464,62,131072); # 7.75 gb, -2 blocks, vram? + # ($total,$count,$size) = (33554432,256,131072); # 32 gb + # ($total,$count,$size) = (8388608,64,131072); # 8gb + # ($total,$count,$size) = (270532608,129,2097152); # 258 gb, +1 block + # ($total,$count,$size) = (17563648,134,131072); # 16.75 gb, +6 block + # ($total,$count,$size) = (3801088,29,131072); # 3.62 gb, -3 blocks + # ($total,$count,$size) = (67108864,32,2097152); # 64 gb + # ($total,$count,$size) = (524288,4,131072); # 512 mb, maybe -4 blocks, vm + } + # Max stick size assumed: 64 blocks: 8 GiB/128 GiB min module: 2 GiB/32 GiB + # 128 blocks: 16 GiB/256 GiB min module: 4 GiB/64 GiB but no way to know + # Note: 128 MiB blocks; > 32 GiB, 2 GiB blocks, I think. + # 64: 8 GiB/256 GiB, min module: 2 GiB/32 GiB + if ($count > 32){ + $factor = 16;} + # 32: 4 GiB/64 GiB, min module: 1 GiB/16 GiB + elsif ($count > 16){ + $factor = 8;} + # 16: 2 GiB, min module: 512 MiB + elsif ($count > 8){ + $factor = 4;} + # 8: 1 GiB, min module: 256 MiB + elsif ($count > 4){ + $factor = 2;} + # 4: 512 MiB, min module: 128 MiB + else { + $factor = 1;} + if ($total || $count || $size){ + ${$_[0]} = [$total,$count,$size,$factor]; + } + if ($dbg[54] || $b_log){ + my $d = ['/sys:','Total: ' . main::get_size($total,'string'), + 'Blocks: ' . $count, + 'Block-size: ' . main::get_size($size,'string'), + "Count-factor: $count % $factor: " . $count % $factor]; + main::log_data('dump','$d sys-mem',$d) if $b_log; + print "\n",join("\n",@$d),"\n\n" if $dbg[54]; + } + main::log_data('dump','$sys_memory',$_[0]) if $b_log; + print 'sys memory: ', Data::Dumper::Dumper $_[0] if $dbg[53]; + eval $end if $b_log; +} + +# These are hacks since the phy ram real data is not available in clear form +# args: 0: memory array ref; 1: $total ref; 2: $note ref. +sub process_total { + eval $start if $b_log; + my ($memory,$total,$note) = @_; + my ($d,$b_vm,@info); + my $src = ''; + $b_vm = MachineItem::is_vm() if $show{'machine'}; + # Seen case where actual 128 GiB, result here 130, 65x2GiB. Maybe nvme? + # This can be over or under phys ram + if ($memory->[4] && $memory->[4][0]){ + @info = main::get_size($memory->[4][0]); + # We want to show note for probably wrong results + if ((!$fake{'sys-mem'} && $memory->[0] && $memory->[4][0] < $memory->[0]) || + (!$b_vm && $memory->[4][1] % $memory->[4][3] != 0)){ + $$note = main::message('note-check'); + } + $src = 'sys'; + } + # Note: this is a touch under the real ram amount, varies, igpu/vram can eat it. + # This working total will only be under phys ram. + if ($memory->[5] && $memory->[5][0] && + (!$memory->[4] || !$memory->[4][0] || ($memory->[4][0] != $memory->[5][0]))){ + @info = main::get_size($memory->[5][0]); + $src = 'iomem'; + } + if (@info){ + $$note = ''; + if (!$b_vm){ + # $info[0] = 384; + # $info[1] = 'MiB'; + my ($factor,$factor2) = (1,0.5); + # For M, assume smallest is 128, anything older won't even work probably. + # For T RAM, the system ram is going to be 99.9% of physical because the + # reserved stuff is going to be tiny, I believe. We will see. + # T array stick sizes: 128/256/512/1024 G + # Note: samsung ships 1T modules (2024?), 512G (2023). + if ($info[0] > 512){ + $factor = ($info[1] eq 'MiB') ? 256 : 64; + } + elsif ($info[0] > 256){ + $factor = ($info[1] eq 'MiB') ? 128 : 32; + } + elsif ($info[0] > 128){ + $factor = ($info[1] eq 'MiB') ? 64 : 16; + } + elsif ($info[0] > 64){ + $factor = 8; + } + elsif ($info[0] > 16){ + $factor = 4; + } + elsif ($info[0] > 8){ + $factor = 4; + } + elsif ($info[0] > 4){ + $factor = 2; + } + elsif ($info[0] > 3){ + $factor = 1; + } + elsif ($info[0] > 2){ + $factor = ($info[1] eq 'TiB') ? 0.25 : 0.5; + } + # Note: get_size returns 1 as 1024, so we never actually see 1 + elsif ($info[0] > 1){ + $factor = ($info[1] eq 'TiB') ? 0.125 : 0.25; + } + my $result = $info[0] / $factor; + my $mod = ((100 * $result) % 100); + if ($b_log || $dbg[54]){ + push(@$d,"src: $src result: $info[0] / $factor: $result math-modulus: $mod"); + } + if ($mod > 0){ + my ($check,$working) = (0,0); + # Sometimes Perl generates a tiny value over 0.1: 0.100000000000023 + # but also we want to be a little loose here. Note that when high + # numbers, like 1012 M, we want the math much looser. + # Within ~ 5% + if ($info[1] eq 'MiB'){ + if ($info[0] > 768){ + $check = 64; + } + elsif ($info[0] > 512){ + $check = 32; + } + elsif ($info[0] > 256){ + $check = 16; + } + else { + $check = 4; + } + } + # Within ~ 1% + elsif ($info[1] eq 'GiB'){ + if ($info[0] > 512){ + $check = 4; + } + elsif ($info[0] > 256){ + $check = 2; + } + elsif ($info[0] > 3){ + $check = 0.25; + } + else { + $check = 0.1; + } + } + # Will need to verify this T assumption on real data one day, but keep + # in mind how much reserved ram this would be! + elsif ($info[1] eq 'TiB'){ + if ($info[0] > 16){ + $check = 0.25; + } + elsif ($info[0] > 8){ + $check = 0.15; + } + elsif ($info[0] > 2){ + $check = 0.1; + } + else { + $check = 0.05; + } + } + # iomem is always under, sys can be over or under. we want fractional + # corresponding value over or under result. + # sys has block sizes: 128M, 2G, 32G, so sizes will always be divisible + if ($src eq 'sys'){ + if ($info[0] > 64){ + $factor2 = 0.25; + } + } + if ($src eq 'sys' && int($result + $factor2) == int($result)){ + $working = int($result) * $factor; + } + else { + $working = POSIX::ceil($result) * $factor; + } + if ($b_log || $dbg[54]){ + push(@$d, "factor2: $factor2 floor_res+fact2: " . int($result + $factor2), + "ceil_result * factor: " . (POSIX::ceil($result) * $factor), + "floor_result * factor: " . (int($result) * $factor)); + } + if (abs(($working - $info[0])) < $check){ + if ($src eq 'sys' && $info[0] != $working){ + $$note = main::message('note-est'); + } + if ($b_log || $dbg[54]){ + push(@$d,"check less: ($working - $info[0]) < $check: ", + "result: inside ceil < $check, clean"); + } + } + else { + if ($b_log || $dbg[54]){ + push(@$d,"check not less: ($working - $info[0]) < $check: ", + "set: $info[0] = $working"); + } + $$note = main::message('note-est'); + } + $info[0] = $working; + } + else { + if ($b_log || $dbg[54]){ + push(@$d,"result: clean match, no change: $info[0] $info[1]"); + } + } + } + else { + my $dec = ($info[1] eq 'MiB') ? 1: 2; + $info[0] = sprintf("%0.${dec}f",$info[0]) + 0; + if ($b_log || $dbg[54]){ + push(@$d,"result: vm, using size: $info[0] $info[1]"); + } + } + $$total = $info[0] . ' ' . $info[1]; + } + if ($b_log || $dbg[54]){ + main::log_data('dump','debugger',$d) if $b_log; + print Data::Dumper::Dumper $d if $dbg[54]; + } + eval $end if $b_log; +} + +## BSD DATA ## +## openbsd/linux +# procs memory page disks traps cpu +# r b w avm fre flt re pi po fr sr wd0 wd1 int sys cs us sy id +# 0 0 0 55256 1484092 171 0 0 0 0 0 2 0 12 460 39 3 1 96 +## openbsd 6.3? added in M/G/T etc, sigh... +# 2 57 55M 590M 789 0 0 0... +## freebsd: +# procs memory page disks faults cpu +# r b w avm fre flt re pi po fr sr ad0 ad1 in sy cs us sy id +# 0 0 0 21880M 6444M 924 32 11 0 822 827 0 0 853 832 463 8 3 88 +# with -H +# 2 0 0 14925812 936448 36 13 10 0 84 35 0 0 84 30 42 11 3 86 +## dragonfly: V1, supported -H +# procs memory page disks faults cpu +# r b w avm fre flt re pi po fr sr ad0 ad1 in sy cs us sy id +# 0 0 0 0 84060 30273993 2845 12742 1164 407498171 320960902 0 0 .... +## dragonfly: V2, no avm, no -H support +sub bsd_data { + eval $start if $b_log; + my ($type) = @_; + my ($avm,$av_pages,$cnt,$fre,$free_mem,$mult,$real_mem,$total) = (0,0,0,0,0,0,0,0); + my (@data,$memory,$message); + # my $arg = ($bsd_type ne 'openbsd' && $bsd_type ne 'dragonfly') ? '-H' : ''; + if (my $program = main::check_program('vmstat')){ + # See above, it's the last line. -H makes it hopefully all in kB so no need + # for K/M/G tests, note that -H not consistently supported, so don't use. + my @vmstat = main::grabber("vmstat 2>/dev/null",'\n','strip'); + main::log_data('dump','@vmstat',\@vmstat) if $b_log; + my @header = split(/\s+/, $vmstat[1]); + foreach (@header){ + if ($_ eq 'avm'){$avm = $cnt} + elsif ($_ eq 'fre'){$fre = $cnt} + elsif ($_ eq 'flt'){last;} + $cnt++; + } + my $row = $vmstat[-1]; + if ($row){ + @data = split(/\s+/, $row); + # Openbsd 6.3, dragonfly 5.x introduced an M / G character, sigh. + if ($avm > 0 && $data[$avm] && $data[$avm] =~ /^([0-9\.]+[KGMT])(iB|B)?$/){ + $data[$avm] = main::translate_size($1); + } + if ($fre > 0 && $data[$fre] && $data[$fre] =~ /^([0-9\.]+[KGMT])(iB|B)?$/){ + $data[$fre] = main::translate_size($1); + } + # Dragonfly can have 0 avg, or no avm, sigh, but they may fix that so make test dynamic + if ($avm > 0 && $data[$avm] != 0){ + $av_pages = ($bsd_type !~ /^(net|open)bsd$/) ? sprintf('%.1f',$data[$avm]/1024) : $data[$avm]; + } + if ($fre > 0 && $data[$fre] != 0){ + $free_mem = sprintf('%.1f',$data[$fre]); + } + } + } + # Code to get total goes here: + if ($alerts{'sysctl'}->{'action'} eq 'use'){ + # For dragonfly, we will use free mem, not used because free is 0 + my @working; + if ($sysctl{'memory'}){ + foreach (@{$sysctl{'memory'}}){ + # Freebsd seems to use bytes here + if (!$real_mem && /^hw.physmem:/){ + @working = split(/:\s*/, $_); + # if ($working[1]){ + $working[1] =~ s/^[^0-9]+|[^0-9]+$//g; + $real_mem = sprintf("%.1f", $working[1]/1024); + # } + last if $free_mem; + } + # But, it uses K here. Openbsd/Dragonfly do not seem to have this item + # This can be either: Free Memory OR Free Memory Pages + elsif (/^Free Memory:/){ + @working = split(/:\s*/, $_); + $working[1] =~ s/[^0-9]+//g; + $free_mem = sprintf("%.1f", $working[1]); + last if $real_mem; + } + } + } + } + else { + $message = "sysctl $alerts{'sysctl'}->{'action'}" + } + # Not using, but leave in place for a bit in case we want it + # my $type = ($free_mem) ? ' free':'' ; + # Hack: temp fix for openbsd/darwin: in case no free mem was detected but we have physmem + if (($av_pages || $free_mem) && !$real_mem){ + my $error = ($message) ? $message: 'total N/A'; + my $used = (!$free_mem) ? $av_pages : $real_mem - $free_mem; + if ($type eq 'short'){ + $memory = short_data($error,$used); + } + else { + $memory = [$error,$used,undef]; + } + } + # Use openbsd/dragonfly avail mem data if available + elsif (($av_pages || $free_mem) && $real_mem){ + my $used = (!$free_mem) ? $av_pages : $real_mem - $free_mem; + my $percent = ($used && $real_mem) ? sprintf("%.1f", ($used/$real_mem)*100) : ''; + if ($type eq 'short'){ + $memory = short_data($real_mem,$used,$percent); + } + else { + $memory = [$real_mem,$used,$percent,0]; + } + } + eval $end if $b_log; + return $memory; +} + +## TOOLS ## +# args: 0: avail memory; 1: used memory; 2: percent used +sub short_data { + # some BSDs, no available + my @avail = (main::is_numeric($_[0])) ? main::get_size($_[0]) : ($_[0]); + my @used = main::get_size($_[1]); + my $string = ''; + if ($avail[1] && $used[1]){ + if ( $avail[1] eq $used[1]){ + $string = "$used[0]/$avail[0] $used[1]"; + } + else { + $string = "$used[0] $used[1]/$avail[0] $avail[1]"; + } + } + elsif ($used[1]){ + $string = "$used[0]/[$avail[0]] $used[1]"; + } + $string .= " ($_[2]%)" if $_[2]; + return $string; +} + +# Raspberry pi only +sub gpu_ram_arm { + eval $start if $b_log; + my ($gpu_ram) = (0); + if (my $program = main::check_program('vcgencmd')){ + # gpu=128M + # "VCHI initialization failed" - you need to add video group to your user + my $working = (main::grabber("$program get_mem gpu 2>/dev/null"))[0]; + $working = (split(/\s*=\s*/, $working))[1] if $working; + $gpu_ram = main::translate_size($working) if $working; + } + main::log_data('data',"gpu ram: $gpu_ram") if $b_log; + eval $end if $b_log; + return $gpu_ram; +} +} + +# args: 0: module to get version of +sub get_module_version { + eval $start if $b_log; + my ($module) = @_; + return if !$module; + my ($version); + my $path = "/sys/module/$module/version"; + if (-r $path){ + $version = reader($path,'',0); + } + elsif (-f "/sys/module/$module/uevent"){ + $version = 'kernel'; + } + # print "version:$version\n"; + if (!$version){ + if (my $path = check_program('modinfo')){ + my @data = grabber("$path $module 2>/dev/null"); + $version = awk(\@data,'^version',2,':\s+') if @data; + } + } + $version ||= ''; + eval $end if $b_log; + return $version; +} + +## PackageData ## +# Note: this outputs the key/value pairs ready to go and is +# called from either -r or -Ix, -r precedes. +{ +package PackageData; +my ($count,$num,%pms,$type); +$pms{'total'} = 0; + +sub get { + eval $start if $b_log; + # $num passed by reference to maintain incrementing where requested + ($type,$num) = @_; + $loaded{'package-data'} = 1; + my $output = {}; + package_counts(); + appimage_counts(); + create_output($output); + eval $end if $b_log; + return $output; +} + +sub create_output { + eval $start if $b_log; + my $output = $_[0]; + my $total = ''; + if ($pms{'total'}){ + $total = $pms{'total'}; + } + else { + if ($type eq 'inner' || $pms{'disabled'}){ + $total = 'N/A' if $extra < 2; + } + else { + $total = main::message('package-data'); + } + } + if ($pms{'total'} && $extra > 1){ + delete $pms{'total'}; + my $b_mismatch; + foreach (keys %pms){ + next if $_ eq 'disabled'; + if ($pms{$_}->{'pkgs'} && $pms{$_}->{'pkgs'} != $total){ + $b_mismatch = 1; + last; + } + } + $total = '' if !$b_mismatch; + } + $output->{main::key($$num++,1,1,'Packages')} = $total; + # if blocked pm secondary, only show if no total or improbable total + if ($pms{'disabled'} && $extra < 2 && (!$pms{'total'} || $total < 100)){ + $output->{main::key($$num++,0,2,'note')} = $pms{'disabled'}; + } + if ($extra > 1 && %pms){ + foreach my $pm (sort keys %pms){ + my ($cont,$ind) = (1,2); + # if package mgr command returns error, this will not be a hash + next if ref $pms{$pm} ne 'HASH'; + if ($pms{$pm}->{'pkgs'} || $b_admin || ($extra > 1 && $pms{$pm}->{'disabled'})){ + my $type = $pm; + $type =~ s/^zzz-//; # get rid of the special sorters for items to show last + $output->{main::key($$num++,$cont,$ind,'pm')} = $type; + ($cont,$ind) = (0,3); + $pms{$pm}->{'pkgs'} = 'N/A' if $pms{$pm}->{'disabled'}; + $output->{main::key($$num++,($cont+1),$ind,'pkgs')} = $pms{$pm}->{'pkgs'}; + if ($pms{$pm}->{'disabled'}){ + $output->{main::key($$num++,$cont,$ind,'note')} = $pms{$pm}->{'disabled'}; + } + if ($b_admin ){ + if ($pms{$pm}->{'libs'}){ + $output->{main::key($$num++,$cont,($ind+1),'libs')} = $pms{$pm}->{'libs'}; + } + if ($pms{$pm}->{'tools'}){ + $output->{main::key($$num++,$cont,$ind,'tools')} = $pms{$pm}->{'tools'}; + } + } + } + } + } + # print Data::Dumper::Dumper \%output; + eval $end if $b_log; +} + +sub package_counts { + eval $start if $b_log; + my ($type) = @_; + # note: there is a program called discover which has nothing to do with kde + # apt systems: plasma-discover, non apt, discover, but can't use due to conflict + # my $disc = 'plasma-discover'; + my $gs = 'gnome-software'; + # 0: key; 1: program; 2: p/d [no-list]; 3: arg/path/no-list; 4: 0/1 use lib; + # 5: lib slice; 6: lib splitter; 7: optional eval test; + # 8: optional installed tool tests for -ra + # needed: cards [nutyx], urpmq [mageia] + my @pkg_managers = ( + ['alps','alps','p','showinstalled',1,0,''], + ['apk','apk','p','info',1,0,''], + # ['aptd','dpkg-query','d','/usr/lib/*',1,3,'\\/'], + # mutyx. do cards test because there is a very slow pkginfo python pkg mgr + ['cards','pkginfo','p','-i',1,1,'','main::check_program(\'cards\')'], + # older dpkg-query do not support -f values consistently: eg ${binary:Package} + ['dpkg','dpkg-query','p','-W --showformat=\'${Package}\n\'',1,0,'','', + ['apt','apt-get','aptitude','deb-get','muon','nala','synaptic']], + ['emerge','emerge','d','/var/db/pkg/*/*/',1,5,'\\/'], + ['eopkg','eopkg','d','/var/lib/eopkg/package/*',1,5,'\\/'], + ['guix-sys','guix','p','package -p "/run/current-system/profile" -I',1,0,''], + ['guix-usr','guix','p','package -I',1,0,''], + ['kiss','kiss','p','list',1,0,''], + ['mine','mine','p','-q',1,0,'','',['gasgui','gastone']], + ['mport','mport','p','list',1,0,''], + # netpkg puts packages in same place as slackpkg, only way to tell apart + ['netpkg','netpkg','d','/var/lib/pkgtools/packages/*',1,5,'\\/', + '-d \'/var/netpkg\' && -d \'/var/lib/pkgtools/packages\'', + ['netpkg','sbopkg','sboui','slackpkg','slapt-get','slpkg','swaret']], + ['nix-sys','nix-store','p','-qR /run/current-system/sw',1,1,'-'], + ['nix-usr','nix-store','p','-qR ~/.nix-profile',1,1,'-'], + ['nix-default','nix-store','p','-qR /nix/var/nix/profiles/default',1,2,'-'], + ['opkg','opkg','p','list',1,0,''], # ubuntu based Security Onion + ['pacman','pacman','p','-Qq --color never',1,0,'', + '!main::check_program(\'pacman-g2\')', # pacman-g2 has sym link to pacman + # these may need to be trimmed down depending on how useful/less some are + ['argon','aura','aurutils','baph','cylon','octopi','pacaur','pacseek', + 'pakku','pamac','paru','pikaur','trizen','yaourt','yay','yup']], + ['pacman-g2','pacman-g2','p','-Q',1,0,'','',], + ['pkg','pkg','d','/var/db/pkg/*',1,0,''], # 'pkg list' returns non programs + ['pkg_add','pkg_info','p','',1,0,''], # OpenBSD has set of tools, not 1 pm + # like cards, avoid pkginfo directly due to python pm being so slow + # but pkgadd is also found in scratch + ['pkgutils','pkginfo','p','-i',1,0,'','main::check_program(\'pkgadd\')'], + # slack 15 moves packages to /var/lib/pkgtools/packages but links to /var/log/packages + ['pkgtool','installpkg','d','/var/lib/pkgtools/packages/*',1,5,'\\/', + '!-d \'/var/netpkg\' && -d \'/var/lib/pkgtools/packages\'', + ['sbopkg','sboui','slackpkg','slapt-get','slpkg','swaret']], + ['pkgtool','installpkg','d','/var/log/packages/*',1,4,'\\/', + '! -d \'/var/lib/pkgtools/packages\' && -d \'/var/log/packages/\'', + ['sbopkg','sboui','slackpkg','slapt-get','slpkg','swaret']], + # rpm way too slow without nodigest/sig!! confirms packages exist + # but even with, MASSIVELY slow in some cases, > 20, 30 seconds!!!! + # Find another way to get rpm package counts to get rid of --rpm requirement! + ['rpm','rpm','force','-qa --nodigest --nosignature',1,0,'','skip_pm($pm)', + ['dnf','packagekit','up2date','urpmi','yast','yum','zypper']], + # uncommon case where apt-get frontend for rpm, w/o dpkg, eg AltLinux + ['rpm-apt','rpm','p','-qa',1,0,'','skip_pm($pm)',['apt-get','rpm']], + # scratch is a programming language too, with software called scratch + ['scratch','pkgbuild','d','/var/lib/scratchpkg/index/*/.pkginfo',1,5,'\\/', + '-d \'/var/lib/scratchpkg\''], + # note: slackpkg, slapt-get, spkg, and pkgtool all return the same count + # ['slackpkg','pkgtool','slapt-get','slpkg','swaret']], + # ['slapt-get','slapt-get','p','--installed',1,0,''], + # ['spkg','spkg','p','--installed',1,0,''], + ['tazpkg','tazpkg','p','list',1,0,'','',['tazpkgbox','tazpanel']], + ['tce','tce-status','p','-i',1,0,'','',['apps','tce-load']], + ['xbps','xbps-query','p','-l',1,1,''], + # ['xxx-brew','brew','p','--cellar',0,0,''], # verify how this works + ['zzz-flatpak','flatpak','p','list',0,0,''], + ['zzz-snap','snap','p','list',0,0,'','@ps_cmd && (grep {/\bsnapd\b/} @ps_cmd)'], + ); + my ($program); + foreach my $pm (@pkg_managers){ + if ($program = main::check_program($pm->[1])){ + print "0: test: $pm->[0]: $pm->[1]\n" if $dbg[67]; + next if $pm->[7] && !eval $pm->[7]; + print "1: use: $pm->[0]: $pm->[1]\n" if $dbg[67]; + my ($disabled,$libs,@list,$pm_tools); + if ($pm->[2] eq 'p' || ($pm->[2] eq 'force' && use_pm($pm))){ + chomp(@list = qx($program $pm->[3] 2>/dev/null)) if $pm->[3]; + } + elsif ($pm->[2] eq 'd'){ + @list = main::globber($pm->[3]); + } + else { + # update message() if pm other than rpm disabled by default + $disabled = main::message('pm-disabled',$pm->[1]); + } + $count = scalar @list if !$disabled; + # print Data::Dumper::Dumper \@list; + if (!$disabled){ + if ($b_admin && $count && $pm->[4]){ + $libs = count_libs(\@list,$pm->[5],$pm->[6]); + } + } + else { + $pms{'disabled'} = $disabled; + } + # if there is ambiguity about actual program installed, use this loop + if ($b_admin && $pm->[8]){ + my @tools; + foreach my $tool (@{$pm->[8]}){ + if (main::check_program($tool)){ + push(@tools,$tool); + } + } + # only show gs if tools found, and if not added before + if (@tools){ + if ($gs && main::check_program($gs)){ + push(@tools,$gs); + $gs = ''; + } + } + if (@tools){ + main::make_list_value(\@tools,\$pm_tools,',','sort'); + } + } + $pms{$pm->[0]} = { + 'disabled' => $disabled, + 'pkgs' => $count, + 'libs' => $libs, + 'tools' => $pm_tools, + }; + $pms{'total'} += $count if defined $count; + # print Data::Dumper::Dumper \%pms; + } + } + print 'package_counts %pms: ', Data::Dumper::Dumper \%pms if $dbg[65]; + main::log_data('dump','Package managers: %pms',\%pms) if $b_log; + eval $end if $b_log; +} + +sub appimage_counts { + if (@ps_cmd && (grep {/\bappimage(d|launcher)\b/} @ps_cmd)){ + my @list = main::globber($ENV{'HOME'} . '/.{appimage/,local/bin/}*.[aA]pp[iI]mage'); + $count = scalar @list; + $pms{'zzz-appimage'} = { + 'pkgs' => $count, + 'libs' => undef, + }; + $pms{'total'} += $count; + } +} + +# skip is if false, so skip conditions must be false, non skip true. +# args: 0: $pm ref, used directly +sub skip_pm { + my $b_use; + # print Data::Dumper::Dumper $_[0]; + if (${_[0]}->[1] eq 'rpm'){ + # use only if not urpmi and not rpm-apt, this covers most cases, and use_pm + # fine tunes the coverage. + if (${_[0]}->[0] eq 'rpm'){ + if (!(main::check_program('apt-get') && !main::check_program('dpkg'))){ + $b_use = 1; + } + } + # this covers corner case of alt linux, that has apt-get but not dpkg + elsif (${_[0]}->[0] eq 'rpm-apt'){ + if (main::check_program('apt-get') && !main::check_program('dpkg')){ + $b_use = 1; + } + } + } + return $b_use; +} + +# args: 0: $pm ref, use directly +sub use_pm { + if ($force{'pkg'}){ + print " use_pm: --rpm force\n" if $dbg[67]; + return 1; + } + elsif (${_[0]}->[1] eq 'rpm'){ + # testing for core wrappers for rpm, these should not be present in non + # mageia/redhat/suse based systems. mageia has urpmi, dnf, yum + foreach my $tool (('dnf','up2date','urpmi','yum','zypper')){ + if (main::check_program($tool)){ + print " use_pm: $tool match\n" if $dbg[67]; + return 0; + } + } + # Note: test fails: apt-rpm (pclinuxos,alt linux), but apt-rpm should pass + # Add pm test if known to have rpm available. + foreach my $tool (('dpkg','pacman','pkgtool','tce-load')){ + if (main::check_program($tool)){ + print " use_pm: $tool match\n" if $dbg[67]; + return 1; + } + } + } +} + +sub count_libs { + my ($items,$pos,$split) = @_; + my (@data); + my $i = 0; + $split ||= '\\s+'; + # print scalar @$items, '::', $split, '::', $pos, "\n"; + foreach (@$items){ + @data = split(/$split/, $_); + # print scalar @data, '::', $data[$pos], "\n"; + $i++ if $data[$pos] && $data[$pos] =~ m%^lib%; + } + return $i; +} +} + +## ParseEDID ## +{ +package ParseEDID; +# CVT_ratios: +my @known_ratios = qw(5/4 4/3 3/2 16/10 15/9 16/9); + +# Set values +my @edid_info = ( + ['a8', '_header'], + ['a2', 'manufacturer_name'], + ['v', 'product_code'], + ['V', 'serial_number'], + ['C', 'week'], + ['C', 'year'], + ['C', 'edid_version'], + ['C', 'edid_revision'], + ['a', 'video_input_definition'], + ['C', 'max_size_horizontal'], # in cm, 0 on projectors + ['C', 'max_size_vertical'], # in cm, 0 on projectors + ['C', 'gamma'], + ['a', 'feature_support'], + ['a10', 'color_characteristics'], + ['a3' , 'established_timings'], + ['a16', 'standard_timings'], + ['a72', 'monitor_details'], + ['C', 'extension_flag'], + ['C', 'checksum'], +); +my %subfields = ( + manufacturer_name => [ + [1, ''], + [5, '1'], + [5, '2'], + [5, '3'], + ], + video_input_definition => [ + [1, 'digital'], + [1, 'separate_sync'], + [1, 'composite_sync'], + [1, 'sync_on_green'], + [2, ''], + [2, 'voltage_level'], + ], + feature_support => [ + [1, 'DPMS_standby'], + [1, 'DPMS_suspend'], + [1, 'DPMS_active_off'], + [1, 'rgb'], + [1, ''], + [1, 'sRGB_compliance'], + [1, 'has_preferred_timing'], + [1, 'GTF_compliance'], + ], + # these are VESA timings, basically: VESA-EEDID-A2.pdf + established_timings => [ + # byte 1, 23h + [1, '720x400_70'], + [1, '720x400_88'], + [1, '640x480_60'], + [1, '640x480_67'], + [1, '640x480_72'], + [1, '640x480_75'], + [1, '800x600_56'], + [1, '800x600_60'], + # byte 2, 24h + [1, '800x600_72'], + [1, '800x600_75'], + [1, '832x624_75'], + [1, '1024x768_87i'], + [1, '1024x768_60'], + [1, '1024x768_70'], + [1, '1024x768_75'], + [1, '1280x1024_75'], + # byte 3, 25h + # 7: [1, '1152x870_75'], # apple macII + # 6-0: manufacturer's timings + ], + detailed_timing => [ + [8, 'horizontal_active'], + [8, 'horizontal_blanking'], + [4, 'horizontal_active_hi'], + [4, 'horizontal_blanking_hi'], + [8, 'vertical_active'], + [8, 'vertical_blanking'], + [4, 'vertical_active_hi'], + [4, 'vertical_blanking_hi'], + [8, 'horizontal_sync_offset'], + [8, 'horizontal_sync_pulse_width'], + [4, 'vertical_sync_offset'], + [4, 'vertical_sync_pulse_width'], + [2, 'horizontal_sync_offset_hi'], + [2, 'horizontal_sync_pulse_width_hi'], + [2, 'vertical_sync_offset_hi'], + [2, 'vertical_sync_pulse_width_hi'], + [8, 'horizontal_image_size'], # in mm + [8, 'vertical_image_size'], # in mm + [4, 'horizontal_image_size_hi'], + [4, 'vertical_image_size_hi'], + [8, 'horizontal_border'], + [8, 'vertical_border'], + [1, 'interlaced'], + [2, 'stereo'], + [2, 'digital_composite'], + [1, 'horizontal_sync_positive'], + [1, 'vertical_sync_positive'], + [1, ''], + ], + # 16 bytes, up to 8 additional timings, each identified by a unique 2 byte + # code derived from the horizontal active pixel count, the image aspect ratio + # and field refresh rate as described in Table 3.19 + standard_timing => [ + [8, 'X'], + [2, 'aspect'], + [6, 'vfreq'], + ], + monitor_range => [ + [8, 'vertical_min'], + [8, 'vertical_max'], + [8, 'horizontal_min'], + [8, 'horizontal_max'], + [8, 'pixel_clock_max'], + ], + manufacturer_specified_range_timing => [ + # http://www.spwg.org/salisbury_march_19_2002.pdf + # for the glossary: http://www.vesa.org/Public/PSWG/PSWG15v1.pdf + [8, 'horizontal_sync_pulse_width_min'], # HSPW (Horizontal Sync Pulse Width) + [8, 'horizontal_sync_pulse_width_max'], + [8, 'horizontal_back_porch_min'], # t_hbp + [8, 'horizontal_back_porch_max'], + [8, 'vertical_sync_pulse_width_min'], # VSPW (Vertical Sync Pulse Width) + [8, 'vertical_sync_pulse_width_max'], + [8, 'vertical_back_porch_min'], # t_vbp (Vertical Back Porch) + [8, 'vertical_back_porch_max'], + [8, 'horizontal_blanking_min'], # t_hp (Horizontal Period) + [8, 'horizontal_blanking_max'], + [8, 'vertical_blanking_min'], # t_vp + [8, 'vertical_blanking_max'], + [8, 'module_revision'], + ], + cea_data_block_collection => [ + [3, 'type'], + [5, 'size'], + ], + cea_video_data_block => [ + [1, 'native'], + [7, 'mode'], + ], + # Section 3.7 in VESA-EEDID-A2.pdf specs + color_characteristics => [ + # Rx1 Rx0 Ry1 Ry0 Gx1 Gx0 Gy1 Gy0 + [8, 'white_point_red_green'], + # Bx1 Bx0 By1 By0 Wx1 Wx0 Wy1 Wy0 + [8, 'white_point_blue_white'], + [8, 'red_x'], + [8, 'red_y'], + [8, 'green_x'], + [8, 'green_y'], + [8, 'blue_x'], + [8, 'blue_y'], + [8, 'white_x'], + [8, 'white_y'], + ], +); +my @cea_video_mode_to_detailed_timing = ( + 'pixel_clock', + 'horizontal_active', + 'vertical_active', + 'aspect', + 'horizontal_blanking', + 'horizontal_sync_offset', + 'horizontal_sync_pulse_width', + 'vertical_blanking', + 'vertical_sync_offset', + 'vertical_sync_pulse_width', + 'horizontal_sync_positive', + 'vertical_sync_positive', + 'interlaced' +); +my @cea_video_modes = ( +# [0] pixel clock, [1] X, [2] Y, [3] aspect, [4] Hblank, [5] Hsync_offset, [6] Hsync_pulse_width, +# [7] Vblank, [8] Vsync_offset, [9] Vsync_pulse_width, [10] Hsync+, [11] Vsync+, [12] interlaced +# 59.94/29.97 and similar modes also have a 60.00/30.00 counterpart by raising the pixel clock + [ 25.175, 640, 480, "4/3", 160, 16, 96, 45, 10, 2, 0, 0, 0 ], # 1: 640x 480@59.94 + [ 27.000, 720, 480, "4/3", 138, 16, 62, 45, 9, 6, 0, 0, 0 ], # 2: 720x 480@59.94 + [ 27.000, 720, 480, "16/9", 138, 16, 62, 45, 9, 6, 0, 0, 0 ], # 3: 720x 480@59.94 + [ 74.250, 1280, 720, "16/9", 370, 110, 40, 30, 5, 5, 1, 1, 0 ], # 4: 1280x 720@60.00 + [ 74.250, 1920, 1080, "16/9", 280, 88, 44, 45, 4, 10, 1, 1, 1 ], # 5: 1920x1080@30.00 + [ 27.000, 1440, 480, "4/3", 276, 38, 124, 45, 8, 6, 0, 0, 1 ], # 6: 1440x 480@29.97 + [ 27.000, 1440, 480, "16/9", 276, 38, 124, 45, 8, 6, 0, 0, 1 ], # 7: 1440x 480@29.97 + [ 27.000, 1440, 240, "4/3", 276, 38, 124, 22, 4, 3, 0, 0, 0 ], # 8: 1440x 240@60.05 + [ 27.000, 1440, 240, "16/9", 276, 38, 124, 22, 4, 3, 0, 0, 0 ], # 9: 1440x 240@60.05 + [ 54.000, 2880, 480, "4/3", 552, 76, 248, 45, 8, 6, 0, 0, 1 ], # 10: 2880x 480@29.97 + [ 54.000, 2880, 480, "16/9", 552, 76, 248, 45, 8, 6, 0, 0, 1 ], # 11: 2880x 480@29.97 + [ 54.000, 2880, 240, "4/3", 552, 76, 248, 22, 4, 3, 0, 0, 0 ], # 12: 2880x 240@60.05 + [ 54.000, 2880, 240, "16/9", 552, 76, 248, 22, 4, 3, 0, 0, 0 ], # 13: 2880x 240@60.05 + [ 54.000, 1440, 480, "4/3", 276, 32, 124, 45, 9, 6, 0, 0, 0 ], # 14: 1440x 480@59.94 + [ 54.000, 1440, 480, "16/9", 276, 32, 124, 45, 9, 6, 0, 0, 0 ], # 15: 1440x 480@59.94 + [ 148.500, 1920, 1080, "16/9", 280, 88, 44, 45, 4, 5, 1, 1, 0 ], # 16: 1920x1080@60.00 + [ 27.000, 720, 576, "4/3", 144, 12, 64, 49, 5, 5, 0, 0, 0 ], # 17: 720x 576@50.00 + [ 27.000, 720, 576, "16/9", 144, 12, 64, 49, 5, 5, 0, 0, 0 ], # 18: 720x 576@50.00 + [ 74.250, 1280, 720, "16/9", 700, 440, 40, 30, 5, 5, 1, 1, 0 ], # 19: 1280x 720@50.00 + [ 74.250, 1920, 1080, "16/9", 720, 528, 44, 45, 4, 10, 1, 1, 1 ], # 20: 1920x1080@25.00 + [ 27.000, 1440, 576, "4/3", 288, 24, 126, 49, 4, 6, 0, 0, 1 ], # 21: 1440x 576@25.00 + [ 27.000, 1440, 576, "16/9", 288, 24, 126, 49, 4, 6, 0, 0, 1 ], # 22: 1440x 576@25.00 + [ 27.000, 1440, 288, "4/3", 288, 24, 126, 24, 2, 3, 0, 0, 0 ], # 23: 1440x 288@50.08 + [ 27.000, 1440, 288, "16/9", 288, 24, 126, 24, 2, 3, 0, 0, 0 ], # 24: 1440x 288@50.08 + [ 54.000, 2880, 576, "4/3", 576, 48, 252, 49, 4, 6, 0, 0, 1 ], # 25: 2880x 576@25.00 + [ 54.000, 2880, 576, "16/9", 576, 48, 252, 49, 4, 6, 0, 0, 1 ], # 26: 2880x 576@25.00 + [ 54.000, 2880, 288, "4/3", 576, 48, 252, 24, 2, 3, 0, 0, 0 ], # 27: 2880x 288@50.08 + [ 54.000, 2880, 288, "16/9", 576, 48, 252, 24, 2, 3, 0, 0, 0 ], # 28: 2880x 288@50.08 + [ 54.000, 1440, 576, "4/3", 288, 24, 128, 49, 5, 5, 0, 0, 0 ], # 29: 1440x 576@50.00 + [ 54.000, 1440, 576, "16/9", 288, 24, 128, 49, 5, 5, 0, 0, 0 ], # 30: 1440x 576@50.00 + [ 148.500, 1920, 1080, "16/9", 720, 528, 44, 45, 4, 5, 1, 1, 0 ], # 31: 1920x1080@50.00 + [ 74.250, 1920, 1080, "16/9", 830, 638, 44, 45, 4, 5, 1, 1, 0 ], # 32: 1920x1080@24.00 + [ 74.250, 1920, 1080, "16/9", 720, 528, 44, 45, 4, 5, 1, 1, 0 ], # 33: 1920x1080@25.00 + [ 74.250, 1920, 1080, "16/9", 280, 88, 44, 45, 4, 5, 1, 1, 0 ], # 34: 1920x1080@30.00 + [ 108.000, 2880, 480, "4/3", 552, 64, 248, 45, 9, 6, 0, 0, 0 ], # 35: 2880x 480@59.94 + [ 108.000, 2880, 480, "16/9", 552, 64, 248, 45, 9, 6, 0, 0, 0 ], # 36: 2880x 480@59.94 + [ 108.000, 2880, 576, "4/3", 576, 48, 256, 49, 5, 5, 0, 0, 0 ], # 37: 2880x 576@50.00 + [ 108.000, 2880, 576, "16/9", 576, 48, 256, 49, 5, 5, 0, 0, 0 ], # 38: 2880x 576@50.00 + [ 72.000, 1920, 1080, "16/9", 384, 32, 168, 170, 46, 10, 1, 0, 1 ], # 39: 1920x1080@25.00 + [ 148.500, 1920, 1080, "16/9", 720, 528, 44, 45, 4, 10, 1, 1, 1 ], # 40: 1920x1080@50.00 + [ 148.500, 1280, 720, "16/9", 700, 440, 40, 30, 5, 5, 1, 1, 0 ], # 41: 1280x 720@100.00 + [ 54.000, 720, 576, "4/3", 144, 12, 64, 49, 5, 5, 0, 0, 0 ], # 42: 720x 576@100.00 + [ 54.000, 720, 576, "16/9", 144, 12, 64, 49, 5, 5, 0, 0, 0 ], # 43: 720x 576@100.00 + [ 54.000, 1440, 576, "4/3", 288, 24, 126, 49, 4, 6, 0, 0, 0 ], # 44: 1440x 576@50.00 + [ 54.000, 1440, 576, "16/9", 288, 24, 126, 49, 4, 6, 0, 0, 0 ], # 45: 1440x 576@50.00 + [ 148.500, 1920, 1080, "16/9", 280, 88, 44, 45, 4, 10, 1, 1, 1 ], # 46: 1920x1080@60.00 + [ 148.500, 1280, 720, "16/9", 370, 110, 40, 30, 5, 5, 1, 1, 0 ], # 47: 1280x 720@120.00 + [ 54.000, 720, 480, "4/3", 138, 16, 62, 45, 9, 6, 0, 0, 0 ], # 48: 720x 480@119.88 + [ 54.000, 720, 480, "16/9", 138, 16, 62, 45, 9, 6, 0, 0, 0 ], # 49: 720x 480@119.88 + [ 54.000, 1440, 480, "4/3", 276, 38, 124, 45, 8, 6, 0, 0, 1 ], # 50: 1440x 480@59.94 + [ 54.000, 1440, 480, "16/9", 276, 38, 124, 45, 8, 6, 0, 0, 1 ], # 51: 1440x 480@59.94 + [ 108.000, 720, 576, "4/3", 144, 12, 64, 49, 5, 5, 0, 0, 0 ], # 52: 720x 576@200.00 + [ 108.000, 720, 576, "16/9", 144, 12, 64, 49, 5, 5, 0, 0, 0 ], # 53: 720x 576@200.00 + [ 108.000, 1440, 576, "4/3", 288, 24, 126, 49, 4, 6, 0, 0, 1 ], # 54: 1440x 576@100.00 + [ 108.000, 1440, 576, "16/9", 288, 24, 126, 49, 4, 6, 0, 0, 1 ], # 55: 1440x 576@100.00 + [ 108.000, 720, 480, "4/3", 138, 16, 62, 45, 9, 6, 0, 0, 0 ], # 56: 720x 480@239.76 + [ 108.000, 720, 480, "16/9", 138, 16, 62, 45, 9, 6, 0, 0, 0 ], # 57: 720x 480@239.76 + [ 108.000, 1440, 480, "4/3", 276, 38, 124, 45, 8, 6, 0, 0, 1 ], # 58: 1440x 480@119.88 + [ 108.000, 1440, 480, "16/9", 276, 38, 124, 45, 8, 6, 0, 0, 1 ], # 59: 1440x 480@119.88 + [ 59.400, 1280, 720, "16/9", 2020, 1760, 40, 30, 5, 5, 1, 1, 0 ], # 60: 1280x 720@24.00 + [ 74.250, 1280, 720, "16/9", 2680, 2420, 40, 30, 5, 5, 1, 1, 0 ], # 61: 1280x 720@25.00 + [ 74.250, 1280, 720, "16/9", 2020, 1760, 40, 30, 5, 5, 1, 1, 0 ], # 62: 1280x 720@30.00 + [ 297.000, 1920, 1080, "16/9", 280, 88, 44, 45, 4, 5, 1, 1, 0 ], # 63: 1920x1080@120.00 + [ 297.000, 1920, 1080, "16/9", 720, 528, 44, 45, 4, 10, 1, 1, 0 ], # 64: 1920x1080@100.00 +); +# Exist but IDs Unknown: Pixio, AOpen (AON?), AORUS [probably GBT], Deco Gear, +# Eyoyo, GAEMS, GeChic, KOORUI, Lilliput, Mobile Pixels, Nexanic, SunFounder, +# TECNII, TPEKKA, V7/VSEVEN, +# Guesses: KYY=KYY, MSI=MSI, KOE=Kaohsiung Opto Electronics +# PGS: Princeton Graphic Systems; SDC: Samsung Display Co; +# SIS: Silicon Integrated Systems; STN: Samsung Electronics America; +# BDS: Barco Display Systems +# TAI: Toshiba America +# HIQ: Hitachi ImageQuest or Kaohsiung Opto Electronics? or does Imagequest make hitachi: +# NVD: Nvidia or NewVisionDisplay? +my %vendors = ( +'AAC' => 'AcerView', 'ACI' => 'Asus', 'ACR' => 'Acer', 'ACT' => 'Targa', 'ADI' => 'ADI', +'AIC' => 'AG Neovo', 'AMW' => 'AMW', 'ANX' => 'Acer Netxix', 'AOC' => 'AOC', 'API' => 'A Plus Info', +'APP' => 'Apple', 'ART' => 'ArtMedia', 'AST' => 'AST Research', 'AUO' => 'AU Optronics', +'BEL' => 'Beltronic', 'BMM' => 'BMM', 'BNQ' => 'BenQ', 'BOE' => 'BOE Display', 'BDS' => 'Barco', +'CHO' => 'Sichuang Changhong', 'CMN' => 'ChiMei InnoLux', 'CMO' => 'Chi Mei Optoelectronics', +'CPL' => 'Compal/ALFA', 'CPQ' => 'Compaq', 'CPT' => 'Chungwa Picture Tubes', 'CTX' => 'CTX (Chuntex)', 'CVT' => 'DGM', +'DEC' => 'DEC', 'DEL' => 'Dell', 'DON' => 'Denon', 'DPC' => 'Delta', 'DPL' => 'Digital Projection', 'DWE' => 'Daewoo', +'ECS' => 'Elitegroup', 'EIZ' => 'EIZO', 'ELS' => 'ELSA', 'ENC' => 'EIZO NANAO', 'EPI' => 'Envision', 'ETR' => 'Rotel', +'FCM' => 'Funai', 'FUJ' => 'Fujitsu', 'FUS' => 'Fujitsu Siemens', +'GBT' => 'Gigabyte', 'GFN' => 'Gefen', 'GSM' => 'LG (GoldStar)', 'GWY' => 'Gateway 2000', +'HEI' => 'Hyundai.', 'HIQ' => 'Hyundai ImageQuest', 'HIT' => 'Hitachi', 'HPN' => 'HP', +'HSD' => 'HannSpree/HannStar', 'HSL' => 'Hansol', 'HTC' => 'Hitachi/Nissei', 'HVR' => 'Hitachi', +'HWP' => 'HP', 'HWV' => 'Huawei', +'IBM' => 'IBM', 'ICL' => 'Fujitsu ICL', 'IFS' => 'InFocus', 'INO' => 'Innolab Pte', 'IQT' => 'Hyundai', +'IVM' => 'Idek Iiyama', 'IVO' => 'InfoVision Optronics/Kunshan', +'KDS' => 'Korea Data Systems (KDS)', 'KFC' => 'KFC Computek', 'KOE' => 'Kaohsiung OptoElectronics', +'KTC' => 'Kingston', 'KYY' => 'KYY', +'LCD' => 'Toshiba Matsushita', 'LEN' => 'Lenovo', 'LGD' => 'LG Display', 'LKM' => 'Adlas/Azalea', +'LNK' => 'LINK', 'LPL' => 'LG Philips', 'LTN' => 'Lite-On', +'MAG' => 'MAG InnoVision', 'MAX' => 'Belinea/Maxdata', 'MED' => 'Medion', +'MEI' => 'Panasonic', 'MEL' => 'Mitsubishi', 'MIR' => 'Miro', 'MSI' => 'MSI', 'MTC' => 'MITAC', +'NAN' => 'NANAO/EIZO', 'NEX' => 'Nexgen Mediatech', 'NCP' => 'Najing CEC Panda', 'NEC' => 'NEC', +'NOK' => 'Nokia', 'NVD' => 'Nvidia', +'ONK' => 'Onkyo', 'OPT' => 'Optoma','OQI' => 'ViewSonic Optiquest', 'ORN' => 'Orion', +'PBN' => 'Packard Bell', 'PCK' => 'Daewoo', 'PDC' => 'Polaroid', 'PGS' => 'Princeton', +'PHL' => 'Philips', 'PIO' => 'Pioneer', 'PNR' => 'Planar', 'PRT' => 'Princeton', +'QDI' => 'Quantum Data', 'QDS' => 'Quanta Display', 'REL' => 'Relisys', 'REN' => 'Renesas', +'SAM' => 'Samsung', 'SAN' => 'Sanyo', 'SBI' => 'Smarttech', 'SDC' => 'Samsung', 'SEC' => 'Seiko Epson', +'SEN' => 'Sensics', 'SHP' => 'Sharp', 'SGD' => 'Sigma Designs', 'SGI' => 'SGI', 'SHI' => 'Jiangsu Shinco', +'SII' => 'Silicon Image', 'SIS' => 'SIS', 'SKM' => 'Guangzhou Teclast', 'SMC' => 'Samtron', +'SMI' => 'Smile', 'SNI' => 'Siemens Nixdorf', 'SNY' => 'Sony', 'SPT' => 'Sceptre', +'SRC' => 'Shamrock', 'STN' => 'Samsung', 'STP' => 'Sceptre', 'SUN' => 'Sun Microsystems', 'SYN' => 'Synaptics', +'TAI' => 'Toshiba', 'TAT' => 'Tatung', 'TOS' => 'Toshiba', 'TRL' => 'Royal Information', +'TSB' => 'Toshiba', 'UEG' => 'EliteGroup', 'UNM' => 'Unisys', +'VIT' => 'Visitech', 'VLV' => 'Valve', 'VSC' => 'ViewSonic', 'VTK' => 'Viewteck', 'VTS' => 'VTech', +'WTC' => 'Wen Technology', 'XLX' => 'Xilinx', 'YMH' => 'Yamaha', 'ZCM' => 'Zenith', +); + +sub _within_limit { + my ($value, $type, $limit) = @_; + $type eq 'min' ? $value >= $limit : $value <= $limit; +} + +sub _get_many_bits { + my ($s, $field_name) = @_; + my @bits = split('', unpack('B*', $s)); + my %h; + foreach (@{$subfields{$field_name}}) { + my ($size, $field) = @$_; + my @l = ('0' x (8 - $size), splice(@bits, 0, $size)); + if ($field && $field !~ /^_/){ + $h{$field} = unpack("C", pack('B*', join('', @l))); + # spec: chromacity: 0.xyz: white_point see color_characteristics + if ($h{$field} && $field_name eq 'color_characteristics'){ + $h{$field} = ($field =~ /_[xy]$/) ? sprintf('%0.3f',$h{$field}/255) : [@l[1..8]]; + } + } + } + \%h; +} + +sub _build_detailed_timing { + my ($pixel_clock, $vv) = @_; + my $h = _get_many_bits($vv, 'detailed_timing'); + $h->{pixel_clock} = $pixel_clock / 100; # to have it in MHz + my %detailed_timing_field_size = map { $_->[1], $_->[0] } @{$subfields{detailed_timing}}; + foreach my $field (keys %detailed_timing_field_size) { + $field =~ s/_hi$// or next; + my $hi = delete($h->{$field . '_hi'}); + $h->{$field} += $hi << $detailed_timing_field_size{$field}; + } + $h; +} + +sub _add_standard_timing_modes { + my ($edid, $v) = @_; + my @aspect2ratio = ( + $edid->{edid_version} > 1 || $edid->{edid_revision} > 2 ? '16/10' : '1/1', + '4/3', '5/4', '16/9', + ); + $v = [ map { + my $h = _get_many_bits($_, 'standard_timing'); + $h->{X} = ($h->{X} + 31) * 8; + if ($_ ne "\x20\x20" && $h->{X} > 256){ # cf VALID_TIMING in Xorg edid.h + $h->{vfreq} += 60; + if ($h->{ratio} = $aspect2ratio[$h->{aspect}]){ + delete $h->{aspect}; + $h->{Y} = $h->{X} / eval($h->{ratio}); + } + $h; + } + else { () } + } unpack('a2' x (length($v) / 2), $v) ]; + $v; +} + +sub parse_edid { + eval $start if $b_log; + my ($raw_edid, $verbose) = @_; + my (%edid, @warnings); + my ($main_edid, @eedid_blocks) = unpack("a128" x (length($raw_edid) / 128), $raw_edid); + my @vals = unpack(join('', map { $_->[0] } @edid_info), $main_edid); + my $i = 0; + foreach (@edid_info) { + my ($field, $v) = ($_->[1], $vals[$i++]); + if ($field eq 'year'){ + $v += 1990; + } + elsif ($field eq 'manufacturer_name'){ + my $h = _get_many_bits($v, 'manufacturer_name'); + $v = join('', map { chr(ord('A') + $h->{$_} - 1) } 1 .. 3); + $v = "" if $v eq "@@@"; + $edid{'manufacturer_name_nice'} = ($v && $vendors{$v}) ? $vendors{$v} : ''; + } + elsif ($field eq 'video_input_definition'){ + $v = _get_many_bits($v, 'video_input_definition'); + } + elsif ($field eq 'feature_support'){ + $v = _get_many_bits($v, 'feature_support'); + } + elsif ($field eq 'color_characteristics'){ + $v = _get_many_bits($v, 'color_characteristics'); + } + elsif ($field eq 'established_timings'){ + my $h = _get_many_bits($v, 'established_timings'); + $v = [ + sort { $a->{X} <=> $b->{X} || $a->{vfreq} <=> $b->{vfreq} } + map { /(\d+)x(\d+)_(\d+)(i?)/ ? { X => $1, Y => $2, vfreq => $3, $4 ? (interlace => 1) : () } : () } + grep { $h->{$_} } keys %$h ]; + } + elsif ($field eq 'standard_timings'){ + $v = _add_standard_timing_modes(\%edid, $v); + } + elsif ($field eq 'monitor_details'){ + while ($v){ + (my $pixel_clock, my $vv, $v) = unpack("v a16 a*", $v); + if ($pixel_clock){ + # detailed timing + my $h = _build_detailed_timing($pixel_clock, $vv); + push @{$edid{detailed_timings}}, $h + if $h->{horizontal_active} > 1 && $h->{vertical_active} > 1; + } + else { + (my $flag, $vv) = unpack("n x a*", $vv); + if ($flag == 0xfd){ + # range + $edid{monitor_range} = _get_many_bits($vv, 'monitor_range'); + if ($edid{monitor_range}{pixel_clock_max} == 0xff){ + delete $edid{monitor_range}{pixel_clock_max}; + } + else { + $edid{monitor_range}{pixel_clock_max} *= 10; #- to have it in MHz + } + } + elsif ($flag == 0xf){ + my $range = _get_many_bits($vv, 'manufacturer_specified_range_timing'); + my $e = $edid{detailed_timings}[0]; + my $valid = 1; + foreach my $m ('min', 'max') { + my %total; + foreach my $dir ('horizontal', 'vertical'){ + $range->{$dir . '_sync_pulse_width_' . $m} *= 2; + $range->{$dir . '_back_porch_' . $m} *= 2; + $range->{$dir . '_blanking_' . $m} *= 2; + if ($e && $e->{$dir . '_active'} + && _within_limit($e->{$dir . '_blanking'}, $m, $range->{$dir . '_blanking_' . $m}) + && _within_limit($e->{$dir . '_sync_pulse_width'}, $m, $range->{$dir . '_sync_pulse_width_' . $m}) + && _within_limit($e->{$dir . '_blanking'} - $e->{$dir . '_sync_offset'} - $e->{$dir . '_sync_pulse_width'}, + $m, $range->{$dir . '_back_porch_' . $m})){ + $total{$dir} = $e->{$dir . '_active'} + $range->{$dir . '_blanking_' . $m}; + } + } + if ($total{horizontal} && $total{vertical}){ + my $hfreq = $e->{pixel_clock} * 1000 / $total{horizontal}; + my $vfreq = $hfreq * 1000 / $total{vertical}; + $range->{'horizontal_' . ($m eq 'min' ? 'max' : 'min')} = _round($hfreq); + $range->{'vertical_' . ($m eq 'min' ? 'max' : 'min')} = _round($vfreq); + } + else { + $valid = 0; + } + } + $edid{$valid ? 'monitor_range' : 'manufacturer_specified_range_timing'} = $range; + } + elsif ($flag == 0xfa){ + push @{$edid{standard_timings}}, _add_standard_timing_modes(\%edid, unpack('a12', $vv)); + } + elsif ($flag == 0xfc){ + my $prev = $edid{monitor_name}; + $edid{monitor_name} = ($prev ? "$prev " : '') . unpack('A13', $vv); + } + elsif ($flag == 0xfe){ + push @{$edid{monitor_text}}, unpack('A13', $vv); + } + elsif ($flag == 0xff){ + push @{$edid{serial_number2}}, unpack('A13', $vv); + } + elsif ($vv ne "\0" x 13 && $vv ne " " x 13){ + push(@warnings, "parse_edid: unknown flag $flag"); + warn "$warnings[-1]\n" if $verbose; + } + } + } + } + $edid{$field} = $v if $field && $field !~ /^_/; + } + foreach (@eedid_blocks){ + my ($tag, $v) = unpack("C a*", $_); + if ($tag == 0x02){ # CEA EDID + my $dtd_offset; + ($dtd_offset, $v) = unpack("x C x a*", $v); + next if $dtd_offset < 4; + $dtd_offset -= 4; + while ($dtd_offset > 0){ + if (!$v){ + push(@warnings, "parse_edid: DTD offset outside of available data"); + warn "$warnings[-1]\n" if $verbose; + last; + } + my $h = _get_many_bits($v, 'cea_data_block_collection'); + $dtd_offset -= $h->{size} + 1; + my $vv; + ($vv, $v) = unpack("x a$h->{size} a*", $v); + if ($h->{type} == 0x02){ # Video Data Block + my @vmodes = unpack("a" x $h->{size}, $vv); + foreach my $vmode (@vmodes){ + $h = _get_many_bits($vmode, 'cea_video_data_block'); + my $cea_mode = $cea_video_modes[$h->{mode} - 1]; + if (!$cea_mode){ + push(@warnings, "parse_edid: unhandled CEA mode $h->{mode}"); + warn "$warnings[-1]\n" if $verbose; + next; + } + my %det_mode = (source => 'cea_vdb'); + @det_mode{@cea_video_mode_to_detailed_timing} = @$cea_mode; + push @{$edid{detailed_timings}}, \%det_mode; + } + } + } + while (length($v) >= 18){ + (my $pixel_clock, my $vv, $v) = unpack("v a16 a*", $v); + last if !$pixel_clock; + my $h = _build_detailed_timing($pixel_clock, $vv); + push @{$edid{detailed_timings}}, $h + if $h->{horizontal_active} > 1 && $h->{vertical_active} > 1; + } + } + else { + push(@warnings, "parse_edid: unknown tag $tag"); + warn "$warnings[-1]\n" if $verbose; + } + } + $edid{max_size_precision} = 'cm'; + if ($edid{product_code}){ + $edid{product_code_h} = sprintf('%04x', $edid{product_code}); + if ($edid{manufacturer_name}){ + $edid{EISA_ID} = $edid{manufacturer_name} . $edid{product_code_h}; + } + $edid{product_code_h} = '0x'. $edid{product_code_h}; + } + if ($edid{monitor_range}){ + $edid{HorizSync} = $edid{monitor_range}{horizontal_min} . '-' . $edid{monitor_range}{horizontal_max}; + $edid{VertRefresh} = $edid{monitor_range}{vertical_min} . '-' . $edid{monitor_range}{vertical_max}; + } + if ($edid{max_size_vertical}){ + $edid{ratio} = $edid{max_size_horizontal} / $edid{max_size_vertical}; + $edid{ratio_name} = _ratio_name($edid{max_size_horizontal}, $edid{max_size_vertical}, 'cm'); + $edid{ratio_precision} = 'cm'; + } + if ($edid{feature_support}{has_preferred_timing} && $edid{detailed_timings}[0]){ + $edid{detailed_timings}[0]{preferred} = 1; + } + foreach my $h (@{$edid{detailed_timings}}){ + # EDID standard is ambiguous on how interlaced modes should be + # specified; workaround clearly broken modes: + if ($h->{interlaced}){ + foreach ("720x480", "1440x480", "2880x480", "720x576", "1440x576", "2880x576", "1920x1080"){ + if ($_ eq $h->{horizontal_active} . 'x' . $h->{vertical_active} * 2){ + $h->{vertical_active} *= 2; + $h->{vertical_blanking} *= 2; + $h->{vertical_sync_offset} *= 2; + $h->{vertical_sync_pulse_width} *= 2; + $h->{vertical_blanking} |= 1; + } + } + } + # if the mm size given in the detailed_timing is not far from the cm size + # put it as a more precise cm size + my %in_cm = ( + horizontal => _define($h->{horizontal_image_size}) / 10, + vertical => _define($h->{vertical_image_size}) / 10, + ); + my ($error) = sort { $b <=> $a } map { abs($edid{'max_size_' . $_} - $in_cm{$_}) } keys %in_cm; + if ($error <= 0.5){ + $edid{'max_size_' . $_} = $in_cm{$_} foreach keys %in_cm; + $edid{max_size_precision} = 'mm'; + } + if ($error < 1 && $in_cm{vertical}){ + # using it for the ratio + $edid{ratio} = $in_cm{horizontal} / $in_cm{vertical}; + $edid{ratio_name} = _ratio_name($in_cm{horizontal}, $in_cm{vertical}, 'mm'); + $edid{ratio_precision} = 'mm'; + } + if ($edid{ratio_precision} && + abs($edid{ratio} - $h->{horizontal_active} / $h->{vertical_active}) > ($edid{ratio_precision} eq 'mm' ? 0.02 : 0.2)){ + $h->{bad_ratio} = 1; + } + if ($edid{ratio_name}){ + $edid{ratios} = $edid{ratio_name}; + $edid{ratios} =~ s|/|:|g; + $edid{ratios} = [split(/ or /, $edid{ratios})]; # "3/2 or 16/10" + } + if ($edid{max_size_vertical}){ + $h->{vertical_dpi} = $h->{vertical_active} / $edid{max_size_vertical} * 2.54; + } + if ($edid{max_size_horizontal}){ + $h->{horizontal_dpi} = $h->{horizontal_active} / $edid{max_size_horizontal} * 2.54; + } + if ($h->{horizontal_image_size}){ + $h->{horizontal_image_size_i} = sprintf('%.2f',($h->{horizontal_image_size}/25.4)) + 0; + } + if ($h->{vertical_image_size}){ + $h->{vertical_image_size_i} = sprintf('%.2f',($h->{vertical_image_size}/25.4)) + 0; + } + my $dpi_string = ''; + if ($h->{vertical_dpi} && $h->{horizontal_dpi}){ + $dpi_string = + abs($h->{vertical_dpi} / $h->{horizontal_dpi} - 1) < 0.05 ? + sprintf("%d dpi", $h->{horizontal_dpi}) : + sprintf("%dx%d dpi", $h->{horizontal_dpi}, $h->{vertical_dpi}); + } + my $horizontal_total = $h->{horizontal_active} + $h->{horizontal_blanking}; + my $vertical_total = $h->{vertical_active} + $h->{vertical_blanking}; + no warnings 'uninitialized'; + $h->{ModeLine_comment} = sprintf(qq(# Monitor %s%s modeline (%.1f Hz vsync, %.1f kHz hsync, %sratio %s%s)), + $h->{preferred} ? "preferred" : "supported", + $h->{source} eq 'cea_vdb' ? " CEA" : '', + $h->{pixel_clock} / $horizontal_total / $vertical_total * 1000 * 1000 * ($h->{interlaced} ? 2 : 1), + $h->{pixel_clock} / $horizontal_total * 1000, + $h->{interlaced} ? "interlaced, " : '', + _nearest_ratio($h->{horizontal_active} / $h->{vertical_active}, 0.01) || sprintf("%.2f", $h->{horizontal_active} / $h->{vertical_active}), + $dpi_string ? ", $dpi_string" : ''); + + $h->{ModeLine} = sprintf(qq("%dx%d" $h->{pixel_clock} %d %d %d %d %d %d %d %d %shsync %svsync%s), + $h->{horizontal_active}, $h->{vertical_active}, + $h->{horizontal_active}, + $h->{horizontal_active} + $h->{horizontal_sync_offset}, + $h->{horizontal_active} + $h->{horizontal_sync_offset} + $h->{horizontal_sync_pulse_width}, + $horizontal_total, + $h->{vertical_active}, + $h->{vertical_active} + $h->{vertical_sync_offset}, + $h->{vertical_active} + $h->{vertical_sync_offset} + $h->{vertical_sync_pulse_width}, + $vertical_total, + $h->{horizontal_sync_positive} ? '+' : '-', + $h->{vertical_sync_positive} ? '+' : '-', + $h->{interlaced} ? ' Interlace' : ''); + } + $edid{diagonal_size} = sqrt(_sqr($edid{max_size_horizontal}) + _sqr($edid{max_size_vertical})) / 2.54; + # we want to use null data found tests so only return errors/warnings if + # %edid or if verbose, since then we want to know no matter what. + if (%edid || $verbose){ + _edid_errors(\%edid); + $edid{edid_warnings} = \@warnings if @warnings; + } + eval $end if $b_log; + \%edid; +} + +sub _edid_errors { + my $edid = shift @_; + if (!defined $edid->{edid_version}){ + _edid_error($edid,'edid-version','undefined'); + } + elsif ($edid->{edid_version} < 1 || $edid->{edid_version} > 2){ + _edid_error($edid,'edid-version',$edid->{edid_version}); + } + if (!defined $edid->{edid_revision}){ + _edid_error($edid,'edid-revision','undefined'); + } + elsif ($edid->{edid_revision} == 0xff){ + _edid_error($edid,'edid-revision',$edid->{edid_revision}); + } + if ($edid->{monitor_range}){ + if (!$edid->{monitor_range}{horizontal_min}){ + _edid_error($edid,'edid-sync','no horizontal'); + } + elsif ($edid->{monitor_range}{horizontal_min} > $edid->{monitor_range}{horizontal_max}){ + _edid_error($edid,'edid-sync', + "bad horizontal values: min: $edid->{monitor_range}{horizontal_min} max: $edid->{monitor_range}{horizontal_max}"); + } + if (!$edid->{monitor_range}{vertical_min}){ + _edid_error($edid,'edid-sync','no vertical'); + } + elsif ($edid->{monitor_range}{vertical_min} > $edid->{monitor_range}{vertical_max}){ + _edid_error($edid,'edid-sync', + "bad vertical values: min: $edid->{monitor_range}{vertical_min} max: $edid->{monitor_range}{vertical_max}"); + } + } +} + +sub _edid_error { + my ($edid,$error,$data) = @_; + $edid->{edid_errors} = [] if !$edid->{edid_errors}; + push(@{$edid->{edid_errors}},main::message($error,$data)); +} + +sub _nearest_ratio { + my ($ratio, $max_error) = @_; + my @sorted = + sort { $a->[1] <=> $b->[1] } + map { + my $error = abs($ratio - eval($_)); + $error > $max_error ? () : [ $_, $error ]; + } @known_ratios; + $sorted[0][0]; +} + +sub _ratio_name { + my ($horizontal, $vertical, $precision) = @_; + if ($precision eq 'mm'){ + _nearest_ratio($horizontal / $vertical, 0.1); + } + else { + my $error = 0.5; + my $ratio1 = _nearest_ratio(($horizontal + $error) / ($vertical - $error), 0.2); + my $ratio2 = _nearest_ratio(($horizontal - $error) / ($vertical + $error), 0.2); + $ratio1 && $ratio2 or return; + if ($ratio1 eq $ratio2){ + $ratio1; + } + else { + my $ratio = _nearest_ratio($horizontal / $vertical, 0.2); + join(' or ', $ratio, $ratio eq $ratio1 ? $ratio2 : $ratio1); + } + } +} + +sub _define { + defined $_[0] ? $_[0] : 0; +} + +sub _sqr { + $_[0] * $_[0]; +} + +sub _round { + int($_[0] + 0.5); +} +} + +## PartitionData ## +# public methods: set(), get() +# for /proc/partitions only, see DiskDataBSD for BSD partition data. +{ +package PartitionData; + +sub set { + my ($type) = @_; + $loaded{'partition-data'} = 1; + if (my $file = $system_files{'proc-partitions'}){ + proc_data($file); + } +} + +# args: 0: partition name, without /dev, like sda1, sde +sub get { + eval $start if $b_log; + my $item = $_[0]; + return if !@proc_partitions; + my $result; + foreach my $device (@proc_partitions){ + if ($device->[3] eq $item){ + $result = $device; + last; + } + } + eval $start if $b_log; + return ($result) ? $result : []; +} + +sub proc_data { + eval $start if $b_log; + my $file = $_[0]; + if ($fake{'partitions'}){ + # $file = "$fake_data_dir/block-devices/proc-partitions/proc-partitions-1.txt"; + } + my @parts = main::reader($file,'strip'); + # print Data::Dumper::Dumper \@parts; + shift @parts if @parts; # get rid of headers + for (@parts){ + my @temp = split(/\s+/, $_); + next if !defined $temp[2]; + push (@proc_partitions,[$temp[0],$temp[1],$temp[2],$temp[3]]); + } + eval $end if $b_log; +} +} + +# args: 0: pci device string; 1: pci cleaned subsystem string +sub get_pci_vendor { + eval $start if $b_log; + my ($device, $subsystem) = @_; + return if !$subsystem; + my ($vendor,$sep) = ('',''); + # get rid of any [({ type characters that will make regex fail + # and similar matches show as non-match + my @data = split(/\s+/, clean_regex($subsystem)); + foreach my $word (@data){ + # AMD Tahiti PRO [Radeon HD 7950/8950 OEM / R9 280] + # PC Partner Limited / Sapphire Technology Tahiti PRO [Radeon HD 7950/8950 OEM / R9 280] + # $word =~ s/(\+|\$|\?|\^|\*)/\\$1/g; + if (length($word) == 1 || $device !~ m|\b\Q$word\E\b|i){ + $vendor .= $sep . $word; + $sep = ' '; + } + else { + last; + } + } + # just in case we had a standalone last character after done + $vendor =~ s| [/\(\[\{a\.,-]$|| if $vendor; + eval $end if $b_log; + return $vendor; +} + +# $rows, $num by ref. +sub get_pcie_data { + eval $start if $b_log; + my ($bus_id,$j,$rows,$num,$type) = @_; + $type ||= ''; + # see also /sys/class/drm/ + my $path_start = '/sys/bus/pci/devices/0000:'; + return if !$bus_id || ! -d $path_start . $bus_id; + $path_start .= $bus_id; + my $path = $path_start . '/{max_link_width,current_link_width,max_link_speed'; + $path .= ',current_link_speed}'; + my @files = globber($path); + if ($type eq 'gpu'){ + $path = $path_start . '/0000*/0000*/{mem_info_vram_used,mem_info_vram_total}'; + push(@files,globber($path)); + } + # print @files,"\n"; + return if !@files; + my (%data,$name); + my %gen = ( + '2.5 GT/s' => 1, + '5 GT/s' => 2, + '8 GT/s' => 3, + '16 GT/s' => 4, + '32 GT/s' => 5, + '64 GT/s' => 6, + ); + foreach (@files){ + if (-r $_){ + $name = $_; + $name =~ s|^/.*/||; + $data{$name} = reader($_,'strip',0); + if ($name eq 'max_link_speed' || $name eq 'current_link_speed'){ + $data{$name} =~ s/\.0\b| PCIe$//g; # trim .0 off in 5.0, 8.0 + } + } + } + # print Data::Dumper::Dumper \%data; + # Maximum PCIe Bandwidth = SPEED * WIDTH * (1 - ENCODING) - 1Gb/s. + if ($data{'current_link_speed'} && $data{'current_link_width'}){ + $$rows[$j]->{key($$num++,1,2,'pcie')} = ''; + if ($b_admin && $gen{$data{'current_link_speed'}}){ + $$rows[$j]{key($$num++,0,3,'gen')} = $gen{$data{'current_link_speed'}}; + } + $$rows[$j]{key($$num++,0,3,'speed')} = $data{'current_link_speed'}; + $$rows[$j]->{key($$num++,0,3,'lanes')} = $data{'current_link_width'}; + if ($b_admin && (($data{'max_link_speed'} && + $data{'max_link_speed'} ne $data{'current_link_speed'}) || + ($data{'max_link_width'} && + $data{'max_link_width'} ne $data{'current_link_width'}))){ + $$rows[$j]->{key($$num++,1,3,'link-max')} = ''; + if ($data{'max_link_speed'} && + $data{'max_link_speed'} ne $data{'current_link_speed'}){ + $$rows[$j]{key($$num++,0,4,'gen')} = $gen{$data{'max_link_speed'}}; + $$rows[$j]->{key($$num++,0,4,'speed')} = $data{'max_link_speed'}; + } + if ($data{'max_link_width'} && + $data{'max_link_width'} ne $data{'current_link_width'}){ + $$rows[$j]->{key($$num++,0,4,'lanes')} = $data{'max_link_width'}; + } + } + } + if ($type eq 'gpu' && $data{'mem_info_vram_used'} && $data{'mem_info_vram_total'}){ + $$rows[$j]->{key($$num++,1,2,'vram')} = ''; + $$rows[$j]->{key($$num++,0,3,'total')} = get_size($data{'mem_info_vram_total'}/1024,'string'); + my $used = get_size($data{'mem_info_vram_used'}/1024,'string'); + $used .= ' (' . sprintf('%0.1f',($data{'mem_info_vram_used'}/$data{'mem_info_vram_total'}*100)) . '%)'; + $$rows[$j]->{key($$num++,0,3,'used')} = $used; + + } + eval $end if $b_log; +} + +## PowerData ## +# public method: get() +# No BSD support currently. Test by !$bsd_type. Should any BSD data source +# appear, make bsd_data() and add $bsd_type switch here, remove from caller. +{ +package PowerData; +my $power = {}; + +# args: 0: $power by ref +sub get { + eval $start if $b_log; + sys_data(); + eval $end if $b_log; + return $power; +} + +sub sys_data { + eval $start if $b_log; + # Some systems also report > 1 wakeup events per wakeup with + # /sys/power/wakeup_count, thus, we are using /sys/power/suspend_stats/success + # which does not appear to have that issue. There is more info in suspend_stats + # which we might think of using, particularly fail events, which can be useful. + # this increments on suspend, but you can't see it until wake, numbers work. + # note: seen android instance where reading file wakeup_count hangs endlessly. + my %files = ('suspend-resumes' => '/sys/power/suspend_stats/success'); + if ($extra > 2){ + $files{'hibernate'} = '/sys/power/disk'; + $files{'hibernate-image-size'} = '/sys/power/image_size'; + $files{'suspend'} = '/sys/power/mem_sleep'; + $files{'suspend-fails'} = '/sys/power/suspend_stats/fail'; + $files{'states-avail'} = '/sys/power/state'; + } + foreach (sort keys %files){ + if (-r $files{$_}){ + $power->{$_} = main::reader($files{$_}, 'strip', 0); + if ($_ eq 'states-avail'){ + $power->{$_} =~ s/\s+/,/g if $power->{$_}; + } + # seen: s2idle [deep] OR [s2idle] deep OR s2idle shallow [deep] + elsif ($_ eq 'hibernate' || $_ eq 'suspend'){ + # [item] is currently selected/active option + if ($power->{$_}){ + if ($power->{$_} =~ /\[([^\]]+)\]/){ + $power->{$_ . '-active'} = $1; + $power->{$_} =~ s/\[$1\]//; + $power->{$_} =~ s/^\s+|\s+$//g; + } + # some of these can get pretty long, so handle with make_list_value + if ($power->{$_}){ + main::make_list_value([split(/\s+/,$power->{$_})],\$power->{$_},','); + $power->{$_ . '-avail'} = $power->{$_}; + } + } + } + # size is in bytes + elsif ($_ eq 'hibernate-image-size'){ + $power->{$_} = main::get_size(($power->{$_}/1024),'string') if defined $power->{$_}; + } + } + } + print 'power: ', Data::Dumper::Dumper $power if $dbg[58]; + main::log_data('dump','$power',$power) if $b_log; + eval $end if $b_log; +} +} + +# ProgramData ## +# public methods: +# full(): returns (print name, version nu, [full version data output]). +# values(): returns program values array +# version(): returns program version number +{ +package ProgramData; +my $output; + +# returns array of: 0: program print name 1: program version +# args: 0: program values ID [usually program name]; +# 1: program alternate name, or path [allows for running different command]; +# 2: $extra level. Note that StartClient runs BEFORE -x levels are set!; +# 3: [array ref/undef] return full version output block +# Only use this function when you only need the name/version data returned +sub full { + eval $start if $b_log; + my ($values_id,$version_id,$level,$b_return_full) = @_; + my @full; + $level = 0 if !$level; + # print "val_id: $values_id ver_id:$version_id lev:$level ex:$extra\n"; + ProgramData::set_values() if !$loaded{'program-values'}; + $version_id = $values_id if !$version_id; + if (my $values = $program_values{$values_id}){ + $full[0] = $values->[3]; + # programs that have no version method return 0 0 for index 1 and 2 + if ($extra >= $level && $values->[1] && $values->[2]){ + $full[1] = version($version_id,$values->[0],$values->[1],$values->[2], + $values->[5],$values->[6],$values->[7],$values->[8]); + } + } + # should never trip since program should be whitelist, but mistakes happen! + $full[0] ||= $values_id; + $full[1] ||= ''; + $full[2] = $output if $b_return_full; + eval $end if $b_log; + return @full; +} + +# It's almost 1000 times slower to load these each time values() is called!! +# %program_values: key: desktop/app command for --version => [0: search string; +# 1: space print number; 2: [optional] version arg: -v, version, etc; +# 3: print name; 4: console 0/1; +# 5: [optional] exit first line 0/1 [alt: if version=file replace value with \s]; +# 6: [optional] 0/1 stderr output; 7: replace regex; 8: extra data] +sub set_values { + $loaded{'program-values'} = 1; + %program_values = ( + ## Clients (IRC,chat) ## + 'bitchx' => ['bitchx',2,'','BitchX',1,0,0,'',''],# special + 'finch' => ['finch',2,'-v','Finch',1,1,0,'',''], + 'gaim' => ['[0-9.]+',2,'-v','Gaim',0,1,0,'',''], + 'ircii' => ['[0-9.]+',3,'-v','ircII',1,1,0,'',''], + 'irssi' => ['irssi',2,'-v','Irssi',1,1,0,'',''], + 'irssi-text' => ['irssi',2,'-v','Irssi',1,1,0,'',''], + 'konversation' => ['konversation',2,'-v','Konversation',0,0,0,'',''], + 'kopete' => ['Kopete',2,'-v','Kopete',0,0,0,'',''], + 'ksirc' => ['KSirc',2,'-v','KSirc',0,0,0,'',''], + 'kvirc' => ['[0-9.]+',2,'-v','KVIrc',0,0,1,'',''], # special + 'pidgin' => ['[0-9.]+',2,'-v','Pidgin',0,1,0,'',''], + 'quassel' => ['',1,'-v','Quassel [M]',0,0,0,'',''], # special + 'quasselclient' => ['',1,'-v','Quassel',0,0,0,'',''],# special + 'quasselcore' => ['',1,'-v','Quassel (core)',0,0,0,'',''],# special + 'gribble' => ['^Supybot',2,'--version','Gribble',1,0,0,'',''],# special + 'limnoria' => ['^Supybot',2,'--version','Limnoria',1,0,0,'',''],# special + 'supybot' => ['^Supybot',2,'--version','Supybot',1,0,0,'',''],# special + 'weechat' => ['[0-9.]+',1,'-v','WeeChat',1,0,0,'',''], + 'weechat-curses' => ['[0-9.]+',1,'-v','WeeChat',1,0,0,'',''], + 'xchat-gnome' => ['[0-9.]+',2,'-v','X-Chat-Gnome',1,1,0,'',''], + 'xchat' => ['[0-9.]+',2,'-v','X-Chat',1,1,0,'',''], + ## Desktops / wm / compositors ## + '2bwm' => ['^2bwm',0,'0','2bWM',0,1,0,'',''], # unverified/based on mcwm + '3dwm' => ['^3dwm',0,'0','3Dwm',0,1,0,'',''], # unverified + '5dwm' => ['^5dwm',0,'0','5Dwm',0,1,0,'',''], # unverified + '9wm' => ['^9wm',3,'-version','9wm',0,1,0,'',''], + 'aewm' => ['^aewm',3,'--version','aewm',0,1,0,'',''], + 'aewm++' => ['^Version:',2,'-version','aewm++',0,1,0,'',''], + 'afterstep' => ['^afterstep',3,'--version','AfterStep',0,1,0,'',''], + 'amiwm' => ['^amiwm',0,'0','AmiWM',0,1,0,'',''], # no version + 'antiwm' => ['^antiwm',0,'0','AntiWM',0,1,0,'',''], # no version known + 'asc' => ['^asc',0,'0','asc',0,1,0,'',''], + 'awc' => ['^awc',0,'0','awc',0,1,0,'',''], # unverified + 'awesome' => ['^awesome',2,'--version','awesome',0,1,0,'',''], + 'beryl' => ['^beryl',0,'0','Beryl',0,1,0,'',''], # unverified; legacy + 'bismuth' => ['^bismuth',0,'0','Bismuth',0,1,0,'',''], # unverified + 'blackbox' => ['^Blackbox',2,'--version','Blackbox',0,1,0,'',''], + 'bspwm' => ['^\S',1,'-v','bspwm',0,1,0,'',''], + 'budgie-desktop' => ['^budgie-desktop',2,'--version','Budgie',0,1,0,'',''], + 'budgie-wm' => ['^budgie',0,'0','budgie-wm',0,1,0,'',''], + 'cage' => ['^cage',3,'-v','Cage',0,1,0,'',''], + 'cagebreak' => ['^Cagebreak',3,'-v','Cagebreak',0,1,0,'',''], + 'calmwm' => ['^calmwm',0,'0','CalmWM',0,1,0,'',''], # unverified + 'cardboard' => ['^cardboard',0,'0','Cardboard',0,1,0,'',''], # unverified + 'catwm' => ['^catwm',0,'0','catwm',0,1,0,'',''], # unverified + 'cde' => ['^cde',0,'0','CDE',0,1,0,'',''], # unverified + 'chameleonwm' => ['^chameleon',0,'0','ChameleonWM',0,1,0,'',''], # unverified + 'cinnamon' => ['^cinnamon',2,'--version','Cinnamon',0,1,0,'',''], + 'clfswm' => ['^clsfwm',0,'0','clfswm',0,1,0,'',''], # no version + 'comfc' => ['^comfc',0,'0','comfc',0,1,0,'',''], # unverified + 'compiz' => ['^compiz',2,'--version','Compiz',0,1,0,'',''], + 'compton' => ['^\d',1,'--version','Compton',0,1,0,'',''], + 'cosmic-comp' => ['^cosmic-comp',0,'0','cosmic-comp',0,1,0,'',''], # cosmic alpha, no versions + 'cosmic-session' => ['^cosmic-session',0,'0','Cosmic',0,1,0,'',''], # cosmic alpha, no versions + 'ctwm' => ['^\S',1,'-version','ctwm',0,1,0,'',''], + 'cwm' => ['^cwm',0,'0','CWM',0,1,0,'',''], # no version + 'dawn' => ['^dawn',1,'-v','dawn',0,1,1,'^dawn-',''], # to stderr, not verified + 'dcompmgr' => ['^dcompmgr',0,'0','dcompmgr',0,1,0,'',''], # unverified + 'deepin' => ['^Version',2,'file','Deepin',0,100,'=','','/etc/deepin-version'], # special + 'deepin-kwin_wayland' => ['^deepin-kwin',2,'--version','deepin-kwin_wayland',0,1,0,'',''],# + 'deepin-kwin_x11' => ['^deepin-kwin',2,'--version','deepin-kwin_x11',0,1,0,'',''],# + 'deepin-metacity' => ['^metacity',2,'--version','Deepin-Metacity',0,1,0,'',''], + 'deepin-mutter' => ['^mutter',2,'--version','Deepin-Mutter',0,1,0,'',''], + 'deepin-wm' => ['^gala',0,'0','DeepinWM',0,1,0,'',''], # no version + 'draco' => ['^draco',0,'0','Draco',0,1,0,'',''], # no version + 'dusk' => ['^dusk',1,'-v','dusk',0,1,1,'^dusk-',''], # to stderr, not verified + 'dtwm' => ['^dtwm',0,'0','dtwm',0,1,0,'',''],# no version + 'dwc' => ['^dwc',0,'0','dwc',0,1,0,'',''], # unverified + 'dwl' => ['^dwl',1,'-v','dwl',0,1,0,'^dwl-',''], # assume same as dwm + 'dwm' => ['^dwm',1,'-v','dwm',0,1,1,'^dwm-',''], + 'echinus' => ['^echinus',1,'-v','echinus',0,1,1,'',''], # echinus-0.4.9 (c)... + # only listed here for compositor values, version data comes from xprop + 'enlightenment' => ['^enlightenment',0,'0','Enlightenment',0,1,0,'',''], # no version. Starts new + 'epd-wm' => ['^epd-wm',0,'0','epd-wm',0,1,0,'',''], # unverified + 'evilwm' => ['evilwm',3,'-V','evilwm',0,1,0,'',''],# might use full path in match + 'feathers' => ['^feathers',0,'0','feathers',0,1,0,'',''], # unverified + 'fenestra' => ['^fenestra',0,'0','fenestra',0,1,0,'',''], # unverified + 'fireplace' => ['^fireplace',0,'0','fireplace',0,1,0,'',''], # unverified + 'fluxbox' => ['^fluxbox',2,'-v','Fluxbox',0,1,0,'',''], + 'flwm' => ['^flwm',0,'0','FLWM',0,0,1,'',''], # no version + # openbsd changed: version string: [FVWM[[main] Fvwm.. sigh, and outputs to stderr. Why? + 'fvwm' => ['^fvwm',2,'-version','FVWM',0,1,0,'',''], + 'fvwm1' => ['^Fvwm',3,'-version','FVWM1',0,1,1,'',''], + 'fvwm2' => ['^fvwm',2,'--version','FVWM2',0,1,0,'',''], + 'fvwm3' => ['^fvwm',2,'--version','FVWM3',0,1,0,'',''], + 'fvwm95' => ['^fvwm',2,'--version','FVWM95',0,1,1,'',''], + # Note: first line can be: FVWM-Cystal starting... so always use fvwm --version + 'fvwm-crystal' => ['^fvwm',2,'--version','FVWM-Crystal',0,0,0,'',''], # for print name fvwm + 'gala' => ['^gala',2,'--version','gala',0,1,0,'',''], # pantheon wm: can be slow result + 'gamescope' => ['^gamescope',0,'0','Gamescope',0,1,0,'',''], # unverified + 'glass' => ['^glass',3,'-v','Glass',0,1,0,'',''], + 'gnome' => ['^gnome',3,'--version','GNOME',0,1,0,'',''], # no version, print name + 'gnome-about' => ['^gnome',3,'--version','GNOME',0,1,0,'',''], + 'gnome-shell' => ['^gnome',3,'--version','gnome-shell',0,1,0,'',''], + 'greenfield' => ['^greenfield',0,'0','Greenfield',0,1,0,'',''], # unverified + 'grefson' => ['^grefson',0,'0','Grefson',0,1,0,'',''], # unverified + 'hackedbox' => ['^hackedbox',2,'-version','HackedBox',0,1,0,'',''], # unverified, assume blackbox + # note, herbstluftwm when launched with full path returns full path in version string + 'herbstluftwm' => ['herbstluftwm',2,'--version','herbstluftwm',0,1,0,'',''], + 'hikari' => ['^hikari',0,'0','hikari',0,1,0,'',''], # unverified + 'hopalong' => ['^hopalong',0,'0','Hopalong',0,1,0,'',''], # unverified + 'hyprctl' => ['^Tag:',2,'version','Hyprland',0,0,0,'',''], # method to get hyprland version + 'hyprland' => ['^hyprland',0,'0','Hyprland',0,0,0,'',''], # uses hyprctl for version + 'i3' => ['^i3',3,'--version','i3',0,1,0,'',''], + 'icewm' => ['^icewm',2,'--version','IceWM',0,1,0,'',''], + 'inaban' => ['^inaban',0,'0','inaban',0,1,0,'',''], # unverified + 'instantwm' => ['^instantwm',1,'-v','instantWM',0,1,1,'^instantwm-?(instantos-?)?',''], + 'ion3' => ['^ion3',0,'--version','Ion3',0,1,0,'',''], # unverified; also shell called ion + 'japokwm' => ['^japokwm',0,'0','japokwm',0,1,0,'',''], # unverified + 'jbwm' => ['jbwm',3,'-v','JBWM',0,1,0,'',''], # might use full path in match + 'jwm' => ['^jwm',2,'-v','JWM',0,1,0,'',''], + 'kded' => ['^KDE( Development Platform)?:',2,'--version','KDE',0,0,0,'\sDevelopment Platform',''], + 'kded1' => ['^KDE( Development Platform)?:',2,'--version','KDE',0,0,0,'\sDevelopment Platform',''], + 'kded2' => ['^KDE( Development Platform)?:',2,'--version','KDE',0,0,0,'\sDevelopment Platform',''], + 'kded3' => ['^KDE( Development Platform)?:',2,'--version','KDE',0,0,0,'\sDevelopment Platform',''], + 'kded4' => ['^KDE( Development Platform)?:',2,'--version','KDE Plasma',0,0,0,'\sDevelopment Platform',''], + 'kdesktop-trinity' => ['^TDE:',2,'--version','TDE (Trinity)',0,0,0], # kdesktop/twin + 'kiwmi' => ['^kwimi',0,'0','kiwmi',0,1,0,'',''], # unverified + 'ksmcon' => ['^ksmcon',0,'0','ksmcon',0,1,0,'',''],# no version + 'kwin' => ['^kwin',0,'0','kwin',0,1,0,'',''],# no version, same as kde + 'kwin-kde' => ['^kwin',2,'--version','KDE Plasma',0,1,0,'',''],# only for 5+, same as KDE version + 'kwin_wayland' => ['^kwin_wayland',0,'0','kwin_wayland',0,1,0,'',''],# no version, same as kde + 'kwin_x11' => ['^kwin_x11',0,'0','kwin_x11',0,1,0,'',''],# no version, same as kde + 'kwinft' => ['^kwinft',0,'0','KWinFT',0,1,0,'',''], # unverified + 'labwc' => ['^labwc',0,'0','LabWC',0,1,0,'',''], # unverified + 'laikawm' => ['^laikawm',0,'0','LaikaWM',0,1,0,'',''], # unverified + 'larswm' => ['^larswm',2,'-v','larswm',0,1,1,'',''], + 'leftwm' => ['^leftwm',0,'0','LeftWM',0,1,0,'',''],# no version, in CHANGELOG + 'liri' => ['^liri',0,'0','liri',0,1,0,'',''], + 'lipstick' => ['^lipstick',0,'0','Lipstick',0,1,0,'',''], # unverified + 'liri' => ['^liri',0,'0','liri',0,1,0,'',''], # unverified + 'lumina-desktop' => ['^\S',1,'--version','Lumina',0,1,1,'',''], + 'lwm' => ['^lwm',0,'0','lwm',0,1,0,'',''], # no version + 'lxpanel' => ['^lxpanel',2,'--version','LXDE',0,1,0,'',''], + # command: lxqt-panel + 'lxqt-panel' => ['^lxqt-panel',2,'--version','LXQt',0,1,0,'',''], + 'lxqt-session' => ['^lxqt-session',2,'--version','LXQt',0,1,0,'',''], + 'lxqt-variant' => ['^lxqt-panel',0,'0','LXQt-Variant',0,1,0,'',''], + 'lxsession' => ['^lxsession',0,'0','lxsession',0,1,0,'',''], + 'magmawm' => ['^magma',0,'0','MagmaWM',0,1,0,'',''], # unverified + 'mahogany' => ['^mahogany',0,'0','Mahogany',0,1,0,'',''], # unverified, from stumpwm + 'manokwari' => ['^manokwari',0,'0','Manokwari',0,1,0,'',''], + 'marina' => ['^marina',0,'0','Marina',0,1,0,'',''], # unverified + 'marco' => ['^marco',2,'--version','marco',0,1,0,'',''], + 'matchbox' => ['^matchbox',0,'0','Matchbox',0,1,0,'',''], + 'matchbox-window-manager' => ['^matchbox',2,'--help','Matchbox',0,0,0,'',''], + 'mate-about' => ['^MATE[[:space:]]DESKTOP',-1,'--version','MATE',0,1,0,'',''], + # note, mate-session when launched with full path returns full path in version string + 'mate-session' => ['mate-session',-1,'--version','MATE',0,1,0,'',''], + 'maxx' => ['^maxx',0,'0','MaXX',0,1,0,'',''], # unverified, 5Dwm recreation + 'maynard' => ['^maynard',0,'0','maynard',0,1,0,'',''], # unverified + 'maze' => ['^maze',0,'0','Maze',0,1,0,'',''], # unverified + 'mcompositor' => ['^mcompositor',0,'0','MCompositor',0,1,0,'',''], # unverified + 'mcwm' => ['^mcwm',0,'0','mcwm',0,1,0,'',''], # unverified/see 2bwm + 'metacity' => ['^metacity',2,'--version','Metacity',0,1,0,'',''], + 'metisse' => ['^metisse',0,'0','metisse',0,1,0,'',''], + 'mini' => ['^Mini',5,'--version','Mini',0,1,0,'',''], + 'mir' => ['^mir',0,'0','mir',0,1,0,'',''],# unverified + 'miwm' => ['^miwm',0,'0','MIWM',0,1,0,'',''], # no version + 'mlvwm' => ['^mlvwm',3,'--version','MLVWM',0,1,1,'',''], + 'moblin' => ['^moblin',0,'0','moblin',0,1,0,'',''],# unverified + 'moksha' => ['^\S',1,'-version','Moksha',0,1,0,'',''], # v: x.y.z + 'monsterwm' => ['^monsterwm',0,'0','monsterwm',0,1,0,'',''],# unverified + 'motorcar' => ['^motorcar',0,'0','motorcar',0,1,0,'',''],# unverified + 'muffin' => ['^mu(ffin|tter)',2,'--version','Muffin',0,1,0,'',''], + 'musca' => ['^musca',0,'-v','Musca',0,1,0,'',''], # unverified + 'mutter' => ['^mutter',2,'--version','Mutter',0,1,0,'',''], + 'mvwm' => ['^mvwm',0,'0','mvwm',0,1,0,'',''], # unverified + 'mwm' => ['^mwm',0,'0','MWM',0,1,0,'',''],# no version + 'nawm' => ['^nawm',0,'0','nawm',0,1,0,'',''],# unverified + 'newm' => ['^newm',0,'0','newm',0,1,0,'',''], # unverified + 'newm-atha' => ['^newm',0,'0','new-atha',0,1,0,'',''], # unverified + 'niri' => ['^niri',0,'0','niri',0,1,0,'',''], # unverified + 'notion' => ['^.',1,'--version','Notion',0,1,0,'',''], + 'nscde' => ['^(fvwm|nscde)',2,'--version','NsCDE',0,1,0,'',''], + 'nucleus' => ['^nucleus',0,'0','Nucleus',0,1,0,'',''], # unverified + 'openbox' => ['^openbox',2,'--version','Openbox',0,1,0,'',''], + 'orbital' => ['^orbital',0,'0','Orbital',0,1,0,'',''],# unverified + 'orbment' => ['^orbment',0,'0','orbment',0,1,0,'',''], # unverified + 'pantheon' => ['^pantheon',0,'0','Pantheon',0,1,0,'',''],# no version + 'papyros' => ['^papyros',0,'0','papyros',0,1,0,'',''],# no version + 'pekwm' => ['^pekwm',3,'--version','PekWM',0,1,0,'',''], + 'penrose' => ['^penrose',0,'0','Penrose',0,1,0,'',''],# no version? + 'perceptia' => ['^perceptia',0,'0','perceptia',0,1,0,'',''], + 'phoc' => ['^phoc',0,'0','phoc',0,1,0,'',''], # unverified + 'picom' => ['^\S',1,'--version','Picom',0,1,0,'^v',''], + 'pinnacle' => ['^pinnacle',0,'0','Pinnacle',0,1,0,'',''], # unverified + 'plasmashell' => ['^plasmashell',2,'--version','KDE Plasma',0,1,0,'',''], + 'polonium' => ['^polonium',0,'0','polonium',0,1,0,'',''], # unverified + 'pywm' => ['^pywm',0,'0','pywm',0,1,0,'',''], # unverified + 'qtile' => ['^',1,'--version','Qtile',0,1,0,'',''], + 'qvwm' => ['^qvwm',0,'0','qvwm',0,1,0,'',''], # unverified + 'razor-session' => ['^razor',0,'0','Razor-Qt',0,1,0,'',''], + 'ratpoison' => ['^ratpoison',2,'--version','Ratpoison',0,1,0,'',''], + 'river' => ['^river',0,'0','River',0,1,0,'',''], # unverified + 'rootston' => ['^rootston',0,'0','rootston',0,1,0,'',''], # unverified, wlroot ref + 'rustland' => ['^rustland',0,'0','rustland',0,1,0,'',''], # unverified + 'sapphire' => ['^version sapphire',3,'-version','sapphire',0,1,0,'',''], + 'sawfish' => ['^sawfish',3,'--version','Sawfish',0,1,0,'',''], + 'scrotwm' => ['^scrotwm',2,'-v','scrotwm',0,1,1,'welcome to scrotwm',''], + 'simulavr' => ['simulavr^',0,'0','SimulaVR',0,1,0,'',''], # unverified + 'skylight' => ['^skylight',0,'0','Skylight',0,1,0,'',''], # unverified + 'smithay' => ['^smithay',0,'0','Smithay',0,1,0,'',''], # unverified + 'sommelier' => ['^sommelier',0,'0','sommelier',0,1,0,'',''], # unverified + 'snapwm' => ['^snapwm',0,'0','snapwm',0,1,0,'',''], # unverified + 'spectrwm' => ['^spectrwm',2,'-v','spectrwm',0,1,1,'welcome to spectrwm',''], + # out of stump, 2 --version, but in tries to start new wm instance endless hang + 'stumpwm' => ['^SBCL',0,'--version','StumpWM',0,1,0,'',''], # hangs when run in wm + 'subtle' => ['^subtle',2,'--version','subtle',0,1,0,'',''], + 'surfaceflinger' => ['surfaceflinger^',0,'0','SurfaceFlinger',0,1,0,'',''], # unverified, Android + 'sway' => ['^sway',3,'-v','Sway',0,1,0,'',''], + 'swayfx' => ['^swayfx',0,'0','SwayFX',0,1,0,'',''], # unverified, probably same as sway + 'swayfx' => ['^sway',3,'-v','SwayFX',0,1,0,'',''], # not sure if safe + 'swc' => ['^swc',0,'0','swc',0,1,0,'',''], # unverified + 'swvkc' => ['^swvkc',0,'0','swvkc',0,1,0,'',''], # unverified + 'tabby' => ['^tabby',0,'0','Tabby',0,1,0,'',''], # unverified + 'taiwins' => ['^taiwins',0,'0','taiwins',0,1,0,'',''], # unverified + 'tinybox' => ['^tinybox',0,'0','tinybox',0,1,0,'',''], # unverified + 'tinywl' => ['^tinywl',0,'0','TinyWL',0,1,0,'',''], # unverified + 'tinywm' => ['^tinywm',0,'0','TinyWM',0,1,0,'',''], # no version + 'trinkster' => ['^trinkster',0,'0','Trinkster',0,1,0,'',''], # unverified + 'tvtwm' => ['^tvtwm',0,'0','tvtwm',0,1,0,'',''], # unverified + 'twin' => ['^Twin:',2,'--version','Twin',0,0,0,'',''], + 'twm' => ['^twm',0,'0','TWM',0,1,0,'',''], # no version + 'ukui' => ['^ukui-session',2,'--version','UKUI',0,1,0,'',''], + 'ukwm' => ['^ukwm',2,'--version','ukwm',0,1,0,'',''], + 'unagi' => ['^\S',1,'--version','unagi',0,1,0,'',''], + 'unity' => ['^unity',2,'--version','Unity',0,1,0,'',''], + 'unity-system-compositor' => ['^unity-system-compositor',2,'--version', + 'unity-system-compositor (mir)',0,0,0,'',''], + 'uwm' => ['^uwm',0,'0','UWM',0,1,0,'',''], # unverified + 'velox' => ['^velox',0,'0','Velox',0,1,0,'',''], # unverified + 'vimway' => ['^vimway',0,'0','vimway',0,1,0,'',''], # unverified + 'vivarium' => ['^vivarium',0,'0','Vivarium',0,1,0,'',''], # unverified + 'vtwm' => ['^vtwm',0,'0','vtwm',0,1,0,'',''], # no version + 'w9wm' => ['^w9wm',3,'-version','w9wm',0,1,0,'',''], # unverified, fork of 9wm + 'wavy' => ['^wavy',0,'0','wavy',0,1,0,'',''], # unverified + 'waybox' => ['^way',0,'0','waybox',0,1,0,'',''], # unverified + 'waycooler' => ['^way',3,'--version','way-cooler',0,1,0,'',''], + 'way-cooler' => ['^way',3,'--version','way-cooler',0,1,0,'',''], + 'wayfire' => ['^\d',1,'--version','wayfire',0,1,0,'',''], # -version/--version + 'wayhouse' => ['^wayhouse',0,'0','wayhouse',0,1,0,'',''], # unverified + 'waymonad' => ['^waymonad',0,'0','waymonad',0,1,0,'',''], # unverified + 'westeros' => ['^westeros',0,'0','westeros',0,1,0,'',''], # unverified + 'westford' => ['^westford',0,'0','westford',0,1,0,'',''], # unverified + 'weston' => ['^weston',2,'--version','Weston',0,1,0,'',''], + 'windowlab' => ['^windowlab',2,'-about','WindowLab',0,1,0,'',''], + 'windowmaker' => ['^Window\s*Maker',-1,'--version','WindowMaker',0,1,0,'',''], # uses wmaker + 'wingo' => ['^wingo',0,'0','Wingo',0,1,0,'',''], # unverified + 'wio' => ['^wio',0,'0','Wio',0,1,0,'',''], # unverified + 'wio' => ['^wio\+',0,'0','wio+',0,1,0,'',''], # unverified + 'wm2' => ['^wm2',0,'0','wm2',0,1,0,'',''], # no version + 'wmaker' => ['^Window\s*Maker',-1,'--version','WindowMaker',0,1,0,'',''], + 'wmfs' => ['^wmfs',0,'0','WMFS',0,1,0,'',''], # unverified + 'wmfs2' => ['^wmfs',0,'0','WMFS',0,1,0,'',''], # unverified + 'wmii' => ['^wmii',1,'-v','wmii',0,1,0,'^wmii[234]?-',''], # wmii is wmii3 + 'wmii2' => ['^wmii2',1,'--version','wmii2',0,1,0,'^wmii[234]?-',''], + 'wmx' => ['^wmx',0,'0','wmx',0,1,0,'',''], # no version + 'wxrc' => ['^wx',0,'0','',0,1,0,'WXRC',''], # unverified + 'wxrd' => ['^wx',0,'0','',0,1,0,'WXRD',''], # unverified + 'x9wm' => ['^x9wm',3,'-version','x9wm',0,1,0,'',''], # unverified, fork of 9wm + 'xcompmgr' => ['^xcompmgr',0,'0','xcompmgr',0,1,0,'',''], # no version + 'xfce-panel' => ['^xfce-panel',2,'--version','Xfce',0,1,0,'',''], + 'xfce4-panel' => ['^xfce4-panel',2,'--version','Xfce',0,1,0,'',''], + 'xfce5-panel' => ['^xfce5-panel',2,'--version','Xfce',0,1,0,'',''], + 'xfdesktop' => ['xfdesktop\sversion',5,'--version','Xfce',0,1,0,'',''], + # ' This is xfwm4 version 4.16.1 (revision 5f61a84ad) for Xfce 4.16' + 'xfwm' => ['xfwm[3-8]? version',5,'--version','xfwm',0,1,0,'^^\s+',''],# unverified + 'xfwm3' => ['xfwm3? version',5,'--version','xfwm3',0,1,0,'^^\s+',''], # unverified + 'xfwm4' => ['xfwm4? version',5,'--version','xfwm4',0,1,0,'^^\s+',''], + 'xfwm5' => ['xfwm5? version',5,'--version','xfwm5',0,1,0,'^^\s+',''], # unverified + 'xmonad' => ['^xmonad',2,'--version','XMonad',0,1,0,'',''], + 'xuake' => ['^xuake',0,'0','xuake',0,1,0,'',''], # unverified + 'yeahwm' => ['^yeahwm',0,'--version','YeahWM',0,1,0,'',''], # unverified + ## Desktop Toolkits/Frameworks ## + 'efl-version' => ['^\S',1,'--version','EFL',0,1,0,'',''], # any arg returns v + 'gtk-launch' => ['^\S',1,'--version','GTK',0,1,0,'',''], + 'kded-qt' => ['^Qt',2,'--version','Qt',0,0,0,'',''], + # --version: kded5 5.110.0 (frameworks v, not kde) + 'kded5-frameworks' => ['^kded5',2,'--version','frameworks',0,1,0], + 'kded6-frameworks' => ['^kded6',2,'--version','frameworks',0,1,0], + 'kf-config-qt' => ['^^Qt',2,'--version','Qt',0,0,0,'',''], + 'qmake-qt' => ['^Using Qt version',4,'--version','Qt',0,0,0,'',''], + 'qtdiag-qt' => ['^qt',2,'--version','Qt',0,0,0,'',''], + # command: xfdesktop + 'xfdesktop-gtk' => ['Built\swith\sGTK',4,'--version','Gtk',0,0,0,'',''], + ## Display/Login Managers (dm,lm) ## + 'brzdm' => ['^brzdm version',3,'-v','brzdm',0,1,0,'',''], # unverified, slim fork + 'cdm' => ['^cdm',0,'0','CDM',0,1,0,'',''], + # might be xlogin, unknown output for -V + 'clogin' => ['^clogin',0,'-V','clogin',0,1,0,'',''], # unverified, cysco router + 'cosmic-greeter' => ['^cosmic-greeter',0,'0','cosmic-greeter',0,1,0,'',''], # no version, uses greetd + 'elephant-greeter' => ['^elephant',0,'0','elephant-greeter',0,1,0,'',''], # unverified, lightdm greeter + 'elogind' => ['^elogind',0,'0','elogind',0,1,0,'',''], # no version + 'emptty' => ['^emptty',0,'0','EMPTTY',0,1,0,'',''], # unverified + 'entranced' => ['^entrance',0,'0','Entrance',0,1,0,'',''], + 'gdm' => ['^gdm',2,'--version','GDM',0,1,0,'',''], + 'gdm3' => ['^gdm',2,'--version','GDM3',0,1,0,'',''], + 'greetd' => ['^greetd',0,'0','greetd',0,1,0,'',''], # no version + 'kdm' => ['^kdm',0,'0','KDM',0,1,0,'',''], + 'kdm3' => ['^kdm',0,'0','KDM',0,1,0,'',''], + 'kdmctl' => ['^kdm',0,'0','KDM',0,1,0,'',''], + 'ldm' => ['^ldm',0,'0','LDM',0,1,0,'',''], + 'lemurs' => ['^lemurs',0,'0','lemurs',0,1,0,'',''], # unverified + 'lightdm' => ['^lightdm',2,'--version','LightDM',0,1,1,'',''], + 'loginx' => ['^loginx',0,'0','loginx',0,1,0,'',''], # unverified + 'lxdm' => ['^lxdm',0,'0','LXDM',0,1,0,'',''], + 'ly' => ['^ly',3,'--version','Ly',0,1,0,'',''], + 'mdm' => ['^mdm',0,'0','MDM',0,1,0,'',''], + 'mlogind' => ['^mlogind',3,'-v','mlogind',0,1,0,'',''], # unverified, guess. BSD SLiM fork + 'nodm' => ['^nodm',0,'0','nodm',0,1,0,'',''], + 'pcdm' => ['^pcdm',0,'0','PCDM',0,1,0,'',''], + 'qingy' => ['^qingy',0,'0','qingy',0,1,0,'',''], # unverified + 'qtgreet' => ['^qtgreet',0,'0','qtgreet',0,1,0,'',''], # unverified + 'seatd' => ['^seatd',3,'-v','seatd',0,1,0,'',''], + 'sddm' => ['^sddm',0,'0','SDDM',0,1,0,'',''], + 'slick-greeter' => ['^slick',0,'0','slick-greeter',0,1,0,'',''], # unverified, , lightdm greeter + 'slim' => ['slim version',3,'-v','SLiM',0,1,0,'',''], + 'slimski' => ['slimski version',3,'-v','slimski',0,1,0,'',''], # slim fork + 'tbsm' => ['^tbsm',0,'0','tbsm',0,1,0,'',''], # unverified + 'tdm' => ['^tdm',0,'0','TDM',0,1,0,'',''], # could be consold-tdm or tizen dm + 'udm' => ['^udm',0,'0','udm',0,1,0,'',''], + 'wdm' => ['^wdm',0,'0','WINGs DM',0,1,0,'',''], + 'x3dm' => ['^x3dm',0,'0','X3DM',0,1,0,'',''], # unverified + 'xdm' => ['^xdm',0,'0','XDM',0,1,0,'',''], + 'xdmctl' => ['^xdm',0,'0','XDM',0,1,0,'',''],# opensuse/redhat may use this to start real dm + 'xenodm' => ['^xenodm',0,'0','xenodm',0,1,0,'',''], + 'xlogin' => ['^xlogin',0,'-V','xlogin',0,1,0,'',''], # unverified, cysco router + ## Shells - not checked: ion, eshell ## + ## See ShellData::shell_test() for unhandled but known shells + 'ash' => ['',3,'pkg','ash',1,0,0,'',''], # special; dash precursor + 'bash' => ['^GNU[[:space:]]bash',4,'--version','Bash',1,1,0,'',''], + 'cicada' => ['^\s*version',2,'cmd','cicada',1,1,0,'',''], # special + 'csh' => ['^tcsh',2,'--version','csh',1,1,0,'',''], # mapped to tcsh often + 'dash' => ['',3,'pkg','DASH',1,0,0,'',''], # no version, pkg query + 'elvish' => ['^\S',1,'--version','Elvish',1,0,0,'',''], + 'fish' => ['^fish',3,'--version','fish',1,0,0,'',''], + 'fizsh' => ['^fizsh',3,'--version','FIZSH',1,0,0,'',''], + # ksh/lksh/loksh/mksh/posh//pdksh need to print their own $VERSION info + 'ksh' => ['^\S',1,'cmd','ksh',1,0,0,'^(Version|.*KSH)\s*',''], # special + 'ksh93' => ['^\S',1,'cmd','ksh93',1,0,0,'^(Version|.*KSH)\s*',''], # special + 'lksh' => ['^\S',1,'cmd','lksh',1,0,0,'^.*KSH\s*',''], # special + 'loksh' => ['^\S',1,'cmd','loksh',1,0,0,'^.*KSH\s*',''], # special + 'mksh' => ['^\S',1,'cmd','mksh',1,0,0,'^.*KSH\s*',''], # special + 'nash' => ['^nash',0,'0','Nash',1,0,0,'',''], # unverified; rc based [no version] + 'oh' => ['^oh',0,'0','Oh',1,0,0,'',''], # no version yet + 'oil' => ['^Oil',3,'--version','Oil',1,1,0,'',''], # could use cmd $OIL_SHELL + 'osh' => ['^osh',3,'--version','OSH',1,1,0,'',''], # precursor of oil + 'pdksh' => ['^\S',1,'cmd','pdksh',1,0,0,'^.*KSH\s*',''], # special, in ksh family + 'posh' => ['^\S',1,'cmd','posh',1,0,0,'',''], # special, in ksh family + 'tcsh' => ['^tcsh',2,'--version','tcsh',1,1,0,'',''], # enhanced csh + 'xonsh' => ['^xonsh',1,'--version','xonsh',1,0,0,'^xonsh[\/-]',''], + 'yash' => ['^Y',5,'--version','yash',1,0,0,'',''], + 'zsh' => ['^zsh',2,'--version','Zsh',1,0,0,'',''], + ## Sound Servers ## + 'arts' => ['^artsd',2,'-v','aRts',0,1,0,'',''], + 'esound' => ['^Esound',3,'--version','EsounD',0,1,1,'',''], + 'jack' => ['^jackd',3,'--version','JACK',0,1,0,'',''], + 'nas' => ['^Network Audio',5,'-V','NAS',0,1,0,'',''], + 'pipewire' => ['^Compiled with libpipe',4,'--version','PipeWire',0,0,0,'',''], + 'pulseaudio' => ['^pulseaudio',2,'--version','PulseAudio',0,1,0,'',''], + 'roaraudio' => ['^roaraudio',0,'0','RoarAudio',0,1,0,'',''], # no version/unknown? + ## Tools: Compilers ## + # T2 SED clang version 18.1 + # clang version 18.1 + 'clang' => ['clang',2,'--version','clang',1,1,0,'^.*clang',''], + # gcc (Debian 6.3.0-18) 6.3.0 20170516 + # gcc (GCC) 4.2.2 20070831 prerelease [FreeBSD] + 'gcc' => ['^gcc',2,'--version','GCC',1,0,0,'\([^\)]*\)',''], + 'gcc-apple' => ['Apple[[:space:]]LLVM',2,'--version','LLVM',1,0,0,'',''], # not used + 'zigcc' => ['zigcc',0,'0','zigcc',1,1,0,'',''], # unverified + ## Tools: Init ## + 'busybox' => ['busybox',2,'--help','BusyBox',0,1,1,'',''], + # Dinit version 0.15.1. [ends .] + 'dinit' => ['^Dinit',3,'--version','Dinit',0,1,0,'',''], + # version: Epoch Init System 1.0.1 "Sage" + 'epoch' => ['^Epoch',4,'version','Epoch',0,1,0,'',''], + 'finit' => ['^Finit',2,'-v','finit',0,1,0,'',''], + # /sbin/openrc --version: openrc (OpenRC) 0.13 + 'openrc' => ['^openrc',3,'--version','OpenRC',0,1,0,'',''], + # /sbin/rc --version: rc (OpenRC) 0.11.8 (Gentoo Linux) + 'rc' => ['^rc',3,'--version','OpenRC',0,1,0,'',''], + 'shepherd' => ['^shepherd',4,'--version','Shepherd',0,1,0,'',''], + 'systemd' => ['^systemd',2,'--version','systemd',0,1,0,'',''], + 'upstart' => ['upstart',3,'--version','Upstart',0,1,0,'',''], + ## Tools: Miscellaneous ## + 'sudo' => ['^Sudo',3,'-V','Sudo',1,1,0,'',''], # sudo pre 1.7 does not have --version + 'udevadm' => ['^\d{3}',1,'--version','udevadm',0,1,0,'',''], + ## Tools: Package Managers ## + 'guix' => ['^guix',4,'--version','Guix',0,1,0,'',''], # used for distro ID + ); +} + +# returns array of: +# 0: match string; 1: search word number; 2: version string [alt: file]; +# 3: Print name; 4: console 0/1; +# 5: 0/1 exit version loop at 1 [alt: if version=file replace value with \s]; +# 6: 0/1 write to stderr [alt: if version=file, path for file]; +# 7: replace regex for further cleanup; 8: extra data +# note: setting index 1 or 2 to 0 will trip flags to not do version +# args: 0: program lower case name +sub values { + my @values; + ProgramData::set_values() if !$loaded{'program-values'}; + if (defined $program_values{$_[0]}){ + @values = @{$program_values{$_[0]}}; + } + # my $debug = Dumper \@values; + main::log_data('dump','@values',\@values) if $b_log; + return @values; +} + +# args: 0: desktop/app command for --version; 1: search string; +# 2: space print number; 3: [optional] version arg: -v, version, etc; +# 4: [optional] exit 1st line 0/1; 5: [optional] 0/1 stderr output; +# 6: replace regex; 7: extra data +sub version { + eval $start if $b_log; + my ($app,$search,$num,$version,$exit,$stderr,$replace,$extra) = @_; + my ($b_no_space,$cmd,$line); + my $version_nu = ''; + my $count = 0; + my $app_name = $app; + $output = (); + $app_name =~ s%^.*/%%; + # print "app: $app :: appname: $app_name\n"; + $exit ||= 100; # basically don't exit ever + $version ||= '--version'; + # adjust to array index, not human readable + $num-- if (defined $num && $num > 0); + # konvi in particular doesn't like using $ENV{'PATH'} as set, so we need + # to always assign the full path if it hasn't already been done + if ($version ne 'file' && $app !~ /^\//){ + if (my $program = main::check_program($app)){ + $app = $program; + } + else { + main::log_data('data',"$app not found in path.") if $b_log; + return 0; + } + } + if ($version eq 'file'){ + return 0 unless $extra && -r $extra; + $output = main::reader($extra,'strip','ref'); + @$output = map {s/$stderr/ /;$_} @$output if $stderr; # $stderr is the splitter + $cmd = ''; + } + # These will mostly be shells that require running the shell command -c to get info data + elsif ($version eq 'cmd'){ + ($cmd,$b_no_space) = version_cmd($app,$app_name,$extra); + return 0 if !$cmd; + } + # slow: use pkg manager to get version, avoid unless you really want version + elsif ($version eq 'pkg'){ + ($cmd,$search) = version_pkg($app_name); + return 0 if !$cmd; + } + # note, some wm/apps send version info to stderr instead of stdout + elsif ($stderr){ + $cmd = "$app $version 2>&1"; + } + else { + $cmd = "$app $version 2>/dev/null"; + } + # special case, in rare instances version comes from file + if ($version ne 'file'){ + $output = main::grabber($cmd,'','strip','ref'); + } + if ($b_log){ + main::log_data('data',"version: $version num: $num search: $search command: $cmd"); + main::log_data('dump','output',$output); + } + if ($dbg[64]){ + print "::::::::::\nPD::version() cmd: $cmd\noutput:",Data::Dumper::Dumper $output; + } + # sample: dwm-5.8.2, ©.. etc, why no space? who knows. Also get rid of v in number string + # xfce, and other, output has , in it, so dump all commas and parentheses + if ($output && @$output){ + foreach (@$output){ + last if $count == $exit; + if ($_ =~ /$search/i){ + # print "loop: $_ :: num: $num\n"; + $_ =~ s/$replace//i if $replace; + $_ =~ s/\s/_/g if $b_no_space; # needed for some items with version > 1 word + my @data = split(/\s+/, $_); + $version_nu = $data[$num]; + last if !defined $version_nu; + # some distros add their distro name before the version data, which + # breaks version detection. A quick fix attempt is to just add 1 to $num + # to get the next value. + $version_nu = $data[$num+1] if $data[$num+1] && $version_nu =~ /version/i; + $version_nu =~ s/(\([^)]+\)|,|"|\||\(|\)|\.$)//g if $version_nu; + # trim off leading v but only when followed by a number + $version_nu =~ s/^v([0-9])/$1/i if $version_nu; + # print "$version_nu\n"; + last; + } + $count++; + } + } + main::log_data('data',"Program version: $version_nu") if $b_log; + eval $end if $b_log; + return $version_nu; +} +# print version('bash', 'bash', 4) . "\n"; + +# returns ($cmdd, $b_no_space) +# ksh: Version JM 93t+ 2010-03-05 [OR] Version A 2020.0.0 +# mksh: @(#)MIRBSD KSH R56 2018/03/09; lksh/pdksh: @(#)LEGACY KSH R56 2018/03/09 +# loksh: @(#)PD KSH v5.2.14 99/07/13.2; posh: 0.13.2 +sub version_cmd { + eval $start if $b_log; + my ($app,$app_name,$extra) = @_; + my @data = ('',0); + if ($app_name eq 'cicada'){ + $data[0] = $app . ' -c "' . $extra . '" 2>/dev/null';} + elsif ($app_name =~ /^(|l|lo|m|pd)ksh(93)?$/){ + $data[0] = $app . ' -c \'printf %s "$KSH_VERSION"\' 2>/dev/null'; + $data[1] = 1;} + elsif ($app_name eq 'posh'){ + $data[0] = $app . ' -c \'printf %s "$POSH_VERSION"\' 2>/dev/null'} + # print "$data[0] :: $data[1]\n"; + eval $end if $b_log; + return @data; +} + +# returns $cmd, $search +sub version_pkg { + eval $start if $b_log; + my ($app) = @_; + my ($program,@data); + # note: version $num is 3 in dpkg-query/pacman/rpm, which is convenient + if ($program = main::check_program('dpkg-query')){ + $data[0] = "$program -W -f='\${Package}\tversion\t\${Version}\n' $app 2>/dev/null"; + $data[1] = "^$app\\b"; + } + elsif ($program = main::check_program('pacman')){ + $data[0] = "$program -Q --info $app 2>/dev/null"; + $data[1] = '^Version'; + } + elsif ($program = main::check_program('rpm')){ + $data[0] = "$program -qi --nodigest --nosignature $app 2>/dev/null"; + $data[1] = '^Version'; + } + # print "$data[0] :: $data[1]\n"; + eval $end if $b_log; + return @data; +} +} + +## PsData ## +# public methods: +# set(): sets @ps_aux, @ps_cmd +# set_dm(): sets $ps_data{'dm-active'} +# set_de_wm(): sets -S/-G de/wm/comp/tools items +# set_network(): sets -na network services +# set_power(): sets -I $ps_data{'power-services'} +{ +package PsData; + +sub set { + eval $start if $b_log; + my ($b_busybox,$header,$link,$path,$ps,@temp); + $loaded{'ps-data'} = 1; + my $args = 'wwaux'; + # it's possible ps isn't even installed + if ($path = main::check_program('ps')){ + $link = readlink($path); + if ($link && $link =~ /busybox/i){ + $b_busybox = 1; + $args = ''; + } + } + else { + main::log_data('data','No ps installed.') if $b_log; + eval $end if $b_log; + return; + } + # note: some ps cut output based on terminal width, ww sets width unlimited + # old busybox returns error with args, new busybox ignores auxww + $ps = main::grabber("$path $args 2>/dev/null",'','strip','ref'); + if (@$ps){ + $header = shift @$ps; # get rid of header row + # handle busy box, which has 3 columns, regular ps aux has 11 + # avoid deprecated implicit split error in older Perls + @temp = split(/\s+/, $header); + } + else { + main::log_data('data','@$ps is empty.') if $b_log; + eval $end if $b_log; + return; + } + $ps_data{'header'}->[0] = $#temp; # the indexes, not the scalar count + for (my $i = 0; $i <= $#temp; $i++){ + if ($temp[$i] eq 'PID'){ + $ps_data{'header'}->[1] = $i;} + elsif ($temp[$i] eq '%CPU'){ + $ps_data{'header'}->[2] = $i;} + # note: %mem is percent used + elsif ($temp[$i] eq '%MEM'){ + $ps_data{'header'}->[3] = $i;} + elsif ($temp[$i] eq 'RSS'){ + $ps_data{'header'}->[4] = $i;} + } + # we want more data from ps busybox, to get TinyX screen res + my $cols_use = ($b_busybox) ? 7 : 2; + my $pattern = 'brave|chrom(e|ium)|falkon|(fire|water)fox|gvfs|'; + $pattern .= 'konqueror|mariadb|midori|mysql|openvpn|opera|'; + $pattern .= 'pale|postgre|php|qtwebengine|smtp|vivald'; + for (@$ps){ + next if !$_; + next if $self_name eq 'inxi' && /\/$self_name\b/; + # $_ = lc; + push (@ps_aux,$_); + my @split = split(/\s+/, $_); + # slice out COMMAND to last elements of psrows + my $final = $#split; + # some stuff has a lot of data, chrome for example + $final = ($final > ($ps_data{'header'}->[0] + $cols_use)) ? + $ps_data{'header'}->[0] + $cols_use : $final; + # handle case of ps wrapping lines despite ww unlimited width, which + # should NOT be happening, except on busybox ps, which has no ww. + next if !defined $split[$ps_data{'header'}->[0]]; + # we don't want zombie/system/kernel processes, or servers, browsers. + # but we do want network kernel process servers [nfsd] + $split[$ps_data{'header'}->[0]] =~ s/^\[(mld|nfsd)\]/$1/; + if ($split[$ps_data{'header'}->[0]] !~ /^([\[\(]|(\S+\/|)($pattern))/i){ + push(@ps_cmd,join(' ', @split[$ps_data{'header'}->[0] .. $final])); + } + } + # dump multiple instances, just need to see if process running + main::uniq(\@ps_cmd) if @ps_cmd; + # Use $dbg[61] to see @ps_cmd result + eval $end if $b_log; +} + +# only runs when no /run type dm found +sub set_dm { + eval $start if $b_log; + # startx: /bin/sh /usr/bin/startx + process_items(\@{$ps_data{'dm-active'}},join('|',qw(ly startx xinit))); # possible dm values + print '$ps_data{dm-active}: ', Data::Dumper::Dumper $ps_data{'dm-active'} if $dbg[5]; + main::log_data('dump','$ps_data{dm-active}',$ps_data{'dm-active'}) if $b_log; + eval $end if $b_log; +} + +sub set_de_wm { + eval $start if $b_log; + $loaded{'ps-gui'} = 1; + my ($b_de_wm_comp,$b_wm_comp); + # desktops / wm (some wm also compositors) + if ($show{'system'}){ + # some desktops detect via ps as fallback + process_items(\@{$ps_data{'de-ps-detect'}},join('|', qw( + cosmic-session razor-desktop razor-session lxsession lxqt-session nscde + tdelauncher tdeinit_phase1))); + # order matters! + process_items(\@{$ps_data{'wm-parent'}},join('|', qw(xfdesktop icewm fluxbox + blackbox))); + # regular wm + # unverfied: 2bwm catwm mcwm penrose snapwm uwm wmfs wmfs2 wingo wmii2 + process_items(\@{$ps_data{'wm-main'}},join('|', qw(2bwm 9wm + afterstep aewm aewm\+\+ amiwm antiwm awesome + bspwm calmwm catwm cde clfswm ctwm (openbsd-)?cwm + dawn dtwm dusk dwm echinus evilwm flwm flwm_topside + fvwm.*-crystal\S* fvwm1 fvwm2 fvwm3 fvwm95 fvwm + hackedbox herbstluftwm i3 instantwm ion3 jbwm jwm larswm leftwm lwm + matchbox-window-manager maxx mcwm mini miwm mlvwm monsterwm musca mvwm mwm + nawm notion openbox nscde pekwm penrose qvwm ratpoison + sapphire sawfish scrotwm snapwm spectrwm stumpwm subtle tinywm tvtwm twm + uwm vtwm windowlab [wW]indo[mM]aker w9wm wingo wm2 wmfs wmfs2 wmii2 wmii + wmx x9wm xmonad yeahwm))); + $b_wm_comp = 1; + # wm: note that for all but the listed wm, the wm and desktop would be the + # same, particularly with all smaller wayland wm/compositors. + $b_de_wm_comp = 1 if $extra > 1; + } + # compositors (for wayland these are also the server, note). + # for wayland always show, so always load these + if ($show{'graphic'}){ + $b_de_wm_comp = 1; + $b_wm_comp = 1; + process_items(\@{$ps_data{'compositors-pure'}},join('|',qw(cairo compton + cosmic-comp dcompmgr mcompositor picom steamcompmgr surfaceflinger + xcompmgr unagi))); + } + if ($b_de_wm_comp){ + process_items(\@{$ps_data{'de-wm-compositors'}},join('|',qw(budgie-wm compiz + deepin-kwin_wayland deepin-kwin_x11 deepin-wm enlightenment + gala gnome-shell twin kwin_wayland kwin_x11 kwinft kwin marco + deepin-metacity metacity metisse mir moksha muffin deepin-mutter mutter + ukwm xfwm[345]?))); + } + if ($b_wm_comp){ + # x11: 3dwm, qtile [originally], rest wayland + # wayland compositors generally are compositors and wm. + # These will be used globally to avoid having to redo it over and over. + process_items(\@{$ps_data{'wm-compositors'}},join('|',qw(3dwm asc awc bismuth + cage cagebreak cardboard chameleonwm clayland comfc + dwl dwc epd-wm fireplace feathers fenestra glass gamescope greenfield grefson + hikari hopalong [Hh]yprland inaban japokwm kiwmi labwc laikawm lipstick liri + magmawm mahogany marina maze maynard motorcar newm(-atha)? niri nucleus + orbital orbment perceptia phoc pinnacle polonium pywm + qtile river rootston rustland + simulavr skylight smithay sommelier sway swayfx swc swvkc + tabby taiwins tinybox tinywl trinkster velox vimway vivarium + wavy waybox way-?cooler wayfire wayhouse waymonad westeros westford + weston wio\+? wxr[cd] xuake))); + } + # info:/tools: + if ($show{'system'} && $extra > 2){ + process_items(\@{$ps_data{'components-active'}},join('|', qw( + albert alltray awesomebar awn + bar barpanel bbdock bbpager bemenu bipolarbar bmpanel bmpanel2 budgie-panel + cairo-dock dde-dock deskmenu dmenu(-wayland)? dockbarx docker docky dzen dzen2 + fbpanel fspanel fuzzel gmenu glx-dock gnome-panel hpanel hybridbar + i3bar i3-status(-rs|-rust)? icewmtray jgmenu kdocker kicker krunner ksmoothdock + latte latte-dock lavalauncher lemonbar ltpanel luastatus + lxpanel lxqt-panel + matchbox-panel mate-panel mauncher mopag nwg-(bar|dock|launchers|panel) + onagre openbox-menu ourico perlpanel plank polybar pypanel + razor(qt)?-panel rofi rootbar + sfwbar simplepanel sirula some_sorta_bar stalonetray swaybar + taffybar taskbar tint2 tofi trayer ukui-panel ulauncher vala-panel + wapanel waybar wbar wharf wingpanel witray wldash wmdocker wmenu + wmsystemtray wofi xfce[45]?-panel xmobar yambar yabar yofi))); + # Generate tools: power manager daemons, then screensavers/lockers. + # Note that many lockers may not be services + @{$ps_data{'tools-test'}}=qw(away boinc-screensaver budgie-screensaver + cinnamon-screensaver gnome-screensaver gsd-screensaver-proxy gtklock + hyprlock i3lock kscreenlocker light-locker lockscreen lxlock + mate-screensaver nwg-lock + physlock rss-glx slock swayidle swaylock ukui-screensaver unicode-screensaver + waylock xautolock xfce4-screensaver xlock xlockmore xscreensaver + xscreensaver-systemd xsecurelock xss-lock xtrlock); + process_items(\@{$ps_data{'tools-active'}},join('|',@{$ps_data{'tools-test'}})); + } + if ($dbg[63]){ + main::feature_debugger('ps de-wm', + ['compositors-pure:',$ps_data{'compositors-pure'}, + 'de-ps-detect:',$ps_data{'de-ps-detect'}, + 'de-wm-compositors:',$ps_data{'de-wm-compositors'}, + 'wm-main:',$ps_data{'wm-main'}, + 'wm-parent:',$ps_data{'wm-parent'}, + 'wm-compositors:',$ps_data{'wm-compositors'}],$dbg[63]); + } + print '%ps_data: ', Data::Dumper::Dumper \%ps_data if $dbg[5]; + main::log_data('dump','%ps_data',\%ps_data) if $b_log; + eval $end if $b_log; +} + +sub set_network { + eval $start if $b_log; + process_items(\@{$ps_data{'network-services'}},join('|', qw(apache\d? + cC]onn[mM]and? dhcpd dhcpleased fingerd ftpd gated httpd inetd ircd iwd + mld [mM]odem[mM]nager named networkd-dispatcher [nN]etwork[mM]anager nfsd nginx + ntpd proftpd routed smbd sshd systemd-networkd systemd-timesyncd tftpd + wicd wpa_supplicant xinetd xntpd))); + print '$ps_data{network-daemons}: ', Data::Dumper::Dumper $ps_data{'network-services'} if $dbg[5]; + main::log_data('dump','$ps_data{network-daemons}',$ps_data{'network-services'}) if $b_log; + eval $end if $b_log; +} + +sub set_power { + eval $start if $b_log; + process_items(\@{$ps_data{'power-services'}},join('|', qw(apmd csd-power + gnome-power-manager gsd-power kpowersave org\.dracolinux\.power + org_kde_powerdevil mate-power-manager power-profiles-daemon powersaved + system76-power tdepowersave thermald tlp upowerd ukui-power-manager + xfce4-power-manager))); + print '$ps_data{power-daemons}: ', Data::Dumper::Dumper $ps_data{'power-services'} if $dbg[5]; + main::log_data('dump','$ps_data{power-daemons}',$ps_data{'power-services'}) if $b_log; + eval $end if $b_log; +} + +# args: 0: array ref or scalar to become ref; 1: 1: matches pattern +sub process_items { + foreach (@ps_cmd){ + # strip out python/lisp/*sh starters + if (/^(\/\S+?\/(c?lisp|perl|python|[a-z]{0,3}sh)\s+)?(|\S*?\/)($_[1])(:|\s|$)/i){ + push(@{$_[0]},$4) ; # deal with duplicates with uniq + } + } + main::uniq($_[0]) if @{$_[0]} && scalar @{$_[0]} > 1; +} +} + +sub get_self_version { + eval $start if $b_log; + my $patch = $self_patch; + if ($patch ne ''){ + # for cases where it was for example: 00-b1 clean to -b1 + $patch =~ s/^[0]+-?//; + $patch = "-$patch" if $patch; + } + eval $end if $b_log; + return $self_version . $patch; +} + +## ServiceData ## +{ +package ServiceData; +my ($key,$service,$type); + +sub get { + eval $start if $b_log; + ($type,$service) = @_; + my $value; + set() if !$loaded{'service-tool'}; + $key = (keys %service_tool)[0] if %service_tool; + if ($key){ + if ($type eq 'status'){ + $value = process_status(); + } + elsif ($type eq 'tool'){ + $value = $service_tool{$key}->[1]; + } + } + eval $end if $b_log; + return $value; +} + +sub process_status { + eval $start if $b_log; + my ($cmd,$status,@data); + my ($result,$value) = ('',''); + my %translate = ( + 'active' => 'running', + 'down' => 'stopped', + 'fail' => 'not found', + 'failed' => 'not found', + 'inactive' => 'stopped', + 'ok' => 'running', + 'not running' => 'stopped', + 'run' => 'running', + 'started' => 'running', + ); + if ($key eq 'systemctl'){ + $cmd = "$service_tool{$key}->[0] status $service"; + } + # can be /etc/init.d or /etc/rc.d; ghostbsd/gentoo have this + elsif ($key eq 'rc-service'){ + $cmd = "$service_tool{$key}->[0] $service status"; + } + elsif ($key eq 'rcctl'){ + $cmd = "$service_tool{$key}->[0] check $service"; + } + # dragonfly/netbsd/freebsd have this. We prefer service over following since + # if it is present, the assumption is that it is being used, though multi id + # is probably better. + elsif ($key eq 'service'){ + $cmd = "$service_tool{$key}->[0] $service status"; + } + # upstart, legacy, and finit, needs more data + elsif ($key eq 'initctl' || $key eq 'dinitctl'){ + $cmd = "$service_tool{$key}->[0] status $service"; + } + # runit + elsif ($key eq 'sv'){ + $cmd = "$service_tool{$key}->[0] status $service"; + } + # s6: note, shows s6-rc but uses s6-svstat; -n makes human-readable. Needs + # real data samples before adding. + # elsif ($key eq 's6-rc'){ + # $cmd = "$service_tool{$key}->[0] $service"; + # } + # check or status or onestatus (netbsd) + elsif ($key eq 'rc.d'){ + if (-e "$service_tool{$key}->[0]$service"){ + $status = ($bsd_type && $bsd_type =~ /(dragonfly)/) ? 'status' : 'check'; + $cmd = "$service_tool{$key}->[0]$service check"; + } + else { + $result = 'not found'; + } + } + elsif ($key eq 'init.d'){ + if (-e "$service_tool{$key}->[0]$service"){ + $cmd = "$service_tool{$key}->[0]$service status"; + } + else { + $result = 'not found'; + } + } + @data = main::grabber("$cmd 2>&1",'','strip') if $cmd; + # @data = ('bluetooth is running.'); + print "key: $key\n", Data::Dumper::Dumper \@data if $dbg[29]; + main::log_data('dump','service @data',\@data) if $b_log; + for my $row (@data){ + my @working = split(/\s*:\s*/,$row); + ($value) = (''); + # print "$working[0]::$working[1]\n"; + # Loaded: masked (Reason: Unit sddm.service is masked.) + if ($working[0] eq 'Loaded'){ + # note: sshd shows ssh for ssh.service + $working[1] =~ /^(.+?)\s*\(.*?\.service;\s+(\S+?);.*/; + $result = lc($1) if $1; + $result = lc($2) if $2; # this will be enabled/disabled + } + # Active: inactive (dead) + elsif ($working[0] eq 'Active'){ + $working[1] =~ /^(.+?)\s*\((\S+?)\).*/; + $value = lc($1) if $1 && (!$result || $result ne 'disabled'); + $value = $translate{$value} if $value && $translate{$value}; + $result .= ",$value" if ($result && $value); + last; + } + # Status : running + elsif ($working[0] eq 'Status' || $working[0] eq 'State'){ + $result = lc($working[1]); + $result = $translate{$result} if $translate{$result}; + last; + } + # valid syntax, but service does not exist + # * rc-service: service 'ntp' does not exist :: + # dinitctl: service not loaded [whether exists or not] + elsif ($row =~ /$service.*?(not (exist|(be )?found|loaded)|no such (directory|file)|unrecognized)/i){ + $result = 'not found'; + last; + } + # means command directive doesn't exist, we don't know if service exists or not + # * ntpd: unknown function 'disable' :: + elsif ($row =~ /unknown (directive|function)|Usage/i){ + last; + } + # rc-service: * status: started :: * status: stopped, fail handled in not exist test + elsif ($working[0] eq '* status' && $working[1]){ + $result = lc($working[1]); + $result = $translate{$result} if $translate{$result}; + last; + } + ## start exists status detections + elsif ($working[0] =~ /\b$service is ([a-z\s]+?)(\s+as\s.*|\s+\.\.\..*)?\.?$/){ + $result = lc($1); + $result = $translate{$result} if $translate{$result}; + last; + } + # runit sv: run/down/fail - fail means not found + # run: udevd: (pid 631) 641s :: down: sshd: 9s, normally up + elsif ($working[1] && $working[1] eq $service && $working[0] =~ /^([a-z]+)$/){ + $result = lc($1); + $result = $translate{$result} if $translate{$result}; + $result = "enabled,$result" if $working[2] && $working[2] =~ /normally up/i; + } + # OpenBSD: sshd(ok) + elsif ($working[0] =~ /\b$service\s*\(([^\)]+)\)/){ + $result = lc($1); + $result = $translate{$result} if $translate{$result}; + last; + } + } + print "service result: $result\n" if $dbg[29]; + main::log_data('data',"result: $result") if $b_log; + eval $end if $b_log; + return $result; +} + +sub set { + eval $start if $b_log; + $loaded{'service-tool'} = 1; + my ($path); + if ($path = main::check_program('systemctl')){ + # systemctl status ssh :: Loaded: / Active: + %service_tool = ('systemctl' => [$path,'systemctl']); + } + elsif ($path = main::check_program('rc-service')){ + # rc-service ssh status :: * status: stopped + %service_tool = ('rc-service' => [$path,'rc-service']); + } + elsif ($path = main::check_program('rcctl')){ + # rc-service ssh status :: * status: stopped + %service_tool = ('rcctl' => [$path,'rcctl']); + } + elsif ($path = main::check_program('service')){ + # service sshd status + %service_tool = ('service' => [$path,'service']); + } + elsif ($path = main::check_program('sv')){ + %service_tool = ('sv' => [$path,'sv']); + } + # needs data, never seen output, but report if present + elsif ($path = main::check_program('s6-svstat')){ + %service_tool = ('s6-rc' => [$path,'s6-rc']); + } + elsif ($path = main::check_program('dinitctl')){ + %service_tool = ('dinitctl' => [$path,'dinitctl']); + } + # make it last in tools, need more data + elsif ($path = main::check_program('initctl')){ + %service_tool = ('initctl' => [$path,'initctl']); + } + # freebsd does not have 'check', netbsd does not have status + elsif (-d '/etc/rc.d/'){ + # /etc/rc.d/ssh check :: ssh(ok|failed) + %service_tool = ('rc.d' => ['/etc/rc.d/','/etc/rc.d']); + } + elsif (-d '/etc/init.d/'){ + # /etc/init.d/ssh status :: Loaded: loaded (...)/ Active: active (...) + %service_tool = ('init.d' => ['/etc/init.d/','/etc/init.d']); + } + eval $end if $b_log; +} +} +# $dbg[29] = 1; set_path(); print ServiceData::get('status','bluetooth'),"\n"; + +## ShellData ## +{ +package ShellData; +my $b_debug = 0; # disable all debugger output in case forget to comment out! + +# Public. This does not depend on using ps -jfp, open/netbsd do not at this +# point support it, so we only want to use -jp to get parent $ppid set in +# initialize(). shell_launcher will use -f so it only runs in case we got +# $pppid. $client{'pppid'} will be used to trigger launcher tests. If started +# with sshd via ssh user@address 'pinxi -Ia' will show sshd as shell, which is +# fine, that's what it is. +sub set { + eval $start if $b_log; + my (@app,$cmd,$parent,$pppid,$shell); + $loaded{'shell-data'} = 1; + $cmd = "ps -wwp $ppid -o comm= 2>/dev/null"; + $shell = qx($cmd); + # we'll be using these $client pppid/parent values in shell_launcher() + $pppid = $client{'pppid'} = get_pppid($ppid); + $pppid ||= ''; + $client{'pppid'} ||= ''; + # print "sh: $shell\n"; + main::log_data('cmd',$cmd) if $b_log; + chomp($shell); + if ($shell){ + # print "shell pre: $shell\n"; + # when run in debugger subshell, would return sh as shell, + # and parent as perl, that is, pinxi itself, which is actually right. + # trim leading /.../ off just in case. ps -p should return the name, not path + # but at least one user dataset suggests otherwise so just do it for all. + $shell =~ s/^.*\///; + # NOTE: su -c "inxi -F" results in shell being su + # but: su - results in $parent being su + my $i=0; + $parent = $client{'parent'} = parent_name($pppid) if $pppid; + $parent ||= ''; + print "1: shell: $shell $ppid parent: $parent $pppid\n" if $b_debug; + # this will fail in this case: sudo su -c 'inxi -Ia' + if ($shell =~ /^(doas|login|sudo|su)$/){ + $client{'su-start'} = $shell if $shell ne 'login'; + $shell = $parent if $parent; + } + # eg: su to root, then sudo + elsif ($parent && $client{'parent'} =~ /^(doas|sudo|su)$/){ + $client{'su-start'} = $parent; + $parent = ''; + } + print "2: shell: $shell parent: $parent\n" if $b_debug; + my $working = $ENV{'SHELL'}; + if ($working){ + $working =~ s/^.*\///; + # a few manual changes for known + # Note: parent when fizsh shows as zsh but SHELL is fizsh, but other times + # SHELL is default shell, but in zsh, SHELL is default shell, not zfs + if ($shell eq 'zsh' && $working eq 'fizsh'){ + $shell = $working; + } + } + # print "3: shell post: $shell working: $working\n"; + # since there are endless shells, we'll keep a list of non program value + # set shells since there is little point in adding those to program values + if (shell_test($shell)){ + # do nothing, just leave $shell as is + } + # note: not all programs return version data. This may miss unhandled shells! + elsif ((@app = ProgramData::full(lc($shell),lc($shell),1)) && $app[0]){ + $shell = $app[0]; + $client{'version'} = $app[1] if $app[1]; + print "3: app test $shell v: $client{'version'}\n" if $b_debug; + } + else { + # NOTE: we used to guess here with position 2 --version but this cuold lead + # to infinite loops when inxi called from a script 'infos' that is in PATH and + # script does not have any start arg handlers or bad arg handlers: + # eg: shell -> infos -> inxi -> sh -> infos --version -> infos -> inxi... + # Basically here we are hoping that the grandparent is a shell, or at least + # recognized as a known possible program + # print "app not shell?: $shell\n"; + if ($shell){ + print "shell 4: $shell StartClientVersionType: $parent\n" if $b_debug; + if ($parent){ + if (shell_test($parent)){ + $shell = $parent; + } + elsif ((@app = ProgramData::full(lc($parent),lc($parent),0)) && $app[0]){ + $shell = $app[0]; + $client{'version'} = $app[1] if $app[1]; + } + print "shell 5: $shell version: $client{'version'}\n" if $b_debug; + } + } + else { + $client{'version'} = main::message('unknown-shell'); + } + print "6: shell not app version: $client{'version'}\n" if $b_debug; + } + $client{'version'} ||= ''; + $client{'version'} =~ s/(\(.*|-release|-version)// if $client{'version'}; + $shell =~ s/^[\s-]+|[\s-]+$//g if $shell; # sometimes will be like -sh + $client{'name'} = lc($shell); + $client{'name-print'} = $shell; + print "7: shell: $client{'name-print'} version: $client{'version'}\n" if $b_debug; + if ($extra > 2 && $working && lc($shell) ne lc($working)){ + if (@app = ProgramData::full(lc($working))){ + $client{'default-shell'} = $app[0]; + $client{'default-shell-v'} = $app[1]; + $client{'default-shell-v'} =~ s/(\s*\(.*|-release|-version)// if $client{'default-shell-v'}; + } + else { + $client{'default-shell'} = $working; + } + } + } + else { + # last fallback to catch things like busybox shells + if (my $busybox = readlink(main::check_program('sh'))){ + if ($busybox =~ m|busybox$|){ + $client{'name'} = 'ash'; + $client{'name-print'} = 'ash (busybox)'; + } + } + print "8: shell: $client{'name-print'} version: $client{'version'}\n" if $b_debug; + if (!$client{'name'}) { + $client{'name'} = 'shell'; + # handling na here, not on output, so we can test for !$client{'name-print'} + $client{'name-print'} = 'N/A'; + } + } + if (!$client{'su-start'}){ + $client{'su-start'} = 'sudo' if $ENV{'SUDO_USER'}; + $client{'su-start'} = 'doas' if $ENV{'DOAS_USER'}; + } + if ($parent && $parent eq 'login'){ + $client{'su-start'} = ($client{'su-start'}) ? $client{'su-start'} . ',' . $parent: $parent; + } + eval $end if $b_log; +} + +# Public: returns shell launcher, terminal, program, whatever +# depends on $pppid so only runs if that is set. +sub shell_launcher { + eval $start if $b_log; + my (@data); + my ($msg,$pppid,$shell_parent) = ('','',''); + $pppid = $client{'pppid'}; + if ($b_log){ + $msg = ($ppid) ? "pppid: $pppid ppid: $ppid": "ppid: undefined"; + main::log_data('data',$msg); + } + # print "self parent: $pppid ppid: $ppid\n"; + if ($pppid){ + $shell_parent = $client{'parent'}; + # print "shell parent 1: $shell_parent\n"; + if ($b_log){ + $msg = ($shell_parent) ? "shell parent 1: $shell_parent": "shell parent 1: undefined"; + main::log_data('data',$msg); + } + # in case sudo starts inxi, parent is shell (or perl inxi if run by debugger) + # so: perl (2) started pinxi with sudo (3) in sh (4) in terminal + my $shells = 'ash|bash|busybox|cicada|csh|dash|doas|elvish|fish|fizsh|ksh|'; + $shells .= 'ksh93|lksh|login|loksh|mksh|nash|oh|oil|osh|pdksh|perl|posh|'; + $shells .= 'su|sudo|tcsh|xonsh|yash|zsh'; + $shells .= shell_test('return'); + my $i = 0; + print "self::pppid-0: $pppid :: $shell_parent\n" if $b_debug; + # note that new shells not matched will keep this loop spinning until it ends. + # All we really can do about that is update with new shell name when we find them. + while ($i < 8 && $shell_parent && $shell_parent =~ /^($shells)$/){ + # bash > su > parent + $i++; + $pppid = get_pppid($pppid); + $shell_parent = parent_name($pppid); + print "self::pppid-${i}: $pppid :: $shell_parent\n" if $b_debug; + if ($b_log){ + $msg = ($shell_parent) ? "parent-$i: $shell_parent": "shell parent $i: undefined"; + main::log_data('data',$msg); + } + } + } + if ($b_log){ + $pppid ||= ''; + $shell_parent ||= ''; + main::log_data('data',"parents: pppid: $pppid parent-name: $shell_parent"); + } + eval $end if $b_log; + return $shell_parent; +} + +# args: 0: parent id +# returns SID/start ID +sub get_pppid { + eval $start if $b_log; + my ($ppid) = @_; + return 0 if !$ppid; + # ps -j -fp : some bsds ps do not have -f for PPID, so we can't get the ppid + my $cmd = "ps -wwjfp $ppid 2>/dev/null"; + main::log_data('cmd',$cmd) if $b_log; + my @data = main::grabber($cmd); + # shift @data if @data; + my $pppid = main::awk(\@data,"$ppid",3,'\s+'); + eval $end if $b_log; + return $pppid; +} + +# args: 0: parent id +# returns parent command name +sub parent_name { + eval $start if $b_log; + my ($ppid) = @_; + return '' if !$ppid; + my ($parent_name); + # known issue, ps truncates long command names, like io.elementary.t[erminal] + my $cmd = "ps -wwjp $ppid 2>/dev/null"; + main::log_data('cmd',$cmd) if $b_log; + my @data = main::grabber($cmd,'','strip'); + # dump the headers if they exist + $parent_name = (grep {/$ppid/} @data)[0] if @data; + if ($parent_name){ + # we don't want to worry about column position, just slice off all + # the first part before the command + $parent_name =~ s/^.*[0-9]+:[0-9\.]+\s+//; + # then get the command + $parent_name = (split(/\s+/,$parent_name))[0]; + # get rid of /../ path info if present + $parent_name =~ s|^.*/|| if $parent_name; + # to work around a ps -p or gnome-terminal bug, which returns + # gnome-terminal- trim -/_ off start/end; _su, etc, which breaks detections + $parent_name =~ s/^[_-]|[_-]$//g; + } + eval $end if $b_log; + return $parent_name; +} + +# List of program_values non-handled shells, or known to have no version +# Move shell to set_program_values for print name, or version if available +# args: 0: return|[shell name to test +# returns test list OR shell name/'' +sub shell_test { + my ($test) = @_; + # these shells are not verified or tested + my $shells = 'apush|ccsh|ch|esh?|eshell|heirloom|hush|'; + $shells .= 'ion|imrsh|larryshell|mrsh|msh(ell)?|murex|nsh|nu(shell)?|'; + $shells .= 'oksh|psh|pwsh|pysh(ell)?|rush|sash|xsh?|'; + # these shells are tested and have no version info + $shells .= 'es|rc|scsh|sh'; + return '|' . $shells if $test eq 'return'; + return ($test =~ /^($shells)$/) ? $test : ''; +} + +# This will test against default IP like: (:0) vs full IP to determine +# ssh status. Surprisingly easy test? Cross platform +sub ssh_status { + eval $start if $b_log; + my ($b_ssh,$ssh); + # fred pts/10 2018-03-24 16:20 (:0.0) + # fred-remote pts/1 2018-03-27 17:13 (43.43.43.43) + if (my $program = main::check_program('who')){ + $ssh = (main::grabber("$program am i 2>/dev/null"))[0]; + # crude IP validation, v6 ::::::::, v4 x.x.x.x + if ($ssh && $ssh =~ /\(([:0-9a-f]{8,}|[1-9][\.0-9]{6,})\)$/){ + $b_ssh = 1; + } + } + eval $end if $b_log; + return $b_ssh; +} + +# If IRC: called if root for -S, -G, or if not in display for user. +sub console_irc_tty { + eval $start if $b_log; + $loaded{'con-irc-tty'} = 1; + # not set for root in or out of display + if (defined $ENV{'XDG_VTNR'}){ + $client{'con-irc-tty'} = $ENV{'XDG_VTNR'}; + } + else { + # ppid won't work with name, so this is assuming there's only one client running + # if in display, -G returns vt size, not screen dimensions in rowsxcols. + $client{'con-irc-tty'} = main::awk(\@ps_aux,'.*\b' . $client{'name'} . '\b.*',7,'\s+'); + $client{'con-irc-tty'} =~ s/^(tty|\?)// if defined $client{'con-irc-tty'}; + } + $client{'con-irc-tty'} = '' if !defined $client{'con-irc-tty'}; + main::log_data('data',"console-irc-tty:$client{'con-irc-tty'}") if $b_log; + eval $end if $b_log; +} + +sub tty_number { + eval $start if $b_log; + $loaded{'tty-number'} = 1; + # note: ttyname returns undefined if pinxi is > redirected output + # variants: /dev/pts/1 /dev/tty1 /dev/ttyp2 /dev/ttyra [hex number a] + $client{'tty-number'} = POSIX::ttyname(1); + # but tty direct works fine in that case + if (!defined $client{'tty-number'} && (my $program = main::check_program('tty'))){ + chomp($client{'tty-number'} = qx($program 2>/dev/null)); + if (defined $client{'tty-number'} && $client{'tty-number'} =~ /^not/){ + undef $client{'tty-number'}; + } + } + if (defined $client{'tty-number'}){ + $client{'tty-number'} =~ s/^\/dev\/(tty)?//; + } + else { + $client{'tty-number'} = ''; + } + # systemd only item, usually same as tty in console, not defined + # for root or non systemd systems. + if (defined $ENV{'XDG_VTNR'} && $client{'tty-number'} ne '' && + $ENV{'XDG_VTNR'} ne $client{'tty-number'}){ + $client{'tty-number'} = "$client{'tty-number'} (vt $ENV{'XDG_VTNR'})"; + } + elsif ($client{'tty-number'} eq '' && defined $ENV{'XDG_VTNR'}){ + $client{'tty-number'} = $ENV{'XDG_VTNR'}; + } + main::log_data('data',"tty:$client{'tty-number'}") if $b_log; + eval $end if $b_log; +} +} + +sub set_sysctl_data { + eval $start if $b_log; + return if !$alerts{'sysctl'} || $alerts{'sysctl'}->{'action'} ne 'use'; + my (@temp); + # darwin sysctl has BOTH = and : separators, and repeats data. Why? + if (!$fake{'sysctl'}){ + # just on odd chance we hit a bsd with /proc/cpuinfo, don't want to + # sleep 2x + if ($use{'bsd-sleep'} && !$system_files{'proc-cpuinfo'}){ + if ($b_hires){ + eval 'Time::HiRes::usleep($sleep)'; + } + else { + select(undef, undef, undef, $cpu_sleep); + } + } + @temp = grabber($alerts{'sysctl'}->{'path'} . " -a 2>/dev/null"); + } + else { + my $file; + # $file = "$fake_data_dir/bsd/sysctl/obsd_6.1_sysctl_soekris6501_root.txt"; + # $file = "$fake_data_dir/bsd/sysctl/obsd_6.1sysctl_lenovot500_user.txt"; + ## matches: compaq: openbsd-dmesg.boot-1.txt + # $file = "$fake_data_dir/bsd/sysctl/openbsd-5.6-sysctl-1.txt"; + ## matches: toshiba: openbsd-5.6-dmesg.boot-1.txt + # $file = "$fake_data_dir/bsd/sysctl/openbsd-5.6-sysctl-2.txt"; + # $file = "$fake_data_dir/bsd/sysctl/obsd-6.8-sysctl-a-battery-sensor-1.txt"; + # @temp = reader($file); + } + foreach (@temp){ + $_ =~ s/\s*=\s*|:\s+/:/; + $_ =~ s/\"//g; + push(@{$sysctl{'main'}}, $_); + # we're building these here so we can use these arrays per feature + if ($use{'bsd-audio'} && /^hw\.snd\./){ + push(@{$sysctl{'audio'}}, $_); # not used currently, just test data + } + # note: we could use ac0 to indicate plugged in but messes with battery output + elsif ($use{'bsd-battery'} && /^hw\.sensors\.acpi(bat|cmb)/){ + push(@{$sysctl{'battery'}}, $_); + } + # hw.cpufreq.temperature: 40780 :: dev.cpu0.temperature + # hw.acpi.thermal.tz2.temperature: 27.9C :: hw.acpi.thermal.tz1.temperature: 42.1C + # hw.acpi.thermal.tz0.temperature: 42.1C + elsif ($use{'bsd-sensor'} &&((/^hw\.sensors/ && !/^hw\.sensors\.acpi(ac|bat|cmb)/ && + !/^hw\.sensors\.softraid/) || /^hw\.acpi\.thermal/ || /^dev\.cpu\.[0-9]+\.temp/)){ + push(@{$sysctl{'sensor'}}, $_); + } + # Must go AFTER sensor because sometimes freebsd puts sensors in dev.cpu + # hw.l1dcachesize hw.l2cachesize + elsif ($use{'bsd-cpu'} && (/^hw\.(busfreq|clock|n?cpu|l[123].?cach|model|smt)/ || + /^dev\.cpu/ || /^machdep\.(cpu|hlt_logical_cpus)/)){ + push(@{$sysctl{'cpu'}}, $_); + } + # only activate if using the diskname feature in dboot!! note assign to $dboot. + elsif ($use{'bsd-disk'} && /^hw\.disknames/){ + push(@{$dboot{'disk'}}, $_); + } + elsif ($use{'bsd-kernel'} && /^kern.compiler_version/){ + push(@{$sysctl{'kernel'}}, $_); + } + elsif ($use{'bsd-machine'} && + /^(hw\.|machdep\.dmi\.(bios|board|system)-)(date|product|serial(no)?|uuid|vendor|version)/){ + push(@{$sysctl{'machine'}}, $_); + } + # let's rely on dboot, we really just want the hardware specs for solid ID + # elsif ($use{'bsd-machine'} && !$dboot{'machine-vm'} && + # /(\bhvm\b|innotek|\bkvm\b|microsoft.*virtual machine|openbsd[\s-]vmm|qemu|qumranet|vbox|virtio|virtualbox|vmware)/i){ + # push(@{$dboot{'machine-vm'}}, $_); + # } + elsif ($use{'bsd-memory'} && /^(hw\.(physmem|usermem)|Free Memory)/){ + push(@{$sysctl{'memory'}}, $_); + } + + elsif ($use{'bsd-raid'} && /^hw\.sensors\.softraid[0-9]\.drive[0-9]/){ + push(@{$sysctl{'softraid'}}, $_); + } + } + if ($dbg[7]){ + print("main\n", Dumper $sysctl{'main'}); + print("dboot-machine-vm\n", Dumper $dboot{'machine-vm'}); + print("audio\n", Dumper $sysctl{'audio'}); + print("battery\n", Dumper $sysctl{'battery'}); + print("cpu\n", Dumper $sysctl{'cpu'}); + print("kernel\n", Dumper $sysctl{'kernel'}); + print("machine\n", Dumper $sysctl{'machine'}); + print("memory\n", Dumper $sysctl{'memory'}); + print("sensors\n", Dumper $sysctl{'sensor'}); + print("softraid\n", Dumper $sysctl{'softraid'}); + } + # this thing can get really long. + if ($b_log){ + main::log_data('dump','$sysctl{main}',$sysctl{'main'}); + main::log_data('dump','$dboot{machine-vm}',$sysctl{'machine-vm'}); + main::log_data('dump','$sysctl{audio}',$sysctl{'audio'}); + main::log_data('dump','$sysctl{battery}',$sysctl{'battery'}); + main::log_data('dump','$sysctl{cpu}',$sysctl{'cpu'}); + main::log_data('dump','$sysctl{kernel}',$sysctl{'kernel'}); + main::log_data('dump','$sysctl{machine}',$sysctl{'machine'}); + main::log_data('dump','$sysctl{memory}',$sysctl{'memory'}); + main::log_data('dump','$sysctl{sensors}',$sysctl{'sensor'}); + main::log_data('dump','$sysctl{softraid}',$sysctl{'softraid'}); + } + eval $end if $b_log; +} + +sub get_uptime { + eval $start if $b_log; + my ($days,$hours,$minutes,$seconds,$sys_time,$uptime) = ('','','','','',''); + if (check_program('uptime')){ + $uptime = qx(uptime); + $uptime = trimmer($uptime); + if ($fake{'uptime'}){ + # $uptime = '2:58PM up 437 days, 8:18, 3 users, load averages: 2.03, 1.72, 1.77'; + # $uptime = '04:29:08 up 3:18, 3 users, load average: 0,00, 0,00, 0,00'; + # $uptime = '10:23PM up 5 days, 16:17, 1 user, load averages: 0.85, 0.90, 1.00'; + # $uptime = '05:36:47 up 1 day, 3:28, 4 users, load average: 1,88, 0,98, 0,62'; + # $uptime = '05:36:47 up 1 day, 3 min, 4 users, load average: 1,88, 0,98, 0,62'; + # $uptime = '04:41:23 up 2:16, load average: 7.13, 6.06, 3.41 # root openwrt'; + # $uptime = '9:51 PM up 2 mins, 1 user, load average: 0:58, 0.27, 0.11'; + # $uptime = '05:36:47 up 3 min, 4 users, load average: 1,88, 0,98, 0,62'; + # $uptime = '9:51 PM up 49 secs, 1 user, load average: 0:58, 0.27, 0.11'; + # $uptime = '04:11am up 0:00, 1 user, load average: 0.08, 0.03, 0.01'; # openSUSE 13.1 (Bottle) + # $uptime = '11:21:43 up 1 day 5:53, 4 users, load average: 0.48, 0.62, 0.48'; # openSUSE Tumbleweed 20210515 + } + if ($uptime){ + # trim off and store system time and up, and cut off user/load data + $uptime =~ s/^([0-9:])\s*([AP]M)?.+up\s+|,?\s*([0-9]+\suser|load).*$//gi; + # print "ut: $uptime\n"; + if ($1){ + $sys_time = $1; + $sys_time .= lc($2) if $2; + } + if ($uptime =~ /\b([0-9]+)\s+day[s]?\b/){ + $days = ($1 + 0) . 'd'; + } + if ($uptime =~ /\b([0-9]{1,2}):([0-9]{1,2})\b/){ + $hours = ($1 + 0) . 'h'; + $minutes = ($2 + 0) . 'm'; + } + else { + if ($uptime =~ /\b([0-9]+)\smin[s]?\b/){ + $minutes = ($1 + 0) . 'm'; + } + if ($uptime =~ /\b([0-9]+)\ssec[s]?\b/){ + $seconds = ($1 + 0) . 's'; + } + } + $days .= ' ' if $days && ($hours || $minutes || $seconds); + $hours .= ' ' if $hours && $minutes; + $minutes .= ' ' if $minutes && $seconds; + $uptime = $days . $hours . $minutes . $seconds; + } + } + $uptime ||= 'N/A'; + eval $end if $b_log; + return $uptime; +} + +## UsbData ## +# %usb array indexes +# 0: bus id / sort id +# 1: device id +# 2: path_id +# 3: path +# 4: class id +# 5: subclass id +# 6: protocol id +# 7: vendor:chip id +# 8: usb version +# 9: interfaces +# 10: ports +# 11: vendor +# 12: product +# 13: device-name +# 14: type string +# 15: driver +# 16: serial +# 17: speed (bits, Si base 10, [MG]bps) +# 18: configuration - not used +# 19: power mW bsd only, not used yet +# 20: product rev number +# 21: driver_nu [bsd only] +# 22: admin usb rev info +# 23: rx lanes +# 24: tx lanes +# 25: speed (Bytes, IEC base 2, [MG]iBs +# 26: absolute path +{ +package UsbData; +my (@working); +my (@asound_ids,$b_asound,$b_hub,$addr_id,$bus_id,$bus_id_alpha, +$chip_id,$class_id,$device_id,$driver,$driver_nu,$ids,$interfaces, +$name,$network_regex,$path,$path_id,$power,$product,$product_id,$protocol_id, +$mode,$rev,$serial,$speed_si,$speed_iec,$subclass_id,$type,$version, +$vendor,$vendor_id); +my $b_live = 1; # debugger file data + +sub set { + eval $start if $b_log; + ${$_[0]} = 1; # set checked boolean + # note: bsd package usbutils has lsusb in it, but we dont' want it for default + # usbdevs is best, has most data, and runs as user + if ($alerts{'usbdevs'}->{'action'} eq 'use'){ + usbdevs_data(); + } + # usbconfig has weak/poor output, and requires root, only fallback + elsif ($alerts{'usbconfig'}->{'action'} eq 'use'){ + usbconfig_data(); + } + # if user config sets USB_SYS you can override with --usb-tool + elsif ((!$force{'usb-sys'} || $force{'lsusb'}) && $alerts{'lsusb'}->{'action'} eq 'use'){ + lsusb_data(); + } + elsif (-d '/sys/bus/usb/devices'){ + sys_data('main'); + } + @{$usb{'main'}} = sort {$a->[0] cmp $b->[0]} @{$usb{'main'}} if $usb{'main'}; + if ($b_log){ + main::log_data('dump','$usb{audio}: ',$usb{'audio'}); + main::log_data('dump','$usb{bluetooth}: ',$usb{'bluetooth'}); + main::log_data('dump','$usb{disk}: ',$usb{'disk'}); + main::log_data('dump','$usb{graphics}: ',$usb{'graphics'}); + main::log_data('dump','$usb{network}: ',$usb{'network'}); + } + if ($dbg[55]){ + print '$usb{audio}: ', Data::Dumper::Dumper $usb{'audio'}; + print '$usb{bluetooth}: ', Data::Dumper::Dumper $usb{'bluetooth'}; + print '$usb{disk}: ', Data::Dumper::Dumper $usb{'disk'}; + print '$usb{graphics}: ', Data::Dumper::Dumper $usb{'graphics'}; + print '$usb{network}: ', Data::Dumper::Dumper $usb{'network'}; + } + eval $end if $b_log; +} + +sub lsusb_data { + eval $start if $b_log; + my (@temp); + my @data = usb_grabber('lsusb'); + foreach (@data){ + next if /^~$|^Couldn't/; # expensive second call: || /UNAVAIL/ + @working = split(/\s+/, $_); + next unless defined $working[1] && defined $working[3]; + $working[3] =~ s/:$//; + # Don't use this fix, the data is garbage in general! Seen FreeBSD lsusb with: + # Bus /dev/usb Device /dev/ugen0.3: ID 24ae:1003 Shenzhen Rapoo Technology Co., Ltd. + # hub, note incomplete data: Bus /dev/usb Device /dev/ugen0.1: ID 0000:0000 + # linux: + # Bus 005 Device 007: ID 0d8c:000c C-Media Electronics, Inc. Audio Adapter + # if ($working[3] =~ m|^/dev/ugen([0-9]+)\.([0-9]+)|){ + # $working[1] = $1; + # $working[3] = $2; + # } + next unless main::is_numeric($working[1]) && main::is_numeric($working[3]); + $addr_id = int($working[3]); + $bus_id = int($working[1]); + $path_id = "$bus_id-$addr_id"; + $chip_id = $working[5]; + @temp = @working[6..$#working]; + $name = main::remove_duplicates(join(' ', @temp)); + # $type = check_type($name,'',''); + $type ||= ''; + # do NOT set bus_id_alpha here!! + # print "$name\n"; + $working[0] = $bus_id; + $working[1] = $addr_id; + $working[2] = $path_id; + $working[3] = ''; + $working[4] = '00'; + $working[5] = ''; + $working[6] = ''; + $working[7] = $chip_id; + $working[8] = ''; + $working[9] = ''; + $working[10] = 0; + $working[11] = ''; + $working[12] = ''; + $working[13] = $name; + $working[14] = '';# $type; + $working[15] = ''; + $working[16] = ''; + $working[17] = ''; + $working[18] = ''; + $working[19] = ''; + $working[20] = ''; + push(@{$usb{'main'}},[@working]); + # print join("\n",@working),"\n\n=====\n"; + } + print 'lsusb-pre-sys: ', Data::Dumper::Dumper $usb{'main'} if $dbg[6]; + sys_data('lsusb') if $usb{'main'}; + print 'lsusb-w-sys: ', Data::Dumper::Dumper $usb{'main'} if $dbg[6]; + main::log_data('dump','$usb{main}: plain',$usb{'main'}) if $b_log; + eval $end if $b_log; +} + +# ugen0.1: at usbus0, cfg=0 md=HOST spd=FULL (12Mbps) pwr=SAVE (0mA) +# ugen0.2: at usbus0, cfg=0 md=HOST spd=FULL (12Mbps) pwr=ON (160mA) +# note: tried getting driver/ports from dmesg, impossible, waste of time +sub usbconfig_data { + eval $start if $b_log; + my ($cfg,$hub_id,$ports); + my @data = usb_grabber('usbconfig'); + foreach (@data){ + if ($_ eq '~' && @working){ + $chip_id = ($vendor_id || $product_id) ? "$vendor_id:$product_id" : ''; + $working[7] = $chip_id; + $product ||= ''; + $vendor ||= ''; + $working[13] = main::remove_duplicates("$vendor $product") if $product || $vendor; + # leave the ugly vendor/product ids unless chip-ID shows! + $working[13] = $chip_id if $extra < 2 && $chip_id && !$working[13]; + if (defined $class_id && defined $subclass_id && defined $protocol_id){ + $class_id = hex($class_id); + $subclass_id = hex($subclass_id); + $protocol_id = hex($protocol_id); + $type = device_type("$class_id/$subclass_id/$protocol_id"); + } + if ($working[13] && (!$type || $type eq '')){ + $type = check_type($working[13],'',''); + } + $working[14] = $type; + push(@{$usb{'main'}},[@working]); + assign_usb_type([@working]); + undef @working; + } + elsif (/^([a-z_-]+)([0-9]+)\.([0-9]+):\s+<[^>]+>\s+at usbus([0-9]+)\b/){ + ($class_id,$cfg,$power,$rev,$mode,$speed_si,$speed_iec,$subclass_id, + $type) = (); + ($product,$product_id,$vendor,$vendor_id) = ('','','',''); + $hub_id = $2; + $addr_id = $3; + $bus_id = $4; + $path_id = "$bus_id-$hub_id.$addr_id"; + $bus_id_alpha = bus_id_alpha($path_id); + if (/\bcfg\s*=\s*([0-9]+)/){ + $cfg = $1; + } + if (/\bmd\s*=\s*([\S]+)/){ + # nothing + } + # odd, using \b after ) doesn't work as expected + # note that bsd spd=FULL has no interest since we get that from the speed + if (/\b(speed|spd)\s*=\s*([\S]+)\s+\(([^\)]+)\)/){ + $speed_si = $3; + } + if (/\b(power|pwr)\s*=\s*([\S]+)\s+\(([0-9]+mA)\)/){ + $power = $3; + process_power(\$power) if $power; + } + version_data('bsd',\$speed_si,\$speed_iec,\$rev,\$mode); + $working[0] = $bus_id_alpha; + $working[1] = $addr_id; + $working[2] = $path_id; + $working[3] = ''; + $working[8] = $rev; + $working[9] = ''; + $working[10] = $ports; + $working[15] = $driver; + $working[17] = $speed_si; + $working[18] = $cfg; + $working[19] = $power; + $working[20] = ''; + $working[21] = $driver_nu; + $working[22] = $mode; + $working[25] = $speed_iec; + } + elsif (/^bDeviceClass\s*=\s*0x00([a-f0-9]{2})\s*(<([^>]+)>)?/){ + $class_id = $1; + $working[4] = $class_id; + } + elsif (/^bDeviceSubClass\s*=\s*0x00([a-f0-9]{2})/){ + $subclass_id = $1; + $working[5] = $subclass_id; + } + elsif (/^bDeviceProtocol\s*=\s*0x00([a-f0-9]{2})/){ + $protocol_id = $1; + $working[6] = $protocol_id; + } + elsif (/^idVendor\s*=\s*0x([a-f0-9]{4})/){ + $vendor_id = $1; + } + elsif (/^idProduct\s*=\s*0x([a-f0-9]{4})/){ + $product_id = $1; + } + elsif (/^iManufacturer\s*=\s*0x([a-f0-9]{4})\s*(<([^>]+)>)?/){ + $vendor = main::clean($3); + $vendor =~ s/^0x.*//; # seen case where vendor string was ID + $working[11] = $vendor; + } + elsif (/^iProduct\s*=\s*0x([a-f0-9]{4})\s*(<([^>]+)>)?/){ + $product = main::clean($3); + $product =~ s/^0x.*//; # in case they put product ID in, sigh + $working[12] = $product; + } + elsif (/^iSerialNumber\s*=\s*0x([a-f0-9]{4})\s*(<([^>]+)>)?/){ + $working[16] = main::clean($3); + } + } + main::log_data('dump','$usb{main}: usbconfig',$usb{'main'}) if $b_log; + print 'usbconfig: ', Data::Dumper::Dumper $usb{'main'} if $dbg[6]; + eval $end if $b_log; +} + +# Controller /dev/usb2: +# addr 1: full speed, self powered, config 1, UHCI root hub(0x0000), Intel(0x8086), rev 1.00 +# port 1 addr 2: full speed, power 98 mA, config 1, USB Receiver(0xc52b), Logitech(0x046d), rev 12.01 +# port 2 powered +sub usbdevs_data { + eval $start if $b_log; + my ($b_multi,$class,$config,$hub_id,$port,$port_value,$product_rev); + my ($ports) = (0); + my @data = usb_grabber('usbdevs'); + foreach (@data){ + if ($_ eq '~' && @working){ + $working[10] = $ports; + push(@{$usb{'main'}},[@working]); + assign_usb_type([@working]); + undef @working; + ($config,$driver,$power,$rev) = ('','','',''); + } + elsif (/^Controller\s\/dev\/usb([0-9]+)/){ + $bus_id = $1; + } + elsif (/^addr\s([0-9]+):\s([^,]+),[^,0-9]+([0-9]+ mA)?,\s+config\s+([0-9]+),\s?([^,]+)\(0x([0-9a-f]{4})\),\s?([^,]+)\s?\(0x([0-9a-f]{4})\)/){ + ($mode,$rev,$speed_si,$speed_iec) = (); + $hub_id = $1; + $addr_id = $1; + $speed_si = $2; # requires prep + $power = $3; + $chip_id = "$6:$8"; + $config = $4; + $name = main::remove_duplicates("$7 $5"); + # print "p1:$protocol\n"; + $path_id = "$bus_id-$hub_id"; + $bus_id_alpha = bus_id_alpha($path_id); + $ports = 0; + process_power(\$power) if $power; + $port_value = ''; + version_data('bsd',\$speed_si,\$speed_iec,\$rev,\$mode); + $working[0] = $bus_id_alpha; + $working[1] = $addr_id; + $working[2] = $path_id; + $working[3] = ''; + $working[4] = '09'; + $working[5] = ''; + $working[6] = ''; + $working[7] = $chip_id; + $working[8] = $rev; + $working[9] = ''; + $working[10] = $ports; + $working[13] = $name; + $working[14] = 'Hub'; + $working[15] = ''; + $working[16] = ''; + $working[17] = $speed_si; + $working[18] = $config; + $working[19] = $power; + $working[20] = ''; + $working[22] = $mode; + $working[25] = $speed_iec; + } + elsif (/^port\s([0-9]+)\saddr\s([0-9]+):\s([^,]+),[^,0-9]*([0-9]+\s?mA)?,\s+config\s+([0-9]+),\s?([^,]+)\(0x([0-9a-f]{4})\),\s?([^,]+)\s?\(0x([0-9a-f]{4})\)/){ + ($rev,$mode,$speed_iec,$speed_si) = (); + $port = $1; + $addr_id = $2; + $speed_si = $3; + $power = $4; + $config = $5; + $chip_id = "$7:$9"; + $name = main::remove_duplicates("$8 $6"); + $type = check_type($name,'',''); + $type ||= ''; + # print "p2:$protocol\n"; + $ports++; + $path_id = "$bus_id-$hub_id.$port"; + $bus_id_alpha = bus_id_alpha($path_id); + process_power(\$power) if $power; + version_data('bsd',\$speed_si,\$speed_iec,\$rev,\$mode); + $working[0] = $bus_id_alpha; + $working[1] = $addr_id; + $working[2] = $path_id; + $working[3] = ''; + $working[4] = '01'; + $working[5] = ''; + $working[6] = ''; + $working[7] = $chip_id; + $working[8] = $rev; + $working[9] = ''; + $working[10] = $ports; + $working[11] = ''; + $working[12] = ''; + $working[13] = $name; + $working[14] = $type; + $working[15] = ''; + $working[16] = ''; + $working[17] = $speed_si; + $working[18] = $config; + $working[19] = $power; + $working[20] = ''; + $working[22] = $mode; + $working[25] = $speed_iec; + } + elsif (/^port\s([0-9]+)\spowered/){ + $ports++; + } + # newer openbsd usbdevs totally changed their syntax and layout, but it is better... + elsif (/^addr\s*([0-9a-f]+):\s+([a-f0-9]{4}:[a-f0-9]{4})\s*([^,]+)?(,\s[^,]+?)?,\s+([^,]+)$/){ + $addr_id = $1; + $chip_id = $2; + $vendor = main::clean($3) if $3; + $vendor ||= ''; + $name = main::remove_duplicates("$vendor $5"); + $type = check_type($name,'',''); + $class_id = ($name =~ /hub/i) ? '09': '01'; + $path_id = "$bus_id-$addr_id"; + $bus_id_alpha = bus_id_alpha($path_id); + $ports = 0; + $b_multi = 1; + $working[0] = $bus_id_alpha; + $working[1] = $addr_id; + $working[2] = $path_id; + $working[3] = ''; + $working[4] = $class_id; + $working[5] = ''; + $working[6] = ''; + $working[7] = $chip_id; + $working[8] = ''; + $working[9] = ''; + $working[10] = $ports; + $working[11] = ''; + $working[12] = ''; + $working[13] = $name; + $working[14] = $type; + $working[15] = ''; + $working[16] = ''; + $working[17] = ''; + $working[18] = ''; + $working[19] = ''; + $working[20] = ''; + } + elsif ($b_multi && + /^([^,]+),\s+(self powered|power\s+([0-9]+\s+mA)),\s+config\s([0-9]+),\s+rev\s+([0-9\.]+)(,\s+i?Serial\s(\S*))?/i){ + ($mode,$rev,$speed_iec,$speed_si) = (); + $speed_si = $1; + $power = $3; + process_power(\$power) if $power; + version_data('bsd',\$speed_si,\$speed_iec,\$rev,\$mode); + $working[8] = $rev; + $working[16] = $7 if $7; + $working[17] = $speed_si; + $working[18] = $4; # config number + $working[19] = $power; + $working[20] = $5; # product rev + $working[22] = $mode; + $working[25] = $speed_iec; + } + # 1 or more drivers supported + elsif ($b_multi && /^driver:\s*([^,]+)$/){ + my $temp = $1; + $working[4] = '09' if $temp =~ /hub[0-9]/; + $temp =~ s/([0-9]+)$//; + $working[21] = $1; # driver nu + # drivers, note that when numbers trimmed off, drivers can have same name + $working[15] = ($working[15] && $working[15] !~ /\b$temp\b/) ? "$working[15],$temp" : $temp; + # now that we have the driver, let's recheck the type + if (!$type && $name && $working[15]){ + $type = check_type($name,$working[15],''); + $working[14] = $type if $type; + } + } + elsif ($b_multi && /^port\s[0-9]/){ + $ports++; + } + } + main::log_data('dump','$usb{main}: usbdevs',$usb{'main'}) if $b_log; + print 'usbdevs: ', Data::Dumper::Dumper $usb{'main'} if $dbg[6]; + eval $end if $b_log; +} + +sub usb_grabber { + eval $start if $b_log; + my ($program) = @_; + my ($args,$path,$pattern,@data,@working); + if ($program eq 'lsusb'){ + $args = ''; + $path = $alerts{'lsusb'}->{'path'}; + $pattern = '^Bus [0-9]'; + } + elsif ($program eq 'usbconfig'){ + $args = 'dump_device_desc'; + $path = $alerts{'usbconfig'}->{'path'}; + $pattern = '^[a-z_-]+[0-9]+\.[0-9]+:'; + } + elsif ($program eq 'usbdevs'){ + $args = '-vv'; + $path = $alerts{'usbdevs'}->{'path'}; + $pattern = '^(addr\s[0-9a-f]+:|port\s[0-9]+\saddr\s[0-9]+:)'; + } + if ($b_live && !$fake{'usbdevs'} && !$fake{'usbconfig'}){ + @data = main::grabber("$path $args 2>/dev/null",'','strip'); + } + else { + my $file; + if ($fake{'usbdevs'}){ + $file = "$fake_data_dir/usb/usbdevs/bsd-usbdevs-v-1.txt"; + } + elsif ($fake{'usbconfig'}){ + $file = "$fake_data_dir/usb/usbconfig/bsd-usbconfig-list-v-1.txt"; + } + else { + $file = "$fake_data_dir/usb/lsusb/mdmarmer-lsusb.txt"; + } + @data = main::reader($file,'strip'); + } + if (@data){ + $use{'usb-tool'} = 1 if scalar @data > 2; + foreach (@data){ + # this is the group separator and assign trigger + push(@working, '~') if $_ =~ /$pattern/i; + push(@working, $_); + } + push(@working, '~'); + } + print Data::Dumper::Dumper \@working if $dbg[30]; + eval $end if $b_log; + return @working; +} + +sub sys_data { + eval $start if $b_log; + my ($source) = @_; + my ($configuration,$lanes_rx,$lanes_tx,$ports,$mode,$rev); + my (@drivers,@uevent); + my $i = 0; + my @files = main::globber('/sys/bus/usb/devices/*'); + # we want to get rid of the hubs with x-0: syntax, those are hubs found in /usbx + @files = grep {!/\/[0-9]+-0:/} @files; + # print join("\n", @files); + foreach my $file (@files){ + # be careful, sometimes uevent is not readable + @uevent = (-r "$file/uevent") ? main::reader("$file/uevent") : undef; + if (@uevent && ($ids = main::awk(\@uevent,'^(DEVNAME|DEVICE\b)',2,'='))){ + ($b_hub,$class_id,$protocol_id,$subclass_id) = (0,0,0,0); + (@drivers,$lanes_rx,$lanes_tx,$mode,$rev,$speed_iec,$speed_si) = (); + ($configuration,$driver,$interfaces,$name,$ports,$product,$serial, + $type,$vendor) = ('','','','','','','','',''); + # print Cwd::abs_path($file),"\n"; + # print "f1: $file\n"; + $path_id = $file; + $path_id =~ s/^.*\///; + $path_id =~ s/^usb([0-9]+)/$1-0/; + # if DEVICE= then path = /proc/bus/usb/001/001 else: bus/usb/006/001 + $ids =~ s/^\///; + @working = split('/', $ids); + shift @working if $working[0] eq 'proc'; + $bus_id = int($working[2]); + $bus_id_alpha = bus_id_alpha($path_id); + $device_id = int($working[3]); + # this will be a hex number + $class_id = sys_item("$file/bDeviceClass"); + # $subclass_id = sys_item("$file/bDeviceSubClass"); + # $protocol_id = sys_item("$file/bDeviceProtocol"); + $class_id = hex($class_id) if $class_id; + # $subclass_id = hex($subclass_id) if $subclass_id; + # $protocol_id = hex($protocol_id) if $protocol_id; + # print "$path_id $class_id/$subclass_id/$protocol_id\n"; + $power = sys_item("$file/bMaxPower"); + process_power(\$power) if $power; + # this populates class, subclass, and protocol id with decimal numbers + @drivers = uevent_data("$file/[0-9]*/uevent"); + push(@drivers, uevent_data("$file/[0-9]*/*/uevent")) if !$b_hub; + $ports = sys_item("$file/maxchild") if $b_hub; + if (@drivers){ + main::uniq(\@drivers); + $driver = join(',', sort @drivers); + } + $interfaces = sys_item("$file/bNumInterfaces"); + $lanes_rx = sys_item("$file/rx_lanes"); + $lanes_tx = sys_item("$file/tx_lanes"); + $serial = sys_item("$file/serial"); + $rev = sys_item("$file/version"); + $speed_si = sys_item("$file/speed"); + version_data('sys',\$speed_si,\$speed_iec,\$rev,\$mode,$lanes_rx,$lanes_tx); + $configuration = sys_item("$file/configuration"); + $power = sys_item("$file/bMaxPower"); + process_power(\$power) if $power; + $class_id = sprintf("%02x", $class_id) if defined $class_id && $class_id ne ''; + $subclass_id = sprintf("%02x", $subclass_id) if defined $subclass_id && $subclass_id ne ''; + if ($source eq 'lsusb'){ + for ($i = 0; $i < scalar @{$usb{'main'}}; $i++){ + if ($usb{'main'}->[$i][0] eq $bus_id && $usb{'main'}->[$i][1] == $device_id){ + if (!$b_hub && $usb{'main'}->[$i][13] && (!$type || $type eq '')){ + $type = check_type($usb{'main'}->[$i][13],$driver,$type); + } + $usb{'main'}->[$i][0] = $bus_id_alpha; + $usb{'main'}->[$i][2] = $path_id; + $usb{'main'}->[$i][3] = $file; + $usb{'main'}->[$i][4] = $class_id; + $usb{'main'}->[$i][5] = $subclass_id; + $usb{'main'}->[$i][6] = $protocol_id; + $usb{'main'}->[$i][8] = $rev; + $usb{'main'}->[$i][9] = $interfaces; + $usb{'main'}->[$i][10] = $ports if $ports; + if ($type && $b_hub && (!$usb{'main'}->[$i][13] || + $usb{'main'}->[$i][13] =~ /^linux foundation/i)){ + $usb{'main'}->[$i][13] = "$type"; + } + $usb{'main'}->[$i][14] = $type if ($type && !$b_hub); + $usb{'main'}->[$i][15] = $driver if $driver; + $usb{'main'}->[$i][16] = $serial if $serial; + $usb{'main'}->[$i][17] = $speed_si if $speed_si; + $usb{'main'}->[$i][18] = $configuration; + $usb{'main'}->[$i][19] = $power; + $usb{'main'}->[$i][20] = ''; + $usb{'main'}->[$i][22] = $mode; + $usb{'main'}->[$i][23] = $lanes_rx; + $usb{'main'}->[$i][24] = $lanes_tx; + $usb{'main'}->[$i][25] = $speed_iec if $speed_iec; + $usb{'main'}->[$i][26] = Cwd::abs_path($file); + assign_usb_type($usb{'main'}->[$i]); + # print join("\n",@{$usb{'main'}->[$i]}),"\n\n";# if !$b_hub; + last; + } + } + } + else { + $chip_id = sys_item("$file/idProduct"); + $vendor_id = sys_item("$file/idVendor"); + # we don't want the device, it's probably a bad path in /sys/bus/usb/devices + next if !$vendor_id && !$chip_id; + $product = sys_item("$file/product"); + $product = main::clean($product) if $product; + $vendor = sys_item("$file/manufacturer"); + $vendor = main::clean($vendor) if $vendor; + if (!$b_hub && ($product || $vendor)){ + if ($vendor && $product && $product !~ /$vendor/){ + $name = "$vendor $product"; + } + elsif ($product){ + $name = $product; + } + elsif ($vendor){ + $name = $vendor; + } + } + elsif ($b_hub){ + $name = $type; + } + $name = main::remove_duplicates($name) if $name; + if (!$b_hub && $name && (!$type || $type eq '')){ + $type = check_type($name,$driver,$type); + } + # this isn't that useful, but save in case something shows up + # if ($configuration){ + # $name = ($name) ? "$name $configuration" : $configuration; + # } + $type = 'Hub' if $b_hub; + $usb{'main'}->[$i][0] = $bus_id_alpha; + $usb{'main'}->[$i][1] = $device_id; + $usb{'main'}->[$i][2] = $path_id; + $usb{'main'}->[$i][3] = $file; + $usb{'main'}->[$i][4] = $class_id; + $usb{'main'}->[$i][5] = $subclass_id; + $usb{'main'}->[$i][6] = $protocol_id; + $usb{'main'}->[$i][7] = "$vendor_id:$chip_id"; + $usb{'main'}->[$i][8] = $rev; + $usb{'main'}->[$i][9] = $interfaces; + $usb{'main'}->[$i][10] = $ports; + $usb{'main'}->[$i][11] = $vendor; + $usb{'main'}->[$i][12] = $product; + $usb{'main'}->[$i][13] = $name; + $usb{'main'}->[$i][14] = $type; + $usb{'main'}->[$i][15] = $driver; + $usb{'main'}->[$i][16] = $serial; + $usb{'main'}->[$i][17] = $speed_si; + $usb{'main'}->[$i][18] = $configuration; + $usb{'main'}->[$i][19] = $power; + $usb{'main'}->[$i][20] = ''; + $usb{'main'}->[$i][22] = $mode; + $usb{'main'}->[$i][23] = $lanes_rx; + $usb{'main'}->[$i][24] = $lanes_tx; + $usb{'main'}->[$i][25] = $speed_iec; + $usb{'main'}->[$i][26] = Cwd::abs_path($file); + assign_usb_type($usb{'main'}->[$i]); + $i++; + } + # print "$path_id ids: $bus_id:$device_id driver: $driver ports: $ports\n==========\n"; # if $dbg[6];; + } + } + print 'usb-sys: ', Data::Dumper::Dumper $usb{'main'} if $source eq 'main' && $dbg[6]; + main::log_data('dump','$usb{main}: sys',$usb{'main'}) if $source eq 'main' && $b_log; + eval $end if $b_log; +} + +# Get driver, interface [type:] data +sub uevent_data { + my ($path) = @_; + my ($interface,$interfaces,$temp,@interfaces,@drivers); + my @files = main::globber($path); + @files = grep {!/\/(subsystem|driver|ep_[^\/]+)\/uevent$/} @files if @files; + foreach (@files){ + last if $b_hub; + # print "f2: $_\n"; + ($interface) = (''); + @working = main::reader($_) if -r $_; + # print join("\n",@working), "\n"; + if (@working){ + $driver = main::awk(\@working,'^DRIVER',2,'='); + $interface = main::awk(\@working,'^INTERFACE',2,'='); + if ($interface){ + # for hubs, we need the specific protocol, which is in TYPE + if ($interface eq '9/0/0' && + (my $temp = main::awk(\@working,'^TYPE',2,'='))){ + $interface = $temp; + } + # print "$interface\n"; + $interface = device_type($interface); + if ($interface){ + if ($interface ne ''){ + push(@interfaces, $interface); + } + # networking requires more data but this test is reliable + elsif (!@interfaces){ + $temp = $_; + $temp =~ s/\/uevent$//; + push(@interfaces, 'Network') if -d "$temp/net/"; + } + if (!@interfaces){ + push(@interfaces, $interface); + } + } + } + } + # print "driver:$driver\n"; + $b_hub = 1 if $driver && $driver eq 'hub'; + $driver = '' if $driver && ($driver eq 'usb' || $driver eq 'hub'); + push(@drivers,$driver) if $driver; + } + if (@interfaces){ + main::uniq(\@interfaces); + # clear out values like: ,Printer + if (scalar @interfaces > 1 && (grep {!/^ device on the bus, + # although nested hubs of course can be > 1 too. No need to build these if + # none of lines are showing. + if (($row->[4] && $row->[4] eq '09') || + ($row->[14] && lc($row->[14]) eq 'hub') || $row->[1] <= 1 || + (!$show{'audio'} && !$show{'bluetooth'} && !$show{'disk'} && + !$show{'graphic'} && !$show{'network'})){ + return; + } + $row->[13] = '' if !defined $row->[13]; # product + $row->[14] = '' if !defined $row->[14]; # type + $row->[15] = '' if !defined $row->[15]; # driver + set_asound_ids() if $show{'audio'} && !$b_asound; + set_network_regex() if $show{'network'} && !$network_regex; + # NOTE: a device, like camera, can be audio+graphic + # NOTE: 13, 14 can be upper/lower case, so use i. + if ($show{'audio'} && ( + (@asound_ids && $row->[7] && (grep {$row->[7] eq $_} @asound_ids)) || + ($row->[14] && $row->[14] =~ /audio/i) || + ($row->[15] && $row->[15] =~ /audio/) || + ($row->[13] && lc($row->[13]) =~ /(audio|\bdac[0-9]*\b|headphone|\bmic(rophone)?\b)/i) + )){ + push(@{$usb{'audio'}},$row); + } + if ($show{'graphic'} && ( + ($row->[14] && $row->[14] =~ /video/i) || + ($row->[15] && $row->[15] =~ /video/) || + ($row->[13] && lc($row->[13]) =~ /(camera|\bdvb-t|\b(pc)?tv\b|video|webcam)/i) + )){ + push(@{$usb{'graphics'}},$row); + } + # we want to catch bluetooth devices, which otherwise can trip network regex + elsif (($show{'bluetooth'} || $show{'network'}) && ( + ($row->[14] && $row->[14] =~ /bluetooth/i) || + ($row->[15] && $row->[15] =~ /\b(btusb|ubt)\b/) || + ($row->[13] && $row->[13] =~ /bluetooth/i) + )){ + push(@{$usb{'bluetooth'}},$row); + } + elsif ($show{'disk'} && ( + ($row->[14] && $row->[14] =~ /mass storage/i) || + ($row->[15] && $row->[15] =~ /storage/) + )){ + push(@{$usb{'disk'}},$row); + } + elsif ($show{'network'} && ( + ($row->[14] && $row->[14] =~ /(ethernet|network|wifi)/i) || + ($row->[15] && $row->[15] =~ /(^ipw|^iwl|wifi)/) || + ($row->[13] && $row->[13] =~ /($network_regex)/i) + )){ + push(@{$usb{'network'}},$row); + } +} + +sub device_type { + my ($data) = @_; + my ($type); + # note: the 3/0/0 value passed will be decimal, not hex + my @types = split('/', $data) if $data; + # print @types,"\n"; + if (!@types || $types[0] eq '0' || scalar @types != 3){return '';} + elsif ($types[0] eq '255'){ return '';} + if (scalar @types == 3){ + $class_id = $types[0]; + $subclass_id = $types[1]; + $protocol_id = $types[2]; + } + if ($types[0] eq '1'){ + $type = 'audio';} + elsif ($types[0] eq '2'){ + if ($types[1] eq '2'){ + $type = 'abstract (modem)';} + elsif ($types[1] eq '6'){ + $type = 'ethernet network';} + elsif ($types[1] eq '10'){ + $type = 'mobile direct line';} + elsif ($types[1] eq '12'){ + $type = 'ethernet emulation';} + else { + $type = 'communication';} + } + elsif ($types[0] eq '3'){ + if ($types[2] eq '0'){ + $type = 'HID';} # actual value: None + elsif ($types[2] eq '1'){ + $type = 'keyboard';} + elsif ($types[2] eq '2'){ + $type = 'mouse';} + } + elsif ($types[0] eq '6'){ + $type = 'still imaging';} + elsif ($types[0] eq '7'){ + $type = 'printer';} + elsif ($types[0] eq '8'){ + $type = 'mass storage';} + # note: there is a bug in linux kernel that always makes hubs 9/0/0 + elsif ($types[0] eq '9'){ + if ($types[2] eq '0'){ + $type = 'full speed or root hub';} + elsif ($types[2] eq '1'){ + $type = 'hi-speed hub with single TT';} + elsif ($types[2] eq '2'){ + $type = 'hi-speed hub with multiple TTs';} + # seen protocol 3, usb3 type hub, but not documented on usb.org + elsif ($types[2] eq '3'){ + $type = 'super-speed hub';} + # this is a guess, never seen it + elsif ($types[2] eq '4'){ + $type = 'super-speed+ hub';} + } + elsif ($types[0] eq '10'){ + $type = 'CDC-data';} + elsif ($types[0] eq '11'){ + $type = 'smart card';} + elsif ($types[0] eq '13'){ + $type = 'content security';} + elsif ($types[0] eq '14'){ + $type = 'video';} + elsif ($types[0] eq '15'){ + $type = 'personal healthcare';} + elsif ($types[0] eq '16'){ + $type = 'audio-video';} + elsif ($types[0] eq '17'){ + $type = 'billboard';} + elsif ($types[0] eq '18'){ + $type = 'type-C bridge';} + elsif ($types[0] eq '88'){ + $type = 'Xbox';} + elsif ($types[0] eq '220'){ + $type = 'diagnostic';} + elsif ($types[0] eq '224'){ + if ($types[1] eq '1'){ + $type = 'bluetooth';} + elsif ($types[1] eq '2'){ + if ($types[2] eq '1'){ + $type = 'host wire adapter';} + elsif ($types[2] eq '2'){ + $type = 'device wire adapter';} + elsif ($types[2] eq '3'){ + $type = 'device wire adapter';} + } + } + # print "$data: $type\n"; + return $type; +} + +# Device name/driver string based test, return if not detected +# for linux based tests, and empty for bsd tests +sub check_type { + my ($name,$driver,$type) = @_; + $name = lc($name); + if (($driver && $driver =~ /hub/) || $name =~ /\b(hub)/i){ + $type = 'Hub'; + } + elsif ($name =~ /(audio|\bdac[0-9]*\b|(head|micro|tele)phone|hifi|\bmidi\b|\bmic\b|sound)/){ + $type = 'Audio'; + } + # Broadcom HP Portable SoftSailing + elsif (($driver && $driver =~ /\b(btusb|ubt)\b/) || $name =~ /(bluetooth)/){ + $type = 'Bluetooth' + } + elsif (($driver && $driver =~ /video/) || + $name =~ /(camera|display|\bdvb-t|\b(pc)?tv\bvideo|webcam)/){ + $type = 'Video'; + } + elsif ($name =~ /(wlan|wi-?fi|802\.1[15]|(11|54|108|240|300|433|450|900|1300)\s?mbps|(11|54|108|240)g\b|wireless[\s-][bgn]\b|wireless.*adapter)/){ + $type = 'WiFi'; + } + # note, until freebsd match to actual drivers, these top level driver matches aren't interesting + elsif (($driver && $bsd_type && $driver =~ /\b(muge)\b/) || + $name =~ /(ethernet|\blan|802\.3|100?\/1000?|gigabit|10\s?G(b|ig)?E)/){ + $type = 'Ethernet'; + } + # note: audio devices show HID sometimes, not sure why + elsif ($name =~ /(joystick|keyboard|mouse|trackball)/){ + $type = 'HID'; + } + elsif (($driver && $driver =~ /^(umass)$/) || + $name =~ /\b(disk|drive|flash)\b/){ + $type = 'Mass Storage'; + } + return $type; +} + +# linux only, will create a positive match to sound devices +sub set_asound_ids { + $b_asound = 1; + if (-d '/proc/asound'){ + # note: this will double the data, but it's easier this way. + # binxi tested for -L in the /proc/asound files, and used only those. + my @files = main::globber('/proc/asound/*/usbid'); + foreach (@files){ + my $id = main::reader($_,'',0); + push(@asound_ids, $id) if ($id && !(grep {/$id/} @asound_ids)); + } + } + main::log_data('dump','@asound_ids',\@asound_ids) if $b_log; +} + +# USB networking search string data, because some brands can have other products +# than wifi/nic cards, they need further identifiers, with wildcards. Putting +# the most common and likely first, then the less common, then some specifics +sub set_network_regex { + # belkin=050d; d-link=07d1; netgear=0846; ralink=148f; realtek=0bda; + # Atmel, Atheros make other stuff. NOTE: exclude 'networks': IMC Networks + # intel, ralink bluetooth as well as networking; (WG|WND?A)[0-9][0-9][0-9] netgear IDs + $network_regex = 'Ethernet|gigabit|\bISDN|\bLAN\b|Mobile\s?Broadband|'; + $network_regex .= '\bNIC\b|wi-?fi|Wireless[\s-][GN]\b|WLAN|'; + $network_regex .= '802\.(1[15]|3)|(10|11|54|108|240|300|450|1300)\s?Mbps|(11|54|108|240)g\b|100?\/1000?|'; + $network_regex .= '(100?|N)Base-?T\b|'; + $network_regex .= '(Actiontec|AirLink|Asus|Belkin|Buffalo|Dell|D-Link|DWA-|ENUWI-|'; + $network_regex .= 'Ralink|Realtek|Rosewill|RNX-|Samsung|Sony|TEW-|TP-Link|'; + $network_regex .= 'Zonet.*ZEW.*).*Wireless|'; + # Note: Intel Bluetooth wireless interface < should be caught by bluetooth tests + $network_regex .= '(\bD-Link|Network(ing)?|Wireless).*(Adapter|Interface)|'; + $network_regex .= '(Linksys|Netgear|Davicom)|'; + $network_regex .= 'Range(Booster|Max)|Samsung.*LinkStick|\b(WG|WND?A)[0-9][0-9][0-9]|'; + $network_regex .= '\b(050d:935b|0bda:8189|0bda:8197)\b'; +} + +# For linux, process rev, get mode. For bsds, get rev, speed. +# args: 0: sys/bsd; 1: speed_si; 2: speed_iec; 3: rev; 4: rev_info; 5: rx lanes; +# 6: tx lanes +# 1,2,3,4 passed by reference. +sub version_data { + return if !${$_[1]}; + if ($_[0] eq 'sys'){ + if (${$_[3]} && main::is_numeric(${$_[3]})){ + # as far as we know, 4 will not have subversions, but this may change, + # check how /sys reports this in coming year(s) + if (${$_[3]} =~ /^4/){ + ${$_[3]} = ${$_[3]} + 0; + } + else { + ${$_[3]} = sprintf('%.1f',${$_[3]}); + } + } + # BSD rev is synthetic, it's a hack. And no lane data, so not trying. + if ($b_admin && ${$_[1]} && ${$_[3]} && $_[5] && $_[6] && + ${$_[3]} =~ /^[1234]/){ + if (${$_[3]} =~ /^[12]/){ + if (${$_[1]} == 1.5){ + ${$_[4]} = '1.0';} + elsif (${$_[1]} == 12){ + ${$_[4]} = '1.1';} + elsif (${$_[1]} == 480){ + ${$_[4]} = '2.0';} + } + # Note: unless otherwise indicated, 1 lane is 1rx+1tx. + elsif (${$_[3]} =~ /^3/){ + if (${$_[1]} == 5000){ + ${$_[4]} = '3.2 gen-1x1';} # 1 lane + elsif (${$_[1]} == 10000){ + if ($_[6] == 1){ + ${$_[4]} = '3.2 gen-2x1';} # 1 lane + elsif ($_[6] == 2){ + ${$_[4]} = '3.2 gen-1x2';} # 2 lane + } + elsif (${$_[1]} == 20000){ + if ($_[6] == 1){ + ${$_[4]} = '3.2 gen-3x1';} # 1 lane + elsif ($_[6] == 2){ + ${$_[4]} = '3.2 gen-2x2';} # 2 lane + } + # just in case rev: 3.x shows these speeds + elsif (${$_[1]} == 40000){ + if ($_[6] == 1){ + ${$_[4]} = '4-v1 gen-4x1';} # 1 lane + elsif ($_[6] == 2){ + ${$_[4]} = '4-v1 gen-3x2';} # 2 lane + } + elsif (${$_[1]} == 80000){ + ${$_[4]} = '4-v2 gen-4x2'; # 2 lanes + } + ${$_[4]} = main::message('usb-mode-mismatch') if !${$_[4]}; + } + # NOTE: no realworld usb4 data, unclear if these gen are reliable. + # possible /sys will expose v1/v2/v3. Check future data. + elsif (${$_[3]} =~ /^4/){ + # gen 2: 10gb x 1 ln + if (${$_[1]} < 10001){ + ${$_[4]} = '4-v1 gen-2x1';} # 1 lane + # gen2: 10gb x 2 ln; gen3: 20gb x 1 ln. Confirm + elsif (${$_[1]} < 20001){ + if ($_[6] == 2){ + ${$_[4]} = '4-v1 gen-2x2';} # 2 lanes + elsif ($_[6] == 1){ + ${$_[4]} = '4-v1 gen-3x1';} # 1 lane + } + # gen3: 20gb x 2 ln; gen4 40gb x 1 ln. Confirm + elsif (${$_[1]} < 40001){ + if ($_[6] == 2){ + ${$_[4]} = '4-v1 gen-3x2';} # 2 lanes + elsif ($_[6] == 1){ + ${$_[4]} = '4-v2 gen-4x1';} # 1 lane + } + # 40gb x 2 ln + elsif (${$_[1]} < 80001){ + ${$_[4]} = '4-v2 gen-4x2';} # 2 lanes + # 3 lanes: 2 tx+tx @ 60gb, 1 rx+rx @ 40gb, wait for data + elsif (${$_[1]} < 120001){ + ${$_[4]} = '4-v2 gen-4x3-asym'; # 3 lanes, asymmetric + } + ${$_[4]} = main::message('usb-mode-mismatch') if !${$_[4]}; + } + } + } + else { + (${$_[1]},${$_[3]}) = prep_speed(${$_[1]}); + # bsd rev hardcoded. We want this set to undef if bad data + ${$_[3]} = usb_rev(${$_[1]}) if !${$_[3]}; + } + # Add Si/IEC units + if ($extra > 0 && ${$_[1]}){ + # 1 == 1000000 bits + my $si = ${$_[1]}; + if (${$_[1]} >= 1000){ + ${$_[1]} = (${$_[1]}/1000) . ' Gb/s'; + } + else { + ${$_[1]} = ${$_[1]} . ' Mb/s'; + } + if ($b_admin){ + $si = (($si*1000**2)/8); + if ($si < 1000000){ + ${$_[2]} = sprintf('%0.0f KiB/s',($si/1024)); + } + elsif ($si < 1000000000){ + ${$_[2]} = sprintf('%0.1f MiB/s',$si/1024**2); + } + else { + ${$_[2]} = sprintf('%0.2f GiB/s',($si/1024**3)); + } + } + } + # print Data::Dumper::Dumper \@_; +} + +## BSD SPEED/REV ## +# Mapping of speed string to known speeds. Unreliable, very inaccurate, and some +# unconfirmed. Without real data source can never be better than a decent guess. +# args: 0: speed string +sub prep_speed { + return if !$_[0]; + my $speed_si = $_[0]; + my $rev; + if ($_[0] =~ /^([0-9\.]+)\s*Mb/){ + $speed_si = $1; + } + elsif ($_[0] =~ /^([0-9\.]+)+\s*Gb/){ + $speed_si = $1 * 1000; + } + elsif ($_[0] =~ /usb4?\s?120/i){ + $speed_si = 120000;# 4 120Gbps + $rev = '4'; + } + elsif ($_[0] =~ /usb4?\s?80/i){ + $speed_si = 80000;# 4 80Gbps + $rev = '4'; + } + elsif ($_[0] =~ /usb4?\s?40/i){ + $speed_si = 40000;# 4 40Gbps + $rev = '4'; + } + elsif ($_[0] =~ /usb4?\s?20/i){ + $speed_si = 20000;# 4 20Gbps + $rev = '4'; + } + elsif ($_[0] =~ /usb\s?20|super[\s-]?speed\s?(\+|plus) gen[\s-]?2x2/i){ + $speed_si = 20000;# 3.2 20Gbps + $rev = '3.2'; + } + # could be 3.2, 20000 too, also superspeed+ + elsif ($_[0] =~ /super[\s-]?speed\s?(\+|plus)/i){ + $speed_si = 10000;# 3.1; # can't trust bsds to use superspeed+ but we'll hope + $rev = '3.1'; + } + elsif ($_[0] =~ /super[\s-]?speed/i){ + $speed_si = 5000;# 3.0; + $rev = '3.0'; + } + elsif ($_[0] =~ /hi(gh)?[\s-]?speed/i){ + $speed_si = 480; # 2.0, + $rev = '2.0'; + } + elsif ($_[0] =~ /full[\s-]?speed/i){ + $speed_si = 12; # 1.1 - could be full speed 1.1/2.0 + $rev = '1.1'; + } + elsif ($_[0] =~ /low?[\s-]?speed/i){ + $speed_si = 1.5; # 1.5 - could be 1.0, or low speed 1.1/2.0 + $rev = '1.0'; + } + else { + undef $speed_si; # we don't know what the syntax was + } + return ($speed_si,$rev); +} + +# Try to guess at usb rev version from speed. Unreliable, very inaccurate. +# Note: this will probably be so inaccurate with USB 3.2/4 that it might be best +# to remove this feature at some point, unless better data sources found. +# args: 0: speed +sub usb_rev { + return if !$_[0] || !main::is_numeric($_[0]); + my $rev; + if ($_[0] < 2){ + $rev = '1.0';} + elsif ($_[0] < 13) + {$rev = '1.1';} + elsif ($_[0] < 481){ + $rev = '2.0';} + # 5 Gbps + elsif ($_[0] < 5001) + {$rev = '3.0';} + # 10 Gbps, this can be 3.1, 3.2 or 4 + elsif ($_[0] < 10001){ + $rev = '3.1';} + # SuperSpeed 'USB 20Gbps', this can be 3.2 or 4 + elsif ($_[0] < 20001){ + $rev = '3.2';} + # 4 does not use 4.x syntax, and real lanes/rev/speed data source required. + # 4: 10-120 Gbps. Update once data available for USB 3.2/4 speed strings + elsif ($_[0] < 120001){ + $rev = '4';} + return $rev; +} + +## UTILITIES ## +# This is used to create an alpha sortable bus id for main $usb[0] +sub bus_id_alpha { + my ($id) = @_; + $id =~ s/^([1-9])-/0$1-/; + $id =~ s/([-\.:])([0-9])\b/${1}0$2/g; + return $id; +} + +sub process_power { + return if !${$_[0]}; + ${$_[0]} =~ s/\s//g; + # ${$_[0]} = '' if ${$_[0]} eq '0mA'; # better to handle on output +} +} + +######################################################################## +#### GENERATE OUTPUT +######################################################################## + +## OutputGenerator ## +# Also creates Short, Info, and System items +{ +package OutputGenerator; +my ($items,$subs); + +sub generate { + eval $start if $b_log; + my ($item,%checks); + PsData::set() if !$loaded{'ps-data'}; + main::set_sysctl_data() if $use{'sysctl'}; + main::set_dboot_data() if $bsd_type && !$loaded{'dboot'}; + # note: ps aux loads before logging starts, so create debugger data here + if ($b_log){ + # With logging, we already get ps wwwaux so no need to get it again here + main::log_data('dump','@ps_cmd',\@ps_cmd); + } + print Data::Dumper::Dumper \@ps_cmd if $dbg[61]; + if ($show{'short'}){ + $item = short_output(); + assign_data($item); + } + else { + if ($show{'system'}){ + $item = system_item(); + assign_data($item); + } + if ($show{'machine'}){ + DmidecodeData::set(\$checks{'dmi'}) if $use{'dmidecode'} && !$checks{'dmi'}; + $item = item_handler('Machine','machine'); + assign_data($item); + } + if ($show{'battery'}){ + DmidecodeData::set(\$checks{'dmi'}) if $use{'dmidecode'} && !$checks{'dmi'}; + $item = item_handler('Battery','battery'); + if ($item || $show{'battery-forced'}){ + assign_data($item); + } + } + if ($show{'ram'}){ + DmidecodeData::set(\$checks{'dmi'}) if $use{'dmidecode'} && !$checks{'dmi'}; + $item = item_handler('Memory','ram'); + assign_data($item); + } + if ($show{'slot'}){ + DmidecodeData::set(\$checks{'dmi'}) if $use{'dmidecode'} && !$checks{'dmi'}; + $item = item_handler('PCI Slots','slot'); + assign_data($item); + } + if ($show{'cpu'} || $show{'cpu-basic'}){ + DeviceData::set(\$checks{'device'}) if %risc && !$checks{'device'}; + DmidecodeData::set(\$checks{'dmi'}) if $use{'dmidecode'} && !$checks{'dmi'}; + my $arg = ($show{'cpu-basic'}) ? 'basic' : 'full' ; + $item = item_handler('CPU','cpu',$arg); + assign_data($item); + } + if ($show{'graphic'}){ + UsbData::set(\$checks{'usb'}) if !$checks{'usb'}; + DeviceData::set(\$checks{'device'}) if !$checks{'device'}; + $item = item_handler('Graphics','graphic'); + assign_data($item); + } + if ($show{'audio'}){ + UsbData::set(\$checks{'usb'}) if !$checks{'usb'}; + DeviceData::set(\$checks{'device'}) if !$checks{'device'}; + $item = item_handler('Audio','audio'); + assign_data($item); + } + if ($show{'network'}){ + UsbData::set(\$checks{'usb'}) if !$checks{'usb'}; + DeviceData::set(\$checks{'device'}) if !$checks{'device'}; + IpData::set() if ($show{'ip'} || ($bsd_type && $show{'network-advanced'})); + $item = item_handler('Network','network'); + assign_data($item); + } + if ($show{'bluetooth'}){ + UsbData::set(\$checks{'usb'}) if !$checks{'usb'}; + DeviceData::set(\$checks{'device'}) if !$checks{'device'}; + $item = item_handler('Bluetooth','bluetooth'); + assign_data($item); + } + if ($show{'logical'}){ + $item = item_handler('Logical','logical'); + assign_data($item); + } + if ($show{'raid'}){ + DeviceData::set(\$checks{'device'}) if !$checks{'device'}; + $item = item_handler('RAID','raid'); + assign_data($item); + } + if ($show{'disk'} || $show{'disk-basic'} || $show{'disk-total'} || $show{'optical'}){ + UsbData::set(\$checks{'usb'}) if !$checks{'usb'}; + $item = item_handler('Drives','disk'); + assign_data($item); + } + if ($show{'partition'} || $show{'partition-full'}){ + $item = item_handler('Partition','partition'); + assign_data($item); + } + if ($show{'swap'}){ + $item = item_handler('Swap','swap'); + assign_data($item); + } + if ($show{'unmounted'}){ + $item = item_handler('Unmounted','unmounted'); + assign_data($item); + } + if ($show{'usb'}){ + UsbData::set(\$checks{'usb'}) if !$checks{'usb'}; + $item = item_handler('USB','usb'); + assign_data($item); + } + if ($show{'sensor'}){ + $item = item_handler('Sensors','sensor'); + assign_data($item); + } + if ($show{'repo'}){ + $item = item_handler('Repos','repo'); + assign_data($item); + } + if ($show{'process'}){ + $item = item_handler('Processes','process'); + assign_data($item); + } + if ($show{'weather'}){ + $item = item_handler('Weather','weather'); + assign_data($item); + } + if ($show{'info'}){ + $item = info_item(); + assign_data($item); + } + } + if ($output_type ne 'screen'){ + main::output_handler($items); + } + eval $end if $b_log; +} + +## Short, Info, System Items ## +sub short_output { + eval $start if $b_log; + my $num = 0; + my $kernel_os = ($bsd_type) ? 'OS' : 'Kernel'; + my ($cpu_string,$speed,$speed_key,$type) = ('','','speed',''); + my $cpu = CpuItem::get('short'); + if (ref $cpu eq 'ARRAY' && scalar @$cpu > 1){ + $type = ($cpu->[2]) ? " (-$cpu->[2]-)" : ''; + ($speed,$speed_key) = ('',''); + if ($cpu->[6]){ + $speed_key = "$cpu->[3]/$cpu->[5]"; + $speed = "$cpu->[4]/$cpu->[6] MHz"; + } + else { + $speed_key = $cpu->[3]; + $speed = "$cpu->[4] MHz"; + } + $cpu->[1] ||= main::message('cpu-model-null'); + $cpu_string = $cpu->[0] . ' ' . $cpu->[1] . $type; + } + elsif ($bsd_type){ + if ($alerts{'sysctl'}->{'action'}){ + if ($alerts{'sysctl'}->{'action'} ne 'use'){ + $cpu_string = "sysctl $alerts{'sysctl'}->{'action'}"; + $speed = "sysctl $alerts{'sysctl'}->{'action'}"; + } + else { + $cpu_string = 'bsd support coming'; + $speed = 'bsd support coming'; + } + } + } + $speed ||= 'N/A'; # totally unexpected situation, what happened? + my $disk = DriveItem::get('short'); + # print Dumper \@disk; + my $disk_string = 'N/A'; + my ($size,$used) = ('',''); + my ($size_holder,$used_holder); + if (ref $disk eq 'ARRAY' && @$disk){ + $size = ($disk->[0]{'logical-size'}) ? $disk->[0]{'logical-size'} : $disk->[0]{'size'}; + # must be > 0 + if ($size && main::is_numeric($size)){ + $size_holder = $size; + $size = main::get_size($size,'string'); + } + $used = $disk->[0]{'used'}; + if ($used && main::is_numeric($disk->[0]{'used'})){ + $used_holder = $disk->[0]{'used'}; + $used = main::get_size($used,'string'); + } + # in some fringe cases size can be 0 so only assign 'N/A' if no percents etc + if ($size_holder && $used_holder){ + my $percent = ' (' . sprintf("%.1f", $used_holder/$size_holder*100) . '% used)'; + $disk_string = "$size$percent"; + } + else { + $size ||= main::message('disk-size-0'); + $disk_string = "$used/$size"; + } + } + my $memory = MemoryData::get('short'); + $memory = 'N/A' if !$memory; + # print join('; ', @cpu), " sleep: $cpu_sleep\n"; + if (!$loaded{'shell-data'} && $ppid && (!$b_irc || !$client{'name-print'})){ + ShellData::set(); + } + my $client = $client{'name-print'}; + my $client_shell = ($b_irc) ? 'Client' : 'Shell'; + if ($client{'version'}){ + $client .= ' ' . $client{'version'}; + } + my $data = [{ + main::key($num++,0,0,'CPU') => $cpu_string, + main::key($num++,0,0,$speed_key) => $speed, + main::key($num++,0,0,$kernel_os) => join(' ', @{main::get_kernel_data()}), + main::key($num++,0,0,'Up') => main::get_uptime(), + main::key($num++,0,0,'Mem') => $memory, + main::key($num++,0,0,'Storage') => $disk_string, + # could make -1 for ps aux itself, -2 for ps aux and self + main::key($num++,0,0,'Procs') => scalar @ps_aux, + main::key($num++,0,0,$client_shell) => $client, + main::key($num++,0,0,$self_name) => main::get_self_version(), + },]; + eval $end if $b_log; + return { + main::key($prefix,1,0,'SHORT') => $data, + }; +} + +sub info_item { + eval $start if $b_log; + my $num = 0; + my $running_in = ''; + my $data_name = main::key($prefix++,1,0,'Info'); + my ($index); + my ($available,$gpu_ram,$parent,$percent,$used) = ('',0,'','',''); + my $data = { + $data_name => [{}], + }; + $index = 0; + if (!$loaded{'memory'}){ + main::MemoryData::row('info',$data->{$data_name}[$index],\$num,1); + if ($gpu_ram){ + $data->{$data_name}[$index]{main::key($num++,0,2,'gpu')} = $gpu_ram; + } + $index++; + } + $data->{$data_name}[$index]{main::key($num++,0,1,'Processes')} = scalar @ps_aux; + my $uptime = main::get_uptime(); + if ($bsd_type || $extra < 2){ + $data->{$data_name}[$index]{main::key($num++,1,1,'Uptime')} = $uptime; + } + if (!$bsd_type && $extra > 1){ + my $power = PowerData::get(); + $data->{$data_name}[$index]{main::key($num++,1,1,'Power')} = ''; + $data->{$data_name}[$index]{main::key($num++,0,2,'uptime')} = $uptime; + if ($power->{'states-avail'}){ + $data->{$data_name}[$index]{main::key($num++,0,2,'states')} = $power->{'states-avail'}; + } + my $resumes = (defined $power->{'suspend-resumes'}) ? $power->{'suspend-resumes'} : undef; + if ($extra > 2){ + my $suspend = (defined $power->{'suspend-active'}) ? $power->{'suspend-active'} : ''; + $data->{$data_name}[$index]{main::key($num++,1,2,'suspend')} = $suspend; + if ($b_admin && $power->{'suspend-avail'}){ + $data->{$data_name}[$index]{main::key($num++,0,3,'avail')} = $power->{'suspend-avail'}; + } + if (defined $resumes){ + $data->{$data_name}[$index]{main::key($num++,0,3,'wakeups')} = $resumes; + if ($b_admin && $power->{'suspend-fails'}){ + $data->{$data_name}[$index]{main::key($num++,0,3,'fails')} = $power->{'suspend-fails'}; + } + } + if (defined $power->{'hibernate-active'}){ + $data->{$data_name}[$index]{main::key($num++,1,2,'hibernate')} = $power->{'hibernate-active'}; + if ($b_admin && $power->{'hibernate-avail'}){ + $data->{$data_name}[$index]{main::key($num++,0,3,'avail')} = $power->{'hibernate-avail'}; + } + if ($b_admin && $power->{'hibernate-image-size'}){ + $data->{$data_name}[$index]{main::key($num++,0,3,'image')} = $power->{'hibernate-image-size'}; + } + } + if ($b_admin){ + PsData::set_power(); + if (@{$ps_data{'power-services'}}){ + my $services; + main::make_list_value($ps_data{'power-services'},\$services,',','sort'); + $data->{$data_name}[$index]{main::key($num++,0,2,'services')} = $services; + } + } + } + else { + if (defined $resumes){ + $data->{$data_name}[$index]{main::key($num++,0,2,'wakeups')} = $resumes; + } + } + } + if ((!$b_display || $force{'display'}) || $extra > 0){ + my $init = InitData::get(); + my $init_type = ($init->{'init-type'}) ? $init->{'init-type'}: 'N/A'; + $data->{$data_name}[$index]{main::key($num++,1,1,'Init')} = $init_type; + if ($extra > 1){ + my $init_version = ($init->{'init-version'}) ? $init->{'init-version'}: 'N/A'; + $data->{$data_name}[$index]{main::key($num++,0,2,'v')} = $init_version; + } + if ($init->{'rc-type'}){ + $data->{$data_name}[$index]{main::key($num++,1,2,'rc')} = $init->{'rc-type'}; + if ($init->{'rc-version'}){ + $data->{$data_name}[$index]{main::key($num++,0,3,'v')} = $init->{'rc-version'}; + } + } + if ($init->{'runlevel'}){ + my $key = ($init->{'init-type'} && $init->{'init-type'} eq 'systemd') ? 'target' : 'runlevel'; + $data->{$data_name}[$index]{main::key($num++,1,2,$key)} = $init->{'runlevel'}; + } + if ($extra > 1){ + if ($init->{'default'}){ + $data->{$data_name}[$index]{main::key($num++,0,3,'default')} = $init->{'default'}; + } + if ($b_admin && (my $tool = ServiceData::get('tool',''))){ + $data->{$data_name}[$index]{main::key($num++,0,2,'tool')} = $tool; + undef %service_tool; + } + } + } + $index++ if $extra > 0; + if ($extra > 0 && !$loaded{'package-data'}){ + my $packages = PackageData::get('inner',\$num); + + for (keys %$packages){ + $data->{$data_name}[$index]{$_} = $packages->{$_}; + } + } + if ($extra > 0){ + my (%cc,$path); + foreach my $compiler (qw(clang gcc zigcc)){ + my $comps = main::get_compiler_data($compiler); + if (@$comps){ + $cc{$compiler}->{'version'} = shift @$comps; + if ($extra > 1 && @$comps){ + $cc{$compiler}->{'alt'} = join('/', @$comps); + } + $cc{$compiler}->{'version'} ||= 'N/A'; # should not be needed after fix but leave in case undef + } + } + my $cc_value = ($cc{'clang'} || $cc{'gcc'} || $cc{'zigcc'}) ? '': 'N/A'; + $data->{$data_name}[$index]{main::key($num++,1,1,'Compilers')} = $cc_value; + foreach my $compiler (qw(clang gcc zigcc)){ + if ($cc{$compiler}){ + $data->{$data_name}[$index]{main::key($num++,0,2,$compiler)} = $cc{$compiler}->{'version'}; + if ($extra > 1 && $cc{$compiler}->{'alt'}){ + $data->{$data_name}[$index]{main::key($num++,0,3,'alt')} = $cc{$compiler}->{'alt'}; + } + } + } + } + # $index++ if $extra > 1 && !$loaded{'shell-data'}; + if (!$loaded{'shell-data'} && $ppid && (!$b_irc || !$client{'name-print'})){ + ShellData::set(); + } + my $client_shell = ($b_irc) ? 'Client' : 'Shell'; + my $client = $client{'name-print'}; + if (!$b_irc && $extra > 1){ + # some bsds don't support -f option to get PPPID + # note: root/su - does not have $DISPLAY usually + if ($b_display && !$force{'display'} && $ppid && $client{'pppid'}){ + $parent = ShellData::shell_launcher(); + } + else { + ShellData::tty_number() if !$loaded{'tty-number'}; + if ($client{'tty-number'} ne ''){ + my $tty_type = ''; + if ($client{'tty-number'} =~ /^[a-f0-9]+$/i){ + $tty_type = 'tty '; + } + elsif ($client{'tty-number'} =~ /pts/i){ + $tty_type = 'pty '; + } + $parent = "$tty_type$client{'tty-number'}"; + } + } + # can be tty 0 so test for defined + $running_in = $parent if $parent; + if ($extra > 2 && $running_in && ShellData::ssh_status()){ + $running_in .= ' (SSH)'; + } + if ($extra > 2 && $client{'su-start'}){ + $client .= " ($client{'su-start'})"; + } + } + $data->{$data_name}[$index]{main::key($num++,1,1,$client_shell)} = $client; + if ($extra > 0 && $client{'version'}){ + $data->{$data_name}[$index]{main::key($num++,0,2,'v')} = $client{'version'}; + } + if (!$b_irc){ + if ($extra > 2 && $client{'default-shell'}){ + $data->{$data_name}[$index]{main::key($num++,1,2,'default')} = $client{'default-shell'}; + $data->{$data_name}[$index]{main::key($num++,0,3,'v')} = $client{'default-shell-v'} if $client{'default-shell-v'}; + } + if ($running_in){ + $data->{$data_name}[$index]{main::key($num++,0,2,'running-in')} = $running_in; + } + } + $data->{$data_name}[$index]{main::key($num++,0,1,$self_name)} = main::get_self_version(); + eval $end if $b_log; + return $data; +} + +sub system_item { + eval $start if $b_log; + my ($cont_desk,$ind_dm,$num) = (1,2,0); + my ($index); + my $data_name = main::key($prefix++,1,0,'System'); + my ($desktop,$desktop_key,$toolkit,$wm) = ('','Desktop','',''); + my ($cs_curr,$cs_avail,@desktop_data,$de_components,$de_info,$de_info_v, + $de_version,$tools_running,$tools_avail,$tk_version,$wm_version); + my $data = { + $data_name => [{}], + }; + $index = 0; + if ($show{'host'}){ + $data->{$data_name}[$index]{main::key($num++,0,1,'Host')} = main::get_hostname(); + } + my $dms = DmData::get(); + my $dm_key = (!$dms->{'dm'} && $dms->{'lm'}) ? 'LM' : 'DM'; + my $kernel_data = main::get_kernel_data(); + $data->{$data_name}[$index]{main::key($num++,1,1,'Kernel')} = $kernel_data->[0]; + $data->{$data_name}[$index]{main::key($num++,0,2,'arch')} = $kernel_data->[1]; + $data->{$data_name}[$index]{main::key($num++,0,2,'bits')} = main::get_kernel_bits(); + if ($extra > 0){ + my $compiler = KernelCompiler::get(); # get compiler data + if (scalar @$compiler != 2){ + @$compiler = ('N/A', ''); + } + $data->{$data_name}[$index]{main::key($num++,1,2,'compiler')} = $compiler->[0]; + # if no compiler, obviously no version, so don't waste space showing. + if ($compiler->[0] ne 'N/A'){ + $compiler->[1] ||= 'N/A'; + $data->{$data_name}[$index]{main::key($num++,0,3,'v')} = $compiler->[1]; + } + } + if ($extra > 2){ + main::get_kernel_clocksource(\$cs_curr,\$cs_avail); + $cs_curr ||= 'N/A'; + $data->{$data_name}[$index]{main::key($num++,1,2,'clocksource')} = $cs_curr; + if ($b_admin && $cs_avail){ + $data->{$data_name}[$index]{main::key($num++,0,3,'avail')} = $cs_avail; + } + } + if ($b_admin && (my $params = KernelParameters::get())){ + # print "$params\n"; + if ($use{'filter-label'}){ + main::filter_partition('system', \$params, '=LABEL='); + } + if ($use{'filter-uuid'}){ + main::filter_partition('system', \$params, '=UUID='); + main::filter_partition('system', \$params, 'systemd.machine_id='); + + } + $data->{$data_name}[$index]{main::key($num++,0,2,'parameters')} = $params; + + } + $index++; + # note: tty can have the value of 0 but the two tools + # return '' if undefined, so we test for explicit '' + if ($b_display){ + my $desktop_data = DesktopData::get(); + $desktop = $desktop_data->[0] if $desktop_data->[0]; + if ($desktop){ + $de_version = ($desktop_data->[1]) ? $desktop_data->[1] : 'N/A'; + if ($extra > 0 && $desktop_data->[2]){ + $toolkit = $desktop_data->[2]; + if ($desktop_data->[1] || $desktop_data->[3]){ + $tk_version = ($desktop_data->[3]) ? $desktop_data->[3] : 'N/A'; + } + } + if ($b_admin && $desktop_data->[9] && $desktop_data->[10]){ + $de_info = $desktop_data->[9]; + $de_info_v = $desktop_data->[10]; + } + } + # don't print the desktop if it's a wm and the same + if ($extra > 1 && $desktop_data->[5] && + (!$desktop_data->[0] || $desktop_data->[5] =~ /^(deepin.+|gnome[\s_-]shell|budgie.+)$/i || + index(lc($desktop_data->[5]),lc($desktop_data->[0])) == -1)){ + $wm = $desktop_data->[5]; + $wm_version = $desktop_data->[6] if $extra > 2 && $desktop_data->[6]; + } + if ($extra > 2 && $desktop_data->[4]){ + $de_components = $desktop_data->[4]; + } + if ($extra > 2 && $desktop_data->[7]){ + $tools_running = $desktop_data->[7]; + } + if ($b_admin && $desktop_data->[8]){ + $tools_avail = $desktop_data->[8]; + } + } + if (!$b_display || (!$desktop && $b_root)){ + ShellData::tty_number() if !$loaded{'tty-number'}; + my $tty = $client{'tty-number'}; + if (!$desktop){ + $de_components = ''; + } + # it is defined, as '' + if ($tty eq '' && $client{'console-irc'}){ + ShellData::console_irc_tty() if !$loaded{'con-irc-tty'}; + $tty = $client{'con-irc-tty'}; + } + if ($tty ne ''){ + my $tty_type = ''; + if ($tty =~ /^[a-f0-9]+$/i){ + $tty_type = 'tty '; + } + elsif ($tty =~ /pts/i){ + $tty_type = 'pty '; + } + $desktop = "$tty_type$tty"; + } + $desktop_key = 'Console'; + $ind_dm = 1; + $cont_desk = 0; + } + else { + $dm_key = lc($dm_key); + } + $desktop ||= 'N/A'; + $data->{$data_name}[$index]{main::key($num++,$cont_desk,1,$desktop_key)} = $desktop; + if ($b_display){ + if ( $de_version){ + $data->{$data_name}[$index]{main::key($num++,0,2,'v')} = $de_version; + } + if ($toolkit){ + $data->{$data_name}[$index]{main::key($num++,1,2,'tk')} = $toolkit; + if ($tk_version){ + $data->{$data_name}[$index]{main::key($num++,0,3,'v')} = $tk_version; + } + } + if ($de_info){ + $data->{$data_name}[$index]{main::key($num++,1,2,'info')} = $de_info; + $data->{$data_name}[$index]{main::key($num++,0,3,'v')} = $de_info_v; + } + if ($extra > 1){ + if ($wm){ + $data->{$data_name}[$index]{main::key($num++,1,2,'wm')} = $wm; + if ($wm_version){ + $data->{$data_name}[$index]{main::key($num++,0,3,'v')} = $wm_version; + } + } + if ($extra > 2){ + if ($de_components){ + $data->{$data_name}[$index]{main::key($num++,0,2,'with')} = $de_components; + } + if ($tools_running || $tools_avail){ + $tools_running ||= ''; + $data->{$data_name}[$index]{main::key($num++,1,2,'tools')} = $tools_running; + if ($tools_avail){ + $data->{$data_name}[$index]{main::key($num++,0,3,'avail')} = $tools_avail; + } + } + if (defined $ENV{'XDG_VTNR'}){ + $data->{$data_name}[$index]{main::key($num++,0,2,'vt')} = $ENV{'XDG_VTNR'}; + } + } + } + } + if ($extra > 1){ + # note: version only present if proper extra level so no need to test again + if (%$dms || $desktop_key ne 'Console'){ + my $type = (!$dms->{'dm'} && $dms->{'lm'}) ? $dms->{'lm'}: $dms->{'dm'}; + if ($type && @$type && scalar @$type > 1){ + my $i = 0; + $data->{$data_name}[$index]{main::key($num++,1,$ind_dm,$dm_key)} = ''; + foreach my $dm_data (@{$type}){ + $i++; + $data->{$data_name}[$index]{main::key($num++,1,($ind_dm + 1),$i)} = $dm_data->[0]; + if ($dm_data->[1]){ + $data->{$data_name}[$index]{main::key($num++,0,($ind_dm + 2),'v')} = $dm_data->[1]; + } + if ($dm_data->[2]){ + $data->{$data_name}[$index]{main::key($num++,0,($ind_dm + 2),'note')} = $dm_data->[2]; + } + } + } + else { + my $dm = ($type && $type->[0][0]) ? $type->[0][0] : 'N/A'; + $data->{$data_name}[$index]{main::key($num++,1,$ind_dm,$dm_key)} = $dm; + if ($type && @{$type} && $type->[0][1]){ + $data->{$data_name}[$index]{main::key($num++,0,($ind_dm + 1),'v')} = $type->[0][1]; + } + } + } + } + # if ($extra > 2 && $desktop_key ne 'Console'){ + # my $tty = ShellData::tty_number() if !$loaded{'tty-number'}; + # $data->{$data_name}[$index]{main::key($num++,0,1,'vc')} = $tty if $tty ne ''; + # } + my $distro_key = ($bsd_type) ? 'OS': 'Distro'; + my $distro = DistroData::get(); + $distro->{'name'} ||= 'N/A'; + $data->{$data_name}[$index]{main::key($num++,1,1,$distro_key)} = $distro->{'name'}; + if ($extra > 0 && $distro->{'base'}){ + $data->{$data_name}[$index]{main::key($num++,0,2,'base')} = $distro->{'base'}; + } + eval $end if $b_log; + return $data; +} + +## Item Processors ## +sub assign_data { + return if !$_[0] || ref $_[0] ne 'HASH'; + if ($output_type eq 'screen'){ + main::print_data($_[0]); + } + else { + push(@$items,$_[0]); + } +} + +sub item_handler { + eval $start if $b_log; + my ($key,$item,$arg) = @_; + set_subs() if !$subs; + my $rows = $subs->{$item}($arg); + eval $end if $b_log; + if (ref $rows eq 'ARRAY' && @$rows){ + return {main::key($prefix++,1,0,$key) => $rows}; + } +} + +sub set_subs { + $subs = { + 'audio' => \&AudioItem::get, + 'battery' => \&BatteryItem::get, + 'bluetooth' => \&BluetoothItem::get, + 'cpu' => \&CpuItem::get, + 'disk' => \&DriveItem::get, + 'graphic' => \&GraphicItem::get, + 'logical' => \&LogicalItem::get, + 'machine' => \&MachineItem::get, + 'network' => \&NetworkItem::get, + 'partition' => \&PartitionItem::get, + 'raid' => \&RaidItem::get, + 'ram' => \&RamItem::get, + 'repo' => \&RepoItem::get, + 'process' => \&ProcessItem::get, + 'sensor' => \&SensorItem::get, + 'slot' => \&SlotItem::get, + 'swap' => \&SwapItem::get, + 'unmounted' => \&UnmountedItem::get, + 'usb' => \&UsbItem::get, + 'weather' => \&WeatherItem::get, + }; +} +} + +####################################################################### +#### LAUNCH +######################################################################## + +main(); ## From the End comes the Beginning + +## note: this EOF is needed for self updater, triggers the full download ok +###**EOF**###