diff options
Diffstat (limited to 'inxi')
-rwxr-xr-x | inxi | 37648 |
1 files changed, 26107 insertions, 11541 deletions
@@ -1,11 +1,12 @@ #!/usr/bin/env perl ## infobash: Copyright (C) 2005-2007 Michiel de Boer aka locsmif -## inxi: Copyright (C) 2008-2021 Harald Hope -## Additional features (C) Scott Rogers - kde, cpu info +## 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 <hjt at sidux.com> ## Steven Barrett (aka: damentz) - usb audio patch; swap percent used patch -## Jarett.Stevens - dmidecode -M patch for older systems with the /sys -## +## 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 @@ -13,6 +14,8 @@ ## ## 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; @@ -20,93 +23,99 @@ use warnings; use 5.008; ## Perl 7 things for testing: depend on Perl 5.032 -#use 5.032; +# use 5.034; # use compat::perl5; # act like Perl 5's defaults -#no feature qw(indirect); -#no multidimensional; -#no bareword::filehandles; +# 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::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(uname strftime ttyname); -# use feature qw(state); +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.01'; -my $self_date='2021-02-08'; +my $self_version='3.3.33'; +my $self_date='2024-02-06'; my $self_patch='00'; ## END INXI INFO ## -### INITIALIZE VARIABLES ### +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 ($self_path, $user_config_dir, $user_config_file,$user_data_dir); +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 $debug=0; -my (@t0,$end,$start,$fh_l,$log_file); # log file handle, file -my ($b_hires,$t1,$t2,$t3) = (0,0,0,0); +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 -## Hashes -my (%alerts,%build_prop,%client,%colors,%debugger,%dl,%files, -%dmmapper,%mapper,%program_values,%rows,%sensors_raw,%system_files); - -## Arrays -# ps_aux is full output, ps_cmd is only the last 10 columns to last -my (@app,@dmesg_boot,@devices_audio,@devices_bluetooth,@devices_graphics, -@devices_network,@devices_hwraid,@devices_timer,@dmi,@gpudata,@ifs,@ifs_bsd, -@paths,@proc_partitions,@ps_aux,@ps_cmd,@ps_gui,@sensors_exclude,@sensors_use, -@sysctl,@sysctl_battery,@sysctl_sensors,@sysctl_machine,@uname,@usb); -## Disk arrays -my (@dm_boot_disk,@dm_boot_optical,@glabel,@gpart,@labels,@lsblk,@lvm, -@lvm_raid,@md_raid,@partitions,@raw_logical,@sysctl_disks,@swaps,@uuids,@zfs_raid); -my @test = (0,0,0,0,0); - -## Booleans -my ($b_active_general,$b_active_lvm, -$b_admin,$b_android,$b_arm,$b_bb_ps,$b_block_tool,$b_build_prop, -$b_display,$b_dmesg_boot_check,$b_dmi,$b_dmidecode_force, -$b_fake_bluetooth,$b_fake_bsd,$b_fake_cpu,$b_fake_dboot,$b_fake_dmidecode, -$b_fake_logical,$b_fake_pciconf,$b_fake_raid,$b_fake_sensors,$b_fake_sysctl, -$b_fake_usbdevs,$b_force_display, -$b_gpudata,$b_hddtemp_force,$b_irc,$b_log,$b_log_colors,$b_log_full,$b_lvm,$b_lvm_data, -$b_man,$b_mapper,$b_mdadm,$b_mem,$b_mips, -$b_no_html_wan,$b_no_sudo,$b_pci,$b_pci_tool,$b_pkg,$b_ppc,$b_proc_partitions, -$b_ps_gui,$b_root,$b_running_in_display,$b_sensors,$b_skip_dig, -$b_slot_tool,$b_soc_audio,$b_soc_bluetooth,$b_soc_gfx,$b_soc_net,$b_soc_timer,$b_sparc, -$b_swaps,$b_sysctl,$b_usb,$b_usb_check,$b_usb_sys,$b_usb_tool, -$b_wmctrl); -## Disk checks -my ($b_dm_boot_disk,$b_dm_boot_optical,$b_glabel,$b_hardware_raid, -$b_label_uuid,$b_lsblk,$b_partitions,$b_raid,$b_smartctl); -# initialize basic use features -my %use = ( -'sysctl_disk' => 1, # unused currently -'update' => 1, # switched off/on with maintainer config ALLOW_UPDATE -'weather' => 1, # switched off/on with maintainer config ALLOW_WEATHER -); + +## 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,$wan_url) = ('','','','','',''); -my ($bits_sys,$cpu_arch); -my ($cpu_sleep,$dl_timeout,$limit,$ps_cols,$ps_count) = (0.35,4,10,0,5); +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 ($dl_ua,$weather_source,$weather_unit) = ('s-tools/' . $self_name . '-',100,'mi'); +my ($weather_source,$weather_unit) = (100,'mi'); + ## Tools -my ($display,$ftp_alt,$tty_session); -my ($display_opt,$sudo) = ('',''); +my ($display,$ftp_alt); +my ($display_opt,$sudoas) = ('',''); ## Output my $extra = 0;# supported values: 0-3 @@ -115,36 +124,40 @@ my $line1 = "------------------------------------------------------------------- my $line2 = "======================================================================\n"; my $line3 = "----------------------------------------\n"; my ($output_file,$output_type) = ('','screen'); -my $prefix = 0; # for the primiary row hash key prefix +my $prefix = 0; # for the primary row hash key prefix -# these will assign a separator to non irc states. Important! Using ':' can +## 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 = ( +my %sep = ( 's1-irc' => ':', 's1-console' => ':', 's2-irc' => '', 's2-console' => ':', ); -my %show; #$show{'host'} = 1; my %size = ( -'console' => 115, +'console' => 80, # In display, orig: 115 # Default indentation level. NOTE: actual indent is 1 greater to allow for # spacing 'indent' => 11, -'wrap-max' => 90, +'indents' => 2, 'irc' => 100, # shorter because IRC clients have nick lists etc -'max' => 0, -'no-display' => 130, -# these will be set dynamically in set_display_width() -'term' => 80, -'term-lines' => 100, +'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 ); - -## debug / temp tools -$debugger{'sys'} = 1; -$client{'test-konvi'} = 0; ######################################################################## #### STARTUP @@ -155,24 +168,24 @@ $client{'test-konvi'} = 0; #### ------------------------------------------------------------------- sub main { -# print Dumper \@ARGV; + # print Dumper \@ARGV; eval $start if $b_log; initialize(); ## Uncomment these two values for start client debugging - # $debug = 3; # 3 prints timers / 10 prints to log file + # $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(); + # my $ob_start = StartClient->new(); #$ob_start->get_client_data(); - StartClient::get_client_data(); - # print_line( Dumper \%client); - get_options(); + StartClient::set(); + # print_line(Dumper \%client); + OptionsHandler::get(); set_debugger(); # right after so it's set - check_tools(); + CheckTools::set(); set_colors(); set_sep(); # print download_file('stdout','https://') . "\n"; - generate_lines(); + OutputGenerator::generate(); eval $end if $b_log; cleanup(); # weechat's executor plugin forced me to do this, and rightfully so, @@ -185,160 +198,222 @@ sub main { #### ------------------------------------------------------------------- sub initialize { - set_os(); set_path(); set_user_paths(); set_basics(); - system_files('set'); - get_configs(); + set_system_files(); + set_os(); + Configs::set(); # set_downloader(); - set_display_width('live'); -} - -sub check_tools { - my ($action,$program,$message,@data,%commands); - if ($b_dmi){ - $action = 'use'; - if ($program = check_program('dmidecode')) { - @data = grabber("$program -t chassis -t baseboard -t processor 2>&1"); - if (scalar @data < 15){ - if ($b_root) { - foreach (@data){ - if ($_ =~ /No SMBIOS/i){ - $action = 'smbios'; - last; - } - elsif ($_ =~ /^\/dev\/mem: Operation/i){ - $action = 'no-data'; - last; - } - else { - $action = 'unknown-error'; - last; - } - } + 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; } - else { - if (grep { $_ =~ /^\/dev\/mem: Permission/i } @data){ - $action = 'permissions'; - } - else { - $action = 'unknown-error'; - } + elsif (grep { $_ =~ /$commands{$test}->[3]/i } @data){ + $action = 'permissions'; } } } else { $action = 'missing'; } - $alerts{'dmidecode'} = { - 'action' => $action, - 'missing' => row_defaults('tool-missing-required','dmidecode'), - 'permissions' => row_defaults('tool-permissions','dmidecode'), - 'path' => $program, - 'smbios' => row_defaults('dmidecode-smbios'), - 'no-data' => row_defaults('dmidecode-dev-mem'), - 'unknown-error' => row_defaults('tool-unknown-error','dmidecode'), - }; - } - # 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 ($b_lvm || $b_pci || $b_sysctl || $show{'bluetooth'}){ - if (!$bsd_type){ - if ($b_pci ){ - $commands{'lspci'} = '-n'; - } - if ($b_lvm){ - $commands{'lvs'} = ''; - } + $alerts{$test}->{'action'} = $action; + $alerts{$test}->{'path'} = $program; + if ($action eq 'missing'){ + $alerts{$test}->{'message'} = main::message('tool-missing-recommends',"$test"); } - else { - if ($b_pci ){ - $commands{'pciconf'} = '-l'; - $commands{'pcictl'} = 'list'; - $commands{'pcidump'} = ''; + 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; } - if ($b_sysctl ){ - # note: there is a case of kernel.osrelease but it's a linux distro - $commands{'sysctl'} = 'kern.osrelease'; + elsif ($_ =~ /No SMBIOS/i){ + $action = 'smbios'; + last; } - } - foreach ( keys %commands ){ - $action = 'use'; - if ($program = check_program($_)) { - # > 0 means error in shell - #my $cmd = "$program $commands{$_} >/dev/null"; - #print "$cmd\n"; - $pci_tool = $_ if $_ =~ /pci/; - $action = 'permissions' if system("$program $commands{$_} >/dev/null 2>&1"); + elsif ($_ =~ /^\/dev\/mem: Operation/i){ + $action = 'no-data'; + last; } else { - $action = 'missing'; + $action = 'unknown-error'; + last; } - $alerts{$_} = { - 'action' => $action, - 'missing' => row_defaults('tool-missing-incomplete',"$_"), - 'path' => $program, - 'permissions' => row_defaults('tool-permissions',"$_"), - }; } } - %commands = (); + 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'}){ - # hangs when bluetooth service is enabled - # $commands{'bt-adapter'} = '-l'; - # hangs endlessly - # $commands{'bluetoothctl'} = 'list'; - $commands{'hciconfig'} = 'linux'; + $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'} = 'linux'; - } - # note: lsusb ships in FreeBSD ports sysutils/usbutils - if ($b_usb){ - $commands{'lsusb'} = 'all'; - $commands{'usbdevs'} = 'bsd'; + $commands{'sensors'} = ['missing','linux','','']; } if ($show{'ip'} || ($bsd_type && $show{'network-advanced'})){ - $commands{'ip'} = 'linux'; - $commands{'ifconfig'} = 'all'; + $commands{'ip'} = ['missing','linux','','']; + $commands{'ifconfig'} = ['missing','','','']; } # can't check permissions since we need to know the partition/disc - if ($b_block_tool){ - $commands{'blockdev'} = 'linux'; - $commands{'lsblk'} = 'linux'; - } - if ($b_mdadm){ - $commands{'mdadm'} = 'linux'; - } - if ($b_smartctl){ - $commands{'smartctl'} = 'all'; - } - foreach ( keys %commands ){ - $action = 'use'; - $program = ''; - $message = row_defaults('tool-present'); - if ( ($commands{$_} eq 'linux' && $os ne 'linux' ) || ($commands{$_} eq 'bsd' && $os eq 'linux' ) ){ - $message = row_defaults('tool-missing-os', ucfirst($os) . " $_"); - $action = 'platform'; - } - elsif (!($program = check_program($_))){ - $message = row_defaults('tool-missing-recommends',"$_"); - $action = 'missing'; - } - $alerts{$_} = { - 'action' => $action, - 'missing' => $message, - 'path' => $program, - 'platform' => $message, + 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', }; } - # print Dumper \%alerts; - set_fake_bsd_tools() if $b_fake_bsd; + 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'; + } +} } -# args: 1 - desktop/app command for --version; 2 - search string; -# 3 - space print number; 4 - [optional] version arg: -v, version, etc -# 5 - [optional] exit first find 0/1; 6 - [optional] 0/1 stderr output + sub set_basics { ### LOCALIZATION - DO NOT CHANGE! ### # set to default LANG to avoid locales errors with , or . @@ -347,15 +422,15 @@ sub set_basics { $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 = ( check_program('tty') && system('tty >/dev/null') ) ? 1 : 0; + $b_irc = (check_program('tty') && system('tty >/dev/null')) ? 1 : 0; # print "birc: $b_irc\n"; - $b_display = ( $ENV{'DISPLAY'} ) ? 1 : 0; + $b_display = ($ENV{'DISPLAY'}) ? 1 : 0; $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; - $dl{'fetch'} = 1; $client{'console-irc'} = 0; $client{'dcop'} = (check_program('dcop')) ? 1 : 0; $client{'qdbus'} = (check_program('qdbus')) ? 1 : 0; @@ -364,96 +439,114 @@ sub set_basics { $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); -} - -# args: $1 - default OR override default cols max integer count. $_[0] -# is the display width override. -sub set_display_width { - my ($width) = @_; - if ( $width eq 'live' ){ - ## sometimes tput will trigger an error (mageia) if irc client - if ( ! $b_irc ){ - if ( check_program('tput') ) { - # trips error if use qx()... - chomp($size{'term'}=qx{tput cols}); - chomp($size{'term-lines'}=qx{tput lines}); - $size{'term-cols'} = $size{'term'}; - } - # print "tc: $size{'term'} cmc: $size{'console'}\n"; - # double check, just in case it's missing functionality or whatever - if ( $size{'term'} == 0 || !is_int($size{'term'}) ){ - $size{'term'}=80; - # we'll be using this for terminal dimensions later so don't set default. - # $size{'term-lines'}=100; - } - } - # this lets you set different size for in or out of display server - if ( ! $b_running_in_display && $size{'no-display'} ){ - $size{'console'}=$size{'no-display'}; - } - # term_cols is set in top globals, using tput cols - # print "tc: $size{'term'} cmc: $size{'console'}\n"; - if ( $size{'term'} < $size{'console'} ){ - $size{'console'}=$size{'term'}; - } - # adjust, some terminals will wrap if output cols == term cols - $size{'console'}=( $size{'console'} - 2 ); - # echo cmc: $size{'console'} - # comes after source for user set stuff - if ( ! $b_irc ){ - $size{'max'}=$size{'console'}; - } - else { - $size{'max'}=$size{'irc'}; + $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 } } - else { - $size{'max'}=$width; - } - # print "tc: $size{'term'} cmc: $size{'console'} cm: $size{'max'}\n"; } -# only for dev/debugging BSD -sub set_fake_bsd_tools { - $system_files{'dmesg-boot'} = '/var/run/dmesg.boot' if $b_fake_dboot; - $alerts{'pciconf'}->{'action'} = 'use' if $b_fake_pciconf; - $alerts{'sysctl'}->{'action'} = 'use' if $b_fake_sysctl; - if ($b_fake_usbdevs){ - $alerts{'usbdevs'}->{'action'} = 'use'; - $alerts{'lsusb'} = { - 'action' => 'missing', - 'missing' => 'Required program lsusb not available', - }; +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"; } -# NOTE: most tests internally are against !$bsd_type sub set_os { @uname = uname(); $os = lc($uname[0]); $cpu_arch = lc($uname[-1]); - if ($cpu_arch =~ /arm|aarch/){$b_arm = 1;} - elsif ($cpu_arch =~ /mips/) {$b_mips = 1} - elsif ($cpu_arch =~ /power|ppc/) {$b_ppc = 1} - elsif ($cpu_arch =~ /sparc/) {$b_sparc = 1} - # aarch32 mips32 intel/amd handled in cpu - if ($cpu_arch =~ /(armv[1-7]|32|sparc_v9)/){ + 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)/){ + 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; } - $b_android = 1 if -e '/system/build.prop'; - if ( $os =~ /(aix|bsd|cosix|dragonfly|darwin|hp-?ux|indiana|irix|sunos|solaris|ultrix|unix)/ ){ - if ( $os =~ /openbsd/ ){ + 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'; } @@ -470,22 +563,26 @@ sub set_path { 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. - @paths = qw(/sbin /bin /usr/sbin /usr/bin /usr/local/sbin /usr/local/bin); + my @test = qw(/sbin /bin /usr/sbin /usr/bin /usr/local/sbin /usr/local/bin + /usr/X11R6/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 ( !(grep { /^$id$/ } @paths) && $id !~ /(game)/ ){ + foreach my $id (@path){ + if (-d $id && !(grep {/^$id$/} @paths) && $id !~ /(game)/){ push(@paths, $id); } } - # print "paths: @paths\n"; + # print "paths: \n", join("\n", @paths),"\n"; } sub set_sep { - if ( $b_irc ){ + if ($b_irc){ # too hard to read if no colors, so force that for users on irc - if ($colors{'scheme'} == 0 ){ + if ($colors{'scheme'} == 0){ $sep{'s1'} = $sep{'s1-console'}; $sep{'s2'} = $sep{'s2-console'}; } @@ -501,107 +598,106 @@ sub set_sep { } # Important: -n makes it non interactive, no prompt for password -# only use sudo if not root, -n option requires sudo -V 1.7 or greater. +# 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 && !$b_no_sudo && (my $path = check_program('sudo'))) { - my @data = program_data('sudo'); - $data[1] =~ s/^([0-9]+\.[0-9]+).*/$1/; - #print "sudo v: $data[1]\n"; - $sudo = "$path -n " if is_numeric($data[1]) && $data[1] >= 1.7; + 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 ); + 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"; - - if ( defined $ENV{'XDG_CONFIG_HOME'} && $ENV{'XDG_CONFIG_HOME'} ){ + # 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" ){ + elsif (-d "$ENV{'HOME'}/.config"){ $user_config_dir="$ENV{'HOME'}/.config"; $b_conf=1; } else { $user_config_dir="$ENV{'HOME'}/.$self_name"; } - if ( defined $ENV{'XDG_DATA_HOME'} && $ENV{'XDG_DATA_HOME'} ){ + if ($ENV{'XDG_DATA_HOME'}){ $user_data_dir="$ENV{'XDG_DATA_HOME'}/$self_name"; $b_data=1; } - elsif ( -d "$ENV{'HOME'}/.local/share" ){ + 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 ){ + # 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; + 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"; + 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"; + # system 'echo', "$ENV{'HOME'}/.$self_name/* $user_data_dir"; # print "scd: $user_config_dir sdd: $user_data_dir \n"; } -# args: 1: set|hash key to return either null or path -sub system_files { - my ($file) = @_; - if ( $file eq 'set'){ - %files = ( - 'asound-cards' => '/proc/asound/cards', - 'asound-modules' => '/proc/asound/modules', - 'asound-version' => '/proc/asound/version', - 'cmdline' => '/proc/cmdline', - 'cpuinfo' => '/proc/cpuinfo', - 'dmesg-boot' => '/var/run/dmesg.boot', - 'lsb-release' => '/etc/lsb-release', - 'mdstat' => '/proc/mdstat', - 'meminfo' => '/proc/meminfo', - 'modules' => '/proc/modules', - 'mounts' => '/proc/mounts', - 'os-release' => '/etc/os-release', - 'partitions' => '/proc/partitions', - 'scsi' => '/proc/scsi/scsi', - 'version' => '/proc/version', - # note: 'xorg-log' is set only if -G is triggered - ); - foreach ( keys %files ){ - $system_files{$_} = ( -e $files{$_} ) ? $files{$_} : ''; - } - } - else { - return $system_files{$file}; - } -} 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 - # we are just going to get all the Xorg logs we can find, and not worry about - # which is 'right'. - @temp = globber('/var/log/Xorg.*.log'); + # 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; @@ -616,18 +712,18 @@ sub set_xorg_log { foreach (@x_logs){ if (-r $_){ my $src_info = File::stat::stat("$_"); - #print "$_\n"; + # print "$_\n"; if ($src_info){ $x_mtime = $src_info->mtime; # print $_ . ": $x_time" . "\n"; - if ($x_mtime > $time_holder ){ + if ($x_mtime > $time_holder){ $time_holder = $x_mtime; $file_holder = $_; } } } } - if ( !$file_holder && check_program('xset') ){ + if (!$file_holder && check_program('xset')){ my $data = qx(xset q 2>/dev/null); foreach (split('\n', $data)){ if ($_ =~ /Log file/i){ @@ -636,7 +732,7 @@ sub set_xorg_log { } } } - print "Xorg log file: $file_holder\nLast modified: $time_holder\n" if $test[14]; + 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; @@ -650,49 +746,49 @@ sub set_xorg_log { #### COLORS #### ------------------------------------------------------------------- -## arg: 1 - the type of action, either integer, count, or full +## args: 0: the type of action, either integer, count, or full sub get_color_scheme { - my ($type) = @_; eval $start if $b_log; - my @color_schemes = ( - [qw(EMPTY EMPTY EMPTY )], - [qw(NORMAL NORMAL NORMAL )], + 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(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(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 DGREY NORMAL)], [qw(DBLUE DMAGENTA NORMAL)], - [qw(DBLUE DRED NORMAL )], + [qw(DBLUE DRED NORMAL)], [qw(DBLUE BLACK NORMAL)], - [qw(DGREEN DYELLOW 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(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(RED WHITE NORMAL)], [qw(BLUE WHITE NORMAL)], # miscellaneous - [qw(RED BLUE NORMAL )], + [qw(RED BLUE NORMAL)], [qw(RED DBLUE NORMAL)], [qw(BLACK BLUE NORMAL)], [qw(BLACK DBLUE NORMAL)], @@ -702,17 +798,17 @@ sub get_color_scheme { [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 'count'){ + return scalar @$color_schemes; } - if ($type eq 'full' ){ - return @color_schemes; + if ($type eq 'full'){ + return $color_schemes; } else { - return @{$color_schemes[$type]}; - # print Dumper $color_schemes[$scheme_nu]; + # print Dumper $color_schemes->[$type]; + return $color_schemes->[$type]; } } @@ -720,8 +816,7 @@ sub set_color_scheme { eval $start if $b_log; my ($scheme) = @_; $colors{'scheme'} = $scheme; - my $index = ( $b_irc ) ? 1 : 0; # defaults to non irc - + 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 = ( @@ -744,10 +839,10 @@ sub set_color_scheme { 'GREY' => [ "\e[0;37m", "\x0315" ], 'NORMAL' => [ "\e[0m", "\x03" ], ); - my @scheme = get_color_scheme($colors{'scheme'}); - $colors{'c1'} = $color_palette{$scheme[0]}->[$index]; - $colors{'c2'} = $color_palette{$scheme[1]}->[$index]; - $colors{'cn'} = $color_palette{$scheme[2]}->[$index]; + 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; @@ -759,9 +854,9 @@ sub set_colors { 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 + # 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(); @@ -774,14 +869,14 @@ sub set_colors { $color_scheme = $colors{'global'}; } else { - if ( $b_irc ){ + 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'}) { + elsif (defined $colors{'irc-gui'}){ $color_scheme = $colors{'irc-gui'}; } } @@ -795,7 +890,7 @@ sub set_colors { } } # force 0 for | or > output, all others prints to irc or screen - if (!$b_irc && ! -t STDOUT ){ + if (!$b_irc && !$force{'colors'} && ! -t STDOUT){ $color_scheme = 0; } set_color_scheme($color_scheme); @@ -805,24 +900,19 @@ sub set_colors { ## SelectColors { package SelectColors; - -# use warnings; -# use strict; -# use diagnostics; -# use 5.008; - my (@data,%configs,%status); my ($type,$w_fh); my $safe_color_count = 12; # null/normal + default color group my $count = 0; -# args: 1 - type +# 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(); @@ -830,8 +920,8 @@ sub select_schema { set_status(); start_selector(); create_color_selections(); - if (! $b_irc ){ - main::check_config_file(); + if (!$b_irc){ + Configs::check_file(); get_selection(); } else { @@ -875,9 +965,10 @@ sub assign_selectors { $configs{'selection'} = 'global'; } } + sub start_selector { my $whoami = getpwuid($<) || "unknown???"; - if ( ! $b_irc ){ + if (!$b_irc){ @data = ( [ 0, '', '', "Welcome to $self_name! Please select the default $configs{'selection'} color scheme."], @@ -893,7 +984,7 @@ sub start_selector { 3-dark^backgrounds; 4-miscellaneous"], [ 0, '', '', ""], ); - if ( ! $b_irc ){ + if (!$b_irc){ push(@data, [ 0, '', '', "Please note that this will set the $configs{'selection'} preferences only for user: $whoami"], @@ -905,14 +996,15 @@ sub start_selector { 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 ); - for my $i (0 .. $count){ + $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 ){ + if ($configs{'selection'} =~ /^(global|irc-gui|irc-console|irc-virt-term)$/ && $i > $safe_color_count){ last; } main::set_color_scheme($i); @@ -925,6 +1017,7 @@ sub create_color_selections { @data = (); main::set_color_scheme(0); } + sub get_selection { my $number = $count + 1; @data = ( @@ -949,9 +1042,8 @@ sub get_selection { ); main::print_basic(\@data); @data = (); - my $response = <STDIN>; - chomp($response); - if (!main::is_int($response) || $response > ($count + 3) ){ + chomp(my $response = <STDIN>); + if (!main::is_int($response) || $response > ($count + 3)){ @data = ( [0, '', '', "Error - Invalid Selection. You entered this: $response. Hit <ENTER> to continue."], [0, '', '', "$line1"], @@ -965,11 +1057,18 @@ sub 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."],); + if ($response == ($count + 3)){ + @data = ( + [0, '', '', "Ok, exiting $self_name now. You can set the colors later."], + ); main::print_basic(\@data); exit 0; } @@ -979,10 +1078,10 @@ sub process_selection { [0, '', '', "$line1"], ); main::print_basic(\@data); - if ( defined $colors{'console'} && !$b_display ){ + if (defined $colors{'console'} && !$b_display){ main::set_color_scheme($colors{'console'}); } - if ( defined $colors{'virt-term'} ){ + if (defined $colors{'virt-term'}){ main::set_color_scheme($colors{'virt-term'}); } else { @@ -1014,39 +1113,42 @@ sub process_selection { 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)/){ + 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/){ + 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'}/ ){ + 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 ){ + if (!$b_found){ print $w_fh "$configs{'variable'}=$value\n"; } close $w_fh; @@ -1068,97 +1170,149 @@ sub print_irc_message { main::print_basic(\@data); exit 0; } - } #### ------------------------------------------------------------------- #### CONFIGS #### ------------------------------------------------------------------- -sub check_config_file { - $user_config_file = "$user_config_dir/$self_name.conf"; - if ( ! -f $user_config_file ){ - open( my $fh, '>', $user_config_file ) or error_handler('create', $user_config_file, $!); - } -} +## Configs +# public: set() check_file() +{ +package Configs; -sub get_configs { - my ($configs) = @_; - my ($key, $val,@config_files); - if (!$configs){ - @config_files = ( - qq(/etc/$self_name.conf), - qq($user_config_dir/$self_name.conf) - ); - } - else { - @config_files = @$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 open(my $fh, '<', "$_"); - while (<$fh>) { + 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; - s/true/1/i; # switch to 1/0 perl boolean - s/false/0/i; # switch to 1/0 perl boolean next unless length; ($key, $val) = split(/\s*=\s*/, $_, 2); next unless length($val); - get_config_item($key,$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. +# 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 get_config_item { +sub process_item { my ($key,$val) = @_; - if ($key eq 'ALLOW_UPDATE' || $key eq 'B_ALLOW_UPDATE') {$use{'update'} = $val if is_int($val)} - elsif ($key eq 'ALLOW_WEATHER' || $key eq 'B_ALLOW_WEATHER') {$use{'weather'} = $val if is_int($val)} - elsif ($key eq 'CPU_SLEEP') {$cpu_sleep = $val if is_numeric($val)} - elsif ($key eq 'DL_TIMEOUT') {$dl_timeout = $val if is_int($val)} - elsif ($key eq 'DOWNLOADER') { + + ## 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 = set_perl_downloader($val); + $val = main::set_perl_downloader($val); %dl = ('dl' => $val, $val => 1); }} - elsif ($key eq 'FILTER_STRING') {$filter_string = $val} - elsif ($key eq 'LANGUAGE') {$language = $val if $val =~ /^(en)$/} - elsif ($key eq 'LIMIT') {$limit = $val if is_int($val)} - elsif ($key eq 'OUTPUT_TYPE') {$output_type = $val if $val =~ /^(json|screen|xml)$/} - elsif ($key eq 'NO_DIG') {$b_skip_dig = $val if is_int($val)} - elsif ($key eq 'NO_HTML_WAN') {$b_no_html_wan = $val if is_int($val)} - elsif ($key eq 'NO_SUDO') {$b_no_sudo = $val if is_int($val)} - elsif ($key eq 'PARTITION_SORT') {$show{'partition-sort'} = $val if ($val =~ /^(dev-base|fs|id|label|percent-used|size|uuid|used)$/) } - elsif ($key eq 'PS_COUNT') {$ps_count = $val if is_int($val) } - elsif ($key eq 'SENSORS_CPU_NO') {$sensors_cpu_nu = $val if 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 (is_int($val)){ + 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') {$b_usb_sys = $val if is_int($val)} - elsif ($key eq 'WAN_IP_URL') { + 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; - $b_skip_dig = 1; + $force{'no-dig'} = 1; } } - elsif ($key eq 'WEATHER_SOURCE') {$weather_source = $val if is_int($val)} - elsif ($key eq 'WEATHER_UNIT') { + 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'); @@ -1166,28 +1320,65 @@ sub get_config_item { $weather_unit = $val; } } - # layout - elsif ($key eq 'CONSOLE_COLOR_SCHEME') {$colors{'console'} = $val if is_int($val)} - elsif ($key eq 'GLOBAL_COLOR_SCHEME') {$colors{'global'} = $val if is_int($val)} - elsif ($key eq 'IRC_COLOR_SCHEME') {$colors{'irc-gui'} = $val if is_int($val)} - elsif ($key eq 'IRC_CONS_COLOR_SCHEME') {$colors{'irc-console'} = $val if is_int($val)} - elsif ($key eq 'IRC_X_TERM_COLOR_SCHEME') {$colors{'irc-virt-term'} = $val if is_int($val)} - elsif ($key eq 'VIRT_TERM_COLOR_SCHEME') {$colors{'virt-term'} = $val if is_int($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} - # size - elsif ($key eq 'COLS_MAX_CONSOLE') {$size{'console'} = $val if is_int($val)} - elsif ($key eq 'COLS_MAX_IRC') {$size{'irc'} = $val if is_int($val)} - elsif ($key eq 'COLS_MAX_NO_DISPLAY') {$size{'no-display'} = $val if is_int($val)} - elsif ($key eq 'INDENT') {$size{'indent'} = $val if is_int($val)} - elsif ($key eq 'WRAP_MAX' || $key eq 'INDENT_MIN') {$size{'wrap-max'} = $val if is_int($val)} + 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 #### ------------------------------------------------------------------- @@ -1197,20 +1388,20 @@ sub get_config_item { # 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 $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], \@_);'; + $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 $@; + # 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 ){ + if (-f $log_file){ # copy if present second to third - if ( -f $log_file_2 ){ + 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 @@ -1235,17 +1426,15 @@ sub begin_logging { # 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: $1 - type [fs|fe|cat|dump|raw] OR data to log -# arg: $2 - -# arg: $one type (fs/fe/cat/dump/raw) or logged data; -# [$two is function name; [$three - function args]] +# 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; + 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 ($one eq 'fs'){ if (ref $three eq 'ARRAY'){ # print Data::Dumper::Dumper $three; $args = "\n${spacer}Args: " . joiner($three, '; ', 'unset'); @@ -1256,24 +1445,24 @@ sub log_data { # $t1 = [gettimeofday]; #$t3 = tv_interval ($t0, [gettimeofday]); $t3 = eval 'Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()])' if $b_hires; - #print Dumper $@; + # print Dumper $@; $data = "Start: Function: $two$args\n${spacer}Elapsed: $t3\n"; $spacer=''; $timer = $data if $debugger{'timers'}; } - elsif ( $one eq 'fe') { + 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; + # 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 ){ - for my $file ($two){ - my $contents = do { local( @ARGV, $/ ) = $file; <> }; # or: qx(cat $file) + 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=''; @@ -1286,7 +1475,7 @@ sub log_data { elsif ($one eq 'data'){ $data = "$two\n"; } - elsif ( $one eq 'dump') { + elsif ($one eq 'dump'){ $data = "$two:\n"; if (ref $three eq 'HASH'){ $data .= Data::Dumper::Dumper $three; @@ -1301,8 +1490,8 @@ sub log_data { $data .= "\n"; # print $data; } - elsif ( $one eq 'raw') { - if ( $b_log_full ){ + elsif ($one eq 'raw'){ + if ($b_log_full){ $data = "\n${line3}Raw System Data:\n\n$two\n$line3"; $spacer=''; } @@ -1313,7 +1502,7 @@ sub log_data { if ($debugger{'timers'}){ print $timer if $timer; } - #print "d: $data"; + # print "d: $data"; elsif ($data){ print $fh_l "$spacer$data"; } @@ -1321,27 +1510,27 @@ sub log_data { sub set_debugger { user_debug_test_1() if $debugger{'test-1'}; - if ( $debug >= 20){ + if ($debugger{'level'} >= 20){ error_handler('not-in-irc', 'debug data generator') if $b_irc; - my $option = ( $debug > 22 ) ? 'main-full' : 'main'; - $debugger{'gz'} = 1 if ($debug == 22 || $debug == 24); + 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 $debug > 20; + $ob_sys->upload_file($ftp_alt) if $debugger{'level'} > 20; exit 0; } - elsif ($debug >= 10 && $debug <= 12){ + elsif ($debugger{'level'} >= 10 && $debugger{'level'} <= 12){ $b_log = 1; - if ($debug == 11){ + if ($debugger{'level'} == 11){ $b_log_full = 1; } - elsif ($debug == 12){ + elsif ($debugger{'level'} == 12){ $b_log_colors = 1; } begin_logging(); } - elsif ($debug <= 3){ - if ($debug == 3){ + elsif ($debugger{'level'} <= 3){ + if ($debugger{'level'} == 3){ $b_log = 1; $debugger{'timers'} = 1; begin_logging(); @@ -1352,17 +1541,17 @@ sub set_debugger { } } } + ## 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: 1 - type -# args: 2 - upload + +# args: 0: type; 1: upload sub new { my $class = shift; ($option) = @_; @@ -1374,27 +1563,7 @@ sub new { sub run_debugger { print "Starting $self_name debugging data collector...\n"; - 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('find'); - } - 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'); - } + check_required_items(); create_debug_directory(); print "Note: for dmidecode, smartctl, lvm data you must be root.\n" if !$b_root; print $line3; @@ -1412,10 +1581,12 @@ sub run_debugger { 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') ){ + if ($debugger{'sys'} && main::count_dir_files('/sys')){ build_tree('sys'); # kernel crash, not sure what creates it, for ppc, as root - sys_traverse_data() if ($debugger{'sys'} && ($debugger{'sys-force'} || !$b_root || !$b_ppc )) ; + if ($debugger{'sys'} && ($debugger{'sys-force'} || !$b_root || !$risc{'ppc'})){ + sys_traverse_data(); + } } else { print "Skipping /sys data collection.\n"; @@ -1423,7 +1594,7 @@ sub run_debugger { 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') ){ + if (!$debugger{'no-proc'} && (!$b_root || $debugger{'proc'}) && -d '/proc' && main::count_dir_files('/proc')){ build_tree('proc'); proc_traverse_data(); } @@ -1437,44 +1608,84 @@ sub run_debugger { 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,$bsd_string,$root_string) = ('','',''); + 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";} - + 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'; } - $bsd_string = "-BSD-$bsd_type" if $bsd_type; - if ($b_arm ){$alt_string = '-ARM'} - elsif ($b_mips) {$alt_string = '-MIPS'} - elsif ($b_ppc) {$alt_string = '-PPC'} - elsif ($b_sparc) {$alt_string = '-SPARC'} - $debug_dir = "$self_name$alt_string$bsd_string-$host-$today$root_string-$self_version-$self_patch"; + 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 ){ + 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" ){ + 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"; @@ -1482,21 +1693,37 @@ sub compress_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) ){ + 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', '-l'], # alsa + ['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*'); @@ -1516,16 +1743,27 @@ sub audio_data { push(@files,@files2) if @files2; copy_files(\@files,'audio'); } + sub bluetooth_data { print "Collecting bluetooth data...\n"; -# no warnings 'uninitialized'; + # no warnings 'uninitialized'; my @cmds = ( - # ['bluetoothctl','list'], # do not use, hangs!! - # ['bt-adapter','-l'], # hangs once bluetooth service is enabled - ['hciconfig','-a'], - ['hcidump',''], + ['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'); } @@ -1554,13 +1792,16 @@ sub disk_data { } 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'], + ['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'], @@ -1569,10 +1810,10 @@ sub disk_data { ['findmnt', ''], ['findmnt', '--df --no-truncate'], ['findmnt', '--list --no-truncate'], - ['gpart', 'list'], + ['gpart', 'list'], # no version ['gpart', 'show'], ['gpart', 'status'], - ['ls', '-l /dev'], + ['ls', '-l /dev'],# core util, don't need version # block is for mmcblk / arm devices ['ls', '-l /dev/block'], ['ls', '-l /dev/block/bootdevice'], @@ -1587,6 +1828,7 @@ sub disk_data { # 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'], @@ -1599,13 +1841,18 @@ sub disk_data { ['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'], @@ -1613,18 +1860,20 @@ sub disk_data { ['lvs', '-o +devices -av --separator : --segments'], ['lvs', '-o +devices -aPv --separator : --segments'], # LSI raid https://hwraid.le-vert.net/wiki/LSIMegaRAIDSAS - ['megacli', '-AdpAllInfo -aAll'], + ['megacli', '-AdpAllInfo -aAll'], # no version ['megacli', '-LDInfo -L0 -a0'], ['megacli', '-PDList -a0'], - ['megaclisas-status', ''], + ['megaclisas-status', ''], # no version ['megaraidsas-status', ''], ['megasasctl', ''], ['mount', ''], - ['nvme', 'present'], + ['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'], @@ -1633,47 +1882,54 @@ sub disk_data { ['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'], - ['swapon', '-s'], + ['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 :'], + ['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'], + ['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 ){ + 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 ){ + 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/" ){ + if (-d "/etc/X11/xorg.conf.d/"){ @files = main::globber("/etc/X11/xorg.conf.d/*"); } else { @@ -1686,11 +1942,13 @@ sub display_data { 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, weston...\n"; + 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'}, @@ -1700,22 +1958,29 @@ sub display_data { 'xdg-session-desktop' => $ENV{'XDG_SESSION_DESKTOP'}, 'xdg-vtnr' => $ENV{'XDG_VTNR'}, # wayland data collectors: - 'xdg-session-type' => $ENV{'XDG_SESSION_TYPE'}, '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'}, + 'size-cols-max' => $size{'max-cols'}, 'size-indent' => $size{'indent'}, - 'size-wrap-width' => $size{'wrap-max'}, + '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'], @@ -1725,40 +1990,65 @@ sub display_data { ['kded4','--version'], ['kded5','--version'], ['kded6','--version'], + ['kded7','--version'], + ['kf-config','--version'], ['kf4-config','--version'], ['kf5-config','--version'], ['kf6-config','--version'], + ['kf7-config','--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'], ['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'; + # no warnings 'uninitialized'; my @cmds = ( - ['ifconfig',''], + ['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; @@ -1784,7 +2074,7 @@ sub perl_modules { foreach (@modules){ my $dir = $_; $dir =~ s/[^\/]+$//; - if (!$holder || $holder ne $dir ){ + if (!$holder || $holder ne $dir){ $holder = $dir; $value = "DIR: $dir\n"; $_ =~ s/^$dir//; @@ -1801,6 +2091,7 @@ sub perl_modules { 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 @@ -1811,6 +2102,7 @@ sub system_data { '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'}, @@ -1834,20 +2126,30 @@ sub system_data { # 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','list'], - ['pcictl','list -ns'], + ['pcictl','pci0 list'], + ['pcictl','pci0 list -N'], + ['pcictl','pci0 list -n'], + # sunos + ['prtdiag',''], + ['prtdiag','-v'], ); run_commands(\@cmds,'system-bsd'); # diskinfo -v <disk> @@ -1856,14 +2158,23 @@ sub system_data { ['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',''], + ['lscpu',''],# part of util-linux + ['lsmem',''], + ['lsmem','--all'], + ['lspci','--version'], ['lspci',''], ['lspci','-k'], ['lspci','-n'], @@ -1877,16 +2188,20 @@ sub system_data { ['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'], @@ -1896,9 +2211,16 @@ sub system_data { # ['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',''], @@ -1906,30 +2228,38 @@ sub system_data { ['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 = RepoData::get($data_dir); + @files = RepoItem::get($data_dir); copy_files(\@files, 'repo'); # chdir "/etc"; - @files = main::globber('/etc/*[-_s[rR]elease,[vV]ersion,issue}*'); - push(@files, '/etc/issue'); - push(@files, '/etc/lsb-release'); - push(@files, '/etc/os-release'); - push(@files, '/system/build.prop');# android data file, requires rooted - push(@files, '/var/log/installer/oem-id'); # ubuntu only for oem installs? + @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', @@ -1952,17 +2282,23 @@ sub system_files { @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; - my $iz = "$i$z"; - $iz =~ s/[\s-]//g; - my $self_file = "$data_dir/$self_name-FERfJLrploudma$iz-slots-y$w.txt"; - my $cmd = "$self_path/$self_name -FERfJLrploudma$i$z --slots --debug 10 -y $w > $self_file 2>&1"; + $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"); @@ -1974,7 +2310,7 @@ sub copy_files { my ($absent,$error,$good,$name,$unreadable); my $directory = ($alt_dir) ? $alt_dir : $data_dir; my $working = ($type ne 'proc') ? "$type-file-": ''; - foreach (@$files_ref) { + foreach (@$files_ref){ $name = $_; $name =~ s/^\///; $name =~ s/\//~/g; @@ -1985,7 +2321,7 @@ sub copy_files { $error = $name . '-error'; $unreadable = $name . '-unreadable'; # proc have already been tested for readable/exists - if ($type eq 'proc' || -e $_ ) { + 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); @@ -1999,6 +2335,7 @@ sub copy_files { } } } + sub run_commands { my ($cmds,$type) = @_; my $holder = ''; @@ -2029,17 +2366,38 @@ sub run_commands { } } } + +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) { + 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 (defined $value){ if ($value || $value eq '0'){ open($fh, '>', $good) or main::toucher($error); print $fh "$value"; @@ -2053,10 +2411,11 @@ sub write_data { } } } + ## TOOLS FOR DIRECTORY TREE/LS/TRAVERSE; UPLOADER sub build_tree { my ($which) = @_; - if ( $which eq 'sys' && main::check_program('tree') ){ + if ($which eq 'sys' && main::check_program('tree')){ print "Constructing /$which tree data...\n"; my $dirname = '/sys'; my $cmd; @@ -2067,7 +2426,7 @@ sub build_tree { foreach (@files){ next if /^\./; $cmd = "tree -a -L 10 $dirname/$_ > $data_dir/sys-data-tree-$_-10.txt"; - #print "$cmd\n"; + # print "$cmd\n"; system($cmd); } } @@ -2078,7 +2437,7 @@ sub build_tree { directory_ls($which,3); directory_ls($which,4); } - elsif ($which eq 'proc') { + 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 @@ -2090,36 +2449,39 @@ sub build_tree { # include is basic regex for ls path syntax, like [a-z] sub directory_ls { - my ( $dir,$depth,$include) = @_; + my ($dir,$depth,$include) = @_; $include ||= ''; my ($exclude) = (''); - # wd do NOT want to see anything in self or thread-self!! + # 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" } + 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> ){ + 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/ ){ + 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 - "; } @@ -2127,7 +2489,7 @@ sub directory_ls { $working[10] ||= ''; $output = $output . " $type$working[8] $working[9] $working[10]\n"; } - elsif ( $working[0] !~ /^total/ ){ + elsif ($working[0] !~ /^total/){ $output = $output . $line . "\n"; } } @@ -2138,6 +2500,7 @@ sub directory_ls { 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 @@ -2148,6 +2511,7 @@ sub proc_traverse_data { process_proc_traverse(); @content = (); } + sub process_proc_traverse { my ($data,$fh,$result,$row,$sep); my $proc_dir = "$data_dir/proc"; @@ -2155,7 +2519,7 @@ sub process_proc_traverse { mkdir $proc_dir or main::error_handler('mkdir', "$proc_dir", "$!"); # @content = sort @content; copy_files(\@content,'proc',$proc_dir); -# foreach (@content){print "$_\n";} + # foreach (@content){print "$_\n";} } sub sys_traverse_data { @@ -2168,6 +2532,7 @@ sub sys_traverse_data { process_sys_traverse(); @content = (); } + sub process_sys_traverse { my ($data,$fh,$result,$row,$sep); my $filename = "sys-data-parse.txt"; @@ -2182,7 +2547,7 @@ sub process_sys_traverse { open($fh, '<', $_) or $b_fh = 0; # needed for removing -T test and root if ($b_fh){ - while ($row = <$fh>) { + while ($row = <$fh>){ chomp($row); $data .= $sep . '"' . $row . '"'; $sep=', '; @@ -2201,23 +2566,44 @@ sub process_sys_traverse { # 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'){ - # 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. Also do not need . files or __ starting files # 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 $b_arm && $File::Find::name =~ /^\/sys\/power\/(wait_for_fb_|wakeup_count$)/; - return if $File::Find::name =~ /\/(\.[a-z]|kernel\/|trace\/|parameters\/|debug\/)/; + 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 =~ /\/pp_num_states$/; + 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 @@ -2226,24 +2612,17 @@ sub wanted { # the readable tests in copy_files() # return unless -T; } - elsif ($parse_src eq 'proc') { - return if $File::Find::name =~ /^\/proc\/[0-9]+\//; - return if $File::Find::name =~ /^\/proc\/bus\/pci\//; - return if $File::Find::name =~ /^\/proc\/(irq|spl|sys)\//; - # these choke on sudo/root: kmsg kcore kpage and we don't want keys or kallsyms - return if $File::Find::name =~ /^\/proc\/k/; - return if $File::Find::name =~ /(\/mb_groups|debug)$/; + 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: 1 - path to file to be uploaded -# args: 2 - optional: alternate ftp upload url + +# 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 { - require Net::FTP; - Net::FTP->import; my ($self, $ftp_url) = @_; my ($ftp, $domain, $host, $user, $pass, $dir, $error); $ftp_url ||= main::get_defaults('ftp-upload'); @@ -2256,13 +2635,11 @@ sub upload_file { $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 ) ){ + 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); @@ -2285,6 +2662,37 @@ sub upload_file { } } } + +# 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); @@ -2304,28 +2712,29 @@ sub user_debug_test_1 { #### 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-opt'} ||= ''; + $dl{'no-ssl'} ||= ''; $dl{'spider'} ||= ''; $file ||= 'N/A'; # to avoid debug error - if ( ! $dl{'dl'} ){ + if (!$dl{'dl'}){ return 0; } if ($dl{'timeout'}){ $timeout = "$dl{'timeout'}$dl_timeout"; } - # print "$dl{'no-ssl-opt'}\n"; + # 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' ){ + if ($dl{'dl'} eq 'tiny'){ $cmd = "Using tiny: type: $type \nurl: $url \nfile: $file"; - $result = get_file($type, $url, $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 @@ -2334,34 +2743,36 @@ sub download_file { else { if ($type eq 'stdout'){ $args = $dl{'stdout'}; - $cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $ua $timeout $args \"$url\" $dl{'null'}"; + $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') { + elsif ($type eq 'file'){ $args = $dl{'file'}; - $cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $ua $timeout $args $file \"$url\" $dl{'null'}"; + $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-opt'} $ua $timeout $dl{'spider'} \"$url\""; + 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 $test[1]; + 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 { - my ($type, $url, $file) = @_; - my $tiny = HTTP::Tiny->new; +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 !$dl{'no-ssl-opt'}; + $tiny->verify_SSL => 1 if !$use{'no-ssl'}; my $response = $tiny->get($url); my $return = 1; my $debug = 0; @@ -2369,26 +2780,26 @@ sub get_file { $file ||= 'N/A'; log_data('dump','%{$response}',$response) if $b_log; # print Dumper $response; - if ( ! $response->{'success'} ){ + 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 $test[1]; + print error_defaults('download-error',$msg) if $dbg[1]; $return = 0; } else { - if ( $debug ){ + 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) { + 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" ){ + if ($type eq "stdout" || $type eq "ua-stdout"){ $return = $response->{'content'}; } elsif ($type eq "spider"){ @@ -2406,6 +2817,7 @@ sub get_file { sub set_downloader { eval $start if $b_log; my $quiet = ''; + my $ua_raw = 's-tools/' . $self_name . '-'; $dl{'no-ssl'} = ''; $dl{'null'} = ''; $dl{'spider'} = ''; @@ -2413,7 +2825,11 @@ sub set_downloader { # 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'}){ - if (check_perl_module('HTTP::Tiny') && check_perl_module('IO::Socket::SSL')){ + # 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; @@ -2422,52 +2838,56 @@ sub set_downloader { $dl{'tiny'} = 0; } } - #print $dl{'tiny'} . "\n"; + # 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 !$test[1]; + 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 ' . $dl_ua; + $dl{'ua'} = ' -A ' . $ua_raw; } - elsif ($dl{'wget'} && check_program('wget') ){ - $quiet = '-q ' if !$test[1]; + 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 ' . $dl_ua; + $dl{'ua'} = ' -U ' . $ua_raw; } elsif ($dl{'fetch'} && check_program('fetch')){ - $quiet = '-q ' if !$test[1]; + $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; } - elsif ( $bsd_type eq 'openbsd' && check_program('ftp') ){ + # 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'} = ''; } - # no-ssl-opt is set to 1 with --no-ssl, so it is true, then assign - $dl{'no-ssl-opt'} = $dl{'no-ssl'} if $dl{'no-ssl-opt'}; + # $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; } @@ -2483,81 +2903,93 @@ sub set_perl_downloader { sub error_handler { eval $start if $b_log; - my ( $err, $one, $two) = @_; + my ($err,$one,$two) = @_; my ($b_help,$b_recommends); my ($b_exit,$errno) = (1,0); my $message = do { - if ( $err eq 'empty' ) { 'empty value' } + if ($err eq 'empty'){ 'empty value' } ## Basic rules - elsif ( $err eq 'not-in-irc' ) { + 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' ) { + elsif ($err eq 'bad-arg'){ $errno=10; $b_help=1; "Unsupported value: $two for option: $one" } - elsif ( $err eq 'bad-arg-int' ) { + elsif ($err eq 'bad-arg-int'){ $errno=11; "Bad internal argument: $one" } - elsif ( $err eq 'distro-block' ) { + 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' ) { + elsif ($err eq 'option-feature-incomplete'){ $errno=21; "Option: '$one' feature: '$two' has not been implemented yet." } - elsif ( $err eq 'unknown-option' ) { + 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' ) { + elsif ($err eq 'open-data'){ $errno=32; "Error opening data for reading: $one \nError: $two" } - elsif ( $err eq 'download-error' ) { + elsif ($err eq 'download-error'){ $errno=33; "Error downloading file with $dl{'dl'}: $one \nError: $two" } ## Files: - elsif ( $err eq 'copy-failed' ) { + elsif ($err eq 'copy-failed'){ $errno=40; "Error copying file: $one \nError: $two" } - elsif ( $err eq 'create' ) { + elsif ($err eq 'create'){ $errno=41; "Error creating file: $one \nError: $two" } - elsif ( $err eq 'downloader-error' ) { + elsif ($err eq 'downloader-error'){ $errno=42; "Error downloading file: $one \nfor download source: $two" } - elsif ( $err eq 'file-corrupt' ) { + elsif ($err eq 'file-corrupt'){ $errno=43; "Downloaded file is corrupted: $one" } - elsif ( $err eq 'mkdir' ) { + elsif ($err eq 'mkdir'){ $errno=44; "Error creating directory: $one \nError: $two" } - elsif ( $err eq 'open' ) { + elsif ($err eq 'open'){ $errno=45; $b_exit=0; "Error opening file: $one \nError: $two" } - elsif ( $err eq 'open-dir' ) { + elsif ($err eq 'open-dir'){ $errno=46; "Error opening directory: $one \nError: $two" } - elsif ( $err eq 'output-file-bad' ) { + 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' ) { + elsif ($err eq 'not-writable'){ $errno=48; "The file: $one is not writable!" } - elsif ( $err eq 'open-dir-failed' ) { + elsif ($err eq 'open-dir-failed'){ $errno=49; "The directory: $one failed to open with error: $two" } - elsif ( $err eq 'remove' ) { + elsif ($err eq 'remove'){ $errno=50; "Failed to remove file: $one Error: $two" } - elsif ( $err eq 'rename' ) { + elsif ($err eq 'rename'){ $errno=51; "There was an error moving files: $one\nError: $two" } - elsif ( $err eq 'write' ) { + 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' ) { + elsif ($err eq 'missing-downloader'){ $errno=60; "Downloader program $two could not be located on your system." } - elsif ( $err eq 'missing-perl-downloader' ) { + elsif ($err eq 'missing-perl-downloader'){ $errno=61; $b_recommends=1; "Perl downloader missing required module." } ## FTP - elsif ( $err eq 'ftp-bad-path' ) { + elsif ($err eq 'ftp-bad-path'){ $errno=70; "Unable to locate for FTP upload file:\n$one" } - elsif ( $err eq 'ftp-connect' ) { + elsif ($err eq 'ftp-connect'){ $errno=71; "There was an error with connection to ftp server: $one" } - elsif ( $err eq 'ftp-login' ) { + elsif ($err eq 'ftp-login'){ $errno=72; "There was an error with login to ftp server: $one" } - elsif ( $err eq 'ftp-upload' ) { + elsif ($err eq 'ftp-upload'){ $errno=73; "There was an error with upload to ftp server: $one" } ## Modules - elsif ( $err eq 'required-module' ) { + 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 parameters.\n"); + print_line("Check -h for correct useage.\n"); } if ($b_recommends){ print_line("See --recommends for more information.\n"); @@ -2582,50 +3014,44 @@ sub error_defaults { ## CheckRecommends { package CheckRecommends; -my (@modules); +my ($item_data,@modules,@pms); + sub run { main::error_handler('not-in-irc', 'recommends') if $b_irc; my (@data,@rows); - my $line = make_line(); - my $pm = get_pm(); - @data = basic_data($line,$pm); - push(@rows, @data); + my $rows = []; + my $line = main::make_line(); + @pms = get_pms(); + set_item_data(); + basic_data($rows,$line); if (!$bsd_type){ - @data = check_items('required system directories',$line,$pm); - push(@rows, @data); - } - @data = check_items('recommended system programs',$line,$pm); - push(@rows, @data); - @data = check_items('recommended display information programs',$line,$pm); - push(@rows, @data); - @data = check_items('recommended downloader programs',$line,$pm); - push(@rows, @data); + 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){ - @data = check_items('recommended kernel modules',$line,$pm); - push(@rows, @data); - } - @data = check_items('recommended Perl modules',$line,$pm); - push(@rows, @data); - @data = check_items('recommended directories',$line,''); - push(@rows, @data); - @data = check_items('recommended files',$line,''); - push(@rows, @data); - @data = ( + 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', '', '', " "], + ['0', '', '', ''], ); - push(@rows, @data); - #print Data::Dumper::Dumper \@rows; - main::print_basic(\@rows); + # print Data::Dumper::Dumper $rows; + main::print_basic($rows); exit 0; # shell true } sub basic_data { - my ($line,$pm_local) = @_; + my ($rows,$line) = @_; my (@data,@rows); + $extra = 1; # needed for shell version + ShellData::set(); my $client = $client{'name-print'}; - $pm_local ||= 'N/A'; $client .= ' ' . $client{'version'} if $client{'version'}; my $default_shell = 'N/A'; if ($ENV{'SHELL'}){ @@ -2634,28 +3060,39 @@ sub basic_data { } my $sh = main::check_program('sh'); my $sh_real = Cwd::abs_path($sh); - @rows = ( + push(@$rows, ['0', '', '', "$self_name will now begin checking for the programs it needs to operate."], - ['0', '', '', "" ], + ['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" ], - ['0', '', '', "Package manager: $pm_local" ], + 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"], ); - return @rows; + 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 ($type,$line,$pm) = @_; - my (@data,%info,@missing,$row,@rows,$result,@unreadable); + 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,$install) = ('','','','','','info',''); + my ($about,$extra,$extra2,$extra3,$extra4,$info_os) = ('','','','','','info'); if ($type eq 'required system directories'){ @data = qw(/proc /sys); $b_dir = 1; @@ -2663,14 +3100,16 @@ sub check_items { } elsif ($type eq 'recommended system programs'){ if ($bsd_type){ - @data = qw(camcontrol dig dmidecode fdisk file glabel gpart ifconfig ipmi-sensors - ipmitool lsusb sudo smartctl sysctl tree upower uptime usbdevs); + @data = qw(camcontrol dig disklabel dmidecode doas fdisk file glabel gpart + ifconfig ipmi-sensors ipmitool pciconfig pcidump pcictl smartctl sudo + sysctl tree upower uptime usbconfig usbdevs); $info_os = 'info-bsd'; } else { - @data = qw(blockdev dig dmidecode fdisk file hciconfig hddtemp ifconfig ip ipmitool - ipmi-sensors lsblk lsusb lvs mdadm modinfo runlevel sensors smartctl strings - sudo tree upower uptime); + @data = qw(blockdev bt-adapter btmgmt dig dmidecode doas fdisk file + fruid_print hciconfig hddtemp ifconfig ip ipmitool ipmi-sensors lsblk + lsusb lvs mdadm modinfo runlevel sensors smartctl strings sudo tree + udevadm upower uptime); } $b_program = 1; $item = 'Program'; @@ -2679,11 +3118,13 @@ sub check_items { } elsif ($type eq 'recommended display information programs'){ if ($bsd_type){ - @data = qw(glxinfo wmctrl xdpyinfo xprop xrandr); + @data = qw(eglinfo glxinfo vulkaninfo wayland-info wmctrl xdpyinfo xprop + xdriinfo xrandr); $info_os = 'info-bsd'; } else { - @data = qw(glxinfo wmctrl xdpyinfo xprop xrandr); + @data = qw(eglinfo glxinfo vulkaninfo wayland-info wmctrl xdpyinfo xprop + xdriinfo xrandr); } $b_program = 1; $item = 'Program'; @@ -2708,19 +3149,24 @@ sub check_items { } elsif ($type eq 'recommended Perl modules'){ @data = qw(File::Copy File::Find File::Spec::Functions HTTP::Tiny IO::Socket::SSL - Time::HiRes Cpanel::JSON::XS JSON::XS XML::Dumper Net::FTP); + 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. To run --debug 20-22 File::Copy, - File::Find, and File::Spec::Functions must be present (most distros have these in Core Modules). + $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); + @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 @@ -2736,7 +3182,7 @@ sub check_items { } else { @data = qw(/dev /dev/disk/by-id /dev/disk/by-label /dev/disk/by-path - /dev/disk/by-uuid /sys/class/dmi/id); + /dev/disk/by-uuid /sys/class/dmi/id /sys/class/hwmon); } $b_dir = 1; $item = 'Directory'; @@ -2748,35 +3194,36 @@ sub check_items { 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 ); + /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."; } - @rows = ( + push(@$rows, ['0', '', '', "$line" ], ['0', '', '', "Test: $type$extra:" ], - ['0', '', '', " " ], + ['0', '', '', ''], ); if ($extra2){ - $rows[scalar @rows] = (['0', '', '', $extra2]); - $rows[scalar @rows] = (['0', '', '', ' ']); + push(@$rows, + ['0', '', '', $extra2], + ['0', '', '', '']); } if ($extra3){ - $rows[scalar @rows] = (['0', '', '', $extra3]); - $rows[scalar @rows] = (['0', '', '', ' ']); + push(@$rows, + ['0', '', '', $extra3], + ['0', '', '', '']); } foreach my $item (@data){ - $install = ''; - $about = ''; - %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))){ + 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){ @@ -2785,41 +3232,40 @@ sub check_items { } else { $result = 'Missing'; - if (($b_program || $b_perl_module) && $pm){ - $info{$pm} ||= 'N/A'; - $install = " ~ Install package: $info{$pm}"; + 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); } - push(@missing, "$item$install"); } $row = make_row($item,$about,$result); - $rows[scalar @rows] = (['0', '', '', $row]); + push(@$rows, ['0', '', '', $row]); } - $rows[scalar @rows] = (['0', '', '', " "]); + push(@$rows, ['0', '', '', '']); if (@missing){ - $rows[scalar @rows] = (['0', '', '', "The following $type are missing$extra4:"]); - foreach (@missing) { - $rows[scalar @rows] = (['0', '', '', "$item: $_"]); + push(@$rows, ['0', '', '', "The following $type are missing$extra4:"]); + foreach (@missing){ + push(@$rows, ['0', '', '', $_]); } } if (@unreadable){ - $rows[scalar @rows] = (['0', '', '', "The following $type are not readable: "]); - foreach (@unreadable) { - $rows[scalar @rows] = (['0', '', '', "$item: $_"]); + push(@$rows, ['0', '', '', "The following $type are not readable: "]); + foreach (@unreadable){ + push(@$rows, ['0', '', '', "$item: $_"]); } } if (!@missing && !@unreadable){ - $rows[scalar @rows] = (['0', '', '', "All $type are present"]); + push(@$rows, ['0', '', '', "All $type are present"]); } - return @rows; } -sub item_data { - my ($type) = @_; - my %data = ( - # Directory Data - '/sys/class/dmi/id' => { - 'info' => '-M system, motherboard, bios', - }, +sub set_item_data { + $item_data = { + ## Directory Data ## '/dev' => { 'info' => '-l,-u,-o,-p,-P,-D disk partition data', }, @@ -2841,7 +3287,13 @@ sub item_data { '/sys' => { 'info' => '', }, - # File Data + '/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)', }, @@ -2878,9 +3330,9 @@ sub item_data { '/var/run/dmesg.boot' => { 'info' => '-D,-d disk data', }, - ## Kernel Module Data + ## Kernel Module Data ## 'amdgpu' => { - 'info' => '-s AMD GPU sensor data (newer AMD GPUs)', + 'info' => '-s, -G AMD GPU sensor data (newer GPUs)', 'info-bsd' => '', }, 'drivetemp' => { @@ -2888,94 +3340,128 @@ sub item_data { 'info-bsd' => '', }, 'nouveau' => { - 'info' => '-s Nvidia GPU sensor data (if using free driver)', + '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 ## - # Note: see inxi-perl branch for details: docs/recommends-package-manager.txt + # 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', - 'apt' => '', - 'pacman' => '', - 'rpm' => '', }, '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', - 'apt' => '', - 'pacman' => '', - 'rpm' => '', }, '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', - 'apt' => '', - 'pacman' => '', - 'rpm' => '', }, 'gpart' => { 'info' => '', - 'info-bsd' => '-p,-P file system, size', - 'apt' => '', - 'pacman' => '', - 'rpm' => '', + 'info-bsd' => '-p,-P; -R; -o (FreeBSD+derived)', }, 'hciconfig' => { - 'info' => '-E bluetooth HCI data', + 'info' => '-E bluetooth data (deprecated, good report)', 'info-bsd' => '', 'apt' => 'bluez', - 'pacman' => 'bluez-utils', + 'pacman' => 'bluez-utils-compat (frugalware: bluez-utils)', + 'pkgtool' => 'bluez', 'rpm' => 'bluez-utils', }, 'hddtemp' => { @@ -2983,6 +3469,7 @@ sub item_data { 'info-bsd' => '-Dx show hdd temp', 'apt' => 'hddtemp', 'pacman' => 'hddtemp', + 'pkgtool' => 'hddtemp', 'rpm' => 'hddtemp', }, 'ifconfig' => { @@ -2990,6 +3477,7 @@ sub item_data { 'info-bsd' => '-i ip LAN', 'apt' => 'net-tools', 'pacman' => 'net-tools', + 'pkgtool' => 'net-tools', 'rpm' => 'net-tools', }, 'ip' => { @@ -2997,6 +3485,7 @@ sub item_data { 'info-bsd' => '', 'apt' => 'iproute', 'pacman' => 'iproute2', + 'pkgtool' => 'iproute2', 'rpm' => 'iproute', }, 'ipmi-sensors' => { @@ -3004,6 +3493,7 @@ sub item_data { 'info-bsd' => '', 'apt' => 'freeipmi-tools', 'pacman' => 'freeipmi', + 'pkgtool' => 'freeipmi', 'rpm' => 'freeipmi', }, 'ipmitool' => { @@ -3011,6 +3501,7 @@ sub item_data { 'info-bsd' => '-s IPMI sensors (servers)', 'apt' => 'ipmitool', 'pacman' => 'ipmitool', + 'pkgtool' => 'ipmitool', 'rpm' => 'ipmitool', }, 'lsblk' => { @@ -3018,6 +3509,7 @@ sub item_data { 'info-bsd' => '-o unmounted file system', 'apt' => 'util-linux', 'pacman' => 'util-linux', + 'pkgtool' => 'util-linux', 'rpm' => 'util-linux-ng', }, 'lvs' => { @@ -3025,13 +3517,15 @@ sub item_data { 'info-bsd' => '', 'apt' => 'lvm2', 'pacman' => 'lvm2', + 'pkgtool' => 'lvm2', 'rpm' => 'lvm2', }, 'lsusb' => { 'info' => '-A usb audio; -J (optional); -N usb networking', - 'info-bsd' => '-A; -J; -N. Alternate to usbdevs', + 'info-bsd' => '', 'apt' => 'usbutils', 'pacman' => 'usbutils', + 'pkgtool' => 'usbutils', 'rpm' => 'usbutils', }, 'mdadm' => { @@ -3039,6 +3533,7 @@ sub item_data { 'info-bsd' => '', 'apt' => 'mdadm', 'pacman' => 'mdadm', + 'pkgtool' => 'mdadm', 'rpm' => 'mdadm', }, 'modinfo' => { @@ -3046,20 +3541,35 @@ sub item_data { '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)', + }, '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', + 'info' => '-s sensors output (optional, /sys supplies most)', 'info-bsd' => '', 'apt' => 'lm-sensors', 'pacman' => 'lm-sensors', + 'pkgtool' => 'lm_sensors', 'rpm' => 'lm-sensors', }, 'smartctl' => { @@ -3067,41 +3577,50 @@ sub item_data { 'info-bsd' => '-Da advanced data', 'apt' => 'smartmontools', 'pacman' => 'smartmontools', + 'pkgtool' => 'smartmontools', 'rpm' => 'smartmontools', }, 'strings' => { 'info' => '-I sysvinit version', 'info-bsd' => '', 'apt' => 'binutils', - 'pacman' => '?', - 'rpm' => '?', - }, - 'sysctl' => { - 'info' => '', - 'info-bsd' => '-C; -I; -m; -tm', - 'apt' => '?', - 'pacman' => '?', - 'rpm' => '?', + 'pacman' => 'binutils', + 'pkgtool' => 'binutils', + 'rpm' => 'binutils', }, 'sudo' => { - 'info' => '-Dx hddtemp-user; -o file-user', - 'info-bsd' => '-Dx hddtemp-user; -o file-user', + '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' => { @@ -3109,92 +3628,137 @@ sub item_data { '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; -J; -N;', - 'apt' => 'usbutils', - 'pacman' => 'usbutils', - 'rpm' => 'usbutils', + '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', }, - # Display Tools + ## 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 glx info', - 'info-bsd' => '-G glx info', + 'info' => '-G X11 GLX info', + 'info-bsd' => '-G X11 GLX info', 'apt' => 'mesa-utils', - 'pacman' => 'mesa-demos', - 'rpm' => 'glx-utils (openSUSE 12.3 and later Mesa-demo-x)', + '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 managerr (fallback)', + 'info-bsd' => '-S active window manager (fallback)', 'apt' => 'wmctrl', 'pacman' => 'wmctrl', + 'pkgtool' => 'wmctrl', 'rpm' => 'wmctrl', }, 'xdpyinfo' => { - 'info' => '-G multi screen resolution', - 'info-bsd' => '-G multi screen resolution', + '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', - 'rpm' => 'xorg-x11-utils', + '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 desktop data', - 'info-bsd' => '-S desktop data', + 'info' => '-S (X) desktop data', + 'info-bsd' => '-S (X) desktop data', 'apt' => 'X11-utils', 'pacman' => 'xorg-xprop', - 'rpm' => 'x11-utils', + 'pkgtool' => 'xprop', + 'rpm' => 'x11-utils (Fedora/SUSE: xprop)', }, 'xrandr' => { - 'info' => '-G single screen resolution', - 'info-bsd' => '-G single screen resolution', + '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', - 'rpm' => 'x11-server-utils', + 'pkgtool' => 'xrandr', + 'rpm' => 'x11-server-utils (SUSE/Fedora: xrandr)', }, - # Perl Modules + ## Perl Modules ## 'Cpanel::JSON::XS' => { - 'info' => '--output json - required for export.', - 'info-bsd' => '--output json - required for export.', + '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 to run debugger.', - 'info-bsd' => '--debug 20-22 - required to run debugger.', + '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 to run debugger.', - 'info-bsd' => '--debug 20-22 - required to run debugger.', + '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 to run debugger.', - 'info-bsd' => '--debug 20-22 - required to run debugger.', + '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', + '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' => { @@ -3202,13 +3766,23 @@ sub item_data { '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' => '--output json - required for export (legacy).', - 'info-bsd' => '--output json - required for export (legacy).', + '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' => { @@ -3216,13 +3790,23 @@ sub item_data { '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' => { @@ -3230,44 +3814,44 @@ sub item_data { '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 ## - ); - return %{$data{$type}}; + }; } -sub get_pm { - my ($pm) = (''); + +sub get_pms { + my @pms = (); # support maintainers of other pm types using custom lists if (main::check_program('dpkg')){ - $pm = 'apt'; + push(@pms,'apt'); } - elsif (main::check_program('pacman')){ - $pm = 'pacman'; + if (main::check_program('pacman')){ + push(@pms,'pacman'); } - elsif (main::check_program('rpm')){ - $pm = 'rpm'; + # assuming netpkg uses installpkg as backend + if (main::check_program('installpkg')){ + push(@pms,'pkgtool'); } - return $pm; + # 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'} - 16 - length("$start$middle"))){ + foreach (0 .. ($size{'max-cols'} - 16 - length("$start$middle"))){ $dots .= '.'; } $line = "$start$sep$middle$dots $end"; return $line; } -sub make_line { - my $line = ''; - foreach (0 .. $size{'max'} - 2 ){ - $line .= '-'; - } - return $line; -} } #### ------------------------------------------------------------------- @@ -3276,7 +3860,7 @@ sub make_line { # Duplicates the functionality of awk to allow for one liner # type data parsing. note: -1 corresponds to awk NF -# args 1: array of data; 2: search term; 3: field result; 4: separator +# 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 @@ -3286,8 +3870,9 @@ sub awk { my ($ref,$search,$num,$sep) = @_; my ($result); # print "search: $search\n"; - return if ! @$ref || ! $search; + return if !@$ref || !$search; foreach (@$ref){ + next if !defined $_; if (/$search/i){ $result = $_; $result =~ s/^\s+|\s+$//g; @@ -3304,7 +3889,7 @@ sub awk { return $result; } -# $1 - Perl module to check +# 0: Perl module to check sub check_perl_module { my ($module) = @_; my $b_present = 0; @@ -3313,7 +3898,7 @@ sub check_perl_module { return $b_present; } -# arg: 1 - string or path to search gneerated @paths data for. +# 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]; @@ -3328,7 +3913,7 @@ sub cleanup { } } -# args: $1, $2, version numbers to compare by turning them to strings +# 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 { @@ -3351,6 +3936,7 @@ sub compare_versions { 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]; @@ -3360,9 +3946,9 @@ sub count_dir_files { return $count; } -# args: 1 - the string to get piece of -# 2 - the position in string, starting at 1 for 0 index. -# 3 - the separator, default is ' ' +# 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) = @_; @@ -3371,36 +3957,44 @@ sub get_piece { $string =~ s/^\s+|\s+$//g; my @temp = split(/$sep/, $string); eval $end if $b_log; - if ( exists $temp[$num] ){ + if (exists $temp[$num]){ $temp[$num] =~ s/,//g; return $temp[$num]; } } -# arg: 1 - command to turn into an array; 2 - optional: splitter -# 3 - optionsl, strip and clean data +# 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) = @_; + my ($cmd,$split,$strip,$type) = @_; + $type ||= 'arr'; $split ||= "\n"; - my @rows = split(/$split/, qx($cmd)); - if ($strip && @rows){ - @rows = grep {/^\s*[^#]/} @rows; - @rows = map {s/^\s+|\s+$//g; $_} @rows if @rows; + 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 @rows; + return ($type eq 'arr') ? @rows : \@rows; } -# args: 1 - string value to glob +# 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; @@ -3409,19 +4003,20 @@ sub is_hex { ## 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//)); + return 1 if (defined $_[0] && length($_[0]) && + length($_[0]) == ($_[0] =~ tr/0123456789//)); } -# receives string, returns boolean 1 if numeric. tr/// is 4x faster than regex +# 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); + 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: 1 - array ref; 2 - join string; 3 - default value, optional +# args: 0: array ref; 1: join string; 2: default value, optional sub joiner { my ($arr,$join,$default) = @_; $default ||= ''; @@ -3446,465 +4041,99 @@ sub lister { closedir $dir; return @list; } - -# returns array of: 0: program print name 1: program version -# args: 1: program values id 2: program version string -# 3: $extra level. Note that StartClient runs BEFORE -x levels are set! -# Only use this function when you only need the name/version data returned -sub program_data { - eval $start if $b_log; - my ($values_id,$version_id,$level) = @_; - my (@data,$path,@program_data); - $level = 0 if ! $level; - #print "val_id: $values_id ver_id:$version_id lev:$level ex:$extra\n"; - $version_id = $values_id if ! $version_id; - @data = program_values($values_id); - if ($data[3]){ - $program_data[0] = $data[3]; - # programs that have no version method return 0 0 for index 1 and 2 - if ( $extra >= $level && $data[1] && $data[2]){ - $program_data[1] = program_version($version_id,$data[0], - $data[1],$data[2],$data[5],$data[6],$data[7],$data[8]); - } - } - $program_data[0] ||= ''; - $program_data[1] ||= ''; - eval $end if $b_log; - return @program_data; -} - -# it's almost 1000 times slower to load these each time program_values is called!! -sub set_program_values { - %program_values = ( - ## Clients ## - '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,'',''], - '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 ## - '3dwm' => ['^3dwm',0,'0','3Dwm',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,'',''], - 'awesome' => ['^awesome',2,'--version','awesome',0,1,0,'',''], - 'beryl' => ['^beryl',0,'0','Beryl',0,1,0,'',''], # unverified; legacy - '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,'',''], - 'cagebreak' => ['^Cagebreak',3,'-v','Cagebreak',0,1,0,'',''], - 'calmwm' => ['^calmwm',0,'0','CalmWM',0,1,0,'',''], # unverified - 'cinnamon' => ['^cinnamon',2,'--version','Cinnamon',0,1,0,'',''], - 'clfswm' => ['^clsfwm',0,'0','clfswm',0,1,0,'',''], # no version - 'compiz' => ['^compiz',2,'--version','Compiz',0,1,0,'',''], - 'compton' => ['^\d',1,'--version','Compton',0,1,0,'',''], - 'cwm' => ['^cwm',0,'0','CWM',0,1,0,'',''], # no version - 'dcompmgr' => ['^dcompmgr',0,'0','dcompmgr',0,1,0,'',''], # unverified - 'deepin' => ['^Version',2,'file','Deepin',0,100,'=','','/etc/deepin-version'], # special - '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 - 'dwc' => ['^dwc',0,'0','dwc',0,1,0,'',''], # unverified - '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, yet? - 'evilwm' => ['evilwm',3,'-V','evilwm',0,1,0,'',''],# might use full path in match - '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 - '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,'',''], - 'fvwm-crystal' => ['^fvwm',2,'--version','FVWM-Crystal',0,0,0,'',''], # for print name fvwm - 'gala' => ['^gala',0,'0','gala',0,1,0,'',''], # pantheon wm: super slow result, 2, '--version' works? - '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,'',''], - '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,'',''], - 'i3' => ['^i3',3,'--version','i3',0,1,0,'',''], - 'icewm' => ['^icewm',2,'--version','IceWM',0,1,0,'',''], - 'instantwm' => ['^instantwm',1,'-v','instantWM',0,1,1,'^instantwm-?(instantos-?)?',''], - 'ion3' => ['^ion3',0,'--version','Ion3',0,1,0,'',''], # unverified; also shell called ion - 'jbwm' => ['jbwm',3,'-v','JBWM',0,1,0,'',''], # might use full path in match - 'jwm' => ['^jwm',2,'--version','JWM',0,1,0,'',''], - 'kded' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0,'',''], - 'kded1' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0,'',''], - 'kded2' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0,'',''], - 'kded3' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0,'',''], - 'kded4' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0,'',''], - 'ksmcon' => ['^ksmcon',0,'0','ksmcon',0,1,0,'',''],# no version - 'kwin' => ['^kwin',0,'0','kwin',0,1,0,'',''],# no version - 'kwin_wayland' => ['^kwin_wayland',0,'0','kwin_wayland',0,1,0,'',''],# no version - 'kwin_x11' => ['^kwin_x11',0,'0','kwin_x11',0,1,0,'',''],# no version - 'larswm' => ['^larswm',2,'-v','larswm',0,1,1,'',''], - 'liri' => ['^liri',0,'0','liri',0,1,0,'',''], - 'lumina' => ['^\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-variant' => ['^lxqt-panel',0,'0','LXQt-Variant',0,1,0,'',''], - 'lxsession' => ['^lxsession',0,'0','lxsession',0,1,0,'',''], - 'manokwari' => ['^manokwari',0,'0','Manokwari',0,1,0,'',''], - '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,'',''], - '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 - 'moblin' => ['^moblin',0,'0','moblin',0,1,0,'',''],# unverified - 'motorcar' => ['^motorcar',0,'0','motorcar',0,1,0,'',''],# unverified - 'muffin' => ['^muffin',2,'--version','Muffin',0,1,0,'',''], - 'musca' => ['^musca',0,'-v','Musca',0,1,0,'',''], # unverified - 'mutter' => ['^mutter',2,'--version','Mutter',0,1,0,'',''], - 'mwm' => ['^mwm',0,'0','MWM',0,1,0,'',''],# no version - 'nawm' => ['^nawm',0,'0','nawm',0,1,0,'',''],# unverified - 'notion' => ['^.',1,'--version','Notion',0,1,0,'',''], - 'openbox' => ['^openbox',2,'--version','Openbox',0,1,0,'',''], - 'orbital' => ['^orbital',0,'0','orbital',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,'',''], - 'perceptia' => ['^perceptia',0,'0','perceptia',0,1,0,'',''], - 'picom' => ['^\S',1,'--version','Picom',0,1,0,'^v',''], - 'plasmashell' => ['^plasmashell',2,'--version','KDE Plasma',0,1,0,'',''], - '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,'',''], - 'rustland' => ['^rustland',0,'0','rustland',0,1,0,'',''], # unverified - 'sawfish' => ['^sawfish',3,'--version','Sawfish',0,1,0,'',''], - 'scrotwm' => ['^scrotwm.*welcome.*',5,'-v','scrotwm',0,1,1,'',''], - 'sommelier' => ['^sommelier',0,'0','sommelier',0,1,0,'',''], # unverified - 'spectrwm' => ['^spectrwm.*welcome.*wm',5,'-v','spectrwm',0,1,1,'',''], - # 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 - 'sway' => ['^sway',3,'-v','sway',0,1,0,'',''], - 'swc' => ['^swc',0,'0','swc',0,1,0,'',''], # unverified - 'tinywm' => ['^tinywm',0,'0','TinyWM',0,1,0,'',''], # no version - '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,'',''], - 'wavy' => ['^wavy',0,'0','wavy',0,1,0,'',''], # unverified - 'waycooler' => ['^way',3,'--version','way-cooler',0,1,0,'',''], - 'way-cooler' => ['^way',3,'--version','way-cooler',0,1,0,'',''], - 'wayfire' => ['^way',0,'0','wayfire',0,1,0,'',''], # unverified - 'wayhouse' => ['^wayhouse',0,'0','wayhouse',0,1,0,'',''], # unverified - 'westford' => ['^westford',0,'0','westford',0,1,0,'',''], # unverified - 'weston' => ['^weston',0,'0','weston',0,1,0,'',''], # unverified - 'windowlab' => ['^windowlab',2,'-about','WindowLab',0,1,0,'',''], - 'wm2' => ['^wm2',0,'0','wm2',0,1,0,'',''], # no version - 'wmaker' => ['^Window[[:space:]]*Maker',-1,'--version','WindowMaker',0,1,0,'',''], - '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 - 'xcompmgr' => ['^xcompmgr',0,'0','xcompmgr',0,1,0,'',''], # no version - 'xfce4-panel' => ['^xfce4-panel',2,'--version','Xfce',0,1,0,'',''], - 'xfce5-panel' => ['^xfce5-panel',2,'--version','Xfce',0,1,0,'',''], - 'xfdesktop' => ['xfdesktop[[:space:]]version',5,'--version','Xfce',0,1,0,'',''], - # command: xfdesktop - 'xfdesktop-toolkit' => ['Built[[:space:]]with[[:space:]]GTK',4,'--version','Gtk',0,1,0,'',''], - 'xmonad' => ['^xmonad',2,'--version','XMonad',0,1,0,'',''], - 'yeahwm' => ['^yeahwm',0,'--version','YeahWM',0,1,0,'',''], # unverified - ## Toolkits ## - 'gtk-launch' => ['^\S',1,'--version','GTK',0,1,0,'',''], - 'qmake' => ['^^Using Qt version',4,'--version','Qt',0,0,0,'',''], - 'qtdiag' => ['^qt',2,'--version','Qt',0,1,0,'',''], - ## Display Managers (dm) ## - 'cdm' => ['^cdm',0,'0','CDM',0,1,0,'',''], - 'entrance' => ['^entrance',0,'0','Entrance',0,1,0,'',''], - 'gdm' => ['^gdm',2,'--version','GDM',0,1,0,'',''], - 'gdm3' => ['^gdm',2,'--version','GDM3',0,1,0,'',''], - 'kdm' => ['^kdm',0,'0','KDM',0,1,0,'',''], - 'ldm' => ['^ldm',0,'0','LDM',0,1,0,'',''], - 'lightdm' => ['^lightdm',2,'--version','LightDM',0,1,1,'',''], - 'lxdm' => ['^lxdm',0,'0','LXDM',0,1,0,'',''], - 'ly' => ['^ly',3,'--version','Ly',0,1,0,'',''], - 'mdm' => ['^mdm',0,'0','MDM',0,1,0,'',''], - 'nodm' => ['^nodm',0,'0','nodm',0,1,0,'',''], - 'pcdm' => ['^pcdm',0,'0','PCDM',0,1,0,'',''], - 'sddm' => ['^sddm',0,'0','SDDM',0,1,0,'',''], - 'slim' => ['slim version',3,'-v','SLiM',0,1,0,'',''], - 'tdm' => ['^tdm',0,'0','TDM',0,1,0,'',''], - 'udm' => ['^udm',0,'0','udm',0,1,0,'',''], - 'wdm' => ['^wdm',0,'0','WINGs DM',0,1,0,'',''], - 'xdm' => ['^xdm',0,'0','XDM',0,1,0,'',''], - 'xenodm' => ['^xenodm',0,'0','xenodm',0,1,0,'',''], - ## Shells - not checked: ion, eshell ## - ## See test_shell() 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,'',''], - 'busybox' => ['^busybox',0,'0','BusyBox',1,0,0,'',''], # unverified, hush/ash likely - '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,'',''], - ## Tools ## - 'clang' => ['clang',3,'--version','Clang',1,0,0,'',''], - 'gcc' => ['^gcc',3,'--version','GCC',1,0,0,'',''], - 'gcc-apple' => ['Apple[[:space:]]LLVM',2,'--version','LLVM',1,0,0,'',''], - 'sudo' => ['^Sudo',3,'-V','Sudo',1,1,0,'',''], # sudo pre 1.7 does not have --version - ); -} - -# returns array of: -# 0 - match string; 1 - search 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 -# arg: 1 - program lower case name -sub program_values { - my ($app) = @_; - my (@program_data); - set_program_values() if !%program_values; - if ( defined $program_values{$app} ){ - @program_data = @{$program_values{$app}}; - } - #my $debug = Dumper \@program_data; - log_data('dump',"Program Data",\@program_data) if $b_log; - return @program_data; -} - -# args: 1 - desktop/app command for --version; 2 - search string; -# 3 - space print number; 4 - [optional] version arg: -v, version, etc -# 5 - [optional] exit first find 0/1; 6 - [optional] 0/1 stderr output -# 7 - replace regex; 8 - extra data -sub program_version { - eval $start if $b_log; - my ($app,$search,$num,$version,$exit,$stderr,$replace,$extra) = @_; - my ($b_no_space,$cmd,$line,$output); - my $version_nu = ''; - my $count = 0; - my $app_name = $app; - $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 = check_program($app) ){ - $app = $program; - } - else { - log_data('data',"$app not found in path.") if $b_log; - return 0; - } - } - if ($version eq 'file'){ - return 0 unless $extra && -r $extra; - my @data = reader($extra,'strip'); - @data = map {s/$stderr/ /;$_} @data if $stderr; # $stderr is the splitter - $output = join("\n", @data); - $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) = program_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) = program_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"; - } - log_data('data',"version: $version num: $num search: $search command: $cmd") if $b_log; - # special case, in rare instances version comes from file - if ($version ne 'file'){ - $output = qx($cmd); - log_data('data',"output: $output") if $b_log; - } - # print "cmd: $cmd\noutput:\n$output\n"; - # 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){ - open(my $ch, '<', \$output) or error_handler('open-data',"$cmd", "$!"); - while (<$ch>){ - #chomp; - last if $count > $exit; - if ( $_ =~ /$search/i ) { - $_ = trimmer($_); - # 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++; - } - close $ch if $ch; - } - log_data('data',"Program version: $version_nu") if $b_log; - eval $end if $b_log; - return $version_nu; -} -# print program_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 program_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 program_version_pkg { +# 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; - my ($app) = @_; - my ($program,@data); - # note: version $num is 3 in dpkg-query/pacman/rpm, which is convenient - if ($program = check_program('dpkg-query') ){ - $data[0] = "$program -W -f='\${Package}\tversion\t\${Version}\n' $app 2>/dev/null"; - $data[1] = "^$app\\b"; - } - elsif ($program = check_program('pacman') ){ - $data[0] = "$program -Q --info $app 2>/dev/null"; - $data[1] = '^Version'; + $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}; } - elsif ($program = check_program('rpm') ){ - $data[0] = "$program -qi --nodigest --nosignature $app 2>/dev/null"; - $data[1] = '^Version'; + # 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}; } - # print "$data[0] :: $data[1]\n"; eval $end if $b_log; - return @data; } -# arg: 1 - full file path, returns array of file lines. -# 2 - optionsl, strip and clean data -# 3 - optional, return specific index, if it exists, else undef +# 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,$index) = @_; - return if ! $file; - open(my $fh, '<', $file ) or error_handler('open', $file, $!); - chomp(my @rows = <$fh>); - close $fh if $fh; - if (@rows && $strip){ - @rows = grep {/^\s*[^#]/} @rows; - @rows = map {s/^\s+|\s+$//g; $_} @rows if @rows; + 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 (defined $index) ? $rows[$index] : @rows; + return $rows[$type]; } -# args: 1 - the file to create if not exists +# 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, $!); + if (! -e $file){ + open(my $fh, '>', $file) or error_handler('create', $file, $!); } } # calling it trimmer to avoid conflicts with existing trim stuff -# arg: 1 - string to be right left trimmed. Also slices off \n so no chomp needed +# 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; + # eval $start if $b_log; my ($str) = @_; $str =~ s/^\s+|\s+$|\n$//g; - #eval $end if $b_log; + # eval $end if $b_log; return $str; } -# args: 1 - array, by ref, modifying by ref +# 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]}; } -# arg: 1 file full path to write to; 2 - array ref or scalar of data to write. +# 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) = @_; @@ -3924,24 +4153,21 @@ sub writer { #### ------------------------------------------------------------------- #### UPDATER -##### ------------------------------------------------------------------- +#### ------------------------------------------------------------------- -# arg 1: type to return +# args: 0: type to return sub get_defaults { my ($type) = @_; my %defaults = ( 'ftp-upload' => 'ftp.smxi.org/incoming', - 'inxi-branch-1' => 'https://github.com/smxi/inxi/raw/one/', - 'inxi-branch-2' => 'https://github.com/smxi/inxi/raw/two/', - 'inxi-dev' => 'https://smxi.org/in/', - 'inxi-main' => 'https://github.com/smxi/inxi/raw/master/', - 'inxi-pinxi' => 'https://github.com/smxi/inxi/raw/inxi-perl/', - 'inxi-man' => "https://smxi.org/in/$self_name.1.gz", - 'inxi-man-gh' => "https://github.com/smxi/inxi/raw/master/$self_name.1", - 'pinxi-man' => "https://smxi.org/in/$self_name.1.gz", - 'pinxi-man-gh' => "https://github.com/smxi/inxi/raw/inxi-perl/$self_name.1", + '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 ( exists $defaults{$type}){ + if ($defaults{$type}){ return $defaults{$type}; } else { @@ -3949,23 +4175,22 @@ sub get_defaults { } } -# args: 1 - download url, not including file name; 2 - string to print out -# 3 - update type option -# note that 1 must end in / to properly construct the url path +# 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 ($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 ($b_irc){ + error_handler('not-in-irc', "-U/--update") } - if ( ! -w $full_self_path ){ + if (! -w $full_self_path){ error_handler('not-writable', "$self_name", ''); } $output .= "Starting $self_name self updater.\n"; @@ -3978,26 +4203,25 @@ sub update_me { $output = ''; $self_download = "$self_download/$self_name"; $file_contents = download_file('stdout', $self_download); - # then do the actual download - if ( $file_contents ){ + if ($file_contents){ # make sure the whole file got downloaded and is in the variable - if ( $file_contents =~ /###\*\*EOF\*\*###/ ){ + 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", "$!" ); + print $fh $file_contents or error_handler('write', $full_self_path, "$!"); close $fh; - qx( chmod +x '$self_path/$self_name' ); + 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"; - $output .= "Starting download of man page file now.\n"; print $output; $output = ''; - if ($b_man){ - update_man($download_id); + if ($use{'man'}){ + update_man($self_download,$download_id); } else { print "Skipping man download because branch version is being used.\n"; @@ -4016,62 +4240,69 @@ sub update_me { } sub update_man { - my ($download_id) = @_; - my $man_file_location=set_man_location(); - my $man_file_path="$man_file_location/$self_name.1" ; - my ($man_file_url,$output) = ('',''); - - my $b_downloaded = 0; - if ( ! -d $man_file_location ){ + 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 ){ + 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" ){ + 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 (check_program('mandb')){ + system('mandb'); } } - # first choice is inxi.1/pinxi.1 from gh, second gz from smxi.org - if ( $download_id ne 'dev server' && (my $program = check_program('gzip'))){ - $man_file_url=get_defaults($self_name . '-man-gh'); - print "Downloading Man page file...\n"; - $b_downloaded = download_file('file', $man_file_url, $man_file_path); - if ($b_downloaded){ - print "Download successful. Compressing file...\n"; + 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 manfile:\n"; - print "Local path: $man_file_path Error: $err\n"; + print "Oh no! Something went wrong compressing the man file!\n"; + print "Error: $err\n"; } else { - print "Download and install of man page successful.\nCheck to make sure it works: man $self_name\n"; + print "Download, install, and compression of man page successful.\n"; + print "Check to make sure it works: man $self_name\n"; } } - } - else { - $man_file_url = get_defaults($self_name . '-man'); - # used to use spider tests, but only wget supports that, so no need - print "Downloading Man page file gz...\n"; - $man_file_path .= '.gz'; - # returns perl, 1 for true, 0 for false, even when using shell tool returns - $b_downloaded = download_file('file', $man_file_url, $man_file_path ); - if ($b_downloaded) { - print "Download and install of man page successful.\nCheck to make sure it works: man $self_name\n"; + else { + error_handler('file-corrupt', "$self_name.1"); } } - if ( !$b_downloaded ){ - print "Oh no! Something went wrong downloading the Man file at:\n$man_file_url\n"; - print "Try -U with --dbg 1 for more information on the failure.\n"; + # 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 { @@ -4080,22 +4311,22 @@ sub set_man_location { 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/ ){ + if ($man_paths && $man_paths =~ /$man_local/){ $b_use_local=1; } # for distro installs - if ( -f "$default_location/inxi.1.gz" ){ + if (-f "$default_location/inxi.1.gz"){ $location=$default_location; } else { - if ( $b_use_local ){ - if ( ! -d "$man_local/man1" ){ + if ($b_use_local){ + if (! -d "$man_local/man1"){ mkdir "$man_local/man1"; } $location="$man_local/man1"; } } - if ( ! $location ){ + if (!$location){ $location=$default_location; } return $location; @@ -4106,19 +4337,19 @@ sub set_man_location { # 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>){ + while (my $row = <$fh>){ chomp($row); $row =~ s/'|;//g; - if ($row =~ /^my \$self_name/ ){ + if ($row =~ /^my \$self_name/){ $self_name = (split('=', $row))[1]; } - elsif ($row =~ /^my \$self_version/ ){ + elsif ($row =~ /^my \$self_version/){ $self_version = (split('=', $row))[1]; } - elsif ($row =~ /^my \$self_date/ ){ + elsif ($row =~ /^my \$self_date/){ $self_date = (split('=', $row))[1]; } - elsif ($row =~ /^my \$self_patch/ ){ + elsif ($row =~ /^my \$self_patch/){ $self_patch = (split('=', $row))[1]; } elsif ($row =~ /^## END INXI INFO/){ @@ -4132,12 +4363,17 @@ sub set_version_data { #### OPTIONS HANDLER / VERSION ######################################################################## -sub get_options { +## 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; - my ($b_downloader,$b_help,$b_no_man,$b_no_man_force,$b_sensors_default, - $b_recommends,$b_updater,$b_version,$b_use_man,$self_download, $download_id); - GetOptions ( + Getopt::Long::GetOptions ( 'a|admin' => sub { $b_admin = 1;}, 'A|audio' => sub { @@ -4158,36 +4394,44 @@ sub get_options { 'B|battery' => sub { $show{'short'} = 0; $show{'battery'} = 1; - $show{'battery-forced'} = 1; }, + $show{'battery-forced'} = 1;}, 'c|color:i' => sub { my ($opt,$arg) = @_; - if ( $arg >= 0 && $arg < get_color_scheme('count') ){ - set_color_scheme($arg); + if ($arg >= 0 && $arg < main::get_color_scheme('count')){ + main::set_color_scheme($arg); } - elsif ( $arg >= 94 && $arg <= 99 ){ + elsif ($arg >= 94 && $arg <= 99){ $colors{'selector'} = $arg; } else { - error_handler('bad-arg', $opt, $arg); - } }, + main::error_handler('bad-arg', $opt, $arg); + }}, 'C|cpu' => sub { $show{'short'} = 0; - $show{'cpu'} = 1; }, + $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; }, + $show{'optical'} = 1;}, 'D|disk' => sub { $show{'short'} = 0; - $show{'disk'} = 1; }, + $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; }, + $show{'cpu-flag'} = 1;}, 'F|full' => sub { $show{'short'} = 0; $show{'audio'} = 1; @@ -4197,6 +4441,7 @@ sub get_options { $show{'disk'} = 1; $show{'graphic'} = 1; $show{'graphic-basic'} = 1; + $show{'graphic-full'} = 1; $show{'info'} = 1; $show{'machine'} = 1; $show{'network'} = 1; @@ -4205,114 +4450,149 @@ sub get_options { $show{'raid'} = 1; $show{'sensor'} = 1; $show{'swap'} = 1; - $show{'system'} = 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-basic'} = 1; + $show{'graphic-full'} = 1;}, 'h|help|?' => sub { - $b_help = 1; }, + $show{'help'} = 1;}, 'i|ip' => sub { $show{'short'} = 0; $show{'ip'} = 1; $show{'network'} = 1; $show{'network-advanced'} = 1; - $b_downloader = 1 if ! check_program('dig');}, + $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; }, + $show{'info'} = 1;}, 'j|swap|swaps' => sub { $show{'short'} = 0; - $show{'swap'} = 1; }, + $show{'swap'} = 1;}, 'J|usb' => sub { $show{'short'} = 0; - $show{'usb'} = 1; }, + $show{'usb'} = 1;}, 'l|labels|label' => sub { - $show{'short'} = 0; - $show{'label'} = 1; - $show{'partition'} = 1; }, - 'limit:i' => sub { - my ($opt,$arg) = @_; - if ($arg != 0){ - $limit = $arg; - } - else { - error_handler('bad-arg',$opt,$arg); - } }, + $show{'label'} = 1;}, 'L|logical|lvm' => sub { $show{'short'} = 0; - $show{'logical'} = 1; }, + $show{'logical'} = 1;}, 'm|memory' => sub { $show{'short'} = 0; - $show{'ram'} = 1; }, - 'memory-modules' => sub { + $show{'ram'} = 1;}, + 'memory-modules|mm' => sub { $show{'short'} = 0; $show{'ram'} = 1; $show{'ram-modules'} = 1;}, - 'memory-short' => sub { + 'memory-short|ms' => sub { $show{'short'} = 0; $show{'ram'} = 1; $show{'ram-short'} = 1;}, 'M|machine' => sub { $show{'short'} = 0; - $show{'machine'} = 1; }, + $show{'machine'} = 1;}, 'n|network-advanced' => sub { $show{'short'} = 0; $show{'network'} = 1; - $show{'network-advanced'} = 1; }, + $show{'network-advanced'} = 1;}, 'N|network' => sub { $show{'short'} = 0; - $show{'network'} = 1; }, + $show{'network'} = 1;}, 'o|unmounted' => sub { $show{'short'} = 0; - $show{'unmounted'} = 1; }, + $show{'unmounted'} = 1;}, 'p|partition-full|partitions-full' => sub { $show{'short'} = 0; $show{'partition'} = 0; - $show{'partition-full'} = 1; }, - 'P|partitions|partition' => sub { - $show{'short'} = 0; - $show{'partition'} = 1; }, - 'partition-sort:s' => sub { + $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 { - error_handler('bad-arg',$opt,$arg); - } }, + 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; }, + $show{'repo'} = 1;}, 'R|raid' => sub { $show{'short'} = 0; $show{'raid'} = 1; - $show{'raid-forced'} = 1; }, + $show{'raid-forced'} = 1;}, 's|sensors|sensor' => sub { $show{'short'} = 0; - $show{'sensor'} = 1; }, + $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 { - error_handler('bad-arg',$opt,$arg); - } }, + main::error_handler('bad-arg',$opt,$arg); + }}, 'slots|slot' => sub { $show{'short'} = 0; - $show{'slot'} = 1; }, + $show{'slot'} = 1;}, 'S|system' => sub { $show{'short'} = 0; - $show{'system'} = 1; }, + $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+/) ){ + if ($arg =~ /^([cm]+)([0-9]+)?$/ && (!$num || $num =~ /^\d+/)){ $show{'process'} = 1; if ($arg =~ /c/){ $show{'ps-cpu'} = 1; @@ -4323,20 +4603,18 @@ sub get_options { $ps_count = $num if $num; } else { - error_handler('bad-arg',$opt,$arg); - } }, + main::error_handler('bad-arg',$opt,$arg); + }}, 'u|uuid' => sub { - $show{'short'} = 0; - $show{'partition'} = 1; - $show{'uuid'} = 1; }, + $show{'uuid'} = 1;}, 'v|verbosity:i' => sub { my ($opt,$arg) = @_; $show{'short'} = 0; - if ( $arg =~ /^[0-8]$/ ){ - if ($arg == 0 ){ + if ($arg =~ /^[0-8]$/){ + if ($arg == 0){ $show{'short'} = 1; } - if ($arg >= 1 ){ + if ($arg >= 1){ $show{'cpu-basic'} = 1; $show{'disk-total'} = 1; $show{'graphic'} = 1; @@ -4344,105 +4622,105 @@ sub get_options { $show{'info'} = 1; $show{'system'} = 1; } - if ($arg >= 2 ){ + if ($arg >= 2){ $show{'battery'} = 1; $show{'disk-basic'} = 1; $show{'raid-basic'} = 1; $show{'machine'} = 1; $show{'network'} = 1; } - if ($arg >= 3 ){ + if ($arg >= 3){ $show{'network-advanced'} = 1; $show{'cpu'} = 1; $extra = 1; } - if ($arg >= 4 ){ + if ($arg >= 4){ $show{'disk'} = 1; $show{'partition'} = 1; } - if ($arg >= 5 ){ + if ($arg >= 5){ $show{'audio'} = 1; $show{'bluetooth'} = 1; - $show{'ram'} = 1; + $show{'graphic-full'} = 1; $show{'label'} = 1; $show{'optical-basic'} = 1; - $show{'ram'} = 1; $show{'raid'} = 1; + $show{'ram'} = 1; $show{'sensor'} = 1; $show{'swap'} = 1; $show{'uuid'} = 1; } - if ($arg >= 6 ){ + if ($arg >= 6){ $show{'optical'} = 1; $show{'partition-full'} = 1; $show{'unmounted'} = 1; $show{'usb'} = 1; $extra = 2; } - if ($arg >= 7 ){ - $b_downloader = 1 if ! check_program('dig'); + 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 ){ + if ($arg >= 8){ $b_admin = 1; - $b_downloader = 1; - $show{'logical'} = 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; + # $show{'weather'} = 1; } } else { - error_handler('bad-arg',$opt,$arg); - } }, - 'V|version' => sub { - $b_version = 1 }, - 'w|weather' => sub { - my ($opt) = @_; - $show{'short'} = 0; - $b_downloader = 1; - if ( $use{'weather'} ){ - $show{'weather'} = 1; - } - else { - error_handler('distro-block', $opt); - } }, - 'W|weather-location:s' => sub { + 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) = @_; - $arg ||= ''; - $arg =~ s/\s//g; $show{'short'} = 0; - $b_downloader = 1; - if ( $use{'weather'} ){ + $use{'downloader'} = 1; + if ($use{'weather'}){ + $arg =~ s/\s//g if $arg; if ($arg){ $show{'weather'} = 1; $show{'weather-location'} = $arg; } else { - error_handler('bad-arg',$opt,$arg); + $show{'weather'} = 1; } } else { - error_handler('distro-block', $opt); - } }, + 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 { - error_handler('bad-arg',$opt,$arg); - } }, - 'weather-unit:s' => sub { + main::error_handler('bad-arg',$opt,$arg); + }}, + 'weather-unit|wu:s' => sub { my ($opt,$arg) = @_; $arg ||= ''; $arg =~ s/\s//g; @@ -4451,10 +4729,11 @@ sub get_options { 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 { - error_handler('bad-arg',$opt,$arg); - } }, + main::error_handler('bad-arg',$opt,$arg); + }}, 'x|extra:i' => sub { my ($opt,$arg) = @_; if ($arg > 0){ @@ -4462,95 +4741,153 @@ sub get_options { } else { $extra++; - } }, + }}, 'y|width:i' => sub { my ($opt, $arg) = @_; - if( defined $arg && $arg == -1){ + 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 >= 80) ){ - set_display_width($arg); + 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 { - error_handler('bad-arg', $opt, $arg); - } }, + main::error_handler('bad-arg', $opt, $arg); + }}, 'z|filter' => sub { - $use{'filter'} = 1; }, - 'filter-label' => sub { - $use{'filter-label'} = 1; }, - 'Z|filter-override' => sub { - $use{'filter-override'} = 1; }, - 'filter-uuid' => sub { - $use{'filter-uuid'} = 1; }, + $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) { + if ($arg == 40){ $dl{'tiny'} = 0; - $b_downloader = 1;} - elsif ($arg == 41) { + $use{'downloader'} = 1;} + elsif ($arg == 41){ $dl{'curl'} = 0; - $b_downloader = 1;} - elsif ($arg == 42) { + $use{'downloader'} = 1;} + elsif ($arg == 42){ $dl{'fetch'} = 0; - $b_downloader = 1;} - elsif ($arg == 43) { + $use{'downloader'} = 1;} + elsif ($arg == 43){ $dl{'wget'} = 0; - $b_downloader = 1;} - elsif ($arg == 44) { + $use{'downloader'} = 1;} + elsif ($arg == 44){ $dl{'curl'} = 0; $dl{'fetch'} = 0; $dl{'wget'} = 0; - $b_downloader = 1;} + $use{'downloader'} = 1;} else { - error_handler('bad-arg', $opt, $arg); + 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 { - $b_arm = 1 }, + 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); - $b_fake_bsd = 1; + $fake{'bsd'} = 1; } else { - error_handler('bad-arg', $opt, $arg); + main::error_handler('bad-arg', $opt, $arg); } }, - 'bsd-data:s' => sub { + 'bt-tool:s' => sub { my ($opt,$arg) = @_; - if ($arg =~ /^(dboot|pciconf|sysctl|usbdevs)$/i){ - $b_fake_dboot = 1 if $arg eq 'dboot'; - $b_fake_pciconf = 1 if $arg eq 'pciconf'; - $b_fake_sysctl = 1 if $arg eq 'sysctl'; - $b_fake_usbdevs = 1 if $arg eq 'usbdevs'; + if ($arg =~ /^(bluetoothctl|bt-adapter|btmgmt|hciconfig|rfkill)$/i){ + $force{lc($arg)} = 1; } else { - error_handler('bad-arg', $opt, $arg); + main::error_handler('bad-arg', $opt, $arg); } }, - 'dbg:i' => sub { + 'cygwin' => sub { + $windows{'cygwin'} = 1;}, + 'dbg:s' => sub { my ($opt,$arg) = @_; - if ($arg > 0) { - $test[$arg] = 1; + if ($arg !~ /^\d+(,\d+)*$/){ + main::error_handler('bad-arg', $opt, $arg); } - else { - 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]$/){ - $debug=$arg; + $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 { - error_handler('bad-arg', $opt, $arg); - } }, + 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; @@ -4559,27 +4896,38 @@ sub get_options { 'debug-no-exit' => sub { $debugger{'no-exit'} = 1 }, 'debug-no-proc' => sub { - $debugger{'no-proc'} = 1; }, + $debugger{'no-proc'} = 1;}, 'debug-no-sys' => sub { - $debugger{'sys'} = 0; }, + $debugger{'sys'} = 0;}, 'debug-proc' => sub { - $debugger{'proc'} = 1; }, + $debugger{'proc'} = 1;}, 'debug-proc-print' => sub { $debugger{'proc-print'} = 1;}, 'debug-sys-print' => sub { - $debugger{'sys-print'} = 1; }, + $debugger{'sys-print'} = 1;}, 'debug-test-1' => sub { - $debugger{'test-1'} = 1; }, - 'debug-width:i' => sub { + $debugger{'test-1'} = 1;}, + 'debug-width|debug-y:i' => sub { my ($opt,$arg) = @_; - if ($arg =~ /^[0-9]+$/ && ($arg == 1 || $arg >= 80)){ + $arg ||= 80; + if ($arg =~ /^\d+$/ && ($arg == 1 || $arg >= 80)){ $debugger{'width'} = $arg; } else { - error_handler('bad-arg', $opt, $arg); - } }, + 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 { - $b_skip_dig = 0; }, + $force{'no-dig'} = 0;}, 'display:s' => sub { my ($opt,$arg) = @_; if ($arg =~ /^:?([0-9\.]+)?$/){ @@ -4587,761 +4935,1046 @@ sub get_options { $display ||= ':0'; $display = ":$display" if $display !~ /^:/; $b_display = ($b_root) ? 0 : 1; - $b_force_display = 1; + $force{'display'} = 1; $display_opt = "-display $display"; } else { - error_handler('bad-arg', $opt, $arg); - } }, - 'dmidecode' => sub { - $b_dmidecode_force = 1 }, + 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' && (!check_perl_module('HTTP::Tiny') || !check_perl_module('IO::Socket::SSL') )){ - error_handler('missing-perl-downloader', $opt, $arg); + 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 ( !check_program($arg)) { - error_handler('missing-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 = set_perl_downloader($arg); + $arg = main::set_perl_downloader($arg); %dl = ('dl' => $arg, $arg => 1); - $b_downloader = 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 { - error_handler('bad-arg', $opt, $arg); - } }, - 'fake-cpu' => sub { - $b_fake_cpu = 1 }, - 'fake-dmi' => sub { - $b_fake_dmidecode = 1 }, - 'fake-logical' => sub { - $b_fake_logical = 1 }, - 'fake-raid' => sub { - $b_fake_raid = 1 }, - 'fake-sensors' => sub { - $b_fake_sensors = 1 }, + main::error_handler('bad-arg', $opt, $arg); + }}, 'ftp:s' => sub { my ($opt,$arg) = @_; # pattern: ftp.x.x/x - if ($arg =~ /^ftp\..+\..+\/[^\/]+$/ ){ + if ($arg =~ /^ftp\..+\..+\/[^\/]+$/){ $ftp_alt = $arg; } else { - error_handler('bad-arg', $opt, $arg); + main::error_handler('bad-arg', $opt, $arg); }}, 'hddtemp' => sub { - $b_hddtemp_force = 1 }, + $force{'hddtemp'} = 1;}, 'host|hostname' => sub { $show{'host'} = 1; - $show{'no-host'} = 0}, + $show{'no-host'} = 0;}, 'html-wan' => sub { - $b_no_html_wan = 0; }, + $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; }, + $b_irc = 1;}, 'man' => sub { - $b_use_man = 1; }, - 'mips' => sub { - $b_mips = 1 }, - 'output:s' => sub { + $use{'yes-man'} = 1;}, + 'max-wrap|wrap-max|indent-min:i' => sub { my ($opt,$arg) = @_; - if ($arg =~ /^(json|screen|xml)$/){ - if ($arg =~ /json|screen|xml/){ - $output_type = $arg; - } - else { - error_handler('option-feature-incomplete', $opt, $arg); - } + if ($arg >= 0){ + $size{'max-wrap'} = $arg; } else { - error_handler('bad-arg', $opt, $arg); + main::error_handler('bad-arg', $opt, $arg); }}, + 'mips' => sub { + undef %risc; + $risc{'id'} = 'mips'; + $risc{'mips'} = 1;}, 'no-dig' => sub { - $b_skip_dig = 1; }, + $force{'no-dig'} = 1;}, + 'no-doas' => sub { + $force{'no-doas'} = 1;}, 'no-host|no-hostname' => sub { - $show{'host'} = 0 ; - $show{'no-host'} = 1}, + $show{'host'} = 0; + $show{'no-host'} = 1;}, 'no-html-wan' => sub { - $b_no_html_wan= 1;}, + $force{'no-html-wan'}= 1;}, 'no-man' => sub { - $b_no_man_force = 0; }, + $use{'no-man'} = 0;}, 'no-ssl' => sub { - $dl{'no-ssl-opt'}=1 }, + $use{'no-ssl'} = 1;}, 'no-sudo' => sub { - $b_no_sudo = 1; }, - 'output-file:s' => 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' || check_output_path($arg)){ + if ($arg eq 'print' || main::check_output_path($arg)){ $output_file = $arg; } else { - error_handler('output-file-bad', $opt, $arg); + main::error_handler('output-file-bad', $opt, $arg); } } else { - error_handler('bad-arg', $opt, $arg); + main::error_handler('bad-arg', $opt, $arg); }}, + 'pkg|rpm' => sub { + $force{'pkg'} = 1;}, 'ppc' => sub { - $b_ppc = 1 }, + undef %risc; + $risc{'id'} = 'ppc'; + $risc{'ppc'} = 1;}, 'recommends' => sub { - $b_recommends = 1; }, - 'sensors-default' => sub { - $b_sensors_default = 1; }, - 'sensors-exclude:s' => sub { - my ($opt,$arg) = @_; - if ($arg){ - @sensors_exclude = split(/\s*,\s*/, $arg); - } - else { - error_handler('bad-arg',$opt,$arg); - }}, - 'sensors-use:s' => sub { - my ($opt,$arg) = @_; - if ($arg){ - @sensors_use = split(/\s*,\s*/, $arg); - } - else { - error_handler('bad-arg',$opt,$arg); - }}, + $show{'recommends'} = 1;}, + 'riscv' => sub { + undef %risc; + $risc{'id'} = 'riscv'; + $risc{'riscv'} = 1;}, + 'sensors-sys' => sub { + $force{'sensors-sys'} = 1;}, 'sparc' => sub { - $b_sparc = 1; }, + undef %risc; + $risc{'id'} = 'sparc'; + $risc{'sparc'} = 1;}, 'sys-debug' => sub { - $debugger{'sys-force'} = 1; }, - 'tty' => sub { # workaround for ansible running this - $b_irc = 0; }, - 'U|update:s' => sub { # 1,2,3 OR http://myserver/path/inxi + $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) = @_; - $b_downloader = 1; - if ( $use{'update'} ){ - $b_updater = 1; - if (!$arg && $self_name eq 'pinxi'){ - $b_man = 1; - $download_id = 'inxi-perl branch'; - $self_download = get_defaults('inxi-pinxi'); - } - elsif ($arg && $arg eq '3'){ - $b_man = 1; - $download_id = 'dev server'; - $self_download = get_defaults('inxi-dev'); - } - else { - if (!$arg){ - $download_id = 'main branch'; - $self_download = get_defaults('inxi-main'); - $b_man = 1; - $b_use_man = 1; - } - elsif ( $arg =~ /^[12]$/){ - $download_id = "branch $arg"; - $self_download = get_defaults("inxi-branch-$arg"); - } - elsif ( $arg =~ /^http/){ - $download_id = 'alt server'; - $self_download = $arg; - } - } - if (!$self_download){ - error_handler('bad-arg', $opt, $arg); - } - } - else { - error_handler('distro-block', $opt); - } }, + process_updater($opt,$arg);}, 'usb-sys' => sub { - $b_usb_sys = 1 }, + $force{'usb-sys'} = 1;}, 'usb-tool' => sub { - $b_usb_tool = 1 }, + $force{'lsusb'} = 1;}, 'wan-ip-url:s' => sub { my ($opt,$arg) = @_; if ($arg && $arg =~ /^(f|ht)tp[s]?:\/\//){ $wan_url = $arg; - $b_skip_dig = 1 + $force{'no-dig'} = 1; } else { - error_handler('bad-arg', $opt, $arg); - }}, - 'wm' => sub { - $b_wmctrl = 1 }, - 'wrap-max|indent-min:i' => sub { - my ($opt,$arg) = @_; - if ($arg =~ /^\d+$/){ - $size{'wrap-max'} = $arg; - } - else { - error_handler('bad-arg', $opt, $arg); + 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) = @_; - error_handler('unknown-option', "$opt", "" ); } - ) ; #or error_handler('unknown-option', "@ARGV", ''); - ## run all these after so that we can change widths, downloaders, etc - eval $end if $b_log; - CheckRecommends::run() if $b_recommends; - set_downloader() if $b_downloader || $wan_url || ($b_skip_dig && $show{'ip'}); # sets for either config or arg here - set_xorg_log() if $show{'graphic'}; - show_version() if $b_version; - show_options() if $b_help; - $b_man = 0 if (!$b_use_man || $b_no_man_force); - update_me( $self_download, $download_id ) if $b_updater; - if ($output_type){ - if ($output_type ne 'screen' && ! $output_file){ - error_handler('bad-arg', '--output', '--output-file not provided'); - } - } - $show{'graphic-basic'} = 0 if $b_admin; - if ($b_sensors_default){ + 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'}){ - $b_block_tool = 1; - } - if ($show{'raid'} || $show{'disk'} || $show{'disk-total'} || $show{'disk-basic'} - || $show{'unmounted'}){ - $b_mdadm = 1; + $show{'logical'} || $show{'partition'} || $show{'partition-full'} || $show{'raid'} || + $show{'unmounted'}){ + $use{'block-tool'} = 1; } - if ($bsd_type && ($show{'short'} || $show{'disk-basic'} || $show{'disk-total'} || $show{'disk'})){ - $b_dm_boot_disk = 1; - } - if ($bsd_type && ($show{'optical-basic'} || $show{'optical'})){ - $b_dm_boot_optical = 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'}){ - $b_smartctl = 1; + $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'}){ - $b_lvm = 1; + $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; } - set_sudo() if ( $show{'unmounted'} || ($extra > 0 && $show{'disk'}) ); - $extra = 3 if $b_admin; - $use{'filter'} = 0 if $use{'filter-override'}; # 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'} ){ + if ($show{'disk'} || $show{'optical'}){ $show{'disk-basic'} = 0; $show{'disk-total'} = 0; } - if ( $show{'ram'} || $show{'slot'} || ($show{'cpu'} && $extra > 1) || - ( ( $bsd_type || $b_dmidecode_force ) && ($show{'machine'} || $show{'battery'}) ) ){ - $b_dmi = 1; + if ($show{'ram'} || $show{'slot'} || + ($show{'cpu'} && ($extra > 1 || $bsd_type)) || + (($bsd_type || $force{'dmidecode'}) && ($show{'machine'} || $show{'battery'}))){ + $use{'dmidecode'} = 1; } - if ($show{'audio'} || $show{'graphic'} || $show{'network'} || $show{'raid'} ){ - $b_pci = 1; + if (!$bsd_type && ($show{'ram'})){ + $use{'udevadm'} = 1; } - if ($show{'usb'} || $show{'audio'} || $show{'bluetooth'} || $show{'graphic'} || $show{'network'} ){ - $b_usb = 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; } - if ($bsd_type && ($show{'short'} || $show{'system'} || $show{'battery'} || $show{'cpu'} || $show{'cpu-basic'} || - $show{'info'} || $show{'machine'} || $show{'process'} || $show{'ram'} || $show{'sensor'} ) ){ - $b_sysctl = 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 (@data); - my $line = ''; + 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 = ($b_arm) ? 'features' : 'flags' ; - if ( $bsd_type ){ + my $flags = (%risc || $bsd_type) ? 'features' : 'flags' ; + if ($bsd_type){ $partition_string='slice'; $partition_string_u='Slice'; } # fit the line to the screen! - for my $i ( 0 .. ( ( $size{'max'} / 2 ) - 2 ) ){ - $line = $line . '- '; - } - push(@data, + 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', '', '', '' ], + 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, E, G, I, J, L, M, N, - P, R, S, W, d, f, i, j, l, m, n, o, p, r, s, t, u, w, --slots. - If you use them with -v [level], -b or -F, $self_name will add the requested - lines to the output." ], + 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" ], + $self_name^-FzjJxy^80"], ['0', '', '', $line ], - ['0', '', '', "Output Control Options (see Extra Data Options to extend output):" ], - ['1', '-A', '--audio', "Audio/sound devices(s), driver, sound server." ], - ['1', '-b', '--basic', "Basic output, short form. Same as $self_name^-v^2." ], - ['1', '-B', '--battery', "System battery info, including charge and condition, plus - extra info (if battery present)." ], - ['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', '-C', '--cpu', "CPU output, including per CPU clock speed and max - CPU speed (if available)." ], + ['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." ], + 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." ], + 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." ], + 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, renderer, - OpenGL version)." ], + (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', '-I', '--info', "General info, including processes, uptime, memory, - 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. Triggers -P. - For full -p output, use -pl." ], + 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. Requires root. Numbers of - devices (slots) supported and individual memory devices (sticks of memory etc). - For devices, shows device locator, size, speed, type (e.g. DDR3). - If neither -I nor -tm are selected, also shows RAM used/total." ], - ['1', '', '--memory-modules', "Memory (RAM) data. Exclude empty module slots." ], - ['1', '', '--memory-short', "Memory (RAM) data. Show only short Memory RAM report, - number of arrays, slots, modules, and RAM type." ], + 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). + 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." ], + 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)." ], - ['1', '', '', "Example: ^<username>^ALL^=^NOPASSWD:^/usr/bin/file^" ], - ['1', '-p', '--partitions-full', "Full $partition_string information (-P plus all other - detected ${partition_string}s)." ], + you have added to /etc/sudoers (sudo v. 1.7 or newer)(or try doas)."], + ['1', '', '', "Example: ^<username>^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." ], + mounted ${partition_string}s."], ['1', '-r', '--repos', "Distro repository data. Supported repo types: APK, - APT, CARDS, EOPKG, PACMAN, PACMAN-G2, PISI, PORTAGE, PORTS (BSDs), SLACKPKG, - TCE, URPMQ, 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." ], + APT, CARDS, EOPKG, NETPKG, NIX, PACMAN, PACMAN-G2, PISI, PKG (BSDs), PORTAGE, + PORTS (BSDs), SBOPKG, SBOUI, SCRATCHPKG, SLACKPKG, SLAPT_GET, SLPKG, TCE, + TAZPKG, URPMQ, 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. GPU temp only for Fglrx/Nvidia drivers. - Nvidia shows screen number for > 1 screen. IPMI sensors if present." ], - ['1', '', '--slots', "PCI slots: type, speed, status. Requires root." ], + 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." ], + (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). " ], + 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 UUIDs. Triggers -P. For full -p - output, use -pu." ], + 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" ], + 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. " ], + triggers -x. "], ['2', '4', '', "$partition_string_u size/used data (-P) for - (if present) /, /home, /var/, /boot. Shows full disk data (-D). " ], + (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)." ], + 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 and RAID forced; - triggers -xxx."], - ['2', '8', '', "Everything available, including logical (-L), - repos (-r), processes (-tcm), PCI slots (--slots); triggers admin (-a)."], + 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(@data, - ['1', '-w', '--weather', "Local weather data/time. To check an alternate - location, see -W. NO AUTOMATED QUERIES ALLOWED!"], - ['1', '-W', '--weather-location', "[location] Supported options for - [location]: postal code[,country/country code]; city, state (USA)/country + 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', "[1-9] Change weather data source. 1-4 generally - active, 5-9 check. See man."], - ['1', '', '--weather-unit', "Set weather units to metric (m), imperial (i), - metric/imperial (mi), or imperial/metric (im)."], + 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(@data, - ['1', '-y', '--width', "Output line width max (integer >= 80). 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', '-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', '', '--filter-label', "Filters out ${partition_string} labels in -j, - -o, -p, -P, -Sa." ], - ['1', '-Z', '--filter-override', "Override for output filters. Useful for - debugging networking issues in IRC, for example." ], - ['1', '', '--filter-uuid', "Filters out ${partition_string} UUIDs in -j, - -o, -p, -P, -Sa." ], - ['0', '', '', "$line" ], - ['0', '', '', "Extra Data Options:" ], - ['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)." ], - ['2', '-C', '', "If available: CPU socket type, base/boost speeds - (dmidecode+root/sudo required); CPU vulnerabilities (bugs); - family, model-id, stepping - format: hex (decimal) if greater - than 9, otherwise hex; microcode - format: hex." ], - ['2', '-d,-D', '', "If available: logical and physical block sizes; drive family; - maj:min, USB drive specifics; SMART report." ], - ['2', '-E', '', "If available: in Report:, adds Info: line: acl-mtu, - sco-mtu, link-policy, link-mode, service-classes." ], - ['2', '-G', '', "If available: Xorg Display ID, Screens total, default Screen, - current Screen; per X Screen: resolution, dpi, size, diagonal; per Monitor: - resolution; hz; dpi; size; diagonal; list of alternate kernel modules/drivers - for device(s)." ], - ['2', '-I', '', "As well as per package manager counts, also adds total - number of lib files found for each package manager if not -r." ], - ['2', '-j,-p,-P', '', "For swap (if available): swappiness and vfs cache - pressure, and if values are default or not." ], - ['2', '-L', '', "LV, Crypto, devices, components: add maj:min; show - full device/components report (speed, mapped names)." ], - ['2', '-n,-N', '', "If available: list of alternate kernel modules/drivers - for device(s)." ], - ['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 boot parameters." ], - ['0', '', '', ''], + 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):" ], + 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)." ], - ['2', '-B', '', "Vendor/model, status (if available); attached devices - (e.g. wireless mouse, keyboard, if present)." ], - ['2', '-C', '', "CPU $flags (short list, use -f to see full list); - CPU boost (turbo) enabled/disabled, if present; - Bogomips on CPU; CPU microarchitecture + revision (if found, or - unless --admin, then shows as 'stepping')." ], + 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." ], + 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). - Example:^<username>^ALL^=^NOPASSWD:^/usr/sbin/hddtemp" ], + (sudo v. 1.7 or newer)(or try doas). + Example:^<username>^ALL^=^NOPASSWD:^/usr/sbin/hddtemp"], ['2', '-E', '', "PCI/USB Bus ID of device, driver version, - LMP version." ], - ['2', '-G', '', "Specific vendor/product information (if relevant); - PCI/USB ID of device; Direct rendering status (in X); Screen - number GPU is running on (Nvidia only)." ], + 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 GCC. With -xx, also shows other installed - GCC versions. If running in shell, not in IRC client, shows shell version - number, if detected. Init/RC type and runlevel (if available). Total - count of all packages discovered in system and not -r." ], - ['2', '-j', '', "Add mapped: name if partition mapped." ], - ['2', '-J', '', "For Device: driver." ], - ['2', '-L', '', "For VG > LV, and other Devices, dm:" ], - ['2', '-m,--memory-modules', '', "Max memory module size (if available), device type." ], + 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)." ], - ['2', '-o,-p,-P', '', "Add mapped: name if partition mapped." ], - ['2', '-r', '', "Packages, see -Ix." ], + 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." ], + 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)" ], + 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)." ], + memory (-xt m)."], ); - if ( $use{'weather'} ){ - push(@data, - ['2', '-w,-W', '', "Wind speed and direction, humidity, pressure, - and time zone, if available." ]); + if ($use{'weather'}){ + push(@$rows, + ['2', '-w', '', "Wind speed and direction, humidity, pressure, and time + zone, if available."]); } - push(@data, + 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." ], - ['2', '-B', '', "Serial number, voltage now/minimum (if available)." ], - ['2', '-C', '', "L1/L3 cache (if root and dmidecode installed)." ], - ['2', '-D', '', "Disk transfer speed; NVMe lanes; Disk serial number; LVM - volume group free space (if available)." ], - ['2', '-E', '', "Chip vendor:product ID, LMP subversion." ], - ['2', '-G', '', "Chip vendor:product ID for each video device; OpenGL - compatibility version, if free drivers and available; 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 dpi." ], - ['2', '-I', '', "Other detected installed gcc versions (if present). System - default runlevel. Adds parent program (or tty) for shell info if not in - IRC. Adds Init version number, RC (if found). Adds per package manager - package counts if not -r." ], - ['2', '-j,-p,-P', '', "Swap priority." ], - ['2', '-J', '', "Vendor:chip ID." ], + 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,--memory-modules', '', "Manufacturer, part number; single/double bank (if found)." ], - ['2', '-M', '', "Chassis info, BIOS ROM size (dmidecode only), if available." ], - ['2', '-N', '', "Chip vendor:product ID." ], - ['2', '-r', '', "Packages, see -Ixx." ], + 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', '', "Display manager (dm) in desktop output (e.g. kdm, - gdm3, lightdm); active window manager if detected; desktop toolkit, - if available (Xfce/KDE/Trinity only)." ], - ['2', '--slots', '', "Slot length." ], + 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(@data, - ['2', '-w,-W', '', "Snow, rain, precipitation, (last observed hour), - cloud cover, wind chill, dew point, heat index, 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(@data, + 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)." ], - ['2', '-D', '', "Firmware rev. if available; partition scheme, in some cases; disk - rotation speed/SSD (if detected)." ], - ['2', '-E', '', "Serial number, class ID, HCI version and revision." ], - ['2', '-G', '', "Serial number, class ID." ], - ['2', '-I', '', "For 'Shell:' adds ([su|sudo|login]) to shell name if present; - adds default shell+version if different; for 'running in:' adds (SSH) if SSH session; - adds wakeups: (from suspend) to Uptime." ], - ['2', '-J', '', "For Device: serial number (if present), interface count; USB speed." ], - ['2', '-m,--memory-modules', '', "Width of memory bus, data and total (if present and greater - than data); Detail for Type, if present; module voltage, if available; serial - number." ], - ['2', '-N', '', "Serial number, class ID." ], + 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', '', "Panel/tray/bar/dock info in desktop output, if in X (like lxpanel, - xfce4-panel, mate-panel); (if available) dm version number, window manager - version number."], + 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(@data, - ['2', '-w,-W', '', "Location (uses -z/irc filter), weather observation - time, altitude, sunrise/sunset, if available." ] + if ($use{'weather'}){ + push(@$rows, + ['2', '-w', '', "Location (uses -z/irc filter), weather observation time, + altitude, sunrise/sunset, if available."] ); } - push(@data, - [0, '', '', "$line" ], - [0, '', '', "Additional Options:" ], - ['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." ], + 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 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."], ); - if ( $use{'update'} ){ - push(@data, - ['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', '1', '', "Get the git branch one version." ], - ['2', '2', '', "Get the git branch two version." ], - ['3', '3', '', "Get the dev server (smxi.org) version." ], - ['2', '<http>', '', "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, + [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(@data, - ['1', '-V', '--version', "Prints $self_name version info then exits." ], - ['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." ], + 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', '', '--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', '', '--hddtemp', "Force use of hddtemp for disk temps." ], - ['1', '', '--host', "Turn on hostname for -S." ], - ['1', '', '--html-wan', "Overrides configuration item NO_HTML_WAN (resets to default)." ], - ['1', '', '--limit', "[-1; 1-x] Set max output limit of IP addresses for -i - (default 10; -1 removes limit)." ], + Perl if HTTP::Tiny present."], + ['1', '', '--bt-tool', "[bt-adapter btmgmt hciconfig rfkill] Force use of + given tool forbluetooth 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(@data, - ['1', '', '--man', "Install correct man version for dev branch (-U 3) or pinxi using -U." ], + if ($use{'update'}){ + push(@$rows, + ['1', '', '--man', "Install correct man version for dev branch (-U 3) or + pinxi using -U."], ); } - push(@data, - ['1', '', '--no-dig', "Skip dig for WAN IP checks, use downloader program." ], - ['1', '', '--no-host', "Turn off hostname for -S. Useful if showing output from servers etc. - -z triggers --no-host." ], - ['1', '', '--no-html-wan', "Skip HTML IP sources for WAN IP checks, use dig only, - or nothing if --no-dig." ], + 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(@data, - ['1', '', '--no-man', "Disable man install for all -U update actions." ], + if ($use{'update'}){ + push(@$rows, + ['1', '', '--no-man', "Disable man install for all -U update actions."], ); } - push(@data, + 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', '', '--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', '', '--partition-sort', "[dev-base|fs|id|label|percent-used|size|uuid|used] - Change sort order of ${partition_string} output. See man page for specifics." ], - ['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, Linux only)." ], - ['1', '', '--sensors-use', "[sensor[s] name, comma separated] Use only supplied sensor - array[s] for -s output (lm-sensors, Linux only)." ], + (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 slow to massive rpm + package 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."], - ['1', '', '--usb-sys', "Force USB data to use /sys as data source (Linux only)." ], - ['1', '', '--usb-tool', "Force USB data to use lsusb as data source (Linux only)." ], + 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/ip.php" ], - ['1', '', '--wm', "Force wm: to use wmctrl as data source. Default uses ps." ], - ['1', '', '--wrap-max', "Set maximum width where $self_name autowraps line starters - (previously --indent-min). Current: $size{'wrap-max'}" ], + 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', "Specific debuggers, change often. Only 1 is constant:" ], - ['2', '1', '', "Show downloader output. Turns off quiet mode." ], - ['1', '', '--debug', "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." ], + ['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." ], + 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-proc', "Force debugger parsing of /proc as sudo/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/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" ], + 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(\@data); + 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 (@data,$link,$self_string); + 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 '.' ){ + if ($working_path eq '.'){ $working_path = getcwd(); } - elsif ( $working_path !~ /^\// ){ + 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" ){ + 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(@data, [ 0, '', '', "$self_name $self_version-$self_patch ($self_date)"]); - if ( ! $b_irc ){ - push(@data, [ 0, '', '', '']); + 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(@data, + 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(@data, [ 0, '', '', "Started via symbolic link: $link" ]); + if ($link){ + push(@$rows, [ 0, '', '', "Started via symbolic link: $link" ]); } - push(@data, + push(@$rows, [ 0, '', '', '' ], - [ 0, '', '', "Website:^https://github.com/smxi/inxi^or^https://smxi.org/" ], + [ 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, '', '', '' ], @@ -5351,23 +5984,22 @@ sub show_version { (https://www.gnu.org/licenses/gpl.html)" ] ); } - print_basic(\@data); - exit 0; # shell true + print_basic($rows); + exit 0 if !$show{'version-short'} || $show{'short'}; # shell true } ######################################################################## #### STARTUP DATA ######################################################################## -# StartClient +## StartClient { package StartClient; # use warnings; # use strict; -my $ppid = ''; my $pppid = ''; -# NOTE: there's no reason to crete an object, we can just access +# NOTE: there's no reason to create an object, we can just access # the features statically. # args: none # sub new { @@ -5378,13 +6010,12 @@ my $pppid = ''; # return bless $self, $class; # } -sub get_client_data { +sub set { eval $start if $b_log; - $ppid = getppid(); - main::set_ps_aux() if ! @ps_aux; + PsData::set_cmd() if !$loaded{'ps-cmd'}; + # $b_irc = 1; # for testing, like cli konvi start which shows as tty if (!$b_irc){ - # we'll run get_shell_data for -I, but only then - $client{'ppid'} = $ppid; + # we'll run ShellData::set() for -I, but only then } else { $use{'filter'} = 1; @@ -5399,17 +6030,16 @@ sub get_client_data { sub get_client_name { eval $start if $b_log; my $client_name = ''; - # print "$ppid\n"; - if ($ppid && -e "/proc/$ppid/exe" ){ + if ($ppid && -e "/proc/$ppid/exe"){ $client_name = lc(readlink "/proc/$ppid/exe"); $client_name =~ s/^.*\///; - if ($client_name =~ /^bash|dash|sh|python.*|perl.*$/){ - $pppid = (main::grabber("ps -p $ppid -o ppid"))[1]; - #my @temp = (main::grabber("ps -p $ppid -o ppid 2>/dev/null"))[1]; + 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" ){ + if ($pppid && -f "/proc/$pppid/exe"){ $client_name = lc(readlink "/proc/$pppid/exe"); $client_name =~ s/^.*\///; $client{'native'} = 0; @@ -5418,16 +6048,15 @@ sub get_client_name { $client{'name'} = $client_name; get_client_version(); # print "c:$client_name p:$pppid\n"; - #print "$client{'name-print'}\n"; + # print "$client{'name-print'}\n"; } else { - if (! check_modern_konvi() ){ - $ppid = getppid(); - $client_name = (main::grabber("ps -p $ppid"))[1]; + 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 $client_name; + my @data = split(/\s+/, $client_name); if ($bsd_type){ - $client_name = lc($data[5]); + $client_name = lc($data[4]); } # gnu/linux uses last value else { @@ -5445,27 +6074,29 @@ sub get_client_name { } } if ($b_log){ - my $string = "Client: $client{'name'} :: version: $client{'version'} :: konvi: $client{'konvi'} :: PPID: $ppid"; + 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; - @app = main::program_values($client{'name'}); + my @app = ProgramData::values($client{'name'}); my (@data,@working,$string); if (@app){ $string = ($client{'name'} =~ /^gribble|limnoria|supybot$/) ? 'supybot' : $client{'name'}; - $client{'version'} = main::program_version($string,$app[0],$app[1],$app[2],$app[4],$app[5],$app[6]); + $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|dash|sh$/ ){ + 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"); + elsif ($client{'name'} eq 'bitchx'){ + @data = main::grabber("$client{'name'} -v 2>/dev/null"); $string = awk(\@data,'Version'); if ($string){ $string =~ s/[()]|bitchx-//g; @@ -5479,28 +6110,28 @@ sub get_client_version { # 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' ){ + 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' ){ + 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'}) { + 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'} eq 'konversation'){ + $client{'konvi'} = (!$client{'native'}) ? 2 : 1; } - elsif ($client{'name'} =~ /quassel/) { + elsif ($client{'name'} =~ /quassel/i){ @data = main::grabber("$client{'name'} -v 2>/dev/null"); foreach (@data){ if ($_ =~ /^Quassel IRC:/){ @@ -5515,8 +6146,8 @@ sub get_client_version { $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(); + 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/<pid of the grandparent of this process>/exe is a link to /usr/bin/kdeinit # with one parameter which contains parameters separated by spaces(??), first param being KSirc. @@ -5525,36 +6156,38 @@ sub get_client_version { # 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{'version'} = main::program_version('ksirc','KSirc:',2,'-v',0,0); + foreach (@$cmdline){ + if ($_ =~ /dsirc/){ $client{'name'} = 'ksirc'; - $client{'name-print'} = 'KSirc'; + ($client{'name-print'},$client{'version'}) = ProgramData::full('ksirc'); } } $client{'console-irc'} = 1; perl_python_client(); } - elsif ($client{'name'} =~ /python/) { + elsif ($client{'name'} =~ /python/){ perl_python_client(); } - if (!$client{'name-print'}) { - # NOTE: these must be empirically determined, not all events that - # show no tty are actually IRC. - my $wl_terms = 'alacritty|evilvte|germinal|guake|hyper|kate|kitty|kmscon|'; - $wl_terms .= 'konsole|minicom|putty|rxvt|sakura|shellinabox|^st$|sudo|term|tilda|'; - $wl_terms .= 'tilix|urvxt|yaft|yakuake'; - my $wl_clients = 'ansible|chef|run-parts|sshd'; + # 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|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){ - main::get_shell_data($ppid); + ShellData::set(); } else { $client{'name-print'} = $client{'name'}; } $b_irc = 0; + $use{'filter'} = 0; } else { $client{'name-print'} = 'Unknown Client: ' . $client{'name'}; @@ -5562,17 +6195,17 @@ sub get_client_version { } eval $end if $b_log; } + sub get_cmdline { eval $start if $b_log; my @cmdline; my $i = 0; - $ppid = getppid(); - if (! -e "/proc/$ppid/cmdline" ){ + if (! -e "/proc/$ppid/cmdline"){ return 1; } local $\ = ''; - open( my $fh, '<', "/proc/$ppid/cmdline" ) or - print_line("Open /proc/$ppid/cmdline failed: $!"); + open(my $fh, '<', "/proc/$ppid/cmdline") or + print_line("Open /proc/$ppid/cmdline failed: $!"); my @rows = <$fh>; close $fh; foreach (@rows){ @@ -5580,42 +6213,44 @@ sub get_cmdline { $i++; last if $i > 31; } - if ( $i == 0 ){ + 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; + 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 = main::program_values('konversation'); - $client{'version'} = main::program_version('konversation',$app[0],$app[1],$app[2],$app[5],$app[6]); + 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 && + elsif (!$b_display && (main::check_program('supybot') || main::check_program('gribble') || main::check_program('limnoria')) && - ( grep { $_ =~ /supybot/ } @ps_cmd ) ){ - @app = main::program_values('supybot'); - $client{'version'} = main::program_version('supybot',$app[0],$app[1],$app[2],$app[5],$app[6]); + (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 ){ + if (grep { $_ =~ /gribble/ } @ps_cmd){ $client{'name'} = 'gribble'; $client{'name-print'} = 'Gribble'; } - if ( grep { $_ =~ /limnoria/ } @ps_cmd){ + if (grep { $_ =~ /limnoria/ } @ps_cmd){ $client{'name'} = 'limnoria'; $client{'name-print'} = 'Limnoria'; } @@ -5634,40 +6269,49 @@ sub perl_python_client { $client{'name-print'} = "Unknown $client{'name'} client"; } if ($b_log){ - my $string = "namep: $client{'name-print'} name: $client{'name'} version: $client{'version'}"; + 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 + +# 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 = 0; - my $konvi_version = ''; - my $konvi = ''; - my $pid = ''; - my (@temp); + 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 - if ( -d '/usr/share/kde4/apps/konversation' || -d '/usr/share/apps/konversation' ){ - $pid = main::awk(\@ps_aux,'konversation -session',2,'\s+'); - main::log_data('data',"pid: $pid") if $b_log; - $konvi = readlink ("/proc/$pid/exe"); - $konvi =~ s/^.*\///; # basename - @app = main::program_values('konversation'); + # 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){ - @app = main::program_values('konversation'); - $konvi_version = main::program_version($konvi,$app[0],$app[1],$app[2],$app[5],$app[6]); - @temp = split('\.', $konvi_version); + 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; @@ -5678,23 +6322,23 @@ sub check_modern_konvi { 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: $konvi_qt4 verNum: $konvi_version pid: $pid ppid: $ppid" ); + # 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; - my $config_tool = ''; # https://userbase.kde.org/Konversation/Scripts/Scripting_guide - if ( $client{'konvi'} == 3 ){ + if ($client{'konvi'} == 3){ $client{'dserver'} = shift @ARGV; $client{'dtarget'} = shift @ARGV; $client{'dobject'} = 'default'; } - elsif ( $client{'konvi'} == 1 ){ + elsif ($client{'konvi'} == 1){ $client{'dport'} = shift @ARGV; $client{'dserver'} = shift @ARGV; $client{'dtarget'} = shift @ARGV; @@ -5702,22 +6346,6 @@ sub set_konvi_data { } # for some reason this logic hiccups on multiple spaces between args @ARGV = grep { $_ ne '' } @ARGV; - # there's no current kde 5 konvi config tool that we're aware of. Correct if changes. - if ( main::check_program('kde4-config') ){ - $config_tool = 'kde4-config'; - } - elsif ( main::check_program('kde5-config') ){ - $config_tool = 'kde5-config'; - } - elsif ( main::check_program('kde-config') ){ - $config_tool = 'kde-config'; - } - # The section below is on request of Argonel from the Konversation developer team: - # it sources config files like $HOME/.kde/share/apps/konversation/scripts/inxi.conf - if ($config_tool){ - my @data = main::grabber("$config_tool --path data 2>/dev/null",':'); - main::get_configs(\@data); - } eval $end if $b_log; } } @@ -5727,37 +6355,25 @@ sub set_konvi_data { ######################################################################## #### ------------------------------------------------------------------- -#### FILTERS AND TOOLS +#### CLEANERS, FILTERS, AND TOOLS #### ------------------------------------------------------------------- -sub apply_filter { - my ($string) = @_; - if ($string){ - $string = ( $use{'filter'} ) ? $filter_string : $string; - } - else { - $string = 'N/A'; - } - return $string; -} -# note, let the print logic handle N/A cases -sub apply_partition_filter { - my ($source,$string,$type) = @_; - return $string if !$string || $string eq 'N/A'; - if ($source eq 'system') { - my $test = ($type eq 'label') ? '=LABEL=': '=UUID='; - $string =~ s/$test[^\s]+/$test$filter_string/g; - } - else { - $string = $filter_string; - } - return $string; +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|<?no\sstring>?|revision|semiconductor|software|technolog(ies|y)|<?unknown>?|ltd\.|<ltd>|\bltd\b|inc\.|<inc>|\binc\b|intl\.|co\.|<co>|corp\.|<corp>|\(tm\)|\(r\)|®|\(rev ..\)|\'|\"|\?//gi; + $item =~ s/,|\*/ /g; + $item =~ s/^\s+|\s+$//g; + $item =~ s/\s\s+/ /g; + return $item; } -sub arm_cleaner { + +sub clean_arm { my ($item) = @_; $item =~ s/(\([^\(]*Device Tree[^\)]*\))//gi; - $item =~ s/\s\s+/ /g; $item =~ s/^\s+|\s+$//g; + $item =~ s/\s\s+/ /g; return $item; } @@ -5766,58 +6382,150 @@ 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 - return if ! $data; + return if !$data; $data =~ s/[:\47]|\\[a-z]|\n|,|\"|\*|\||\+|\[\s\]|n\/a|\s\s+/ /g; $data =~ s/\(\s*\)//; $data =~ s/^\s+|\s+$//g; return $data; } -sub cleaner { - my ($item) = @_; - return $item if !$item;# handle cases where it was 0 or '' - # note: |nee trips engineering, but I don't know why nee was filtered - $item =~ s/chipset|company|components|computing|computer|corporation|communications|electronics|electrical|electric|gmbh|group|incorporation|industrial|international|\bnee\b|revision|semiconductor|software|technologies|technology|ltd\.|<ltd>|\bltd\b|inc\.|<inc>|\binc\b|intl\.|co\.|<co>|corp\.|<corp>|\(tm\)|\(r\)|®|\(rev ..\)|\'|\"|\sinc\s*$|\?//gi; - $item =~ s/,|\*/ /g; - $item =~ s/\s\s+/ /g; - $item =~ s/^\s+|\s+$//g; - return $item; -} - -sub disk_cleaner { +sub clean_disk { my ($item) = @_; return $item if !$item; # <?unknown>?| $item =~ s/vendor.*|product.*|O\.?E\.?M\.?//gi; - $item =~ s/\s\s+/ /g; $item =~ s/^\s+|\s+$//g; + $item =~ s/\s\s+/ /g; return $item; } -sub dmi_cleaner { +sub clean_dmi { my ($string) = @_; - my $cleaner = '^Base Board .*|^Chassis .*|empty|Undefined.*|.*O\.E\.M\..*|.*OEM.*|^Not .*'; - $cleaner .= '|^System .*|.*unknow.*|.*N\/A.*|none|^To be filled.*|^0x[0]+$'; - $cleaner .= '|\[Empty\]|<Bad Index>|<OUT OF SPEC>|Default string|^\.\.$|Manufacturer.*'; - $cleaner .= '|AssetTagNum|Manufacturer| Or Motherboard|PartNum.*|\bOther\b.*|SerNum'; - $string =~ s/$cleaner//i; - $string =~ s/^\s+|\bbios\b|\bacpi\b|\s+$//gi; + $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 =~ s/^\s+|\s+$//g; $string = remove_duplicates($string) if $string; return $string; } -sub general_cleaner { +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) = @_; - my $cleaner = '\b(defauult string|empty|none|undefined.*|unknown|unspecified)\b'; - $string =~ s/$cleaner//i; + 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; } -# args: $1 - size in KB, return KB, MB, GB, TB, PB, EB; $2 - 'string'; -# $3 - default value if null -# returns string with units or array or size unmodified if not numeric + +# Note, let the print logic handle N/A cases +sub filter_partition { + my ($source,$string,$type) = @_; + return $string if !$string || $string eq 'N/A'; + if ($source eq 'system'){ + my $test = ($type eq 'label') ? '=LABEL=': '=UUID='; + $string =~ s/$test[^\s]+/$test$filter_string/g; + } + else { + $string = $filter_string; + } + return $string; +} + +sub filter_pci_long { + my ($string) = @_; + if ($string =~ /\[AMD(\/ATI)?\]/){ + $string =~ s/Advanced\sMicro\sDevices\s\[AMD(\/ATI)?\]/AMD/; + } + return $string; +} + +# 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); @@ -5867,140 +6575,163 @@ sub get_size { sub increment_starters { my ($key,$indexes) = @_; my $result = $key; - if (defined $indexes->{$key} ){ + if (defined $indexes->{$key}){ $indexes->{$key}++; $result = "$key-$indexes->{$key}"; } return $result; } -sub pci_cleaner { - my ($string,$type) = @_; - #print "st1 $type:$string\n"; - my $filter = 'and\ssubsidiaries|compatible\scontroller|'; - $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 pci_cleaner_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|motherboard|network|onboard|'; - $filter .= 'raid|pci\s?express'; - $string =~ s/\b($filter)\b//ig; - $string =~ s/\s\s+/ /g; - $string =~ s/^\s+|\s+$//g; - return $string; -} - -sub pci_long_filter { - my ($string) = @_; - if ($string =~ /\[AMD(\/ATI)?\]/){ - $string =~ s/Advanced\sMicro\sDevices\s\[AMD(\/ATI)?\]/AMD/; +sub make_line { + my $line = ''; + foreach (0 .. $size{'max-cols-basic'} - 2){ + $line .= '-'; } - 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 regex_cleaner { - my ($string) = @_; - return if ! $string; - $string =~ s/(\{|\}|\(|\)|\[|\]|\|)/ /g; - $string =~ s/\s\s+/ /g; - $string =~ s/^\s+|\s+$//g; - return $string; + return $line; } -sub remove_duplicates { - my ($string) = @_; - return if ! $string; - my $holder = ''; - my (@temp); - foreach (split(/\s+/, $string)){ - if ($holder ne $_){ - push(@temp, $_); - } - $holder = $_; +# 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; } - $string = join(' ', @temp); - return $string; + # 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]}); } -sub row_defaults { - my ($type,$id) = @_; +# args: 0: type; 1: info [optional]; 2: info [optional] +sub message { + my ($type,$id,$id2) = @_; $id ||= ''; - my %unfound = ( + $id2 ||= ''; + my %message = ( 'arm-cpu-f' => 'Use -f option to see features', - 'arm-pci' => 'No ARM data found for this feature.', - 'battery-data' => 'No system Battery data found. Is one present?', + '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 was 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 speed data found for $id cores.", + '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.', - 'disk-data' => 'No Disk data was found.', - 'disk-data-bsd' => 'No Disk data found for this BSD system.', + '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-console' => 'No advanced graphics data found on this system in console.', - 'display-driver-na' => 'n/a (using device driver)', - 'display-null' => 'No advanced graphics data found on this system.', - 'display-root' => 'Advanced graphics data unavailable in console for root.', - 'display-root-x' => 'Advanced graphics data unavailable for root.', + '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?', - 'glxinfo-missing' => 'Unable to show advanced data. Required tool glxinfo missing.', - 'gl-empty' => 'Unset. Missing GL driver?', - 'display-try' => 'Advanced graphics data unavailable in console. Try -G --display', - 'dev' => 'Feature under development', 'dmesg-boot-permissions' => 'dmesg.boot permissions', 'dmesg-boot-missing' => 'dmesg.boot not found', - 'IP' => "No $id found. Connected to web? SSL issues?", '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", - 'lvm-data' => 'No LVM data was found.', - 'lvm-data-bsd' => 'No BSD support for LVM data.', - '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.', - 'mips-pci' => 'No MIPS data found for this feature.', + '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.', - 'optical-data' => 'No Optical or Floppy data was found.', - 'optical-data-bsd' => 'No Optical or Floppy data found for this BSD system.', + '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]", - 'packages' => 'No packages detected. Unsupported package manager?', - 'partition-data' => 'No Partition data was found.', + '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 unavailable', - 'pci-card-data' => 'No Device data found.', - 'pci-card-data-root' => 'Device data requires root.', + '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.', - 'ps-data-null' => 'No Process data available.', - 'raid-data' => 'No RAID data was found.', - 'ram-data' => 'No RAM data was found.', + 'pm-disabled' => "see --$id", + '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' => '<superuser required>', - 'root-suggested' => 'try sudo/root', - 'sensors-data-ipmi' => 'No ipmi sensors data was found.', - 'sensors-data-linux' => 'No sensors data was found. Is sensors configured?', - 'sensors-ipmi-root' => 'Unable to run ipmi sensors. Root privileges required.', - 'smartctl-command-failed' => 'A mandatory SMART command failed. Various possible causes.', + '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?', - 'swap-admin' => 'No admin Swap data available.', - 'swap-data' => 'No Swap data was found.', + 'stopped' => 'stopped', + 'swap-admin' => 'No admin swap data available.', + 'swap-data' => 'No swap data was found.', 'tool-missing-basic' => "<missing: $id>", 'tool-missing-incomplete' => "Missing system tool: $id. Output will be incomplete", 'tool-missing-os' => "No OS support. Is a comparable $id tool available?", @@ -6009,45 +6740,91 @@ sub row_defaults { 'tool-permissions' => "Unable to run $id. Root privileges required.", 'tool-present' => 'Present and working', 'tool-unknown-error' => "Unknown $id error. Unable to generate data.", - 'unmounted-data' => 'No Unmounted partitions found.', - 'unmounted-data-bsd' => 'No Unmounted partition data found for this BSD system.', + 'tools-missing' => "This feature requires one of these tools: $id", + 'tools-missing-bsd' => "This feature requires one of these tools: $id", + 'undefined' => '<undefined>', + 'unmounted-data' => 'No unmounted partitions found.', + 'unmounted-data-bsd' => "Unmounted partition feature unsupported in $id.", 'unmounted-file' => 'No /proc/partitions file found.', - 'usb-data' => 'No USB data was found. Server?', + 'unsupported' => '<unsupported>', + 'usb-data' => 'No USB data found. Server?', + 'usb-mode-mismatch' => '<unknown rev+speed>', + '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 $unfound{$type}; + 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); } -# convert string passed to KB, based on GB/MB/TB id -# NOTE: K 1024 KB 1000 +# 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 = 0; - #print ":$working:\n"; - return if ! defined $working; - my $math = ( $working =~ /B$/) ? 1000: 1024; - if ( $working =~ /^([0-9\.]+)\s*M[B]?$/i){ + 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 ( $working =~ /^([0-9\.]+)\s*G[B]?$/i){ + elsif ($unit eq 'G'){ $size = $1 * $math**2; } - elsif ( $working =~ /^([0-9\.]+)\s*T[B]?$/i){ + elsif ($unit eq 'T'){ $size = $1 * $math**3; } - elsif ( $working =~ /^([0-9\.]+)\s*P[B]?$/i){ + elsif ($unit eq 'P'){ $size = $1 * $math**4; } - elsif ( $working =~ /^([0-9\.]+)\s*E[B]?$/i){ + elsif ($unit eq 'E'){ $size = $1 * $math**5; } - elsif ( $working =~ /^([0-9\.]+)\s*[kK][B]?$/i){ - $size = $1; - } $size = int($size) if $size; return $size; } @@ -6066,7 +6843,8 @@ sub check_output_path { $b_good = 1 if (-d $dir && -w $dir && $dir =~ /^\// && $file); return $b_good; } -# passing along hash ref + +# Passing along hash ref sub output_handler { my ($data) = @_; # print Dumper \%data; @@ -6080,7 +6858,8 @@ sub output_handler { generate_xml($data); } } -# passing along hash ref + +# Passing along hash ref # NOTE: file has already been set and directory verified sub generate_json { eval $start if $b_log; @@ -6090,16 +6869,17 @@ sub generate_json { my ($b_cpanel,$b_valid); error_handler('not-in-irc', 'help') if $b_irc; print Dumper $data if $b_debug; - if (check_perl_module('Cpanel::JSON::XS')){ - Cpanel::JSON::XS->import; - $json = Cpanel::JSON::XS::encode_json($data); - } - elsif (check_perl_module('JSON::XS')){ - JSON::XS->import; - $json = JSON::XS::encode_json($data); + 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', 'Cpanel::JSON::XS OR JSON::XS'); + error_handler('required-module', 'json', 'JSON::PP, Cpanel::JSON::XS or JSON::XS'); } if ($json){ #$json =~ s/"[0-9]+#/"/g; @@ -6127,7 +6907,7 @@ sub generate_xml { my ($xml); my $b_debug = 0; error_handler('not-in-irc', 'help') if $b_irc; - #print Dumper $data if $b_debug; + # print Dumper $data if $b_debug; if (check_perl_module('XML::Dumper')){ XML::Dumper->import; $xml = XML::Dumper::pl2xml($data); @@ -6153,6 +6933,18 @@ sub key { return sprintf("%03d#%s#%s#%s", $_[0],$_[1],$_[2],$_[3]); } +sub output_control { + print message('output-control'); + chomp(my $response = <STDIN>); + if (!$response){ + $size{'lines'} = 1; + } + else { + print message('output-control-exit'), "\n"; + exit 0; + } +} + sub print_basic { my ($data) = @_; my $indent = 18; @@ -6163,29 +6955,29 @@ sub print_basic { my $indent2 = 8; my $length = @$data; my ($start,$i,$j,$line); - - if ( $size{'max'} > 110 ){ + my $width = $size{'max-cols-basic'}; + if ($width > 110){ $indent_static = 22; } - elsif ($size{'max'} < 90 ){ + 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 ){ + # print "0: $data->[$i][0]\n"; + if ($data->[$i][0] == 0){ $indent = 0; $indent1 = 0; $indent2 = 0; } - elsif ($data->[$i][0] == 1 ){ + 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 ); + elsif ($data->[$i][0] == 2){ + $indent = ($indent_static + 7); + $indent1 = ($indent_static + 5); $indent2 = 0; } $data->[$i][3] =~ s/\n/ /g; @@ -6194,17 +6986,17 @@ sub print_basic { $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) ) ){ + if ($indent > 1 && (length($start) > ($indent - 1))){ $line = sprintf("%-${indent}s\n", "$start"); print_line($line); $start = ''; - #print "1-print.\n"; + # print "1-print.\n"; } - if ( ( $indent + length($data->[$i][3]) ) < $size{'max'} ){ + 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"; + # print "2-print.\n"; } else { my $holder = ''; @@ -6212,56 +7004,60 @@ sub print_basic { # 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) ) < $size{'max'} ) { + # print "$word\n"; + if (($indent + length($holder) + length($word)) < $width){ $word =~ s/\^/ /g; $holder .= $word . $sep; - #print "3-hold.\n"; + # print "3-hold.\n"; } - #elsif ( ( $indent + length($holder) + length($word) ) >= $size{'max'}){ + # 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"; + # print "4-print-hold.\n"; } } if ($holder !~ /^[ ]*$/){ $line = sprintf("%-${indent}s%s\n", "$start", $holder); print_line($line); - #print "5-print-last.\n"; + # 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. +# 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 ($array,$counter,$length,$split_count) = (0,0,0,0); - my ($hash_id,$holder,$start,$start2,$start_holder) = ('','','','',''); + my ($counter,$length,$split_count) = (0,0,0); + my ($hash_id,$holder,$holder2,$start,$start2,$start_holder) = ('','','','','',''); my $indent = $size{'indent'}; - my (@temp,@working,@values,%ids,%row); - my ($holder2,$key,$line,$val2,$val3); + my (%ids); + my ($b_container,$b_ni2,$key,$line,$val2,$val3); # these 2 sets are single logic items - my $b_single = ($size{'max'} == 1) ? 1: 0; - my ($b_container,$indent_use,$indentx) = (0,0,0); - # $size{'max'} = 88; + 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'} < $size{'wrap-max'} || $size{'indent'} < 11 ){ - $indent = 2; + if ($size{'max-cols'} < $size{'max-wrap'} || $size{'indent'} < 11){ + $indent = $size{'indents'}; } - #foreach my $key1 (sort { (split('#', $a))[0] <=> (split('#', $b))[0] } keys %$data) { - foreach my $key1 (sort { substr($a,0,3) <=> substr($b,0,3) } keys %$data) { - #foreach my $key1 (sort { $a cmp $b } keys %$data) { + foreach my $key1 (sort { substr($a,0,3) <=> substr($b,0,3) } keys %$data){ $key = (split('#', $key1))[3]; - if ($key ne 'SHORT' ) { + $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); @@ -6273,7 +7069,6 @@ sub print_data { $indent = 0; } next if ref($data->{$key1}) ne 'ARRAY'; - # @working = @{$data->{$key1}}; # Line starters that will be -x incremented always # It's a tiny bit faster manually resetting rather than using for loop %ids = ( @@ -6290,17 +7085,21 @@ sub print_data { 'Monitor' => 1, 'Optical' => 1, 'Screen' => 1, + 'Server' => 1, # was 'Sound Server' 'variant' => 1, # arm > 1 cpu type ); foreach my $val1 (@{$data->{$key1}}){ - $indent_use = $length = $indent; if (ref($val1) eq 'HASH'){ - #%row = %$val1; - ($counter,$split_count) = (0,0); - #foreach my $key2 (sor ({ (split('#', $a))[0] <=> (split('#', $b))[0] } keys %$val1){ - foreach my $key2 (sort { substr($a,0,3) <=> substr($b,0,3) } keys %$val1){ - #foreach my $key2 (sort { $a cmp $b } keys %$val1){ + 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; } @@ -6324,39 +7123,52 @@ sub print_data { 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. - @temp = split(/\s+/, $val2); - $split_count = scalar @temp; - if ( !$b_single && ( length( "$key$sep{'s2'} $val2" ) + $length ) < $size{'max'} ) { - #print "one\n"; + # 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 opening 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 - elsif ( !$b_single && ( length( "$key$sep{'s2'} $val2" ) + $indent ) > $size{'max'} && - !defined $ids{$key} && $split_count > 2 ) { - #print "two\n"; - @values = split(/\s+/, $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; - # $length += length("$key$sep{'s2'} $val3 ") + $indent; $start2 = "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val3 "; - $holder2 = ''; + # 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"; - if ( (length("$_ ") + $length) < $size{'max'} ){ - #print "three.1\n"; - #print "a\n"; + # 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 = ''; - #$length += $length2; - #$length2 = 0; } else { $holder2 .= "$_ "; @@ -6364,81 +7176,101 @@ sub print_data { $length += length("$_ "); } else { - #print "three.2\n"; + # print "p-1b: r1: $b_row1 iu: $indent_use\n"; if ($start2){ $holder2 = "$start2$holder2"; } else { $holder2 = "$colors{'c2'}$holder2"; } - #print "xx:$holder"; - $line = sprintf("%-${indent}s%s$colors{'cn'}\n","$start","$holder$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; + # print "h2: $holder2\n"; + $length = length($holder2) + $indent_use; $start2 = ''; $start = ''; - #$length2 = 0; } } + # We don't want to start a new line, continue until full length. if ($holder2 !~ /^\s*$/){ - #print "four\n"; + # print "p-2: r1: $b_row1 iu: $indent_use\n"; $holder2 = "$colors{'c2'}$holder2"; - $line = sprintf("%-${indent}s%s$colors{'cn'}\n","$start","$holder$holder2"); - print_line($line); - $holder = ''; + $holder = $holder2; + $b_row1 = 0; $holder2 = ''; - $length = $indent; $start2 = ''; $start = ''; - #$length2 = 0; } } # NOTE: only these and the last fallback are used for b_single output else { - #print "H: $counter " . scalar %$val1 . " $indent3 $indent2\n"; if ($holder){ - #print "five\n"; + # 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 "six\n"; + # print "h-3a: r1: $b_row1 iu: $indent_use\n"; $length = $indent_use; - #$holder = ''; + } + 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++; - $indent_use = ($indent * $indentx) if $b_single; } if ($holder !~ /^\s*$/){ - #print "seven\n"; + # 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 + # Only for repos currently elsif (ref($val1) eq 'ARRAY'){ - #print "eight\n"; - $array=0; + # print "p-5: r1: $b_row1 iu: $indent_use\n"; + my $num = 0; + my ($l1,$l2); + $indent_use = $indent_2; foreach my $item (@$val1){ - $array++; - $indent_use = ($b_single) ? $indent + 2: $indent; - $line = "$colors{'c1'}$array$sep{'s2'} $colors{'c2'}$item$colors{'cn'}"; + $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 + # We want a space between data blocks for single print_line("\n") if $b_single; } } @@ -6449,344 +7281,734 @@ sub print_line { $client{'konvi'} = 3; $client{'dobject'} = 'Konversation'; } - if ($client{'konvi'} == 1 && $client{'dcop'} ){ + 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'} ){ + 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'}; } } ######################################################################## -#### DATA PROCESSORS +#### ITEM PROCESSORS ######################################################################## #### ------------------------------------------------------------------- -#### PRIMARY DATA GENERATORS +#### ITEM GENERATORS #### ------------------------------------------------------------------- -## AudioData +## AudioItem { -package AudioData; +package AudioItem; sub get { eval $start if $b_log; - my (@rows); + my $rows = []; my $num = 0; - if (($b_arm || $b_mips) && !$b_soc_audio && !$b_pci_tool){ - my $type = ($b_arm) ? 'arm' : 'mips'; + if (%risc && !$use{'soc-audio'} && !$use{'pci-tool'}){ my $key = 'Message'; - push(@rows,{ - main::key($num++,0,1,$key) => main::row_defaults($type . '-pci',''), - },); + @$rows = ({ + main::key($num++,0,1,$key) => main::message('risc-pci',$risc{'id'}) + }); } else { - push(@rows,device_output()); + device_output($rows); } - if ( ( (($b_arm || $b_mips) && !$b_soc_audio && !$b_pci_tool) || !@rows ) && - (my $file = main::system_files('asound-cards') ) ){ - push(@rows,asound_output($file)); + if (((%risc && !$use{'soc-audio'} && !$use{'pci-tool'}) || !@$rows) && + (my $file = $system_files{'asound-cards'})){ + asound_output($rows,$file); } - push(@rows,usb_output()); - if (!@rows){ + usb_output($rows); + # note: for servers often no audio, so we don't care about pci specific + if (!@$rows){ my $key = 'Message'; - my $type = 'pci-card-data'; + my $type = 'device-data'; if ($pci_tool && $alerts{$pci_tool}->{'action'} eq 'permissions'){ $type = 'pci-card-data-root'; } - push(@rows,{ - main::key($num++,0,1,$key) => main::row_defaults($type,''), - },); + @$rows = ({main::key($num++,0,1,$key) => main::message($type,'')}); } - push(@rows,sound_server_output()); + sound_output($rows); eval $end if $b_log; - return @rows; + return $rows; } sub device_output { eval $start if $b_log; - my (@rows); + return if !$devices{'audio'}; + my $rows = $_[0]; my ($j,$num) = (0,1); - foreach my $row (@devices_audio){ + foreach my $row (@{$devices{'audio'}}){ $num = 1; - $j = scalar @rows; + $j = scalar @$rows; my $driver = $row->[9]; $driver ||= 'N/A'; - my $card = $row->[4]; - $card = ($card) ? main::pci_cleaner($card,'output') : '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($card) > 85 || $size{'max'} < 110){ - $card = main::pci_long_filter($card); + if (length($device) > 85 || $size{'max-cols'} < 110){ + $device = main::filter_pci_long($device); } - push(@rows, { - main::key($num++,1,1,'Device') => $card, - },); - if ($extra > 0 && $b_pci_tool && $row->[12]){ + 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++,0,2,'vendor')} = $item if $item; } - $rows[$j]->{main::key($num++,1,2,'driver')} = $driver; + $rows->[$j]{main::key($num++,1,2,'driver')} = $driver; if ($extra > 0 && !$bsd_type){ - if ($row->[9] ){ + if ($row->[9]){ my $version = main::get_module_version($row->[9]); - $rows[$j]->{main::key($num++,0,3,'v')} = $version if $version; + $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]; + $rows->[$j]{main::key($num++,0,3,'alternate')} = $row->[10] if $row->[10]; } if ($extra > 0){ - $rows[$j]->{main::key($num++,0,2,'bus ID')} = (!$row->[2] && !$row->[3]) ? 'N/A' : "$row->[2].$row->[3]"; + 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 = 'N/A'; - if ($row->[5] && $row->[6]){ - $chip_id = "$row->[5]:$row->[6]"; - } - elsif ($row->[6]){ - $chip_id = $row->[6]; - } - $rows[$j]->{main::key($num++,0,2,'chip ID')} = $chip_id; + 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]; + $rows->[$j]{main::key($num++,0,2,'class-ID')} = $row->[1]; } } - #print "$row->[0]\n"; + # print "$row->[0]\n"; } eval $end if $b_log; - return @rows; } + # 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) = @_; - my (@asound,@rows); - my ($card,$driver,$j,$num) = ('','',0,1); - @asound = main::reader($file); + 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]/ ) { + if (!/modem|usb/i && /^\s*[0-9]/){ $num = 1; my @working = split(/:\s*/, $_); # now let's get 1 2 $working[1] =~ /(.*)\s+-\s+(.*)/; - $card = $2; + $device = $2; $driver = $1; - if ( $card ){ - $j = scalar @rows; + if ($device){ + $j = scalar @$rows; $driver ||= 'N/A'; - push(@rows, { - main::key($num++,1,1,'Device') => $card, + 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::row_defaults('pci-advanced-data',''); + $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 \s@rows; + # print Data::Dumper:Dumper $rows; eval $end if $b_log; - return @rows; } + sub usb_output { eval $start if $b_log; - my (@rows,@ids,$driver,$path_id,$product,@temp2); + my $rows = $_[0]; + my (@ids,$path_id,$product,@temp2); my ($j,$num) = (0,1); - if (-d '/proc/asound') { - # note: this will double the data, but it's easier this way. - # inxi 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(@ids, $id) if ($id && ! grep {/$id/} @ids); - } - # lsusb is a very expensive operation - if (@ids){ - if (!$bsd_type && !$b_usb_check){ - main::USBData::set(); + 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]; + } } - } - main::log_data('dump','@ids',\@ids) if $b_log; - return if !@usb; - foreach my $id (@ids){ - $j = scalar @rows; - foreach my $row (@usb){ - # a device will always be the second or > device on the bus - if ($row->[1] > 1 && $row->[7] eq $id){ - # print Data::Dumper::Dumper $row; - $num = 1; - # makre sure to reset, or second device trips last flag - ($driver,$path_id,$product) = ('','',''); - $product = main::cleaner($row->[13]) if $row->[13]; - $driver = $row->[15] if $row->[15]; - $path_id = $row->[2] if $row->[2]; - $product ||= 'N/A'; - $driver ||= 'snd-usb-audio'; - push(@rows, { - main::key($num++,1,1,'Device') => $product, - main::key($num++,0,2,'type') => 'USB', - main::key($num++,0,2,'driver') => $driver, - },); - if ($extra > 0){ - $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 && defined $row->[5] && $row->[5] ne ''){ - $rows[$j]->{main::key($num++,0,2,'class ID')} = "$row->[4]$row->[5]"; - } - if ($extra > 2 && $row->[16]){ - $rows[$j]->{main::key($num++,0,2,'serial')} = main::apply_filter($row->[16]); - } + $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; - return @rows; } -sub sound_server_output { +sub sound_output { eval $start if $b_log; - my (@data,$server,$version); - my $num = 0; - if (my $file = main::system_files('asound-version') ){ - my $content = main::reader($file,'',0); - # some alsa strings have the build date in (...) - # remove trailing . and remove possible second line if compiled by user -# foreach (@content){ -# if (!/compile/i){ - #$_ =~ s/Advanced Linux Sound Architecture/ALSA/; - $version = (split(/\s+/, $content))[-1]; + 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 - $server = 'ALSA'; -# } -# } - } - elsif (my $program = main::check_program('oss')){ - $server = 'OSS'; - $version = main::program_version('oss','\S',2); - $version ||= 'N/A'; - } - if ($server){ - @data = ({ - main::key($num++,1,1,'Sound Server') => $server, - main::key($num++,0,2,'v') => $version, - },); + } + $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; + 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; } } -## BatteryData +## BatteryItem { -package BatteryData; +package BatteryItem; my (@upower_items,$b_upower,$upower); + sub get { eval $start if $b_log; - my (@rows,%battery,$key1,$val1); + my ($key1,$val1); + my $battery = {}; + my $rows = []; my $num = 0; - if ($bsd_type || $b_dmidecode_force){ + if ($force{'dmidecode'}){ if ($alerts{'dmidecode'}->{'action'} ne 'use'){ $key1 = $alerts{'dmidecode'}->{'action'}; - $val1 = $alerts{'dmidecode'}->{$key1}; + $val1 = $alerts{'dmidecode'}->{'message'}; $key1 = ucfirst($key1); - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); } else { - %battery = battery_data_dmi(); - if (!%battery){ + battery_data_dmi($battery); + if (!%$battery){ if ($show{'battery-forced'}){ $key1 = 'Message'; - $val1 = main::row_defaults('battery-data',''); - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + $val1 = main::message('battery-data',''); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); } } else { - @rows = battery_output(\%battery); + 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 = battery_data_sys(); - if (!%battery){ + battery_data_sys($battery); + if (!%$battery){ if ($show{'battery-forced'}){ $key1 = 'Message'; - $val1 = main::row_defaults('battery-data',''); - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + $val1 = main::message('battery-data',''); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); } } else { - @rows = battery_output(\%battery); + battery_output($rows,$battery); } } else { if ($show{'battery-forced'}){ $key1 = 'Message'; - $val1 = main::row_defaults('battery-data-sys',''); - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + $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) = undef; + (@upower_items,$b_upower,$upower) = (); eval $end if $b_log; - return @rows; + 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 +# 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 ($battery) = @_; - my ($key,@rows); + 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,$volts) = ('','','','','',''); + 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 ''){ @@ -6797,30 +8019,37 @@ sub battery_output { } 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'; + $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, { + $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 > 0){ - if ($extra > 1){ - if ($battery->{$key}{'voltage_min_design'} || $battery->{$key}{'voltage_now'}){ - $battery->{$key}{'voltage_min_design'} ||= 'N/A'; - $battery->{$key}{'voltage_now'} ||= 'N/A'; - $volts = "$battery->{$key}{'voltage_now'}/$battery->{$key}{'voltage_min_design'}"; - } - $volts ||= 'N/A'; - $rows[$j]->{main::key($num++,0,2,'volts')} = $volts; + }); + 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 ($battery->{$key}{'manufacturer'} || $battery->{$key}{'model_name'}) { + } + 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'}"; } @@ -6834,23 +8063,23 @@ sub battery_output { else { $model = 'N/A'; } - $rows[$j]->{main::key($num++,0,2,'model')} = $model; + $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; + $chemistry = ($battery->{$key}{'technology'}) ? $battery->{$key}{'technology'}: 'N/A'; + $rows->[$j]{main::key($num++,0,2,'type')} = $chemistry; } if ($extra > 1){ - $serial = main::apply_filter($battery->{$key}{'serial_number'}); - $rows[$j]->{main::key($num++,0,2,'serial')} = $serial; + $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; + $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'}; + $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'}; + $rows->[$j]{main::key($num++,0,2,'location')} = $battery->{$key}{'location'}; } } } @@ -6864,20 +8093,19 @@ sub battery_output { $num = 0; next if !defined $battery->{$key} || $battery->{$key}{'purpose'} eq 'mains'; my ($charge,$model,$serial,$percent,$status,$vendor) = ('','','','','',''); - my (%upower_data); - $j = scalar @rows; - %upower_data = upower_data($key) if $upower; - if ($upower_data{'percent'}){ - $charge = $upower_data{'percent'}; + $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'){ + 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'}; - $status = ($battery->{$key}{'status'} && lc($battery->{$key}{'status'}) ne 'unknown') ? $battery->{$key}{'status'}: 'N/A' ; $vendor = $battery->{$key}{'manufacturer'} if $battery->{$key}{'manufacturer'}; if ($vendor || $model){ if ($vendor && $model){ @@ -6890,38 +8118,40 @@ sub battery_output { else { $model = 'N/A'; } - push(@rows, { + push(@$rows, { main::key($num++,1,1,'Device') => $key, main::key($num++,0,2,'model') => $model, },); if ($extra > 1){ - $serial = main::apply_filter($battery->{$key}{'serial_number'}); - $rows[$j]->{main::key($num++,0,2,'serial')} = $serial; + $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'}; + $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'}; } - $rows[$j]->{main::key($num++,0,2,'status')} = $status; + $status = ($battery->{$key}{'status'}) ? $battery->{$key}{'status'}: 'N/A' ; + $rows->[$j]{main::key($num++,0,2,'status')} = $status; } } eval $end if $b_log; - return @rows; } # charge: mAh energy: Wh sub battery_data_sys { eval $start if $b_log; - my ($b_ma,%battery,$file,$id,$item,$path,$value); + 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 + 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); + power_now present scope serial_number status technology type voltage_min_design + voltage_now); foreach $item (@batteries){ $b_ma = 0; $id = $item; @@ -6931,8 +8161,8 @@ sub battery_data_sys { # 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 ($file eq 'type' && $value && lc($value) ne 'battery'){ + $battery->{$id}{'purpose'} = 'mains'; } if ($value){ $value = main::trimmer($value); @@ -6969,378 +8199,699 @@ sub battery_data_sys { $b_ma = 1; } elsif ($file eq 'manufacturer'){ - $value = main::dmi_cleaner($value); + $value = main::clean_dmi($value); } elsif ($file eq 'model_name'){ - $value = main::dmi_cleaner($value); + $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::row_defaults('root-required'); + elsif ($b_root && -e $path && ! -r $path){ + $value = main::message('root-required'); } - $battery{$id}->{$file} = $value; - # print "$battery{$id}->{$file}\n"; + $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'}){ + 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'; + ($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'; + $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 ($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 ($battery{$id}->{'charge_full'}){ - $battery{$id}->{'energy_full'} = $battery{$id}->{'charge_full'}*$battery{$id}->{'voltage_min_design'}; + if (/\s*serial\s+([\S]*?)\s*/){ + $battery->{$id}{'serial_number'} = main::clean_unset($1,'^(0x)0+$'); } - if ($battery{$id}->{'charge_full_design'}){ - $battery{$id}->{'energy_full_design'} = $battery{$id}->{'charge_full_design'} * $battery{$id}->{'voltage_min_design'}; + if (/\s*type\s+(.*?)\s*/){ + $battery->{$id}{'technology'} = $1; + } + if (/\s*oem\s+(.*)/){ + $battery->{$id}{'manufacturer'} = main::clean_dmi($1); } } - 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'}); + } + # 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_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'}); + 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_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'}); } - 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'}); } } - main::log_data('dump','sys: %battery',\%battery) if $b_log; + print Data::Dumper::Dumper $battery if $dbg[33]; + main::log_data('dump','dmi: %$battery',$battery) if $b_log; eval $end if $b_log; - return %battery; } + # note, dmidecode does not have charge_now or charge_full sub battery_data_dmi { eval $start if $b_log; - my (%battery,$id); + 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'; + $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::dmi_cleaner($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::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'Design Capacity') { + 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); + $battery->{$id}{'energy_full_design'} = sprintf("%.1f", $value[1]/1000); } - elsif ($value[0] eq 'Design Voltage') { + elsif ($value[0] eq 'Design Voltage'){ $value[1] =~ s/\s*mv$//i; - $battery{$id}->{'voltage_min_design'} = sprintf("%.1f", $value[1]/1000); + $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_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'}); + 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; - main::log_data('dump','dmi: %battery',\%battery) if $b_log; + print Data::Dumper::Dumper $battery if $dbg[33]; + main::log_data('dump','dmi: %$battery',$battery) if $b_log; eval $end if $b_log; - return %battery; } + sub upower_data { my ($id) = @_; eval $start if $b_log; - my (%data); + my $data = {}; if (!$b_upower && $upower){ - @upower_items = main::grabber("$upower -e",'','strip'); + @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 $_",'','strip'); + 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]; + $data->{'percent'} = $temp[1]; } elsif ($temp[0] eq 'rechargeable'){ - $data{'rechargeable'} = $temp[1]; + $data->{'rechargeable'} = $temp[1]; } } last; } } } - main::log_data('dump','upower: %data',\%data) if $b_log; + main::log_data('dump','upower: %$data',$data) if $b_log; eval $end if $b_log; - return %data; + return $data; } - } -## BluetoothData +## BluetoothItem { -package BluetoothData; -my ($b_hci_error,$b_hci,%hci); +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 $rows = []; my $num = 0; - if (($b_arm || $b_mips) && !$b_soc_bluetooth && !$b_pci_tool){ + 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 arm case to always run - #my $type = ($b_arm) ? 'arm' : 'mips'; - #my $key = 'Message'; - #push(@rows,{ - #main::key($num++,0,1,$key) => main::row_defaults($type . '-pci',''), - #},); + # the non risc case to always run + # my $key = 'Message'; + # @$rows = ({ + # main::key($num++,0,1,$key) => main::message('risc-pci',$risc{'id'}) + # }); } else { - push(@rows,device_output()); + device_output($rows); } - push(@rows,usb_output()); - if (!@rows){ + usb_output($rows); + if (!@$rows){ if ($show{'bluetooth-forced'}){ my $key = 'Message'; - push(@rows,{ - main::key($num++,0,1,$key) => main::row_defaults('bluetooth-data'), - },); + @$rows = ({main::key($num++,0,1,$key) => main::message('bluetooth-data')}); } } # if there are any unhandled hci items print them out if (%hci){ - push(@rows,advanced_output('check','')); + advanced_output($rows,'check',''); } eval $end if $b_log; - return @rows; + return $rows; } sub device_output { eval $start if $b_log; - my (@rows); + return if !$devices{'bluetooth'}; + my $rows = $_[0]; + my ($bus_id); my ($j,$num) = (0,1); - foreach my $row (@devices_bluetooth){ + foreach my $row (@{$devices{'bluetooth'}}){ $num = 1; - $j = scalar @rows; + $bus_id = ''; + $j = scalar @$rows; my $driver = ($row->[9]) ? $row->[9] : 'N/A'; - my $card = $row->[4]; - $card = ($card) ? main::pci_cleaner($card,'output') : '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($card) > 85 || $size{'max'} < 110){ - $card = main::pci_long_filter($card); + if (length($device) > 85 || $size{'max-cols'} < 110){ + $device = main::filter_pci_long($device); } - push(@rows, { - main::key($num++,1,1,'Device') => $card, + push(@$rows, { + main::key($num++,1,1,'Device') => $device, },); - if ($extra > 0 && $b_pci_tool && $row->[12]){ + 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++,0,2,'vendor')} = $item if $item; } - $rows[$j]->{main::key($num++,1,2,'driver')} = $driver; + $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; + $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]; + $rows->[$j]{main::key($num++,0,3,'alternate')} = $row->[10] if $row->[10]; } if ($extra > 0){ - $rows[$j]->{main::key($num++,0,2,'bus ID')} = (!$row->[2] && !$row->[3]) ? 'N/A' : "$row->[2].$row->[3]"; + $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 = 'N/A'; - if ($row->[5] && $row->[6]){ - $chip_id = "$row->[5]:$row->[6]"; - } - elsif ($row->[6]){ - $chip_id = $row->[6]; - } - $rows[$j]->{main::key($num++,0,2,'chip ID')} = $chip_id; + 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]; + $rows->[$j]{main::key($num++,0,2,'class-ID')} = $row->[1]; } } - push(@rows,advanced_output('pci',"$row->[2].$row->[3]")) if defined $row->[2] && defined $row->[3]; - #print "$row->[0]\n"; + # 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; - return @rows; } + sub usb_output { eval $start if $b_log; - return if !@usb; - my (@rows,$driver,$path_id,$product); + return if !$usb{'bluetooth'}; + my $rows = $_[0]; + my ($path_id,$product); my ($j,$num) = (0,1); - foreach my $row (@usb){ - #print Data::Dumper::Dumper $row; - if ($row->[14] && $row->[14] eq 'Bluetooth'){ - #print Data::Dumper::Dumper $row; - $num = 1; - $j = scalar @rows; - # makre sure to reset, or second device trips last flag - ($driver,$path_id,$product) = ('','',''); - $product = main::cleaner($row->[13]) if $row->[13]; - $driver = ($row->[15]) ? $row->[15] : 'N/A'; - $path_id = $row->[2] if $row->[2]; -# $product ||= 'N/A'; - push(@rows, { - main::key($num++,1,1,'Device') => $product, - main::key($num++,0,2,'type') => 'USB', - main::key($num++,1,2,'driver') => $driver, - },); - 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; - } - if ($extra > 0){ - $rows[$j]->{main::key($num++,0,2,'bus ID')} = "$path_id:$row->[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]; + $rows->[$j]{main::key($num++,0,2,'chip-ID')} = $row->[7]; } - if ($extra > 2 && defined $row->[5] && $row->[5] ne ''){ - $rows[$j]->{main::key($num++,0,2,'class ID')} = "$row->[4]$row->[5]"; - } - if ($extra > 2 && $row->[16]){ - $rows[$j]->{main::key($num++,0,2,'serial')} = main::apply_filter($row->[16]); + 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]); + } } - push(@rows,advanced_output('usb',$path_id)) if $path_id; } + advanced_output($rows,'usb',$path_id) if $path_id; } eval $end if $b_log; - return @rows; } + sub advanced_output { - my ($type,$bus_id) = @_; eval $start if $b_log; - my ($path,@rows,@temp); - my ($j,$num,$k,$l,$m,$id,$id2) = (0,1,2,3,4,'',''); - hci_data() if !$b_hci && $alerts{'hciconfig'}->{'action'} eq 'use'; - if ($type eq 'usb'){ - $path = "/sys/bus/usb/devices/$bus_id:*/bluetooth"; - } - elsif ($type eq 'pci') { - $path = "/sys/bus/pci/devices/0000:$bus_id/bluetooth"; - } + 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("$path/*") if $path; + @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) = (1,2,3); + ($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}){ - $id2 = $item if $id; - $j = scalar @rows; - push(@rows,{ - main::key($num++,1,$k,'Report' . $id) => $id2, + $j = scalar @$rows; + push(@$rows,{ + main::key($num++,1,$k,'Report' . $id) => $tool, },); - $rows[$j]->{main::key($num++,0,$l,'ID')} = $item if !$id; - $rows[$j]->{main::key($num++,0,$l,'state')} = $hci{$item}->{'state'}; - if (my $btv = bluetooth_version($hci{$item}->{'lmp-version'})){ - $rows[$j]->{main::key($num++,0,$l,'bt-v')} = $btv; + 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 ($extra > 0 && $hci{$item}->{'lmp-version'}){ - $rows[$j]->{main::key($num++,0,$l,'lmp-v')} = $hci{$item}->{'lmp-version'}; + 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'}; + $rows->[$j]{main::key($num++,0,$m,'sub-v')} = $hci{$item}->{'lmp-subversion'}; } } - if ($extra > 0 && $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 > 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'}; + $rows->[$j]{main::key($num++,0,$m,'rev')} = $hci{$item}->{'hci-revision'}; } } - $rows[$j]->{main::key($num++,0,$l,'address')} = main::apply_filter($hci{$item}->{'address'}); if ($b_admin && - ($hci{$item}->{'acl-mtu'} || $hci{$item}->{'sco-mtu'} || $hci{$item}->{'link-policy'})){ - $j = scalar @rows; - push(@rows,{ + ($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'}; + $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'}; + $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'}; + $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'}; + $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'}; + $rows->[$j]{main::key($num++,0,$m,'service-classes')} = $hci{$item}->{'service-classes'}; } } delete $hci{$item}; } } } - if ($alerts{'hciconfig'}->{'action'} ne 'use' && !$b_hci_error){ - my $key = 'Message'; - push(@rows,{ - main::key($num++,0,1,$key) => $alerts{'hciconfig'}->{$alerts{'hciconfig'}->{'action'}}, + # 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; - return @rows; } -sub hci_data { + +# 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 ($b_fake_bluetooth){ + 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'); } @@ -7359,16 +8910,31 @@ sub hci_data { $hci{$id}->{'acl-mtu'} = $2; $hci{$id}->{'sco-mtu'} = $3; } - elsif (/^(UP.*|DOWN.*)/){ + elsif (/^(UP|DOWN).*/){ $hci{$id}->{'state'} = lc($1); } - elsif (/^HCI Version:\s+([0-9\.]+)\s+.*Revision:\s+0x([0-9a-f]+)/){ - $hci{$id}->{'hci-version'} = $1; - $hci{$id}->{'hci-revision'} = $2; - } - elsif (/^LMP Version:\s+([0-9\.]+)\s+.*Subversion:\s+0x([0-9a-f]+)/){ - $hci{$id}->{'lmp-version'} = $1; - $hci{$id}->{'lmp-subversion'} = $2; + 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); @@ -7377,1138 +8943,1635 @@ sub hci_data { $hci{$id}->{'link-mode'} = lc($1); } elsif (/^Service Classes?:\s+(.+)/){ - $hci{$id}->{'service-classes'} = main::general_cleaner(lc($1)); + $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 Data::Dumper::Dumper \%hci; + 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 - 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); + # 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; } } -## CpuData +## CpuItem { -package CpuData; +package CpuItem; +my (%fake_data,$type); sub get { eval $start if $b_log; - my ($type) = @_; - my (@rows); + ($type) = @_; + my $rows = []; if ($type eq 'short' || $type eq 'basic'){ # note, for short form, just return the raw data, not the processed output - @rows = short_data($type); + my $cpu = short_data(); if ($type eq 'basic'){ - @rows = short_output(\@rows); + short_output($rows,$cpu); + } + else { + $rows = $cpu; } } else { - @rows = full_output(); + full_output($rows); } eval $end if $b_log; - return @rows; + return $rows; } + +## OUTPUT HANDLERS ## sub full_output { eval $start if $b_log; + my $rows = $_[0]; my $num = 0; - my ($b_flags,$b_speeds,$core_speeds_value,$flag_key,@flags,%cpu,@rows); + my ($b_speeds,$core_speeds_value,$cpu); my $sleep = $cpu_sleep * 1000000; - if ($b_hires){ - eval 'Time::HiRes::usleep( $sleep )'; + if (my $file = $system_files{'proc-cpuinfo'}){ + $cpu = cpuinfo_data($file); } - else { - select(undef, undef, undef, $cpu_sleep); - } - if (my $file = main::system_files('cpuinfo')){ - %cpu = cpuinfo_data($file,'full'); - } - elsif ($bsd_type ){ + elsif ($bsd_type){ my ($key1,$val1) = ('',''); - if ( $alerts{'sysctl'} ){ - if ( $alerts{'sysctl'}->{'action'} eq 'use' ){ + if ($alerts{'sysctl'}){ + if ($alerts{'sysctl'}->{'action'} eq 'use'){ # $key1 = 'Status'; -# $val1 = main::row_defaults('dev'); - %cpu = sysctl_data('full'); +# $val1 = main::message('dev'); + $cpu = sysctl_data(); } else { $key1 = ucfirst($alerts{'sysctl'}->{'action'}); - $val1 = $alerts{'sysctl'}->{$alerts{'sysctl'}->{'action'}}; - @rows = ({main::key($num++,0,1,$key1) => $val1,}); - return @rows; + $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 @processors = @{$cpu{'processors'}}; - my @speeds = cpu_speeds(\@processors); - my $j = scalar @rows; - $cpu{'model_name'} ||= 'N/A'; - push(@rows, { - main::key($num++,1,1,'Info') => $properties{'cpu-layout'}, - main::key($num++,0,2,'model') => $cpu{'model_name'}, + 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'}}; + if ($cpu->{'system-cpus'}){ + my %system_cpus = %{$cpu->{'system-cpus'}}; my $i = 1; - my $counter = ( %system_cpus && scalar keys %system_cpus > 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; + $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::row_defaults('note-check'); + 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'}; + $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'}; + $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; + $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'}; + $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'}; + } } - # ntoe: had if arch, but stepping can be defined where arch failed, stepping can be 0 - if ( !$b_admin && defined $cpu{'stepping'} ){ - $rows[$j]->{main::key($num++,0,2,'rev')} = $cpu{'stepping'}; + # 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'}); - $rows[$j]->{main::key($num++,0,2,'stepping')} = hex_and_decimal($cpu{'stepping'}); - if (!$b_arm && !$b_mips && !$b_ppc && $cpu{'type'} ne 'elbrus'){ - $cpu{'microcode'} ||= 'N/A'; - $rows[$j]->{main::key($num++,0,2,'microcode')} = $cpu{'microcode'}; + $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; + $rows->[$j]{main::key($num++,1,$id+1,'cores')} = $topo->{'cores'}; + 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; + } + if ($topo->{'threads'}){ + $rows->[$j]{main::key($num++,0,$id+1,'threads')} = $topo->{'threads'}; + } + if ($topo->{'dies'}){ + $rows->[$j]{main::key($num++,0,$id+1,'dies')} = $topo->{'dies'}; + } } + $cpu->{'smt'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'smt')} = $cpu->{'smt'}; + full_output_caches($j,$properties,\$num,$rows); } - if ($extra > 1 && $properties{'l1-cache'}){ - $rows[$j]->{main::key($num++,0,2,'L1 cache')} = main::get_size($properties{'l1-cache'},'string'); - } - if (!$b_arm || ($b_arm && $properties{'l2-cache'})){ - $properties{'l2-cache'} = ($properties{'l2-cache'}) ? main::get_size($properties{'l2-cache'},'string') : 'N/A'; - $rows[$j]->{main::key($num++,0,2,'L2 cache')} = $properties{'l2-cache'}; - } - if ($extra > 1 && $properties{'l3-cache'}){ - $rows[$j]->{main::key($num++,0,2,'L3 cache')} = main::get_size($properties{'l3-cache'},'string'); - } - if ($extra > 0 && !$show{'cpu-flag'}){ - $j = scalar @rows; - @flags = split(/\s+/, $cpu{'flags'}) if $cpu{'flags'}; - $flag_key = ($b_arm || $bsd_type) ? 'features': 'flags'; - my $flag = 'N/A'; - if (@flags){ - # failure to read dmesg.boot: dmesg.boot permissions; then short -Cx list flags - @flags = grep {/^(dmesg.boot|permissions|avx[2-9]?|lm|nx|pae|pni|(sss|ss)e([2-9])?([a-z])?(_[0-9])?|svm|vmx)$/} @flags; - @flags = map {s/pni/sse3/; $_} @flags; - @flags = sort @flags; - $flag = join(' ', @flags) if @flags; - } - if ($b_arm && $flag eq 'N/A'){ - $flag = main::row_defaults('arm-cpu-f'); - } - push(@rows, { - main::key($num++,0,2,$flag_key) => $flag, - }); - $b_flags = 1; + 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'; } - if ($extra > 0 && !$bsd_type){ - my $bogomips = (main::is_numeric($cpu{'bogomips'})) ? int($cpu{'bogomips'}) : 'N/A'; - $rows[$j]->{main::key($num++,0,2,'bogomips')} = $bogomips; - } - $j = scalar @rows; - my $core_key = (scalar @speeds > 1) ? 'Core speeds (MHz)' : 'Core speed (MHz)'; - 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 = (defined $properties{'speed'}) ? $properties{'speed'}: 'N/A'; - # aren't able to get per core speeds in bsds yet - if (@speeds){ - if (grep {$_ ne '0'} @speeds){ + # 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 { - $core_speeds_value = main::row_defaults('cpu-speeds',scalar @speeds); + my $id = ($bsd_type) ? 'cpu-speeds-bsd' : 'cpu-speeds'; + $core_speeds_value = main::message($id); } } else { - $core_speeds_value = 'N/A'; + $core_speeds_value = main::message('cpu-speeds'); } - $j = scalar @rows; - push(@rows, { + $j = scalar @$rows; + push(@$rows, { main::key($num++,1,1,$speed_key) => $speed, - main::key($num++,0,2,$min_max_key) => $min_max, }); - 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 ($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'}; + } } - if ($extra > 0){ - my $boost = get_boost_status(); - $rows[$j]->{main::key($num++,0,2,'boost')} = $boost if $boost; + $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->{'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'}; + 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; + $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++)} = $_; + foreach (@{$speeds}){ + $rows->[$j]{main::key($num++,0,3,$i++)} = $_; } } - if ($show{'cpu-flag'} && !$b_flags){ - $flag_key = ($b_arm || $bsd_type) ? 'Features': 'Flags'; - @flags = split(/\s+/, $cpu{'flags'}) if $cpu{'flags'}; + 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) if @flags; + $flag = join(' ', @flags); } - push(@rows, { + push(@$rows, { main::key($num++,0,1,$flag_key) => $flag, },); } if ($b_admin){ - my @bugs = cpu_bugs_sys(); my $value = ''; - if (!@bugs){ - if ( $cpu{'bugs'}){ - my @proc_bugs = split(/\s+/, $cpu{'bugs'}); + 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::row_defaults('cpu-bugs-null'); + $value = main::message('cpu-bugs-null'); } } - push(@rows, { + 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 (@bugs){ - $j = $#rows; - foreach my $bug (@bugs){ - $rows[$j]->{main::key($num++,1,2,'Type')} = $bug->[0]; - $rows[$j]->{main::key($num++,0,3,$bug->[1])} = $bug->[2]; + 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; - return @rows; } + +# $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 ($cpu) = @_; - my @data; + my ($rows,$cpu) = @_; my $num = 0; - $cpu->[1] ||= main::row_defaults('cpu-model-null'); + $cpu->[1] ||= main::message('cpu-model-null'); $cpu->[2] ||= 'N/A'; - @data = ({ - main::key($num++,1,1,'Info') => $cpu->[0] . ' ' . $cpu->[1] . ' [' . $cpu->[2] . ']', + 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){ - $data[0]->{main::key($num++,1,2,'arch')} = $cpu->[7]; - if ($cpu->[8]){ - $data[0]->{main::key($num++,0,3,'note')} = $cpu->[8]; + $rows->[0]{main::key($num++,1,2,'arch')} = $cpu->[8]; + if ($cpu->[9]){ + $rows->[0]{main::key($num++,0,3,'note')} = $cpu->[9]; } } - $data[0]->{main::key($num++,0,2,$cpu->[3])} = $cpu->[4]; + 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]){ - $data[0]->{main::key($num++,0,2,$cpu->[5])} = $cpu->[6]; + $rows->[0]{main::key($num++,0,3,$cpu->[5])} = $cpu->[6]; } eval $end if $b_log; - return @data; } + +## SHORT OUTPUT DATA ## sub short_data { eval $start if $b_log; - my ($type) = @_; my $num = 0; - my (%cpu,@data,%speeds); + my ($cpu,$data,%speeds); my $sys = '/sys/devices/system/cpu/cpufreq/policy0'; - my $sleep = $cpu_sleep * 1000000; - if ($b_hires){ - eval 'Time::HiRes::usleep( $sleep )'; - } - else { - select(undef, undef, undef, $cpu_sleep); - } # NOTE: : Permission denied, ie, this is not always readable # /sys/devices/system/cpu/cpu0/cpufreq/cpuinfo_cur_freq - if (my $file = main::system_files('cpuinfo')){ - %cpu = cpuinfo_data($file,$type); + if (my $file = $system_files{'proc-cpuinfo'}){ + $cpu = cpuinfo_data($file); } - elsif ($bsd_type ){ + elsif ($bsd_type){ my ($key1,$val1) = ('',''); - if ( $alerts{'sysctl'} ){ - if ( $alerts{'sysctl'}->{'action'} eq 'use' ){ + if ($alerts{'sysctl'}){ + if ($alerts{'sysctl'}->{'action'} eq 'use'){ # $key1 = 'Status'; -# $val1 = main::row_defaults('dev'); - %cpu = sysctl_data($type); +# $val1 = main::message('dev'); + $cpu = sysctl_data($type); } else { $key1 = ucfirst($alerts{'sysctl'}->{'action'}); - $val1 = $alerts{'sysctl'}->{$alerts{'sysctl'}->{'action'}}; - @data = ({main::key($num++,0,1,$key1) => $val1,}); - return @data; + $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); + $data = prep_short_data($cpu); eval $end if $b_log; - return @data; + return $data; } sub prep_short_data { eval $start if $b_log; my ($cpu_data) = @_; - my %properties = cpu_properties($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{'cpu-layout'}, + $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->{'min-max-key'}, + $properties->{'min-max'}, + $properties->{'avg-speed-key'}, + ]; if ($extra > 0){ $cpu_data->{'arch'} ||= 'N/A'; - $result[7] = $cpu_data->{'arch'}; - $result[8] = $cpu_data->{'arch-note'}; + $result->[8] = $cpu_data->{'arch'}; + $result->[9] = $cpu_data->{'arch-note'}; } eval $end if $b_log; - return @result; + return $result; } +## PRIMARY DATA GENERATORS ## sub cpuinfo_data { eval $start if $b_log; - my ($file,$type)= @_; - my ($arch,@ids,@line,$b_first,$b_proc_int,$note,$starter); + my ($file)= @_; + my ($cpu,$arch,$note,$temp); # has to be set above fake cpu section - my %cpu = set_cpu_data(); - $cpu{'type'} = cpu_vendor($cpu_arch) if $cpu_arch =~ /e2k/; # already set to lower - # use --arm flag when testing arm cpus, and --fake-cpu to trigger fake data - if ($b_fake_cpu){ - # $cpu{'type'} = 'elbrus'; # uncomment to test elbrus - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/arm-4-core-pinebook-1.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/armv6-single-core-1.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/armv7-dual-core-1.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/armv7-new-format-model-name-single-core.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/arm-2-die-96-core-rk01.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/16-core-32-mt-ryzen.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/2-16-core-epyc-abucodonosor.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/2-core-probook-antix.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-jean-antix.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-althlon-mjro.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-apu-vc-box.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-a10-5800k-1.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-core-ht-atom-bruh.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/core-2-i3.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/8-core-i7-damentz64.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-10-core-xeon-ht.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/4-core-xeon-fake-dual-die-zyanya.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-core-i5-fake-dual-die-hek.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-1-core-xeon-vm-vs2017.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/4-1-core-xeon-vps-frodo1.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/4-6-core-xeon-no-mt-lathander.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/mips/mips-mainusg-cpuinfo.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/ppc/ppc-debian-ppc64-cpuinfo.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/elbrus/1xE1C-8.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/elbrus/1xE2CDSP-4.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/elbrus/1xE2S4-3-monocub.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/elbrus/1xMBE8C-7.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/elbrus/4xEL2S4-3.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/elbrus/4xE8C-7.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/elbrus/4xE2CDSP-4.txt"; - # $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/elbrus/cpuinfo.e8c2.txt"; - } - my @cpuinfo = main::reader($file); - my %speeds = set_cpu_speeds_sys(); - my @phys_cpus = (0);# start with 1 always - my ($core_count,$die_holder,$die_id,$phys_id,$proc_count,$speed) = (0,0,0,0,0,0,0); - my ($phys_holder) = (undef); + set_cpu_data(\$cpu); + set_fake_data() if $fake{'cpu'} && !$loaded{'cpu-fake-data'}; + # sleep is also set in front of 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 (@cpuinfo){ - next if /^\s*$/; - @line = split(/\s*:\s*/, $_, 2); - next if !$line[0]; - $starter = $line[0]; # preserve case for one specific ARM issue - $line[0] = lc($line[0]); - if ($b_arm && !$b_first && $starter eq 'Processor' && $line[1] !~ /^\d+$/){ - #print "l1:$line[1]\n"; - $cpu{'model_name'} = main::cleaner($line[1]); - $cpu{'model_name'} = cpu_cleaner($cpu{'model_name'}); - $cpu{'type'} = 'arm'; - # Processor : AArch64 Processor rev 4 (aarch64) - # Processor : Feroceon 88FR131 rev 1 (v5l) - if ($cpu{'model_name'} && $cpu{'model_name'} =~ /(.*)\srev\s([\S]+)\s(\(([\S]+)\))?/){ - $cpu{'model_name'} = $1; - $cpu{'stepping'} = $2; - if ($4){ - $cpu{'arch'} = $4; - $cpu{'model_name'} .= ' ' . $cpu{'arch'} if $cpu{'model_name'} !~ /$cpu{'arch'}/i; - } - $cpu{'processors'}->[$proc_count] = 0; - $b_proc_int = 0; - $b_first = 1; - #print "p0:\n"; - } - } - elsif ($line[0] eq 'processor'){ - # this protects against double processor lines, one int, one string - if ($line[1] =~ /^\d+$/){ - $b_proc_int = 1; - $b_first = 1; - $cpu{'processors'}->[$proc_count] = 0; - $proc_count++; - #print "p1: $proc_count\n"; + 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 ($risc{'mips'} || $cpu->{'model_name'} =~ /mips/i){ + $cpu->{'type'} = 'mips'; + } } - else { - if (!$b_proc_int){ - $cpu{'processors'}->[$proc_count] = 0; - $proc_count++; - #print "p2a: $proc_count\n"; - } - if (!$b_first ){ - # note: alternate: - # Processor : AArch64 Processor rev 4 (aarch64) - # but no model name type - if ( $b_arm || $line[1] =~ /ARM|AArch/i){ - $b_arm = 1; - $cpu{'type'} = 'arm'; + $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)); + } + } + # 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'}; } - $cpu{'model_name'} = main::cleaner($line[1]); - $cpu{'model_name'} = cpu_cleaner($cpu{'model'}); - #print "p2b:\n"; - } - $b_first = 1; - } - } - elsif (!$cpu{'family'} && - ($line[0] eq 'architecture' || $line[0] eq 'cpu family' || $line[0] eq 'cpu architecture' )){ - if ($line[1] =~ /^\d+$/){ - # translate integers to hex - $cpu{'family'} = uc(sprintf("%x", $line[1])); - } - elsif ($b_arm) { - $cpu{'arch'} = $line[1]; - } - } - elsif (!defined $cpu{'stepping'} && ($line[0] eq 'stepping' || $line[0] eq 'cpu revision')){ - $cpu{'stepping'} = uc(sprintf("%x", $line[1])); - } - # ppc - elsif (!defined $cpu{'stepping'} && $line[0] eq 'revision'){ - $cpu{'stepping'} = $line[1]; - } - # this is hex so uc for cpu arch id. raspi 4 has Model rather than Hard - elsif (!$cpu{'model_id'} && (!$b_ppc && !$b_arm && $line[0] eq 'model') ){ - $cpu{'model_id'} = uc(sprintf("%x", $line[1])); - } - elsif (!$cpu{'model_id'} && $line[0] eq 'cpu variant' ){ - $cpu{'model_id'} = uc($line[1]); - $cpu{'model_id'} =~ s/^0X//; - } - # cpu can show in arm - elsif (!$cpu{'model_name'} && ( $line[0] eq 'model name' || $line[0] eq 'cpu' || $line[0] eq 'cpu model' )){ - $cpu{'model_name'} = main::cleaner($line[1]); - $cpu{'model_name'} = cpu_cleaner($cpu{'model_name'}); - if ( $b_arm || $line[1] =~ /ARM|AArch/i){ - $b_arm = 1; - $cpu{'type'} = 'arm'; - if ($cpu{'model_name'} && $cpu{'model_name'} =~ /(.*)\srev\s([\S]+)\s(\(([\S]+)\))?/){ - $cpu{'model_name'} = $1; - $cpu{'stepping'} = $2; - if ($4){ - $cpu{'arch'} = $4; - $cpu{'model_name'} .= ' ' . $cpu{'arch'} if $cpu{'model_name'} !~ /$cpu{'arch'}/i; + # 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'})); + } } - #$cpu{'processors'}->[$proc_count] = 0; } } - elsif ($b_mips || $line[1] =~ /mips/i){ - $b_mips = 1; - $cpu{'type'} = 'mips'; - } } - elsif ( $line[0] eq 'cpu mhz' || $line[0] eq 'clock' ){ - $speed = speed_cleaner($line[1]); - $cpu{'processors'}->[$proc_count-1] = $speed; - #$ids[$phys_id]->[$die_id] = ([($speed)]); + # 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; + } } - elsif (!$cpu{'siblings'} && $line[0] eq 'siblings' ){ - $cpu{'siblings'} = $line[1]; + ## Start incrementers + $temp = main::get_defined($block->{'cpu mhz'},$block->{'clock'}); + if ($temp){ + $speed = clean_speed($temp); + push(@{$cpu->{'processors'}},$speed); } - elsif (!$cpu{'cores'} && $line[0] eq 'cpu cores' ){ - $cpu{'cores'} = $line[1]; + # 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'}; } - # 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. - elsif ( $line[0] eq 'physical id' ){ - if ( !defined $phys_holder || $phys_holder != $line[1] ){ - # only increment if not in array counter - push(@phys_cpus, $line[1]) if ! grep {/$line[1]/} @phys_cpus; - $phys_holder = $line[1]; - #print "pid: $line[1] ph: $phys_holder did: $die_id\n"; - $die_id = 0; - #$die_holder = 0; + # just to get core counts for ARM/MIPS/PPC systems + if (defined $block->{'processor'} && !$temp){ + if ($block->{'processor'} =~ /^\d+$/){ + push(@{$cpu->{'processors'}},0); } } - elsif ( $line[0] eq 'core id' ){ - #print "ph: $phys_holder did: $die_id l1: $line[1] s: $speed\n"; + # 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 - if ($line[1] > 0 ){ - $die_holder = $line[1]; - $core_count++; + 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'}); } - # NOTE: this logic won't work for die detections, unforutnately. - # ARM uses a different /sys based method, and ryzen relies on math on the cores - # in process_data - elsif ($line[1] == 0 && $die_holder > 0 ){ - $die_holder = $line[1]; - $core_count = 0; - $die_id++ if ($cpu{'type'} ne 'intel' && $cpu{'type'} ne 'amd' ); + } + } + 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'); + } } - $phys_holder = 0 if ! defined $phys_holder; - $ids[$phys_holder]->[$die_id][$line[1]] = $speed; - #print "ph: $phys_holder did: $die_id l1: $line[1] s: $speed\n"; } - if (!$cpu{'type'} && $line[0] eq 'vendor_id' ){ - $cpu{'type'} = cpu_vendor($line[1]); + } + 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; +} + +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; } - ## this is only for -C full cpu output - if ( $type eq 'full' ){ - if (!$cpu{'l2-cache'} && ($line[0] eq 'cache size' || $line[0] eq 'l2 cache size' )){ - if ($line[1] =~ /(\d+)\s(K|M)B$/){ - $cpu{'l2-cache'} = ($2 eq 'M') ? ($1*1024) : $1; + } + 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 cpu_sys_data { + eval $start if $b_log; + my $sys_freq = $_[0]; + my $cpu_sys = {}; + my $working = sys_data_grabber(); + return $cpu_sys if !%$working; + $cpu_sys->{'data'} = $working->{'data'} if $working->{'data'}; + my ($core_id,$fake_core_id,$phys_id,) = (0,0,-1); + my (%cache_ids,@ci_freq_max,@ci_freq_min,@sc_freq_max,@sc_freq_min); + foreach my $key (sort keys %{$working->{'cpus'}}){ + ($core_id,$phys_id) = (0,0); + my $cpu_id = $key + 0; + my $speed; + my $cpu = $working->{'cpus'}{$key}; + if (defined $cpu->{'topology'}{'physical_package_id'}){ + $phys_id = sprintf("%04d",$cpu->{'topology'}{'physical_package_id'}); + } + if (defined $cpu->{'topology'}{'core_id'}){ + # id is not consistent, seen 5 digit id + $core_id = sprintf("%08d",$cpu->{'topology'}{'core_id'}); + if ($fake{'cpu'}){ + if (defined $cpu->{'cpufreq'}{'scaling_cur_freq'} && + $cpu->{'cpufreq'}{'affected_cpus'} && + $cpu->{'cpufreq'}{'affected_cpus'} ne 'UNDEFINED' && + # manually generated cpu debuggers will show '', not UNDEFINED + $cpu->{'cpufreq'}{'affected_cpus'} ne ''){ + $speed = clean_speed($cpu->{'cpufreq'}{'scaling_cur_freq'},'khz'); } } - elsif (!$cpu{'l1-cache'} && $line[0] eq 'l1 cache size'){ - if ($line[1] =~ /(\d+)\sKB$/){ - $cpu{'l1-cache'} = $1; + elsif (defined $sys_freq && defined $sys_freq->{$key}){ + $speed = $sys_freq->{$key}; + } + if (defined $speed){ + push(@{$cpu_sys->{'cpus'}{$phys_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++; + push(@{$cpu_sys->{'cpus'}{$phys_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 $cpu->{'cpufreq'}{'cpuinfo_max_freq'}){ + $cpu->{'cpufreq'}{'cpuinfo_max_freq'} = clean_speed($cpu->{'cpufreq'}{'cpuinfo_max_freq'},'khz'); + if (!grep {$_ eq $cpu->{'cpufreq'}{'cpuinfo_max_freq'}} @ci_freq_max){ + push(@ci_freq_max,$cpu->{'cpufreq'}{'cpuinfo_max_freq'}); + } + if (!grep {$_ eq $cpu->{'cpufreq'}{'cpuinfo_max_freq'}} @{$cpu_sys->{'cpus'}{$phys_id}{'max-freq'}}){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'max-freq'}},$cpu->{'cpufreq'}{'cpuinfo_max_freq'}); } } - elsif (!$cpu{'l3-cache'} && $line[0] eq 'l3 cache size'){ - if ($line[1] =~ /(\d+)\s(K|M)B$/){ - $cpu{'l2-cache'} = ($2 eq 'M') ? ($1*1024) : $1; + if (defined $cpu->{'cpufreq'}{'cpuinfo_min_freq'}){ + $cpu->{'cpufreq'}{'cpuinfo_min_freq'} = clean_speed($cpu->{'cpufreq'}{'cpuinfo_min_freq'},'khz'); + if (!grep {$_ eq $cpu->{'cpufreq'}{'cpuinfo_min_freq'}} @ci_freq_min){ + push(@ci_freq_min,$cpu->{'cpufreq'}{'cpuinfo_min_freq'}); + } + if (!grep {$_ eq $cpu->{'cpufreq'}{'cpuinfo_min_freq'}} @{$cpu_sys->{'cpus'}{$phys_id}{'min-freq'}}){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'min-freq'}},$cpu->{'cpufreq'}{'cpuinfo_min_freq'}); } } - if ($cpu{'type'} eq 'elbrus'){ - # note: cache0 is L1i and cache1 L1d, but add both for L1 - if (!$cpu{'l0-cache'} && $line[0] eq 'cache0'){ - if ($line[1] =~ /size=(\d+)K\s/){ - $cpu{'l0-cache'} = $1; - } + if (defined $cpu->{'cpufreq'}{'scaling_max_freq'}){ + $cpu->{'cpufreq'}{'scaling_max_freq'} = clean_speed($cpu->{'cpufreq'}{'scaling_max_freq'},'khz'); + if (!grep {$_ eq $cpu->{'cpufreq'}{'scaling_max_freq'}} @sc_freq_max){ + push(@sc_freq_max,$cpu->{'cpufreq'}{'scaling_max_freq'}); } - elsif (!$cpu{'l1-cache'} && $line[0] eq 'cache1'){ - if ($line[1] =~ /size=(\d+)K\s/){ - $cpu{'l1-cache'} = $1; - $cpu{'l1-cache'} += $cpu{'l0-cache'} if $cpu{'l0-cache'}; - } + if (!grep {$_ eq $cpu->{'cpufreq'}{'scaling_max_freq'}} @{$cpu_sys->{'cpus'}{$phys_id}{'max-freq'}}){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'max-freq'}},$cpu->{'cpufreq'}{'scaling_max_freq'}); } - elsif (!$cpu{'l2-cache'} && $line[0] eq 'cache2'){ - if ($line[1] =~ /size=(\d+)(K|M)\s/){ - $cpu{'l2-cache'} = ($2 eq 'M') ? ($1*1024) : $1; - } + } + if (defined $cpu->{'cpufreq'}{'scaling_min_freq'}){ + $cpu->{'cpufreq'}{'scaling_min_freq'} = clean_speed($cpu->{'cpufreq'}{'scaling_min_freq'},'khz'); + if (!grep {$_ eq $cpu->{'cpufreq'}{'scaling_min_freq'}} @sc_freq_min){ + push(@sc_freq_min,$cpu->{'cpufreq'}{'scaling_min_freq'}); } - elsif (!$cpu{'l3-cache'} && $line[0] eq 'cache3'){ - if ($line[1] =~ /size=(\d+)(K|M)\s/){ - $cpu{'l3-cache'} = ($2 eq 'M') ? ($1*1024) : $1; - } + if (!grep {$_ eq $cpu->{'cpufreq'}{'scaling_min_freq'}} @{$cpu_sys->{'cpus'}{$phys_id}{'min-freq'}}){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'min-freq'}},$cpu->{'cpufreq'}{'scaling_min_freq'}); } } - if (!$cpu{'flags'} && ($line[0] eq 'flags' || $line[0] eq 'features' )){ - $cpu{'flags'} = $line[1]; + if (defined $cpu->{'cpufreq'}{'scaling_governor'}){ + if (!grep {$_ eq $cpu->{'cpufreq'}{'scaling_governor'}} @{$cpu_sys->{'cpus'}{$phys_id}{'governor'}}){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'governor'}},$cpu->{'cpufreq'}{'scaling_governor'}); + } } - } - if ( $extra > 0 && $type eq 'full' ){ - if ($line[0] eq 'bogomips'){ - # new arm shows bad bogomip value, so don't use it - $cpu{'bogomips'} += $line[1] if $line[1] > 50; + if (defined $cpu->{'cpufreq'}{'scaling_driver'}){ + $cpu_sys->{'cpus'}{$phys_id}{'scaling-driver'} = $cpu->{'cpufreq'}{'scaling_driver'}; } } - if ($b_admin ){ - # note: not used unless maybe /sys data missing? - if ( !$cpu{'bugs'} && $line[0] eq 'bugs'){ - $cpu{'bugs'} = $line[1]; - } - # unlike family and model id, microcode appears to be hex already - if ( !$cpu{'microcode'} && $line[0] eq 'microcode'){ - if ($line[1] =~ /0x/){ - $cpu{'microcode'} = uc($line[1]); - $cpu{'microcode'} =~ s/^0X//; + if (!defined $cpu_sys->{'data'}{'cpufreq-boost'} && defined $cpu->{'cpufreq'}{'cpb'}){ + $cpu_sys->{'data'}{'cpufreq-boost'} = $cpu->{'cpufreq'}{'cpb'}; + } + if (defined $cpu->{'topology'}{'core_cpus_list'}){ + $cpu->{'topology'}{'thread_siblings_list'} = $cpu->{'topology'}{'core_cpus_list'}; + } + if (defined $cpu->{'cache'} && keys %{$cpu->{'cache'}} > 0){ + foreach my $key2 (sort keys %{$cpu->{'cache'}}){ + my $cache = $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'}; } - else { - $cpu{'microcode'} = uc(sprintf("%x", $line[1])); + # 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); + } } } } + # die_id is relatively new, core_siblings_list has been around longer + if (defined $cpu->{'topology'}{'die_id'} || + defined $cpu->{'topology'}{'core_siblings_list'}){ + my $die = $cpu->{'topology'}{'die_id'}; + $die = $cpu->{'topology'}{'core_siblings_list'} if !defined $die; + if (!grep {$_ eq $die} @{$cpu_sys->{'cpus'}{$phys_id}{'dies'}}){ + push(@{$cpu_sys->{'cpus'}{$phys_id}{'dies'}},$die); + } + } } - $cpu{'phys'} = scalar @phys_cpus; - $cpu{'dies'} = $die_id++; # count starts at 0, all cpus have 1 die at least - if ($b_arm || $b_mips){ - if ($cpu{'dies'} <= 1){ - my $arm_dies = cpu_dies_sys(); - # case were 4 core arm returned 4 sibling lists, obviously wrong - $cpu{'dies'} = $arm_dies if $arm_dies && $proc_count != $arm_dies; + 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'; } - $cpu{'type'} = ($b_arm) ? 'arm' : 'mips' if !$cpu{'type'}; - if (!$bsd_type){ - my %system_cpus = system_cpu_name(); - $cpu{'system-cpus'} = \%system_cpus if %system_cpus; + else { + $cpu_sys->{'data'}{'cpufreq-boost'} = 'disabled'; } } - $cpu{'ids'} = (\@ids); - if ( $extra > 0 && !$cpu{'arch'} && $type ne 'short' ){ - ($cpu{'arch'},$cpu{'arch-note'}) = cpu_arch($cpu{'type'},$cpu{'family'},$cpu{'model_id'},$cpu{'stepping'}); - # cpu_arch comes from set_os() - $cpu{'arch'} = $cpu_arch if (!$cpu{'arch'} && $cpu_arch && ($b_mips || $b_arm || $b_ppc)); - #print "$cpu{'type'},$cpu{'family'},$cpu{'model_id'},$cpu{'arch'}\n"; + # 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 (!$speeds{'cur-freq'}){ - $cpu{'cur-freq'} = $cpu{'processors'}->[0]; - $speeds{'min-freq'} = 0; - $speeds{'max-freq'} = 0; + 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::Dumper::Dumper $cpu_sys if $dbg[8]; + eval $end if $b_log; + return $cpu_sys; +} + +sub sys_data_grabber { + eval $start if $b_log; + my (@files); + set_fake_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 { - $cpu{'cur-freq'} = $speeds{'cur-freq'}; - $cpu{'min-freq'} = $speeds{'min-freq'}; - $cpu{'max-freq'} = $speeds{'max-freq'}; + my $glob = '/sys/devices/system/cpu/{'; + if ($dbg[43]){ + $glob .= 'cpufreq,cpu*/topology,cpu*/cpufreq,cpu*/cache/index*,smt,vulnerabilities}/*'; + } + else { + $glob .= 'cpu*/topology/{core_cpus_list,core_id,core_siblings_list,die_id,'; + $glob .= 'physical_package_id,thread_siblings_list}'; + $glob .= ',cpufreq/{boost,ondemand}'; + $glob .= ',cpu*/cpufreq/{cpb,cpuinfo_max_freq,cpuinfo_min_freq,'; + $glob .= 'scaling_max_freq,scaling_min_freq'; + $glob .= ',scaling_driver,scaling_governor' if $type eq 'full' && $b_admin; + $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','%cpu',\%cpu) if $b_log; - print Data::Dumper::Dumper \%cpu if $test[8]; + main::log_data('dump','%$working',$working) if $b_log; + print Data::Dumper::Dumper $working if $dbg[39]; eval $end if $b_log; - return %cpu; + return $working; +} + +# Set in one place to make sure we get them all consistent +sub set_fake_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"; + + ## 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";v + # $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"; + $fake_data{'cpuinfo'} = $ci; + $fake_data{'sys'} = $sys; } sub sysctl_data { eval $start if $b_log; - my ($type) = @_; - my %cpu = set_cpu_data(); - my (@ids,@line,%speeds,@working); + 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); - foreach (@sysctl){ + 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]; + 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' ){ + 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::cleaner($line[1]); - $line[1] = cpu_cleaner($line[1]); - if ( $line[1] =~ /([0-9]+)[-[:space:]]*([KM]B)\s+L2 cache/) { + $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; + $cpu->{'l2-cache'} = $1 * $multiplier; } - if ( $line[1] =~ /([^0-9\.][0-9\.]+)[-[:space:]]*[MG]Hz/) { - $cpu{'max-freq'} = $1; - if ($cpu{'max-freq'} =~ /MHz/i) { - $cpu{'max-freq'} =~ s/[-[:space:]]*MHz//; - $cpu{'max-freq'} = speed_cleaner($cpu{'max-freq'},'mhz'); + 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/[-[:space:]]*GHz//i; - $cpu{'max-freq'} = $cpu{'max-freq'} / 1000; - $cpu{'max-freq'} = speed_cleaner($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] =~ /\)$/ ){ + if ($line[1] =~ /\)$/){ $line[1] =~ s/\s*\(.*\)$//; } - $cpu{'model_name'} = $line[1]; - $cpu{'type'} = cpu_vendor($line[1]); + $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; } - # NOTE: hw.l1icachesize: hw.l1dcachesize: - elsif ($line[0] eq 'hw.l1icachesize') { - $cpu{'l1-cache'} = $line[1]/1024; + elsif ($line[0] eq 'hw.l3cachesize'){ + $cpu->{'l3-cache'} = $line[1]/1024; } - elsif ($line[0] eq 'hw.l2cachesize') { - $cpu{'l2-cache'} = $line[1]/1024; + # hw.smt: openbsd + elsif ($line[0] eq 'hw.smt'){ + $cpu->{'smt'} = ($line[1]) ? 'enabled' : 'disabled'; } - elsif ($line[0] eq 'hw.l3cachesize') { - $cpu{'l3-cache'} = $line[1]/1024; + # 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 ($line[0] eq 'hw.clockrate' || $line[0] eq 'hw.cpuspeed') { - $cpu{'cur-freq'} = $line[1]; + 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.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_min'){ + $cpu->{'min-freq'} = $line[1]/1000000; } - elsif ($line[0] eq 'hw.busfrequency_max') { - $cpu{'max-freq'} = $line[1]/1000000; + elsif ($line[0] eq 'hw.busfrequency_max'){ + $cpu->{'max-freq'} = $line[1]/1000000; } - 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]); + # 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 'hw.ncpu' ) { - $cpu{'cores'} = $line[1]; + elsif ($line[0] eq 'machdep.cpu.vendor'){ + $cpu->{'type'} = cpu_vendor($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. - elsif ($line[0] eq 'dev.cpu.0.freq_levels') { + # 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]+/ ) { + 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; + $cpu->{'max-freq'} = $temp[0]; + $cpu->{'min-freq'} = $temp[-1]; + $cpu->{'scalings'} = \@temp; } } - elsif (!$cpu{'cur-freq'} && $line[0] eq 'dev.cpu.0.freq' ) { - $cpu{'cur-freq'} = $line[1]; + # 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' ) { + elsif ($line[0] eq 'hw.cpu_topology.members'){ my @temp = split(/\s+/, $line[1]); my $count = scalar @temp; $count-- if $count > 0; - $cpu{'processors'}->[$count] = 0; # no way to get per processor speeds yet, so assign 0 to each foreach (0 .. $count){ - $cpu{'processors'}->[$_] = 0; + $cpu->{'processors'}->[$_] = 0; } } - elsif ($line[0] eq 'hw.cpu_topology.cpu1.physical_siblings' ) { + elsif ($line[0] eq 'hw.cpu_topology.cpu1.physical_siblings'){ # string, like: cpu0 cpu1 my @temp = split(/\s+/, $line[1]); - $cpu{'siblings'} = scalar @temp; + $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. - elsif ( $line[0] eq 'hw.cpu_topology.cpu0.physical_id' ){ - if ($phys_holder != $line[1] ){ + # 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]; - $ids[$phys_id] = ([(0)]); - $ids[$phys_id]->[$die_id] = ([(0)]); - } - } - elsif ( $line[0] eq 'hw.cpu_topology.cpu0.core_id' ){ - if ($line[1] > 0 ){ - $die_holder = $line[1]; - } - # this handles multi die cpus like 16 core ryzen - elsif ($line[1] == 0 && $die_holder > 0 ){ - $die_id++ ; - $die_holder = $line[1]; - } - $ids[$phys_id]->[$die_id][$line[1]] = $speed; - $cpu{'dies'} = $die_id; - } - } - if (!$cpu{'flags'}){ - $cpu{'flags'} = cpu_flags_bsd(); - } - main::log_data('dump','%cpu',\%cpu) if $b_log; - print Data::Dumper::Dumper \%cpu if $test[8]; + 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 = 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 Data::Dumper::Dumper $cpu if $dbg[8]; eval $end if $b_log; - return %cpu; + return $cpu; } -sub cpu_properties { - my ($cpu) = @_; - my ($b_amd_zen,$b_epyc,$b_ht,$b_elbrus,$b_intel,$b_ryzen,$b_xeon); - if ($cpu->{'type'} ){ - if ($cpu->{'type'} eq 'intel'){ - $b_intel = 1; - $b_xeon = 1 if $cpu->{'model_name'} =~ /Xeon/i; - } - elsif ($cpu->{'type'} eq 'amd' ){ - if ( $cpu->{'family'} && $cpu->{'family'} eq '17' ) { - $b_amd_zen = 1; - if ($cpu->{'model_name'} ){ - if ($cpu->{'model_name'} =~ /Ryzen/i ){ - $b_ryzen = 1; - } - elsif ($cpu->{'model_name'} =~ /EPYC/i){ - $b_epyc = 1; - } +## DATA GENERATOR DATA SOURCES ## +sub 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: <....<b23>,<b34>> + # Features2=0x1e98220b<SSE3,PCLMULQDQ,MON,SSSE3,CX16,SSE4.1,SSE4.2,POPCNT,AESNI,XSAVE,OSXSAVE,AVX> + $line[1] =~ s/^[^<]*<|>[^>]*$//g; + # then get rid of <b23> 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 ($cpu->{'type'} eq 'elbrus') { - $b_elbrus = 1; - } - } - #my @dies = $phys[0]->[0]; - my @phys = @{$cpu->{'ids'}}; - my $phyical_count = 0; - #my $phyical_count = scalar @phys; - my @processors; - my ($speed,$speed_key); - # handle case where cpu reports say, phys id 0, 2, 4, 6 [yes, seen it] - foreach (@phys) { - $phyical_count++ if $_; - } - # count unique processors ## - # note, this fails for intel cpus at times - @processors = @{$cpu->{'processors'}}; - #print ref $cpu->{'processors'}, "\n"; - my $processors_count = scalar @processors; - #print "p count:$processors_count\n"; - #print Data::Dumper::Dumper \@processors; - # $cpu_cores is per physical cpu - my ($cpu_layout,$cpu_type,$min_max,$min_max_key) = ('','','',''); - my ($dmi_max_speed,$dmi_speed,$ext_clock,$socket,$upgrade,$volts) = (undef); - my ($l1_cache,$l2_cache,$l3_cache,$core_count,$cpu_cores,$die_count) = (0,0,0,0,0,0); - # note: elbrus supports turning off cores, so we need to add one for cases where rounds to 0 or 1 less - if ($b_elbrus && $processors_count){ - my @elbrus = elbrus_data($cpu->{'model_id'},$processors_count,$cpu->{'arch'}); - $cpu_cores = $elbrus[0]; - $phyical_count = $elbrus[1]; - $cpu->{'arch'} = $elbrus[2]; - # print 'model id: ' . $cpu->{'model_id'} . ' arch: ' . $cpu->{'arch'} . " cpc: $cpu_cores phyc: $phyical_count proc: $processors_count \n"; - } - $phyical_count ||= 1; # assume 1 if no id found, as with ARM - if ($extra > 1){ - # note: dmidecode has one entry per cpu per cache type, so this already - # has done the arithmetic on > 1 cpus for L1 and L3. - my %cpu_dmi = cpu_dmi_data(); - $l1_cache = $cpu_dmi{'L1'} if $cpu_dmi{'L1'}; - $l3_cache = $cpu_dmi{'L3'} if $cpu_dmi{'L3'}; - # bsd sysctl can have these values so let's check just in case - $l1_cache = $cpu->{'l1-cache'} * $phyical_count if !$l1_cache && $cpu->{'l1-cache'}; - $l3_cache = $cpu->{'l3-cache'} * $phyical_count if !$l3_cache && $cpu->{'l3-cache'}; - $dmi_max_speed = $cpu_dmi{'max-speed'} if $cpu_dmi{'max-speed'}; - $socket = $cpu_dmi{'socket'} if $cpu_dmi{'socket'}; - $upgrade = $cpu_dmi{'upgrade'} if $cpu_dmi{'upgrade'}; - $dmi_speed = $cpu_dmi{'speed'} if $cpu_dmi{'speed'}; - $ext_clock = $cpu_dmi{'ext-clock'} if $cpu_dmi{'ext-clock'}; - $volts = $cpu_dmi{'volts'} if $cpu_dmi{'volts'}; - } - foreach my $die_ref ( @phys ){ - next if ref $die_ref ne 'ARRAY'; - $core_count = 0; - $die_count = scalar @$die_ref; - #$cpu->{'dies'} = $die_count; - foreach my $core_ref (@$die_ref){ - next if ref $core_ref ne 'ARRAY'; - $core_count = 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 - # arm cpus do not actually show core id so ignore that counter - foreach my $id (@$core_ref){ - $core_count++ if defined $id && !$b_arm; + 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; + } } - #print 'cores: ' . $core_count, "\n"; - } - } - # this covers potentially cases where ARM cpus have > 1 die - $cpu->{'dies'} = ($b_arm && $die_count <= 1 && $cpu->{'dies'} > 1) ? $cpu->{'dies'}: $die_count; - # 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 (!$cpu_cores){ - if ($cpu->{'cores'} && ! $core_count || $cpu->{'cores'} >= $core_count){ - $cpu_cores = $cpu->{'cores'}; - } - elsif ($core_count > $cpu->{'cores'}){ - $cpu_cores = $core_count; - } - } - #print "cpu-c:$cpu_cores\n"; - #$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 ($b_intel){ - if ($cpu->{'siblings'} && $cpu->{'siblings'} > 1 && $cpu->{'cores'} && $cpu->{'cores'} > 1 ){ - if ( $cpu->{'siblings'}/$cpu->{'cores'} == 1 ){ - $b_intel = 0; - $b_ht = 0; + elsif (/^cpu0:.*?[0-9\.]+\s?MHz:\sspeeds:\s(.*?)\s?MHz/){ + @scalings = split(/[,\s]+/,$1); + $min_freq = $scalings[-1]; + $max_freq = $scalings[0]; } - else { - $cpu_cores = ($cpu->{'siblings'}/2); - $b_ht = 1; + # 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; } } - } - # ryzen is made out of blocks of 8 core dies - elsif ($b_ryzen){ - $cpu_cores = $cpu->{'cores'}; - # note: posix ceil isn't present in Perl for some reason, deprecated? - my $working = $cpu_cores / 8; - my @temp = split('\.', $working); - $cpu->{'dies'} = ($temp[1] && $temp[1] > 0) ? $temp[0]++ : $temp[0]; - } - # these always have 4 dies - elsif ($b_epyc) { - $cpu_cores = $cpu->{'cores'}; - $cpu->{'dies'} = 4; - } -# elsif ($b_elbrus){ -# $cpu_cores = -# } - # 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 ( $cpu_cores == 0 && ($cpu->{'cores'} * $phyical_count > 1)){ - $cpu_cores = ($cpu->{'cores'} * $phyical_count); - } - # last check, seeing some intel cpus and vms with intel cpus that do not show any - # core id data at all, or siblings. - if ($cpu_cores == 0 && $processors_count > 0){ - $cpu_cores = $processors_count; - } - # this happens with BSDs which have very little cpu data available - if ( $processors_count == 0 && $cpu_cores > 0 ){ - $processors_count = $cpu_cores; - if ($bsd_type && ($b_ht || $b_amd_zen) && $cpu_cores > 2 ){ - $cpu_cores = $cpu_cores/2;; - } - my $count = $processors_count; - $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; - } - } - # 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: $processors_count phc: $phyical_count coc: $core_count cpc: $cpu_cores\n"; - if (!$b_arm && $processors_count == $phyical_count*$core_count && $cpu_cores > $core_count){ - $b_ht = 0; - #$b_xeon = 0; - $b_intel = 0; - $cpu_cores = 1; - $core_count = 1; - $cpu->{'siblings'} = 1; - } - #print "pc: $processors_count s: $cpu->{'siblings'} cpuc: $cpu_cores corec: $core_count\n"; - # Algorithm: - # 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) - if ( $processors_count > 1 || ( $b_intel && $cpu->{'siblings'} > 0 ) ) { - # non-multicore MT - if ($processors_count == ($phyical_count * $cpu_cores * 2)){ - #print "mt:1\n"; - $cpu_type .= 'MT'; - } -# elsif ($b_xeon && $cpu->{'siblings'} > 1){ -# #print "mt:2\n"; -# $cpu_type .= 'MT'; -# } - elsif ($cpu->{'siblings'} > 1 && ($cpu->{'siblings'} == 2 * $cpu_cores )){ - #print "mt:3\n"; - $cpu_type .= 'MT'; - } - # non-MT multi-core or MT multi-core - if ( ($processors_count == $cpu_cores ) || ($phyical_count < $cpu_cores)){ - my $sep = ($cpu_type) ? ' ' : '' ; - $cpu_type .= $sep . 'MCP'; - } - # only solidly known > 1 die cpus will use this, ryzen and arm for now - if ( $cpu->{'dies'} > 1 ){ - my $sep = ($cpu_type) ? ' ' : '' ; - $cpu_type .= $sep . 'MCM'; - } - # >1 cpu sockets active: Symetric Multi Processing - if ($phyical_count > 1){ - my $sep = ($cpu_type) ? ' ' : '' ; - $cpu_type .= $sep . 'SMP'; + if ($flags){ + $flags =~ s/\s+/ /g; + $flags =~ s/^\s+|\s+$//g; } } else { - $cpu_type = 'UP'; - } - if ($phyical_count > 1){ - $cpu_layout = $phyical_count . 'x '; - } - $cpu_layout .= count_alpha($cpu_cores) . 'Core'; - $cpu_layout .= ' (' . $cpu->{'dies'}. '-Die)' if !$bsd_type && $cpu->{'dies'} > 1; - # the only possible change for bsds is if we can get phys counts in the future - if ($bsd_type){ - $l2_cache = $cpu->{'l2-cache'} * $phyical_count; - } - # AMD SOS chips appear to report full L2 cache per core - elsif ($cpu->{'type'} eq 'amd' && ($cpu->{'family'} eq '14' || $cpu->{'family'} eq '15' || $cpu->{'family'} eq '16')){ - $l2_cache = $cpu->{'l2-cache'} * $phyical_count; - } - elsif ($cpu->{'type'} ne 'intel'){ - $l2_cache = $cpu->{'l2-cache'} * $cpu_cores * $phyical_count; - } - ## note: this handles how intel reports L2, total instead of per core like AMD does - # note that we need to multiply by number of actual cpus here to get true cache size - else { - $l2_cache = $cpu->{'l2-cache'} * $phyical_count; - } - if ($cpu->{'cur-freq'} && $cpu->{'min-freq'} && $cpu->{'max-freq'} ){ - $min_max = "$cpu->{'min-freq'}/$cpu->{'max-freq'} MHz"; - $min_max_key = "min/max"; - $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed'; - $speed = "$cpu->{'cur-freq'} MHz"; - } - elsif ($cpu->{'cur-freq'} && $cpu->{'max-freq'}){ - $min_max = "$cpu->{'max-freq'} MHz"; - $min_max_key = "max"; - $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed'; - $speed = "$cpu->{'cur-freq'} MHz"; - } -# elsif ($cpu->{'cur-freq'} && $cpu->{'max-freq'} && $cpu->{'cur-freq'} == $cpu->{'max-freq'}){ -# $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed'; -# $speed = "$cpu->{'cur-freq'} MHz (max)"; -# } - elsif ($cpu->{'cur-freq'} && $cpu->{'min-freq'}){ - $min_max = "$cpu->{'min-freq'} MHz"; - $min_max_key = "min"; - $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed'; - $speed = "$cpu->{'cur-freq'} MHz"; - } - elsif ($cpu->{'cur-freq'} && !$cpu->{'max-freq'}){ - $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed'; - $speed = "$cpu->{'cur-freq'} MHz"; - } - - if ( !$bits_sys && !$b_arm && $cpu->{'flags'} ){ - $bits_sys = ($cpu->{'flags'} =~ /\blm\b/) ? 64 : 32; - } - my %cpu_properties = ( - 'bits-sys' => $bits_sys, - 'cpu-layout' => $cpu_layout, - 'cpu-type' => $cpu_type, - 'dmi-max-speed' => $dmi_max_speed, - 'dmi-speed' => $dmi_speed, - 'ext-clock' => $ext_clock, - 'min-max-key' => $min_max_key, - 'min-max' => $min_max, - 'socket' => $socket, - 'speed-key' => $speed_key, - 'speed' => $speed, - 'upgrade' => $upgrade, - 'volts' => $volts, - 'l1-cache' => $l1_cache, - 'l2-cache' => $l2_cache, - 'l3-cache' => $l3_cache, - ); - main::log_data('dump','%cpu_properties',\%cpu_properties) if $b_log; - #print Data::Dumper::Dumper $cpu; - #print Data::Dumper::Dumper \%cpu_properties; - #my $dc = scalar @dies; - #print 'phys: ' . $pc . ' dies: ' . $dc, "\n"; + 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 Data::Dumper::Dumper $values if $dbg[27]; eval $end if $b_log; - return %cpu_properties; + return $values; } -sub cpu_dmi_data { + +sub dmidecode_data { eval $start if $b_log; - return if !@dmi; - my %dmi_data = ('L1' => 0, 'L2' => 0,'L3' => 0, 'ext-clock' => undef, 'socket' => undef, - 'speed' => undef, 'max-speed' => undef, 'upgrade' => undef, 'volts' => undef); + 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 row, we don't need that data + # 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; CPU Internal L1 - if ($value =~ /^Socket Designation:.* (L[1-3])\b/){ - $id = $1; + 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/){ - $id = "L$1"; + elsif (!$id && $value =~ /^Configuration:.* Level.*?([1-3])\b/){ + if ($value !~ /Disabled/i){ + $id = "l$1"; + } } - elsif ($id && $value =~ /^Installed Size:\s+(.*B)$/){ + # 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; + $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 ARM etc won't be using dmi data here anyway. + # 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, we don't need that data - ($socket,$upgrade) = (undef); + # 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 =~ /~/; + 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::dmi_cleaner($2) if $2 !~ /(cpu|[mg]hz|onboard|socket|@|^#?[0-9]$)/i; - #print "$socket_temp\n"; + $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::dmi_cleaner($2) if $2 !~ /(ZIF|\bslot\b)/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::dmi_cleaner($1); + $dmi_data->{'volts'} = main::clean_dmi($1); } elsif ($value =~ /^Current Speed:\s*([0-9\.]+)\s*([MGK]Hz)?\b/i){ - $dmi_data{'speed'} = main::dmi_cleaner($1); + $dmi_data->{'speed'} = main::clean_dmi($1); } elsif ($value =~ /^Max Speed:\s*([0-9\.]+)\s*([MGK]Hz)?\b/i){ - $dmi_data{'max-speed'} = main::dmi_cleaner($1); + $dmi_data->{'max-speed'} = main::clean_dmi($1); } elsif ($value =~ /^External Clock:\s*([0-9\.]+\s*[MGK]Hz)\b/){ - $dmi_data{'ext-clock'} = main::dmi_cleaner($1); + $dmi_data->{'ext-clock'} = main::clean_dmi($1); } } } @@ -8516,560 +10579,1945 @@ sub cpu_dmi_data { # Seen older cases where Upgrade: Other value exists if ($socket || $upgrade){ if ($socket && $upgrade){ - $upgrade = undef if $socket eq $upgrade; + undef $upgrade if $socket eq $upgrade; } elsif ($upgrade){ $socket = $upgrade; - $upgrade = undef; + undef $upgrade; } - $dmi_data{'socket'} = $socket; - $dmi_data{'upgrade'} = $upgrade; + $dmi_data->{'socket'} = $socket; + $dmi_data->{'upgrade'} = $upgrade; } - main::log_data('dump','%dmi_data',\%dmi_data) if $b_log; - # print Data::Dumper::Dumper \%dmi_data; + main::log_data('dump','%$dmi_data',$dmi_data) if $b_log; + print Data::Dumper::Dumper $dmi_data if $dbg[27]; eval $end if $b_log; - return %dmi_data; + return $dmi_data; } -sub cpu_bugs_sys { - eval $start if $b_log; - my (@bugs,$type,$value); - return if ! -d '/sys/devices/system/cpu/vulnerabilities/'; - my @items = main::globber('/sys/devices/system/cpu/vulnerabilities/*'); - if (@items){ - foreach (@items){ - $value = ( -r $_) ? main::reader($_,'',0) : main::row_defaults('root-required'); - $type = ($value =~ /^Mitigation:/) ? 'mitigation': 'status'; - $_ =~ s/.*\/([^\/]+)$/$1/; - $value =~ s/Mitigation: //; - push(@bugs,[($_,$type,$value)]); + +## CPU PROPERTIES MAIN ## +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'} = 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'}); } } - main::log_data('dump','@bugs',\@bugs) if $b_log; - # print Data::Dumper::Dumper \@bugs; - eval $end if $b_log; - return @bugs; -} - -sub cpu_speeds { - eval $start if $b_log; - my ($processors) = @_; - my (@speeds); - my @files = main::globber('/sys/devices/system/cpu/cpu*/cpufreq/scaling_cur_freq'); - foreach (@files){ - my $speed = main::reader($_,'',0); - if (defined $speed){ - $speed = sprintf("%.0f", $speed/1000); - push(@speeds, $speed); + ## END CACHE PROCESSING ## + + ## START TYPE/LAYOUT/ARCH/BUGS ## + my ($cpu_type) = (''); + $cpu_type = cp_cpu_type( + $counts, + $cpu, + $tests + ); + my $topology = {}; + cp_cpu_topology($counts,$topology); + my $arch = cp_cpu_arch( + $cpu->{'type'}, + $cpu->{'family'}, + $cpu->{'model-id'}, + $cpu->{'stepping'}, + $cpu->{'model_name'}, + ); + # 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; +} + +## CPU DATA ENGINES ## +# 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 = 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; +} + +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 $_; } } - if (!@speeds){ - foreach (@$processors){ - if ($_ || $_ eq '0'){ - $_ = sprintf("%.0f", $_); - push(@speeds, $_); + # 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'} = $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"; } } - #print join('; ', @speeds), "\n"; - eval $end if $b_log; - return @speeds; -} -sub set_cpu_speeds_sys { - eval $start if $b_log; - my (@max_freq,@min_freq,@policies,%speeds); - my $sys = '/sys/devices/system/cpu/cpufreq/policy0'; - my $sys2 = '/sys/devices/system/cpu/cpu0/cpufreq/'; - my ($cur,$min,$max) = ('scaling_cur_freq','scaling_min_freq','scaling_max_freq'); - if (!-d $sys && -d $sys2){ - $sys = $sys2; - ($cur,$min,$max) = ('scaling_cur_freq','cpuinfo_min_freq','cpuinfo_max_freq'); - } - if (-d $sys){ - # corner cases, android, will have the files but they may be unreadable - if (-r "$sys/$cur"){ - $speeds{'cur-freq'} = main::reader("$sys/$cur",'',0); - $speeds{'cur-freq'} = speed_cleaner($speeds{'cur-freq'},'khz'); - } - if (-r "$sys/$min"){ - $speeds{'min-freq'} = main::reader("$sys/$min",'',0); - $speeds{'min-freq'} = speed_cleaner($speeds{'min-freq'},'khz'); - } - if (-r "$sys/$max"){ - $speeds{'max-freq'} = main::reader("$sys/$max",'',0); - $speeds{'max-freq'} = speed_cleaner($speeds{'max-freq'},'khz'); - } - if ($b_arm || $b_mips){ - @policies = main::globber('/sys/devices/system/cpu/cpufreq/policy*/'); - # there are arm chips with two dies, that run at different min max speeds!! - # see: https://github.com/smxi/inxi/issues/128 - # it would be slick to show both die min/max/cur speeds, but this is - # ok for now. - if (scalar @policies > 1){ - my ($current,$cur_temp,$max,$max_temp,$min,$min_temp) = (0,0,0,0,0,0); - foreach (@policies){ - $_ =~ s/\/$//; # strip off last slash in case globs have them - $max_temp = (-r "$_/cpuinfo_max_freq") ? main::reader("$_/cpuinfo_max_freq",'',0) : 0; - if ($max_temp){ - $max_temp = speed_cleaner($max_temp,'khz'); - push(@max_freq, $max_temp); - } - $max = $max_temp if ($max_temp > $max); - $min_temp = (-r "$_/cpuinfo_min_freq") ? main::reader("$_/cpuinfo_min_freq",'',0) : 0; - if ($min_temp){ - $min_temp = speed_cleaner($min_temp,'khz'); - push(@min_freq, $min_temp); - } - $min = $min_temp if ($min_temp < $min || $min == 0); - $cur_temp = (-r "$_/scaling_cur_freq") ? main::reader("$_/scaling_cur_freq",'',0) : 0; - $cur_temp = speed_cleaner($cur_temp,'khz') if $cur_temp; - if ($cur_temp > $current){ - $current = $cur_temp; - } - } - if (@max_freq){ - main::uniq(\@max_freq); - $max = join(':', @max_freq); - } - if (@min_freq){ - main::uniq(\@min_freq); - $min = join(':', @min_freq); - } - $speeds{'cur-freq'} = $current if $current; - $speeds{'max-freq'} = $max if $max; - $speeds{'min-freq'} = $min if $min; - } + # 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'}){ + if ($risc{'arm'} && $counts->{'dies'} <= 1 && $cpu->{'dies'} > 1){ + $counts->{'dies'} = $cpu->{'dies'}; } - # policy4/cpuinfo_max_freq:["2000000"] policy0/cpuinfo_max_freq:["1500000"] - # policy4/cpuinfo_min_freq:["200000"] - if ( (scalar @max_freq < 2 && scalar @min_freq < 2 ) && - (defined $speeds{'min-freq'} && defined $speeds{'max-freq'}) && - ($speeds{'min-freq'} > $speeds{'max-freq'} || $speeds{'min-freq'} == $speeds{'max-freq'} )){ - $speeds{'min-freq'} = 0; + else { + $cpu->{'dies'} = $counts->{'dies'}; } } - main::log_data('dump','%speeds',\%speeds) if $b_log; - eval $end if $b_log; - return %speeds; -} - -# right now only using this for ARM cpus, this is not the same in intel/amd -sub cpu_dies_sys { - eval $start if $b_log; - my @data = main::globber('/sys/devices/system/cpu/cpu*/topology/core_siblings_list'); - my (@dies); - foreach (@data){ - my $siblings = main::reader($_,'',0); - if (! grep {/$siblings/} @dies){ - push(@dies, $siblings); + # 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'}; } } - my $die_count = scalar @dies; - eval $end if $b_log; - return $die_count; -} -# 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 elbrus_data { - eval $start if $b_log; - my ($model_id,$count,$arch) = @_; - # 0: cores - my @cores; - my @return = (0,1,$arch); - $cores[1] = 1; - $cores[2] = 1; - $cores[3] = 4; - $cores[4] = 2; - $cores[6] = 1; - $cores[7] = 8; - $cores[8] = 1; - $cores[9] = 8; - $cores[10] = 12; - $cores[11] = 16; - $cores[12] = 2; - if (main::is_numeric($model_id) && $cores[$model_id]){ - $return[0] = $cores[$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; -} -sub cpu_flags_bsd { - eval $start if $b_log; - my ($flags,$sep) = ('',''); - # this will be null if it was not readable - my $file = main::system_files('dmesg-boot'); - if ( @dmesg_boot){ - foreach (@dmesg_boot){ - 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: <....<b23>,<b34>> - # Features2=0x1e98220b<SSE3,PCLMULQDQ,MON,SSSE3,CX16,SSE4.1,SSE4.2,POPCNT,AESNI,XSAVE,OSXSAVE,AVX> - $line[1] =~ s/^[^<]*<|>[^>]*$//g; - # then get rid of <b23> stuff - $line[1] =~ s/<[^>]+>//g; - # and replace commas with spaces - $line[1] =~ s/,/ /g; - $flags .= $sep . $line[1]; - $sep = ' '; + # 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; } - elsif (/real mem/){ - last; + else { + $counts->{'cpu-cores'} = ($cpu->{'siblings'}/2); + $tests->{'ht'} = 1; } } - if ($flags){ - $flags =~ s/\s+/ /g; - $flags =~ s/^\s+|\s+$//g; + } + # 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'} = ($temp[1] && $temp[1] > 0) ? $temp[0]++ : $temp[0]; + $counts->{'dies'} = $cpu->{'dies'}; + } + # these always have 4 dies + elsif ($tests->{'epyc'}){ + $counts->{'cpu-cores'} = $cpu->{'cores'}; + $counts->{'dies'} = $cpu->{'dies'} = 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; } } - else { - if ( $file && ! -r $file ){ - $flags = main::row_defaults('dmesg-boot-permissions'); + # 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; - return $flags; } -# only elbrus ID is actually used live -sub cpu_vendor { +# all values passed by reference so no need for returns +sub cp_data_sys { eval $start if $b_log; - my ($string) = @_; - my ($vendor) = (''); - $string = lc($string); - if ($string =~ /intel/) { - $vendor = "intel" + my ($cpu,$cpu_sys,$caches,$counts) = @_; + my (@keys) = (sort keys %{$cpu_sys->{'cpus'}}); + return if !@keys; + $counts->{'physical'} = scalar @keys; + if ($type eq 'full' && $cpu_sys->{'cpus'}{$keys[0]}{'caches'}){ + cp_sys_caches($cpu_sys->{'cpus'}{$keys[0]}{'caches'},$caches,'l1','l1d'); + cp_sys_caches($cpu_sys->{'cpus'}{$keys[0]}{'caches'},$caches,'l1','l1i'); + cp_sys_caches($cpu_sys->{'cpus'}{$keys[0]}{'caches'},$caches,'l2',''); + cp_sys_caches($cpu_sys->{'cpus'}{$keys[0]}{'caches'},$caches,'l3',''); } - elsif ($string =~ /amd/){ - $vendor = "amd" + if ($cpu_sys->{'data'}{'speeds'}{'all'}){ + $counts->{'processors'} = scalar @{$cpu_sys->{'data'}{'speeds'}{'all'}}; } - # via - elsif ($string =~ /centaur/){ - $vendor = "centaur" + 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 (@governor,@max,@min,@phys_cores); + foreach my $phys_id (@keys){ + if ($cpu_sys->{'cpus'}{$phys_id}{'cores'}){ + my ($mt,$st) = (0,0); + my (@core_keys) = keys %{$cpu_sys->{'cpus'}{$phys_id}{'cores'}}; + $cpu->{'cores'} = $counts->{'cpu-cores'} = scalar @core_keys; + $counts->{'cpu-topo'}[$i]{'cores'} = $cpu->{'cores'}; + if ($cpu_sys->{'cpus'}{$phys_id}{'dies'}){ + $counts->{'cpu-topo'}[$i]{'dies'} = scalar @{$cpu_sys->{'cpus'}{$phys_id}{'dies'}}; + $cpu->{'dies'} = $counts->{'cpu-topo'}[$i]{'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'}){ + if ($counts->{'processors'} > $counts->{'cpu-cores'}){ + for my $key (@core_keys){ + if ((my $threads = scalar @{$cpu_sys->{'cpus'}{$phys_id}{'cores'}{$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; + } + } + } + } + $i++; + } } - elsif ($string =~ /e2k/){ - $vendor = "elbrus" + $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','%cpu_properties',$caches); + main::log_data('dump','%cpu_properties',$counts); } + # print Data::Dumper::Dumper $caches; + # print Data::Dumper::Dumper $counts; eval $end if $b_log; - return $vendor; } -sub get_boost_status { + +sub cp_sys_caches { eval $start if $b_log; - my ($boost); - my $path = '/sys/devices/system/cpu/cpufreq/boost'; - if (-r $path){ - $boost = main::reader($path,'',0); - if (defined $boost && $boost =~ /^[01]$/){ - $boost = ($boost) ? 'enabled' : 'disabled'; + 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; - return $boost; } -sub system_cpu_name { + +## CPU PROPERTIES 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 (%cpus,$compat,@working); - 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; - } + my ($counts,$cpu,$caches,$cache_check) = @_; + # L1 Cache + if ($cpu->{'l1-cache'}){ + $caches->{'l1'} = $cpu->{'l1-cache'} * $counts->{'cores-multiplier'}; } - # 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; + 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'}; } } - main::log_data('dump','%cpus',\%cpus) if $b_log; + # 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; - return %cpus; } -sub cpu_arch { +## START CPU ARCH ## +sub cp_cpu_arch { eval $start if $b_log; - my ($type,$family,$model,$stepping) = @_; - $stepping = 0 if !main::is_numeric($stepping); - my ($arch,$note) = ('',''); - my $check = main::row_defaults('note-check'); - # See: docs/inxi-resources.txt + 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 =~ /^[A-F0-9]{1,3}$/i){ + $stepping = hex($stepping); + } + else { + $stepping = 0 + } + $family ||= ''; + $model = '' if !defined $model; # model can be 0 + 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"; - if ( $type eq 'amd'){ - if ($family eq '4'){ - if ( $model =~ /^(3|7|8|9|A)$/ ) {$arch = 'Am486'} - elsif ( $model =~ /^(E|F)$/ ) {$arch = 'Am5x86'} + # 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'){ - if ( $model =~ /^(0|1|2|3)$/ ) {$arch = 'K5'} - elsif ( $model =~ /^(6|7)$/ ) {$arch = 'K6'} - elsif ( $model =~ /^(8)$/ ) {$arch = 'K6-2'} - elsif ( $model =~ /^(9|D)$/ ) {$arch = 'K6-3'} - elsif ( $model =~ /^(A)$/ ) {$arch = 'Geode'} - } + ## 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'){ - if ( $model =~ /^(1|2)$/ ) {$arch = 'K7'} - elsif ( $model =~ /^(3|4)$/ ) {$arch = 'K7 Thunderbird'} - elsif ( $model =~ /^(6|7|8|A)$/ ) {$arch = 'K7 Palomino+'} - else {$arch = 'K7'} + ## 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'){ - if ( $model =~ /^(4|5|7|8|B|C|E|F|14|15|17|18|1B|1C|1F)$/ ) {$arch = 'K8'} - elsif ( $model =~ /^(21|23|24|25|27|28|2C|2F)$/ ) {$arch = 'K8 rev.E'} - elsif ( $model =~ /^(41|43|48|4B|4C|4F|5D|5F|68|6B|6C|6F|7C|7F|C1)$/ ) {$arch = 'K8 rev.F+'} - else {$arch = 'K8'} - } - elsif ($family eq '10'){ - if ( $model =~ /^(2|4|5|6|8|9|A)$/ ) {$arch = 'K10'} - else {$arch = 'K10'} - } - elsif ($family eq '11'){ - if ( $model =~ /^(3)$/ ) {$arch = 'Turion X2 Ultra'} + ## 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'){ - if ( $model =~ /^(1)$/ ) {$arch = 'Fusion'} - else {$arch = 'Fusion'} + 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'){ - if ( $model =~ /^(1|2)$/ ) {$arch = 'Bobcat'} - else {$arch = 'Bobcat'} - } - elsif ($family eq '15'){ - if ( $model =~ /^(0|1|2|3|4|5|6|7|8|9|A|B|C|D|E|F)$/ ) {$arch = 'Bulldozer'} - elsif ( $model =~ /^(10|11|12|13|14|15|16|17|18|19|1A|1B|1C|1D|1E|1F)$/ ) {$arch = 'Piledriver'} - elsif ( $model =~ /^(30|31|32|33|34|35|36|37|38|39|3A|3B|3C|3D|3E|3F)$/ ) {$arch = 'Steamroller'} - 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'} - else {$arch = 'Bulldozer'} + 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'){ - if ( $model =~ /^(0|1|2|3|4|5|6|7|8|9|A|B|C|D|E|F)$/ ) {$arch = 'Jaguar'} - elsif ( $model =~ /^(30|31|32|33|34|35|36|37|38|39|3A|3B|3C|3D|3E|3F)$/ ) {$arch = 'Puma'} - else {$arch = 'Jaguar'} + 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'){ - if ( $model =~ /^(1|11|20)$/ ) {$arch = 'Zen'} + 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)$/ ) { + elsif ($model =~ /^(18)$/){ $arch = 'Zen/Zen+'; + $gen = '1'; + $process = 'GF 12nm'; $note = $check; - } - elsif ( $model =~ /^(8)$/ ) {$arch = 'Zen+'} - # not positive about 2x, main resource shows only listed hex values + $year = '2019';} + # shares model 8 with zen, stepping unknown + elsif ($model =~ /^(8)$/){ + $arch = 'Zen+'; + $gen = '2'; + $process = 'GF 12nm'; + $year = '2018-21';} # used this but it didn't age well: ^(2[0123456789ABCDEF]| - elsif ( $model =~ /^(31|60|71|90)$/ ) {$arch = 'Zen 2'} - # no info on these yet, but they are coming and are scheduled - # elsif ( $model =~ /^()$/ ) {$arch = 'Zen 4'} + elsif ($model =~ /^(3.|4.|5.|6.|7.|8.|9.|A.)$/){ + $arch = 'Zen 2'; + $gen = '3'; + $process = 'TSMC n7 (7nm)'; # some consumer maybe GF 14nm + $year = '2020-22';} else { $arch = 'Zen'; - $note = $check;} + $note = $check; + $process = '7-14nm'; + $year = '';} } - elsif ($family eq '18'){ - # model #s not known yet + # 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 = '5'; + $process = 'TSMC n4 (4nm)'; + $year = '2023+';} + # ext model 6,7, base models trickling in + # 10 engineering sample + elsif ($model =~ /^(1.|6.|7.|A.)$/){ + $arch = 'Zen 4'; + $gen = '5'; + $process = 'TSMC n5 (5nm)'; + $year = '2022+';} + # double check 40, 44; 21 confirmed + elsif ($model =~ /^(21|4.)$/){ + $arch = 'Zen 3+'; + $gen = '4'; + $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 = '4'; + $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 n3 (3nm)'; # turin could be 4nm, need more data + $year = '2023+';} + elsif ($model =~ /^(20|40)$/){ + $arch = 'Zen 5'; + $gen = '5'; + $process = 'TSMC n3 (3nm)'; # desktop, granite ridge, confirm 2024 + $year = '2024+';} + else { + $arch = 'Zen 5'; + $note = $check; + $process = 'TSMC n3/n4 (3,4nm)'; + $year = '2024+';} } - elsif ($family eq '19'){ - # unconfirmed: model: 0 20 40 50 - $arch = 'Zen 3'; - } - # note: family 20 may be Zen 4 but not known for sure yet + # 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 } - elsif ( $type eq 'arm'){ - if ($family ne ''){$arch="ARMv$family";} - else {$arch='ARM';} + # 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'; -# } + # elsif ($type eq 'ppc'){ + # $arch='PPC'; + # } # aka VIA - elsif ( $type eq 'centaur'){ + elsif ($type eq 'centaur'){ if ($family eq '5'){ - if ( $model =~ /^(4)$/ ) {$arch = 'WinChip C6'} - elsif ( $model =~ /^(8)$/ ) {$arch = 'WinChip 2'} - elsif ( $model =~ /^(9)$/ ) {$arch = 'WinChip 3'} + 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 = 'WinChip-based'} - elsif ( $model =~ /^(7|8)$/ ) {$arch = 'C3'} - elsif ( $model =~ /^(9)$/ ) {$arch = 'C3-2'} - elsif ( $model =~ /^(A|D)$/ ) {$arch = 'C7'} - elsif ( $model =~ /^(F)$/ ) {$arch = 'Isaiah'} + 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 - elsif ( $type eq 'elbrus'){ + # ExpLicit Basic Resources Utilization Scheduling + elsif ($type eq 'elbrus'){ # E8CB - if ($family eq '4'){ - if ( $model eq '1' ) {$arch = 'Elbrus'} - elsif ( $model eq '2' ) {$arch = 'Elbrus-S'} - elsif ( $model eq '3' ) {$arch = 'Elbrus-4C'} - elsif ( $model eq '4' ) {$arch = 'Elbrus-2C+'} - elsif ( $model eq '6' ) {$arch = 'Elbrus-2CM'} - elsif ( $model eq '7' ) { - if ($stepping >= 2) {$arch = 'Elbrus-8C1';} - else {$arch = 'Elbrus-8C';} - } # note: stepping > 1 may be 8C1 - elsif ( $model eq '8' ) {$arch = 'Elbrus-1C+'} - # 8C2 morphed out of E8CV, but the two were the same die - elsif ( $model eq '9' ) { - $arch = 'Elbrus-8CV/8C2'; - $note = $check;} - elsif ( $model eq '10' ) {$arch = 'Elbrus-12C'} - elsif ( $model eq '11' ) {$arch = 'Elbrus-16C'} - elsif ( $model eq '12' ) {$arch = 'Elbrus-2C3'} - else { - $arch = 'Elbrus-??'; - $note = $check;} - } - elsif ($family eq '5'){ - if ($model eq '9') {$arch = 'Elbrus-8C2'} + 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;} - } + $note = $check; + } } - elsif ( $type eq 'intel'){ + elsif ($type eq 'intel'){ if ($family eq '4'){ - if ( $model =~ /^(0|1|2|3|4|5|6|7|8|9)$/ ) {$arch = '486'} + 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'){ - if ( $model =~ /^(1|2|3|7)$/ ) {$arch = 'P5'} - elsif ( $model =~ /^(4|8)$/ ) {$arch = 'P5'} # MMX - elsif ( $model =~ /^(9|A)$/ ) {$arch = 'Lakemont'} + # 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'} - elsif ( $model =~ /^(3)$/ ) {$arch = 'P6 II Klamath'} - elsif ( $model =~ /^(5)$/ ) {$arch = 'P6 II Deschutes'} - elsif ( $model =~ /^(6)$/ ) {$arch = 'P6 II Mendocino'} - elsif ( $model =~ /^(7)$/ ) {$arch = 'P6 III Katmai'} - elsif ( $model =~ /^(8)$/ ) {$arch = 'P6 III Coppermine'} - elsif ( $model =~ /^(9)$/ ) {$arch = 'M Banias'} # pentium M - elsif ( $model =~ /^(A)$/ ) {$arch = 'P6 III Xeon'} - elsif ( $model =~ /^(B)$/ ) {$arch = 'P6 III Tualitin'} - elsif ( $model =~ /^(D)$/ ) {$arch = 'M Dothan'} # Pentium M - elsif ( $model =~ /^(E)$/ ) {$arch = 'M Yonah'} - elsif ( $model =~ /^(F|16)$/ ) {$arch = 'Core Merom'} - elsif ( $model =~ /^(15)$/ ) {$arch = 'M Tolapai'} # pentium M system on chip - elsif ( $model =~ /^(17|1D)$/ ) {$arch = 'Penryn'} - elsif ( $model =~ /^(1A|1E|1F|25|2C|2E|2F)$/ ) {$arch = 'Nehalem'} - elsif ( $model =~ /^(1C|26)$/ ) {$arch = 'Bonnell'} # atom Bonnell? 27? - elsif ( $model =~ /^(27|35|36)$/ ) {$arch = 'Saltwell'} - elsif ( $model =~ /^(25|2C|2F)$/ ) {$arch = 'Westmere'} - elsif ( $model =~ /^(2A|2D)$/ ) {$arch = 'Sandy Bridge'} - elsif ( $model =~ /^(37|4A|4D|5A|5D)$/ ) {$arch = 'Silvermont'} - elsif ( $model =~ /^(3A|3E)$/ ) {$arch = 'Ivy Bridge'} - elsif ( $model =~ /^(3C|3F|45|46)$/ ) {$arch = 'Haswell'} - elsif ( $model =~ /^(3D|47|4F|56)$/ ) {$arch = 'Broadwell'} - elsif ( $model =~ /^(4C)$/ ) {$arch = 'Airmont'} - elsif ( $model =~ /^(4E)$/ ) {$arch = 'Skylake'} + 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'} - elsif ($stepping >= 8){$arch = 'Cooper Lake'} - else {$arch = 'Skylake'} } - elsif ( $model =~ /^(57)$/ ) {$arch = 'Knights Landing'} - elsif ( $model =~ /^(5C|5F)$/ ) {$arch = 'Goldmont'} - elsif ( $model =~ /^(5E)$/ ) {$arch = 'Skylake-S'} - elsif ( $model =~ /^(66)$/ ) {$arch = 'Cannon Lake'} + 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)$/ ) {$arch = 'Ice Lake'} - elsif ( $model =~ /^(7A)$/ ) {$arch = 'Goldmont Plus'} - elsif ( $model =~ /^(85)$/ ) {$arch = 'Knights Mill'} - elsif ( $model =~ /^(86)$/ ) {$arch = 'Tremont'} - elsif ( $model =~ /^(8C)$/ ) {$arch = 'Tiger Lake'} - elsif ( $model =~ /^(8E)$/ ) { + 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;} + $note = $check; + $process = 'Intel 14nm'; + $year = '2017';} elsif ($stepping == 10){ - $arch = 'Coffee Lake'} + $arch = 'Coffee Lake'; + $process = 'Intel 14nm'; + $year = '2017';} elsif ($stepping == 11){ - $arch = 'Whiskey Lake'} + $arch = 'Whiskey Lake'; + $process = 'Intel 14nm'; + $year = '2018';} # can be WhiskeyL or CometL elsif ($stepping == 12){ $arch = 'Comet/Whiskey Lake'; - $note = $check;} + $note = $check; + $process = 'Intel 14nm'; + $year = '2018';} # note: had it as > 13, but 0xC seems to be CL elsif ($stepping >= 13){ - $arch = 'Comet Lake'} # guess, have not seen docs yet + $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;} - } - elsif ( $model =~ /^(9E)$/ ) { + $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'} + $arch = 'Kaby Lake'; + $process = 'Intel 14nm'; + $year = '2018';} elsif ($stepping >= 10 && $stepping <= 13){ - $arch = 'Coffee Lake'} + $arch = 'Coffee Lake'; # 9E:A,B,C,D + $process = 'Intel 14nm'; + $year = '2018';} else { $arch = 'Kaby Lake'; - $note = $check;} - } - elsif ( $model =~ /^(A5)$/ ) {$arch = 'Comet Lake'} # steppings 0-5 + $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; alder lake; cooper lake; granite rapids; rocket lake; saphire rapids; + # 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+)'; # confirm + $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 = 'Intel 18a (1.8nm)'; + $year = '2024+';} # seen APU IDs, so out there + # Meteor Lake-S maybe cancelled, replaced by arrow + elsif ($model =~ /^(C5|C6)$/){ + $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+';} + ## 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'} - if ( $model =~ /^(1)$/ ) {$arch = 'Knights Corner'} - } + 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'} - elsif ( $model =~ /^(2)$/ ) {$arch = 'Netburst Northwood'} - elsif ( $model =~ /^(3)$/ ) {$arch = 'Netburst Prescott'} # 6? Nocona - elsif ( $model =~ /^(4)$/ ) {$arch = 'Netburst Smithfield'} # 6? Nocona - elsif ( $model =~ /^(6)$/ ) {$arch = 'Netburst Presler'} - else {$arch = 'Netburst'} + 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 (!$model){ + if (!$arch){ my $file = '/sys/devices/cpu/caps/pmu_name'; - $model = main::reader($file,'strip',0) if -r $file; - $note = $check if $model; + $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"; + } } } eval $end if $b_log; - return ($arch,$note); + return [$arch,$note,$process,$gen,$year]; } +## END CPU ARCH ## -sub count_alpha { - my ($count) = @_; - #print "$count\n"; +# 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; +} + +sub cp_cpu_topology { + my ($counts,$topology) = @_; my @alpha = qw(Single Dual Triple Quad); - if ($count > 4){ - $count .= '-'; + 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'} && $topo->{'dies'} > 1){ + $topology->{'full'}[$j]{'dies'} = $topo->{'dies'}; + } + 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_cpu_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_cpu_alpha($counts->{'cpu-cores'}); + } + } + $topology->{'string'} ||= ''; +} + +sub cp_cpu_alpha { + my $cores = $_[0]; + my $string = ''; + if ($cores > 4){ + $string = $cores . '-core'; + } + elsif ($cores == 0){ + $string = main::message('unknown-cpu-topology'); } else { - $count = $alpha[$count-1] . ' ' if $count > 0; + my @alpha = qw(single dual triple quad); + $string = $alpha[$cores-1] . ' core'; } - return $count; + return $string; } + +# 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 ($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; +} + +# 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; +} + +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; + } +} + +## CPU UTILITIES ## +# only elbrus ID is actually used live +sub cpu_vendor { + eval $start if $b_log; + my ($string) = @_; + 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 { - my %cpu = ( + ${$_[0]} = { 'arch' => '', + 'avg-freq' => 0, # MHz 'bogomips' => 0, 'cores' => 0, - 'cur-freq' => 0, + 'cur-freq' => 0, # MHz 'dies' => 0, 'family' => '', 'flags' => '', @@ -9077,30 +12525,61 @@ sub set_cpu_data { 'l1-cache' => 0, # store in KB 'l2-cache' => 0, # store in KB 'l3-cache' => 0, # store in KB - 'max-freq' => 0, - 'min-freq' => 0, - 'model_id' => undef, + 'max-freq' => 0, # MHz + 'min-freq' => 0, # MHz 'model_name' => '', 'processors' => [], - 'rev' => '', 'scalings' => [], 'siblings' => 0, 'type' => '', - ); - return %cpu; + }; +} + +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; } + +## CLEANERS/OUTPUT HANDLERS ## # MHZ - cell cpus -sub speed_cleaner { +sub clean_speed { my ($speed,$opt) = @_; - return if ! $speed || $speed eq '0'; + # eq '0' might be for string typing; value can be: <unknown> + 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 cpu_cleaner { + +sub clean_cpu { my ($cpu) = @_; - return if ! $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]'; @@ -9109,11 +12588,16 @@ sub cpu_cleaner { $cpu =~ s/^\s+|\s+$//g; return $cpu; } + sub hex_and_decimal { my ($data) = @_; - $data ||= ''; + $data = '' if !defined $data; if ($data =~ /\S/){ - $data .= ' (' . hex($data) . ')' if hex($data) ne $data; + # 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'; @@ -9122,117 +12606,120 @@ sub hex_and_decimal { } } -## DiskData +## DriveItem { -package DiskData; -my ($b_hddtemp,$b_nvme,$smartctl_missing); +package DriveItem; +my ($b_hddtemp,$b_nvme,$smartctl_missing,$vendors); my ($hddtemp,$nvme) = ('',''); -my (@by_id,@by_path,@vendors); +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 (@data,@rows,$key1,$val1); my ($type) = @_; $type ||= 'standard'; + my ($key1,$val1); + my $rows = []; my $num = 0; - @data = disk_data($type); + my $data = drive_data($type); # NOTE: - if (@data){ + if (@$data){ if ($type eq 'standard'){ - push(@rows,totals_output(\@data)); - push(@rows,drives_output(\@data)) if $show{'disk'} && @data; - if ($bsd_type && !@dm_boot_disk && $type eq 'standard' && $show{'disk'} ){ + 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 = main::system_files('dmesg-boot'); - if ( $file && ! -r $file){ - $val1 = main::row_defaults('dmesg-boot-permissions'); + my $file = $system_files{'dmesg-boot'}; + if ($file && ! -r $file){ + $val1 = main::message('dmesg-boot-permissions'); } elsif (!$file){ - $val1 = main::row_defaults('dmesg-boot-missing'); + $val1 = main::message('dmesg-boot-missing'); } else { - $val1 = main::row_defaults('disk-data-bsd'); + $val1 = main::message('disk-data-bsd'); } - push(@rows,{main::key($num++,0,1,$key1) => $val1,}); + push(@$rows,{main::key($num++,0,1,$key1) => $val1,}); } } # used by short form, raw data returned else { - @rows = @data; - # print Data::Dumper::Dumper \@rows; + $rows = $data; + # print Data::Dumper::Dumper $rows; } } else { $key1 = 'Message'; - $val1 = main::row_defaults('disk-data'); - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + $val1 = main::message('disk-data'); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); } - if (!@rows){ + if (!@$rows){ $key1 = 'Message'; - $val1 = main::row_defaults('disk-data'); - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + $val1 = main::message('disk-data'); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); } - #push(@rows,@data); + # push(@rows,@data); if ($show{'optical'} || $show{'optical-basic'}){ - push(@rows,OpticalData::get()); + OpticalItem::get($rows); } - ($b_hddtemp,$b_nvme,$hddtemp,$nvme) = (undef,undef,undef,undef); - (@by_id,@by_path) = (undef,undef); + ($b_hddtemp,$b_nvme,$hddtemp,$nvme,$vendors) = (); + (@by_id,@by_path) = (); eval $end if $b_log; - return @rows; + return $rows; } -sub totals_output { + +sub storage_output { eval $start if $b_log; - my ($disks) = @_; - my (@rows); + my ($rows,$disks) = @_; my ($num,$j) = (0,0); my ($size,$size_value,$used) = ('','',''); - push(@rows, { + push(@$rows, { main::key($num++,1,1,'Local Storage') => '', }); - #print Data::Dumper::Dumper $disks; + # 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; + $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; + # 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; + $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; + $rows->[$j]{main::key($num++,0,4,'lvm-free')} = $size; } if (($size_value && $size_value =~ /^[0-9]/) && - ($used && $disks->[0]{'used'} =~ /^[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; + $rows->[$j]{main::key($num++,0,2,'used')} = $used; shift @$disks; eval $end if $b_log; - return @rows; } -sub drives_output { + +sub drive_output { eval $start if $b_log; - my ($disks) = @_; - #print Data::Dumper::Dumper $disks; - my ($b_smart_permissions,@rows,$smart_age,$smart_basic,$smart_fail); + 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; + $j = scalar @$rows; + $rows->[$j]{main::key($num++,0,1,'SMART Message')} = $smartctl_missing; } - elsif ($b_admin) { - ($smart_age,$smart_basic,$smart_fail) = smartctl_fields(); + 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) = ('','',''); @@ -9240,86 +12727,124 @@ sub drives_output { $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; + # 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; + $rows->[$j]{main::key($num++,0,1,'SMART Message')} = $row->{'smart-permissions'}; + $j = scalar @$rows; } - push(@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->{'type'}){ - $rows[$j]->{main::key($num++,0,2,'type')} = $row->{'type'}; + $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,'vendor')} = $row->{'vendor'}; } - $rows[$j]->{main::key($num++,0,2,'model')} = $model; + $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'}; + $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'}; + $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,'family')} = $row->{'family'}; } - $rows[$j]->{main::key($num++,0,2,'size')} = $size; + $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'; - $rows[$j]->{main::key($num++,0,3,'logical')} = ($row->{'block-logical'}) ? $row->{'block-logical'} . ' B' : 'N/A'; + $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,'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'}; + $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->{'rotation'} || $row->{'drive-type'})){ - $row->{'rotation'} = $row->{'drive-type'} if !$row->{'rotation'}; - $rows[$j]->{main::key($num++,0,2,'rotation')} = $row->{'rotation'}; + 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){ - my $serial = main::apply_filter($row->{'serial'}); - $rows[$j]->{main::key($num++,0,2,'serial')} = $serial; + 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::apply_filter($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,'rev')} = $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'}; + $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'; + $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 + # Extra level tests already done if (defined $row->{'partition-table'}){ - $rows[$j]->{main::key($num++,0,2,'scheme')} = $row->{'partition-table'}; + $rows->[$j]{main::key($num++,0,2,'scheme')} = $row->{'partition-table'}; } if ($row->{'smart'} || $row->{'smart-error'}){ - $j = scalar @rows; + $j = scalar @$rows; ## Basic SMART and drive info ## - smart_output('basic',$smart_basic,$row,$j,\$num,\@rows); + smart_output('basic',$smart_basic,$row,$j,\$num,$rows); ## Old-Age errors ## - smart_output('age',$smart_age,$row,$j,\$num,\@rows); + smart_output('age',$smart_age,$row,$j,\$num,$rows); ## Pre-Fail errors ## - smart_output('fail',$smart_fail,$row,$j,\$num,\@rows); + smart_output('fail',$smart_fail,$row,$j,\$num,$rows); } } eval $end if $b_log; - return @rows; } -# $num and $rows passed by reference + +# args: $num and $rows passed by reference sub smart_output { eval $start if $b_log; my ($type,$smart_data,$row,$j,$num,$rows) = @_; @@ -9336,7 +12861,7 @@ sub smart_output { } elsif ($type eq 'age'){$key = 'Old-Age';} elsif ($type eq 'fail'){$key = 'Pre-Fail';} - $$rows[$j]->{main::key($$num++,1,$l,$key)} = $support; + $rows->[$j]{main::key($$num++,1,$l,$key)} = $support; $b_found = 1; next if $type eq 'basic'; } @@ -9351,25 +12876,26 @@ sub smart_output { ($p,$m) = ($p_h,$m_h); } } - $$rows[$j]->{main::key($$num++,$p,$m,$smart_data->[$i][1])} = $row->{$smart_data->[$i][0]}; + $rows->[$j]{main::key($$num++,$p,$m,$smart_data->[$i][1])} = $row->{$smart_data->[$i][0]}; } } eval $end if $b_log; } -sub disk_data { +sub drive_data { eval $start if $b_log; my ($type) = @_; - my (@rows,@data,@devs); + my ($data,@devs); my $num = 0; my ($used) = (0); - PartitionData::partition_data() if !$b_partitions; - RaidData::raid_data() if !$b_raid; + 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 used, also, some cases mount - # panfs is parallel NAS volume manager, need more data - next if ($row->{'fs'} && $row->{'fs'} =~ /cifs|iso9660|nfs|panfs|sshfs|smbfs|unionfs/); - # don't count zfs or file type swap + # 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]+$/); @@ -9377,38 +12903,39 @@ sub disk_data { # 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) ){ + 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); + $data = proc_data($used); } else { - @data = dmesg_boot_data($used); + $data = bsd_data($used); } if ($b_admin){ - if ( $alerts{'smartctl'} && $alerts{'smartctl'}->{'action'} eq 'use'){ - @data = smartctl_data(\@data); + if ($alerts{'smartctl'} && $alerts{'smartctl'}->{'action'} eq 'use'){ + smartctl_data($data); } else { - $smartctl_missing = $alerts{'smartctl'}->{'missing'}; + $smartctl_missing = $alerts{'smartctl'}->{'message'}; } } - print Data::Dumper::Dumper \@data if $test[13];; + print Data::Dumper::Dumper $data if $dbg[13]; main::log_data('data',"used: $used") if $b_log; eval $end if $b_log; - return @data; + return $data; } + sub proc_data { eval $start if $b_log; my ($used) = @_; - my (@data,@drives); + my (@drives); my ($b_hdx,$logical_size,$size) = (0,0,0); - main::set_proc_partitions() if !$bsd_type && !$b_proc_partitions; + 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]+)$/) { + 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' => '', @@ -9426,7 +12953,7 @@ sub proc_data { } # 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 ) { + # if ($row->[0] =~ /^(3|22|33|8)$/ && $row->[1] % 16 == 0) { # $size += $row->[2]; # } # special case from this data: 8 0 156290904 sda @@ -9437,9 +12964,9 @@ sub proc_data { # 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]+)$/) ) { + 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]; } } @@ -9451,29 +12978,29 @@ sub proc_data { } # print Data::Dumper::Dumper \@drives; main::log_data('data',"size: $size") if $b_log; - @data = ({ + my $result = [{ 'logical-size' => $logical_size, 'logical-free' => $raw_logical[2], 'size' => $size, 'used' => $used, - }); - #print Data::Dumper::Dumper \@data; + }]; + # print Data::Dumper::Dumper \@data; if ($show{'disk'}){ - unshift(@drives,@data); + unshift(@drives,@$result); # print 'drives:', Data::Dumper::Dumper \@drives; - @data = proc_data_advanced($b_hdx,\@drives); + $result = proc_data_advanced($b_hdx,\@drives); } - main::log_data('dump','@data',\@data) if $b_log; - print Data::Dumper::Dumper \@data if $test[24]; + main::log_data('dump','@$result',$result) if $b_log; + print Data::Dumper::Dumper $result if $dbg[24]; eval $end if $b_log; - return @data; + return $result; } sub proc_data_advanced { eval $start if $b_log; my ($b_hdx,$drives) = @_; my ($i) = (0); - my (@data,@disk_data,@rows,@scsi,@temp,@working); + my ($disk_data,$scsi,@temp,@working); my ($pt_cmd) = ('unset'); my ($block_type,$file,$firmware,$model,$path, $partition_scheme,$serial,$vendor,$working_path); @@ -9492,24 +13019,24 @@ sub proc_data_advanced { 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){ + if ($drives->[$i]{'id'} =~ /^hd[a-z]/ && -e $file){ $model = main::reader($file,'strip',0); $drives->[$i]{'model'} = $model; } } } # scsi stuff - if ($file = main::system_files('scsi')){ - @scsi = scsi_data($file); + 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; + # 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/"; @@ -9526,18 +13053,20 @@ sub proc_data_advanced { $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/"){ - my @working = block_data($drives->[$i]{'id'}); - $drives->[$i]{'block-logical'} = $working[0]; - $drives->[$i]{'block-physical'} = $working[1]; + ($drives->[$i]{'block-logical'},$drives->[$i]{'block-physical'}) = @{block_data($drives->[$i]{'id'})}; } - if ($block_type && @scsi && @by_id && ! -e "${working_path}model" && ! -e "${working_path}name"){ + 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){ + foreach my $row (@$scsi){ if ($row->{'model'}){ $row->{'model'} = (split(/\s*-\s*/,$row->{'model'}))[0]; foreach my $id (@by_id){ @@ -9553,10 +13082,10 @@ sub proc_data_advanced { } # 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){ + 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){ + if (-r $path){ $model = main::reader($path,'strip',0); $drives->[$i]{'model'} = $model if $model; } @@ -9566,20 +13095,22 @@ sub proc_data_advanced { $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]; + 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::disk_cleaner($drives->[$i]{'model'}); - my @device_data = device_vendor($drives->[$i]{'model'},''); - $drives->[$i]{'model'} = $device_data[1] if $device_data[1]; - $drives->[$i]{'vendor'} = $device_data[0] if $device_data[0]; + 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"; - $drives->[$i]{'type'} = 'Removable' if -r $path && main::reader($path,'strip',0); # 0/1 value + 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 @@ -9588,24 +13119,25 @@ sub proc_data_advanced { if ($extra > 0){ $drives->[$i]{'temp'} = hdd_temp("$drives->[$i]{'id'}"); if ($extra > 1){ - my @speed_data = device_speed($drives->[$i]{'id'}); - $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]; + 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){ + if (-r $path){ $serial = main::reader($path,'strip',0); $drives->[$i]{'serial'} = $serial if $serial; } } - if ($extra > 2 && !$drives->[$i]{'firmware'} ){ + 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){ + if (-r $path){ $drives->[$i]{'firmware'} = main::reader($path,'strip',0); last; } @@ -9614,124 +13146,117 @@ sub proc_data_advanced { } } if ($extra > 2){ - @data = disk_data_advanced($pt_cmd,$drives->[$i]{'id'}); - $pt_cmd = $data[0]; - $drives->[$i]{'partition-table'} = uc($data[1]) if $data[1]; - if ($data[2]){ - $drives->[$i]{'rotation'} = "$data[2] rpm"; - $drives->[$i]{'drive-type'} = 'HDD'; + 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 (($drives->[$i]{'model'} && $drives->[$i]{'model'} =~ /(ssd|flash|nvme|mmc|\bm[\.-]?2\b)/i) || - ($block_type && ($block_type eq 'mmc' || $block_type eq 'nvme')) || - # note: this last case could conceivabley be wrong for a spun down HDD - (defined $data[2] && $data[2] eq '0') ){ - $drives->[$i]{'drive-type'} = 'SSD'; + 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'; } } } - # print Data::Dumper::Dumper $drives; + main::log_data('dump','$drives',$drives) if $b_log; + print Data::Dumper::Dumper $drives if $dbg[24]; eval $end if $b_log; - return @$drives; + return $drives; } + # camcontrol identify <device> |grep ^serial (this might be (S)ATA specific) # smartcl -i <device> |grep ^Serial # see smartctl; camcontrol devlist; gptid status; -sub dmesg_boot_data { +sub bsd_data { eval $start if $b_log; my ($used) = @_; - my (@data,@drives,@temp); - my ($id_holder,$i,$size,$working) = ('',0,0,0); - my $file = main::system_files('dmesg-boot'); - if (@dm_boot_disk){ - foreach (@dm_boot_disk){ - my @row = split(/:\s*/, $_); - next if ! defined $row[1]; - if ($id_holder ne $row[0]){ - $i++ if $id_holder; - # print "$i $id_holder $row[0]\n"; - $id_holder = $row[0]; - } - # no dots, note: ada2: 2861588MB BUT: ada2: 600.000MB/s - if (! exists $drives[$i]){ - $drives[$i]->{'id'} = $row[0]; - $drives[$i]->{'firmware'} = ''; - $drives[$i]->{'temp'} = ''; - $drives[$i]->{'type'} = ''; - $drives[$i]->{'vendor'} = ''; - } - #print "$i\n"; - if ($bsd_type eq 'openbsd'){ - if ($row[1] =~ /(^|,\s*)([0-9\.]+[MGTPE][B]?),.*\ssectors$|^</){ - $working = main::translate_size($2); - $size += $working if $working; - $drives[$i]->{'size'} = $working; - } - if ($row[2] && $row[2] =~ /<([^>]+)>/){ - $drives[$i]->{'model'} = $1 if $1; - $drives[$i]->{'type'} = 'removable' if $_ =~ /removable$/; - # <Generic-, Compact Flash, 1.00> - my $count = ($drives[$i]->{'model'} =~ tr/,//); - if ($count && $count > 1){ - @temp = split(/,\s*/, $drives[$i]->{'model'}); - $drives[$i]->{'model'} = $temp[1]; - } - } - # print "openbsd\n"; - } - else { - if ($row[1] =~ /^([0-9]+[KMGTPE][B]?)\s/){ - $working = main::translate_size($1); - $size += $working if $working; - $drives[$i]->{'size'} = $working; - } - if ($row[1] =~ /device$|^</){ - $row[1] =~ s/\sdevice$//g; - $row[1] =~ /<([^>]*)>\s(.*)/; - $drives[$i]->{'model'} = $1 if $1; - $drives[$i]->{'spec'} = $2 if $2; - } - if ($row[1] =~ /^Serial\sNumber\s(.*)/){ - $drives[$i]->{'serial'} = $1; - } - if ($row[1] =~ /^([0-9\.]+[MG][B]?\/s)/){ - $drives[$i]->{'speed'} = $1; - $drives[$i]->{'speed'} =~ s/\.[0-9]+// if $drives[$i]->{'speed'}; - } + 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'}; } - $drives[$i]->{'model'} = main::disk_cleaner($drives[$i]->{'model'}); - my @device_data = device_vendor($drives[$i]->{'model'},''); - $drives[$i]->{'vendor'} = $device_data[0] if $device_data[0]; - $drives[$i]->{'model'} = $device_data[1] if $device_data[1]; + $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::row_defaults('data-bsd'); + $size = main::message('data-bsd'); } } - elsif ( $file && ! -r $file ){ - $size = main::row_defaults('dmesg-boot-permissions'); - } - elsif (!$file ){ - $size = main::row_defaults('dmesg-boot-missing'); - } - @data = ({ + 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(@data,@drives); - # print 'drives:', Data::Dumper::Dumper \@drives; + }]; + #main::log_data('dump','$data',\@data) if $b_log; + if ($show{'disk'}){ + push(@$result,@drives); + # print 'data:', Data::Dumper::Dumper \@data; } - # print 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 @data; + 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 + my $data = [ + [ # age ['smart-gsense-error-rate-ar','g-sense error rate'], ['smart-media-wearout-a','media wearout'], ['smart-media-wearout-t','threshold'], @@ -9810,41 +13335,48 @@ sub smartctl_fields { ['smart-unknown-5-w','worst'], ['smart-unknown-5-t','threshold'], ['smart-unknown-5-f','alert'], - ]); + ] + ]; eval $end if $b_log; - return @data; + 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 threashold, etc + 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"; + # 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'); + @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 $test[12]; - if (scalar @result < 4 ){ + 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::row_defaults('tool-permissions','smartctl'); + $data->[$i]{'smart-permissions'} = main::message('tool-permissions','smartctl'); } elsif (grep {/unknown usb bridge/i} @result){ - $data->[$i]{'smart-error'} = main::row_defaults('smartctl-usb'); + $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::row_defaults('smartctl-command-failed'); + $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::row_defaults('tool-unknown-error','smartctl'); + $data->[$i]{'smart-error'} = main::message('tool-unknown-error','smartctl'); } next; } @@ -9866,20 +13398,34 @@ sub smartctl_data { $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 + # usb/firewire/thunderbolt enclosure id method if ($data->[$i]{'type'}){ - @working = device_vendor("$split[$r]"); - $data->[$i]{'drive-model'} = $working[1] if $data->[$i]{'model'} && $data->[$i]{'model'} ne $working[1]; - $data->[$i]{'drive-vendor'} = $working[0] if $data->[$i]{'vendor'} && $data->[$i]{'vendor'} ne $working[0]; + 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'){ - @working = device_vendor("$split[$r]"); - $data->[$i]{'family'} = $working[1]; + 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'){ @@ -9894,14 +13440,15 @@ sub smartctl_data { elsif ($split[$a] eq 'Rotation Rate'){ if ($split[$r] !~ /^Solid/){ $data->[$i]{'rotation'} = $split[$r]; - $data->[$i]{'drive-type'} = 'HDD'; + $data->[$i]{'rotation'} =~ s/\s*rpm$//i; + $data->[$i]{'tech'} = 'HDD'; } else { - $data->[$i]{'drive-type'} = 'SSD'; + $data->[$i]{'tech'} = 'SSD'; } } elsif ($split[$a] eq 'Serial Number'){ - if ( !$data->[$i]{'serial'}){ + if (!$data->[$i]{'serial'}){ $data->[$i]{'serial'} = $split[$r]; } elsif ($data->[$i]{'type'} && $split[$r] ne $data->[$i]{'serial'}){ @@ -9909,15 +13456,15 @@ sub smartctl_data { } } elsif ($split[$a] eq 'SATA Version is'){ - if ( $split[$r] =~ /SATA ([0-9.]+), ([0-9.]+ [^\s]+)( \(current: ([1-9.]+ [^\s]+)\))?/){ + 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 - 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| ){ + # 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; } @@ -9934,11 +13481,11 @@ sub smartctl_data { $data->[$i]{'smart'} = $1; $data->[$i]{'smart'} = ($data->[$i]{'smart'} eq 'Unavailable') ? 'no' : 'yes'; } - elsif ($split[$r] =~ /^(Enabled|Disabled)/ ){ + elsif ($split[$r] =~ /^(Enabled|Disabled)/){ $data->[$i]{'smart-support'} = lc($1); } } - elsif ($split[$a] eq 'SMART overall-health self-assessment test result' ){ + 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'}; @@ -9946,7 +13493,7 @@ sub smartctl_data { ## 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' ){ + 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' || @@ -9974,8 +13521,8 @@ sub smartctl_data { } # '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' ) { + 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]; } @@ -10012,17 +13559,20 @@ sub smartctl_data { 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 - else { + elsif ($data->[$i]{'block-logical'}) { $split[$r] = int($data->[$i]{'block-logical'} * $split[$r] / 1024); } - $data->[$i]{'smart-read'} = main::get_size($split[$r],'string'); + 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])){ + if (main::is_numeric($split[$r]) && $data->[$i]{'block-logical'}){ # blocks in bytes, so convert to KiB, the internal unit here - # reports in 32MoB units, sigh + # reports in 32MiB units, sigh if ($b_intel){ $split[$r] = $split[$r] * 32 * 1024; } @@ -10030,11 +13580,14 @@ sub smartctl_data { 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 - else { + elsif ($data->[$i]{'block-logical'}) { $split[$r] = int($data->[$i]{'block-logical'} * $split[$r] / 1024); } - $data->[$i]{'smart-written'} = main::get_size($split[$r],'string'); + if ($b_intel || $b_kingston || $data->[$i]{'block-logical'}){ + $data->[$i]{'smart-written'} = main::get_size($split[$r],'string'); + } } } ## DEVICE OLD AGE ## @@ -10047,7 +13600,7 @@ sub smartctl_data { } elsif ($split[$a] eq 'Media_Wearout_Indicator'){ # $data->[$i]{'smart-media-wearout'} = $split[$r]; - # seen case where they used hex numbers becaause values + # 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){ @@ -10058,7 +13611,7 @@ sub smartctl_data { } elsif ($split[$a] eq 'Multi_Zone_Error_Rate'){ # note: all t values are 0 that I have seen - if ( ($split[$v] - $split[$t]) < 50){ + if (($split[$v] - $split[$t]) < 50){ $data->[$i]{'smart-multizone-errors-av'} = $split[$v]; $data->[$i]{'smart-multizone-errors-t'} = $split[$v]; } @@ -10067,7 +13620,7 @@ sub smartctl_data { 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::row_defaults('smartctl-udma-crc') if $split[$r] > 500; + $data->[$i]{'smart-udma-crc-errors-f'} = main::message('smartctl-udma-crc') if $split[$r] > 500; } } @@ -10087,7 +13640,7 @@ sub smartctl_data { } elsif ($split[$a] eq 'Available Spare Threshold'){ $split[$r] =~ s/%$//; - if ($holder{'spare'} && main::is_numeric($split[$r]) && $split[$r]/$holder{'spare'} > 0.92 ){ + 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]); } @@ -10122,7 +13675,7 @@ sub smartctl_data { } } elsif ($split[$a] eq 'Runtime_Bad_Block'){ - if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92 ){ + 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 '-'; @@ -10130,7 +13683,7 @@ sub smartctl_data { } 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 ){ + 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 '-'; @@ -10138,7 +13691,7 @@ sub smartctl_data { } 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 ){ + 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 '-'; @@ -10146,7 +13699,7 @@ sub smartctl_data { } 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 ){ + 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 '-'; @@ -10154,7 +13707,7 @@ sub smartctl_data { } 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 ){ + 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 '-'; @@ -10162,15 +13715,15 @@ sub smartctl_data { } 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 ){ + 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 ))) { + 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]; @@ -10182,9 +13735,8 @@ sub smartctl_data { } } } - print Data::Dumper::Dumper $data if $test[19]; + print Data::Dumper::Dumper $data if $dbg[19]; eval $end if $b_log; - return @$data; } # check for usb/firewire/[and thunderbolt when data found] @@ -10194,9 +13746,9 @@ sub peripheral_data { my ($type) = (''); # print "$id here\n"; if (@by_id){ - foreach (@by_id) { + foreach (@by_id){ if ("/dev/$id" eq Cwd::abs_path($_)){ - #print "$id here\n"; + # print "$id here\n"; if (/usb-/i){ $type = 'USB'; } @@ -10209,7 +13761,7 @@ sub peripheral_data { } # 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) { + foreach (@by_path){ if ("/dev/$id" eq Cwd::abs_path($_)){ if (/usb-/i){ $type = 'USB'; @@ -10224,32 +13776,34 @@ sub peripheral_data { 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,@return); + my ($cmd,$pt,$program,@data); + my $advanced = []; if ($set_cmd ne 'unset'){ - $return[0] = $set_cmd; + $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')){ - $return[0] = "$program info -q property -n "; + $advanced->[0] = "$program info -q property -n "; } - elsif ($b_root && -e "/lib/udev/udisks-part-id") { - $return[0] = "/lib/udev/udisks-part-id /dev/"; + 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'))) { - $return[0] = "$program -l /dev/"; + elsif ($b_root && ($program = main::check_program('fdisk'))){ + $advanced->[0] = "$program -l /dev/"; } - if (!$return[0]) { - $return[0] = 'na' + if (!$advanced->[0]){ + $advanced->[0] = 'na' } } - if ($return[0] ne 'na'){ - $cmd = "$return[0]$id 2>&1"; + 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 @@ -10257,39 +13811,40 @@ sub disk_data_advanced { if ($cmd =~ /fdisk/){ foreach (@data){ if (/^WARNING:\s+GPT/){ - $return[1] = 'gpt'; + $advanced->[1] = 'gpt'; last; } elsif (/^Disklabel\stype:\s*(.+)/i){ - $return[1] = $1; + $advanced->[1] = $1; last; } } - $return[1] = 'dos' if !$return[1]; + $advanced->[1] = 'dos' if !$advanced->[1]; } else { foreach (@data){ - if ( /^(UDISKS_PARTITION_TABLE_SCHEME|ID_PART_TABLE_TYPE)/ ){ + if (/^(UDISKS_PARTITION_TABLE_SCHEME|ID_PART_TABLE_TYPE)/){ my @working = split('=', $_); - $return[1] = $working[1]; + $advanced->[1] = $working[1]; } elsif (/^ID_ATA_ROTATION_RATE_RPM/){ my @working = split('=', $_); - $return[2] = $working[1]; + $advanced->[2] = $working[1]; } - last if defined $return[1] && defined $return[2]; + last if defined $advanced->[1] && defined $advanced->[2]; } } - $return[1] = 'mbr' if $return[1] && lc($return[1]) eq 'dos'; + $advanced->[1] = 'mbr' if $advanced->[1] && lc($advanced->[1]) eq 'dos'; } eval $end if $b_log; - return @return; + return $advanced; } + sub scsi_data { eval $start if $b_log; my ($file) = @_; my @temp = main::reader($file); - my (@scsi); + my $scsi = []; my ($firmware,$model,$vendor) = ('','',''); foreach (@temp){ if (/Vendor:\s*(.*)\s+Model:\s*(.*)\s+Rev:\s*(.*)/i){ @@ -10299,7 +13854,7 @@ sub scsi_data { } if (/Type:/i){ if (/Type:\s*Direct-Access/i){ - push(@scsi, { + push(@$scsi, { 'vendor' => $vendor, 'model' => $model, 'firmware' => $firmware, @@ -10310,20 +13865,20 @@ sub scsi_data { } } } - main::log_data('dump','@scsi', \@scsi) if $b_log; + main::log_data('dump','@$scsi', $scsi) if $b_log; eval $end if $b_log; - return @scsi; + 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); + my $disk_data = []; foreach (@by_id){ if ($device eq Cwd::abs_path($_)){ my @data = split('_', $_); - my @device_data; last if scalar @data < 2; # scsi-3600508e000000000876995df43efa500 $serial = pop @data if @data; # usb-PNY_USB_3.0_FD_3715202280-0:0 @@ -10331,406 +13886,650 @@ sub disk_data_by_id { $model = join(' ', @data); # get rid of the ata-|nvme-|mmc- etc $model =~ s/^\/dev\/disk\/by-id\/([^-]+-)?//; - $model = main::disk_cleaner($model); - @device_data = device_vendor($model,$serial); - $vendor = $device_data[0] if $device_data[0]; - $model = $device_data[1] if $device_data[1]; + $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); + @$disk_data = ($model,$vendor,$serial); last; } } eval $end if $b_log; - return @disk_data; + return $disk_data; } + +## START DISK VENDOR BLOCK ## # 0 - match pattern; 1 - replace pattern; 2 - vendor print; 3 - serial pattern -sub set_vendors { +sub set_disk_vendors { eval $start if $b_log; - @vendors = ( + $vendors = [ ## MOST LIKELY/COMMON MATCHES ## - ['(Crucial|^(FC)?CT|-CT|^M4\b|Gizmo!|^((C300-)?CTF[\s-]?)?DDAC)','Crucial','Crucial',''], + ['(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))','\bINTEL\b','Intel',''], - # note: S[AV][1-9][0-9] can trigger false positives - ['(KINGSTON|DataTraveler|DT\s?(DUO|Microduo|101)|^RBU|^SMS|^SHS|^SS0|^SUV|^T52|^T[AB]29|^Ultimate CF|HyperX|^S[AV][1234]00|^SKYMEDI|13fe\b)','KINGSTON','Kingston',''], # maybe SHS: SHSS37A SKC SUV + ['(\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|^(OM8P|RBU|S[AV][1234]00|S[HMN]S|SK[CY]|SQ5|SS200|SVP|SS0|SUV|SNV|T52|T[AB]29|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 - ['(SAMSUNG|^MCG[0-9]+GC|^MCC|^MCBOE|\bEVO\b|^[GS]2 Portable|^DS20|^[DG]3 Station|^DUO\b|^P3|^[BC]GN|^[CD]JN|^BJ[NT]|^[BC]WB|^(HM|SP)[0-9]{2}|^MZMPC|^HD[0-9]{3}[A-Z]{2}$|SV[0-9]|E[A-Z][1-9]QT|YP\b)','SAMSUNG','Samsung',''], # maybe ^SM, ^HM - # Android UMS Composite? - ['(SanDisk|^SDS[S]?[DQ]|^D[AB]4|^SL([0-9]+)G|^AFGCE|^ABLCD|^SDW[1-9]|^SEM[1-9]|^U3\b|^SU[0-9]|^DX[1-9]|ULTRA\s(FIT|trek)|Clip Sport|Cruzer|^Extreme|iXpand)','SanDisk','SanDisk',''], + # HM320II HM320II HM + ['(SAMSUNG|^(AWMB|[BC]DS20|[BC]WB|BJ[NT]|[BC]GND|CJ[NT]|CKT|CUT|[DG]3 Station|DUO\b|DUT|EB\dMW|E[CS]\d[A-Z]\d|FD\d[A-Z]\dGE4S5|[GS]2 Portable|GN|HD\d{3}[A-Z]{2}$|(HM|SP)\d{2}|HS\d|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|Firebird|S[CD]\d{2}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]|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[^T]|[S]?SEAGATE|^X[AFP]|^5AS|^BUP|Expansion Desk|^Expansion|FreeAgent|GoFlex|Backup(\+|\s?Plus)\s?(Hub)?|OneTouch|Slim\s? BK)','[S]?SEAGATE','Seagate',''], - ['^(WD|WL[0]9]|Western Digital|My (Book|Passport)|\d*LPCX|Elements|easystore|MD0|M000|EARX|EFRX|\d*EAVS|0JD|JP[CV]|[0-9]+(BEV|(00)?AAK|AAV|AZL|EA[CD]S)|3200[AB]|2500[BJ]|EA[A-Z]S|20G2|5000[AB]|6400[AB]|7500[AB]|i HTS|00[ABL][A-Z]{2})','(^WDC|Western\s?Digital)','Western Digital',''], + # 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)','','Western Digital',''], - ## THEN BETTER KNOWN ONESs ## - ['^(A-?DATA|AX[MN]|CH11|HV[1-9]|IM2|HD[1-9]|HDD\s?CH|IUM)','^A-?DATA','A-Data',''], - ['^ASUS','^ASUS','ASUS',''], + ['(\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))','^surge Corsair','Corsair',''], - ['^(FUJITSU|MJA|MH[TVWYZ][0-9]|MP|MAP[0-9])','^FUJITSU','Fujitsu',''], + ['^(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[0-9])','^(HP\b|FUJITSU)','Fujitsu/HP',''], + ['^(MAB\d)','^(HP\b|FUJITSU)','Fujitsu/HP',''], # note: 2012: wdc bought hgst - ['^(HGST|Touro|54[15]0|7250)','^HGST','HGST (Hitachi)',''], # HGST HUA - ['^(Hitachi|HCS|HD[PST]|DK[0-9]|IC|HT|HU|HMS|HDE|0G[0-9])','^Hitachi','Hitachi',''], + ['^(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|[MV]B[0-6]|G[BJ][0-9]|DF[0-9]|F[BK]|0-9]|PSS|XR[0-9]{4}|c350|v[0-9]{3}[bgorw]$|x[0-9]{3}[w]$)','^HP','HP',''], - ['^(Lexar|LSD|JumpDrive|JD\s?Firefly|WorkFlow)','^Lexar','Lexar',''], # mmc-LEXAR_0xb016546c; JD Firefly; + ['^(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|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|APOC|D2|DEN|DEN|DRSAK|EC188|FTNC|GFGC|MANG|MMOC|NIMC|NIMR|PSIR|RALLY2|TALOS2|TMSC|TRSAK)','^OCZ[\s-]','OCZ',''], - ['^OWC','^OWC\b','OWC',''], + ['^(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)','^PNY\s','PNY','','^PNY'], + ['^(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 - ['(^[S]?TOS|^THN|TOSHIBA|TransMemory|^M[GKQ][0-9]|KBG4)','[S]?TOSHIBA','Toshiba',''], # scsi-STOSHIBA_STOR.E_EDITION_ + # 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 - ['^(AbonMax|ASU[0-9])','^AbonMax','AbonMax',''], + ['^(Aar(vex)?|AX\d{2})','^AARVEX','AARVEX',''], + ['^(AbonMax|ASU\d)','^AbonMax','AbonMax',''], ['^Acasis','^Acasis','Acasis (hub)',''], ['^Acclamator','^Acclamator','Acclamator',''], - ['^(Actions|HS USB Flash)','^Actions','Actions',''], + ['^(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',''], + ['^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',''], ['^Alcatel','^Alcatel','Alcatel',''], + ['^(Alcor(\s?Micro)?|058F)','^(Alcor(\s?Micro)?|058F)','Alcor Micro',''], ['^Alfawise','^Alfawise','Alfawise',''], - ['^Android','^Android','Android',''], + ['(^ALKETRON|FireWizard)','^ALKETRON','ALKETRON',''], ['^ANACOMDA','^ANACOMDA','ANACOMDA',''], + ['^Android','^Android','Android',''], + ['^ANK','^Anker','Anker',''], + ['^Ant[\s_-]?Esports','^Ant[\s_-]?Esports','Ant Esports',''], + ['^Anucell','^Anucell','Anucell',''], ['^Apotop','^Apotop','Apotop',''], # must come before AP|Apacer - ['^(APPLE|iPod)','^APPLE','Apple',''], + ['^(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',''], ['^(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',''], - ['^BHT','^BHT','BHT',''], - ['^(Big\s?Reservoir|BG\b)','^Big\s?Reservoir','Big Reservoir',''], + ['^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',''], - ['^(MyDigitalSSD|BP4)','^MyDigitalSSD','MyDigitalSSD',''], # BP4 = BulletProof4 + ['^(BlitzWolf|BW-?PSSD)','^BlitzWolf','BlitzWolf',''], + ['^(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',''], - ['^(STMicro|SMI|CBA)','^(STMicroelectronics|SMI)','SMI (STMicroelectronics)',''], ['^(Canon|MP49)','^Canon','Canon',''], ['^Centerm','^Centerm','Centerm',''], ['^(Centon|DS pro)','^Centon','Centon',''], + ['^(CFD|CSSD)','^CFD','CFD',''], + ['^CHIPAL','^CHIPAL','CHIPAL',''], ['^(Chipsbank|CHIPSBNK)','^Chipsbank','Chipsbank',''], - ['^CHN\b','','Zheino',''], + ['^(Chipfancie)','^Chipfancier','Chipfancier',''], ['^Clover','^Clover','Clover',''], ['^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',''], ['^DIGITAL\s?FILM','DIGITAL\s?FILM','Digital Film',''], + ['^(Digma|Run(\sY2)?\b)','^Digma','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|Shark)','^Dogfish(\s*Technology)?','Dogfish Technolgy',''], + ['^(Dogfish|M\.2 2242|Shark)','^Dogfish(\s*Technology)?','Dogfish Technology',''], ['^DragonDiamond','^DragonDiamond','DragonDiamond',''], - ['^DREVO\b','^DREVO','Drevo',''], + ['^(DREVO\b|X1\s\d+[GT])','^DREVO','Drevo',''], + ['^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)','^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',''], + ['^EVM','^EVM','EVM',''], + ['^eVtran','^eVtran','eVtran',''], # 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',''], - ['^Faspeed','^Faspeed','Faspeed',''], + ['^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',''], ['^Fordisk','^Fordisk','Fordisk',''], # FK0032CAAZP/FB160C4081 FK or FV can be HP but can be other things - ['^FORESEE','^FORESEE','ForeseSU04Ge',''], + ['^(FORESEE|B[123]0)|P900F|S900M','^FORESEE','Foresee',''], + ['^Founder','^Founder','Founder',''], ['^(FOXLINE|FLD)','^FOXLINE','Foxline',''], # russian vendor? - ['^(GALAX\b|Gamer\s?L)','^GALAX','GALAX',''], + ['^(Gateway|W800S)','^Gateway','Gateway',''], + ['^Freecom','^Freecom(\sFreecom)?','Freecom',''], + ['^(FronTech)','^FronTech','Frontech',''], + ['^(Fuhler|FL-D\d{3})','^Fuhler','Fuhler',''], + ['^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',''], - ['^(Generic|UY[67])','^Generic','Generic',''], - ['^Gigabyte','^Gigabyte','Gigabyte',''], # SSD + ['^GelL','^GelL','GelL',''], # typo for Geil? GelL ZENITH R3 120GB + ['^(Generic|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',''], + ['^Getrich','^Getrich','Getrich',''], + ['^(Gigabyte|GP-G)','^Gigabyte','Gigabyte',''], # SSD ['^Gigastone','^Gigastone','Gigastone',''], - ['^Gloway','^Gloway','Gloway',''], + ['^Gigaware','^Gigaware','Gigaware',''], + ['^GJN','^GJN\b','GJN',''], + ['^(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\s*)?(GOODRAM|GOODDRIVE|IR[\s-]?SSD|IRP|SSDPR)','^GOODRAM','GOODRAM',''], + ['^((Wilk|WE)\s*)?(GOODRAM|GOODDRIVE|IR[\s-]?SSD|IRP|SSDPR|Iridium)','^GOODRAM','GOODRAM',''], + ['^(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-]*Technology','G-Technology',''], + ['^G[\s-]*Tech','^G[\s-]*Tech(nology)?','G-Technology',''], + ['^(Gudga|GIM\d+|G[NV](R\d|\d{2,4}\b))','^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',''], ['^(Hikvision|HKVSN|HS-SSD)','^Hikvision','Hikvision',''], + ['^Hi[\s-]?Level ','^Hi[\s-]?Level ','Hi-Level',''], # ^HI\b with no Level? + ['^(Hisense|H8G)','^Hisense','Hisense',''], ['^Hoodisk','^Hoodisk','Hoodisk',''], - ['^HUAWEI','^HUAWEI','Huawei',''], + ['^(HUAWEI|HWE)','^HUAWEI','Huawei',''], + ['^Hypertec','^Hypertec','Hypertec',''], ['^HyperX','^HyperX','HyperX',''], - ['^Hyundai','^Hyundai','Hyundai',''], - ['^(IBM|DT|ESA[1-9])','^IBM','IBM',''], + ['^(HYSSD|HY-)','^HYSSD','HYSSD',''], + ['^(Hyundai|C2S\d|Sapphire)','^Hyundai','Hyundai',''], + ['^iMRAM','^iMRAM','iMRA',''], + ['^(IBM|DT|ESA[1-9]|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)','^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|Innolite)','^InnoDisk( Corp.)?','InnoDisk',''], - ['^Innostor','^Innostor','Innostor',''], - ['^Innovation','^Innovation(\s*IT)?','Innovation IT',''], + ['^(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|Mobile|Rainbow|Speed|Twister|Ultra) Line|Rainbow)','^Intenso','Intenso',''], + ['^(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',''], + ['^(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 + ['^JSYERA','^JSYERA','Jsyera',''], + ['^(Jual|RX7)','^Jual','Jual',''], + ['^(J\.?ZAO|JZ)','^J\.?ZAO','J.ZAO',''], + ['^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',''], - ['^(KingDian|NGF)','^KingDian','KingDian',''], - ['^Kingfast','^Kingfast','Kingfast',''], + ['^(KINGCOMP|KCSSD)','^KINGCOMP','KingComp',''], + ['(KingDian|^NGF|S(280|400))','KingDian','KingDian',''], + ['^(Kingfast|TYFS)','^Kingfast','Kingfast',''], ['^KingMAX','^KingMAX','KingMAX',''], - ['^Kingrich','^Kingrich','KingrSU04Gich',''], - ['^KING\s?SHARE','^KING\s?SHARE','KingShare',''], - ['^(KingSpec|ACSC|KS[DQ]|NT-[0-9]|P4\b|PA18)','^KingSpec','KingSpec',''], + ['^Kingrich','^Kingrich','Kingrich',''], + ['^Kingsand','^Kingsand','Kingsand',''], + ['KING\s?SHA\s?RE','KING\s?SHA\s?RE','KingShare',''], + ['^(KingSpec|ACSC|C3000|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',''], - ['(KIOXIA|^K[BX]G[0-9])','KIOXIA','KIOXIA',''], # company name comes after product ID - ['^KLEVV','^KLEVV','KLEVV',''], - ['^Kodak','^Kodak','Kodak',''], + ['^Kingwin','^Kingwin','Kingwin',''], + ['^KLLISRE','^KLLISRE','KLLISRE',''], + ['(KIOXIA|^K[BX]G\d)','KIOXIA','KIOXIA',''], # company name comes after product ID + ['^(KLEVV|NEO\sN|CRAS)','^KLEVV','KLEVV',''], + ['^(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',''], # LENSE30512GMSP34MEAT3TA / UMIS RPITJ256PED2MWX - ['^(LEN|UMIS)','^Lenovo','Lenovo',''], + ['^(LEN|UMIS|Think)','^Lenovo','Lenovo',''], ['^RPFT','','Lenovo O.E.M.',''], - ['^LG\b','^LG','LG',''], - ['^(LITE[-\s]?ON[\s-]?IT)','^LITE[-]?ON[\s-]?IT','LITE-ON IT',''], # LITEONIT_LSS-24L6G - ['^(LITE[-\s]?ON|PH[1-9])','^LITE[-]?ON','LITE-ON',''], # PH6-CE240-L + # 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',''], - ['^(LSI|MegaRAID)','^LSI\b','LSI',''], + ['^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)','^Mach\s*Xtreme','Mach Xtreme',''], + ['^(Mach\s*Xtreme|MXSSD|MXU|MX[\s-])','^Mach\s*Xtreme','Mach Xtreme',''], + ['^(MacroVIP|MV(\d|GLD))','^MacroVIP','MacroVIP',''], # maybe MV alone + ['^Mainic','^Mainic','Mainic',''], + ['^(MARSHAL\b|MAL\d)','^MARSHAL','Marshal',''], + ['^Maxell','^Maxell','Maxell',''], ['^Maximus','^Maximus','Maximus',''], - ['^(MAXTOR|Atlas|TM[0-9]{4}|[KL]0[1-9]|Y[0-9]{3}[A-Z])','^MAXTOR','Maxtor',''], # note M2 M3 is usually maxtor, but can be samsung - ['^(Memorex|TravelDrive|TD\s?Classic)','^Memorex','Memorex',''], - # note: C300/400 can be either micron or crucial, but C400 is M4 from crucial - ['(^MT|^M5|^Micron|00-MT|C[34]00)','^Micron','Micron',''],# C400-MTFDDAK128MAM - ['^(MARSHAL\b|MAL[0-9])','^MARSHAL','Marshal',''], + ['^MAXIO','^MAXIO','Maxio',''], + ['^Maxmem','^Maxmem','Maxmem',''], + ['^Maxone','^Maxone','Maxone',''], ['^MARVELL','^MARVELL','Marvell',''], ['^Maxsun','^Maxsun','Maxsun',''], ['^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',''], ['^Medion','^Medion','Medion',''], - ['^(MEDIAMAX|WL[0-9]{2})','^MEDIAMAX','MediaMax',''], + ['^(MEDIAMAX|WL\d{2})','^MEDIAMAX','MediaMax',''], + ['^(Memorex|TravelDrive|TD\s?Classic)','^Memorex','Memorex',''], ['^Mengmi','^Mengmi','Mengmi',''], + ['^MicroFrom','^MicroFrom','MicroFrom',''], + ['^MGTEC','^MGTEC','MGTEC',''], + # must come before micron + ['^(Mtron|MSP)','^Mtron','Mtron',''], + # note: C300/400 can be either micron or crucial, but C400 is M4 from crucial + ['(^(Micron|2200[SV]|MT|M5|(\d+|[CM]\d+)\sMTF)|00-MT)','^Micron','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[0-9])','^Motile','Motile',''], - ['^(Motorola|XT[0-9]{4})','^Motorola','Motorola',''], + ['^(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',''], - ['^MTASE','^MTASE','MTASE',''], ['^MSI\b','^MSI\b','MSI',''], + ['^MTASE','^MTASE','MTASE',''], ['^MTRON','^MTRON','MTRON',''], - ['^(Neo\s*Forza|NFS[0-9])','^Neo\s*Forza','Neo Forza',''], - ['^Netac','^Netac','Netac',''], + ['^(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)','^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',''], + ['^Ortial','^Ortial','Ortial',''], ['^OSC','^OSC\b','OSC',''], - ['^OWC','^OWC\b','OWC',''], + ['^(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]|VPN|Viper)','^Patriot([-\s]?Memory)?','Patriot',''],#Viper M.2 VPN100 + ['^(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 - ['PHISON[\s-]?','PHISON[\s-]?','Phison',''],# E12-256G-PHISON-SSD-B3-BB1 + ['(PHISON[\s-]?|ESR\d|PSE)','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',''], - # PS3109S9 is the result of an error condition with ssd drive - ['QEMU','^[0-9]*QEMU( QEMU)?','QEMU',''], # 0QUEMU QEMU HARDDISK + ['^(-?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 ['(^Quantum|Fireball)','^Quantum','Quantum',''], - ['^QUMO','^QUMO','Qumo',''], - ['^(R3|AMD\s?(RADEON)?)','AMD\s?(RADEON)?','AMD Radeon',''], # ssd + ['(^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',''], + ['^(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',''], - ['^Sabrent','^Sabrent','Sabrent',''], + ['^Rundisk','^Rundisk','RunDisk',''], + ['^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',''], ['^SigmaTel','^SigmaTel','SigmaTel',''], # DIAMOND_040_GB - ['^(SILICON\s?MOTION|SM[0-9])','^SILICON\s?MOTION','Silicon Motion',''], + ['^(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)','\s?SK\s?HYNIX','SK Hynix',''], - ['(hynix|^HAG[0-9]|h[BC]8aP)','hynix','Hynix',''],# nvme middle of string, must be after sk hynix + ['(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',''], - ['^(S[FR]-|Sony)','^Sony','Sony',''], + ['^Solidata','^Solidata','Solidata',''], + ['^(SOLIDIGM|SSDPFK)','^SOLIDIGM\b','solidgm',''], + ['^(Sony|IM9|Microvalut|S[FR]-)','^Sony','Sony',''], + ['^SSK\b','^SSK','SSK',''], + ['^(SSSTC|CL1-)','^SSSTC','SSSTC',''], + ['^(SST|SG[AN])','^SST\b','SST',''], ['^STE[CK]','^STE[CK]','sTec',''], # wd bought this one - ['^STmagic','^STmagic','STmagic',''], ['^STORFLY','^STORFLY','StorFly',''], + ['\dSUN\d','^SUN(\sMicrosystems)?','Sun Microsystems',''], + ['^Sundisk','^Sundisk','Sundisk',''], ['^SUNEAST','^SUNEAST','SunEast',''], + ['^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[0-9]|PicoDrive|Teranova)','','Super Talent',''], + ['^(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','^TC[\s-]*SUNBOW','TCSunBow',''], - ['^(TDK|TF[1-9][0-9])','^TDK','TDK',''], + ['^(TC[\s-]*SUNBOW|X3\s\d+[GT])','^TC[\s-]*SUNBOW','TCSunBow',''], + ['^(TDK|TF[1-9]\d|LoR)','^TDK','TDK',''], ['^TEAC','^TEAC','TEAC',''], - ['^TEAM','^TEAM(\s*Group)?','TeamGroup',''], + ['^(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','^Timetec','Timetec',''], + ['^(Timetec|35TT)','^Timetec','Timetec',''], ['^TKD','^TKD','TKD',''], ['^TopSunligt','^TopSunligt','TopSunligt',''], # is this a typo? hard to know ['^TopSunlight','^TopSunlight','TopSunlight',''], ['^TOROSUS','^TOROSUS','Torosus',''], - ['^([F]?TS|Transcend|JetDrive|JetFlash|USDU)','^Transcend','Transcend',''], + ['(Transcend|^((SSD\s|F)?TS|ESD\d|EZEX|USDU)|1307|JetDrive|JetFlash)','\b(Transcend|1307)\b','Transcend',''], ['^(TrekStor|DS (maxi|pocket)|DataStation)','^TrekStor','TrekStor',''], - ['^(TwinMOS|TW[0-9])','^TwinMOS','TwinMOS',''], + ['^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',''], + ['^(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',''], - ['^(Verbatim|STORE N GO|Vi[1-9]|OTG\s?Tiny)','^Verbatim','Verbatim',''], - ['^V-GEN','^V-GEN','V-Gen',''], + ['^(Veno|Scorp)','^Veno','Veno',''], + ['^(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)','^Vaseky','Vaseky',''], # ata-Vseky_V880_350G_ + ['^(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',''], ['^Wellcomm','^Wellcomm','Wellcomm',''], + ['^(wicgtyp|[MN][V]?900)','^wicgtyp','wicgtyp',''], ['^Wilk','^Wilk','Wilk',''], + ['^(WinMemory|SWG\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',''], - ['^(XUM|HX[0-9])','^XUM','XUM',''], + ['^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',''], ['^(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',''], - ['^(Zheino|CHN[0-9]|CNM)','^Zheino','Zheino',''], + ['^ZEUSS','^ZEUSS','Zeuss',''], + ['^(Zheino|CHN|CNM)','^Zheino','Zheino',''], ['^(Zotac|ZTSSD)','^Zotac','Zotac',''], + ['^ZOZT','^ZOZT','ZOZT',''], ['^ZSPEED','^ZSPEED','ZSpeed',''], ['^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 device_vendor { +sub disk_vendor { eval $start if $b_log; my ($model,$serial) = @_; my ($vendor) = (''); - my (@data); return if !$model; - set_vendors() if !@vendors; # 0 - match pattern; 1 - replace pattern; 2 - vendor print; 3 - serial pattern - # Data URLs: inxi-resources.txt Section: DiskData device_vendor() + # Data URLs: inxi-resources.txt Section: DriveItem device_vendor() # $model = 'H10 HBRPEKNX0202A NVMe INTEL 512GB'; - # $model = 'Patriot Memory'; - foreach my $row (@vendors){ + # $model = 'SD Ultra 3D 1TB'; + 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? @@ -10744,39 +14543,38 @@ sub device_vendor { } $model =~ s/^[\/\[\s_-]+|[\/\s_-]+$//g; $model =~ s/\s\s/ /g; - @data = ($vendor,$model); last; } } eval $end if $b_log; - return @data; + return [$vendor,$model]; } # Normally hddtemp requires root, but you can set user rights in /etc/sudoers. -# args: $1 - /dev/<disk> to be tested for +# args: 0: /dev/<disk> 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 !$b_hddtemp_force && -e "/sys/block/$device"; + $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')) { + if ($path = main::check_program('nvme')){ $nvme = $path; } } if ($nvme){ $device =~ s/n[0-9]//; - @data = main::grabber("$sudo$nvme smart-log $device 2>/dev/null"); + @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') { + if ($row[0] eq 'temperature'){ $row[1] =~ s/\s*C//; $hdd_temp = $row[1]; last; @@ -10787,12 +14585,12 @@ sub hdd_temp { else { if (!$b_hddtemp){ $b_hddtemp = 1; - if ($path = main::check_program('hddtemp')) { + if ($path = main::check_program('hddtemp')){ $hddtemp = $path; } } if ($hddtemp){ - $hdd_temp = (main::grabber("$sudo$hddtemp -nq -u C $device 2>/dev/null"))[0]; + $hdd_temp = (main::grabber("$sudoas$hddtemp -nq -u C $device 2>/dev/null"))[0]; } } $hdd_temp =~ s/\s?(Celsius|C)$// if $hdd_temp; @@ -10800,21 +14598,42 @@ sub 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,@working); + my ($hdd_temp,$hdd_temp_alt,%sensors,@data,@working); my ($holder,$index) = ('',''); - my $path = Cwd::abs_path("/sys/block/$device"); - return if !$path; - # slice out the part of path that gives us hwmon - $path =~ s%/(block|nvme)/.*$%%; - return if ! -e "$path/hwmon/"; - my @data = main::globber("$path/hwmon/hwmon*/temp*"); - #print "device: $device\n"; + 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"); + # print "file: $_\n"; + # print(main::reader($_,'',0),"\n"); $path = $_; # cleanup everything in front of temp, the path $path =~ s/^.*\///; @@ -10847,38 +14666,39 @@ sub hdd_temp_sys { $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 $test[21]; + print Data::Dumper::Dumper \%sensors if $dbg[21]; eval $end if $b_log; return $hdd_temp; } -# args: 1: block id + +# 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 @blocks = (0,0); my ($block_log,$block_size) = (0,0); - #my $path_size = "/sys/block/$id/size"; + # 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" ){ + 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"; - @blocks = ($block_log,$block_size); - main::log_data('dump','@blocks',\@blocks) if $b_log; + my $blocks = [$block_log,$block_size]; + main::log_data('dump','@blocks',$blocks) if $b_log; eval $end if $b_log; - return @blocks; + return $blocks; } -sub device_speed { + +sub drive_speed { eval $start if $b_log; my ($device) = @_; - my ($b_nvme,$lanes,$speed,@data); + my ($b_nvme,$lanes,$speed); my $working = Cwd::abs_path("/sys/class/block/$device"); - #print "$working\n"; + # print "$working\n"; if ($working){ my ($id); # slice out the ata id: @@ -10910,7 +14730,7 @@ sub device_speed { # 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 = ($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; @@ -10926,834 +14746,2868 @@ sub device_speed { else { $working = "/sys/class/ata_link/link$id/sata_spd"; $speed = main::reader($working,'',0) if -r $working; - $speed = main::disk_cleaner($speed) if $speed; + $speed = main::clean_disk($speed) if $speed; $speed =~ s/Gbps/Gb\/s/ if $speed; } } } - @data = ($speed,$lanes); - #print "$working $speed\n"; - eval $end if $b_log; - return @data; -} -# gptid/c5e940f1-5ce2-11e6-9eeb-d05099ac4dc2 N/A ada0p1 -sub match_glabel { - eval $start if $b_log; - my ($gptid) = @_; - return if !@glabel || ! $gptid; - #$gptid =~ s/s[0-9]+$//; - 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_glabel { - eval $start if $b_log; - $b_glabel = 1; - if (my $path = main::check_program('glabel')){ - @glabel = main::grabber("$path status 2>/dev/null"); - } - main::log_data('dump','@glabel:with Headers',\@glabel) if $b_log; - # get rid of first header line - shift @glabel; + # print "$working $speed\n"; eval $end if $b_log; + return [$speed,$lanes]; } } -## GraphicData +## GraphicItem { -package GraphicData; -my $driver = ''; # we need this as a fallback in case no xorg log found -my %graphics; +package GraphicItem; +my ($b_primary,$b_wayland_data,%graphics,%mesa_drivers, +$monitor_ids,$monitor_map); +my ($gpu_amd,$gpu_intel,$gpu_nv); + sub get { eval $start if $b_log; - my (@rows); + my $rows = []; my $num = 0; - if (($b_arm || $b_mips) && !$b_soc_gfx && !$b_pci_tool){ - my $type = ($b_arm) ? 'arm' : 'mips'; + if (%risc && !$use{'soc-gfx'} && !$use{'pci-tool'}){ my $key = 'Message'; - push(@rows, { - main::key($num++,0,1,$key) => main::row_defaults($type . '-pci',''), - },); + @$rows = ({ + main::key($num++,0,1,$key) => main::message('risc-pci',$risc{'id'}) + }); } else { - push(@rows,device_output()); - if (!@rows){ + device_output($rows); + ($gpu_amd,$gpu_intel,$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'; } - push(@rows, { - main::key($num++,0,1,$key) => main::row_defaults($type,''), - },); + 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 - push(@rows,usb_output()); - push(@rows,display_output()); - push(@rows,gl_output()); + usb_output($rows); + display_output($rows); + display_api($rows); + (%graphics,$monitor_ids,$monitor_map) = (); eval $end if $b_log; - return @rows; + return $rows; } +## DEVICE OUTPUT ## sub device_output { eval $start if $b_log; - my (@rows); + return if !$devices{'graphics'}; + my $rows = $_[0]; my ($j,$num) = (0,1); - foreach my $row (@devices_graphics){ + 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"; + # 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; - $driver = $row->[9]; - $driver ||= 'N/A'; - my $card = main::trimmer($row->[4]); - $card = ($card) ? main::pci_cleaner($card,'output') : 'N/A'; + # 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($card) > 85 || $size{'max'} < 110){ - $card = main::pci_long_filter($card); + if (length($device) > 85 || $size{'max-cols'} < 110){ + $device = main::filter_pci_long($device); } - push(@rows, { - main::key($num++,1,1,'Device') => $card, + push(@$rows, { + main::key($num++,1,1,'Device') => $device, },); - if ($extra > 0 && $b_pci_tool && $row->[12]){ + 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++,0,2,'vendor')} = $item if $item; } - $rows[$j]->{main::key($num++,1,2,'driver')} = $driver; + 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; + $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]; + $rows->[$j]{main::key($num++,0,3,'alternate')} = $row->[10] if $row->[10]; + } + if ($extra > 0 && $row->[5] && $row->[6] && + $row->[5] =~ /^(1002|10de|12d2|8086)$/){ + # legacy: 1180 0df7 0029 current: 13bc 1c8d 24b1 regex: H100, RTX 4000 + # ($row->[5],$row->[6],$row->[4]) = ('12de','0029',''); + 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){ - $rows[$j]->{main::key($num++,0,2,'bus ID')} = (!$row->[2] && !$row->[3]) ? 'N/A' : "$row->[2].$row->[3]"; + $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){ - $rows[$j]->{main::key($num++,0,2,'chip ID')} = ($row->[5]) ? "$row->[5]:$row->[6]" : $row->[6]; + 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]; + $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"; + # print "$row->[0]\n"; } eval $end if $b_log; - return @rows; } + sub usb_output { eval $start if $b_log; - my (@rows,@ids,$driver,$path_id,$product,@temp2); + my $rows = $_[0]; + my (@ids,$driver,$path_id,$product,@temp2); my ($j,$num) = (0,1); - return if !@usb; - foreach my $row (@usb){ + return if !$usb{'graphics'}; + foreach my $row (@{$usb{'graphics'}}){ # these tests only work for /sys based usb data for now - if ($row->[14] && ($row->[14] eq 'Audio-Video' || $row->[14] eq 'Video' ) ){ - $num = 1; - $j = scalar @rows; - # makre sure to reset, or second device trips last flag - ($driver,$path_id,$product) = ('','',''); - $product = main::cleaner($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'; + $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]; } - else { - $driver = 'N/A'; + 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]; } } - push(@rows, { - main::key($num++,1,1,'Device') => $product, - main::key($num++,0,2,'type') => 'USB', - main::key($num++,0,2,'driver') => $driver, - },); - if ($extra > 0){ - $rows[$j]->{main::key($num++,0,2,'bus ID')} = "$path_id:$row->[1]"; + 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 && defined $row->[5] && $row->[5] ne ''){ - $rows[$j]->{main::key($num++,0,2,'class ID')} = "$row->[4]$row->[5]"; + $rows->[$j]{main::key($num++,0,2,'chip-ID')} = $row->[7]; } - if ($extra > 2 && $row->[16]){ - $rows[$j]->{main::key($num++,0,2,'serial')} = main::apply_filter($row->[16]); + 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; - return @rows; } + +# 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 (@row); - my ($num,$protocol) = (0,''); + 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 - $protocol = get_protocol(); + 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 || $protocol eq 'wayland'){ - set_compositor($protocol); + if ($extra > 1 || $graphics{'protocol'} eq 'wayland'){ + set_compositor_data(); } - if ( $b_display){ - display_data_x(); - # currently barebones, wayland needs a lot more work - if ($protocol && $protocol eq 'wayland' && !$graphics{'screens'}){ + if ($b_display){ + # Add compositors as data sources found + if ($graphics{'protocol'} eq 'wayland'){ display_data_wayland(); - # it worked! we got screen data - $graphics{'no-xdpyinfo'} = undef if $graphics{'screens'}; + } + if (!$b_wayland_data){ + display_data_x() if !$force{'wayland'}; } } else { $graphics{'tty'} = tty_data(); } - # this gives better output than the failure last case, which would only show: - # for example: X.org: 1.9 instead of: X.org: 1.9.0 - $graphics{'x-version'} = $graphics{'xorg-version'} if $graphics{'xorg-version'};; - $graphics{'x-version'} = x_version() if !$graphics{'x-version'}; - $graphics{'x-version'} = $graphics{'x-version-id'} if !$graphics{'x-version'}; - #print Data::Dumper::Dumper \%graphics; + # 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_missing,$resolution,$server_string) = ('','',''); - # print "$graphics{'x-vendor'} $graphics{'x-version'} $graphics{'x-vendor-release'}","\n"; - if ($graphics{'x-vendor'}){ - my $version = ($graphics{'x-version'}) ? " $graphics{'x-version'}" : ''; - #$version = (!$version && $graphics{'x-vendor-release'}) ? " $graphics{'x-vendor-release'}" : ''; - $server_string = "$graphics{'x-vendor'}$version"; - #print "$server_string\n"; - } - elsif ($graphics{'x-version'}) { - if ($graphics{'x-version'} =~ /^Xvesa/){ - $server_string = $graphics{'x-version'}; - } - else { - $server_string = "X.org $graphics{'x-version'}"; - } - } - my @drivers = x_drivers(); - if (!$protocol && !$server_string && !$graphics{'x-vendor'} && !@drivers){ - $server_string = main::row_defaults('display-server'); - @row = ({ + 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'; - @row = ({ - main::key($num++,1,1,'Display') => $protocol, - main::key($num++,0,2,'server') => $server_string, + push(@$rows, { + main::key($num++,1,1,'Display') => $graphics{'protocol'}, + main::key($num++,1,2,'server') => $server_string, }); - if ($graphics{'compositor'}){ - $row[0]->{main::key($num++,0,2,'compositor')} = $graphics{'compositor'}; - if ($graphics{'compositor-version'}){ - $row[0]->{main::key($num++,0,3,'v')} = $graphics{'compositor-version'}; + 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 last driver found on the card section in that case. - # those come from lscpi kernel drivers so there should be no xorg/wayland issues. - if (!$drivers[0]){ - # Fallback: specific case: in Arch/Manjaro gdm run systems, their Xorg.0.log is + # 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 - # $driver comes from the Device lines, and is just last fallback. - if ($driver){ - if (-e '/var/lib/gdm' && !$b_root ){ - $driver_missing = main::row_defaults('display-driver-na') . ' - ' . main::row_defaults('root-suggested'); + 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 { - $driver_missing = main::row_defaults('display-driver-na'); + $drivers = ($graphics{'gpu-drivers'}) ? join(',',@{$graphics{'gpu-drivers'}}): 'N/A'; } + $rows->[$j]{main::key($num++,1,3,'gpu')} = $drivers; } else { - $driver_missing = main::row_defaults('root-suggested') if -e '/var/lib/gdm' && !$b_root; + $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; } - } - else { - $driver = $drivers[0]; - } - $row[0]->{main::key($num++,1,2,'driver')} = ''; - $driver ||= 'N/A'; - $row[0]->{main::key($num++,1,3,'loaded')} = $driver; - if ($driver_missing){ - $row[0]->{main::key($num++,0,4,'note')} = $driver_missing; - } - if ($drivers[1]){ - $row[0]->{main::key($num++,0,3,'unloaded')} = $drivers[1]; - } - if ($drivers[2]){ - $row[0]->{main::key($num++,0,3,'failed')} = $drivers[2]; - } - if ($extra > 1 && $drivers[3]){ - $row[0]->{main::key($num++,0,3,'alternate')} = $drivers[3]; } } - if ($b_admin ){ + 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'}){ - $row[0]->{main::key($num++,0,2,'display ID')} = $graphics{'display-id'}; + $rows->[$j]{main::key($num++,0,2,'display-ID')} = $graphics{'display-id'}; } if (defined $graphics{'display-screens'}){ - $row[0]->{main::key($num++,0,2,'screens')} = $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){ - $row[0]->{main::key($num++,0,2,'default screen')} = $graphics{'display-default-screen'}; + $rows->[$j]{main::key($num++,0,2,'default screen')} = $graphics{'display-default-screen'}; } } - if ($graphics{'no-xdpyinfo'}){ - $row[0]->{main::key($num++,0,2,'resolution')} = $graphics{'no-xdpyinfo'}; + # 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,$row_key,$screen_count) = (0,0,0,0); + 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 @{$main->{'monitors'}} if $main->{'monitors'}; + $m_count = scalar keys %{$main->{'monitors'}} if $main->{'monitors'}; $screen_count++; - ($diag,$dpi,$hz,$resolution,$size) = (undef); - $row_key++ if !$show{'graphic-basic'}; - if ( !$show{'graphic-basic'} || $m_count == 0 ){ - if ( !$show{'graphic-basic'} && defined $main->{'screen'} ){ - $row[$row_key]->{main::key($num++,1,2,'Screen')} = $main->{'screen'}; + ($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 = $main->{'res-x'} . 'x' . $main->{'res-y'} if $main->{'res-x'} && $main->{'res-y'}; - $resolution .= '~' . $main->{'hz'} . 'Hz' if $show{'graphic-basic'} && $main->{'hz'} && $resolution; $resolution ||= 'N/A'; if ($s_count == 1 || !$show{'graphic-basic'}){ - $row[$row_key]->{main::key($num++,0,3,'s-res')} = $resolution; + $rows->[$j]{main::key($num++,0,3,'s-res')} = $resolution; } - elsif ($show{'graphic-basic'}) { - $row[$row_key]->{main::key($num++,0,3,'s-res')} = '' if $screen_count == 1; - $row[$row_key]->{main::key($num++,0,3,$screen_count)} = $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; } - $resolution = ''; - if ($main->{'s-dpi'} && (!$show{'graphic-basic'} || $extra > 1)){ - $row[$row_key]->{main::key($num++,0,3,'s-dpi')} = $main->{'s-dpi'}; + 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'} ){ - 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'} . '")'; + if (!$show{'graphic-basic'} && $extra > 2){ + if ($main->{'size-missing'}){ + $rows->[$j]{main::key($num++,0,3,'s-size')} = $main->{'size-missing'}; } - $size ||= ''; - $row[$row_key]->{main::key($num++,0,3,'s-size')} = $size if $size; - if ($main->{'diagonal'}){ - $diag = $main->{'diagonal-m'} . 'mm ('. $main->{'diagonal'} . '")'; + 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; + } } - $diag ||= ''; - $row[$row_key]->{main::key($num++,0,3,'s-diag')} = $diag if $diag; } } if ($main->{'monitors'}){ - #print $basic_count . '::' . $m_count, "\n"; - foreach my $monitor (@{$main->{'monitors'}}){ - ($diag,$dpi,$hz,$resolution,$size) = (undef); - if ($show{'graphic-basic'}){ - $basic_count++; - if ($monitor->{'res-x'} && $monitor->{'res-y'}){ - $resolution = $monitor->{'res-x'} . 'x' . $monitor->{'res-y'}; - } - # using main, noit monitor, dpi because we want xorg dpi, not physical screen dpi - $dpi = $main->{'s-dpi'} if $resolution && $extra > 1 && $main->{'s-dpi'}; - $resolution .= '~' . $monitor->{'hz'} . 'Hz' if $monitor->{'hz'} && $resolution; - $resolution ||= 'N/A'; - if ($basic_count == 1 && $m_count == 1){ - $row[$row_key]->{main::key($num++,0,2,'resolution')} = $resolution; - } - else { - $row[$row_key]->{main::key($num++,1,2,'resolution')} = '' if $basic_count == 1; - $row[$row_key]->{main::key($num++,0,3,$basic_count)} = $resolution; + # 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; } - if ($m_count == $basic_count){ - $row[$row_key]->{main::key($num++,0,2,'s-dpi')} = $dpi if $dpi; + $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'}; } - next; - } - $row_key++; - $row[$row_key]->{main::key($num++,0,3,'Monitor')} = $monitor->{'monitor'}; - if ($monitor->{'res-x'} && $monitor->{'res-y'}){ - $resolution = $monitor->{'res-x'} . 'x' . $monitor->{'res-y'}; } - $resolution ||= 'N/A'; - $row[$row_key]->{main::key($num++,0,4,'res')} = $resolution; - $hz = ($monitor->{'hz'}) ? $monitor->{'hz'} : ''; - $row[$row_key]->{main::key($num++,0,4,'hz')} = $hz if $hz; - $dpi = ($monitor->{'dpi'}) ? $monitor->{'dpi'} : ''; - $row[$row_key]->{main::key($num++,0,4,'dpi')} = $dpi if $dpi; - #print "$dpi :: $main->{'s-dpi'}\n"; - if ($monitor->{'size-x'} && $monitor->{'size-y'}){ - $size = $monitor->{'size-x'} . 'x' . $monitor->{'size-y'} . - 'mm ('. $monitor->{'size-x-i'} . 'x' . $monitor->{'size-y-i'} . '")'; + else { + $rows->[$j]{main::key($num++,0,3,'driver')} = 'N/A'; } - $size ||= ''; - $row[$row_key]->{main::key($num++,0,4,'size')} = $size if $size; - if ($monitor->{'diagonal'}){ - $diag = $monitor->{'diagonal-m'} . 'mm ('. $monitor->{'diagonal'} . '")'; + $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; } - $diag ||= ''; - $row[$row_key]->{main::key($num++,0,4,'diag')} = $diag if $diag; } } } } - else { - $graphics{'tty'} ||= 'N/A'; - $row[0]->{main::key($num++,0,2,'tty')} = $graphics{'tty'}; + } + 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; - return @row; } -sub display_data_x { +# API Data # +sub gl_data { eval $start if $b_log; - # X vendor and version detection. - # new method added since radeon and X.org and the disappearance of - # <X server name> 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 - if (my $program = main::check_program('xdpyinfo')){ - my ($diagonal,$diagonal_m,$dpi) = ('','',''); - my ($screen_id,$screen,@working); - my ($res_x,$res_x_i,$res_y,$res_y_i,$size_x,$size_x_i,$size_y,$size_y_i); - my @xdpyinfo = main::grabber("$program $display_opt 2>/dev/null","\n",'strip'); - #@xdpyinfo = map {s/^\s+//;$_} @xdpyinfo if @xdpyinfo; - #print join("\n",@xdpyinfo), "\n"; - 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-vendor'} = $working[1]; - } - elsif ($working[0] eq 'name of display'){ - $graphics{'display-id'} = $working[1]; - } - elsif ($working[0] eq 'version number'){ - $graphics{'x-version-id'} = $working[1]; - } - # note used, fix that - elsif ($working[0] eq 'vendor release number'){ - $graphics{'x-vendor-release'} = $working[1]; - } - elsif ($working[0] eq 'X.Org version'){ - $graphics{'xorg-version'} = $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; - $graphics{'screens'} = () if !$graphics{'screens'}; - } - elsif ($working[0] eq 'resolution'){ - $working[1] =~ s/^([0-9]+)x/$1/; - $graphics{'s-dpi'} = $working[1]; - } - elsif ($working[0] eq 'dimensions'){ - ($dpi,$res_x,$res_y,$size_x,$size_y) = (undef,undef,undef,undef,undef); - 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; - $res_x_i = ($1) ? sprintf("%.1f", ($1/25.4)) : 0; - $res_y_i = ($2) ? sprintf("%.1f", ($2/25.4)) : 0; - $size_x_i = ($3) ? sprintf("%.1f", ($3/25.4)) : 0; - $size_y_i = ($4) ? sprintf("%.1f", ($4/25.4)) : 0; - $dpi = ($res_x && $size_x) ? sprintf("%.0f", ($res_x*25.4/$size_x)) : ''; - $diagonal = ($res_x && $size_x) ? sprintf("%.1f", (sqrt($size_x**2 + $size_y**2)/25.4 )) : ''; - $diagonal += 0 if $diagonal;# trick to get rid of decimal 0 - $diagonal_m = ($res_x && $size_x) ? sprintf("%.0f", (sqrt($size_x**2 + $size_y**2))) : ''; - } - $screen = { - 'screen' => $screen_id, - 'res-x' => $res_x, - 'res-x-i' => $res_x_i, - 'res-y' => $res_y, - 'res-y-i' => $res_y_i, - 'size-x' => $size_x, - 'size-x-i' => $size_x_i, - 'size-y' => $size_y, - 'size-y-i' => $size_y_i, - 's-dpi' => $dpi, - 'diagonal' => $diagonal, - 'diagonal-m' => $diagonal_m, - }; - push(@{$graphics{'screens'}}, $screen); - } - } - #print Data::Dumper::Dumper $graphics{'screens'}; - if (my $program = main::check_program('xrandr')){ - ($diagonal,$diagonal_m,$dpi) = (undef); - ($screen_id,$screen,@working) = (undef); - ($res_x,$res_x_i,$res_y,$res_y_i,$size_x,$size_x_i,$size_y,$size_y_i) = (undef); - my (@monitors,$monitor_id,$screen,$screen_id,@xrandr_screens); - my @xrandr = main::grabber("$program $display_opt 2>/dev/null",'','strip'); - #$graphics{'dimensions'} = (\@dimensions); - # we get a bit more info from xrandr than xdpyinfo, but xrandr fails to handle - # multiple screens from different video cards - foreach (@xrandr){ - if (/^Screen ([0-9]+):/){ - $screen_id = $1; - push(@xrandr_screens, \@monitors) if @monitors; - @monitors = (); - } - if (/^([^\s]+)\s+connected\s(primary\s)?([0-9]+)\s*x\s*([0-9]+)\+[0-9+]+(\s\([^)]+\))?(\s([0-9]+)mm\sx\s([0-9]+)mm)?/){ - $monitor_id = $1; - $res_x = $3; - $res_y = $4; - $size_x = $7; - $size_y = $8; - $res_x_i = ($3) ? sprintf("%.1f", ($3/25.4)) : 0; - $res_y_i = ($4) ? sprintf("%.1f", ($4/25.4)) : 0; - $size_x_i = ($7) ? sprintf("%.1f", ($7/25.4)) : 0; - $size_y_i = ($8) ? sprintf("%.1f", ($8/25.4)) : 0; - $dpi = ($res_x && $size_x) ? sprintf("%.0f", $res_x * 25.4 / $size_x) : ''; - $diagonal = ($res_x && $size_x) ? sprintf("%.1f", (sqrt($size_x**2 + $size_y**2)/25.4 )) : ''; - $diagonal += 0 if $diagonal; # trick to get rid of decimal 0 - $diagonal_m = ($res_x && $size_x) ? sprintf("%.0f", (sqrt($size_x**2 + $size_y**2))) : ''; - push(@monitors, { - 'screen' => $screen_id, - 'monitor' => $monitor_id, - 'res-x' => $res_x, - 'res-x-i' => $res_x_i, - 'res-y' => $res_y, - 'res-y-i' => $res_y_i, - '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, - }); - # print "x:$size_x y:$size_y rx:$res_x ry:$res_y dpi:$dpi\n"; - ($res_x,$res_x_i,$res_y,$res_y_i,$size_x,$size_x_i,$size_y,$size_y_i) = (0,0,0,0,0,0,0,0); - + 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"; + $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]; } - my @working = split(/\s+/,$_); - if ($working[1] =~ /\*/){ - $working[1] =~ s/\*|\+//g; - $working[1] = sprintf("%.0f",$working[1]); - $monitors[scalar @monitors - 1]->{'hz'} = $working[1] if @monitors; - ($diagonal,$dpi) = ('',''); - # print Data::Dumper::Dumper \@monitors; + else { + $gl->{'egl'}{'platforms'}{$platform}{'egl'}{'api-version'} = $working[1]; } } - push(@xrandr_screens, \@monitors) if @monitors; - #print "xrand: " . Data::Dumper::Dumper \@xrandr_screens; - my ($i) = (0); - foreach my $main (@{$graphics{'screens'}}){ - # print "h: " . Data::Dumper::Dumper $main; - #print $main->{'screen'}, "\n"; - foreach my $screens (@xrandr_screens){ - # print "d: " . Data::Dumper::Dumper $screens; - if ($screens->[0]{'screen'} eq $main->{'screen'}){ - $graphics{'screens'}->[$i]{'monitors'} = $screens; - last; + 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 + 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 + if ($working[1] =~ /(Mesa|NVIDIA)\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); + # 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 + if ($working[1] =~ /\s+(Mesa|NVIDIA)\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]; } } - $i++; } - if (!$graphics{'screens'}) { - $graphics{'tty'} = tty_data(); + 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 { - $graphics{'no-xdpyinfo'} = main::row_defaults('tool-missing-basic','xdpyinfo'); + 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 'last: ', Data::Dumper::Dumper $graphics{'screens'} if $test[17]; - main::log_data('dump','$graphics{screens}',$graphics{'screens'}) if $b_log; + 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; } - #print 'last: ', Data::Dumper::Dumper $graphics{'screens'} if $test[17]; - #main::log_data('dump','@graphics{screens}',$graphics{'screens'}) if $b_log; + 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; } -sub set_compositor { + +# 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 ($protocol) = @_; - # initial tests, if wayland, it is certainly a compositor - $protocol = lc($protocol) if $protocol; - $graphics{'compositor'} = display_compositor($protocol); - # gnome-shell is incredibly slow to return version - if (($extra > 2 || $protocol eq 'wayland') && $graphics{'compositor'} && - ( !$show{'system'} || $graphics{'compositor'} ne 'gnome-shell' ) ){ - $graphics{'compositor-version'} = (main::program_data($graphics{'compositor'},$graphics{'compositor'},3))[1]; + 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; } -sub get_protocol { + +# Set Display rect size for > 1 monitors, monitor positions, size-i, diag +sub wayland_data_advanced { eval $start if $b_log; - my ($protocol) = (''); - $protocol = $ENV{'XDG_SESSION_TYPE'} if $ENV{'XDG_SESSION_TYPE'}; - $protocol = $ENV{'WAYLAND_DISPLAY'} if (!$protocol && $ENV{'WAYLAND_DISPLAY'}); - # can show as wayland-0 - $protocol = 'wayland' if $protocol && $protocol =~ /wayland/i; - # yes, I've seen this in 2019 distros, sigh - $protocol = '' if $protocol eq 'tty'; - # need to confirm that there's a point to this test, I believe no, fails out of x - # loginctl also results in the session id - if (!$protocol && $b_display && $b_force_display){ - 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){ - next if /tty[v]?[0-6]$/; # freebsd: ttyv3 - $id = (split(/\s+/, $_))[0]; - last; # multiuser? too bad, we'll go for the first one + 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 ($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 - $protocol = $temp if $temp && $temp ne 'tty'; + 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; - return $protocol; } -sub gl_output(){ + +## 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 $num = 0; - my (@row,$arg); - #print ("$b_display : $b_root\n"); - if ( $b_display){ - if (my $program = main::check_program('glxinfo')){ - # NOTE: glxinfo -B is not always available, unfortunately - my @glxinfo = main::grabber("$program $display_opt 2>/dev/null"); - #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/graphics/glxinfo/glxinfo-ssh-centos.txt"; - #my @glxinfo = main::reader($file); - if (!@glxinfo){ - my $type = 'display-console'; - if ($b_root){ - $type = 'display-root-x'; + 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; } - else { - $type = 'display-null'; + elsif ($model) { + $mon{$id}->{'model'} = $model; } - @row = ({ - main::key($num++,0,1,'Message') => main::row_defaults($type), - }); - return @row; - } - #print join("\n", @glxinfo),"\n"; - my $compat_version = ''; - my ($b_compat,$b_nogl,@core_profile_version,@direct_render,@renderer, - @opengl_version,@working); - foreach (@glxinfo){ - next if /^\s/; - if (/^opengl renderer/i){ - @working = split(/:\s*/, $_, 2); - if ($working[1]){ - $working[1] = main::cleaner($working[1]); - # Allow all mesas - #if ($working[1] =~ /mesa/i){ - # - #} - } - # note: there are cases where gl drivers are missing and empty - # field value occurs. - else { - $b_nogl = 1; - $working[1] = main::row_defaults('gl-empty'); + 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'}); } - push(@renderer, $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 - # /opengl version/ && ( f || $2 !~ /mesa/ ) { - elsif (/^opengl version/i){ - @working = split(/:\s*/, $_, 2); - if ($working[1]){ - # fglrx started appearing with this extra string, does not appear - # to communicate anything of value - $working[1] =~ s/(Compatibility Profile Context|\(Compatibility Profile\))//; - $working[1] =~ s/\s\s/ /g; - $working[1] =~ s/^\s+|\s+$//; - push(@opengl_version, $working[1]); - # note: this is going to be off if ever multi opengl versions appear, - # never seen one - @working = split(/\s+/, $working[1]); - $compat_version = $working[0]; + $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; } - elsif (!$b_nogl) { - push(@opengl_version, main::row_defaults('gl-empty')); + else { + $monitor_ids->{$id}{'primary'} = undef; } } - elsif (/^opengl core profile version/i){ - @working = split(/:\s*/, $_, 2); - # note: no need to apply empty message here since we don't have the data - # anyway - if ($working[1]){ - # fglrx started appearing with this extra string, does not appear - # to communicate anything of value - $working[1] =~ s/(Compatibility Profile Context|\((Compatibility|Core) Profile\))//; - $working[1] =~ s/\s\s/ /g; - $working[1] =~ s/^\s+|\s+$//; - push(@core_profile_version, $working[1]); + 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'}; } - elsif (/direct rendering/){ - @working = split(/:\s*/, $_, 2); - push(@direct_render, $working[1]); + if ($mon->{'rect'}){ + $monitor_ids->{$id}{'pos-x'} = $mon->{'rect'}{'x'}; + $monitor_ids->{$id}{'pos-y'} = $mon->{'rect'}{'y'}; } - # if -B was always available, we could skip this, but it is not - elsif (/GLX Visuals/){ - last; + if ($mon->{'scale'}){ + $monitor_ids->{$id}{'scale'} =$mon->{'scale'}; } } - my ($direct_render,$renderer,$version) = ('N/A','N/A','N/A'); - $direct_render = join(', ', @direct_render) if @direct_render; - # non free drivers once filtered and cleaned show the same for core and compat - # but this stopped for some reason at 4.5/4.6 nvidia - if (@core_profile_version && @opengl_version && - join('', @core_profile_version) ne join( '', @opengl_version) && - !(grep {/nvidia/i} @opengl_version ) ){ - @opengl_version = @core_profile_version; - $b_compat = 1; - } - $version = join(', ', @opengl_version) if @opengl_version; - $renderer = join(', ', @renderer) if @renderer; - @row = ({ - main::key($num++,1,1,'OpenGL') => '', - main::key($num++,1,2,'renderer') => ($renderer) ? $renderer : 'N/A', - main::key($num++,0,2,'v') => ($version) ? $version : 'N/A', - }); - if ($b_compat && $extra > 1 && $compat_version){ - $row[0]->{main::key($num++,0,2,'compat-v')} = $compat_version; + } + } + 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; } - if ($extra > 0){ - $row[0]->{main::key($num++,0,2,'direct render')} = $direct_render; + # Output VGA-1 '<Unknown> <Unknown> ' (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; } } - else { - @row = ({ - main::key($num++,0,1,'Message') => main::row_defaults('glxinfo-missing'), + } + 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 '<Unknown> <Unknown> ' (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 + # <X server name> 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 $type = 'display-console'; - if (!main::check_program('glxinfo')){ - $type = 'glxinfo-missing'; + 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 { - if ($b_root){ - $type = 'display-root'; + 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; } - else { - $type = 'display-try'; + 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); + } + } } } - @row = ({ - main::key($num++,0,1,'Message') => main::row_defaults($type), - }); } eval $end if $b_log; - return @row; } -sub tty_data(){ + +sub display_protocol { eval $start if $b_log; - my ($tty); - if ($size{'term-cols'}){ - $tty = "$size{'term-cols'}x$size{'term-lines'}"; + $graphics{'protocol'} = ''; + if ($ENV{'XDG_SESSION_TYPE'}){ + $graphics{'protocol'} = $ENV{'XDG_SESSION_TYPE'}; } - elsif ($b_irc && $client{'console-irc'}){ - my $tty_working = main::get_tty_console_irc('tty'); - if (my $program = main::check_program('stty')){ - my $tty_arg = ($bsd_type) ? '-f' : '-F'; - $tty = (main::grabber("$program $tty_arg /dev/pts/$tty_working size 2>/dev/null"))[0]; - if ($tty){ - my @temp = split(/\s+/, $tty); - $tty = "$temp[1]x$temp[0]"; + 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; - return $tty; } -sub x_drivers { - eval $start if $b_log; - my ($driver,@driver_data,,%drivers); - my ($alternate,$failed,$loaded,$sep,$unloaded) = ('','','','',''); - if (my $log = main::system_files('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 @xorg = main::reader($log); - # list is from sgfxi plus non-free drivers, plus ARM drivers - my $list = join('|', qw(amdgpu apm ark armsoc atimisc ati - chips cirrus cyrix fbdev fbturbo fglrx geode glide glint + +## 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 imstt intel ivtv mach64 mesa mga modesetting - neomagic newport nouveau nsc nvidia nv openchrome r128 radeonhd radeon - rendition s3virge s3 savage siliconmotion sisimedia sisusb sis - sunbw2 suncg14 suncg3 suncg6 sunffb sunleo suntcx - tdfx tga trident tseng unichrome v4l vboxvideo vesa vga via vmware vmwgfx - voodoo)); + iftv igs imstt intel ipaq ivtv mach64 mesa mga m68k modesetting neomagic + newport nouveau 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. - #@xorg = grep {/Failed|Unload|Loading/} @xorg; - foreach (@xorg){ - next if !/Failed|Unload|Loading/; - # print "$_\n"; - # note that in file names, driver is always lower case - if (/\sLoading.*($list)_drv.so$/i ) { + # @$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 (/(Unloading\s|UnloadModule).*\"?($list)(_drv.so)?\"?$/i ) { + 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 @@ -11765,18 +17619,18 @@ sub x_drivers { # 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 (/Failed.*($list)\"?.*$/i ) { + # (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 ( $_ !~ /\(already loaded/){ + if ($line !~ /\(already loaded/){ $drivers{$driver}='failed'; } # reset the previous line's 'unloaded' to 'loaded' as well @@ -11784,278 +17638,1480 @@ sub x_drivers { $drivers{$driver}='loaded'; } } - elsif ($_ =~ /module does not exist/){ + 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); + } + } } - my $sep = ''; + # print 'drivers: ', Data::Dumper::Dumper \%drivers; foreach (sort keys %drivers){ - if ($drivers{$_} eq 'loaded') { - $sep = ($loaded) ? ',' : ''; - $loaded .= $sep . $_; + if ($drivers{$_} eq 'loaded'){ + push(@$loaded,$_); + } + elsif ($drivers{$_} eq 'unloaded'){ + push(@$unloaded,$_); } - elsif ($drivers{$_} eq 'unloaded') { - $sep = ($unloaded) ? ',' : ''; - $unloaded .= $sep . $_; + elsif ($drivers{$_} eq 'failed'){ + push(@$failed,$_); } - elsif ($drivers{$_} eq 'failed') { - $sep = ($failed) ? ',' : ''; - $failed .= $sep . $_; + elsif ($drivers{$_} eq 'alternate'){ + push(@$alternate,$_); } - elsif ($drivers{$_} eq 'alternate') { - $sep = ($alternate) ? ',' : ''; - $alternate .= $sep . $_; + } + 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', + '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', + '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|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' => '4905|4907|4908|4c80|4c8a|4c8b|4c8c|4c90|4c9a|9a40|9a49|9a59|9a60|' . + '9a68|9a70|9a78|9ac0|9ac9|9ad9|9af8', + 'code' => '', + 'process' => 'Intel 10nm', + 'years' => '2020-21', + }, + {'arch' => 'Gen-12.2', + 'ids' => '4626|4628|462a|4636|4638|463a|4682|4688|468a|468b|4690|4692|4693|' . + '46a3|46a6|46a8|46aa|46b0|46b1|46b3|46b6|46b8|46ba|46c1|46c3|46d0|46d1|46d2', + 'code' => '', + 'process' => 'Intel 10nm', + 'years' => '2021-22+', + }, + {'arch' => 'Gen-12.5', + 'ids' => '0bd0|0bd5|0bd6|0bd7|0bd9|0bda|0bdb', + 'code' => '', + 'process' => 'Intel 10nm', + 'years' => '2021-23+', + }, + # Jupiter Sound cancelled? + {'arch' => 'Gen-12.7', + 'ids' => '4f80|4f81|4f82|4f83|4f84|4f85|4f86|4f87|4f88|5690|5691|5692|5693|' . + '5694|5695|5696|5697|5698|56a0|56a1|56a3|56a4|56a5|56a6|56a7|56a8|56a9|56b0|' . + '56b1|56b2|56b3|56ba|56bb|56bc|56bd', + 'code' => 'Alchemist', + 'process' => 'TSMC n6 (7nm)', + 'years' => '2022+', + }, + {'arch' => 'Gen-12.7', + 'ids' => '56c0|56c1', + 'code' => '', + 'process' => 'TSMC n6 (7nm)', + 'years' => '2022+', + }, + {'arch' => 'Gen-13', + 'ids' => '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-14', + 'ids' => '7d40|7d45|7d55|7d60|7dd5', + 'code' => '', + 'process' => 'Intel 4 (7nm+)', + 'years' => '2023+', + }, + {'arch' => 'Gen-15', + 'ids' => '7d51|7d67|7dd1', + 'code' => '', + 'process' => 'TSMC 3nm', + 'years' => '2024+', + }, + ]; +} + +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|1298', + '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', + '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|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' => '545.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' => '545.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' => '545.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|28b8|28f8', + 'code' => 'TUxxx', + 'kernel' => '', + 'legacy' => 0, + 'process' => 'TSMC 12nm FF', + 'release' => '', + 'series' => '545.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|25a0|25a2|25a5|25ab|' . + '25ac|25b6|25b8|25b9|25ba|25bb|25bc|25bd|25e0|25e2|25e5|25ec|25f9|25fa|25fb|' . + '2838', + 'code' => 'GAxxx', + 'kernel' => '', + 'legacy' => 0, + 'process' => 'TSMC n7 (7nm)', + 'release' => '', + 'series' => '545.xx+', + 'status' => main::message('nv-current-eol',$date,'2026-12-xx'), + 'xorg' => '', + 'years' => '2020-2023', + }, + {'arch' => 'Hopper', + 'ids' => '2321|2322|2324|2330|2331|2339|233a|2342', + 'code' => 'GH1xx', + 'kernel' => '', + 'legacy' => 0, + 'process' => 'TSMC n4 (5nm)', + 'release' => '', + 'series' => '545.xx+', + 'status' => $status_current, + 'xorg' => '', + 'years' => '2022+', + }, + {'arch' => 'Lovelace', + 'ids' => '2684|2685|26b1|26b2|26b3|26b5|26b9|26ba|2704|2705|2717|2730|2757|' . + '2770|2782|2783|2786|27a0|27b0|27b1|27b2|27b6|27b8|27ba|27bb|27e0|27fb|2803|' . + '2805|2820|2860|2882|28a0|28a1|28e0|28e1', + 'code' => 'AD1xx', + 'kernel' => '', + 'legacy' => 0, + 'process' => 'TSMC n4 (5nm)', + 'release' => '', + 'series' => '545.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; + } + 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]); } } - @driver_data = ($loaded,$unloaded,$failed,$alternate); + $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; - return @driver_data; } -# fallback if no glx x version data found -sub x_version { + +sub monitor_edid_data { eval $start if $b_log; - my ($version,@data,$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 /usr/X11R6/bin), @paths ); - # IMPORTANT: both commands send version data to stderr! - if ($program = main::check_program('Xorg')){ - @data = main::grabber("$program -version 2>&1"); + 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'}; } - elsif ($program = main::check_program('X')){ - @data = main::grabber("$program -version 2>&1"); + if ($edid->{'gamma'}){ + $monitor_ids->{$port}{'gamma'} = ($edid->{'gamma'}/100 + 0); } - elsif ($program = main::check_program('Xvesa')){ - @data = main::grabber("$program -version 2>&1"); + 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'}); + } } - #print join('^ ', @paths), " :: $program\n"; - #print Data::Dumper::Dumper \@data; - if (@data){ - foreach (@data){ - if (/^X.org X server/i){ - $version = (split(/\s+/, $_))[3]; - last; + # 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'}; } - elsif (/^X Window System Version/i) { - $version = (split(/\s+/, $_))[4]; - last; + 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'}; } - elsif (/^Xvesa from/i) { - $version = (split(/\s+/, $_))[3]; - $version = "Xvesa $version" if $version; - last; + 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; } } - # remove extra X paths - @paths = grep { !/^\/usr\/lib|xorg|X11R6|libexec/ } @paths; + # 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; - return $version; } -# $1 - protocol: wayland|x11 -sub display_compositor { - eval $start if $b_log; - my ($protocol) = @_; - my ($compositor) = (''); - main::set_ps_gui() if !$b_ps_gui; - if (@ps_gui){ - # 1 check program; 2 search; 3 unused version; 4 print - my @compositors = ( - ['asc','asc','','asc'], - ['budgie-wm','budgie-wm','','budgie-wm'], - # owned by: compiz-core in debian - ['compiz','compiz','','compiz'], - ['compton','compton','','compton'], - # as of version 20 is wayland compositor - ['enlightenment','enlightenment','','enlightenment'], - ['gnome-shell','gnome-shell','','gnome-shell'], - ['kwin_wayland','kwin_wayland','','kwin_wayland'], - ['kwin_x11','kwin_x11','','kwin_x11'], - #['kwin','kwin','','kwin'], - ['marco','marco','','marco'], - ['muffin','muffin','','muffin'], - ['mutter','mutter','','mutter'], - ['weston','weston','','weston'], - # these are more obscure, so check for them last - ['3dwm','3dwm','','3dwm'], - ['dcompmgr','dcompmgr','','dcompmgr'], - ['dwc','dwc','','dwc'], - ['fireplace','fireplace','','fireplace'], - ['grefson','grefson','','grefson'], - ['kmscon','kmscon','','kmscon'], - ['liri','liri','','liri'], - ['metisse','metisse','','metisse'], - ['mir','mir','','mir'], - ['moblin','moblin','','moblin'], - ['motorcar','motorcar','','motorcar'], - ['orbital','orbital','','orbital'], - ['papyros','papyros','','papyros'], - ['perceptia','perceptia','','perceptia'], - ['picom','picom','','picom'], - ['rustland','rustland','','rustland'], - ['sommelier','sommelier','','sommelier'], - ['sway','sway','','sway'], - ['swc','swc','','swc'], - ['ukwm','ukwm','','ukwm'], - ['unagi','unagi','','unagi'], - ['unity-system-compositor','unity-system-compositor','','unity-system-compositor'], - ['way-cooler','way-cooler','','way-cooler'], - ['wavy','wavy','','wavy'], - ['wayfire','wayfire','','wayfire'], - ['wayhouse','wayhouse','','wayhouse'], - ['westford','westford','','westford'], - ['xcompmgr','xcompmgr','','xcompmgr'], + +# 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', ); - foreach my $item (@compositors){ - # no need to use check program with short list of ps_gui - # if (main::check_program($item[0]) && (grep {/^$item[1]$/} @ps_gui ) ){ - if (grep {/^$item->[1]$/} @ps_gui){ - $compositor = $item->[3]; - last; + 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]"; } } } - main::log_data('data',"compositor: $compositor") if $b_log; eval $end if $b_log; - return $compositor; + return $tty; } } -## LogicalData +## LogicalItem { -package LogicalData; +package LogicalItem; sub get { eval $start if $b_log; - my (@rows,$key1,$val1); + my ($key1,$val1); + my $rows = []; my $num = 0; if ($bsd_type){ $key1 = 'Message'; - $val1 = main::row_defaults('lvm-data-bsd'); - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + $val1 = main::message('logical-data-bsd',$uname[0]); + push(@$rows,{main::key($num++,0,1,$key1) => $val1}); } else { - main::set_lsblk() if !$b_lsblk; - if ($b_fake_logical || $alerts{'lvs'}->{'action'} eq 'use'){ - lvm_data() if !$b_lvm_data; + 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 = ($b_active_lvm) ? $alerts{'lvs'}->{'permissions'} : main::row_defaults('lvm-data',''); - push(@rows, { + my $message = ($use{'logical-lvm'}) ? main::message('tool-permissions','lvs') : main::message('logical-data',''); + push(@$rows, { main::key($num++,0,1,$key) => $message, - },); + }); } else { - my %processed = process_lvm_data(); - @rows = lvm_output(\%processed); + lvm_output($rows,process_lvm_data()); } } - elsif ($b_active_lvm && $alerts{'lvs'}->{'action'} eq 'permissions'){ + elsif ($use{'logical-lvm'} && $alerts{'lvs'}->{'action'} eq 'permissions'){ my $key = 'Message'; - push(@rows, { - main::key($num++,0,1,$key) => $alerts{'lvs'}->{'permissions'}, - },); + push(@$rows, { + main::key($num++,0,1,$key) => $alerts{'lvs'}->{'message'}, + }); } - elsif (@lsblk && !$b_active_lvm && ($alerts{'lvs'}->{'action'} eq 'permissions' || - $alerts{'lvs'}->{'action'} eq 'missing')){ + 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::row_defaults('lvm-data',''), - },); + 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'}->{$key1}; + $val1 = $alerts{'lvs'}->{'message'}; $key1 = ucfirst($key1); - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + push(@$rows, {main::key($num++,0,1,$key1) => $val1}); } - if ($b_active_general){ - my @general_data = general_data(); - push(@rows,general_output(\@general_data)) if @general_data; + if ($use{'logical-general'}){ + my $general_data = general_data(); + general_output($rows,$general_data) if @$general_data; } } eval $end if $b_log; - return @rows; + return $rows; } + sub general_output { eval $start if $b_log; - my ($general_data) = @_; - my ($size,@rows); + 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; + $j = scalar @$rows; $size = ($item->{'size'}) ? main::get_size($item->{'size'}, 'string') : 'N/A'; - push(@rows,{ + 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,'maj-min')} = $item->{'maj-min'}; } - $rows[$j]->{main::key($num++,0,2,'type')} = $item->{'type'}; + $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,'dm')} = $item->{'dm'}; } - $rows[$j]->{main::key($num++,0,2,'size')} = $size; + $rows->[$j]{main::key($num++,0,2,'size')} = $size; my $b_fake; - components_output('general',\$j,\$num,\@rows,\@{$item->{'components'}},\$b_fake); + components_output('general',\$j,\$num,$rows,\@{$item->{'components'}},\$b_fake); } eval $end if $b_log; - return @rows; } + sub lvm_output { eval $start if $b_log; - my ($lvm_data) = @_; - my (@rows); + my ($rows,$lvm_data) = @_; my ($size); my ($j,$num) = (0,0); foreach my $vg (sort keys %$lvm_data){ - $j = scalar @rows; + $j = scalar @$rows; # print Data::Dumper::Dumper $lvm_data->{$vg}; $size = main::get_size($lvm_data->{$vg}{'vg-size'},'string','N/A'); - push(@rows,{ + 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; + $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; + $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; + $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,'maj-min')} = $lvm_data->{$vg}{'lvs'}{$lv}{'maj-min'}; } - $rows[$j]->{main::key($num++,0,3,'type')} = $lvm_data->{$vg}{'lvs'}{$lv}{'lv-type'}; + $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,'dm')} = $lvm_data->{$vg}{'lvs'}{$lv}{'dm'}; } - $rows[$j]->{main::key($num++,0,3,'size')} = $size; + $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'}; + $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'}; + $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); + components_output('lvm',\$j,\$num,$rows,\@{$lvm_data->{$vg}{'lvs'}{$lv}{'components'}},\$b_raid); } } eval $end if $b_log; - return @rows; } sub components_output { @@ -12070,9 +19126,10 @@ sub components_output { ($l1) = (3); } my $status = (!@$components) ? 'N/A': ''; - $$rows[$$j]->{main::key($$num++,1,$l1,'Components')} = $status; + $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); @@ -12083,9 +19140,9 @@ sub components_recursive_output { elsif ($type eq 'lvm'){ ($l2,$l3) = (4+$indent,5+$indent); } - #print 'outside: ', scalar @$component, "\n", Data::Dumper::Dumper $component; + # print 'outside: ', scalar @$component, "\n", Data::Dumper::Dumper $component; foreach my $component (@$components){ - #print "inside: -n", Data::Dumper::Dumper $component->[$i]; + # print "inside: -n", Data::Dumper::Dumper $component->[$i]; $$j = scalar @$rows if $b_admin; my $id; if ($component->[0] =~ /^(bcache|dm-|md)[0-9]/){ @@ -12096,13 +19153,14 @@ sub components_recursive_output { $id = $p . '-' . $l; $l++; } - $$rows[$$j]->{main::key($$num++,1,$l2,$id)} = $component->[0]; + $rows->[$$j]{main::key($$num++,1,$l2,$id)} = $component->[0]; if ($extra > 1){ if ($b_admin){ - $$rows[$$j]->{main::key($$num++,0,$l3,'maj-min')} = $component->[1]; - $$rows[$$j]->{main::key($$num++,0,$l3,'mapped')} = $component->[3] if $component->[3]; + $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; + $rows->[$$j]{main::key($$num++,0,$l3,'size')} = $size; } #next if !$component->[$i][4]; for (my $i = 4; $i < scalar @$component; $i++){ @@ -12112,25 +19170,27 @@ sub components_recursive_output { } } -# note: type dm is seen in only one dataset, but it's a start +# Note: type dm is seen in only one dataset, but it's a start sub general_data { eval $start if $b_log; - my (@found,@general_data,%parent,$parent_fs); - main::set_mapper() if !$b_mapper; + 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 = main::get_lsblk($row->{'parent'}); - next if !$parent{'fs'}; + $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') ) ){ + $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'){ + if ($parent->{'fs'} eq 'crypto_LUKS'){ $type = 'LUKS'; } # note, testing name is random user string, and there is no other @@ -12141,7 +19201,7 @@ sub general_data { elsif ($row->{'type'} eq 'crypt'){ $type = 'Crypto'; } - elsif ($parent{'fs'} eq 'bcache'){ + elsif ($parent->{'fs'} eq 'bcache'){ $type = 'bcache'; } # probably only seen on older Redhat servers, LVM probably replaces @@ -12151,10 +19211,10 @@ sub general_data { elsif ($row->{'type'} eq 'crypt'){ $type = 'Crypt'; } - #my $name = ($use{'filter-uuid'}) ? "luks-$filter_string" : $row->{'name'}; + # 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, { + push(@$general_data, { 'components' => \@full_components, 'dm' => $mapped, 'maj-min' => $row->{'maj-min'}, @@ -12164,27 +19224,27 @@ sub general_data { }); } } - main::log_data('dump','luks @general_data', \@general_data); - print Data::Dumper::Dumper \@general_data if $test[23]; + 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; + return $general_data; } -# note: called for disk totals, raid, and logical +# Note: called for disk totals, raid, and logical sub lvm_data { eval $start if $b_log; - $b_lvm_data = 1; - main::set_proc_partitions() if !$b_proc_partitions; - main::set_mapper() if !$b_mapper; + $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; - if ($b_fake_logical){ - my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/lvm/lvs-test-1.txt"; - @data = main::reader($file,'strip'); + 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 @@ -12192,16 +19252,16 @@ sub lvm_data { # 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); - $cmd .= ' 2>/dev/null'; - @data = main::grabber("$cmd",'','strip'); + # $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 $test[22]; + 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]; @@ -12214,46 +19274,48 @@ sub lvm_data { } # print Data::Dumper::Dumper \%totals, \@raw_logical; main::log_data('dump','lvm @lvm', \@lvm) if $b_log; - print Data::Dumper::Dumper \@lvm if $test[22]; + print Data::Dumper::Dumper \@lvm if $dbg[22]; eval $end if $b_log; } + sub process_lvm_data { eval $start if $b_log; - my (%processed); + 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'}; + 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; + $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; + $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; + $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; + $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 $test[23]; + 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; + return $processed; } + sub component_data { my ($maj_min,$full_components) = @_; push(@$full_components, component_recursive_data($maj_min)); @@ -12267,16 +19329,16 @@ sub component_recursive_data { @devices = map {$_ =~ s|^/.*/||; $_;} @devices if @devices; # return @devices if !$b_admin; foreach my $device (@devices){ - my ($mapped,$mm2,@part); - @part = main::get_proc_partition($device) if @proc_partitions; - $mm2 = $part[0] . ':' . $part[1] if @part; + 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)]]); + $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]]); + push(@components,[$device,$mm2,$part->[2]]); } } eval $end if $b_log; @@ -12284,80 +19346,105 @@ sub component_recursive_data { } } -## MachineData +## MachineItem +# public methods: get(), is_vm() { -package MachineData; +my $b_vm; +package MachineItem; sub get { eval $start if $b_log; - my (%soc_machine,%data,@rows,$key1,$val1,$which); + my (%soc_machine,$data,@rows,$key1,$val1,$which); + my $rows = []; my $num = 0; - if ($bsd_type && @sysctl_machine && !$b_dmidecode_force ){ - %data = machine_data_sysctl(); - if (%data){ - @rows = machine_output(\%data); + if ($bsd_type && $sysctl{'machine'} && !$force{'dmidecode'}){ + $data = machine_data_sysctl(); + if (%$data){ + machine_output($rows,$data); } elsif (!$key1){ $key1 = 'Message'; - $val1 = main::row_defaults('machine-data-force-dmidecode',''); + $val1 = main::message('machine-data-force-dmidecode',''); } } - elsif ($bsd_type || $b_dmidecode_force){ - if ( !$b_fake_dmidecode && $alerts{'dmidecode'}->{'action'} ne 'use'){ + elsif ($bsd_type || $force{'dmidecode'}){ + if (!$fake{'dmidecode'} && $alerts{'dmidecode'}->{'action'} ne 'use'){ $key1 = $alerts{'dmidecode'}->{'action'}; - $val1 = $alerts{'dmidecode'}->{$key1}; + $val1 = $alerts{'dmidecode'}->{'message'}; $key1 = ucfirst($key1); } else { - %data = machine_data_dmi(); - if (%data){ - @rows = machine_output(\%data); + $data = machine_data_dmi(); + if (%$data){ + machine_output($rows,$data); } elsif (!$key1){ $key1 = 'Message'; - $val1 = main::row_defaults('machine-data',''); + $val1 = main::message('machine-data'); } } } - elsif (-d '/sys/class/dmi/id/') { - %data = machine_data_sys(); - if (%data){ - @rows = machine_output(\%data); + elsif (!$fake{'elbrus'} && -d '/sys/class/dmi/id/'){ + $data = machine_data_sys(); + if (%$data){ + machine_output($rows,$data); } else { $key1 = 'Message'; - $val1 = main::row_defaults('machine-data-dmidecode',''); + if ($alerts{'dmidecode'}->{'action'} eq 'missing'){ + $val1 = main::message('machine-data-dmidecode'); + } + else { + $val1 = main::message('machine-data'); + } } } - elsif (!$bsd_type) { + 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 ($b_arm || $b_mips || $b_ppc){ - %data = machine_data_soc(); - @rows = machine_soc_output(\%data) if %data; + if (%risc){ + $data = machine_data_soc(); + machine_soc_output($rows,$data) if %$data; } - if (!%data){ + if (!$data || !%$data){ $key1 = 'Message'; - $val1 = main::row_defaults('machine-data-force-dmidecode',''); + $val1 = main::message('machine-data-force-dmidecode',''); } } # if error case, null data, whatever - if ($key1) { - push(@rows,{main::key($num++,0,1,$key1) => $val1,}); + if ($key1){ + push(@$rows,{main::key($num++,0,1,$key1) => $val1,}); } eval $end if $b_log; - return @rows; + return $rows; +} + +sub is_vm { + return $b_vm; } + ## keys for machine data are: -# 0-sys_vendor 1-product_name 2-product_version 3-product_serial 4-product_uuid -# 5-board_vendor 6-board_name 7-board_version 8-board_serial -# 9-bios_vendor 10-bios_version 11-bios_date +# 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: -# 12-chassis_vendor 13-chassis_type 14-chassis_version 15-chassis_serial -## unused: 16-bios_rev 17-bios_romsize 18 - firmware type +# chassis_serial; chassis_type; chassis_vendor; chassis_version; +## unused: bios_rev; bios_romsize; firmware type sub machine_output { eval $start if $b_log; - my ($data) = @_; - my (@rows); + my ($rows,$data) = @_; my $firmware = 'BIOS'; my $num = 0; my $j = 0; @@ -12365,74 +19452,76 @@ sub machine_output { 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"; -# } + # 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'})){ + ($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/*') ){ + 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'})) ){ + 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, { + $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::cleaner($data->{'sys_vendor'}); + $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::apply_filter($data->{'product_serial'}); - $rows[$j]->{main::key($num++,1,1,'System')} = $system_vendor; - $rows[$j]->{main::key($num++,0,2,'product')} = $product_name; - $rows[$j]->{main::key($num++,0,2,'v')} = $product_version; - $rows[$j]->{main::key($num++,0,2,'serial')} = $product_serial; + $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'} eq $data->{'board_version'}){ + 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'} ){ + 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'} ){ + 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::apply_filter($data->{'chassis_serial'}); + $chassis_serial = main::filter($data->{'chassis_serial'}); $chassis_vendor ||= ''; $chassis_type ||= ''; - $rows[$j]->{main::key($num++,1,1,'Chassis')} = $chassis_vendor; + $rows->[$j]{main::key($num++,1,1,'Chassis')} = $chassis_vendor; if ($chassis_type){ - $rows[$j]->{main::key($num++,0,2,'type')} = $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,'v')} = $chassis_version; } - $rows[$j]->{main::key($num++,0,2,'serial')} = $chassis_serial; + $rows->[$j]{main::key($num++,0,2,'serial')} = $chassis_serial; } } $j++; # start new row @@ -12440,11 +19529,11 @@ sub machine_output { if ($data->{'firmware'}){ $firmware = $data->{'firmware'}; } - $mobo_vendor = ($data->{'board_vendor'}) ? main::cleaner($data->{'board_vendor'}) : 'N/A'; + $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::apply_filter($data->{'board_serial'}); - $bios_vendor = ($data->{'bios_vendor'}) ? main::cleaner($data->{'bios_vendor'}) : 'N/A'; + $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; @@ -12460,195 +19549,342 @@ sub machine_output { 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++,0,2,'model')} = $mobo_model; + $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,2,'v')} = $mobo_version; + $rows->[$j]{main::key($num++,0,3,'v')} = $mobo_version; } - $rows[$j]->{main::key($num++,0,2,'serial')} = $mobo_serial; - if ($extra > 2 && $data->{'board_uuid'}){ - $rows[$j]->{main::key($num++,0,2,'uuid')} = $data->{'board_uuid'}; + $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'}; } - $rows[$j]->{main::key($num++,1,1,$firmware)} = $bios_vendor; - $rows[$j]->{main::key($num++,0,2,'v')} = $bios_version; + 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,'rev')} = $bios_rev; } - $rows[$j]->{main::key($num++,0,2,'date')} = $bios_date; + $rows->[$j]{main::key($num++,0,2,'date')} = $bios_date; if ($bios_romsize){ - $rows[$j]->{main::key($num++,0,2,'rom size')} = $bios_romsize; + $rows->[$j]{main::key($num++,0,2,'rom size')} = $bios_romsize; } eval $end if $b_log; - return @rows; } + sub machine_soc_output { - my ($soc_machine) = @_; - my ($key,@rows); + my ($rows,$soc_machine) = @_; + my ($key); my ($cont_sys,$ind_sys,$j,$num) = (1,1,0,0); - #print Data::Dumper::Dumper \%soc_machine; + # 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'}){ - if ($b_arm){$key = 'ARM Device'} - elsif ($b_mips){$key = 'MIPS Device'} - elsif ($b_ppc){$key = 'PowerPC Device'} - $rows[$j]->{main::key($num++,0,1,'Type')} = $key; + $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'}; + $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'}; + $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'}; + $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::apply_filter($soc_machine->{'serial'}); + $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; - return @rows; } sub machine_data_sys { eval $start if $b_log; - my (%data,$path,$vm); + 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_uuid product_version sys_vendor + 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'; + $data->{'firmware'} = 'BIOS'; # print Data::Dumper::Dumper \@sys_files; - if (!-d $sys_dir ){ - if ( -d $sys_dir_alt){ + 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'; + if (-d '/sys/firmware/efi'){ + $data->{'firmware'} = 'UEFI'; } - elsif ( glob('/sys/firmware/acpi/tables/UEFI*') ){ - $data{'firmware'} = 'UEFI [Legacy]'; + 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::dmi_cleaner($data{$_}) : ''; + $data->{$_} = main::reader($path,'',0); + $data->{$_} = ($data->{$_}) ? main::clean_dmi($data->{$_}) : ''; } - elsif (!$b_root && -e $path && !-r $path ){ - $data{$_} = main::row_defaults('root-required'); + elsif (!$b_root && -e $path && !-r $path){ + $data->{$_} = main::message('root-required'); } else { - $data{$_} = ''; + $data->{$_} = ''; } } - if ($data{'chassis_type'}){ - if ( $data{'chassis_type'} == 1){ - $data{'device'} = get_device_vm($data{'sys_vendor'},$data{'product_name'}); - $data{'device'} ||= 'other-vm?'; + 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'}); + $data->{'device'} = get_device_sys($data->{'chassis_type'}); } } -# print "sys:\n"; -# foreach (keys %data){ -# print "$_: $data{$_}\n"; -# } - main::log_data('dump','%data',\%data) if $b_log; + # 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; + return $data; } -# this will create an alternate machine data source + +# 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,@temp); - if (my $file = main::system_files('cpuinfo')){ - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/arm-shevaplug-1.2ghz.txt"; - my @data = main::reader($file); - foreach (@data){ - if (/^(Hardware|machine)\s*:/i){ - @temp = split(/\s*:\s*/, $_, 2); - $temp[1] = main::arm_cleaner($temp[1]); - $temp[1] = main::dmi_cleaner($temp[1]); - $data{'device'} = main::cleaner($temp[1]); - } - elsif (/^(system type|model)\s*:/i){ - @temp = split(/\s*:\s*/, $_, 2); - $temp[1] = main::dmi_cleaner($temp[1]); - $data{'model'} = main::cleaner($temp[1]); - } - elsif (/^Revision/i){ - @temp = split(/\s*:\s*/, $_, 2); - $data{'firmware'} = $temp[1]; - } - elsif (/^Serial/i){ - @temp = split(/\s*:\s*/, $_, 2); - $data{'serial'} = $temp[1]; - } - } - } - if (!$data{'model'} && $b_android){ - main::set_build_prop() if !$b_build_prop; + 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'}) { + $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'}; + $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-device'}){ + $data->{'model'} = $build_prop{'product-device'}; } - elsif ($build_prop{'product-name'} ){ - $data{'model'} = $build_prop{'product-name'}; + elsif ($build_prop{'product-name'}){ + $data->{'model'} = $build_prop{'product-name'}; } } - if (!$data{'model'} && -r '/proc/device-tree/model'){ + 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::dmi_cleaner($model); + $model = main::clean_dmi($model); $model = (split(/\x01|\x02|\x03|\x00/, $model))[0] if $model; - my $device_temp = main::regex_cleaner($data{'device'}); - if ( !$data{'device'} || ($model && $model !~ /\Q$device_temp\E/i) ){ - $model = main::arm_cleaner($model); - $data{'model'} = $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'){ + 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; + $data->{'serial'} = $serial if $serial; } - - #print Data::Dumper::Dumper \%data; + print Data::Dumper::Dumper $data if $dbg[28]; + main::log_data('dump','%data',$data) if $b_log; eval $end if $b_log; - return %data; + return $data; } # bios_date: 09/07/2010 @@ -12661,21 +19897,24 @@ sub machine_data_soc { # 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: -# sys_uuid: dmi/sysctl only +# uuid: dmi/sysctl only, map to product_uuid # sys_vendor: sub machine_data_dmi { eval $start if $b_log; - my (%data,$vm); - return if ! @dmi; - $data{'firmware'} = 'BIOS'; + 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 @@ -12686,20 +19925,20 @@ sub machine_data_dmi { 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::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'Vendor') { - $data{'bios_vendor'} = main::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'Version') { - $data{'bios_version'} = main::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'ROM Size') { - $data{'bios_romsize'} = main::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'BIOS Revision') { - $data{'bios_rev'} = main::dmi_cleaner($value[1]) } + 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';} + if ($item eq '~UEFI is supported'){ + $data->{'firmware'} = 'UEFI';} } } next; @@ -12710,16 +19949,18 @@ sub machine_data_dmi { 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::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'Version') { - $data{'product_version'} = main::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'Serial Number') { - $data{'product_serial'} = main::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'Manufacturer') { - $data{'sys_vendor'} = main::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'UUID') { - $data{'sys_uuid'} = main::dmi_cleaner($value[1]) } + 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; @@ -12730,14 +19971,14 @@ sub machine_data_dmi { 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::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'Serial Number') { - $data{'board_serial'} = main::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'Manufacturer') { - $data{'board_vendor'} = main::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'Version') { - $data{'board_version'} = main::dmi_cleaner($value[1]) } + 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; @@ -12748,18 +19989,21 @@ sub machine_data_dmi { 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::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'Type') { - $data{'chassis_type'} = main::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'Manufacturer') { - $data{'chassis_vendor'} = main::dmi_cleaner($value[1]) } - elsif ($value[0] eq 'Version') { - $data{'chassis_version'} = main::dmi_cleaner($value[1]) } - } - } - if ( $data{'chassis_type'} && $data{'chassis_type'} ne 'Other' ){ - $data{'device'} = $data{'chassis_type'}; + 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; } @@ -12767,9 +20011,10 @@ sub machine_data_dmi { # processor information: check for hypervisor elsif ($row->[0] == 4){ # skip first three row, we don't need that data - if (!$data{'device'}){ + if (!$data->{'device'}){ if (grep {/hypervisor/i} @$row){ - $data{'device'} = 'virtual-machine'; + $data->{'device'} = 'virtual-machine'; + $b_vm = 1; } } last; @@ -12778,64 +20023,100 @@ sub machine_data_dmi { last; } } - if (!$data{'device'}){ - $data{'device'} = get_device_vm($data{'sys_vendor'},$data{'product_name'}); - $data{'device'} ||= 'other-vm?'; + 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; - main::log_data('dump','%data',\%data) if $b_log; + # 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; + 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 (%data,$vm); + my ($product,$vendor,$vm); + my $data = {}; # ^hw\.(vendor|product|version|serialno|uuid) - foreach (@sysctl_machine){ - next if ! $_; + foreach (@{$sysctl{'machine'}}){ + next if !$_; my @item = split(':', $_); - next if ! $item[1]; - if ($item[0] eq 'hw.vendor'){ - $data{'board_vendor'} = main::dmi_cleaner($item[1]); + 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'){ - $data{'board_name'} = main::dmi_cleaner($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'){ - $data{'board_version'} = $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'){ - $data{'board_serial'} = $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'} = $item[1]; + $data->{'board_serial'} = main::clean_dmi($item[1]); } elsif ($item[0] eq 'hw.uuid'){ - $data{'board_uuid'} = $item[1]; + $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/; + 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"?([\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[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; + return $data; } sub get_device_sys { @@ -12887,23 +20168,25 @@ sub get_device_sys { return $device; } -sub get_device_vm { +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') ){ + 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'){ + elsif ($vm_test ne 'none'){ $vm = $vm_test; } } } - if (!$vm || lc($vm) eq 'bochs') { + if (!$vm || lc($vm) eq 'bochs'){ if (-e '/proc/vz'){$vm = 'openvz'} elsif (-e '/proc/xen'){$vm = 'xen'} elsif (-e '/dev/vzfs'){$vm = 'virtuozzo'} @@ -12911,37 +20194,53 @@ sub get_device_vm { my @vm_data = main::grabber("$program 2>/dev/null"); if (@vm_data){ if (grep {/kqemu/i} @vm_data){$vm = 'kqemu'} - elsif (grep {/kvm/i} @vm_data){$vm = 'kvm'} + 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' ) { + if (!$vm || lc($vm) eq 'bochs'){ # $device_vm is '' if nothing detected - my @vm_data = (@sysctl,@dmesg_boot,$device_vm); + 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){ + if (grep {/innotek|vbox|virtualbox/i} @vm_data){ $vm = 'virtualbox'; } elsif (grep {/vmware/i} @vm_data){ $vm = 'vmware'; } - elsif (grep {/Virtual HD/i} @vm_data){ + # 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 = main::system_files('cpuinfo'))){ + if (!$vm && (my $file = $system_files{'proc-cpuinfo'})){ my @info = main::reader($file); $vm = 'virtual-machine' if grep {/^flags.*hypervisor/} @info; } - if (!$vm && -e '/dev/vda' || -e '/dev/vdb' || -e '/dev/xvda' || -e '/dev/xvdb' ){ + # 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 (!$vm && $product_name){ if ($product_name eq 'VMware'){ $vm = 'vmware'; } @@ -12958,65 +20257,90 @@ sub get_device_vm { if (!$vm && $manufacturer && $manufacturer eq 'Xen'){ $vm = 'xen'; } + $b_vm = 1 if $vm; eval $end if $b_log; return $vm; } - } -## NetworkData +## NetworkItem { -package NetworkData; +package NetworkItem; my ($b_ip_run,@ifs_found); + sub get { eval $start if $b_log; - my (@rows); + my $rows = []; my $num = 0; - if (($b_arm || $b_mips) && !$b_soc_net && !$b_pci_tool){ + 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 { - push(@rows,device_output()); + device_output($rows); } - push(@rows,usb_output()); - # note: rasberry pi uses usb networking only - if (!@rows && ($b_arm || $b_mips)){ - my $type = ($b_arm) ? 'arm' : 'mips'; - my $key = 'Message'; - push(@rows, { - main::key($num++,0,1,$key) => main::row_defaults($type . '-pci',''), - },); + # 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){ - push(@rows,advanced_data_sys('check','',0,'','','')); + advanced_data_sys($rows,'check','',0,'','',''); } else { - push(@rows,advanced_data_bsd('check')); + advanced_data_bsd($rows,'check'); + } + if ($b_admin){ + info_data($rows); } } if ($show{'ip'}){ - push(@rows,wan_ip()); + wan_ip($rows); } eval $end if $b_log; - return @rows; + return $rows; } sub device_output { eval $start if $b_log; - my ($b_wifi,@rows,%holder); + return if !$devices{'network'}; + my $rows = $_[0]; + my ($b_wifi,%holder); my ($j,$num) = (0,1); - foreach my $row (@devices_network){ + foreach my $row (@{$devices{'network'}}){ $num = 1; - #print "$row->[0] $row->[3]\n"; - #print "$row->[0] $row->[3]\n"; - $j = scalar @rows; + # print "$row->[0] $row->[3]\n"; + # print "$row->[0] $row->[3]\n"; + $j = scalar @$rows; my $driver = $row->[9]; - my $chip_id = "$row->[5]:$row->[6]"; + 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; @@ -13026,143 +20350,153 @@ sub device_output { } # 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 $card = $row->[4]; - $card = ($card) ? main::pci_cleaner($card,'output') : 'N/A'; - #$card ||= 'N/A'; + 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') => $card, + push(@$rows, { + main::key($num++,1,1,'Device') => $device, },); - if ($extra > 0 && $b_pci_tool && $row->[12]){ + 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++,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++,0,2,'type')} = 'network bridge'; } - $rows[$j]->{main::key($num++,1,2,'driver')} = $driver; + $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 (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; + $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]; + $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 - $rows[$j]->{main::key($num++,0,2,'port')} = $row->[8] if (!$b_wifi || ( $b_wifi && $row->[8] ne 'N/A') ); - $rows[$j]->{main::key($num++,0,2,'bus ID')} = $bus_id; + 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; + $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]; + $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){ - @data = advanced_data_sys($row->[5],$row->[6],$holder{$chip_id},$b_wifi,'',$bus_id); + advanced_data_sys($rows,$row->[5],$row->[6],$holder{$chip_id},$b_wifi,'',$bus_id); } else { - @data = advanced_data_bsd("$row->[9]$row->[11]",$b_wifi) if defined $row->[9] && defined $row->[11]; + if (defined $row->[9] && defined $row->[11]){ + advanced_data_bsd($rows,"$row->[9]$row->[11]",$b_wifi); + } } - push(@rows,@data) if @data; } - #print "$row->[0]\n"; + # print "$row->[0]\n"; } # @rows = (); - # we want to handle ARM errors in main get - if (!@rows && !$b_arm && !$b_mips){ - my $key = 'Message'; - my $type = 'pci-card-data'; - if ($pci_tool && $alerts{$pci_tool}->{'action'} eq 'permissions'){ - $type = 'pci-card-data-root'; - } - push(@rows, { - main::key($num++,0,1,$key) => main::row_defaults($type,''), - },); - } eval $end if $b_log; - return @rows; } + sub usb_output { eval $start if $b_log; - my (@rows,@temp2,$b_wifi,$driver, - $path,$path_id,$product,$test,$type); + return if !$usb{'network'}; + my $rows = $_[0]; + my (@temp2,$b_wifi,$driver,$path,$path_id,$product,$type); my ($j,$num) = (0,1); - return if !@usb; - foreach my $row (@usb){ - # a device will always be the second or > device on the bus, except for - # daisychained hubs - if ($row->[1] > 1 && $row->[4] ne '09'){ - $num = 1; - ($driver,$path,$path_id,$product,$test,$type) = ('','','','','',''); - $product = main::cleaner($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]; - $test = "$driver $product $type"; - if ($product && network_device($test)){ - $driver ||= 'usb-network'; - push(@rows, { - main::key($num++,1,1,'Device') => $product, - main::key($num++,0,2,'type') => 'USB', - main::key($num++,0,2,'driver') => $driver, - },); - $b_wifi = check_wifi($product); - if ($extra > 0){ - $rows[$j]->{main::key($num++,0,2,'bus ID')} = "$path_id:$row->[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 ($extra > 1){ - $rows[$j]->{main::key($num++,0,2,'chip ID')} = $row->[7]; + if ($row->[24]){ + $rows->[$j]{main::key($num++,0,3,'lanes')} = $row->[24]; } - if ($extra > 2 && defined $row->[5] && $row->[5] ne ''){ - $rows[$j]->{main::key($num++,0,2,'class ID')} = "$row->[4]$row->[5]"; + if ($b_admin && $row->[22]){ + $rows->[$j]{main::key($num++,0,3,'mode')} = $row->[22]; } - if ($extra > 2 && $row->[16]){ - $rows[$j]->{main::key($num++,0,2,'serial')} = main::apply_filter($row->[16]); + } + $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 ($show{'network-advanced'}){ - my @data; - if (!$bsd_type){ - my (@temp,$vendor,$chip); - @temp = split(':', $row->[7]) if $row->[7]; - ($vendor,$chip) = ($temp[0],$temp[1]) if @temp; - @data = advanced_data_sys($vendor,$chip,0,$b_wifi,$path,''); - } - # NOTE: we need the driver.number, like wlp0 to get a match, and - # we can't get that from usb data, so we have to let it fall back down - # to the check function for BSDs. - #else { - # @data = advanced_data_bsd($row->[2],$b_wifi); - #} - push(@rows,@data) if @data; + if ($row->[16]){ + $rows->[$j]{main::key($num++,0,2,'serial')} = main::filter($row->[16]); } - $j = scalar @rows; + } + } + 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; - return @rows; } + sub advanced_data_sys { eval $start if $b_log; return if ! -d '/sys/class/net'; - my ($vendor,$chip,$count,$b_wifi,$path_usb,$bus_id) = @_; - my ($cont_if,$ind_if,$num) = (2,3,0); + 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,@row,@rows); + 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/ @@ -13174,7 +20508,8 @@ sub advanced_data_sys { @paths = main::globber('/sys/class/net/*'); } @paths = grep {!/\/lo$/} @paths; - if ( $count > 0 && $count < scalar @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'){ @@ -13182,12 +20517,14 @@ sub advanced_data_sys { $key = 'IF-ID'; ($cont_if,$ind_if) = (1,2); } - #print join('; ', @paths), $count, "\n"; + # 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){ - if (( !$b_arm && !$b_ppc) || $b_pci_tool ){ + # 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; @@ -13197,19 +20534,18 @@ sub advanced_data_sys { # this is a fix for a redhat bug in virtio $data2 = (defined $data2 && $data2 eq '0001' && defined $chip && $chip eq '1000') ? '1000' : $data2; } - elsif ($b_arm || $b_ppc) { - $path = Cwd::abs_path($_); - $path =~ /($chip)/; - if ($1){ - $data1 = $vendor; - $data2 = $chip; - } + # 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 && - ( ($b_arm || $b_mips || $b_ppc || $b_sparc) || check_bus_id($_,$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"; @@ -13219,59 +20555,56 @@ sub advanced_data_sys { $duplex ||= 'N/A'; $path = "$_/address"; $mac = main::reader($path,'',0) if -r $path; - $mac = main::apply_filter($mac); + $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"; - @row = ({ + # 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; + 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 : nont always there, but worth a try: wlan/wl/ww/wlp - $b_wifi = 1 if !$b_wifi && ( -e "$_$if/wireless" || $if =~ /^(wl|ww)/); + # /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; - $row[0]->{main::key($num++,0,$ind_if,'speed')} = $speed; - $row[0]->{main::key($num++,0,$ind_if,'duplex')} = $duplex; - } - $row[0]->{main::key($num++,0,$ind_if,'mac')} = $mac; - if ($b_check){ - push(@rows,@row); - } - else { - @rows = @row; - } + $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'}){ - @row = if_ip($key,$if); - push(@rows, @row); + if_ip($rows,$key,$if); } last if !$b_check; } } eval $end if $b_log; - return @rows; } sub advanced_data_bsd { eval $start if $b_log; return if ! @ifs_bsd; - my ($if,$b_wifi) = @_; - my (@data,@row,@rows,$working_if); + my ($rows,$if,$b_wifi) = @_; + my ($data,$working_if); my ($b_check,$state,$speed,$duplex,$mac); - my ($cont_if,$ind_if,$num) = (2,3,0); + my ($cont_if,$ind_if,$j,$num) = (2,3,0,0); my $key = 'IF'; - my $j = 0; if ($if eq 'check'){ $b_check = 1; $key = 'IF-ID'; @@ -13284,62 +20617,60 @@ sub advanced_data_bsd { next; } else { - @data = @$item; + $data = $item; } - if ( $b_check || $working_if eq $if){ + if ($b_check || $working_if eq $if){ $if = $working_if if $b_check; - # print "top: if: $if ifs: @ifs_found\n"; + # print "top1: if: $if ifs: wif: $working_if @ifs_found\n"; next if ($b_check && grep {/$if/} @ifs_found); - foreach my $line (@data){ - # ($state,$speed,$duplex,$mac) - $duplex = $data[2]; - $duplex ||= 'N/A'; - $mac = main::apply_filter($data[3]); - $speed = $data[1]; - $speed ||= 'N/A'; - $state = $data[0]; - $state ||= 'N/A'; - #print "$speed \n"; - @row = ({ - 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'){ - # make sure the value is strictly numeric before appending Mbps - $speed = ( main::is_int($speed) ) ? "$speed Mbps" : $speed; - $row[0]->{main::key($num++,0,$ind_if,'speed')} = $speed; - $row[0]->{main::key($num++,0,$ind_if,'duplex')} = $duplex; - } - $row[0]->{main::key($num++,0,$ind_if,'mac')} = $mac; - } - push(@rows, @row); + # 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){ - @row = if_ip($key,$if); - push(@rows,@row) if @row; + if_ip($rows,$key,$if); } } } eval $end if $b_log; - return @rows; } -## values: -# 0 - ipv -# 1 - ip -# 2 - broadcast, if found -# 3 - scope, if found -# 4 - scope if, if different from if + +## 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 ($type,$if) = @_; - my (@data,@rows,$working_if); - my ($cont_ip,$ind_ip) = (3,4); - my $num = 0; - my $j = 0; + 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); @@ -13351,24 +20682,23 @@ sub if_ip { # print "if:$if wif:$working_if\n"; next; } - else { - @data = @$item; - # print "ref:$item\n"; - } if ($working_if eq $if){ - foreach my $data2 (@data){ - $j = scalar @rows; + $if_cnt = 0; + # print "if $if item:\n", Data::Dumper::Dumper $item; + foreach my $data2 (@$item){ + $j = scalar @$rows; $num = 1; - if ($limit > 0 && $j >= $limit){ - push(@rows, { - main::key($num++,0,$cont_ip,'Message') => main::row_defaults('output-limit',scalar @data), - },); + $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"; + # print "$data2->[0] $data2->[1]\n"; my ($ipv,$ip,$broadcast,$scope,$scope_id); $ipv = ($data2->[0])? $data2->[0]: 'N/A'; - $ip = main::apply_filter($data2->[1]); + $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'){ @@ -13384,73 +20714,104 @@ sub if_ip { # 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, { + 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, { + 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, + 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::apply_filter($data2->[2]); - $rows[$j]->{main::key($num++,0,$ind_ip,'broadcast')} = $broadcast; + $broadcast = main::filter($data2->[2]); + $rows->[$j]{main::key($num++,0,$ind_ip,'broadcast')} = $broadcast; } } } } eval $end if $b_log; - return @rows; } -# get ip using downloader to stdout. This is a clean, text only IP output url, + +sub info_data { + eval $start if $b_log; + my ($rows) = @_; + my $j = scalar @$rows; + my $num = 0; + my $services; + PsData::set_cmd() if !$loaded{'ps-cmd'}; + 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 ' +# 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 (@data,$b_dig,$b_html,$ip,$ua); + 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 - # dig +short @ns1-1.akamaitech.net ANY whoami.akamai.net - # 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 - if (!$b_skip_dig && (my $program = main::check_program('dig') )){ + # 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 && !$b_no_html_wan) { - # note: tests: akamai: 0.055 - 0.065 icanhazip.com: 0.177 0.164 - # smxi: 0.525, so almost 10x slower. Dig is fast too + 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.059s: http://whatismyip.akamai.com/ - # 0.255s: https://get.geojs.io/v1/ip - # 0.371s: http://icanhazip.com/ - # 0.430s: https://smxi.org/opt/ip.php - my @urls = (!$wan_url) ? qw( http://whatismyip.akamai.com/ - http://icanhazip.com/ https://smxi.org/opt/ip.php) : ($wan_url); + # 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){ $ua = 'ip' if $_ =~ /smxi/; $ip = main::download_file('stdout',$_,'',$ua); @@ -13469,61 +20830,21 @@ sub wan_ip { if (!$ip){ # true case trips if (!$b_dig){ - $ip = main::row_defaults('IP-no-dig', 'WAN IP'); + $ip = main::message('IP-no-dig', 'WAN IP'); } elsif ($b_dig && !$b_html){ - $ip = main::row_defaults('IP-dig', 'WAN IP'); + $ip = main::message('IP-dig', 'WAN IP'); } else { - $ip = main::row_defaults('IP', 'WAN IP'); + $ip = main::message('IP', 'WAN IP'); } } - @data = ({ + push(@$rows, { main::key($num++,0,1,'WAN IP') => $ip, - },); + }); eval $end if $b_log; - return @data; } -### 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 - -# Wi-Fi.*Adapter Wireless.*Adapter Ethernet.*Adapter WLAN.*Adapter -# Network.*Adapter 802\.11 Atheros Atmel D-Link.*Adapter D-Link.*Wireless Linksys -# Netgea Ralink Realtek.*Network Realtek.*Wireless Realtek.*WLAN Belkin.*Wireless -# Belkin.*WLAN Belkin.*Network Actiontec.*Wireless Actiontec.*Network AirLink.*Wireless -# Asus.*Network Asus.*Wireless Buffalo.*Wireless Davicom DWA-.*RangeBooster DWA-.*Wireless -# ENUWI-.*Wireless LG.*Wi-Fi Rosewill.*Wireless RNX-.*Wireless Samsung.*LinkStick -# Samsung.*Wireless Sony.*Wireless TEW-.*Wireless TP-Link.*Wireless -# WG[0-9][0-9][0-9].*Wireless WNA[0-9][0-9][0-9] WNDA[0-9][0-9][0-9] -# Zonet.*ZEW.*Wireless -sub network_device { - eval $start if $b_log; - my ($device_string) = @_; - my ($b_network); - # belkin=050d; d-link=07d1; netgear=0846; ralink=148f; realtek=0bda; - # Atmel makes other stuff. NOTE: exclude 'networks': IMC Networks - my @tests = qw(wifi Wi-Fi.*Adapter Ethernet \bLAN\b WLAN Network\b Networking\b - 802\.1[15] 802\.3 - Wireless.*Adapter 54\sMbps 100\/1000 NBase-T Mobile\sBroadband Atheros D-Link.*Adapter - Dell.*Wireless D-Link.*Wireless Linksys Netgea Ralink Realtek.*Network Realtek.*Wireless - Belkin.*Wireless Actiontec.*Wireless AirLink.*Wireless Asus.*Wireless - Buffalo.*Wireless Davicom DWA-.*RangeBooster DWA-.*Wireless - ENUWI-.*Wireless LG.*Wi-Fi Rosewill.*Wireless RNX-.*Wireless Samsung.*LinkStick - Samsung.*Wireless Sony.*Wireless TEW-.*Wireless TP-Link.*Wireless - WG[0-9][0-9][0-9].*Wireless WNA[0-9][0-9][0-9] WNDA[0-9][0-9][0-9] - Zonet.*ZEW.*Wireless 050d:935b 0bda:8189 0bda:8197 - ); - foreach (@tests){ - if ($device_string =~ /$_/i ){ - $b_network = 1; - last; - } - } - eval $end if $b_log; - return $b_network; -} sub check_bus_id { eval $start if $b_log; my ($path,$bus_id) = @_; @@ -13532,134 +20853,129 @@ sub check_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") ) ) ){ + (-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|wifi|wi-fi|wlan|802\.11|centrino/i) ? 1 : 0; + my $b_wifi = ($item =~ /wireless|wi-?fi|wlan|802\.11|centrino/i) ? 1 : 0; return $b_wifi; } } -## OpticalData +## OpticalItem { -package OpticalData; +package OpticalItem; sub get { eval $start if $b_log; - my (%data,@rows,$key1,$val1); + my $rows = $_[0]; + my $rows_start = scalar @$rows; + my ($data,$val1); my $num = 0; if ($bsd_type){ - #%data = optical_data_bsd(); - $key1 = 'Optical Report'; - $val1 = main::row_defaults('optical-data-bsd'); - @rows = ({main::key($num++,0,1,$key1) => $val1,}); - if ( @dm_boot_optical){ - %data = optical_data_bsd(); - @rows = optical_output(\%data) if %data; + $val1 = main::message('optical-data-bsd'); + if ($dboot{'optical'}){ + $data = drive_data_bsd(); + drive_output($rows,$data) if %$data; } else{ - my $file = main::system_files('dmesg-boot'); - if ( $file && ! -r $file ){ - $val1 = main::row_defaults('dmesg-boot-permissions'); + my $file = $system_files{'dmesg-boot'}; + if ($file && ! -r $file){ + $val1 = main::message('dmesg-boot-permissions'); } elsif (!$file){ - $val1 = main::row_defaults('dmesg-boot-missing'); + $val1 = main::message('dmesg-boot-missing'); } - else { - $val1 = main::row_defaults('optical-data-bsd'); - } - $key1 = 'Optical Report'; - @rows = ({main::key($num++,0,1,$key1) => $val1,}); } } else { - %data = optical_data_linux(); - @rows = optical_output(\%data) if %data; + $val1 = main::message('optical-data'); + $data = drive_data_linux(); + drive_output($rows,$data) if %$data; } - if (!@rows){ - $key1 = 'Message'; - $val1 = main::row_defaults('optical-data'); - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + # 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; + return $rows; } -sub optical_output { + +sub drive_output { eval $start if $b_log; - my ($devices) = @_; - my (@rows); + my ($rows,$drives) = @_; my $num = 0; my $j = 0; # build floppy if any - foreach my $key (sort keys %$devices){ - if ($devices->{$key}{'type'} eq 'floppy'){ - push(@rows, { - main::key($num++,0,1,ucfirst($devices->{$key}{'type'})) => "/dev/$key", + 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 $devices->{$key}; + delete $drives->{$key}; } } - foreach my $key (sort keys %$devices){ - $j = scalar @rows; + foreach my $key (sort keys %$drives){ + $j = scalar @$rows; $num = 1; - my $vendor = $devices->{$key}{'vendor'}; + my $vendor = $drives->{$key}{'vendor'}; $vendor ||= 'N/A'; - my $model = $devices->{$key}{'model'}; + my $model = $drives->{$key}{'model'}; $model ||= 'N/A'; - push(@rows, { - main::key($num++,1,1,ucfirst($devices->{$key}{'type'})) => "/dev/$key", + 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 = $devices->{$key}{'rev'}; + my $rev = $drives->{$key}{'rev'}; $rev ||= 'N/A'; - $rows[$j]->{ main::key($num++,0,2,'rev')} = $rev; + $rows->[$j]{ main::key($num++,0,2,'rev')} = $rev; } - if ($extra > 1 && $devices->{$key}{'serial'}){ - $rows[$j]->{ main::key($num++,0,2,'serial')} = main::apply_filter($devices->{$key}{'serial'}); + if ($extra > 1 && $drives->{$key}{'serial'}){ + $rows->[$j]{ main::key($num++,0,2,'serial')} = main::filter($drives->{$key}{'serial'}); } - my $links = (@{$devices->{$key}{'links'}}) ? join(',', sort @{$devices->{$key}{'links'}}) : 'N/A' ; - $rows[$j]->{ main::key($num++,0,2,'dev-links')} = $links; + 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 = $devices->{$key}{'speed'}; + $j = scalar @$rows; + my $speed = $drives->{$key}{'speed'}; $speed ||= 'N/A'; my ($audio,$multisession) = ('',''); - if (defined $devices->{$key}{'multisession'}){ - $multisession = ( $devices->{$key}{'multisession'} == 1 ) ? 'yes' : 'no' ; + if (defined $drives->{$key}{'multisession'}){ + $multisession = ($drives->{$key}{'multisession'} == 1) ? 'yes' : 'no' ; } $multisession ||= 'N/A'; - if (defined $devices->{$key}{'audio'}){ - $audio = ( $devices->{$key}{'audio'} == 1 ) ? 'yes' : 'no' ; + if (defined $drives->{$key}{'audio'}){ + $audio = ($drives->{$key}{'audio'} == 1) ? 'yes' : 'no' ; } $audio ||= 'N/A'; my $dvd = 'N/A'; my (@rw,$rws); - if (defined $devices->{$key}{'dvd'}){ - $dvd = ( $devices->{$key}{'dvd'} == 1 ) ? 'yes' : 'no' ; + if (defined $drives->{$key}{'dvd'}){ + $dvd = ($drives->{$key}{'dvd'} == 1) ? 'yes' : 'no' ; } - if ($devices->{$key}{'cdr'}){ + if ($drives->{$key}{'cdr'}){ push(@rw, 'cd-r'); } - if ($devices->{$key}{'cdrw'}){ + if ($drives->{$key}{'cdrw'}){ push(@rw, 'cd-rw'); } - if ($devices->{$key}{'dvdr'}){ + if ($drives->{$key}{'dvdr'}){ push(@rw, 'dvd-r'); } - if ($devices->{$key}{'dvdram'}){ + if ($drives->{$key}{'dvdram'}){ push(@rw, 'dvd-ram'); } $rws = (@rw) ? join(',', @rw) : 'none' ; - push(@rows, { + push(@$rows, { main::key($num++,1,2,'Features') => '', main::key($num++,0,3,'speed') => $speed, main::key($num++,0,3,'multisession') => $multisession, @@ -13667,22 +20983,23 @@ sub optical_output { main::key($num++,0,3,'dvd') => $dvd, main::key($num++,0,3,'rw') => $rws, }); - if ($extra > 0 ){ - my $state = $devices->{$key}{'state'}; + if ($extra > 0){ + my $state = $drives->{$key}{'state'}; $state ||= 'N/A'; - $rows[$j]->{ main::key($num++,0,3,'state')} = $state; + $rows->[$j]{ main::key($num++,0,3,'state')} = $state; } } } - #print Data::Dumper::Dumper \%devices; + # print Data::Dumper::Dumper $drives; eval $end if $b_log; - return @rows; } -sub optical_data_bsd { + +sub drive_data_bsd { eval $start if $b_log; - my (%devices,@rows,@temp); + my (@rows,@temp); + my $drives = {}; my ($count,$i,$working) = (0,0,''); - foreach (@dm_boot_optical){ + foreach (@{$dboot{'optical'}}){ $_ =~ s/(cd[0-9]+)\(([^:]+):([0-9]+):([0-9]+)\):/$1:$2-$3.$4,/; my @row = split(/:\s*/, $_); next if ! defined $row[1]; @@ -13691,100 +21008,100 @@ sub optical_data_bsd { $working = $row[0]; } # no dots, note: ada2: 2861588MB BUT: ada2: 600.000MB/s - if (! exists $devices{$working}){ - $devices{$working}->{'links'} = ([]); - $devices{$working}->{'model'} = ''; - $devices{$working}->{'rev'} = ''; - $devices{$working}->{'state'} = ''; - $devices{$working}->{'vendor'} = ''; - $devices{$working}->{'temp'} = ''; - $devices{$working}->{'type'} = ($working =~ /^cd/) ? 'optical' : 'unknown'; - } - #print "$_\n"; - if ($bsd_type ne 'openbsd'){ + 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] =~ /^<([^>]+)>/){ - $devices{$working}->{'model'} = $1; - $count = ($devices{$working}->{'model'} =~ tr/ //); + $drives->{$working}{'model'} = $1; + $count = ($drives->{$working}{'model'} =~ tr/ //); if ($count && $count > 1){ - @temp = split(/\s+/, $devices{$working}->{'model'}); - $devices{$working}->{'vendor'} = $temp[0]; - my $index = ($#temp > 2 ) ? ($#temp - 1): $#temp; - $devices{$working}->{'model'} = join(' ', @temp[1..$index]); - $devices{$working}->{'rev'} = $temp[-1] if $count > 2; + @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/){ - $devices{$working}->{'dvd'} = 1; + $drives->{$working}{'dvd'} = 1; } if (/\bRW\b/){ - $devices{$working}->{'cdrw'} = 1; - $devices{$working}->{'dvdr'} = 1 if $devices{$working}->{'dvd'}; + $drives->{$working}{'cdrw'} = 1; + $drives->{$working}{'dvdr'} = 1 if $drives->{$working}{'dvd'}; } } } if ($row[1] && $row[1] =~ /^Serial/){ @temp = split(/\s+/,$row[1]); - $devices{$working}->{'serial'} = $temp[-1]; + $drives->{$working}{'serial'} = $temp[-1]; } if ($show{'optical'}){ if ($row[1] =~ /^([0-9\.]+[MGTP][B]?\/s)/){ - $devices{$working}->{'speed'} = $1; - $devices{$working}->{'speed'} =~ s/\.[0-9]+//; + $drives->{$working}{'speed'} = $1; + $drives->{$working}{'speed'} =~ s/\.[0-9]+//; } if (/\bDVD[-]?RAM\b/){ - $devices{$working}->{'cdr'} = 1; - $devices{$working}->{'dvdram'} = 1; + $drives->{$working}{'cdr'} = 1; + $drives->{$working}{'dvdram'} = 1; } if ($row[2] && $row[2] =~ /,\s(.*)$/){ - $devices{$working}->{'state'} = $1; - $devices{$working}->{'state'} =~ s/\s+-\s+/, /; + $drives->{$working}{'state'} = $1; + $drives->{$working}{'state'} =~ s/\s+-\s+/, /; } } } else { if ($row[2] && $row[2] =~ /<([^>]+)>/){ - $devices{$working}->{'model'} = $1; - $count = ($devices{$working}->{'model'} =~ tr/,//); - #print "c: $count $row[2]\n"; + $drives->{$working}{'model'} = $1; + $count = ($drives->{$working}{'model'} =~ tr/,//); + # print "c: $count $row[2]\n"; if ($count && $count > 1){ - @temp = split(/,\s*/, $devices{$working}->{'model'}); - $devices{$working}->{'vendor'} = $temp[0]; - $devices{$working}->{'model'} = $temp[1]; - $devices{$working}->{'rev'} = $temp[2]; + @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/){ - $devices{$working}->{'dvd'} = 1; + $drives->{$working}{'dvd'} = 1; } if (/\bRW\b/){ - $devices{$working}->{'cdrw'} = 1; - $devices{$working}->{'dvdr'} = 1 if $devices{$working}->{'dvd'}; + $drives->{$working}{'cdrw'} = 1; + $drives->{$working}{'dvdr'} = 1 if $drives->{$working}{'dvd'}; } if (/\bDVD[-]?RAM\b/){ - $devices{$working}->{'cdr'} = 1; - $devices{$working}->{'dvdram'} = 1; + $drives->{$working}{'cdr'} = 1; + $drives->{$working}{'dvdram'} = 1; } } } if ($show{'optical'}){ - #print "$row[1]\n"; + # print "$row[1]\n"; if (($row[1] =~ tr/,//) > 1){ @temp = split(/,\s*/, $row[1]); - $devices{$working}->{'speed'} = $temp[2]; + $drives->{$working}{'speed'} = $temp[2]; } - } } } - - main::log_data('dump','%devices',\%devices) if $b_log; - #print Data::Dumper::Dumper \%devices; + main::log_data('dump','%$drives',$drives) if $b_log; + # print Data::Dumper::Dumper $drives; eval $end if $b_log; - return %devices; + return $drives; } -sub optical_data_linux { + +sub drive_data_linux { eval $start if $b_log; - my (@data,%devices,@info,@rows); + 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, @@ -13796,36 +21113,36 @@ sub optical_data_linux { # possible fix: puppy has these in /mnt not /dev they say $working =~ s/\/(dev|media|mnt)\///; $_ =~ s/\/(dev|media|mnt)\///; - if (!defined $devices{$working}){ + if (!defined $drives->{$working}){ my @temp = ($_ ne $working) ? ($_) : (); - $devices{$working}->{'links'} = \@temp; - $devices{$working}->{'type'} = ($working =~ /^fd/) ? 'floppy' : 'optical' ; + $drives->{$working}{'links'} = \@temp; + $drives->{$working}{'type'} = ($working =~ /^fd/) ? 'floppy' : 'optical' ; } else { - push(@{$devices{$working}->{'links'}}, $_) if $_ ne $working; + push(@{$drives->{$working}{'links'}}, $_) if $_ ne $working; } - #print "$working\n"; + # 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 %devices){ - next if $devices{$key}->{'type'} eq 'floppy'; + # 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 (-d $device){ if (-r "$device/vendor"){ - $devices{$key}->{'vendor'} = main::reader("$device/vendor",'',0); - $devices{$key}->{'vendor'} = main::cleaner($devices{$key}->{'vendor'}); - $devices{$key}->{'state'} = main::reader("$device/state",'',0); - $devices{$key}->{'model'} = main::reader("$device/model",'',0); - $devices{$key}->{'model'} = main::cleaner($devices{$key}->{'model'}); - $devices{$key}->{'rev'} = main::reader("$device/rev",'',0); + $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"){ - $devices{$key}->{'vendor'} = main::reader("/proc/ide/$key/model",'',0); - $devices{$key}->{'vendor'} = main::cleaner($devices{$key}->{'vendor'}); + 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; @@ -13837,73 +21154,78 @@ sub optical_data_linux { last if ($id eq $key); $index++; } - last if ! $index; # index will be > 0 if it was found + last if !$index; # index will be > 0 if it was found } - elsif ($item =~/^drive speed:/) { - $devices{$key}->{'speed'} = $split[$index]; + elsif ($item =~/^drive speed:/){ + $drives->{$key}{'speed'} = $split[$index]; } - elsif ($item =~/^Can read multisession:/) { - $devices{$key}->{'multisession'}=$split[$index+1]; + elsif ($item =~/^Can read multisession:/){ + $drives->{$key}{'multisession'}=$split[$index+1]; } - elsif ($item =~/^Can read MCN:/) { - $devices{$key}->{'mcn'}=$split[$index+1]; + elsif ($item =~/^Can read MCN:/){ + $drives->{$key}{'mcn'}=$split[$index+1]; } - elsif ($item =~/^Can play audio:/) { - $devices{$key}->{'audio'}=$split[$index+1]; + elsif ($item =~/^Can play audio:/){ + $drives->{$key}{'audio'}=$split[$index+1]; } - elsif ($item =~/^Can write CD-R:/) { - $devices{$key}->{'cdr'}=$split[$index+1]; + elsif ($item =~/^Can write CD-R:/){ + $drives->{$key}{'cdr'}=$split[$index+1]; } - elsif ($item =~/^Can write CD-RW:/) { - $devices{$key}->{'cdrw'}=$split[$index+1]; + elsif ($item =~/^Can write CD-RW:/){ + $drives->{$key}{'cdrw'}=$split[$index+1]; } - elsif ($item =~/^Can read DVD:/) { - $devices{$key}->{'dvd'}=$split[$index+1]; + elsif ($item =~/^Can read DVD:/){ + $drives->{$key}{'dvd'}=$split[$index+1]; } - elsif ($item =~/^Can write DVD-R:/) { - $devices{$key}->{'dvdr'}=$split[$index+1]; + elsif ($item =~/^Can write DVD-R:/){ + $drives->{$key}{'dvdr'}=$split[$index+1]; } - elsif ($item =~/^Can write DVD-RAM:/) { - $devices{$key}->{'dvdram'}=$split[$index+1]; + elsif ($item =~/^Can write DVD-RAM:/){ + $drives->{$key}{'dvdram'}=$split[$index+1]; } } } } - main::log_data('dump','%devices',\%devices) if $b_log; - #print Data::Dumper::Dumper \%devices; + main::log_data('dump','%$drives',$drives) if $b_log; + # print Data::Dumper::Dumper $drives; eval $end if $b_log; - return %devices; + return $drives; } - } -## PartitionData +## PartitionItem { -package PartitionData; +# 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 (@rows,$key1,$val1); + my ($key1,$val1); + my $rows = []; my $num = 0; - partition_data() if !$b_partitions; - if (!@partitions) { + 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::row_defaults('darwin-feature') : main::row_defaults('partition-data'); - $val1 = main::row_defaults('partition-data'); - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + # main::message('darwin-feature') : main::message('partition-data'); + $val1 = main::message('partition-data'); + @$rows = ({main::key($num++,0,1,$key1) => $val1,}); } else { - @rows = partition_output(); + create_output($rows); } eval $end if $b_log; - return @rows; + return $rows; } -sub partition_output { + +sub create_output { eval $start if $b_log; + my $rows = $_[0]; my $num = 0; my $j = 0; - my (%part,@rows,$dev,$dev_type,$fs,$percent,$raw_size,$size,$used); + 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; @@ -13911,6 +21233,7 @@ sub partition_output { 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'}; @@ -13918,160 +21241,225 @@ sub partition_output { 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 = ($row->{'used'}) ? main::get_size($row->{'used'},'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::row_defaults('root-required') : main::row_defaults('partition-hidden'); + $used = $size = (!$b_root) ? main::message('root-required') : main::message('partition-hidden'); } - %part = (); $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, { + $j = scalar @$rows; + push(@$rows, { main::key($num++,1,1,'ID') => $row->{'id'}, }); - if (($b_admin || $row->{'hidden'}) && $row->{'raw-size'} ){ + 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; + $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; + $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'}; + $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'}; + $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'}; + $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++,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; + $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'}; + $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'}; + $rows->[$j]{main::key($num++,0,3,'mapped')} = $row->{'dev-mapped'}; } - if ($show{'label'}){ - $row->{'label'} = main::apply_partition_filter('part', $row->{'label'}, '') if $use{'filter-label'}; - $rows[$j]->{main::key($num++,0,2,'label')} = ($row->{'label'}) ? $row->{'label'}: 'N/A'; - } - if ($show{'uuid'}){ - $row->{'uuid'} = main::apply_partition_filter('part', $row->{'uuid'}, '') if $use{'filter-uuid'}; - $rows[$j]->{main::key($num++,0,2,'uuid')} = ($row->{'uuid'}) ? $row->{'uuid'}: 'N/A'; + # 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'}){ + $row->{'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'}){ + $row->{'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; - return @rows; } -sub partition_data { +sub set_partitions { eval $start if $b_log; - #return if $bsd_type && $bsd_type eq 'darwin'; # darwin has muated output, of course - my (@data,@rows,@mount,@partitions_working,%part,@working); - my ($b_fake_map,$b_fs,$b_load,$b_space,$cols,$roots) = (0,1,0,0,6,0); - my ($back_size,$back_used) = (4,3); + # 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); - $b_partitions = 1; + $loaded{'set-partitions'} = 1; if ($b_admin){ - # for partition block size + # For partition block size $blockdev = $alerts{'blockdev'}->{'path'} if $alerts{'blockdev'}->{'path'}; } - # for raw partition sizes, maj_min - main::set_proc_partitions() if !$bsd_type && !$b_proc_partitions; - main::set_lsblk() if !$bsd_type && !$b_lsblk; - # set labels, uuid, gpart - set_label_uuid() if !$b_label_uuid; - # most current OS support -T and -k, but -P means different things + # 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 (!$bsd_type){ - @partitions_working = main::grabber("df -P -T -k 2>/dev/null"); - main::set_mapper() if !$b_mapper; + 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 { - # this is missing the file system data - if ($bsd_type ne 'darwin'){ - @partitions_working = main::grabber("df -T -k 2>/dev/null"); + 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); + } + # 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,$_); } - #Filesystem 1024-blocks Used Available Capacity iused ifree %iused Mounted on - else { - $cols = 8; - ($back_size,$back_used) = (7,6); + @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; - } - # busybox only supports -k and -P, openbsd, darwin - if (!@partitions_working){ - @partitions_working = main::grabber("df -k 2>/dev/null"); - $b_fs = 0; - $cols = 5 if !$bsd_type || $bsd_type ne 'darwin'; - if (my $path = main::check_program('mount')){ - @mount = main::grabber("$path 2>/dev/null"); + # 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); } } - # determine positions - my $row1 = shift @partitions_working; - # 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 - foreach (@partitions_working){ - $roots++ if /\s\/$/; - } - @partitions_working = grep {!/^rootfs/} @partitions_working if $roots > 1; - # IMPORTANT: check the lsblk completer tool check_partition_data() for matching lsblck - # filters. - my $filters = 'aufs|cgroup.*|cgmfs|configfs|debugfs|\/dev|dev|\/dev\/loop[0-9]*|'; - $filters .= 'devfs|devtmpfs|fdescfs|iso9660|linprocfs|none|procfs|\/run(\/.*)?|'; - $filters .= 'run|shm|squashfs|sys|\/sys\/.*|sysfs|tmpfs|type|udev|unionfs|vartmp'; - #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'; + 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; - $b_space = 0; # handle spaces in remote filesystem names - # busybox df shows KM, sigh. - if (/^(.*)(\s[\S]+)\s+[a-z][a-z0-9]+\s+[0-9]+/){ + # 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/){ + if ($test =~ /\s/){ # paranoid test, but better safe than sorry $b_space = 1; $replace =~ s/\s/^^/g; - #print ":$replace:\n"; + # print ":$replace:\n"; $_ =~ s/^$test/$replace/; - #print "$_\n"; + # 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)$/ ) )){ + if ($row[0] =~ /^$filters$/ || $row[0] =~ /^ROOT/i || + ($b_fs && ($row[2] == 0 || $row[1] =~ /^(autofs|devtmpfs|iso9660|tmpfs)$/))){ next; } - ($dev_base,$dev_mapped,$dev_type,$fs,$id,$label, - $maj_min,$type,$uuid) = ('','','','','','','','',''); - ($b_load,$block_size,$percent_used,$raw_size,$size_available, - $size,$used) = (0,0,0,0,0,0,0,0); - %part = (); - # NOTE: using -P for linux fixes line wraps, and for bsds, assuming they don't use such long file names + # 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. @@ -14094,20 +21482,22 @@ sub partition_data { } $dev_base = $row[0]; $dev_base =~ s|^/.*/||; - %part = main::get_lsblk($dev_base) if @lsblk; + $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|zfs)$/ ) ) ){ + 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 = 'raid'; + $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_android && $row[-1] =~ /^\/(cache|data|firmware|system)$/)){ $b_load = 1; # note, older df in bsd do not have file system column $type = 'main'; @@ -14122,38 +21512,33 @@ sub partition_data { if ($b_load){ if (!$bsd_type){ if ($b_fs){ - $fs = (%part && $part{'fs'}) ? $part{'fs'} : $row[1]; + $fs = ($part->{'fs'}) ? $part->{'fs'} : $row[1]; } else { $fs = get_mounts_fs($row[0],\@mount); } - if ($show{'label'}) { - if (%part && $part{'label'}) { - $label = $part{'label'}; + if ($show{'label'}){ + if ($part->{'label'}){ + $label = $part->{'label'}; } - elsif ( @labels){ + elsif (@labels){ $label = get_label($row[0]); } } - if ($show{'uuid'}) { - if (%part && $part{'uuid'}) { - $uuid = $part{'uuid'}; + if ($show{'uuid'}){ + if ($part->{'uuid'}){ + $uuid = $part->{'uuid'}; } - elsif ( @uuids){ + elsif (@uuids){ $uuid = get_uuid($row[0]); } } } else { $fs = ($b_fs) ? $row[1]: get_mounts_fs($row[0],\@mount); - if (@gpart && ($show{'label'} || $show{'uuid'} ) ){ - my @extra = get_bsd_label_uuid("$dev_base"); - if (@extra){ - $label = $extra[0]; - $uuid = $extra[1]; - } - } } + # 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/"){ @@ -14162,29 +21547,62 @@ sub partition_data { $size_available = $working[1]; $block_size = $working[2]; } - $dev_base =~ s/\^\^/ /g if $b_space; 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 - if ($dev_base =~ /^map:\/(.*)/){ + elsif ($dev_base =~ /^map:\/(.*)/){ $dev_type = 'mapped'; $dev_base = $1; } - # note: I have seen this: beta:data/ for sshfs path - elsif ($dev_base =~ /^\/\/|:\//){ + # 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; } - # an error has occurred almost for sure elsif (!$dev_base){ - $dev_type = 'source'; - $dev_base = main::row_defaults('unknown-dev'); + 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) ); + $percent_used = sprintf("%.1f", ($used/$size)*100) if ($size && main::is_numeric($size)); push(@partitions,{ 'block-size' => $block_size, 'dev-base' => $dev_base, @@ -14204,46 +21622,48 @@ sub partition_data { }); } } - @data = swap_data(); - push(@partitions,@data); - # print Data::Dumper::Dumper \@partitions if $test[16]; + 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 $test[16]; + print Data::Dumper::Dumper \@partitions if $dbg[16]; eval $end if $b_log; } sub swap_data { eval $start if $b_log; - return @swaps if $b_swaps; - $b_swaps = 1; + $loaded{'set-swap'} = 1; my (@data,@working); - my ($cache_pressure,$dev_base,$dev_mapped,$dev_type,$label,$maj_min, - $mount,$path,$pattern1,$pattern2,$percent_used,$priority,$size, - $swap_type,$swappiness,$used,$uuid); + 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'){ + if (-r '/proc/swaps'){ @working = main::reader("/proc/swaps"); } - elsif ( $path = main::check_program('swapon') ){ + 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){ - @data = swap_advanced_data(); - $swappiness = $data[0]; - $cache_pressure = $data[1]; + 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') ){ + if ($path = main::check_program('swapctl')){ # output in in KB blocks @working = main::grabber("$path -l -k 2>/dev/null"); } @@ -14256,13 +21676,20 @@ sub swap_data { # data, it's the same exact output as swapon -s foreach (@working){ #next if ! /^\/dev/ || /^\/dev\/(ramzwap|zram)/; - next if /^(Device|Filename)/; - ($dev_base,$dev_mapped,$dev_type,$label,$maj_min,$mount,$priority, - $swap_type,$uuid) = ('','','','','','',undef,'partition',''); + next if /^(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+/, $_); - if (/^\/dev\/(block\/)?(compcache|ramzwap|zram)/i){ + # /dev/zramX; ramzswapX == compcache, legacy version of zram. + # /run/initramfs/dev/zram0; /dev/ramzswap0 + if (/^\/(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'; @@ -14271,20 +21698,23 @@ sub swap_data { $swap_type = 'partition'; $dev_base = $data[0]; $dev_base =~ s|^/dev/||; - if (!$bsd_type && $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]); + 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]); + } } - if ($bsd_type && @gpart && ($show{'label'} || $show{'uuid'} ) ){ - my @extra = get_bsd_label_uuid("$dev_base"); - if (@extra){ - $label = $extra[0]; - $uuid = $extra[1]; + else { + if ($show{'label'} || $show{'uuid'}){ + my $temp = DiskDataBSD::get($data[0]); + $block_size = $temp->{'logical-block-size'}; + $label = $temp->{'label'}; + $uuid = $temp->{'uuid'}; } } $dev_type = 'dev'; @@ -14302,8 +21732,9 @@ sub swap_data { } $size = $data[$size_id]; $used = $data[$used_id]; - $percent_used = sprintf("%.1f", ( $used/$size )*100); + $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, @@ -14321,140 +21752,108 @@ sub swap_data { '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 $test[15];; + print Data::Dumper::Dumper \@swaps if $dbg[15];; eval $end if $b_log; - return @swaps; } + +# 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; - my ($swappiness,$cache_pressure) = (undef,undef); - if (-r "/proc/sys/vm/swappiness"){ - $swappiness = main::reader("/proc/sys/vm/swappiness",'',0); - if (defined $swappiness){ - $swappiness .= ($swappiness == 60) ? ' (default)' : ' (default 60)' ; - } - } - if (-r "/proc/sys/vm/vfs_cache_pressure"){ - $cache_pressure = main::reader("/proc/sys/vm/vfs_cache_pressure",'',0); - if (defined $cache_pressure){ - $cache_pressure .= ($cache_pressure == 100) ? ' (default)' : ' (default 100)' ; + if (-r '/proc/sys/vm/swappiness'){ + ${$_[0]} = main::reader('/proc/sys/vm/swappiness','',0); + if (defined ${$_[0]}){ + ${$_[0]} .= (${$_[0]} == 60) ? ' (default)' : ' (default 60)' ; } } - eval $end if $b_log; - return ($swappiness,$cache_pressure); -} -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) - foreach (@$mount){ - if ($bsd_type && $_ =~ /^$item\son.*\(([^,\s\)]+)[,\s]*.*\)/){ - $fs = $1; - last; - } - elsif (!$bsd_type && $_ =~ /^$item\son.*\stype\s([\S]+)\s\([^\)]+\)/){ - $fs = $1; - last; + 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)' ; } } - eval $end if $b_log; - main::log_data('data',"fs: $fs") if $b_log; - return $fs; -} -# 1. Name: ada1p1 -# label: (null) -# label: ssd-root -# rawuuid: b710678b-f196-11e1-98fd-021fc614aca9 -sub get_bsd_label_uuid { - eval $start if $b_log; - my ($item) = @_; - my (@data,$b_found); - foreach (@gpart){ - my @working = split(/\s*:\s*/, $_); - if ($_ =~ /^[0-9]+\.\sName:/ && $working[1] eq $item){ - $b_found = 1; + 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 ($_ =~ /^[0-9]+\.\sName:/ && $working[1] ne $item){ - $b_found = 0; + elsif (${$_[2]} =~ /^(N|no|false|0)$/){ + ${$_[2]} = 'no'; } - if ($b_found){ - if ($working[0] eq 'label'){ - $data[0] = $working[1]; - $data[0] =~ s/\(|\)//g; # eg: label:(null) - we want to show null - } - if ($working[0] eq 'rawuuid'){ - $data[1] = $working[1]; - $data[0] =~ s/\(|\)//g; - } + else { + ${$_[2]} = 'unset'; } } - main::log_data('dump','@data',\@data) if $b_log; + 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; - return @data; } -sub set_label_uuid { - eval $start if $b_log; - $b_label_uuid = 1; - if ( $show{'unmounted'} || $show{'label'} || $show{'uuid'} ){ - if (!$bsd_type){ - 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/*'); - } - } - else { - if ( my $path = main::check_program('gpart')){ - @gpart = main::grabber("$path list 2>/dev/null",'','strip'); - } + +# 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; } } - eval $end if $b_log; + if (-r "/sys/block/$_[0]/max_comp_streams"){ + ${$_[3]} = main::reader("/sys/block/$_[0]/max_comp_streams",'',0); + } } -# handle cases of hidden file systems +# Handle cases of hidden file systems sub check_partition_data { eval $start if $b_log; my ($b_found,$dev_mapped,$temp); - # NOTE: these filters must match the fs filters in sub partitiion_data!! - my $fs_filters = 'aufs|cgmfs|configfs|devfs|devtmpfs|'; - $fs_filters .= 'fdescfs|linprocfs|procfs|squashfs|swap|'; - $fs_filters .= 'sysfs|tmpfs|unionfs'; + 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'} =~ /^($fs_filters)$/) || + ($row->{'fs'} && $row->{'fs'} =~ /^$filters$/) || ($row->{'type'} =~ /^(disk|loop|rom)$/)){ next; } - #print "$row->{'name'} $row->{'mount'}\n"; + # 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 "m:$row->{'mount'} id:$row2->{'id'}\n"; + # print "1: n:$row->{'name'} m:$row->{'mount'} db:$row2->{'dev-base'} id:$row2->{'id'}\n"; next if !$row2->{'id'}; - if ($row->{'mount'} eq $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; - if (%mapper && $mapper{$row->{'name'}}){ - $dev_mapped = $row->{'name'}; - $row->{'name'} = $mapper{$row->{'name'}}; - } last; } - #print "m:$row->{'mount'} id:$row2->{'id'}\n"; + # print "m:$row->{'mount'} id:$row2->{'id'}\n"; } if (!$b_found){ - #print "found: $row->{'name'} $row->{'mount'}\n"; + # 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'}, @@ -14475,7 +21874,119 @@ sub check_partition_data { } eval $end if $b_log; } -# args: 1: blockdev full path (part only); 2: block id; 3: size (part only) + +# 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) = @_; @@ -14494,7 +22005,7 @@ sub admin_data { $size_raw = 'N/A'; } else { - $percent = sprintf("%.2f", ($size/$size_raw ) * 100) if $size && $size_raw; + $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); @@ -14502,6 +22013,7 @@ sub admin_data { eval $end if $b_log; return @sizes; } + sub get_maj_min { eval $start if $b_log; my ($id) = @_; @@ -14515,6 +22027,7 @@ sub get_maj_min { eval $end if $b_log; return $maj_min; } + sub get_label { eval $start if $b_log; my ($item) = @_; @@ -14532,6 +22045,7 @@ sub get_label { eval $end if $b_log; return $label; } + sub get_root { eval $start if $b_log; my ($path) = ('/dev/root'); @@ -14575,393 +22089,417 @@ sub get_uuid { } } -## ProcessData +## ProcessItem { -package ProcessData; +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); + my $rows = []; if (@ps_aux){ + $header = $ps_data{'header'}; # will always be set if @ps_aux if ($show{'ps-cpu'}){ - push(@rows,cpu_processes()); + cpu_processes($rows); } if ($show{'ps-mem'}){ - push(@rows,mem_processes()); + mem_processes($rows); } } else { my $key = 'Message'; - push(@rows, ({ - main::key($num++,0,1,$key) => main::row_defaults('ps-data-null',''), - },) ); + push(@$rows, { + main::key($num++,0,1,$key) => main::message('ps-data-null','') + }); } eval $end if $b_log; - return @rows; + return $rows; } + sub cpu_processes { eval $start if $b_log; + my $rows = $_[0]; my ($j,$num,$cpu,$cpu_mem,$mem,$pid) = (0,0,'','','',''); - my ($pid_col,@processes,@rows); - my $count = ($b_irc)? 5: $ps_count; - if ($ps_cols >= 10){ - @rows = sort { + 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[2] <=> $a[2] } @ps_aux; - $pid_col = 1; + $b[$header->[2]] <=> $a[$header->[2]] + } @ps_aux; } else { - @rows = @ps_aux; - $pid_col = 0 if $ps_cols == 2; + @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 - @rows = splice(@rows,0,$count); - - $j = scalar @rows; - # $cpu_mem = ' - Memory: MiB / % used' if $extra > 0; - my $throttled = throttled($ps_count,$count,$j); - #my $header = "CPU % used - Command - pid$cpu_mem - top"; - #my $header = "Top $count by CPU"; - my @data = ({ - main::key($num++,1,1,'CPU top') => "$count$throttled" . ' of ' . scalar @ps_aux, - },); - push(@processes,@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 (@rows){ + foreach (@ps_rows){ $num = 1; - $j = scalar @processes; + $j = scalar @$rows; my @row = split(/\s+/, $_); - my @command = process_starter(scalar @row, $row[$ps_cols],$row[$ps_cols + 1]); - $cpu = ($ps_cols >= 10 ) ? $row[2] . '%': 'N/A'; - @data = ({ + 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], - },); - push(@processes,@data); - if ($command[1]) { - $processes[$j]->{main::key($num++,0,4,'started by')} = $command[1]; + main::key($num++,1,3,'command') => $command->[0], + }); + if ($command->[1]){ + $rows->[$j]{main::key($num++,0,4,'started-by')} = $command->[1]; } - $pid = (defined $pid_col)? $row[$pid_col] : 'N/A'; - $processes[$j]->{main::key($num++,0,3,'pid')} = $pid; - if ($extra > 0 && $ps_cols >= 10){ - my $decimals = ($row[5]/1024 > 10 ) ? 1 : 2; - $mem = (defined $row[5]) ? sprintf("%.${decimals}f", $row[5]/1024) . ' MiB' : 'N/A'; - $mem .= ' (' . $row[3] . '%)'; - $processes[$j]->{main::key($num++,0,3,'mem')} = $mem; + $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 "; + # print Data::Dumper::Dumper \@processes, "i: $i; j: $j "; } eval $end if $b_log; - return @processes; } + sub mem_processes { eval $start if $b_log; + my $rows = $_[0]; my ($j,$num,$cpu,$cpu_mem,$mem,$pid) = (0,0,'','','',''); - my (@data,$pid_col,@processes,$memory,@rows); - my $count = ($b_irc)? 5: $ps_count; - if ($ps_cols >= 10){ - @rows = sort { + 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[5] <=> $a[5] } @ps_aux; # 5 - #$a[1] <=> $b[1] } @ps_aux; # 5 - $pid_col = 1; + $b[$header->[4]] <=> $a[$header->[4]] + } @ps_aux; } else { - @rows = @ps_aux; - $pid_col = 0 if $ps_cols == 2; - } - @rows = splice(@rows,0,$count); - #print Data::Dumper::Dumper \@rows; - @processes = main::get_memory_data_full('process') if !$b_mem; - $j = scalar @rows; - my $throttled = throttled($ps_count,$count,$j); - #$cpu_mem = ' - CPU: % used' if $extra > 0; - #my $header = "Memory MiB/% used - Command - pid$cpu_mem - top"; - #my $header = "Top $count by Memory"; - @data = ({ - main::key($num++,1,1,'Memory top') => "$count$throttled" . ' of ' . scalar @ps_aux, - },); - push(@processes,@data); + @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 (@rows){ + foreach (@ps_rows){ $num = 1; - $j = scalar @processes; + $j = scalar @$rows; my @row = split(/\s+/, $_); - if ($ps_cols >= 10){ - my $decimals = ($row[5]/1024 > 10 ) ? 1 : 2; - $mem = (main::is_int($row[5])) ? sprintf("%.${decimals}f", $row[5]/1024) . ' MiB' : 'N/A'; - $mem .= " (" . $row[3] . "%)"; + 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[$ps_cols],$row[$ps_cols + 1]); - @data = ({ + 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], - },); - push(@processes,@data); - if ($command[1]) { - $processes[$j]->{main::key($num++,0,4,'started by')} = $command[1]; + main::key($num++,1,3,'command') => $command->[0], + }); + if ($command->[1]){ + $rows->[$j]{main::key($num++,0,4,'started-by')} = $command->[1]; } - $pid = (defined $pid_col)? $row[$pid_col] : 'N/A'; - $processes[$j]->{main::key($num++,0,3,'pid')} = $pid; - if ($extra > 0 && $ps_cols >= 10){ - $cpu = $row[2] . '%'; - $processes[$j]->{main::key($num++,0,3,'cpu')} = $cpu; + $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 "; + # print Data::Dumper::Dumper \@processes, "i: $i; j: $j "; } eval $end if $b_log; - return @processes; } + sub process_starter { my ($count, $row10, $row11) = @_; - my (@return); + my $return = []; # note: [migration/0] would clear with a simple basename - if ($count > ($ps_cols + 1) && $row11 =~ /^\// && $row11 !~ /^\/(tmp|temp)/){ + if ($count > ($header->[0] + 1) && + $row11 =~ /^\// && $row11 !~ /^\/(tmp|temp)/){ $row11 =~ s/^\/.*\///; - $return[0] = $row11; + $return->[0] = $row11; $row10 =~ s/^\/.*\///; - $return[1] = $row10; + $return->[1] = $row10; } else { $row10 =~ s/^\/.*\///; - $return[0] = $row10; - $return[1] = ''; + $return->[0] = $row10; + $return->[1] = ''; } - return @return; + return $return; } + +# args: 0: $ps_count; 1: $count sub throttled { - my ($ps_count,$count,$j) = @_; - my $throttled = ''; - if ($count > $j){ - $throttled = " ( $j processes)"; # space to avoid emoji in irc - } - elsif ($count < $ps_count){ - $throttled = " (throttled from $ps_count)"; - } - return $throttled; + return ($_[1] < $_[0]) ? " (throttled from $_[0])" : ''; } } -## RaidData +## RaidItem { -package RaidData; -# debugger switches -my $b_hw = 0; -my $b_lvm = 0; -my $b_md = 0; -my $b_zfs = 0; +package RaidItem; sub get { eval $start if $b_log; - my (@hardware_raid,@rows,$key1,$val1); + my ($hardware_raid,$key1,$val1); my $num = 0; - @hardware_raid = hw_data() if $b_hardware_raid || $b_hw; - raid_data() if !$b_raid; - #print 'get: ', Data::Dumper::Dumper \@lvm_raid; - #print 'get: ', Data::Dumper::Dumper \@md_raid; - #print 'get: ', Data::Dumper::Dumper \@zfs_raid; - if (!@lvm_raid && !@md_raid && !@zfs_raid && !@hardware_raid){ + 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::row_defaults('raid-data'); + $val1 = main::message('raid-data'); } } else { - if (@hardware_raid){ - push(@rows,hw_output(\@hardware_raid)); + if ($hardware_raid){ + hw_output($rows,$hardware_raid); + } + if (@btrfs_raid){ + btrfs_output($rows); } if (@lvm_raid){ - push(@rows,lvm_output()); + lvm_output($rows); } if (@md_raid){ - push(@rows,md_output()); + md_output($rows); + } + if (@soft_raid){ + soft_output($rows); } if (@zfs_raid){ - push(@rows,zfs_output()); + zfs_output($rows); } } - if (!@rows && $key1){ - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + if (!@$rows && $key1){ + @$rows = ({main::key($num++,0,1,$key1) => $val1,}); } eval $end if $b_log; - ($b_md,$b_zfs) = undef; - return @rows; + return $rows; } + sub hw_output { eval $start if $b_log; - my ($hardware_raid) = @_; - my (@rows); + 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, { + 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; + $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){ - my $driver_version = ($row->{'driver-version'}) ? $row->{'driver-version'}: 'N/A' ; - $rows[$j]->{main::key($num++,0,3,'v')} = $driver_version; + $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; + $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; + 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 = (defined $row->{'vendor-id'} && defined $row->{'chip-id'}) ? "$row->{'vendor-id'}.$row->{'chip-id'}": 'N/A' ; - $rows[$j]->{main::key($num++,0,2,'chip ID')} = $chip_id; + 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){ - my $rev= (defined $row->{'rev'} && $row->{'rev'}) ? $row->{'rev'}: 'N/A' ; - $rows[$j]->{main::key($num++,0,2,'rev')} = $rev; + $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; - return @rows; + # 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 (@components,@components_good,@components_meta,@rows); + 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, { + $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,'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'}; + $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; + $rows->[$j]{main::key($num++,0,2,'size')} = $size; if ($row->{'raid-sync'}){ - $rows[$j]->{main::key($num++,0,2,'sync')} = $row->{'raid-sync'}; + $rows->[$j]{main::key($num++,0,2,'sync')} = $row->{'raid-sync'}; } - if ($extra > 0){ - $j = scalar @rows; + $j = scalar @$rows; $num = 1; - $rows[$j]->{main::key($num++,1,2,'Info')} = ''; + $rows->[$j]{main::key($num++,1,2,'Info')} = ''; if (defined $row->{'stripes'}){ - $rows[$j]->{main::key($num++,0,3,'stripes')} = $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->{'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) . '%'; + $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'}; + $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; + $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; + $rows->[$j]{main::key($num++,0,4,'vg-free')} = $size; } @components = (ref $row->{'components'} eq 'ARRAY') ? @{$row->{'components'}} : (); - @components_good = (); + @good = (); @components_meta = (); foreach my $item (sort { $a->[0] cmp $b->[0]} @components){ if ($item->[4] =~ /_rmeta/){ push(@components_meta, $item); } else { - push(@components_good, $item); + push(@good, $item); } } - $j = scalar @rows; - $rows[$j]->{main::key($num++,1,2,'Components')} = ''; + $j = scalar @$rows; + $rows->[$j]{main::key($num++,1,2,'Components')} = ''; my $b_bump; - components_output('lvm','Online',\@rows,\@components_good,\$j,\$num,\$b_bump); - components_output('lvm','Meta',\@rows,\@components_meta,\$j,\$num,\$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; - return @rows; + # print Data::Dumper::Dumper $rows; } + sub md_output { eval $start if $b_log; - my (@components,@components_good,@failed,@inactive,@rows,@spare,@temp); + 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; + # print Data::Dumper::Dumper \@md_raid; if ($extra > 2 && $md_raid[0]->{'supported-levels'}){ - push(@rows, { + 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; + $j = scalar @$rows; next if !%$row; $num = 1; - $level = (defined $row->{'level'}) ? $row->{'level'} : 'no-raid'; - push(@rows, { + $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,'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'}; + $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'}; + $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::row_defaults('root-required'): 'N/A'; + $size = (!$b_root && !@lsblk) ? main::message('root-required'): 'N/A'; } - $rows[$j]->{main::key($num++,0,2,'size')} = $size; + $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; + # print "here 0\n"; + $rows->[$j]{main::key($num++,0,2,'report')} = $report; } if ($extra > 0){ - $j = scalar @rows; + $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; + $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; + $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; + $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'}; + $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'}; + $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'}; + $rows->[$j]{main::key($num++,0,3,'algorithm')} = $row->{'algorithm'}; } } } @components = (ref $row->{'components'} eq 'ARRAY') ? @{$row->{'components'}} : (); - @components_good = (); + @good = (); @failed = (); @inactive = (); @spare = (); @@ -14969,131 +22507,203 @@ sub md_output { # print Data::Dumper::Dumper \@components; foreach my $item (sort { $a->[1] <=> $b->[1]} @components){ if (defined $item->[2] && $item->[2] =~ /^(F)$/){ - push(@failed, $item); + push(@failed,$item); } elsif (defined $item->[2] && $item->[2] =~ /(S)$/){ - push(@spare, $item); + push(@spare,$item); } - elsif ($row->{'status'} && $row->{'status'} eq 'inactive' ){ - push(@inactive, $item); + elsif ($row->{'status'} && $row->{'status'} eq 'inactive'){ + push(@inactive,$item); } else { - push(@components_good, $item); + push(@good,$item); } } - $j = scalar @rows; - $rows[$j]->{main::key($num++,1,2,'Components')} = ''; + $j = scalar @$rows; + $rows->[$j]{main::key($num++,1,2,'Components')} = ''; my $b_bump; - components_output('mdraid','Online',\@rows,\@components_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); + 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; + $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; + $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; + $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'}; + $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'}; + $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; - return @rows; + # print Data::Dumper::Dumper $rows; } sub zfs_output { - eval $start if $b_log; - my (@arrays,@arrays_holder,@components,@components_good,@failed,@rows,@spare); + 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; + # print Data::Dumper::Dumper \@zfs_raid; foreach my $row (sort {$a->{'id'} cmp $b->{'id'}} @zfs_raid){ - $j = scalar @rows; + $j = scalar @$rows; $b_row_1_sizes = 0; next if !%$row; $num = 1; - push(@rows, { + 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->{'size'}) ? main::get_size($row->{'size'},'string') : ''; - $available = main::get_size($row->{'free'},'string',''); # could be zero free + $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->{'allocated'}) ? main::get_size($row->{'allocated'},'string') : ''; + $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 = 'no-raid'; - $rows[$j]->{main::key($num++,0,2,'level')} = $level; + 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'}; + $rows->[$j]{main::key($num++,0,2,'level')} = $arrays[0]->{'level'}; } - if ($size){ - #print "here 0\n"; - $rows[$j]->{main::key($num++,0,2,'size')} = $size; - $size = ''; - $b_row_1_sizes = 1; - } - if ($available){ - $rows[$j]->{main::key($num++,0,2,'free')} = $available; - $available = ''; - $b_row_1_sizes = 1; + 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 ($allocated){ - $rows[$j]->{main::key($num++,0,2,'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; + $j = scalar @$rows; $num = 1; - $size = ($row2->{'size'}) ? main::get_size($row2->{'size'},'string') : 'N/A'; - $available = ($row2->{'free'}) ? main::get_size($row2->{'free'},'string') : 'N/A'; - $level = (defined $row2->{'level'}) ? $row2->{'level'}: 'no-raid'; + $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, { + push(@$rows, { main::key($num++,1,2,'Array') => $level, main::key($num++,0,3,'status') => $status, - main::key($num++,0,3,'size') => $size, - main::key($num++,0,3,'free') => $available, + 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->{'size'}) ? main::get_size($row2->{'size'},'string') : 'N/A'; - $available = ($row2->{'free'}) ? main::get_size($row2->{'free'},'string') : 'N/A'; - $rows[$j]->{main::key($num++,0,2,'size')} = $size; - $rows[$j]->{main::key($num++,0,2,'free')} = $available; + # 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 = ($row->{'allocated'}) ? main::get_size($row2->{'allocated'},'string') : ''; + $allocated = ($row2->{'raw-allocated'}) ? main::get_size($row2->{'raw-allocated'},'string') : ''; if ($allocated){ - $rows[$j]->{main::key($num++,0,2,'allocated')} = $allocated; + $rows->[$j]{main::key($num++,0,3,'allocated')} = $allocated; } } } @components = (ref $row2->{'components'} eq 'ARRAY') ? @{$row2->{'components'}} : (); @failed = (); @spare = (); - @components_good = (); + @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)$/){ @@ -15105,29 +22715,31 @@ sub zfs_output { # note: spares in use show: INUSE but technically it's still a spare, # but since it's in use, consider it online. else { - push(@components_good, $item); + push(@good, $item); } } - $j = scalar @rows; - $rows[$j]->{main::key($num++,1,3,'Components')} = ''; + $j = scalar @$rows; + $rows->[$j]{main::key($num++,1,3,'Components')} = ''; my $b_bump; - components_output('zfs','Online',\@rows,\@components_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); + 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; - return @rows; + # print Data::Dumper::Dumper $rows; } -## Most key stuff passed by ref, and is changed on the fly +# Most key stuff passed by ref, and is changed on the fly sub components_output { eval $start if $b_log; - my ($type,$item,$rows_ref,$array_ref,$j_ref,$num_ref,$b_bump_ref) = @_; - return if !@$array_ref && $item ne 'Online'; + 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 'lvm'){ + 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'; @@ -15138,42 +22750,47 @@ sub components_output { $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_ref++ if $$b_bump_ref; - $$b_bump_ref = 0; - my $good = ($item eq 'Online' && !@$array_ref ) ? 'N/A' : ''; - $$rows_ref[$$j_ref]->{main::key($$num_ref++,1,$l1,$item)} = $good; - #$$j_ref++ if $b_admin; - #print Data::Dumper::Dumper $array_ref; - foreach my $device (@$array_ref){ + # 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 && $device->[$f1] && $device->[$f2]){ if ($b_admin){ - $$j_ref++; - $$b_bump_ref = 1; - $$num_ref = 1; + $$j++; + $$b_bump = 1; + $$num = 1; } $key1 = (defined $k1 && defined $device->[$k1]) ? $device->[$k1] : $k++; - $$rows_ref[$$j_ref]->{main::key($$num_ref++,1,$l2,$key1)} = $device->[0]; + $rows->[$$j]{main::key($$num++,1,$l2,$key1)} = $device->[0]; if ($b_admin && $device->[$f2]){ - $$rows_ref[$$j_ref]{main::key($$num_ref++,0,$l3,'maj-min')} = $device->[$f2]; + $rows->[$$j]{main::key($$num++,0,$l3,'maj-min')} = $device->[$f2]; } if ($b_admin && $device->[$f1]){ - my $size = ($device->[$f1]) ? main::get_size($device->[$f1],'string') : 'N/A'; - $$rows_ref[$$j_ref]->{main::key($$num_ref++,0,$l3,'size')} = $size; + my $size = main::get_size($device->[$f1],'string'); + $rows->[$$j]{main::key($$num++,0,$l3,'size')} = $size; } if ($b_admin && $device->[$f3]){ - $$rows_ref[$$j_ref]->{main::key($$num_ref++,0,$l3,'state')} = $device->[$f3]; + $rows->[$$j]{main::key($$num++,0,$l3,'state')} = $device->[$f3]; } if ($b_admin && $extra1 && $device->[$f4]){ - $$rows_ref[$$j_ref]->{main::key($$num_ref++,0,$l3,$extra1)} = $device->[$f4]; + $rows->[$$j]{main::key($$num++,0,$l3,$extra1)} = $device->[$f4]; } if ($b_admin && $extra2 && $device->[$f5]){ - $$rows_ref[$$j_ref]->{main::key($$num_ref++,0,$l3,$extra2)} = $device->[$f5]; + $rows->[$$j]{main::key($$num++,0,$l3,$extra2)} = $device->[$f5]; } } eval $end if $b_log; @@ -15181,45 +22798,57 @@ sub components_output { sub raid_data { eval $start if $b_log; - main::set_lsblk() if !$bsd_type && !$b_lsblk; - main::set_mapper() if !$bsd_type && !$b_mapper; - main::set_proc_partitions() if !$bsd_type && !$b_proc_partitions; + 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); - $b_raid = 1; - if (($b_fake_raid && $b_lvm) || - ($alerts{'lvs'}->{'action'} && $alerts{'lvs'}->{'action'} eq 'use')){ + $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 (($b_fake_raid && $b_md) || (my $file = main::system_files('mdstat') )){ + if ($fake{'raid-md'} || (my $file = $system_files{'proc-mdstat'})){ @md_raid = md_data($file); } - if (($b_fake_raid && $b_zfs) || (my $path = main::check_program('zpool') )){ + 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 + +# 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; - my ($driver,$vendor,@hardware_raid); - foreach my $working (@devices_hwraid){ + 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 && $b_pci_tool && $working->[11]){ + if ($extra > 2 && $use{'pci-tool'} && $working->[11]){ $vendor = main::get_pci_vendor($working->[4],$working->[11]); } - push(@hardware_raid, { + push(@$hardware_raid, { + 'class-id' => $working->[1], 'bus-id' => $working->[2], 'chip-id' => $working->[6], 'device' => $working->[4], @@ -15232,20 +22861,38 @@ sub hw_data { 'vendor' => $vendor, }); } - # print Data::Dumper::Dumper \@hardware_raid; - main::log_data('dump','@hardware_raid',\@hardware_raid) if $b_log; + # 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 @hardware_raid; + return @btraid; } + sub lvm_data { eval $start if $b_log; - LogicalData::lvm_data() if !$b_lvm_data; + 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'} !~ /^raid/; + next if $item->{'segtype'} && $item->{'segtype'} !~ /^raid/; my (@components,$dev,$maj_min,$vg_used); - #print Data::Dumper::Dumper $item; + # print Data::Dumper::Dumper $item; if ($item->{'lv_kernel_major'} . ':' . $item->{'lv_kernel_minor'}){ $maj_min = $item->{'lv_kernel_major'} . ':' . $item->{'lv_kernel_minor'}; } @@ -15256,13 +22903,13 @@ sub lvm_data { @working = main::globber("/sys/dev/block/$maj_min/slaves/*") if $maj_min; @working = map {$_ =~ s|^/.*/||; $_;} @working if @working; foreach my $part (@working){ - my (@data,$dev,$maj_min,$mapped,$size); + my ($dev,$maj_min,$mapped,$size); if (@proc_partitions){ - @data = main::get_proc_partition($part); - $maj_min = $data[0] . ':' . $data[1] if defined $data[1]; - $size = $data[2]; + 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; - @data = main::globber("/sys/dev/block/$maj_min/slaves/*") if $maj_min; + my @data = main::globber("/sys/dev/block/$maj_min/slaves/*") if $maj_min; @data = map {$_ =~ s|^/.*/||; $_;} @data if @data; $dev = join(',', @data) if @data; } @@ -15271,7 +22918,7 @@ sub lvm_data { } if ($item->{'segtype'}){ if ($item->{'segtype'} eq 'raid1'){$item->{'segtype'} = 'mirror';} - else {$item->{'segtype'} =~ s/^raid([0-9]+)/raid-$1/; } + else {$item->{'segtype'} =~ s/^raid([0-9]+)/raid-$1/;} } push(@lvraid, { 'components' => \@components, @@ -15290,37 +22937,37 @@ sub lvm_data { 'vg-used' => $vg_used, }); } - - # print Data::Dumper::Dumper \@lvraid; + 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 ($b_fake_raid) { - #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-4-device-1.txt"; - #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-rebuild-1.txt"; - #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-2-mirror-fserver2-1.txt"; - #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-2-raid10-abucodonosor.txt"; - #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-2-raid10-ant.txt"; - #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-inactive-weird-syntax.txt"; - #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-inactive-active-syntax.txt"; - #$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-inactive-active-spare-syntax.txt"; + 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; + # 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 = (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 = (split(/:\s*/, $working[-1]))[1]; $unused =~ s/<|>|none//g if $unused; pop @working; } @@ -15333,8 +22980,8 @@ sub md_data { # 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,$id,$level,$maj_min,@part,$size,$status); - my (@components,%details,%device); + 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(.*)/){ @@ -15351,20 +22998,20 @@ sub md_data { @temp = (); # cascade of tests, light to cpu intense if ((!$maj_min || !$size) && @proc_partitions){ - @part = main::get_proc_partition($id); - if (@part){ - $maj_min = $part[0] . ':' . $part[1]; - $size = $part[2]; + $part = PartitionData::get($id); + if (@$part){ + $maj_min = $part->[0] . ':' . $part->[1]; + $size = $part->[2]; } } if ((!$maj_min || !$size) && @lsblk){ - %device = main::get_lsblk($id) if @lsblk; - $maj_min = $device{'maj-min'} if $device{'maj-min'}; - $size = $device{'size'} if $device{'size'}; + $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'}; + $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 @@ -15377,19 +23024,19 @@ sub md_data { $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 ($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 = main::get_proc_partition($name); - if (@part){ - $maj_min = $part[0] . ':' . $part[1] if !$maj_min; - $part_size = $part[2] if !$part_size; + $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= main::get_lsblk($name); + 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; } @@ -15398,12 +23045,12 @@ sub md_data { $state = $info if !$state && $info; push(@components,[$name,$number,$info,$part_size,$maj_min,$state,$mapped]); } - #print "$component_string\n"; + # print "$component_string\n"; $j = scalar @mdraid; push(@mdraid, { - 'chunk-size' => $details{'chunk-size'}, # if we got it, great, if not, further down + 'chunk-size' => $details->{'chunk-size'}, # if we got it, great, if not, further down 'components' => \@components, - 'details' => \%details, + 'details' => $details, 'id' => $id, 'level' => $level, 'maj-min' => $maj_min, @@ -15412,7 +23059,7 @@ sub md_data { 'type' => 'mdraid', }); } - #print "$_\n"; + # print "$_\n"; if ($_ =~ /^([0-9]+)\sblocks/){ $mdraid[$j]->{'blocks'} = $1; } @@ -15441,58 +23088,60 @@ sub md_data { $mdraid[$j]->{'recovery-finish'} = $1; $mdraid[$j]->{'recovery-speed'} = $2; } - #print 'mdraid loop: ', Data::Dumper::Dumper \@mdraid; + # 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; + 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 (%details,@working); + 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) { + 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; + $details->{'size'} = $1; } elsif ($working[0] eq 'Active Devices'){ - $details{'c-active'} = $working[1]; + $details->{'c-active'} = $working[1]; } elsif ($working[0] eq 'Chunk Size'){ - $details{'chunk-size'} = $working[1]; + $details->{'chunk-size'} = $working[1]; } elsif ($working[0] eq 'Failed Devices'){ - $details{'c-failed'} = $working[1]; + $details->{'c-failed'} = $working[1]; } elsif ($working[0] eq 'Raid Devices'){ - $details{'c-raid'} = $working[1]; + $details->{'c-raid'} = $working[1]; } elsif ($working[0] eq 'Spare Devices'){ - $details{'c-spare'} = $working[1]; + $details->{'c-spare'} = $working[1]; } elsif ($working[0] eq 'State'){ - $details{'state'} = $working[1]; + $details->{'state'} = $working[1]; } elsif ($working[0] eq 'Total Devices'){ - $details{'c-total'} = $working[1]; + $details->{'c-total'} = $working[1]; } elsif ($working[0] eq 'Used Dev Size' && $working[1] =~ /^([0-9]+)\s\(/){ - $details{'dev-size'} = $1; + $details->{'dev-size'} = $1; } elsif ($working[0] eq 'UUID'){ - $details{'uuid'} = $working[1]; + $details->{'uuid'} = $working[1]; } elsif ($working[0] eq 'Working Devices'){ - $details{'c-working'} = $working[1]; + $details->{'c-working'} = $working[1]; } } # end component data lines @@ -15502,7 +23151,7 @@ sub md_details { # 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]} = { + $details->{'devices'}{$working[-1]} = { 'maj-min' => $working[1] . ':' . $working[2], 'number' => $working[0], 'raid-device' => $working[3], @@ -15510,38 +23159,105 @@ sub md_details { }; } } - #print Data::Dumper::Dumper \%details; - main::log_data('dump',"$id: %details",\%details) if $b_log; + # 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 %details; + return @softraid; } sub zfs_data { eval $start if $b_log; my ($zpool) = @_; my (@components,@zfs); - my ($allocated,$free,$size,$size_holder,$size_logical,$status,@working); + my ($allocated,$free,$size,$size_holder,$status,$zfs_used,$zfs_avail, + $zfs_size,@working); my $b_v = 1; my ($i,$j,$k) = (0,0,0); - if ($b_fake_raid){ - #my $file; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-list-1-mirror-main-solestar.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-list-2-mirror-main-solestar.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-list-v-tank-1.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-list-v-gojev-1.txt"; + 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"; #@working = main::reader($file);$zpool = ''; } else { @working = main::grabber("$zpool list -v 2>/dev/null"); } - DiskData::set_glabel() if $bsd_type && !$b_glabel; # bsd sed does not support inserting a true \n so use this trick # some zfs does not have -v if (!@working){ @working = main::grabber("$zpool list 2>/dev/null"); $b_v = 0; } - #print Data::Dumper::Dumper \@working; + my $zfs_path = main::check_program('zfs'); + # print Data::Dumper::Dumper \@working; main::log_data('dump','@working',\@working) if $b_log; if (!@working){ main::log_data('data','no zpool list data') if $b_log; @@ -15562,84 +23278,127 @@ sub zfs_data { if (/^[\S]+/){ @components = (); $i = 0; - $raw_logical[0] += $size_holder if $size_holder; - $size_holder = $size = ($row[1] && $row[1] ne '-')? main::translate_size($row[1]): ''; + $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], - 'allocated' => $allocated, 'arrays' => ([],), - 'free' => $free, - 'size' => $size, + '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; + # print Data::Dumper::Dumper \@zfs; # raid level is the second item in the output, unless it is not, sometimes it is absent - if ($row[1] =~ /raid|mirror/){ + elsif ($row[1] =~ /raid|mirror/){ $row[1] =~ s/^raid1/mirror/; #$row[1] =~ s/^raid/raid-/; # need to match in zpool status <device> $k = scalar @{$zfs[$j]->{'arrays'}}; $zfs[$j]->{'arrays'}[$k]{'level'} = $row[1]; $i = 0; - $size_logical = $size = ($row[2] && $row[2] ne '-') ? main::translate_size($row[2]) : ''; - $size_holder = 0; - $raw_logical[0] += $size if $size; - $zfs[$j]->{'arrays'}[$k]{'size'} = $size; - $zfs[$j]->{'arrays'}[$k]{'allocated'} = ($row[3] && $row[3] ne '-') ? main::translate_size($row[3]) : ''; - $zfs[$j]->{'arrays'}[$k]{'free'} = ($row[4] && $row[4] ne '-') ? main::translate_size($row[4]) : ''; + $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/){ + elsif ($row[1] =~ /spares?/){ next; } - # the first is a member of a raid array - # ada2 - - - - - - - # this second is a single device not in an array + # 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 - - - - - - - elsif ($row[1] =~ /^(sd[a-z]+|[a-z0-9]+[0-9]+|([\S]+)\/.*)$/ && - ($row[2] eq '-' || $row[2] =~ /^[0-9\.]+[MGTP]$/ )){ - $row[1] =~ /^(sd[a-z]+|[a-z0-9]+[0-9]+|([\S]+)\/.*)\s*(DEGRADED|FAULTED|OFFLINE)?$/; + # 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]$/)){ + #print "r1:$row[1]",' :: ', Cwd::abs_path('/dev/disk/by-id/'.$row[1]), "\n"; + $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,})\s.*?(DEGRADED|FAULTED|INUSE|OFFLINE)?$/; + #my $working = ''; my $working = ($1) ? $1 : ''; # note: the negative case can never happen - my $state = ($3) ? $3 : ''; - my ($maj_min,$part_size); - if ($working =~ /[\S]+\// && @glabel){ - $working = DiskData::match_glabel($working); + my $state = ($4) ? $4 : ''; + my ($maj_min,$real,$part_size); + if ($bsd_type && $working =~ /[\S]+\//){ + $working = GlabelData::get($working); + } + elsif (!$bsd_type && $row[1] =~ /^(ata|mmc|nvme|scsi|wwn)-/ && + -e "/dev/disk/by-id/$row[1]" && ($real = Cwd::abs_path('/dev/disk/by-id/'.$row[1]))){ + $real =~ s|/dev/||; + $working = $real; + } + elsif (!$bsd_type && $row[1] =~ /^(pci)-/ && + -e "/dev/disk/by-path/$row[1]" && ($real = Cwd::abs_path('/dev/disk/by-path/'.$row[1]))){ + $real =~ s|/dev/||; + $working = $real; + } + elsif (!$bsd_type && $row[1] =~ /^[a-f0-9]{4,}(-[a-f0-9]{4,}){3,}$/ && + -e "/dev/disk/by-partuuid/$row[1]" && ($real = Cwd::abs_path('/dev/disk/by-partuuid/'.$row[1]))){ + $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% - if (!$zfs[$j]->{'size'} && $row[2] && $row[2] ne '-') { - $size_logical = $size = ($row[2])? main::translate_size($row[2]): ''; + # 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[2] && $row[2] ne '-'){ + $size = ($row[2]) ? main::translate_size($row[2]): ''; $size_holder = 0; - $zfs[$j]->{'arrays'}[$k]{'size'} = $size; + $zfs[$j]->{'arrays'}[$k]{'raw-size'} = $size; $raw_logical[0] += $size if $size; } - if (!$zfs[$j]->{'allocated'} && $row[3] && $row[3] ne '-') { - $allocated = ($row[3])? main::translate_size($row[3]): ''; - $zfs[$j]->{'arrays'}[$k]{'allocated'} = $allocated; + if (!$zfs[$j]->{'raw-allocated'} && $row[3] && $row[3] ne '-'){ + $allocated = ($row[3]) ? main::translate_size($row[3]) : ''; + $zfs[$j]->{'arrays'}[$k]{'raw-allocated'} = $allocated; } - if (!$zfs[$j]->{'free'} && $row[4] && $row[4] ne '-') { - $free = ($row[4])? main::translate_size($row[4]): ''; - $zfs[$j]->{'arrays'}[$k]{'free'} = $free; + if (!$zfs[$j]->{'raw-free'} && $row[4] && $row[4] ne '-'){ + $free = ($row[4]) ? main::translate_size($row[4]) : ''; + $zfs[$j]->{'arrays'}[$k]{'raw-free'} = $free; } - if ((!$maj_min || !$part_size) && @lsblk){ - my @part = main::get_proc_partition($working); - if (@part){ - $maj_min = $part[0] . ':' . $part[1]; - $part_size = $part[2]; + 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) && @lsblk){ - my %data= main::get_lsblk($working); - $maj_min = $data{'maj-min'}; - $part_size = $data{'size'}; + 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'}; } $raw_logical[1] += $part_size if $part_size; $zfs[$j]->{'arrays'}[$k]{'components'}[$i] = [$working,$part_size,$maj_min,$state]; @@ -15651,16 +23410,39 @@ sub zfs_data { # clear out undefined arrrays values $j = 0; foreach my $row (@zfs){ - my @arrays = (ref $row->{'arrays'} eq 'ARRAY' ) ? @{$row->{'arrays'}} : (); + 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; + 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) = @_; @@ -15669,11 +23451,11 @@ sub zfs_status { foreach my $row (@$zfs){ $i = 0; $k = 0; - if ($b_fake_raid){ + if ($fake{'raid-zfs'}){ my $file; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-status-1-mirror-main-solestar.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-status-2-mirror-main-solestar.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-status-tank-1.txt"; + # $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 { @@ -15681,15 +23463,15 @@ sub zfs_status { @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"; + # @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; + # print "$row->{id} $#arrays\n"; + # print Data::Dumper::Dumper \@arrays; foreach my $array (@{$row->{'arrays'}}){ - #print 'ref: ', ref $array, "\n"; + # print 'ref: ', ref $array, "\n"; #next if ref $array ne 'HASH'; my @components = (ref $array->{'components'} eq 'ARRAY') ? @{$array->{'components'}} : (); $l = 0; @@ -15697,7 +23479,7 @@ sub zfs_status { $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"; + # 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): ''; @@ -15713,6 +23495,7 @@ sub zfs_status { eval $end if $b_log; return @$zfs; } + sub check_zfs_status { eval $start if $b_log; my ($item,$pool_status) = @_; @@ -15730,206 +23513,462 @@ sub check_zfs_status { } } -## RamData +## RamItem { -package RamData; - +package RamItem; +my ($speed_maps,$vendors,$vendor_ids); +my $ram_total = 0; sub get { - my (@data,@rows,$key1,@ram,$val1); + my ($key1,$val1); + my ($ram,$rows) = ([],[]); my $num = 0; - @rows = main::get_memory_data_full('ram') if !$b_mem; - if ( !$b_fake_dmidecode && $alerts{'dmidecode'}->{'action'} ne 'use'){ - $key1 = $alerts{'dmidecode'}->{'action'}; - $val1 = $alerts{'dmidecode'}->{$key1}; - push(@rows, { - main::key($num++,1,1,'RAM Report') => '', - main::key($num++,0,2,$key1) => $val1, - }); + 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, + }); + } } - else { - @ram = dmidecode_data(); - if (@ram){ - @data = ram_output(\@ram); + 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::row_defaults('ram-data'); - @data = ({ + $val1 = main::message('ram-data','dmidecode'); + push(@$rows, { main::key($num++,1,1,'RAM Report') => '', main::key($num++,0,2,$key1) => $val1, }); } - push(@rows,@data); } + 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; + return $rows; +} + +sub ram_total { + return $ram_total; } sub ram_output { eval $start if $b_log; - my ($ram) = @_; + my ($rows,$ram,$source) = @_; return if !@$ram; my $num = 0; my $j = 0; - my (@rows,$b_non_system); - my ($arrays,$modules,$slots,$type_holder) = (0,0,0,''); - foreach my $item (@$ram){ - $j = scalar @rows; - if (!$show{'ram-short'}){ - $b_non_system = ($item->{'use'} && lc($item->{'use'}) ne 'system memory') ? 1:0 ; - $num = 1; - push(@rows, { - main::key($num++,1,1,'Array') => '', - main::key($num++,1,2,'capacity') => process_size($item->{'capacity'}), + 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 ($item->{'cap-qualifier'}){ - $rows[$j]->{main::key($num++,0,3,'note')} = $item->{'cap-qualifier'}; - } - $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'}; - } - $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 > 2 && $item->{'voltage'}){ - $rows[$j]->{main::key($num++,0,2,'voltage')} = $item->{'voltage'}; + } + } + 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'}; } } - else { - $slots += $item->{'slots'} if $item->{'slots'}; - $arrays++; + 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){ + foreach my $mod (@$entry){ $num = 1; - $j = scalar @rows; - # multi array setups will start index at next from previous array + $j = scalar @$rows; + # Multi array setups will start index at next from previous array next if ref $mod ne 'HASH'; - if ($show{'ram-short'}){ - $modules++ if ($mod->{'size'} =~ /^\d/); - $type_holder = $mod->{'device-type'} if $mod->{'device-type'}; - next; - } next if ($show{'ram-modules'} && $mod->{'size'} =~ /\D/); $mod->{'locator'} ||= 'N/A'; - push(@rows, { + push(@$rows, { main::key($num++,1,2,'Device') => $mod->{'locator'}, - main::key($num++,0,3,'size') => process_size($mod->{'size'}), }); - next if ($mod->{'size'} =~ /\D/); - if ($extra > 1 && $mod->{'type'} ){ - $rows[$j]->{main::key($num++,0,3,'info')} = $mod->{'type'}; + # 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'}; - $rows[$j]->{main::key($num++,0,4,'note')} = $mod->{'speed-note'} if $mod->{'speed-note'}; - $rows[$j]->{main::key($num++,0,4,'actual')} = $mod->{'configured-clock-speed'}; - $rows[$j]->{main::key($num++,0,5,'note')} = $mod->{'configured-note'} if $mod->{'configured-note'}; + $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'}; - $mod->{'speed-note'} = $mod->{'configured-note'} if $mod->{'configured-note'} ; - } - # rare instances, dmi type 6, no speed - else { - $mod->{'speed'} = 'N/A'; + if ($mod->{'configured-note'}){ + $mod->{'speed-note'} = $mod->{'configured-note'}; + } } } - $rows[$j]->{main::key($num++,1,3,'speed')} = $mod->{'speed'}; - $rows[$j]->{main::key($num++,0,4,'note')} = $mod->{'speed-note'} if $mod->{'speed-note'}; - } - if ($extra > 0 ){ - $mod->{'device-type'} ||= 'N/A'; - $rows[$j]->{main::key($num++,0,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,3,'detail')} = $mod->{'device-type-detail'}; + # 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'}; } } - if ($extra > 2 ){ - $mod->{'data-width'} ||= 'N/A'; - $rows[$j]->{main::key($num++,0,3,'bus width')} = $mod->{'data-width'}; - $mod->{'total-width'} ||= 'N/A'; - $rows[$j]->{main::key($num++,0,3,'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'}; + # 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 ($extra > 2 ){ - $mod->{'serial'} = main::apply_filter($mod->{'serial'}); - $rows[$j]->{main::key($num++,0,3,'serial')} = $mod->{'serial'}; + 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'}; + } } } } } - if ($show{'ram-short'}){ - $num = 1; - $type_holder ||= 'N/A'; - push(@rows, { - main::key($num++,1,1,'Report') => '', - main::key($num++,0,2,'arrays') => $arrays, - main::key($num++,0,2,'slots') => $slots, - main::key($num++,0,2,'modules') => $modules, - main::key($num++,0,2,'type') => $type_holder, - }); + 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; - return @rows; } +# args: 0: $ram ref; sub dmidecode_data { eval $start if $b_log; - my ($b_5,$handle,@ram,@temp); + 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::row_defaults('note-check'); - #print Data::Dumper::Dumper \@dmi; + my $check = main::message('note-check'); + # print Data::Dumper::Dumper \@dmi; foreach my $entry (@dmi){ - ## NOTE: do NOT reset these values, that causes failures + ## 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]; + 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; + $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; + $ram->[$k]{'max-capacity-5'} = $max_cap_5; } elsif ($temp[0] eq 'Memory Module Voltage'){ - $temp[1] =~ s/\s*V.*$//; - $ram[$k]->{'voltage'} = $temp[1]; + $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]; + $ram->[$k]{'slots-5'} = $temp[1]; } elsif ($temp[0] eq 'Error Detecting Method'){ $temp[1] ||= 'None'; - $ram[$k]->{'eec'} = $temp[1]; + $ram->[$k]{'eec'} = $temp[1] if !$ram->[$k]{'eec'} && $temp[1]; } } - $ram[$k]->{'modules'} = ([],); - #print Data::Dumper::Dumper \@ram; + $ram->[$k]{'modules'} = []; + # print Data::Dumper::Dumper \@ram; $b_5 = 1; } elsif ($entry->[0] == 6){ @@ -15937,24 +23976,25 @@ sub dmidecode_data { my ($bank_locator,$device_type,$locator,$main_locator) = ('','','',''); foreach my $item (@$entry){ @temp = split(/:\s*/, $item, 2); - next if ! $temp[1]; + next if !$temp[1]; if ($temp[0] eq 'Installed Size'){ - # get module 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 + # 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::dmi_cleaner($temp[1]); + $speed = main::clean_dmi($temp[1]); } - elsif ($temp[0] eq 'Locator' || $temp[0] eq 'Socket Designation' ){ + 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]; } @@ -15962,91 +24002,112 @@ sub dmidecode_data { $bank_locator = $temp[1]; } elsif ($temp[0] eq 'Type'){ - $device_type = $temp[1]; + $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/ ) { + # 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] = { + $ram->[$k]{'modules'}[$j] = { + 'slots-active' => $slots_active[$k], 'device-type' => $device_type, 'locator' => $main_locator, 'size' => $size, 'speed' => $speed, 'type' => $type, }; - #print Data::Dumper::Dumper \@ram; + 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; + $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]; + 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; + $ram->[$handle]{'max-capacity-16'} = $max_cap_16; } - # note: these 3 have cleaned data in set_dmidecode_data, so replace stuff manually + # 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]; + $ram->[$handle]{'location'} = $temp[1]; } elsif ($temp[0] eq 'Use'){ $temp[1] ||= 'System Memory'; - $ram[$handle]->{'use'} = $temp[1]; + $ram->[$handle]{'use'} = $temp[1]; } elsif ($temp[0] eq 'Error Correction Type'){ + # seen <OUT OF SPEC> + if ($temp[1] && lc($temp[1]) ne 'none'){ + $temp[1] = main::clean_dmi($temp[1]); + } $temp[1] ||= 'None'; - $ram[$handle]->{'eec'} = $temp[1]; + if (!$ram->[$handle]{'eec'} && $temp[1]){ + $ram->[$handle]{'eec'} = $temp[1]; + } } elsif ($temp[0] eq 'Number Of Devices'){ - $ram[$handle]->{'slots-16'} = $temp[1]; + $ram->[$handle]{'slots-16'} = $temp[1]; } - #print "0: $temp[0]\n"; + # 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"; + $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,$form_factor,$locator,$main_locator) = ('','','','',''); - my ($manufacturer,$part_number,$serial,$speed,$speed_note,$total_width) = ('','','','','',''); + 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]; + 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 = $temp[1]; + $data_width = main::clean_dmi($temp[1]); + $data_width =~ s/[\s_-]?bits// if $data_width; } elsif ($temp[0] eq 'Total Width'){ - $total_width = $temp[1]; + $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 + # 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]B/ ) { + 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]; + $device_size = ($temp[1] =~ /no module/i) ? main::message('ram-no-module') : $temp[1]; } } elsif ($temp[0] eq 'Locator'){ @@ -16059,51 +24120,84 @@ sub dmidecode_data { 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 = $temp[1]; + $device_type = main::clean_dmi($temp[1]); } elsif ($temp[0] eq 'Type Detail'){ - $device_type_detail = $temp[1]; + $device_type_detail = main::clean_dmi($temp[1]); } elsif ($temp[0] eq 'Speed'){ - ($speed,$speed_note) = process_speed($temp[1],$device_type,$check); + 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 + # 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'){ - ($configured_speed,$configured_note) = process_speed($temp[1],$device_type,$check); + 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::dmi_cleaner($temp[1]); + $temp[1] = main::clean_dmi($temp[1]); $manufacturer = $temp[1]; } elsif ($temp[0] eq 'Part Number'){ - $temp[1] =~ s/(^[0]+$||.*Module.*|Undefined.*|PartNum.*|\[Empty\]|^To be filled.*)//g; - $part_number = $temp[1]; + $part_number = main::clean_unset($temp[1],'^[0]+$|.*Module.*|PartNum.*'); } elsif ($temp[0] eq 'Serial Number'){ - $temp[1] =~ s/(^[0]+$|Undefined.*|SerNum.*|\[Empty\]|^To be filled.*)//g; - $serial = $temp[1]; + $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; + } } } - # 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; - } - if ($working_size =~ /^[0-9][0-9]+$/) { - $ram[$handle]->{'device-count-found'}++; + # 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; + $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 + # 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]+).*/; @@ -16113,95 +24207,415 @@ sub dmidecode_data { $data_width = $total_width; $total_width = $temp_width; } - $ram[$handle]->{'derived-module-size'} = $derived_module_size; - $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]{'form-factor'} = $form_factor; - $ram[$handle]->{'modules'}[$i]{'locator'} = $main_locator; - $ram[$handle]->{'modules'}[$i]{'manufacturer'} = $manufacturer; - $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; + ($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 ){ + elsif ($entry->[0] < 17){ next; } - elsif ($entry->[0] > 17 ){ + elsif ($entry->[0] > 17){ last; } } - @ram = process_data(\@ram) if @ram; - main::log_data('dump','@ram',\@ram) if $b_log; - # print Data::Dumper::Dumper \@ram; + 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 <OUT OF SPEC> + } + $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; - return @ram; } + sub process_data { eval $start if $b_log; - my ($ram) = @_; + my $ram = $_[0]; + my @result; my $b_debug = 0; - my (@return); - my $check = main::row_defaults('note-check'); - my $est = main::row_defaults('note-est'); + 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 + # 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 + # 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 + # $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'} :mc: $max_cap :uc: $item->{'used-capacity'}\n"; + 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'}) { + 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'} :mc: $max_cap :uc: $item->{'used-capacity'}\n"; + 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'} ){ + # 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'} :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 + 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'} )){ + $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'}) ){ + $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; @@ -16213,27 +24627,30 @@ sub process_data { } } } - # note that second case will never really activate except on virtual machines and maybe - # mobile devices + # 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 + # 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'})){ $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'} )){ + 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 cap - # however do not use it if cap / devices equals the derived module size + # 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'}) ){ + ($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; @@ -16241,20 +24658,23 @@ sub process_data { } if ($b_debug){ - print "4: mms: $item->{'max-module-size'} :dms: $item->{'derived-module-size'} :mc: $max_cap :uc: $item->{'used-capacity'}\n"; + 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 + # 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 + # 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) ){ + 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; } @@ -16278,18 +24698,18 @@ sub process_data { $est_mod = $est; } } - # case where listed max cap is too big for actual slots x max cap, eg: + # 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'})){ + 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 + # 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'){ @@ -16297,163 +24717,425 @@ sub process_data { $item->{'slots-16'} = scalar @{$item->{'modules'}}; print "L\n" if $b_debug; } - push(@return, { + # 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'}, - 'voltage' => $item->{'voltage'}, + '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; - return @return; } -sub process_speed { - my ($speed,$device_type,$check) = @_; - my $speed_note; - $speed = main::dmi_cleaner($speed) if $speed; - if ($device_type && $device_type =~ /ddr/i && $speed && $speed =~ /^([0-9]+) MHz/){ - $speed = ($1 * 2) . " MT/s ($speed)"; + +## 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; } - # 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 - if ($speed && $speed =~ /^([0-9]+) M/){ - $speed_note = $check if $1 < 50 || $1 > 20000 ; + # 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; + } } - return ($speed,$speed_note); + eval $end if $b_log; + return $main_locator; } -# this should be fixed, but for now, size in RAM is in MiB, not -# KiB like the rest of inxi. + +# 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"; + # print "size0: $size\n"; return 'N/A' if !$size; - #return $size if $size =~ /\D/; + # we're going to preserve the bad data for output return $size if !main::is_numeric($size); - #print "size: $size\n"; - if ( $size < 1024 ){ - $unit='MiB'; - } - elsif ( $size < 1024000 ){ - $size = $size / 1024; - $unit='GiB'; - $b_trim = 1; - } - elsif ( $size < 1024000000 ){ - $size = $size / 1024000; - $unit='TiB'; - $b_trim = 1; - } - # we only want a max 2 decimal places, and only when it's - # a unit > MB + # 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; } -sub calculate_size { - my ($data, $size) = @_; - # technically k is KiB, K is KB but can't trust that - if ( $data =~ /^[0-9]+\s*[kKGMTP]B/) { - if ( $data =~ /([0-9]+)\s*GB/ ) { - $data = $1 * 1024; - } - elsif ( $data =~ /([0-9]+)\s*MB/ ) { - $data = $1; - } - elsif ( $data =~ /([0-9]+)\s*TB/ ) { - $data = $1 * 1024 * 1000; - } - elsif ( $data =~ /([0-9]+)\s*PB/ ) { - $data = $1 * 1024 * 1000 * 1000; - } - elsif ( $data =~ /([0-9]+)\s*[kK]B/ ) { - $data = $1/1024; - #print "d3:$data\n"; - } - #print "d1a: $data s1: $size\n"; - if (main::is_numeric($data) && $data > $size ) { - #if ($data =~ /^[0-9][0-9]+$/ && $data > $size ) { - $size = $data; + +# 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; } - #print "d1b: $data s1: $size\n"; - } - else { - $size = 0; } - #print "d2: $data s2: $size\n"; - return $size; + eval $end if $b_log; + return [$vendor,$id]; } } -## RepoData +## RepoItem { -package RepoData; - +package RepoItem; # easier to keep these package global, but undef after done -my (@dbg_files,$debugger_dir); +my (@dbg_files,$debugger_dir,%repo_keys); my $num = 0; + sub get { eval $start if $b_log; ($debugger_dir) = @_; - my (@data,@rows,@rows_p,@rows_r); - if ($extra > 0 && !$b_pkg){ - my %packages = PackageData::get('main',\$num); - my @data; - for (keys %packages){ - $rows_p[0]->{$_} = $packages{$_}; + my $rows = []; + if ($extra > 0 && !$loaded{'package-data'}){ + my $packages = PackageData::get('main',\$num); + for (keys %$packages){ + $rows->[0]{$_} = $packages->{$_}; } - $b_pkg = 1; } + my $rows_start = scalar @$rows; # to test if we found more rows after $num = 0; if ($bsd_type){ - @rows_r = get_repos_bsd(); + get_repos_bsd($rows); } else { - @rows_r = get_repos_linux(); + get_repos_linux($rows); } if ($debugger_dir){ - @rows = @dbg_files; + @$rows = @dbg_files; undef @dbg_files; undef $debugger_dir; + undef %repo_keys; } else { - if (!@rows_r){ - my $pm = (!$bsd_type) ? 'package manager': 'OS type'; - @data = ( - {main::key($num++,0,1,'Alert') => "No repo data detected. Does $self_name support your $pm?"}, - ); + 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}); } - @rows = (@rows_p,@rows_r,@data); } eval $end if $b_log; - return @rows; + return $rows; } + sub get_repos_linux { eval $start if $b_log; - my (@content,@data,@data2,@data3,@files,$repo,@repos,@rows); + my $rows = $_[0]; + my (@content,$data,@data2,@data3,@files,$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 $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'; @@ -16463,34 +25145,42 @@ sub get_repos_linux { my $xbps_dir_2 = '/usr/share/xbps.d/'; my $zypp_repo_dir = '/etc/zypp/repos.d/'; my $b_test = 0; - # apt - debian, buntus, also sometimes some yum/rpm repos may create - # apt repos here as well + ## 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); - main::log_data('data',"apt repo files:\n" . main::joiner(\@files, "\n", 'unset') ) if $b_log; + # 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 - @data = repo_builder($_,'apt','^\s*(deb|rpm)') if -r $_; - push(@rows,@data); + # 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("$ENV{'HOME'}/bin/scripts/inxi/data/repo/apt/*.sources"); + # @files = main::globber("$fake_data_dir/repo/apt/*.sources"); @files = main::globber("$apt.d/*.sources"); - main::log_data('data',"apt deb822 repo files:\n" . main::joiner(\@files, "\n", 'unset') ) if $b_log; + # 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; + # print Data::Dumper::Dumper \@data2; if (@data2){ @data2 = map {s/^\s*$/~/;$_} @data2; push(@data2, '~'); } push(@dbg_files, $file) if $debugger_dir; - #print "$file\n"; + # print "$file\n"; @apt_urls = (); @apt_working = (); $b_apt_enabled = 1; @@ -16501,20 +25191,20 @@ sub get_repos_linux { next if $row =~ /^\s+/ && $row !~ /^\s+[^#]+:\//; # strip out line space starters now that it's safe $row =~ s/^\s+//; - #print "$row\n"; + # print "$row\n"; if ($row eq '~'){ if (@apt_working && $b_apt_enabled){ - #print "1: url builder\n"; + # 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"; + # print "s1:$string\n"; push(@data3, $string); } - #print join("\n",@data3),"\n"; + # print join("\n",@data3),"\n"; push(@apt_urls,@data3); } @data3 = (); @@ -16525,14 +25215,12 @@ sub get_repos_linux { $apt_types = ''; $b_apt_enabled = 1; } - #print "row:$row\n"; elsif ($row =~ /^Types:\s*(.*)/i){ - #print "ath:$type_holder\n"; + # print "1:$1\n"; $apt_types = $1; } elsif ($row =~ /^Enabled:\s*(.*)/i){ - my $status = $1; - $b_apt_enabled = ($status =~ /\b(disable|false|off|no|without)\b/i) ? 0: 1; + $b_apt_enabled = ($1 =~ /\b(disable|false|off|no|without)\b/i) ? 0: 1; } elsif ($row =~ /^[^#]+:\//){ my $url = $row; @@ -16551,22 +25239,22 @@ sub get_repos_linux { } if (@apt_urls){ $key = repo_data('active','apt'); - @apt_urls = url_cleaner(\@apt_urls); + clean_url(\@apt_urls); } else { $key = repo_data('missing','apt'); } - push(@rows, + push(@$rows, {main::key($num++,1,1,$key) => $file}, [@apt_urls], ); } @files = (); } - # pacman: Arch and derived + ## pacman, pacman-g2: Arch + derived, Frugalware if (-f $pacman || -f $pacman_g2){ $repo = 'pacman'; - if (-f $pacman_g2 ){ + if (-f $pacman_g2){ $pacman = $pacman_g2; $repo = 'pacman-g2'; } @@ -16586,47 +25274,129 @@ sub get_repos_linux { unshift(@files, $pacman) if @repos; foreach (@files){ if (-f $_){ - @data = repo_builder($_,$repo,'^\s*Server','\s*=\s*',1); - push(@rows,@data); + $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, + push(@$rows, {main::key($num++,1,1,'File listed in') => $pacman}, [("$_ does not seem to exist.")], ); } } - if (!@rows){ - push(@rows, + if (!@$rows){ + push(@$rows, {main::key($num++,0,1,repo_data('missing','files')) => $pacman }, ); } } - # slackware - if (-f $slackpkg || -f $slackpkg_plus || -d $slapt_get){ - #$slackpkg = "$ENV{HOME}/bin/scripts/inxi/data/repo/slackware/slackpkg-2.conf"; + ## 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"; + # $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); + $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); + $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; - @data = main::reader($slackpkg_plus,'strip'); my (@repoplus_list,$active_repos); - foreach my $row (@data){ + 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) + # 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; @@ -16641,40 +25411,101 @@ sub get_repos_linux { } } } - if (! @content){ + if (!@content){ $key = repo_data('missing','slackpkg+'); } else { - @content = url_cleaner(\@content); + clean_url(\@content); $key = repo_data('active','slackpkg+'); } - @data = ( + my @data = ( {main::key($num++,1,1,$key) => $slackpkg_plus}, [@content], ); - @data = url_cleaner(\@data); - push(@rows,@data); + push(@$rows,@data); @content = (); } - } - # redhat/suse - if (-d $yum_repo_dir || -f $yum_conf || -d $zypp_repo_dir){ - if (-d $yum_repo_dir || -f $yum_conf){ - @files = main::globber("$yum_repo_dir*.repo"); - push(@files, $yum_conf) if -f $yum_conf; - $repo = 'yum'; + if (-f $slpkg){ + my ($active,$name,$repo); + my $holder = ''; + @data2 = main::reader($slpkg); + # We can't rely on the presence of empty lines as block separator. + push(@data2,'-eof-') if @data2; + # print Data::Dumper::Dumper \@data2; + # old: "https://download.salixos.org/x86_64/slackware-15.0/" + # new: ["https://slac...nl/people/alien/sbrepos/", "15.0/", "x86_64/"] + foreach (@data2){ + next if /^\s*([#\[]|$)/; + $_ = lc($_); + if (/^\s*(\S+?)_(repo(|_name|_mirror))\s*=\s*[\['"]{0,2}(.*?)[\]'"]{0,2}\s*$/ || + $_ eq '-eof-'){ + my ($key,$value) = ($2,$4); + if (($1 && $holder ne $1) || $_ eq '-eof-'){ + $holder = $1; + if ($name && $repo){ + if (!$active || $active =~ /^(true|1|yes)$/i){ + push(@content,"$name ~ $repo"); + } + ($active,$name,$repo) = (); + } + } + if ($key){ + if ($key eq 'repo'){ + $active = $value;} + elsif ($key eq 'repo_name'){ + $name = $value;} + elsif ($key eq 'repo_mirror'){ + # map new form to a real url + $value =~ s/['"],\s*['"]//g; + $repo = $value;} + } + } + } + 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) = (); } - elsif (-d $zypp_repo_dir){ - @files = main::globber("$zypp_repo_dir*.repo"); + } + ## 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; - $repo = 'zypp'; } - #$repo = 'yum'; - #push(@files, "$ENV{'HOME'}/bin/scripts/inxi/data/repo/yum/rpmfusion-nonfree-1.repo"); + # 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 @@ -16715,24 +25546,24 @@ sub get_repos_linux { if ($url && $title && $enabled){ push(@content, "$title ~ $url"); } - if (! @content){ + if (!@content){ $key = repo_data('missing',$repo); } else { - @content = url_cleaner(\@content); + clean_url(\@content); $key = repo_data('active',$repo); } - push(@rows, + push(@$rows, {main::key($num++,1,1,$key) => $_}, [@content], ); @content = (); } } - # print Data::Dumper::Dumper \@rows; + # print Data::Dumper::Dumper \@$rows; } - # gentoo - if ( (-d $portage_dir || -d $portage_gentoo_dir ) && main::check_program('emerge')){ + # 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){ @@ -16782,10 +25613,10 @@ sub get_repos_linux { $key = repo_data('missing','portage'); } else { - @content = url_cleaner(\@content); + clean_url(\@content); $key = repo_data('active','portage'); } - push(@rows, + push(@$rows, {main::key($num++,1,1,$key) => $_}, [@content], ); @@ -16793,12 +25624,27 @@ sub get_repos_linux { } } } - # Alpine linux - if (-f $apk){ - @data = repo_builder($apk,'apk','^\s*[^#]+'); - push(@rows,@data); + ## 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 + # cards: Nutyx if (-f $cards){ @data3 = main::reader($cards,'clean'); push(@dbg_files, $cards) if $debugger_dir; @@ -16808,54 +25654,63 @@ sub get_repos_linux { push(@content, "$1 ~ $type"); } } - if (! @content){ + if (!@content){ $key = repo_data('missing','cards'); } else { - @content = url_cleaner(\@content); + clean_url(\@content); $key = repo_data('active','cards'); } - push(@rows, + push(@$rows, {main::key($num++,1,1,$key) => $cards}, [@content], ); @content = (); } - # TinyCore + ## 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){ - @data = repo_builder($tce_file,'tce','^\s*[^#]+'); - push(@rows,@data); + 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); + $data = repo_builder($tce_file2,'tce','^\s*[^#]+'); + push(@$rows,@$data); } } - # Void + ## 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; + main::log_data('data',"xbps repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log; foreach (sort @files){ - @data = repo_builder($_,'xbps','^\s*repository\s*=','\s*=\s*',1) if -r $_; - push(@rows,@data); + if (-r $_){ + $data = repo_builder($_,'xbps','^\s*repository\s*=','\s*=\s*',1); + push(@$rows,@$data); + } } } - # Mandriva/Mageia using: urpmq - if ( $path = main::check_program('urpmq') ){ - @data2 = main::grabber("$path --list-media active --list-url","\n",'strip'); + ## 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; - # 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 <data>:<url> 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. + # 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 + # <data>:<url> 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 + # 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: @@ -16863,32 +25718,32 @@ sub get_repos_linux { if (/(.+)\s([\S]+:\/\/.+)/){ # pack the repo url push(@content, $1); - @content = url_cleaner(\@content); + clean_url(\@content); # get the repo $repo = $2; - push(@rows, - {main::key($num++,1,1,'urpmq repo') => $repo}, + push(@$rows, + {main::key($num++,1,1,'urpm repo') => $repo}, [@content], ); @content = (); } } } - # Pardus/Solus - if ( (-d $pisi_dir && ( $path = main::check_program('pisi') ) ) || - (-d $eopkg_dir && ( $path = main::check_program('eopkg') ) ) ){ + # 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'); + # 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'); 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 <data>:<url> 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. + # 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 <data>:<url> 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] @@ -16904,14 +25759,14 @@ sub get_repos_linux { push(@content, $_) if $repo; } # Local [inactive] Unstable [active] - elsif ( /^(.*)\s\[([\S]+)\]/){ + elsif (/^(.*)\s\[([\S]+)\]/){ $repo = $1; $repo = ($2 =~ /^activ/i) ? $repo : ''; } if ($repo && @content){ - @content = url_cleaner(\@content); + clean_url(\@content); $key = repo_data('active',$which); - push(@rows, + push(@$rows, {main::key($num++,1,1,$key) => $repo}, [@content], ); @@ -16921,45 +25776,67 @@ sub get_repos_linux { } # last one if present if ($repo && @content){ - @content = url_cleaner(\@content); + clean_url(\@content); $key = repo_data('active',$which); - push(@rows, + push(@$rows, {main::key($num++,1,1,$key) => $repo}, [@content], ); } } - # print Dumper \@rows; + ## 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; - return @rows; } + sub get_repos_bsd { eval $start if $b_log; - my (@content,@data,@data2,@data3,@files,@rows); + 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){ - 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 ( -f $freebsd_pkg ){ -# @data = repo_builder($freebsd_pkg,'freebsd-pkg','^\s*url',':\s+',1); -# push(@rows,@data); -# } - if ( -d $bsd_pkg || -f $freebsd_pkg){ + 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){ @@ -16968,34 +25845,34 @@ sub get_repos_bsd { # 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; + @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; + @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; + # print "url:$url\n" if $url; if ($data2[0] eq 'enabled'){ - if ($url && $data2[1] eq 'yes'){ + if ($url && $data2[1] =~ /^(1|true|yes)$/i){ push(@data3, "$url"); } $url = ''; } } } - if (! @data3){ + if (!@data3){ $key = repo_data('missing','bsd-package'); } else { - @data3 = url_cleaner(\@data3); + clean_url(\@data3); $key = repo_data('active','bsd-package'); } - push(@rows, + push(@$rows, {main::key($num++,1,1,$key) => $_}, [@data3], ); @@ -17004,24 +25881,50 @@ sub get_repos_bsd { } } } - elsif (-f $openbsd || -f $openbsd2) { + if (-f $openbsd || -f $openbsd2){ if (-f $openbsd){ - @data = repo_builder($openbsd,'openbsd','^installpath','\s*=\s*',1); - push(@rows,@data); + $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); + $data = repo_builder($openbsd2,'openbsd','^(http|ftp)','',1); + push(@$rows,@$data); } } - elsif (-f $netbsd){ + if (-f $netbsd){ # not an empty row, and not a row starting with # - @data = repo_builder($netbsd,'netbsd','^\s*[^#]+$'); - push(@rows,@data); - } + $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 (!@$rows){ if ($bsd_type eq 'freebsd'){ $key = repo_data('missing','freebsd-files'); } @@ -17034,27 +25937,28 @@ sub get_repos_bsd { else { $key = repo_data('missing','bsd-files'); } - push(@rows, + push(@$rows, {main::key($num++,0,1,'Message') => $key}, [()], ); } eval $start if $b_log; - return @rows; } -sub repo_data { + +sub set_repo_keys { eval $start if $b_log; - my ($status,$type) = @_; - my %keys = ( + %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 BSD pkg server files found', - 'bsd-package-active' => 'BSD enabled pkg servers 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 repo', 'eopkg-missing' => 'No active eopkg repos found', 'files-missing' => 'No repo files found in', @@ -17063,9 +25967,15 @@ sub repo_data { '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', @@ -17077,14 +25987,25 @@ sub repo_data { 'pisi-missing' => 'No active pisi repos found', 'portage-active' => 'Enabled portage sources in', 'portage-missing' => 'No enabled portage sources in', - 'portsnap-active' => 'BSD ports server', + 'portsnap-active' => 'Ports server', 'portsnap-missing' => 'No ports servers in', - 'slackpkg-active' => 'slackpkg repos in', - 'slackpkg-missing' => 'No active slackpkg repos 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', + 'tazpkg-active' => 'tazpkg mirrors in', + 'tazpkg-missing' => 'No tazpkg mirrors in', 'tce-active' => 'tce mirrors in', 'tce-missing' => 'No tce mirrors in', 'xbps-active' => 'Active xbps repos in', @@ -17095,17 +26016,25 @@ sub repo_data { 'zypp-missing' => 'No active zypp repos in', ); eval $end if $b_log; - return $keys{$type . '-' . $status}; } + +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}; +} + sub repo_builder { eval $start if $b_log; my ($file,$type,$search,$split,$count) = @_; - my (@content,@data,$key); + 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; - @content = data_cleaner(\@content) if @content; + clean_data(\@content) if @content; } if ($split && @content){ @content = map { @@ -17118,27 +26047,34 @@ sub repo_builder { } else { $key = repo_data('active',$type); - @content = url_cleaner(\@content); + clean_url(\@content); } - @data = ( + eval $end if $b_log; + return [ {main::key($num++,1,1,$key) => $file}, [@content], - ); - eval $end if $b_log; - return @data; + ]; } -sub data_cleaner { - my ($content) = @_; - # basics: trim white space, get rid of double spaces - @$content = map { $_ =~ s/^\s+|\s+$//g; $_ =~ s/\s\s+/ /g; $_} @$content; - return @$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 url_cleaner { - my ($content) = @_; - @$content = map { $_ =~ s/:\//: \//; $_} @$content if $b_irc; - return @$content; + +# 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); @@ -17150,399 +26086,507 @@ sub file_path { } } -## SensorData +## SensorItem { -package SensorData; -my ($b_ipmi) = (0); +package SensorItem; +my $gpu_data = []; +my $sensors_raw = {}; +my $max_fan = 15000; + sub get { eval $start if $b_log; - my ($key1,$program,$val1,@data,@rows,%sensors); - my $num = 0; - my $source = 'sensors'; + 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 ( $b_ipmi || - ( main::globber('/dev/ipmi**') && - ( ( $program = main::check_program('ipmi-sensors') ) || - ( $program = main::check_program('ipmitool') ) ) ) ){ - if ($b_ipmi || $b_root){ - %sensors = ipmi_data($program); - @data = sensors_output('ipmi',\%sensors); - if (!@data) { - $key1 = 'Message'; - $val1 = main::row_defaults('sensors-data-ipmi'); - #$val1 = main::row_defaults('dev'); - @data = ({main::key($num++,0,1,$key1) => $val1,}); + 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, + }); } - push(@rows,@data); - $source = 'lm-sensors'; # trips per sensor type output } else { $key1 = 'Permissions'; - $val1 = main::row_defaults('sensors-ipmi-root'); - @data = ({main::key($num++,0,1,$key1) => $val1,}); - push(@rows,@data); + $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; } - if ( $alerts{'sensors'}->{'action'} ne 'use'){ - #print "here 1\n"; - $key1 = $alerts{'sensors'}->{'action'}; - $val1 = $alerts{'sensors'}->{$key1}; - $key1 = ucfirst($key1); - @data = ({main::key($num++,0,1,$key1) => $val1,}); - push(@rows,@data); + $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 { - %sensors = lm_sensors_data(); - @data = sensors_output($source,\%sensors); - #print "here 2\n"; - if (!@data) { - $key1 = 'Message'; - $val1 = main::row_defaults('sensors-data-linux'); - @data = ({main::key($num++,0,1,$key1) => $val1,}); + 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'); + } } - push(@rows,@data); + } + 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; + return $rows; } + sub sensors_output { eval $start if $b_log; - my ($source,$sensors) = @_; - # note: might revisit this, since gpu sensors data might be present - return if ! %$sensors; - my (@gpu,@rows,@fan_default,@fan_main); - my ($data_source) = (''); + my ($rows,$source,$sensors) = @_; + my ($b_result,@fan_default,@fan_main); my $fan_number = 0; my $num = 0; - my $j = 0; - @gpu = gpu_data() if ( $source eq 'sensors' || $source eq 'lm-sensors' ); + 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' ; - $data_source = $source if ($source eq 'ipmi' || $source eq 'lm-sensors'); - push(@rows, { - main::key($num++,1,1,'System Temperatures') => $data_source, - main::key($num++,0,2,$cpu1_key) => $cpu_temp, - }); + 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,2,'cpu-2')} = $sensors->{'cpu2-temp'} . $temp_unit; + $rows->[$j]{main::key($num++,0,$l2,'cpu-2')} = $sensors->{'cpu2-temp'} . $temp_unit; } if ($sensors->{'cpu3-temp'}){ - $rows[$j]->{main::key($num++,0,2,'cpu-3')} = $sensors->{'cpu3-temp'} . $temp_unit; + $rows->[$j]{main::key($num++,0,$l2,'cpu-3')} = $sensors->{'cpu3-temp'} . $temp_unit; } if ($sensors->{'cpu4-temp'}){ - $rows[$j]->{main::key($num++,0,2,'cpu-4')} = $sensors->{'cpu4-temp'} . $temp_unit; + $rows->[$j]{main::key($num++,0,$l2,'cpu-4')} = $sensors->{'cpu4-temp'} . $temp_unit; } - $rows[$j]->{main::key($num++,0,2,'mobo')} = $mobo_temp; + 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,2,'sodimm')} = $sodimm_temp; + $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,2,'psu')} = $psu_temp; + $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,2,'ambient')} = $ambient_temp; - } - if (scalar @gpu == 1 && defined $gpu[0]->{'temp'}){ - my $gpu_temp = $gpu[0]->{'temp'}; - my $gpu_type = $gpu[0]->{'type'}; - my $gpu_unit = (defined $gpu[0]{'temp-unit'} && $gpu_temp ) ? " $gpu[0]->{'temp-unit'}" : ' C'; - $rows[$j]->{main::key($num++,1,2,'gpu')} = $gpu_type; - $rows[$j]->{main::key($num++,0,3,'temp')} = $gpu_temp . $gpu_unit; - if ($extra > 1 && $gpu[0]->{'temp-mem'}){ - $rows[$j]->{main::key($num++,0,3,'mem')} = $gpu[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 = ($data_source) ? $data_source : ''; - if (!@fan_main && !@fan_default){ - $fan_def = ($fan_def) ? "$data_source N/A" : 'N/A'; - } - $rows[$j]->{main::key($num++,1,1,'Fan Speeds (RPM)')} = $fan_def; + $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,2,'cpu')} = $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,2,'mobo')} = $fan_main[$i]; + $rows->[$j]{main::key($num++,0,$l2,'mobo')} = $fan_main[$i]; } elsif ($i == 3){ - $rows[$j]->{main::key($num++,0,2,'psu')} = $fan_main[$i]; + $rows->[$j]{main::key($num++,0,$l2,'psu')} = $fan_main[$i]; } elsif ($i == 4){ - $rows[$j]->{main::key($num++,0,2,'sodimm')} = $fan_main[$i]; + $rows->[$j]{main::key($num++,0,$l2,'sodimm')} = $fan_main[$i]; } elsif ($i > 4){ $fan_number = $i - 4; - $rows[$j]->{main::key($num++,0,2,"case-$fan_number")} = $fan_main[$i]; + $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,2,"fan-$i")} = $fan_default[$i]; + $rows->[$j]{main::key($num++,0,$l2,"fan-$i")} = $fan_default[$i]; } } - $rows[$j]->{main::key($num++,0,2,'psu')} = $sensors->{'fan-psu'} if defined $sensors->{'fan-psu'}; - $rows[$j]->{main::key($num++,0,2,'psu-1')} = $sensors->{'fan-psu1'} if defined $sensors->{'fan-psu1'}; - $rows[$j]->{main::key($num++,0,2,'psu-2')} = $sensors->{'fan-psu2'} if defined $sensors->{'fan-psu2'}; + $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 == 1 && defined $gpu[0]->{'fan-speed'}){ - my $gpu_fan = $gpu[0]->{'fan-speed'} . $gpu[0]{'speed-unit'}; - my $gpu_type = $gpu[0]->{'type'}; - $rows[$j]->{main::key($num++,1,2,'gpu')} = $gpu_type; - $rows[$j]->{main::key($num++,0,3,'fan')} = $gpu_fan; - } - if (scalar @gpu > 1){ - $j = scalar @rows; - $rows[$j]->{main::key($num++,1,1,'GPU')} = ''; - my $gpu_unit = (defined $gpu[0]->{'temp-unit'} ) ? " $gpu[0]->{'temp-unit'}" : ' C'; - foreach my $info (@gpu){ + 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_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,2,'device')} = $gpu_type; - if (defined $info->{'screen'} ){ - $rows[$j]->{main::key($num++,0,3,'screen')} = $info->{'screen'}; + 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,3,'temp')} = $gpu_temp; + $rows->[$j]{main::key($num++,0,$l3,'temp')} = $gpu_temp; if ($extra > 1 && $info->{'temp-mem'}){ - $rows[$j]->{main::key($num++,0,3,'mem')} = $info->{'temp-mem'} . $gpu_unit; + $rows->[$j]{main::key($num++,0,$l3,'mem')} = $info->{'temp-mem'} . $gpu_unit; } if (defined $gpu_fan){ - $rows[$j]->{main::key($num++,0,3,'fan')} = $gpu_fan; + $rows->[$j]{main::key($num++,0,$l3,'fan')} = $gpu_fan; } if ($extra > 2 && $info->{'watts'}){ - $rows[$j]->{main::key($num++,0,3,'watts')} = $info->{'watts'}; + $rows->[$j]{main::key($num++,0,$l3,'watts')} = $info->{'watts'}; } - if ($extra > 2 && $info->{'mvolts'}){ - $rows[$j]->{main::key($num++,0,3,'mV')} = $info->{'mvolts'}; + 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'} || $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,1,'Power')} = $data_source; - $rows[$j]->{main::key($num++,0,2,'12v')} = $sensors->{'volts-12'}; - $rows[$j]->{main::key($num++,0,2,'5v')} = $sensors->{'volts-5'}; - $rows[$j]->{main::key($num++,0,2,'3.3v')} = $sensors->{'volts-3.3'}; - $rows[$j]->{main::key($num++,0,2,'vbat')} = $sensors->{'volts-vbat'}; - if ($extra > 1 && $source eq 'ipmi' ){ + $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'; - $rows[$j]->{main::key($num++,0,2,'dimm-p1')} = $sensors->{'volts-dimm-p1'} if $sensors->{'volts-dimm-p1'}; - $rows[$j]->{main::key($num++,0,2,'dimm-p2')} = $sensors->{'volts-dimm-p2'} if $sensors->{'volts-dimm-p2'}; - $rows[$j]->{main::key($num++,0,2,'soc-p1')} = $sensors->{'volts-soc-p1'} if $sensors->{'volts-soc-p1'}; - $rows[$j]->{main::key($num++,0,2,'soc-p2')} = $sensors->{'volts-soc-p2'} if $sensors->{'volts-soc-p2'}; + 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 == 1 && $extra > 2 && ($gpu[0]->{'watts'} || $gpu[0]->{'mvolts'})){ - $rows[$j]->{main::key($num++,1,2,'gpu')} = $gpu[0]->{'type'}; - $rows[$j]->{main::key($num++,0,3,'watts')} = $gpu[0]->{'watts'} if $gpu[0]->{'watts'} ; - $rows[$j]->{main::key($num++,0,3,'mV')} = $gpu[0]->{'mvolts'} if $gpu[0]->{'mvolts'}; + 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 @rows; + return $b_result; } + sub ipmi_data { eval $start if $b_log; my ($program) = @_; - my ($b_cpu_0,$cmd,$file,@data,$fan_working,%sensors,@row,$sys_fan_nu, - $temp_working,$working_unit); - $program ||= 'ipmi-sensors'; # only for debugging, will always exist if reaches here + 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); - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmitool-sensors-archerseven-1.txt";$program='ipmitool'; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmitool-sensors-crazy-epyc-1.txt";$program='ipmitool'; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmitool-sensors-RK016013.txt";$program='ipmitool'; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmi-sensors-crazy-epyc-1.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmi-sensors-lathander.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmi-sensors-zwerg.txt"; - #@data = main::reader($file); - if ($program =~ /ipmi-sensors$/){ - $cmd = $program; - ($b_ipmitool,$i_key,$i_value,$i_unit) = (0,1,3,4); + 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 { - $cmd = "$program sensors"; - ($b_ipmitool,$i_key,$i_value,$i_unit) = (1,0,1,2); + 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"); } - @data = main::grabber("$cmd 2>/dev/null"); # print join("\n", @data), "\n"; - return if ! @data; + # 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"; + # 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_TEMP[0-9]|System[\s_]Temp|System[\s_]?Board)$/i){ - $sensors{'mobo-temp'} = int($row[$i_value]); + 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; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; } - elsif ($row[$i_key] =~ /^(Ambient)$/i){ - $sensors{'ambient-temp'} = int($row[$i_value]); + 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; + $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([01])?([\s_]Temp)?$/i) { + 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]); + $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; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; } - elsif ($row[$i_key] =~ /^CPU([1-4])([\s_]Temp)?$/i) { + 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]); + $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; + $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[_]?TEMP1|Temp[\s_]1)$/i) { + 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; + 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; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; } - elsif ($row[$i_key] =~ /^(MB[_]?TEMP2|Temp[\s_]2)$/i) { + 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; + 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; + $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) { + 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; + 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; + $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){ - $sensors{'sodimm-temp'} = int($row[$i_value]); + 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; + $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) { - $sensors{'fan-main'}->[1] = int($row[$i_value]); + 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 - elsif ($row[$i_key] =~ /^(SYS[\s_])?FAN[\s_]?([0-9A-F]+)/i) { + # 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]); - $sensors{'fan-default'} = () if !$sensors{'fan-default'}; - if ( $sys_fan_nu =~ /^([0-9]+)$/ ) { + 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; + 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; + $sensors->{'fan-default'}->[$sys_fan_nu] = $fan_working; } } } - elsif ($row[$i_key] =~ /^(FAN PSU|PSU FAN)$/i) { - $sensors{'fan-psu'} = int($row[$i_value]); + 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) { - $sensors{'fan-psu-1'} = int($row[$i_value]); + 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) { - $sensors{'fan-psu-2'} = int($row[$i_value]); + 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] =~ /^(MAIN\s|P[_]?)?12V$/i) { - $sensors{'volts-12'} = $row[$i_value]; + if ($row[$i_key] =~ /^((.+\s|P[_]?)?\+?12V|PSU[12]_VOUT)$/i){ + $sensors->{'volts-12'} = $row[$i_value]; } - elsif ($row[$i_key] =~ /^(MAIN\s5V|P5V|5VCC|5V PG)$/i) { - $sensors{'volts-5'} = $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] =~ /^(MAIN\s3.3V|P3V3|3.3VCC|3.3V PG)$/i) { - $sensors{'volts-3.3'} = $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]; + 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)/i) { - $sensors{'volts-dimm-p1'} = $row[$i_value]; + 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)/i) { - $sensors{'volts-dimm-p2'} = $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-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]; + elsif (!$sensors->{'volts-soc-p2'} && $row[$i_key] =~ /^(P2_SOC_RUN$)/i){ + $sensors->{'volts-soc-p2'} = $row[$i_value]; } } } - # print Data::Dumper::Dumper \%sensors; - %sensors = process_data(%sensors) if %sensors; - main::log_data('dump','ipmi: %sensors',\%sensors) if $b_log; + 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; - return %sensors; + print Data::Dumper::Dumper $sensors if $dbg[31]; + return $sensors; } -sub lm_sensors_data { + +sub linux_sensors_data { eval $start if $b_log; - my (%sensors); + my $sensors = {}; my ($sys_fan_nu) = (0); my ($adapter,$fan_working,$temp_working,$working_unit) = ('','','','',''); - process_lm_sensors() if !$b_sensors; - foreach $adapter (keys %{$sensors_raw{'main'}}){ - next if !$adapter || ref $sensors_raw{'main'}->{$adapter} ne 'ARRAY'; + 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}}){ + foreach (@{$sensors_raw->{'main'}{$adapter}}){ my @working = split(':', $_); next if !$working[0]; - #print "$working[0]:$working[1]\n"; + # 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 @@ -17551,12 +26595,12 @@ sub lm_sensors_data { # 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) { + 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; + 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; + $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 @@ -17566,159 +26610,198 @@ sub lm_sensors_data { # 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 cpu die temp - elsif ($_ =~ /^(T?CPU.*|Tdie.*):([0-9\.]+)[\s°]*(C|F)/i) { + # 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{'cpu-temp'} || - ( defined $temp_working && $temp_working > 0 && $temp_working > $sensors{'cpu-temp'} ) ) { - $sensors{'cpu-temp'} = $temp_working; + 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; + $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; + 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; + $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; + 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; + $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; + 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; + $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) { + 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; + 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; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; } - elsif ($_ =~ /^temp2:([0-9\.]+)[\s°]*(C|F)/i) { + 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; + 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; + $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) { + 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; + 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; + $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) { + 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; + 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; + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit; } # note: can be cpu fan:, cpu fan speed:, etc. - elsif (!$sensors{'fan-main'}->[1] && $_ =~ /^F?(CPU|Processor).*:([0-9]+)[\s]RPM/i) { - $sensors{'fan-main'}->[1] = $2; + elsif (!defined $sensors->{'fan-main'}->[1] && $_ =~ /^F?(CPU|Processor).*:([0-9]+)[\s]RPM/i){ + $sensors->{'fan-main'}->[1] = $2 if $2 < $max_fan; } - elsif (!$sensors{'fan-main'}->[2] && $_ =~ /^F?(M\/B|MB|SYS|Motherboard).*:([0-9]+)[\s]RPM/i) { - $sensors{'fan-main'}->[2] = $2; + 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 (!$sensors{'fan-main'}->[3] && $_ =~ /F?(Power|P\/S|POWER).*:([0-9]+)[\s]RPM/i) { - $sensors{'fan-main'}->[3] = $2; + 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 (!$sensors{'fan-main'}->[4] && $_ =~ /F?(dimm|mem|sodimm).*:([0-9]+)[\s]RPM/i) { - $sensors{'fan-main'}->[4] = $2; + 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) { + 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; + 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; + 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) { + 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]+)$/ ) { + 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; + 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; + $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; + 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 ($_ =~ /^[+]?(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 ($_ =~ /^[+]?(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 ($_ =~ /^(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; } - elsif ($_ =~ /^v(dimm|mem|sodimm).*:([0-9\.]+)\sV/i) { - $sensors{'volts-mem'} = $2; + if (!$sensors->{'temp-unit'} && $working_unit){ + $sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit); } } } } - # print Data::Dumper::Dumper \%sensors; - %sensors = process_data(%sensors) if %sensors; - main::log_data('dump','lm-sensors: %sensors',\%sensors) if $b_log; - # print Data::Dumper::Dumper \%sensors; + 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; + return $sensors; } -sub process_lm_sensors { + +sub load_lm_sensors { eval $start if $b_log; - my (@data,@sensors_data,@values); + my (@sensors_data,@values); my ($adapter,$holder,$type) = ('','',''); - if ($b_fake_sensors){ - #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/amdgpu-w-fan-speed-stretch-k10.txt"; - #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/peci-tin-geggo.txt"; - #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-w-other-biker.txt"; - #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-asus-chassis-1.txt"; - #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-devnull-1.txt"; - #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-jammin1.txt"; - #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-mx-incorrect-1.txt"; - # my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-maximus-arch-1.txt"; - # my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/kernel-58-sensors-ant-1.txt"; - # my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-zenpower-nvme-2.txt"; - #@sensors_data = main::reader($file); + 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 @@ -17729,9 +26812,9 @@ sub process_lm_sensors { @sensors_data = map {$_ =~ s/\s*:\s*\+?/:/;$_} @sensors_data; push(@sensors_data, 'END'); } - #print Data::Dumper::Dumper \@sensors_data; + # print Data::Dumper::Dumper \@sensors_data; foreach (@sensors_data){ - #print 'st:', $_, "\n"; + # print 'st:', $_, "\n"; next if /^\s*$/; $_ = main::trimmer($_); if (@values && $adapter && (/^Adapter/ || $_ eq 'END')){ @@ -17739,20 +26822,31 @@ sub process_lm_sensors { if ($adapter =~ /^(drive|nvme)/){ $type = 'disk'; } - elsif ($adapter =~ /^(amdgpu|intel|nouveau|radeon)-/){ - $type = 'gpu'; + elsif ($adapter =~ /^(BAT)/){ + $type = 'bat'; } - # ath/iwl: wifi; enp/eno/eth: lan nic - elsif ($adapter =~ /^(ath|iwl|en[op][0-9]|eth)[\S]+-/){ - $type = 'network'; + # 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|nouveau|radeon)-/){ + $type = 'gpu'; + } + elsif ($adapter =~ /^(acpitz)-/ && $adapter !~ /^(acpitz-virtual)-/ ){ + $type = 'acpitz'; + } else { $type = 'main'; } - $sensors_raw{$type}->{$adapter} = [@values]; + $sensors_raw->{$type}{$adapter} = [@values]; @values = (); $adapter = ''; } @@ -17766,40 +26860,247 @@ sub process_lm_sensors { $holder = $_; } } - $b_sensors = 1; - if ($test[18]){ - print 'lm sensors: ' , Data::Dumper::Dumper \%sensors_raw; - } - if ($b_log){ - main::log_data('dump','lm-sensors data: %sensors_raw',\%sensors_raw); + 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|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; - return @data; } -# oddly, openbsd sysctl actually has hw.sensors data! +# bsds sysctl may have hw.sensors data sub sysctl_data { eval $start if $b_log; - my (@data,%sensors); - foreach (@sysctl_sensors){ - if (/^hw.sensors\.([0-9a-z]+)\.(temp|fan|volt)([0-9])/){ - my $sensor = $1; - my $type = $2; - my $number = $3; - my @working = split(':', $_); + 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; + } + } } - last if /^(hw.cpuspeed|hw.vendor|hw.physmem)/; } - %sensors = process_data(%sensors) if %sensors; - main::log_data('dump','%sensors',\%sensors) if $b_log; - # print Data::Dumper::Dumper \%sensors; + 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; + return $sensors; } + sub set_temp_unit { my ($sensors,$working) = @_; my $return_unit = ''; - if ( !$sensors && $working ){ + if (!$sensors && $working){ $return_unit = $working; } elsif ($sensors){ @@ -17810,33 +27111,37 @@ sub set_temp_unit { sub process_data { eval $start if $b_log; - my (%sensors) = @_; - my ($cpu_temp,$cpu2_temp,$cpu3_temp,$cpu4_temp,$index_count_fan_default, - $index_count_fan_main,$mobo_temp,$psu_temp) = (0,0,0,0,0,0,0,0); - my ($fan_type,$i,$j) = (0,0,0); + 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 ) { + 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 ) { + 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 ) { + 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'} ) { + elsif ($sensors->{'temp1'} >= $sensors->{'temp2'}){ $fan_type = 1; } else { @@ -17845,128 +27150,135 @@ sub process_data { } } # 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'} ){ + elsif (!$sensors->{'temp2'} && !$sensors->{'cpu-temp'}){ + if (!$sensors->{'temp1'} && !$sensors->{'mobo-temp'}){ $fan_type = 1; } - elsif ( $sensors{'temp1'} && !$sensors{'mobo-temp'} ){ + elsif ($sensors->{'temp1'} && !$sensors->{'mobo-temp'}){ $fan_type = 1; } - elsif ( $sensors{'temp1'} && $sensors{'mobo-temp'} ){ + 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" ) { + if ($sensors->{'temp-unit'} && $sensors->{'temp-unit'} eq "F"){ $temp_diff = $temp_diff * 1.8 } - if ( $sensors{'cpu-temp'} ) { + 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'}; + 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'}; + $cpu_temp = $sensors->{'cpu-temp'}; } } else { - if ($fan_type ){ + 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'}; + if ($fan_type == 1){ + if ($sensors->{'temp1'} && $sensors->{'temp2'} && $sensors->{'temp2'} > $sensors->{'temp1'}){ + $cpu_temp = $sensors->{'temp2'}; } else { - $cpu_temp = $sensors{'temp1'}; + $cpu_temp = $sensors->{'temp1'}; } } else { - if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp1'} > $sensors{'temp2'} ) { - $cpu_temp = $sensors{'temp1'}; + if ($sensors->{'temp1'} && $sensors->{'temp2'} && $sensors->{'temp1'} > $sensors->{'temp2'}){ + $cpu_temp = $sensors->{'temp1'}; } else { - $cpu_temp = $sensors{'temp2'}; + $cpu_temp = $sensors->{'temp2'}; } } } else { - $cpu_temp = $sensors{'temp1'}; # can be null, that is ok + $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 ($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'}; + 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'}; + 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'}; + 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'}; + 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'}; + $mobo_temp = $sensors->{'temp2'}; } } else { - if ( $sensors{'temp1'} && $sensors{'temp2'} && $sensors{'temp1'} > $sensors{'temp2'} ) { - $mobo_temp = $sensors{'temp2'}; + if ($sensors->{'temp1'} && $sensors->{'temp2'} && $sensors->{'temp1'} > $sensors->{'temp2'}){ + $mobo_temp = $sensors->{'temp2'}; } else { - $mobo_temp = $sensors{'temp1'}; + $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'}; - #} + ## 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 { - $mobo_temp = $sensors{'temp2'}; + 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'}; + @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'}; + @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] ) { + 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] ) { + 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] ) { + 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] ) { + 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; } } @@ -17980,54 +27292,56 @@ sub process_data { # 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] ) { + 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] = ''; + $fan_default[$j] = undef; # then add one if required for output - if ( $index_count_fan_main < 2 ) { + 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 = (); + 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'}; + $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'}; - $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'}; + $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 = ( + 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'}, + 'temp-unit' => $sensors->{'temp-unit'}, 'fan-main' => \@fan_main, 'fan-default' => \@fan_default, 'fan-psu' => $psu_fan, @@ -18035,36 +27349,36 @@ sub process_data { 'fan-psu2' => $psu2_fan, ); if ($psu_temp){ - $sensors{'psu-temp'} = $psu_temp; + $sensors->{'psu-temp'} = $psu_temp; } if ($sodimm_temp){ - $sensors{'sodimm-temp'} = $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; + 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; - return %sensors; } -sub gpu_data { + +sub gpu_sensor_data { eval $start if $b_log; - return @gpudata if $b_gpudata; my ($cmd,@data,@data2,$path,@screens,$temp); - my ($j) = (0); + 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) { + if ($b_display){ @data = main::grabber("$path -q screens 2>/dev/null"); foreach (@data){ - if ( /(:[0-9]\.[0-9])/ ) { + if (/(:[0-9]\.[0-9])/){ push(@screens, $1); } } @@ -18098,31 +27412,31 @@ sub gpu_data { @data = main::grabber($cmd); main::log_data('cmd',$cmd) if $b_log; push(@data,@data2); - $j = scalar @gpudata; + $j = scalar @$gpu_data; foreach my $item (@data){ if ($item =~ /^\s*Attribute\s\'([^']+)\'\s.*:\s*([\S]+)\.$/){ my $attribute = $1; my $value = $2; - $gpudata[$j]->{'type'} = 'nvidia'; - $gpudata[$j]->{'speed-unit'} = '%'; - $gpudata[$j]->{'screen'} = $screen; - if (!$gpudata[$j]->{'temp'} && $attribute eq 'GPUCoreTemp'){ - $gpudata[$j]->{'temp'} = $value; + $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 (!$gpudata[$j]->{'ram'} && $attribute eq 'VideoRam'){ - $gpudata[$j]->{'ram'} = $value; + elsif (!$gpu_data->[$j]{'ram'} && $attribute eq 'VideoRam'){ + $gpu_data->[$j]{'ram'} = $value; } - elsif (!$gpudata[$j]->{'clock'} && $attribute eq 'GPUCurrentClockFreqs'){ - $gpudata[$j]->{'clock'} = $value; + elsif (!$gpu_data->[$j]{'clock'} && $attribute eq 'GPUCurrentClockFreqs'){ + $gpu_data->[$j]{'clock'} = $value; } - elsif (!$gpudata[$j]->{'bus'} && $attribute eq 'PCIBus'){ - $gpudata[$j]->{'bus'} = $value; + elsif (!$gpu_data->[$j]{'bus'} && $attribute eq 'PCIBus'){ + $gpu_data->[$j]{'bus'} = $value; } - elsif (!$gpudata[$j]->{'bus-id'} && $attribute eq 'PCIDevice'){ - $gpudata[$j]->{'bus-id'} = $value; + elsif (!$gpu_data->[$j]{'bus-id'} && $attribute eq 'PCIDevice'){ + $gpu_data->[$j]{'bus-id'} = $value; } - elsif (!$gpudata[$j]->{'fan-speed'} && $attribute eq 'GPUCurrentFanSpeed'){ - $gpudata[$j]->{'fan-speed'} = $value; + elsif (!$gpu_data->[$j]{'fan-speed'} && $attribute eq 'GPUCurrentFanSpeed'){ + $gpu_data->[$j]{'fan-speed'} = $value; } } } @@ -18133,279 +27447,548 @@ sub gpu_data { @data = main::grabber("$path --adapter=all --od-gettemperature 2>/dev/null"); foreach (@data){ if (/Sensor [^0-9]*([0-9\.]+) /){ - $j = scalar @gpudata; + $j = scalar @$gpu_data; my $value = $1; - $gpudata[$j]->{'type'} = 'amd'; - $gpudata[$j]->{'temp'} = $value; + $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 @gpudata; - $gpudata[$j]->{'type'} = $adapter; - $gpudata[$j]->{'type'} =~ s/^(amdgpu|intel|nouveau|radeon)-.*/$1/; + 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|radeon)-.*/$1/; # print "ad: $adapter\n"; - foreach (@{$sensors_raw{'gpu'}->{$adapter}}){ + foreach (@{$sensors_raw->{'gpu'}{$adapter}}){ # print "val: $_\n"; if (/^[^:]*mem[^:]*:([0-9\.]+).*\b(C|F)\b/i){ - $gpudata[$j]->{'temp-mem'} = $1; - $gpudata[$j]->{'unit'} = $2; + $gpu_data->[$j]{'temp-mem'} = $1; + $gpu_data->[$j]{'unit'} = $2; # print "temp: $_\n"; } elsif (/^[^:]+:([0-9\.]+).*\b(C|F)\b/i){ - $gpudata[$j]->{'temp'} = $1; - $gpudata[$j]->{'unit'} = $2; + $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){ - $gpudata[$j]->{'fan-speed'} = $1; + elsif (/^.*?fan.*?:([0-9\.]+).*(RPM)?/i){ + $gpu_data->[$j]{'fan-speed'} = $1; # NOTE: we test for nvidia %, everything else stays with nothing - $gpudata[$j]->{'speed-unit'} = ''; + $gpu_data->[$j]{'speed-unit'} = ''; } elsif (/^[^:]+:([0-9\.]+)\s+W\s/i){ - $gpudata[$j]->{'watts'} = $1; + $gpu_data->[$j]{'watts'} = $1; } - elsif (/^[^:]+:([0-9\.]+)\s+mV\s/i){ - $gpudata[$j]->{'mvolts'} = $1; + elsif (/^[^:]+:([0-9\.]+)\s+(m?V)\s/i){ + $gpu_data->[$j]{'volts-gpu'} = [$1,$2]; } } } } - main::log_data('dump','sensors output: video: @gpudata',\@gpudata); - # we'll probably use this data elsewhere so make it a one time call - $b_gpudata = 1; - print 'gpudata: ', Data::Dumper::Dumper \@gpudata if $test[18]; + 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; - return @gpudata; } } -## SlotData +## SlotItem { -package SlotData; +package SlotItem; +my ($sys_slots); sub get { eval $start if $b_log; - my (@rows,$key1,$val1); + my ($data,$key1,$val1); + my $rows = []; my $num = 0; - if ($b_fake_dmidecode || ( $alerts{'dmidecode'}->{'action'} eq 'use' && (!$b_arm || $b_slot_tool ) )){ - @rows = slot_output(); + 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 ($b_arm && !$b_slot_tool){ - $key1 = 'ARM'; - $val1 = main::row_defaults('arm-pci',''); - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + 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'){ + elsif ($alerts{'dmidecode'}->{'action'} ne 'use'){ $key1 = $alerts{'dmidecode'}->{'action'}; - $val1 = $alerts{'dmidecode'}->{$key1}; + $val1 = $alerts{'dmidecode'}->{'message'}; $key1 = ucfirst($key1); - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); } eval $end if $b_log; - return @rows; + return $rows; } + sub slot_output { eval $start if $b_log; - my (@rows); - my $num = 0; - foreach my $entry (@dmi){ + my ($rows,$data) = @_; + my $num = 1; + foreach my $slot_data (@$data){ + next if !$slot_data || ref $slot_data ne 'HASH'; $num = 1; - if ($entry->[0] == 9){ - my ($designation,$id,$length,$type,$usage) = ('','','','',''); - # skip first two row, we don't need that data - my $j = scalar @rows; - foreach my $item (@$entry[2 .. $#$entry]){ - if ($item !~ /^~/){ # skip the indented rows - my @value = split(/:\s+/, $item); - if ($value[0] eq 'Type'){ - $type = $value[1]; - } - if ($value[0] eq 'Designation'){ - $designation = $value[1]; - } - if ($value[0] eq 'Current Usage'){ - $usage = $value[1]; - - } - if ($value[0] eq 'ID'){ - $id = $value[1]; - } - if ($extra > 1 && $value[0] eq 'Length'){ - $length = $value[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); } } } - if ($type){ - $id = 'N/A' if ($id eq '' ); - if ($type eq 'Other' && $designation){ - $type = $designation; - } - elsif ($type && $designation) { - $type = "$type $designation"; - } - push(@rows, { - main::key($num++,1,1,'Slot') => $id, - main::key($num++,0,2,'type') => $type, - main::key($num++,0,2,'status') => $usage, - },); - if ($extra > 1 ){ - $rows[$j]->{main::key($num++,0,2,'length')} = $length; + 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 (!@rows){ - my $key = 'Message'; - push(@rows, { - main::key($num++,0,1,$key) => main::row_defaults('pci-slot-data',''), - },); + 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 @rows; + 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; } } -## SwapData +## SwapItem { -package SwapData; +package SwapItem; sub get { eval $start if $b_log; - my (@rows); + my $rows = []; my $num = 0; - @rows = swap_output(); - if (!@rows){ - push(@rows, - {main::key($num++,0,1,'Alert') => main::row_defaults('swap-data')}, - ); + create_output($rows); + if (!@$rows){ + @$rows = ({main::key($num++,0,1,'Alert') => main::message('swap-data')}); } eval $end if $b_log; - return @rows; + return $rows; } -sub swap_output { + +sub create_output { eval $start if $b_log; + my $rows = $_[0]; my $num = 0; my $j = 0; - my (%part,@rows,$dev,$percent,$raw_size,$size,$used); - main::set_proc_partitions() if !$bsd_type && !$b_proc_partitions; - main::set_mapper() if !$b_mapper; - my @swap_data = PartitionData::swap_data(); - foreach my $row (@swap_data){ + 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'} . '%)' : ''; - %part = (); $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')} = ''; + $rows->[$j]{main::key($num++,1,1,'Kernel')} = ''; if (defined $row->{'swappiness'}){ - $rows[$j]->{main::key($num++,0,2,'swappiness')} = $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'}; + $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::row_defaults('swap-admin'); + $rows->[$j]{main::key($num++,0,1,'Message')} = main::message('swap-admin'); } } - $j = scalar @rows; - push(@rows, { + $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'} ){ + 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; + $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; + $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'; + $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'}; + $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'}; + } } $row->{'mount'} =~ s|/home/[^/]+/(.*)|/home/$filter_string/$1| if $row->{'mount'} && $use{'filter'}; - $rows[$j]->{main::key($num++,1,2,$dev)} = ($row->{'mount'}) ? $row->{'mount'} : 'N/A'; + $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'}; + $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'}; + $rows->[$j]{main::key($num++,0,3,'mapped')} = $row->{'dev-mapped'}; } - if ($show{'label'} && ($row->{'label'} || $row->{'swap-type'} eq 'partition') ){ - $row->{'label'} = main::apply_partition_filter('part', $row->{'label'}, '') if $use{'filter-label'}; - $rows[$j]->{main::key($num++,0,2,'label')} = ($row->{'label'}) ? $row->{'label'}: 'N/A'; + if ($show{'label'} && ($row->{'label'} || $row->{'swap-type'} eq 'partition')){ + if ($use{'filter-label'}){ + $row->{'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' )){ - $row->{'uuid'} = main::apply_partition_filter('part', $row->{'uuid'}, '') if $use{'filter-uuid'}; - $rows[$j]->{main::key($num++,0,2,'uuid')} = ($row->{'uuid'}) ? $row->{'uuid'}: 'N/A'; + if ($show{'uuid'} && ($row->{'uuid'} || $row->{'swap-type'} eq 'partition')){ + if ($use{'filter-uuid'}){ + $row->{'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; - return @rows; } - } -## UnmountedData +## UnmountedItem { -package UnmountedData; +package UnmountedItem; sub get { eval $start if $b_log; - my (@data,@rows,$key1,$val1); + my ($data,$key1,$val1); + my $rows = []; my $num = 0; if ($bsd_type){ - $key1 = 'Message'; - $val1 = main::row_defaults('unmounted-data-bsd'); + 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 (main::system_files('partitions')){ - @data = unmounted_data(); - if (!@data){ + if ($system_files{'proc-partitions'}){ + $data = proc_data(); + if (!@$data){ $key1 = 'Message'; - $val1 = main::row_defaults('unmounted-data'); + $val1 = main::message('unmounted-data'); } else { - @rows = unmounted_output(\@data); + create_output($rows,$data); } } else { $key1 = 'Message'; - $val1 = main::row_defaults('unmounted-file'); + $val1 = main::message('unmounted-file'); } } - if (!@rows && $key1){ - @rows = ({main::key($num++,0,1,$key1) => $val1,}); + if (!@$rows && $key1){ + @$rows = ({main::key($num++,0,1,$key1) => $val1}); } eval $end if $b_log; - return @rows; + return $rows; } -sub unmounted_output { + +sub create_output { eval $start if $b_log; - my ($unmounted) = @_; - my (@rows,$fs); + 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'; @@ -18413,45 +27996,64 @@ sub unmounted_output { $fs = lc($row->{'fs'}); } else { - if (main::check_program('file')){ - $fs = ($b_root) ? 'N/A' : main::row_defaults('root-required'); + if ($bsd_type){ + $fs = 'N/A'; + } + elsif (main::check_program('file')){ + $fs = ($b_root) ? 'N/A' : main::message('root-required'); } else { - $fs = main::row_defaults('tool-missing-basic','file'); + $fs = main::message('tool-missing-basic','file'); } } - $row->{'label'} = main::apply_partition_filter('part', $row->{'label'}, '') if $use{'filter-label'}; - $row->{'uuid'} = main::apply_partition_filter('part', $row->{'uuid'}, '') if $use{'filter-uuid'}; - $j = scalar @rows; - push(@rows, { + $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'}; + $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'}; + $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'}){ + $row->{'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'}){ + $row->{'uuid'} = main::filter_partition('part', $row->{'uuid'}, ''); + } + $row->{'uuid'} ||= 'N/A'; + $rows->[$j]{main::key($num++,0,2,'uuid')} = $row->{'uuid'}; + } } - $rows[$j]->{main::key($num++,0,2,'size')} = $size; - $rows[$j]->{main::key($num++,0,2,'fs')} = $fs; - $rows[$j]->{main::key($num++,0,2,'label')} = $row->{'label'}; - $rows[$j]->{main::key($num++,0,2,'uuid')} = $row->{'uuid'}; } eval $end if $b_log; - return @rows; } -sub unmounted_data { + +sub proc_data { eval $start if $b_log; - my ($dev_mapped,$fs,$label,$maj_min,$size,$uuid,%part,@unmounted); + 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 - PartitionData::partition_data() if !$b_partitions; - RaidData::raid_data() if !$b_raid; - my @mounted = get_mounted(); - #print join("\n",(@filters,@mounted)),"\n"; + PartitionItem::set_partitions() if !$loaded{'set-partitions'}; + RaidItem::raid_data() if !$loaded{'raid'}; + my $mounted = get_mounted(); + # 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 @@ -18461,38 +28063,50 @@ sub unmounted_data { # 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 usinig zfs_member test instead to filter out zfs members. - # in arm/android seen /dev/block/mmcblk0p12 - #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,@mounted)) && - !(grep {$_ =~ /(block\/)?$row->[-1]$/} @mounted)){ + # 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 + # 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,@$mounted)) && + !(grep {$_ =~ /(block\/)?$row->[-1]$/} @$mounted) && + !(grep {$_ =~ /^sd[a-z]+$/ && $row->[-1] =~ /^$_[0-9]+/} @$mounted)){ $dev_mapped = $dmmapper{$row->[-1]} if $dmmapper{$row->[-1]}; if (@lsblk){ my $id = ($dev_mapped) ? $dev_mapped: $row->[-1]; - %part = main::get_lsblk($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]; + $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 - # no te: lvm, raid members are neverm ounted. luks member is never mounted. + # 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]+)?$/; - $label = PartitionData::get_label("/dev/$row->[-1]") if !$label; + 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; - $uuid = PartitionData::get_uuid("/dev/$row->[-1]") if !$uuid; - push(@unmounted, { + push(@$unmounted, { 'dev-base' => $row->[-1], 'dev-mapped' => $dev_mapped, 'fs' => $fs, @@ -18503,51 +28117,101 @@ sub unmounted_data { }); } } - # print Data::Dumper::Dumper @unmounted; - main::log_data('dump','@unmounted',\@unmounted) if $b_log; + 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; + return $unmounted; } + sub get_mounted { eval $start if $b_log; - my (@mounted); + my (@arrays); + my $mounted = []; foreach my $row (@partitions){ - push(@mounted, $row->{'dev-base'}) if $row->{'dev-base'}; + push(@$mounted, $row->{'dev-base'}) if $row->{'dev-base'}; } - foreach my $row ((@lvm_raid,@md_raid,@zfs_raid)){ + # 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'}; - my @arrays = (ref $row->{'arrays'} eq 'ARRAY' ) ? @{$row->{'arrays'}} : (); + 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; - foreach my $array (@arrays){ - my @components = (ref $array->{'components'} eq 'ARRAY') ? @{$array->{'components'}} : (); + # 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){ - my @temp = split('~', $component); - push(@mounted, $temp[0]); + # md has ~, not zfs,lvm,softraid + my $temp = (split('~', $component->[0]))[0]; + push(@$mounted, $temp); } } } eval $end if $b_log; - return @mounted; + 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')) { + 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','swap','btrfs', + 'fat32','fat16','FAT\s\(.*\)','vfat','fatx','tfat','exfat','swap','btrfs', 'ffs','hammer','hfs\+','hfs\splus','hfs\sextended\sversion\s[1-9]','hfsj', - 'hfs','jfs','nss','reiserfs','reiser4','ufs2','ufs','xfs','zfs'); + '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("$sudo$file -s /dev/$item 2>/dev/null"))[0]; + $data = (main::grabber("$sudoas$file -s /dev/$item 2>/dev/null"))[0]; if ($data){ foreach (@filesystems){ if ($data =~ /($_)[\s,]/i){ @@ -18564,72 +28228,89 @@ sub unmounted_filesystem { } } -## UsbData +## UsbItem { -package UsbData; +package UsbItem; sub get { eval $start if $b_log; - my (@rows,$key1,$val1); + my ($key1,$val1); + my $rows = []; my $num = 0; - if ( !@usb && $alerts{'lsusb'}->{'action'} ne 'use' && $alerts{'usbdevs'}->{'action'} ne 'use'){ - if ($os eq 'linux' ){ + 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'}->{$key1}; + $val1 = $alerts{'lsusb'}->{'message'}; } else { - $key1 = $alerts{'usbdevs'}->{'action'}; - $val1 = $alerts{'usbdevs'}->{$key1}; + # 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,}); + @$rows = ({main::key($num++,0,1,$key1) => $val1}); } else { - @rows = usb_output(); - if (!@rows){ + usb_output($rows); + if (!@$rows){ my $key = 'Message'; - push(@rows, { - main::key($num++,0,1,$key) => main::row_defaults('usb-data',''), - },); + @$rows = ({ + main::key($num++,0,1,$key) => main::message('usb-data','') + }); } } eval $end if $b_log; - return @rows; + return $rows; } + sub usb_output { eval $start if $b_log; - return if ! @usb; - my (@rows); - my ($b_hub,$bus_id,$chip_id,$driver,$ind_sc,$path_id,$ports,$product,$serial,$speed,$type); + 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 set_lsusb_data by: - # bus id then device id, so we don't need to worry about the order - foreach my $id (@usb){ - $j = scalar @rows; - ($b_hub,$ind_sc,$num) = (0,3,1); - $chip_id = $id->[7]; - ($driver,$path_id,$ports,$product, - $serial,$speed,$type) = ('','','','','','',''); - $speed = ( main::is_numeric($id->[8]) ) ? sprintf("%1.1f",$id->[8]) : $id->[8] if $id->[8]; - $product = main::cleaner($id->[13]) if $id->[13]; - $serial = main::apply_filter($id->[16]) if $id->[16]; + # 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'; - $speed ||= '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, { + # 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, - main::key($num++,0,2,'rev') => $speed, },); $b_hub = 1; + $ind_rc =3; $ind_sc =2; } # it's a device @@ -18638,206 +28319,250 @@ sub usb_output { $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; + # 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; + $rows->[$j]{main::key($num++,0,3,'driver')} = $driver; } if ($extra > 2 && $id->[9]){ - $rows[$j]->{main::key($num++,0,3,'interfaces')} = $id->[9]; + $rows->[$j]{main::key($num++,0,3,'interfaces')} = $id->[9]; } - $rows[$j]->{main::key($num++,0,3,'rev')} = $speed; } # for either hub or device - if ($extra > 1 && main::is_numeric($id->[17])){ - my $speed = $id->[17]; - if ($speed >= 1000) {$speed = ($id->[17] / 1000 ) . " Gb/s"} - else {$speed = $id->[17] . " Mb/s"} - $rows[$j]->{main::key($num++,0,$ind_sc,'speed')} = $speed; - } - if ($extra > 1){ - $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::apply_filter($serial); + $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; + # print Data::Dumper::Dumper \@rows; eval $end if $b_log; - return @rows; } } -## add metric / imperial (us) switch -## WeatherData +## WeatherItem +# add metric / imperial (us) switch { -package WeatherData; +package WeatherItem; sub get { eval $start if $b_log; - my (@rows); + my $rows = []; my $num = 0; - @rows = weather_output(); - eval $end if $b_log; - return @rows; -} -sub weather_output { - eval $start if $b_log; - my ($j,$num) = (0,0); - my (@location,@rows,$value,%weather,); - my ($conditions) = ('NA'); - 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::apply_filter($location_string); - @location = ($show{'weather-location'},$location_string,''); + 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 { - @location = get_location(); - if (!$location[0]) { - return @rows = ({ - main::key($num++,0,1,'Message') => main::row_defaults('weather-null','current location'), + 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); + } } - %weather = get_weather(\@location); - if ($weather{'error'}) { - return @rows = ({ - main::key($num++,0,1,'Message') => main::row_defaults('weather-error',$weather{'error'}), - }); - } - if (!$weather{'weather'}) { - return @rows = ({ - main::key($num++,0,1,'Message') => main::row_defaults('weather-null','weather data'), + if (!@$rows){ + @$rows = ({ + main::key($num++,0,1,'Message') => main::message('weather-null','weather data') }); } - $conditions = "$weather{'weather'}"; - my $temp = process_unit($weather{'temp'},$weather{'temp-c'},'C',$weather{'temp-f'},'F'); - $j = scalar @rows; - push(@rows, { + 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; + 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 (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->{'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->{'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; + 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'} . '%'; + $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; + 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; + $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 ($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'}, + if ($weather->{'forecast'}){ + $j = scalar @$rows; + push(@$rows, { + main::key($num++,1,1,'Forecast') => $weather->{'forecast'}, },); } } } - $j = scalar @rows; - my $location = ''; + $j = scalar @$rows; if ($extra > 2 && !$use{'filter'}){ - $location = complete_location($location[1],$weather{'city'},$weather{'state'},$weather{'country'}); - } - push(@rows, { - main::key($num++,1,1,'Locale') => $location, + 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'}); + 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'},; + $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'}; + $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->{'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->{'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'}; + if ($weather->{'api-source'}){ + $rows->[$j]{main::key($num++,0,1,'Source')} = $weather->{'api-source'}; } eval $end if $b_log; - return @rows; } + 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("%.1f", $feet/3.28) if defined $feet && !$meters; $meters = sprintf("%.0f", $meters) if $meters; - if ( defined $meters && $weather_unit eq 'mi' ){ + if (defined $meters && $weather_unit eq 'mi'){ $result = "$meters $m_unit ($feet $i_unit)"; } - elsif (defined $meters && $weather_unit eq 'im' ){ + elsif (defined $meters && $weather_unit eq 'im'){ $result = "$feet $i_unit ($meters $m_unit)"; } - elsif (defined $meters && $weather_unit eq 'm' ){ + elsif (defined $meters && $weather_unit eq 'm'){ $result = "$meters $m_unit"; } - elsif (defined $feet && $weather_unit eq 'i' ){ + elsif (defined $feet && $weather_unit eq 'i'){ $result = "$feet $i_unit"; } else { @@ -18846,20 +28571,21 @@ sub process_elevation { 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' ){ + 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' ){ + elsif (defined $metric && defined $imperial && $weather_unit eq 'im'){ $result = "$imperial $i_unit ($metric $m_unit)"; } - elsif (defined $metric && $weather_unit eq 'm' ){ + elsif (defined $metric && $weather_unit eq 'm'){ $result = "$metric $m_unit"; } - elsif (defined $imperial && $weather_unit eq 'i' ){ + elsif (defined $imperial && $weather_unit eq 'i'){ $result = "$imperial $i_unit"; } elsif ($primary){ @@ -18871,6 +28597,7 @@ sub process_unit { eval $end if $b_log; return $result; } + sub process_wind { eval $start if $b_log; my ($primary,$direction,$mph,$ms,$gust_mph,$gust_ms) = @_; @@ -18893,30 +28620,30 @@ sub process_wind { if (!defined $mph && $primary){ $result = $primary; } - elsif (defined $mph && defined $direction ){ - if ( $weather_unit eq 'mi' ){ + 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' ){ + elsif ($weather_unit eq 'im'){ $result = "from $direction at $mph $i_unit ($ms $m_unit, $kmh $km_unit)"; } - elsif ( $weather_unit eq 'm' ){ + elsif ($weather_unit eq 'm'){ $result = "from $direction at $ms $m_unit ($kmh $km_unit)"; } - elsif ( $weather_unit eq 'i' ){ + elsif ($weather_unit eq 'i'){ $result = "from $direction at $mph $i_unit"; } if ($gust_mph){ - if ( $weather_unit eq 'mi' ){ + if ($weather_unit eq 'mi'){ $result .= ". Gusting to $ms $m_unit ($kmh $km_unit, $mph $i_unit)"; } - elsif ( $weather_unit eq 'im' ){ + elsif ($weather_unit eq 'im'){ $result .= ". Gusting to $mph $i_unit ($ms $m_unit, $kmh $km_unit)"; } - elsif ( $weather_unit eq 'm' ){ + elsif ($weather_unit eq 'm'){ $result .= ". Gusting to $ms $m_unit ($kmh $km_unit)"; } - elsif ( $weather_unit eq 'i' ){ + elsif ($weather_unit eq 'i'){ $result .= ". Gusting to $mph $i_unit"; } } @@ -18930,283 +28657,290 @@ sub process_wind { 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,%weather); + 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"; + @$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); + if (!$freshness || $freshness < ($now - 60)){ + $weather_data = download_weather($now,$file_cached,$location); } - #print join("\n", @weather_data), "\n"; + # print join("\n", @weather_data), "\n"; # NOTE: because temps can be 0, we can't do if value tests - foreach (@weather_data){ + 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]; + if ($working[0] eq 'api_source'){ + $weather->{'api-source'} = $working[1]; } - elsif ( $working[0] eq 'city' ){ - $weather{'city'} = $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 'cloud_cover'){ + $weather->{'cloud-cover'} = $working[1]; } - elsif ( $working[0] eq 'country' ){ - $weather{'country'} = $working[1]; + elsif ($working[0] eq 'country'){ + $weather->{'country'} = $working[1]; } - elsif ( $working[0] eq 'dewpoint_string' ){ - $weather{'dewpoint'} = $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;; + $weather->{'dewpoint-c'} = $2;; + $weather->{'dewpoint-f'} = $1;; } - elsif ( $working[0] eq 'dewpoint_c' ){ - $weather{'dewpoint-c'} = $working[1]; + elsif ($working[0] eq 'dewpoint_c'){ + $weather->{'dewpoint-c'} = $working[1]; } - elsif ( $working[0] eq 'dewpoint_f' ){ - $weather{'dewpoint-f'} = $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'){ + 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).*$//; + $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 'error'){ + $weather->{'error'} = $working[1]; } - elsif ( $working[0] eq 'forecast' ){ - $weather{'forecast'} = $working[1]; + elsif ($working[0] eq 'forecast'){ + $weather->{'forecast'} = $working[1]; } - elsif ( $working[0] eq 'heat_index_string' ){ - $weather{'heat-index'} = $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; + $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_c'){ + $weather->{'heat-index-c'} = $working[1]; } - elsif ( $working[0] eq 'heat_index_f' ){ - $weather{'heat-index-f'} = $working[1]; + elsif ($working[0] eq 'heat_index_f'){ + $weather->{'heat-index-f'} = $working[1]; } - elsif ( $working[0] eq 'relative_humidity' ){ + elsif ($working[0] eq 'relative_humidity'){ $working[1] =~ s/%$//; - $weather{'humidity'} = $working[1]; + $weather->{'humidity'} = $working[1]; } - elsif ( $working[0] eq 'local_time' ){ - $weather{'local-time'} = $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 'local_epoch'){ + $weather->{'local-epoch'} = $working[1]; } - elsif ( $working[0] eq 'moonphase' ){ - $weather{'moonphase'} = $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 '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_time_rfc822'){ + $weather->{'observation-time-rfc822'} = $working[1]; } - elsif ( $working[0] eq 'observation_epoch' ){ - $weather{'observation-epoch'} = $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 '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_mm'){ + $weather->{'precip-1h-mm'} = $working[1]; } - elsif ( $working[0] eq 'precip_in' ){ - $weather{'precip-1h-in'} = $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_string'){ + $weather->{'pressure'} = $working[1]; } - elsif ( $working[0] eq 'pressure_mb' ){ - $weather{'pressure-mb'} = $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 '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_mm'){ + $weather->{'rain-1h-mm'} = $working[1]; } - elsif ( $working[0] eq 'rain_1h_in' ){ - $weather{'rain-1h-in'} = $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_mm'){ + $weather->{'snow-1h-mm'} = $working[1]; } - elsif ( $working[0] eq 'snow_1h_in' ){ - $weather{'snow-1h-in'} = $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 'state_name'){ + $weather->{'state'} = $working[1]; } - elsif ( $working[0] eq 'sunrise' ){ + elsif ($working[0] eq 'sunrise'){ if ($working[1]){ if ($working[1] !~ /^[0-9]+$/){ - $weather{'sunrise'} = $working[1]; + $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]); + $weather->{'sunrise'} = POSIX::strftime "%T", localtime($working[1]); } } } - elsif ( $working[0] eq 'sunset' ){ + elsif ($working[0] eq 'sunset'){ if ($working[1]){ if ($working[1] !~ /^[0-9]+$/){ - $weather{'sunset'} = $working[1]; + $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]); + $weather->{'sunset'} = POSIX::strftime "%T", localtime($working[1]); } } } - elsif ( $working[0] eq 'temperature_string' ){ - $weather{'temp'} = $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}/; + $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_f'){ + $weather->{'temp-f'} = $working[1]; } - elsif ( $working[0] eq 'temp_c' ){ - $weather{'temp-c'} = $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 'timezone'){ + $weather->{'timezone'} = $working[1]; } - elsif ( $working[0] eq 'visibility' ){ - $weather{'visibility'} = $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_km'){ + $weather->{'visibility-km'} = $working[1]; } - elsif ( $working[0] eq 'visibility_mi' ){ - $weather{'visibility-mi'} = $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 'weather'){ + $weather->{'weather'} = $working[1]; } - elsif ( $working[0] eq 'wind_degrees' ){ - $weather{'wind-degrees'} = $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_dir'){ + $weather->{'wind-direction'} = $working[1]; } - elsif ( $working[0] eq 'wind_mph' ){ - $weather{'wind-mph'} = $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_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_gust_ms'){ + $weather->{'wind-gust-ms'} = $working[1]; } - elsif ( $working[0] eq 'wind_ms' ){ - $weather{'wind-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 'wind_string'){ + $weather->{'wind'} = $working[1]; } - elsif ( $working[0] eq 'windchill_string' ){ - $weather{'windchill'} = $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; + $weather->{'windchill-c'} = $2; + $weather->{'windchill-f'} = $1; } - elsif ( $working[0] eq 'windchill_c' ){ - $weather{'windchill-c'} = $working[1]; + elsif ($working[0] eq 'windchill_c'){ + $weather->{'windchill-c'} = $working[1]; } - elsif ( $working[0] eq 'windchill_f' ){ - $weather{'windchill_f'} = $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){ + 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'}; + 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; + $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; + 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; + $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; + 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; + return $weather; } + sub download_weather { eval $start if $b_log; my ($now,$file_cached,$location) = @_; - my (@weather,$temp,$ua,$url); + my ($temp,$ua,$url); + my $weather = []; $url = "https://smxi.org/opt/xr2.php?loc=$location->[0]&src=$weather_source"; $ua = 'weather'; -# { -# #my $file2 = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/weather-1.xml"; -# # my $file2 = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/feed-oslo-1.xml"; -# local $/; -# my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/weather-1.xml"; -# open(my $fh, '<', $file) or die "can't open $file: $!"; -# $temp = <$fh>; -# } - $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; -} -# resolve wide character issue, if detected, switch to iso + 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"; + # 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); @@ -19216,11 +28950,41 @@ sub test_locale_date { } } $date_time =~ s/\s+$//; - #print "2: $date_time\n"; + # 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"; @@ -19228,15 +28992,15 @@ sub get_location { @loc_data = main::reader($file_cached); $freshness = (split(/\^\^/, $loc_data[0]))[1]; } - if (!$freshness || $freshness < $now - 90) { + if (!$freshness || $freshness < $now - 90){ my $temp; my $url = "http://geoip.ubuntu.com/lookup"; -# { -# local $/; -# my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/location-1.xml"; -# open(my $fh, '<', $file) or die "can't open $file: $!"; -# $temp = <$fh>; -# } + # { + # 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 { @@ -19249,43 +29013,43 @@ sub get_location { @loc_data = split('\n', $loc_data[0]); unshift(@loc_data, "timestamp^^$now"); main::writer($file_cached,\@loc_data); - #print "$file_cached: download/cleaned\n"; + # print "$file_cached: download/cleaned\n"; } foreach (@loc_data){ my @working = split(/\s*\^\^\s*/, $_); - #print "$working[0]:$working[1]\n"; - if ($working[0] eq 'CountryCode3' ) { + # print "$working[0]:$working[1]\n"; + if ($working[0] eq 'CountryCode3'){ $loc{'country3'} = $working[1]; } - elsif ($working[0] eq 'CountryCode' ) { + elsif ($working[0] eq 'CountryCode'){ $loc{'country'} = $working[1]; } - elsif ($working[0] eq 'CountryName' ) { + elsif ($working[0] eq 'CountryName'){ $loc{'country2'} = $working[1]; } - elsif ($working[0] eq 'RegionCode' ) { + elsif ($working[0] eq 'RegionCode'){ $loc{'region-id'} = $working[1]; } - elsif ($working[0] eq 'RegionName' ) { + elsif ($working[0] eq 'RegionName'){ $loc{'region'} = $working[1]; } - elsif ($working[0] eq 'City' ) { + elsif ($working[0] eq 'City'){ $loc{'city'} = $working[1]; } - elsif ($working[0] eq 'ZipPostalCode' ) { + elsif ($working[0] eq 'ZipPostalCode'){ $loc{'zip'} = $working[1]; } - elsif ($working[0] eq 'Latitude' ) { + elsif ($working[0] eq 'Latitude'){ $loc{'lat'} = $working[1]; } - elsif ($working[0] eq 'Longitude' ) { + elsif ($working[0] eq 'Longitude'){ $loc{'long'} = $working[1]; } - elsif ($working[0] eq 'TimeZone' ) { + elsif ($working[0] eq 'TimeZone'){ $loc{'tz'} = $working[1]; } } - #print Data::Dumper::Dumper \%loc; + # print Data::Dumper::Dumper \%loc; # assign location, cascade from most accurate # latitude,longitude first if ($loc{'lat'} && $loc{'long'}){ @@ -19302,331 +29066,462 @@ sub get_location { $country = ($loc{'country3'}) ? $loc{'country3'} : $loc{'country'}; $city = ($loc{'city'}) ? $loc{'city'} : 'City N/A'; $state = ($loc{'region-id'}) ? $loc{'region-id'} : 'Region N/A'; - $loc_string = main::apply_filter("$city, $state, $country"); - my @location = ($loc_arg,$loc_string,$loc{'tz'}); - #print ($loc_arg,"\n", join("\n", @loc_data), "\n",scalar @loc_data, "\n"); + $loc_string = main::filter("$city, $state, $country"); + @$location = ($loc_arg,$loc_string,$loc{'tz'}); + # print ($loc_arg,"\n", join("\n", @loc_data), "\n",scalar @loc_data, "\n"); eval $end if $b_log; - return @location; } + sub complete_location { eval $start if $b_log; my ($location,$city,$state,$country) = @_; - if ($location && $location =~ /[0-9+-]/ && $city){ - $location = $country . ', ' . $location if $country && $location !~ m|$country|i; - $location = $state . ', ' . $location if $state && $location !~ m|$state|i; - $location = $city . ', ' . $location if $city && $location !~ m|$city|i; + if ($location->[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; - return $location; } } #### ------------------------------------------------------------------- -#### UTILITIES FOR DATA LINES +#### ITEM UTILITIES #### ------------------------------------------------------------------- -sub get_compiler_version { +# android only, for distro / OS id and machine data +sub set_build_prop { eval $start if $b_log; - my (@compiler); - if (my $file = system_files('version') ) { - @compiler = get_compiler_version_linux($file); - } - elsif ($bsd_type) { - @compiler = get_compiler_version_bsd(); + 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 @compiler; } -sub get_compiler_version_bsd { +# Return all detected compiler versions +# args: 0: compiler +sub get_compiler_data { eval $start if $b_log; - my (@compiler,@working); - if ($alerts{'sysctl'}->{'action'} && $alerts{'sysctl'}->{'action'} eq 'use'){ - # for dragonfly, we will use free mem, not used because free is 0 - my @working; - foreach (@sysctl){ - # freebsd seems to use bytes here - # 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] =~ /.*(gcc|clang)\sversion\s([\S]+)\s.*/; - @compiler = ($1,$2); - last; + 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; } } - log_data('dump','@compiler',\@compiler) if $b_log; + 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 @compiler; + return $compilers; } -sub get_compiler_version_linux { - eval $start if $b_log; - my ($file) = @_; - my (@compiler,$version); - my @data = reader($file); - my $result = $data[0] if @data; - if ($result){ - # $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)'; - if ($result =~ /(gcc|clang).*version\s([\S]+)/){ - $version = $2; - $version ||= 'N/A'; - @compiler = ($1,$version); - } - elsif ($result =~ /\((gcc|clang)[^\(]*\([^\)]+\)\s+([0-9\.]+)(\s[^.]*)?,\s*/){ - $version = $2; - $version ||= 'N/A'; - @compiler = ($1,$version); - } - } - log_data('dump','@compiler',\@compiler) if $b_log; - eval $end if $b_log; - return @compiler; -} - -## Get DesktopEnvironment -## returns array: -# 0 - desktop name -# 1 - version -# 2 - toolkit -# 3 - toolkit version -# 4 - info extra desktop data -# 5 - wm -# 6 - wm version -{ -package DesktopEnvironment; -my ($b_gtk,$b_qt,$b_xprop,$desktop_session,$gdmsession,$kde_session_version, -$xdg_desktop,@desktop,@data,@xprop); -sub get { +sub set_dboot_data { eval $start if $b_log; - set_desktop_values(); - main::set_ps_gui() if ! $b_ps_gui; - get_kde_trinity_data(); - if (!@desktop){ - get_env_de_data(); - } - if (!@desktop){ - get_env_xprop_gnome_based_data(); - } - if (!@desktop && $b_xprop ){ - get_env_xprop_non_gnome_based_data(); - } - if (!@desktop){ - get_ps_de_data(); + $loaded{'dboot'} = 1; + my ($file,@db_data,@dm_data,@temp); + my ($counter) = (0); + if (!$fake{'dboot'}){ + $file = $system_files{'dmesg-boot'}; } - if ($extra > 2 && @desktop){ - set_info_data(); + 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 ($b_display && !$b_force_display && $extra > 1){ - get_wm(); + 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: <NVMe, OWC Aura P12 1.0, ECFM> + # 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]; + } } - set_gtk_data() if $b_gtk && $extra > 1; - set_qt_data() if $b_qt && $extra > 1; - main::log_data('dump','@desktop', \@desktop) if $b_log; - # ($b_xprop,$kde_session_version,$xdg_desktop,@data,@xprop) = undef; eval $end if $b_log; - return @desktop; } -sub set_desktop_values { - # 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'} ) ? prep_desktop_value($ENV{'DESKTOP_SESSION'}) : ''; - $xdg_desktop = ( $ENV{'XDG_CURRENT_DESKTOP'} ) ? prep_desktop_value($ENV{'XDG_CURRENT_DESKTOP'}) : ''; - $kde_session_version = ($ENV{'KDE_SESSION_VERSION'}) ? $ENV{'KDE_SESSION_VERSION'} : ''; - # for fallback to fallback protections re false gnome id - $gdmsession = ( $ENV{'GDMSESSION'} ) ? prep_desktop_value($ENV{'GDMSESSION'}) : ''; -} -# 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 -sub prep_desktop_value { - $_[0] = lc(main::trimmer($_[0])); - $_[0] =~ s/\b(arch|debian|fedora|manjaro|mint|opensuse|ubuntu):?\s*//; - return $_[0]; -} -sub get_kde_trinity_data { + +## 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; - my ($program,@version_data,@version_data2); - my $kde_full_session = ($ENV{'KDE_FULL_SESSION'}) ? $ENV{'KDE_FULL_SESSION'} : ''; - if ($desktop_session eq 'trinity' || $xdg_desktop eq 'trinity' || (grep {/^tde/} @ps_gui) ){ - $desktop[0] = 'Trinity'; - if ($program = main::check_program('kdesktop')){ - @version_data = main::grabber("$program --version 2>/dev/null"); - $desktop[1] = main::awk(\@version_data,'^TDE:',2,'\s+') if @version_data; - } - if ($extra > 1 && @version_data){ - $desktop[2] = 'Qt'; - $desktop[3] = main::awk(\@version_data,'^Qt:',2,'\s+') if @version_data; - } - } - # 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 ( $xdg_desktop eq 'kde' || $kde_session_version ){ - if ($kde_session_version && $kde_session_version <= 4){ - @data = main::program_values("kded$kde_session_version"); - if (@data){ - $desktop[0] = $data[3]; - $desktop[1] = main::program_version("kded$kde_session_version",$data[0],$data[1],$data[2],$data[5],$data[6]); - # kded exists, so we can now get the qt data string as well - if ($desktop[1] && ($program = main::check_program("kded$kde_session_version")) ){ - @version_data = main::grabber("$program --version 2>/dev/null"); - } - } - $desktop[0] = 'KDE' if !$desktop[0]; - } + $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 { - # 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 - # Qt: 5.4.2 - # KDE Frameworks: 5.11.0 - # kf5-config: 1.0 - # for QT, and Frameworks if we use it - if (!@version_data && ($program = main::check_program("kf$kde_session_version-config") )){ - @version_data = main::grabber("$program --version 2>/dev/null"); - } - if (!@version_data && ($program = main::check_program("kded$kde_session_version"))){ - @version_data = main::grabber("$program --version 2>/dev/null"); - } - if ($program = main::check_program("plasmashell")){ - @version_data2 = main::grabber("$program --version 2>/dev/null"); - $desktop[1] = main::awk(\@version_data2,'^plasmashell',-1,'\s+'); - } - $desktop[0] = 'KDE Plasma'; - } - if (!$desktop[1]){ - $desktop[1] = ($kde_session_version) ? $kde_session_version: main::row_defaults('unknown-desktop-version'); - } - # print Data::Dumper::Dumper \@version_data; - if ($extra > 1){ - if (@version_data){ - $desktop[3] = main::awk(\@version_data,'^Qt:', 2,'\s+'); - } - # qmake can have variants, qt4-qmake, qt5-qmake, also qt5-default but not tested - if (!$desktop[3] && main::check_program("qmake")){ - # note: this program has issues, it may appear to be in /usr/bin, but it - # often fails to execute, so the below will have null output, but use as a - # fall back test anyway. - ($desktop[2],$desktop[3]) = main::program_data('qmake'); - } - $desktop[2] ||= 'Qt'; - } + tk_misc_data();} } - # KDE_FULL_SESSION property is only available since KDE 3.5.5. - elsif ($kde_full_session eq 'true'){ - @version_data = main::grabber("kded --version 2>/dev/null"); - $desktop[0] = 'KDE'; - $desktop[1] = main::awk(\@version_data,'^KDE:',2,'\s+') if @version_data; - if (!$desktop[1]){ - $desktop[1] = '3.5'; - } - if ($extra > 1 && @version_data){ - $desktop[2] = 'Qt'; - $desktop[3] = main::awk(\@version_data,'^Qt:',2,'\s+') if @version_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; } -sub get_env_de_data { + +## DE SPECIFIC IDS ## + +# ENLIGHTENMENT/MOKSHA # +sub de_enlightenment_based_data { eval $start if $b_log; - my ($program,@version_data); - if (!$desktop[0]){ - # 0: 1/0; 1: env var search; 2: data; 3: gtk tk; 4: qt tk; 5: ps_gui search - my @desktops =( - [1,'unity','unity',0,0], - [0,'budgie','budgie-desktop',0,0], - # debian package: lxde-core. - # NOTE: some distros fail to set XDG data for root - [1,'lxde','lxpanel',0,0,',^lxsession$'], - [1,'razor','razor-session',0,1,'^razor-session$'], - # BAD: lxqt-about opens dialogue, sigh. - # Checked, lxqt-panel does show same version as lxqt-about - [1,'lxqt','lxqt-panel',0,1,'^lxqt-session$'], - [0,'^(razor|lxqt)$','lxqt-variant',0,1,'^(razor-session|lxqt-session)$'], - # note, X-Cinnamon value strikes me as highly likely to change, so just - # search for the last part - [0,'cinnamon','cinnamon',1,0], - # these so far have no cli version data - [1,'deepin','deepin',0,1], # version comes from file read - [1,'pantheon','pantheon',0,0], - [1,'lumina','lumina-desktop',0,1], - [0,'manokwari','manokwari',1,0], - [1,'ukui','ukui-session',0,1], - ); - foreach my $item (@desktops){ - # Check if in xdg_desktop OR desktop_session OR if in $item->[6] 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_gui && (grep {/$item->[5]/} @ps_gui) ) ){ - ($desktop[0],$desktop[1]) = main::program_data($item->[2]); - $b_gtk = $item->[3]; - $b_qt = $item->[4]; - last; - } + # 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; } -sub get_env_xprop_gnome_based_data { + +# GNOME/CINNAMON/MATE # +sub de_gnome_based_data { eval $start if $b_log; - my ($program,$value,@version_data); - # NOTE: Always add to set_prop the search term if you add an item!! - set_xprop(); # 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' || - (main::check_program('muffin') || main::check_program('cinnamon-session') ) && - ($b_xprop && main::awk(\@xprop,'_muffin') )){ - ($desktop[0],$desktop[1]) = main::program_data('cinnamon','cinnamon',0); - $b_gtk = 1; - $desktop[0] ||= 'Cinnamon'; - } - elsif ($xdg_desktop eq 'mate' || $gdmsession eq 'mate' || - ( $b_xprop && main::awk(\@xprop,'_marco') )){ + 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) ) { - @data = main::program_data($key,$program,0); - $desktop[0] = $data[0]; - $versions{$key} = $data[1]; + 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'}); - # $b_gtk = 1; - $desktop[0] ||= 'MATE'; + $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]) = main::program_data('gnome-about'); + 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]) = main::program_data('gnome','gnome-shell'); + elsif (main::check_program('gnome-shell')){ + ($desktop->[0],$desktop->[1]) = ProgramData::full('gnome','gnome-shell'); } - $b_gtk = 1; - $desktop[0] ||= 'GNOME'; + $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 + +# 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 @@ -19639,7 +29534,7 @@ sub check_gnome { $b_gnome = 1; } # should work as long as string contains gnome, eg: peppermint:gnome - # filtered explicitly in set_desktop_values + # filtered explicitly in set_env_data elsif ($xdg_desktop && $xdg_desktop !~ /gnome/){ $detection = 'xdg_current_desktop'; } @@ -19662,100 +29557,262 @@ sub check_gnome { $b_gnome = 1; } # maybe use ^_gnome_session instead? try it for a while - elsif ($b_xprop && main::check_program('gnome-shell') && main::awk(\@xprop,'^_gnome_session')){ + 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; } -sub get_env_xprop_non_gnome_based_data { + +# 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'}}))){ + if ($program = main::check_program('kdesktop')){ + ($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,@version_data,$version); - #print join("\n", @xprop), "\n"; + 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 to xfce to solve some other - # issues so don't test for that. $xdg_desktop eq 'xfce' + # 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' || - (main::check_program('xfdesktop')) && main::awk(\@xprop,'^(xfdesktop|xfce)' )){ - # this is a very expensive test that doesn't usually result in a find - # talk to xfce to see what id they will be using for xfce 5 -# if (main::awk(\@xprop, 'xfce4')){ -# $version = '4'; -# } - if (main::awk(\@xprop, 'xfce5')){ - $version = '5'; - } - else { - $version = '4'; - } - @data = main::program_values('xfdesktop'); - $desktop[0] = $data[3]; - # xfdesktop --version out of x fails to get display, so no data - @version_data = main::grabber('xfdesktop --version 2>/dev/null'); - # out of x, this error goes to stderr, so it's an empty result - $desktop[1] = main::awk(\@version_data,$data[0],$data[1],'\s+'); - #$desktop[1] = main::program_version('xfdesktop',$data[0],$data[1],$data[2],$data[5],$data[6]); - if ( !$desktop[1] ){ - @data = main::program_values("xfce${version}-panel"); - # print Data::Dumper::Dumper \@data; + (($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 - $desktop[1] = main::program_version("xfce${version}-panel",$data[0],$data[1],$data[2],$data[5],$data[6]); # out of x this kicks out an error: xfce4-panel: Cannot open display - $desktop[1] = '' if $desktop[1] !~ /[0-9]\./; + ($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){ - @data = main::program_values('xfdesktop-toolkit'); - #$desktop[3] = main::program_version('xfdesktop',$data[0],$data[1],$data[2],$data[5],$data[6]); - $desktop[3] = main::awk(\@version_data,$data[0],$data[1],'\s+'); - $desktop[2] = $data[3]; + $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; } - elsif ( $xdg_desktop eq 'moksha' || $gdmsession eq 'moksha' || - (main::check_program('enlightenment') || main::check_program('moksha') ) && main::awk(\@xprop,'moksha') ){ - # no -v or --version but version is in xprop -root - # ENLIGHTENMENT_VERSION(STRING) = "Moksha 0.2.0.15989" - $desktop[0] = 'Moksha'; - $desktop[1] = main::awk(\@xprop,'(enlightenment|moksha)_version',2,'\s+=\s+' ); - $desktop[1] =~ s/"?(Moksha|Enlightenment)\s([^"]+)"?/$2/i if $desktop[1]; - } - elsif ( $xdg_desktop eq 'enlightenment' || $gdmsession eq 'enlightenment' || - (main::check_program('enlightenment') && main::awk(\@xprop,'enlightenment' ) ) ){ - # no -v or --version but version is in xprop -root - # ENLIGHTENMENT_VERSION(STRING) = "Enlightenment 0.16.999.49898" - $desktop[0] = 'Enlightenment'; - $desktop[1] = main::awk(\@xprop,'(enlightenment|moksha)_version',2,'\s+=\s+' ); - $desktop[1] =~ s/"?(Moksha|Enlightenment)\s([^"]+)"?/$2/i if $desktop[1]; - } - # 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. get_ps_de_data() and get_wm() will handle alternate wm detections. - if (!$desktop[0]){ - # 0 check program; 1 xprop search; 2: data; 3 - optional: ps_gui search + 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 =( - ['icewm','icewm','icewm'], - # debian package: i3-wm - ['i3','i3','i3'], - ['mwm','^_motif','mwm'], - # debian package name: wmaker - ['WindowMaker','^_?windowmaker','wmaker'], - ['wm2','^_wm2','wm2'], - ['herbstluftwm','herbstluftwm','herbstluftwm'], - ['fluxbox','blackbox_pid','fluxbox','^fluxbox$'], - ['blackbox','blackbox_pid','blackbox'], - ['openbox','openbox_pid','openbox'], - ['amiwm','amiwm','amiwm'], + [1,'unity','unity','',''], + [0,'budgie','budgie-desktop','','gtk'], + # 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){ - if (main::check_program($item->[0]) && main::awk(\@xprop,$item->[1]) && - (!$item->[4] || (@ps_gui && (grep {/$item->[4]/} @ps_gui ))) ){ - ($desktop[0],$desktop[1]) = main::program_data($item->[2]); + # 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; } } @@ -19763,690 +29820,2223 @@ sub get_env_xprop_non_gnome_based_data { # need to check starts line because it's so short eval $end if $b_log; } -sub get_ps_de_data { + +sub de_ps_data { eval $start if $b_log; - my ($program,@version_data); - main::set_ps_gui() if !$b_ps_gui; - if (@ps_gui){ - # 1 check program; 2 ps_gui search; 3 data; 4: trigger alternate values/version - my @desktops =( - ['9wm','9wm','9wm',''], - ['afterstep','afterstep','afterstep',''], - ['aewm++','aewm\+\+','aewm++',''], - ['aewm','aewm','aewm',''], - ['amiwm','amiwm','amiwm',''], - ['antiwm','antiwm','antiwm',''], - ['awesome','awesome','awesome',''], - ['blackbox','blackbox','blackbox',''], - ['bspwm','bspwm','bspwm',''], - ['cagebreak','cagebreak','cagebreak',''], - ['calmwm','calmwm','calmwm',''], - ['clfswm','.*(sh|c?lisp)?.*clfswm','clfswm',''], + 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',''], - ['dwm','dwm','dwm',''], - ['echinus','echinus','echinus',''], - ['evilwm','evilwm','evilwm',''], - ['fireplace','fireplace','fireplace',''], - ['fluxbox','fluxbox','fluxbox',''], - ['flwm','flwm','flwm',''], - ['flwm','flwm_topside','flwm',''], - ['fvwm-crystal','fvwm.*-crystal','fvwm-crystal','fvwm'], - ['fvwm1','fvwm1','fvwm1',''], - ['fvwm2','fvwm2','fvwm2',''], - ['fvwm3','fvwm3','fvwm3',''], - ['fvwm95','fvwm95','fvwm95',''], - ['fvwm','fvwm','fvwm',''], - ['glass','glass','glass',''], - ['hackedbox','hackedbox','hackedbox',''], - ['instantwm','instantwm','instantwm',''], - ['ion3','ion3','ion3',''], - ['jbwm','jbwm','jbwm',''], - ['jwm','jwm','jwm',''], - ['larswm','larswm','larswm',''], - ['lwm','lwm','lwm',''], - ['mini','mini','mini',''], - ['musca','musca','musca',''], - ['mvwm','mvwm','mvwm',''], - ['mwm','mwm','mwm',''], - ['nawm','nawm','nawm',''], - ['notion','notion','notion',''], - ['openbox','openbox','openbox',''], - ['orbital','orbital','orbital',''], - ['pekwm','pekwm','pekwm',''], - ['perceptia','perceptia','perceptia',''], - ['qtile','.*(python.*)?qtile','qtile',''], - ['qvwm','qvwm','qvwm',''], - ['ratpoison','ratpoison','ratpoison',''], - ['sawfish','sawfish','sawfish',''], - ['scrotwm','scrotwm','scrotwm',''], - ['spectrwm','spectrwm','spectrwm',''], - ['stumpwm','(sh|c?lisp)?.*stumpwm','stumpwm',''], - ['sway','sway','sway',''], - ['matchbox-window-manager','matchbox-window-manager','matchbox-window-manager',''], - ['tinywm','tinywm','tinywm',''], - ['tvtwm','tvtwm','tvtwm',''], - ['twm','twm','twm',''], - ['waycooler','waycooler','way-cooler',''], - ['way-cooler','way-cooler','way-cooler',''], - ['WindowMaker','WindowMaker','wmaker',''], - ['windowlab','windowlab','windowlab',''], - # not in debian apt, current is wmii, version 3 - ['wmii2','wmii2','wmii2',''], - ['wmii','wmii','wmii',''], - ['wmx','wmx','wmx',''], - ['xmonad','xmonad','xmonad',''], - ## fallback for xfce in case no xprop - ['xfdesktop','xfdesktop','xfdesktop',''], - ['yeahwm','yeahwm','yeahwm',''], + ['flwm','flwm(_topside)?','flwm',''], + ['fvwm-crystal','fvwm.*-crystal\S*','fvwm-crystal','fvwm'], + ['hyprland','[Hh]yprland','hyprctl',''], + ['xfdesktop','xfdesktop','xfdesktop','',['^Built with GTK',4,'Gtk']], ); - foreach my $item (@desktops){ + # 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 - if (grep {/^$item->[1]$/} @ps_gui){ - ($desktop[0],$desktop[1]) = main::program_data($item->[2],$item->[3]); - if ($extra > 1 && $item->[0] eq 'xfdesktop'){ - ($desktop[2],$desktop[3]) = main::program_data('xfdesktop-toolkit',$item->[0],1); - } + # 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 set_gtk_data { +sub tk_gtk_data { eval $start if $b_log; if (main::check_program('gtk-launch')){ - ($desktop[2],$desktop[3]) = main::program_data('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 tooltips 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; } -sub set_qt_data { + +# 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,@data,@version_data); + my $program; my $kde_version = $kde_session_version; - $program = ''; 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 = '';} + 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] && main::check_program('qmake')){ - ($desktop[2],$desktop[3]) = main::program_data('qmake'); + if (!$desktop->[3] && ($program = main::check_program('qmake'))){ + ($desktop->[2],$desktop->[3]) = ProgramData::full('qmake-qt',$program); } - if (!$desktop[3] && main::check_program('qtdiag')){ - ($desktop[2],$desktop[3]) = main::program_data('qtdiag'); + 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") )){ - @version_data = main::grabber("$program --version 2>/dev/null"); - $desktop[2] = 'Qt'; - $desktop[3] = main::awk(\@version_data,'^Qt:',2) if @version_data; + 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"))){ - @version_data = main::grabber("$program --version 2>/dev/null"); - $desktop[2] = 'Qt'; - $desktop[3] = main::awk(\@version_data,'^Qt:',2) if @version_data; + 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; } -sub get_wm { +## WM DATA ## +sub wm_data { eval $start if $b_log; - if (!$b_wmctrl) { - get_wm_main(); + 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 ( (!$desktop[5] || $b_wmctrl) && (my $program = main::check_program('wmctrl'))){ - get_wm_wmctrl($program); - } - eval $end if $b_log; -} -sub get_wm_main { - eval $start if $b_log; - my ($wms,$working); - # xprop is set only if not kde/gnome/cinnamon/mate/budgie/lx.. - if ($b_xprop){ - #KWIN_RUNNING - $wms = 'amiwm|blackbox|bspwm|compiz|kwin_wayland|kwin_x11|kwin|marco|'; - $wms .= 'motif|muffin|openbox|herbstluftwm|twin|ukwm|wm2|windowmaker|i3'; - foreach (@xprop){ - if (/($wms)/){ - $working = $1; - $working = 'wmaker' if $working eq 'windowmaker'; - last; - } + 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; } } - if (!$desktop[5]){ - main::set_ps_gui() if ! $b_ps_gui; - # order matters, see above logic - # due to lisp/python starters, clfswm/stumpwm/qtile will not detect here - $wms = '9wm|aewm\+\+|aewm|afterstep|amiwm|antiwm|awesome|blackbox|bspwm|budgie-wm|'; - $wms .= 'cagebreak|calmwm|clfswm|compiz|(openbsd-)?cwm|fluxbox|'; - $wms .= 'deepin-wm|dwm|echinus|evilwm|'; - $wms .= 'fireplace|flwm|fvwm-crystal|fvwm1|fvwm2|fvwm3|fvwm95|fvwm|'; - $wms .= 'gala|glass|gnome-shell|hackedbox|i3|instantwm|ion3|jbwm|jwm|'; - $wms .= 'twin|kwin_wayland|kwin_x11|kwin|larswm|lwm|'; - $wms .= 'matchbox-window-manager|marco|mini|muffin|'; - $wms .= 'musca|deepin-mutter|mutter|deepin-metacity|metacity|mvwm|mwm|'; - $wms .= 'nawm|notion|openbox|orbital|perceptia|qtile|qvwm|'; - $wms .= 'ratpoison|sawfish|scrotwm|spectrwm|'; - $wms .= 'stumpwm|sway|tinywm|tvtwm|twm|ukwm|'; - $wms .= 'way-?cooler|windowlab|WindowMaker|wm2|wmii2|wmii|wmx|'; - $wms .= 'xfwm4|xfwm5|xmonad|yeahwm'; - foreach (@ps_gui){ - if (/^($wms)$/){ - $working = $1; + # 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; } } } - get_wm_version('manual',$working) if $working; - $desktop[5] = $working if !$desktop[5] && $working; eval $end if $b_log; } -sub get_wm_wmctrl { + +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*'); - $desktop[5] = '' if $desktop[5] && $desktop[5] eq 'N/A'; - if ($desktop[5]){ + $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]); + $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'} - get_wm_version('wmctrl',$desktop[5]); + 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; } -sub get_wm_version { + +# args: 0: manual/wmctrl; 1: wm; 2: $b_wm ref +sub wm_version { eval $start if $b_log; - my ($type,$wm) = @_; + 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 - return if ! $wm || $wm =~ /^(budgie-wm|gnome-shell)$/ || ($desktop[0] && lc($desktop[0]) eq lc($wm) ); + 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 = main::program_data($temp,$temp,3); + 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]; + $desktop->[5] = $data[0] if $type eq 'manual'; + $desktop->[6] = $data[1] if $data[1]; } eval $end if $b_log; } -sub set_info_data { +## PARTS/TOOLS DATA ## +sub components_data { eval $start if $b_log; - main::set_ps_gui() if ! $b_ps_gui; - my (@data,@info,$item); - my $pattern = 'alltray|awn|bar|bmpanel|bmpanel2|budgie-panel|cairo-dock|'; - $pattern .= 'dde-dock|dmenu|dockbarx|docker|docky|dzen|dzen2|'; - $pattern .= 'fancybar|fbpanel|fspanel|glx-dock|gnome-panel|hpanel|i3bar|i3status|icewmtray|'; - $pattern .= 'kdocker|kicker|'; - $pattern .= 'latte|latte-dock|lemonbar|ltpanel|lxpanel|lxqt-panel|'; - $pattern .= 'matchbox-panel|mate-panel|ourico|'; - $pattern .= 'perlpanel|plank|plasma-desktop|plasma-netbook|polybar|pypanel|'; - $pattern .= 'razor-panel|razorqt-panel|stalonetray|swaybar|taskbar|tint2|trayer|'; - $pattern .= 'ukui-panel|vala-panel|wbar|wharf|wingpanel|witray|'; - $pattern .= 'xfce4-panel|xfce5-panel|xmobar|yabar'; - if (@data = grep {/^($pattern)$/} @ps_gui ) { - # only one entry per type, can be multiple - foreach $item (@data){ - if (! grep {$item =~ /$_/} @info){ - $item = main::trimmer($item); - $item =~ s/.*\///; - push(@info, (split(/\s+/, $item))[0]); + 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'); + } } - if (@info){ - main::uniq(\@info); - $desktop[4] = join(', ', @info); + 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')){ - @xprop = main::grabber("xprop -root $display_opt 2>/dev/null"); - if (@xprop){ - # add wm / de as required, but only add what is really tested for above + $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 - my $pattern = '^amiwm|blackbox_pid|bspwm|compiz|enlightenment|^_gnome|'; - $pattern .= 'herbstluftwm|^kwin_|^i3_|icewm|_marco|moksha|^_motif|_muffin|'; - $pattern .= 'openbox_pid|^_ukwm|^_?windowmaker|^_wm2|^(xfdesktop|xfce)'; - # let's only do these searches once - @xprop = grep {/^\S/ && /($pattern)/i} @xprop; - $_ = lc for @xprop; - $b_xprop = 1 if scalar @xprop > 0; + ['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:NethernetT<NULL>Callwinner,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:NaudioT<NULL>Cbrcm,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:NfbT<NULL>Cbrcm,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:NgpuT<NULL>Callwinner,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; } } - # print "@xprop\n"; 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_display_manager { +sub get { eval $start if $b_log; - my (@data,@found,$path,$working,$b_run,$b_vrun,$b_vrunrc); - # ldm - LTSP display manager. Note that sddm does not appear to have a .pid - # extension in Arch note: to avoid positives with directories, test for -f - # explicitly, not -e. Guessing on cdm.pid - my @dms = qw(cdm.pid entranced.pid gdm.pid gdm3.pid kdm.pid ldm.pid - lightdm.pid lxdm.pid mdm.pid nodm.pid pcdm.pid sddm.pid slim.lock - tdm.pid udm.pid wdm.pid xdm.pid xenodm.pid); - # these are the only one I know of so far that have version info - my @dms_version = qw(gdm gdm3 lightdm slim); - $b_run = 1 if -d "/run"; + 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$|^</){ + $working = main::translate_size($2); + # seen: for some reason, size/sectors did not result in clean integer value + $disks_bsd{$id}->{'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/; + # <Generic-, Compact Flash, 1.00> + 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 <SDHC SL32G 8.0 SN 27414E9E MFG 07/2014 by 3 SD> 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 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 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 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" ){ - my $rdlink = readlink('/var/run'); - $b_vrun = 1 if !$rdlink || ($rdlink && $rdlink ne '/run'); - $b_vrunrc = 1 if -d "/var/run/rc.d"; - } - foreach my $id (@dms){ - # note: $working will create a dir name out of the dm $id, then - # test if pid is in that note: sddm, in an effort to be unique and special, - # do not use a pid/lock file, but rather a random string inside a directory - # called /run/sddm/ so assuming the existence of the pid inside a directory named - # from the dm. Hopefully this change will not have negative results. - $working = $id; - $working =~ s/\.\S+$//; - # note: there were issues with duplicated dm's in inxi, checking @found corrects it - if ( ( ( $b_run && ( -f "/run/$id" || -d "/run/$working" ) ) || - ( $b_vrun && ( -f "/var/run/$id" || -d "/var/run/$working" ) ) || - ( $b_vrunrc && ( -f "/var/run/rc.d/$working" || -d "/var/run/rc.d/$id" ) ) ) && - ! grep {/$working/} @found ){ - if ($extra > 2 && awk( \@dms_version, $working) && ($path = check_program($working)) ){} - else {$path = $working;} - # print "$path $extra\n"; - @data = program_data($working,$path,3); - $working = $data[0]; - $working .= ' ' . $data[1] if $data[1]; - push(@found, $working); - } - } - if (!@found){ + 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 dlm gtkgreet qtgreet tuigreet wlgreet + else { + @dms = qw(elogind greetd 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_gui) { - @data = program_data('ly','ly',3); - $found[0] = $data[0]; - $found[0] .= ' ' . $data[1] if $data[1]; + 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_gui) { - $found[0] = 'startx'; + elsif (grep {/startx$/} @{$ps_data{'dm-active'}}){ + $found->{'dm'}[0] = ['startx']; } - elsif (grep {$_ eq 'xinit'} @ps_gui) { - $found[0] = 'xinit'; + elsif (grep {$_ eq 'xinit'} @{$ps_data{'dm-active'}}){ + $found->{'dm'}[0] = ['xinit']; } } - # might add this in, but the rate of new dm's makes it more likely it's an - # unknown dm, so we'll keep output to N/A - log_data('dump','display manager: @found',\@found) if $b_log; eval $end if $b_log; - return join(', ', @found) if @found; +} } -## Get DistroData +## DistroData { package DistroData; -my (@distro_data,@osr); +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_bsd_os(); + get_distro_bsd(); } else { - get_linux_distro(); + get_distro_linux(); } eval $end if $b_log; - return @distro_data; + return $distro; } -sub get_bsd_os { +## BSD ## +sub get_distro_bsd { eval $start if $b_log; - my ($distro) = (''); - if ($bsd_type eq 'darwin'){ - my $file = '/System/Library/CoreServices/SystemVersion.plist'; - if (-f $file){ - my @data = main::reader($file); - @data = grep {/(ProductName|ProductVersion)/} @data if @data; - @data = grep {/<string>/} @data if @data; - @data = map {s/<[\/]?string>//g; } @data if @data; - $distro = join(' ', @data); + # 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'); } } - # seen a case without osx file, or was it permissions? - # this covers all the other bsds anyway, no problem. - $distro = "$uname[0] $uname[2]" if !$distro; - @distro_data = ($distro,''); + 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 get_linux_distro { +sub system_base_bsd { eval $start if $b_log; - my ($distro,$distro_id,$distro_file,$system_base) = ('','','',''); - my ($b_issue,$b_osr,$b_use_issue,@working); + # 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 - slitaz-release solusos-release turbolinux-release zenwalk-version); - my $derived_s = join('|', @derived); - my @primary = qw(altlinux-release arch-release gentoo-release redhat-release slackware-version - SuSE-release); - my $primary_s = join('|', @primary); - my $exclude_s = 'debian_version|devuan_version|ubuntu_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); + 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_s = 'mandrake-release|mandriva-release|mandrakelinux-release|manjaro-release'; - my $os_release_good_s = 'altlinux-release|arch-release|pclinuxos-release|rpi-issue|SuSE-release'; - # 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 - my @distro_files = main::globber('/etc/*[-_]{[rR]elease,[vV]ersion,issue}*'); - push(@distro_files, '/etc/bodhibuilder.conf') if -r '/etc/bodhibuilder.conf'; - my $lsb_release = '/etc/lsb-release'; - my $b_lsb = 1 if -f $lsb_release; - my ($etc_issue,$issue,$lc_issue) = ('','/etc/issue',''); - $b_issue = 1 if -f $issue; - # note: OpenSuse Tumbleweed 2018-05 has made /etc/issue created by sym link to /run/issue + 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,'',0) if -r $issue; - $etc_issue = main::clean_characters($etc_issue); - my $os_release = '/etc/os-release'; - @osr = main::reader($os_release) if -r $os_release; + $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) - if ($etc_issue){ - $lc_issue = lc($etc_issue) if $etc_issue; - if ($lc_issue =~ /(antergos|grml|linux lite)/){ - $distro_id = $1; - $b_use_issue = 1; - } + $etc_issue = 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}*,issue}'); + push(@{$distro->{'files'}}, '/etc/bodhibuilder.conf') if -r '/etc/bodhibuilder.conf'; # legacy + @osr = main::reader($os_release) if -r $os_release; + if (-f '/etc/bodhi/info'){ + $lsb_release = '/etc/bodhi/info'; + $distro->{'file'} = $lsb_release; + $distro->{'issue-skip'} = 1; + push(@{$distro->{'files'}}, $lsb_release); + } + $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; + $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 && ( grep {/(manjaro|antergos|chakra|pclinuxos|zorin)/i} @osr ) ){ - $distro_file = $os_release; - } - $distro_id = 'armbian' if grep {/armbian/} @distro_files; - main::log_data('dump','@distro_files',\@distro_files) if $b_log; - main::log_data('data',"distro_file-1: $distro_file") if $b_log; - 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 + 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; - #$system_base = 'Arch Linux'; - } - my $distro_files_s = join('|', @distro_files); - @working = (@derived,@primary); - foreach my $file (@working){ - if ( "/etc/$file" =~ /($distro_files_s)$/){ - # 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 - # this is for only those distro's with self named release/version files + 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 - if (@osr && $file =~ /($os_release_good_s)$/){ - $distro_file = $os_release; + # 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; } - elsif ($b_lsb && $file =~ /$lsb_good_s/){ - $distro_file = $lsb_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"; + $distro->{'file'} = "/etc/$file"; } last; } } } } - main::log_data('data',"distro_file-2: $distro_file") if $b_log; + $distro->{'file-for-1'} = $distro->{'file'}; # first test for the legacy antiX distro id file - if ( -r '/etc/antiX'){ + if (-r '/etc/antiX'){ @working = main::reader('/etc/antiX'); - $distro = main::awk(\@working,'antix.*\.iso') if @working; - $distro = main::clean_characters($distro) if $distro; + $distro->{'name'} = main::awk(\@working,'antix.*\.iso') if @working; + $distro->{'name'} = 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 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 && $b_lsb && ($distro_file =~ /\/etc\/($lsb_good_s)$/ || $distro_file eq $lsb_release) ){ - $distro = get_lsb_release(); - } - elsif ($distro_file && $distro_file eq $os_release){ - $distro = get_os_release(); - $b_osr = 1; - } - # 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_s)$/){ - # new opensuse uses os-release, but older ones may have a similar syntax, so just use + 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 + 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 + # 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 = main::awk(\@working,'suse'); + @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 = main::awk(\@working,'^LIVECDLABEL',2,'\s*=\s*'); - $distro =~ s/"//g if $distro; + 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 = main::reader($distro_file,'',0); + $distro->{'name'} = main::reader($distro->{'file'},'',0); # only contains version number. Why? who knows. - if ($distro_file eq '/etc/q4os_version' && $distro !~ /q4os/i){ - $distro = "Q4OS $distro" ; + if ($distro->{'file'} eq '/etc/q4os_version' && $distro->{'name'} !~ /q4os/i){ + $distro->{'name'} = "Q4OS $distro->{'name'}" ; } + push(@{$distro->{'method'}},'default: distro file'); + } + if ($distro->{'name'}){ + $distro->{'name'} = main::clean_characters($distro->{'name'}); } - $distro = main::clean_characters($distro) if $distro; } - # otherwise try the default debian/ubuntu /etc/issue file - elsif ($b_issue){ - if ( !$distro_id && $etc_issue && $lc_issue =~ /(mint|lmde)/ ){ - $distro_id = $1; - $b_use_issue = 1; + # 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 (!$b_use_issue && @osr){ - $distro = get_os_release(); - $b_osr = 1; - } - elsif (!$b_use_issue && $b_lsb){ - $distro = get_lsb_release(); - } - elsif ($etc_issue) { - $distro = $etc_issue; - # 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 =~ /arch linux/i){ - $distro = 'Arch Linux'; + 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 { + $distro->{'name'} = $etc_issue; + push(@{$distro->{'method'}},'issue: source'); + # 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 + # 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 && length($distro) > 60 ){ - if (!$b_osr && @osr){ - $distro = get_os_release(); - $b_osr = 1; + 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 + # 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){ - if (!$b_osr && @osr){ - $distro = get_os_release(); - $b_osr = 1; + 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 ($b_lsb){ - $distro = get_lsb_release(); + elsif ($distro->{'lsb'}){ + $distro->{'name'} = get_lsb(); + push(@{$distro->{'method'}},'get_lsb(): final'); } } - # now some final null tries - if (!$distro ){ - # if the file was null but present, which can happen in some cases, then use + # 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 = $distro_file; - } - } - if ($extra > 0){ - my $base_arch_distro = 'anarchy|antergos|archbang|archlabs|archman|archstrike|arco|artix'; - # note: arch linux derived distro page claims kaos as arch derived but it is NOT - $base_arch_distro .= '|blackarch|bluestar|chakra|ctios|endeavour|hyperbola|linhes'; - $base_arch_distro .= '|manjaor|mysys2|netrunner\s?rolling|ninja|obarun|parabola'; - $base_arch_distro .= '|puppyrus-?a|reborn|snal|talkingarch|ubos'; - my $base_debian_version_distro = 'sidux'; - my $base_debian_version_osr = '\belive|lmde|neptune|parrot|pureos|rescatux|septor|sparky|tails'; - my $base_default = 'antix-version|mx-version'; # osr has base ids - my $base_issue = 'bunsen'; # base only found in issue - my $base_manual = 'blankon|deepin|kali'; # synthesize, no direct data available - my $base_osr = 'aptosid|grml|q4os|siduction|bodhi'; # osr base, distro id in list of distro files - my $base_osr_issue = 'grml|linux lite'; # osr base, distro id in issue - # osr has distro name but has ubuntu ID_LIKE/UBUNTU_CODENAME - my $base_osr_ubuntu = 'mint|neon|nitrux|pop!_os|zorin'; - my $base_upstream_lsb = '/etc/upstream-release/lsb-release'; - my $base_upstream_osr = '/etc/upstream-release/os-release'; - # 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); - if ( @osr_working){ - my (@osr_temp); - @osr_temp = @osr; - @osr = @osr_working; - $system_base = get_os_release(); - @osr = @osr_temp if !$system_base; - (@osr_temp,@osr_working) = (undef,undef); - } - } - elsif ( -r $base_upstream_lsb){ - $system_base = get_lsb_release($base_upstream_lsb); - } - if (!$system_base && @osr){ - my ($base_type) = (''); - if ($etc_issue && (grep {/($base_issue)/i} @osr)){ - $system_base = $etc_issue; - } - # more tests added here for other ubuntu derived distros - elsif ( @distro_files && (grep {/($base_default)/} @distro_files) ){ - $base_type = 'default'; - } - # must go before base_osr_ubuntu test - elsif ( grep {/($base_debian_version_osr)/i} @osr ){ - $system_base = debian_id(); - } - elsif ( grep {/($base_osr_ubuntu)/i} @osr ){ - $base_type = 'ubuntu'; - } - elsif ( ( ($distro_id && $distro_id =~ /($base_osr_issue)/ ) || - (@distro_files && (grep {/($base_osr)/} @distro_files) ) ) && - !(grep {/($base_osr)/i} @osr)){ - $system_base = get_os_release(); - } - if (!$system_base && $base_type){ - $system_base = get_os_release($base_type); - } - } - if (!$system_base && @distro_files && ( grep {/($base_debian_version_distro)/i} @distro_files ) ){ - $system_base = debian_id(); - } - if (!$system_base && $lc_issue && $lc_issue =~ /($base_manual)/){ - my $id = $1; - my %manual = ( - 'blankon' => 'Debian unstable', - 'deepin' => 'Debian unstable', - 'kali' => 'Debian testing', - ); - $system_base = $manual{$id}; - } - if (!$system_base && $distro && $distro =~ /^($base_arch_distro)/i){ - $system_base = 'Arch Linux'; + 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'); } - if ($distro && -d '/etc/salixtools/' && $distro =~ /Slackware/i){ - $system_base = $distro; + # 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()'); + } } - } - if ($distro){ - if ($distro_id eq 'armbian'){ - $distro =~ s/Debian/Armbian/; + elsif (-d '/etc/salixtools/' && $distro->{'name'} =~ /Slackware/i){ + $distro->{'name'} =~ s/Slackware/Salix/; + push(@{$distro->{'method'}},'manual: name swap'); } - elsif (-d '/etc/salixtools/' && $distro =~ /Slackware/i){ - $distro =~ s/Slackware/Salix/; + 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 - if ($b_android) { - main::set_build_prop() if !$b_build_prop;; - $distro = 'Android'; - $distro .= ' ' . $build_prop{'build-version'} if $build_prop{'build-version'}; - $distro .= ' ' . $build_prop{'build-date'} if $build_prop{'build-date'}; - if (!$show{'machine'}){ - if ($build_prop{'product-manufacturer'} && $build_prop{'product-model'}){ - $distro .= ' (' . $build_prop{'product-manufacturer'} . ' ' . $build_prop{'product-model'} . ')'; - } - elsif ($build_prop{'product-device'}){ - $distro .= ' (' . $build_prop{'product-device'} . ')'; - } - elsif ($build_prop{'product-name'}){ - $distro .= ' (' . $build_prop{'product-name'} . ')'; - } + 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|lmde|neptune|nitrux|parrot|pureos|'; + $base_osr_debian_version .= 'rescatux|septor|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 = 'blankon|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', + '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); + $distro->{'base'} = main::clean_characters($distro->{'base'}) if $distro->{'base'}; + push(@{$distro->{'base-method'}},"base_version: file: $key"); + last; } } } - ## finally, if all else has failed, give up - $distro ||= 'unknown'; - @distro_data = ($distro,$system_base); + 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; } -sub get_lsb_release { +## 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 ($distro,$id,$release,$codename,$description) = ('','','','',''); + 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; @@ -20454,45 +32044,53 @@ sub get_lsb_release { next if /^\s*$/; my @working = split(/\s*=\s*/, $_); next if !$working[0]; - if ($working[0] eq 'DISTRIB_ID' && $working[1]){ + 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'; -# } + # elsif ($working[1] =~ /^Arch$/i){ + # $id = 'Arch Linux'; + # } else { $id = $working[1]; } } - elsif ($working[0] eq 'DISTRIB_RELEASE' && $working[1]){ + elsif ($working[0] eq $dist_release && $working[1]){ $release = $working[1]; } - elsif ($working[0] eq 'DISTRIB_CODENAME' && $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 'DISTRIB_DESCRIPTION' && $working[1]){ + elsif ($working[0] eq $dist_desc && $working[1]){ $description = $working[1]; } } if (!$id && !$release && !$codename && $description){ - $distro = $description; + $dist_lsb = $description; } else { - $distro = "$id $release $codename"; - $distro =~ s/^\s+|\s\s+|\s+$//g; # get rid of double and trailing spaces + # 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 $distro; + return $dist_lsb; } -sub get_os_release { + +sub get_osr { eval $start if $b_log; my ($base_type) = @_; - my ($base_id,$base_name,$base_version,$distro,$distro_name,$pretty_name, - $lc_name,$name,$version_name,$version_id) = ('','','','','','','','','',''); + 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; @@ -20501,11 +32099,14 @@ sub get_os_release { my @working = split(/\s*=\s*/, $_); next if !$working[0]; if ($working[0] eq 'PRETTY_NAME' && $working[1]){ - $pretty_name = $working[1]; + $name_pretty = $working[1]; } elsif ($working[0] eq 'NAME' && $working[1]){ $name = $working[1]; - $lc_name = lc($name); + $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]; @@ -20515,14 +32116,28 @@ sub get_os_release { $version_id = $working[1]; } # for mint/zorin, other ubuntu base system base - if ($base_type ){ + if ($base_type){ if ($working[0] eq 'ID_LIKE' && $working[1]){ if ($base_type eq 'ubuntu'){ - # popos shows debian + # feren,popos shows debian, feren ID ubuntu $working[1] =~ s/^(debian|ubuntu\sdebian|debian\subuntu)/ubuntu/; - $working[1] = 'ubuntu' if $working[1] eq 'debian'; + $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]); } - $base_name = ucfirst($working[1]); } elsif ($base_type eq 'ubuntu' && $working[0] eq 'UBUNTU_CODENAME' && $working[1]){ $base_version = ucfirst($working[1]); @@ -20536,93 +32151,202 @@ sub get_os_release { # 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 ($name && $version_name){ - $distro = $name; - $distro = 'Arco Linux' if $lc_name =~ /^arco/; + 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/){ - $distro .= ' ' . $version_id; + $dist_osr .= ' ' . $version_id; } - $distro .= " $version_name"; + $dist_osr .= " $version_name"; } - elsif ($pretty_name && ($pretty_name !~ /tumbleweed/i && $lc_name ne 'arcolinux') ){ - $distro = $pretty_name; + elsif ($name_pretty && ($name_pretty !~ /tumbleweed/i && $name_lc ne 'arcolinux')){ + $dist_osr = $name_pretty; } elsif ($name){ - $distro = $name; + $dist_osr = $name; if ($version_id){ - $distro .= ' ' . $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 { - # mint 17 used ubuntu os-release, so won't have $base_version - if ($base_name && $base_version){ + # 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; - $distro = "$base_name $base_id$base_version"; + $dist_osr = "$base_name $base_id$base_version"; } - elsif ($base_type eq 'default' && ($pretty_name || ($name && $version_name) ) ){ - $distro = ($name && $version_name) ? "$name $version_name" : $pretty_name; + 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' && $lc_name =~ /^(debian|ubuntu)/ && ($pretty_name || ($name && $version_name))){ - $distro = ($name && $version_name) ? "$name $version_name": $pretty_name; - } - elsif ( $base_type eq 'debian' && $base_version ){ - $distro = debian_id($base_version); + 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 $distro; + return $name; } -# arg: 1 - optional: debian codename + +# args: 0: $type [debian|devuan]; 1: optional: debian codename sub debian_id { eval $start if $b_log; - my ($codename) = @_; - my ($debian_version,$id); - $debian_version = main::reader('/etc/debian_version','strip',0) if -r '/etc/debian_version'; - $id = 'Debian'; - return if !$debian_version && !$codename; - # note, 3.0, woody, 3.1, sarge, but after it's integer per version - my %debians = ( - '4' => 'etch', - '5' => 'lenny', - '6' => 'squeeze', - '7' => 'wheezy', - '8' => 'jessie', - '9' => 'stretch', - '10' => 'buster', - '11' => 'bullseye', - '12' => 'bookworm', - '13' => 'trixie', - ); - if (main::is_numeric($debian_version)){ - $id .= " $debian_version $debians{int($debian_version)}"; + 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 + ); } - elsif ($codename) { - my %by_value = reverse %debians; - my $version = (main::is_numeric($debian_version)) ? "$debian_version $codename": $debian_version; - $id .= " $version"; + # 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; + } } - # like buster/sid - elsif ($debian_version) { - $id .= " $debian_version"; + 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 derived names, no need to go -# all the way back here, update as new names are known. This is because +# 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', @@ -20642,90 +32366,204 @@ sub ubuntu_id { '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; +} } -# return all device modules not including driver + +# 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; + return if !$modules; my @mods = split(/,\s+/, $modules); if ($driver){ @mods = grep {!/^$driver$/} @mods; - $modules = join(',', @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; } -# 1: driver; 2: 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_gcc_data { + +## GlabelData: public methods: set(), get() +# Used only to get RAID ZFS gptid path standard name, like ada0p1 +{ +package GlabelData; + +# gptid/c5e940f1-5ce2-11e6-9eeb-d05099ac4dc2 N/A ada0p1 +sub get { eval $start if $b_log; - my ($gcc,@data,@gccs,@temp); - # NOTE: We can't use program_version because we don't yet know where - # the version number is - if (my $program = check_program('gcc') ){ - @data = grabber("$program --version 2>/dev/null"); - $gcc = awk(\@data,'^gcc'); - } - if ($gcc){ - # strip out: gcc (Debian 6.3.0-18) 6.3.0 20170516 - # gcc (GCC) 4.2.2 20070831 prerelease [FreeBSD] - $gcc =~ s/\([^\)]*\)//g; - $gcc = get_piece($gcc,2); - } - if ($extra > 1){ - # glob /usr/bin for gccs, strip out all non numeric values - @temp = globber('/usr/bin/gcc-*'); - foreach (@temp){ - if (/\/gcc-([0-9.]+)$/){ - push(@gccs, $1); - } + my ($gptid) = @_; + 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; } } - unshift(@gccs, $gcc); - log_data('dump','@gccs',\@gccs) if $b_log; + $dev_id ||= $gptid; # no match? return full string eval $end if $b_log; - return @gccs; + return $dev_id; } -# rasberry pi only -sub get_gpu_ram_arm { +sub set { eval $start if $b_log; - my ($gpu_ram) = (0); - if (my $program = check_program('vcgencmd')){ - # gpu=128M - # "VCHI initialization failed" - you need to add video group to your user - my $working = (grabber("$program get_mem gpu 2>/dev/null"))[0]; - $working = (split(/\s*=\s*/, $working))[1] if $working; - $gpu_ram = translate_size($working) if $working; + $loaded{'glabel'} = 1; + if (my $path = main::check_program('glabel')){ + @glabel = main::grabber("$path status 2>/dev/null"); } - log_data('data',"gpu ram: $gpu_ram") if $b_log; + main::log_data('dump','@glabel:with Headers',\@glabel) if $b_log; + # get rid of first header line + shift @glabel; eval $end if $b_log; - return $gpu_ram; } - -# standard systems -sub get_gpu_ram { - eval $start if $b_log; - my ($gpu_ram) = (0); - eval $end if $b_log; - return $gpu_ram; } sub get_hostname { eval $start if $b_log; my $hostname = ''; - if ( $ENV{'HOSTNAME'} ){ + if ($ENV{'HOSTNAME'}){ $hostname = $ENV{'HOSTNAME'}; } - elsif ( !$bsd_type && -r "/proc/sys/kernel/hostname" ){ + elsif (!$bsd_type && -r "/proc/sys/kernel/hostname"){ $hostname = reader('/proc/sys/kernel/hostname','',0); } # puppy removed this from core modules, sigh @@ -20734,7 +32572,7 @@ sub get_hostname { Sys::Hostname->import; $hostname = Sys::Hostname::hostname(); } - elsif (my $program = check_program('hostname')) { + elsif (my $program = check_program('hostname')){ $hostname = (grabber("$program 2>/dev/null"))[0]; } $hostname ||= 'N/A'; @@ -20742,258 +32580,1150 @@ sub get_hostname { return $hostname; } -sub get_init_data { +## InitData +{ +package InitData; +my ($init,$init_version,$program) = ('','',''); + +sub get { eval $start if $b_log; - my $runlevel = get_runlevel_data(); + my $runlevel = get_runlevel(); my $default = ($extra > 1) ? get_runlevel_default() : ''; - my ($init,$init_version,$rc,$rc_version,$program) = ('','','','',''); - my $comm = ( -r '/proc/1/comm' ) ? reader('/proc/1/comm','',0) : ''; - my (@data); + 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. - if ( $comm ){ - if ( $comm =~ /systemd/ ){ - $init = 'systemd'; - if ( $program = check_program('systemd')){ - $init_version = program_version($program,'^systemd','2','--version'); - } - if (!$init_version && ($program = check_program('systemctl') ) ){ - $init_version = program_version($program,'^systemd','2','--version'); - } + # 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 } - # epoch version == Epoch Init System 1.0.1 "Sage" elsif ($comm =~ /epoch/){ - $init = 'Epoch'; - $init_version = program_version('epoch', '^Epoch', '4','version'); + ($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 datas + # 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){ - # output: /sbin/init --version: init (upstart 1.1) - # init (upstart 0.6.3) - # openwrt /sbin/init hangs on --version command, I think - if ((!$b_mips && !$b_sparc && !$b_arm) && ($init_version = program_version('init', 'upstart', '3','--version') )){ + # 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'; } - elsif (check_program('launchctl')){ + # surely more positive way to detect active + elsif (main::check_program('launchctl')){ $init = 'launchd'; } - elsif ( -f '/etc/inittab' ){ + # could be nosh or runit as well for BSDs, not handled yet + elsif (-f '/etc/inittab'){ $init = 'SysVinit'; - if (check_program('strings')){ - @data = grabber('strings /sbin/init'); - $init_version = awk(\@data,'^version\s+[0-9]',2); + 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' ){ + elsif (-f '/etc/ttys'){ $init = 'init (BSD)'; } } - if ( grep { /openrc/ } globber('/run/*openrc*') ){ - $rc = 'OpenRC'; - # /sbin/openrc --version == openrc (OpenRC) 0.13 - if ($program = check_program('openrc')){ - $rc_version = program_version($program, '^openrc', '3','--version'); + if ((grep { /openrc/ } main::globber('/run/*openrc*')) || (grep {/openrc/} @ps_cmd)){ + if (!$init || $init ne 'OpenRC'){ + ($rc,$rc_version) = openrc_data(); } - # /sbin/rc --version == rc (OpenRC) 0.11.8 (Gentoo Linux) - elsif ($program = check_program('rc')){ - $rc_version = program_version($program, '^rc', '3','--version'); + if (-r '/run/openrc/softlevel'){ + $runlevel = main::reader('/run/openrc/softlevel','',0); } - if ( -r '/run/openrc/softlevel' ){ - $runlevel = reader('/run/openrc/softlevel','',0); + elsif (-r '/var/run/openrc/softlevel'){ + $runlevel = main::reader('/var/run/openrc/softlevel','',0); } - elsif ( -r '/var/run/openrc/softlevel'){ - $runlevel = reader('/var/run/openrc/softlevel','',0); - } - elsif ( $program = check_program('rc-status')){ - $runlevel = (grabber("$program -r 2>/dev/null"))[0]; + elsif ($program = main::check_program('rc-status')){ + $runlevel = (main::grabber("$program -r 2>/dev/null"))[0]; } } - my %init = ( + 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 %init; + return @result; } -sub get_kernel_data { +# Check? /var/run/nologin for bsds? +sub get_runlevel { eval $start if $b_log; - my ($kernel,$ksplice) = ('',''); - # 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 = $uname[2]; - if ( (my $program = check_program('uptrack-uname')) && $kernel){ - $ksplice = qx($program -rm); - $ksplice = trimmer($ksplice); - $kernel = ($ksplice) ? $ksplice . ' (ksplice)' : $kernel; + 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,':'); } - $kernel .= ' ' . $uname[-1]; - $kernel = ($bsd_type) ? $uname[0] . ' ' . $kernel : $kernel; } - $kernel ||= 'N/A'; - log_data('data',"kernel: $kernel ksplice: $ksplice") if $b_log; - log_data('dump','perl @uname', \@uname) if $b_log; eval $end if $b_log; - return $kernel; + 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 @data = main::grabber($alerts{'ip'}->{'path'} . " addr 2>/dev/null",'\n','strip'); + 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 $!; + } + my ($b_skip,$broadcast,$if,$if_id,$ip,@ips,$scope,$type,@temp,@temp2); + 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; + # whitespace matters!! Don't use strip + my @data = main::grabber($alerts{'ifconfig'}->{'path'} . " 2>/dev/null",'\n',''); + 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 $!; + } + my ($b_skip,$broadcast,$if,@ips_bsd,$ip,@ips,$scope,$if_id,$type,@temp,@temp2); + my ($state,$speed,$duplex,$mac); + 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 <full-duplex> + # Freebsd 8.2/12.2: media: Ethernet autoselect (1000baseT <full-duplex>) + # 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')){ - $bits = (grabber("$program LONG_BIT 2>/dev/null"))[0]; + # 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 && @uname){ - $bits = $uname[-1]; - $bits = ($bits =~ /64/ ) ? 64 : 32; + if (!$bits && $bits_sys){ + $bits = $bits_sys; } $bits ||= 'N/A'; eval $end if $b_log; return $bits; } -sub get_kernel_parameters { +# 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('cmdline') ) { - $parameters = get_kernel_parameters_linux($file); + if (my $file = $system_files{'proc-cmdline'}){ + $parameters = parameters_linux($file); } - elsif ($bsd_type) { - $parameters = get_kernel_parameters_bsd(); + elsif ($bsd_type){ + $parameters = parameters_bsd(); } eval $end if $b_log; return $parameters; } -sub get_kernel_parameters_linux { + +sub parameters_linux { eval $start if $b_log; my ($file) = @_; # unrooted android may have file only root readable - my $line = reader($file,'',0) if -r $file; + my $line = main::reader($file,'',0) if -r $file; + $line =~ s/\s\s+/ /g; eval $end if $b_log; return $line; } -sub get_kernel_parameters_bsd { + +sub parameters_bsd { eval $start if $b_log; my ($parameters); eval $end if $b_log; return $parameters; } +} -# 1 - partition name -sub get_lsblk { +## 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 (%device); + my $result; foreach my $device (@lsblk){ if ($device->{'name'} eq $item){ - %device = %$device; + $result = $device; last; } } eval $start if $b_log; - return %device; + return ($result) ? $result : {}; } -sub get_memory_data_full { +sub set { eval $start if $b_log; - my ($source) = @_; - my $num = 0; - my ($memory,@rows); - my ($gpu_ram,$percent,$total,$used) = (0,'','',''); - if ($show{'ram'} || (!$show{'info'} && $show{'process'} )){ - $memory = get_memory_data('splits'); - if ($memory){ - my @temp = split(':', $memory); - $gpu_ram = $temp[3] if $temp[3]; - $total = ($temp[0]) ? get_size($temp[0],'string') : 'N/A'; - $used = ($temp[1]) ? get_size($temp[1],'string') : 'N/A'; - $used .= " ($temp[2]%)" if $temp[2]; - if ($gpu_ram){ - $gpu_ram = get_size($gpu_ram,'string'); + $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; + } + } } } - my $key = ($source eq 'process') ? 'System RAM': 'RAM'; - $rows[0]->{main::key($num++,1,1,$key)} = ''; - $rows[0]->{main::key($num++,0,2,'total')} = $total; - $rows[0]->{main::key($num++,0,2,'used')} = $used; - $rows[0]->{main::key($num++,0,2,'gpu')} = $gpu_ram if $gpu_ram; - $b_mem = 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; - return @rows; } -sub get_memory_data { +## MemoryData +{ +package MemoryData; + +sub get { eval $start if $b_log; my ($type) = @_; + $loaded{'memory'} = 1; my ($memory); - if (my $file = system_files('meminfo') ) { - $memory = get_memory_data_linux($type,$file); + # 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 = get_memory_data_bsd($type); + $memory = bsd_data($type); } eval $end if $b_log; return $memory; } -sub get_memory_data_linux { +# $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,$gpu,$memory,$not_used,$total) = (0,0,'',0,0); - my @data = reader($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 = get_piece($_,2); + $total_avail = main::get_piece($_,2); + } + elsif ($_ =~ /^MemFree:/){ + $free = main::get_piece($_,2); + } + elsif ($_ =~ /^Buffers:/){ + $buffers = main::get_piece($_,2); } - elsif ($_ =~ /^(MemFree|Buffers|Cached):/){ - $not_used += get_piece($_,2); + elsif ($_ =~ /^Cached:/){ + $cached = main::get_piece($_,2); } elsif ($_ =~ /^MemAvailable:/){ - $available = get_piece($_,2); + $available = main::get_piece($_,2); } } - $not_used = $available if $available; - $gpu = get_gpu_ram_arm() if $b_arm; - #$gpu = translate_size('128M'); - $total += $gpu; - my $used = $total - ($not_used); - my $percent = ($used && $total) ? sprintf("%.1f", ($used/$total)*100) : ''; - if ($type eq 'string'){ - $percent = " ($percent%)" if $percent; - $memory = sprintf("%.1f/%.1f MiB", $used/1024, $total/1024) . $percent; + $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 { - $memory = "$total:$used:$percent:$gpu"; + # raw return in KiB + $memory = [$total_avail,$used,$percent,$gpu,$sys_memory,$iomem]; } - log_data('data',"memory: $memory") if $b_log; + # 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, sigh... +## 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 @@ -21001,110 +33731,149 @@ sub get_memory_data_linux { # 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 +## 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 .... -sub get_memory_data_bsd { +## dragonfly: V2, no avm, no -H support +sub bsd_data { eval $start if $b_log; my ($type) = @_; - my $memory = ''; - my ($avm,$av_pages,$cnt,$fre,$free_mem,$real_mem,$total) = (3,0,0,4,0,0,0); - my (@data,$message); - my $arg = ($bsd_type ne 'openbsd') ? '-H' : ''; - if (my $program = 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 - my @vmstat = grabber("vmstat $arg 2>/dev/null",'\n','strip'); + 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){ + foreach (@header){ if ($_ eq 'avm'){$avm = $cnt} elsif ($_ eq 'fre'){$fre = $cnt} elsif ($_ eq 'flt'){last;} $cnt++; } my $row = $vmstat[-1]; - if ( $row ){ + if ($row){ @data = split(/\s+/, $row); - # 6.3 introduced an M character, sigh. - if ($data[$avm] && $data[$avm] =~ /^([0-9]+)M$/){ - $data[$avm] = $1 * 1024; + # 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 ($data[$fre] && $data[$fre] =~ /^([0-9]+)M$/){ - $data[$fre] = $1 * 1024; + if ($fre > 0 && $data[$fre] && $data[$fre] =~ /^([0-9\.]+[KGMT])(iB|B)?$/){ + $data[$fre] = main::translate_size($1); } - # dragonfly can have 0 avg, but they may fix that so make test dynamic - if ($data[$avm] != 0){ - $av_pages = ($bsd_type ne 'openbsd') ? sprintf('%.1f',$data[$avm]/1024) : $data[$avm]; + # 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]; } - elsif ($data[$fre] != 0){ + if ($fre > 0 && $data[$fre] != 0){ $free_mem = sprintf('%.1f',$data[$fre]); } } } - ## code to get total goes here: + # 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 + # For dragonfly, we will use free mem, not used because free is 0 my @working; - foreach (@sysctl){ - # 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; + 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 + # 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 + # 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 'string'){ - $used = sprintf("%.1f",$used/1024); - $memory = "$used/($error) MB"; + if ($type eq 'short'){ + $memory = short_data($error,$used); } else { - $memory = "$error:$used:"; + $memory = [$error,$used,undef]; } } - # use openbsd/dragonfly avail mem data if available - elsif (($av_pages || $free_mem) && $real_mem) { + # 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 'string'){ - $used = sprintf("%.1f",$used/1024); - $real_mem = sprintf("%.1f",$real_mem/1024); - $percent = " ($percent)" if $percent; - $memory = "$used/$real_mem MB" . $percent; + if ($type eq 'short'){ + $memory = short_data($real_mem,$used,$percent); } else { - $memory = "$real_mem:$used:$percent:0"; + $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; + return if !$module; my ($version); my $path = "/sys/module/$module/version"; if (-r $path){ @@ -21113,8 +33882,8 @@ sub get_module_version { elsif (-f "/sys/module/$module/uevent"){ $version = 'kernel'; } - #print "version:$version\n"; - if (!$version) { + # 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; @@ -21124,57 +33893,82 @@ sub get_module_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. -## Get PackageData { package PackageData; -my ($count,%counts,@list,$num,%output,$program,$type); -$counts{'total'} = 0; +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) = @_; + ($type,$num) = @_; + $loaded{'package-data'} = 1; + my $output = {}; package_counts(); appimage_counts(); - create_output(); + create_output($output); eval $end if $b_log; - return %output; + return $output; } + sub create_output { eval $start if $b_log; - my $total; - if ($counts{'total'}){ - $total = $counts{'total'}; + my $output = $_[0]; + my $total = ''; + if ($pms{'total'}){ + $total = $pms{'total'}; } else { - if ($type eq 'inner'){$total = 'N/A';} - else {$total = main::row_defaults('packages','');} + if ($type eq 'inner' || $pms{'disabled'}){ + $total = 'N/A' if $extra < 2; + } + else { + $total = main::message('package-data'); + } } - if ($counts{'total'} && $extra > 1){ - delete $counts{'total'}; + if ($pms{'total'} && $extra > 1){ + delete $pms{'total'}; my $b_mismatch; - foreach (keys %counts){ - if ($counts{$_}->[0] && $counts{$_}->[0] != $total){ + 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 ($extra > 1 && %counts){ - foreach (sort keys %counts){ + $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 an array - next if ref $counts{$_} ne 'ARRAY'; - if ($counts{$_}->[0] || $b_admin){ - my $key = $_; - $key =~ s/^zzz-//; # get rid of the special sorters for items to show last - $output{main::key($$num++,$cont,$ind,$key)} = $counts{$_}->[0]; - if ($b_admin && $counts{$_}->[1]){ - ($cont,$ind) = (0,3); - $output{main::key($$num++,$cont,$ind,'lib')} = $counts{$_}->[1]; + # 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'}; + } } } } @@ -21182,1652 +33976,2677 @@ sub create_output { # print Data::Dumper::Dumper \%output; eval $end if $b_log; } + sub package_counts { eval $start if $b_log; my ($type) = @_; - # 0: key; 1: program; 2: p/d; 3: arg/path; 4: 0/1 use lib; - # 5: lib slice; 6: lib splitter; 7 - optional eval test + # 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,''], - # older dpkg-query do not support -f values consistently: eg ${binary:Package} - ['apt','dpkg-query','p','-W -f=\'${Package}\n\'',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 package -I',1,0,''], - ['pacman','pacman','p','-Qq --color never',1,0,''], - ['pacman-g2','pacman-g2','p','-Q',1,0,''], + ['guix-usr','guix','p','package -I',1,0,''], + ['kiss','kiss','p','list',1,0,''], + ['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_info','pkg_info','p','',1,0,''], - ['pkgtool','pkgtool','d','/var/log/packages/*',1,4,'\\/'], - # way too slow without nodigest/sig!! confirms packages exist - ['rpm','rpm','p','-qa --nodigest --nosignature',1,0,''], - # note',' slapt-get, spkg, and pkgtool all return the same count - #['slapt-get','slapt-get','p','--installed',1,0,''], - #['spkg','spkg','p','--installed',1,0,''], - ['tce','tce-status','p','-i',1,0,''], + ['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 or don't show this feature for rpm!! + ['rpm','rpm','force','-qa --nodigest --nosignature',1,0,'', + 'main::check_program(\'apt-get\') && main::check_program(\'dpkg\')', + ['dnf','packagekit','up2date','urpmi','yast','yum','zypper']], + # uncommon case where apt-get frontend for rpm, w/o dpkg, like AltLinux did + ['rpm-apt','rpm','p','-qa',1,0,'', + 'main::check_program(\'apt-get\') && !main::check_program(\'dpkg\')', + ['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']], # note: I believe mageia uses rpm internally but confirm # ['urpmi','urpmq','p','??',1,0,''], ['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 $libs; - foreach (@pkg_managers){ - if ($program = main::check_program($_->[1])){ - next if $_->[7] && !eval $_->[7]; - if ($_->[2] eq 'p'){ - chomp(@list = qx($program $_->[3] 2>/dev/null)); + my ($program); + foreach my $pm (@pkg_managers){ + if ($program = main::check_program($pm->[1])){ + next if $pm->[7] && !eval $pm->[7]; + my ($disabled,$libs,@list,$pmts); + if ($pm->[2] eq 'p' || ($pm->[2] eq 'force' && check_run($pm))){ + chomp(@list = qx($program $pm->[3] 2>/dev/null)) if $pm->[3]; + } + elsif ($pm->[2] eq 'd'){ + @list = main::globber($pm->[3]); } else { - @list = main::globber($_->[3]); + # update message() if pm other than rpm disabled by default + $disabled = main::message('pm-disabled',$pm->[1]); } - $libs = undef; - $count = scalar @list; - #print Data::Dumper::Dumper \@list; - if ($b_admin && $count && $_->[4]){ - $libs = count_libs(\@list,$_->[5],$_->[6]); + $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]); + } } - $counts{$_->[0]} = ([$count,$libs]); - $counts{'total'} += $count; - #print Data::Dumper::Dumper \%counts; + 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,\$pmts,',','sort'); + } + } + $pms{$pm->[0]} = { + 'disabled' => $disabled, + 'pkgs' => $count, + 'libs' => $libs, + 'tools' => $pmts, + }; + $pms{'total'} += $count if defined $count; + # print Data::Dumper::Dumper \%pms; } } - # print Data::Dumper::Dumper \%counts; - main::log_data('dump','Packaage managers: %counts',\%counts) if $b_log; + 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 {/\bappimaged\b/} @ps_cmd)){ - @list = main::globber($ENV{'HOME'} . '/.local/bin/*.appimage'); + 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; - $counts{'zzz-appimage'} = ([$$count,undef]) if $count; - $counts{'total'} += $count; + $pms{'zzz-appimage'} = { + 'pkgs' => $count, + 'libs' => undef, + }; + $pms{'total'} += $count; } } + +sub check_run { + if ($force{'pkg'}){ + return 1; + } + elsif (${_[0]}->[1] eq 'rpm'){ + # testing for core wrappers for rpm, these should not be present in non + # redhat/suse based systems. mageia has urpmi, dnf, yum + foreach my $tool (('dnf','up2date','urpmi','yum','zypper')){ + return 0 if main::check_program($tool); + } + # Note: test fails: apt-rpm (pclinuxos,alt linux), unknown how to detect + # Add pm test if known to have rpm available. + foreach my $tool (('dpkg','pacman','pkgtool','tce-load')){ + return 1 if main::check_program($tool); + } + } +} + sub count_libs { my ($items,$pos,$split) = @_; my (@data); my $i = 0; $split ||= '\\s+'; - #print scalar @$items, '::', $split, '::', $pos, "\n"; + # print scalar @$items, '::', $split, '::', $pos, "\n"; foreach (@$items){ @data = split(/$split/, $_); - #print scalar @data, '::', $data[$pos], "\n"; + # print scalar @data, '::', $data[$pos], "\n"; $i++ if $data[$pos] && $data[$pos] =~ m%^lib%; } return $i; } } -# args: 1 - pci device string; 2 - pci cleaned subsystem string -sub get_pci_vendor { - eval $start if $b_log; - my ($device, $subsystem) = @_; - return if !$subsystem; - my ($vendor,$sep,$temp) = ('','',''); - # get rid of any [({ type characters that will make regex fail - # and similar matches show as non-match - $subsystem = regex_cleaner($subsystem); - my @data = split(/\s+/, $subsystem); - # when using strings in patterns for regex have to escape them - foreach (@data){ - $temp = $_; - $temp =~ s/(\+|\$|\?|\^|\*)/\\$1/g; - if ($device !~ m|\b$temp\b|){ - $vendor .= $sep . $_; - $sep = ' '; - } - else { - last; - } - } - eval $end if $b_log; - return $vendor; -} +## 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', +); -# 1 - partition name, without /dev, like sda1, sde -sub get_proc_partition { - eval $start if $b_log; - my $item = $_[0]; - return if !@proc_partitions; - my (@device); - foreach my $device (@proc_partitions){ - if ($device->[3] eq $item){ - @device = @$device; - last; - } - } - eval $start if $b_log; - return @device; +sub _within_limit { + my ($value, $type, $limit) = @_; + $type eq 'min' ? $value >= $limit : $value <= $limit; } -# # check? /var/run/nologin for bsds? -sub get_runlevel_data { - eval $start if $b_log; - my $runlevel = ''; - if ( my $program = check_program('runlevel')){ - $runlevel = (grabber("$program 2>/dev/null"))[0]; - $runlevel =~ s/[^\d]//g if $runlevel; - #print_line($runlevel . ";;"); +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]]; + } + } } - eval $end if $b_log; - return $runlevel; + \%h; } -# 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 = ''; - my $b_systemd = 0; - my $inittab = '/etc/inittab'; - my $systemd = '/etc/systemd/system/default.target'; - my $upstart = '/etc/init/rc-sysinit.conf'; - # note: systemd systems do not necessarily have this link created - if ( -e $systemd){ - $default = readlink($systemd); - $default =~ s/.*\/// if $default; - $b_systemd = 1; - } - # 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 - elsif ( -r $upstart){ - # env DEFAULT_RUNLEVEL=2 - @data = reader($upstart); - $default = awk(\@data,'^env\s+DEFAULT_RUNLEVEL',2,'='); - } - # handle weird cases where null but inittab exists - if (!$default && -r $inittab ){ - @data = reader($inittab); - $default = awk(\@data,'^id.*initdefault',2,':'); +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}; } - eval $end if $b_log; - return $default; + $h; } -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; +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 get_shell_data { +sub parse_edid { eval $start if $b_log; - my ($ppid) = @_; - my $cmd = "ps -p $ppid -o comm= 2>/dev/null"; - my $shell = qx($cmd); - 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/^.*\///; - my $working = $ENV{'SHELL'}; - # NOTE: su -c "inxi -F" results in shell being su - if ($shell eq 'sudo' || $shell eq 'su' ){ - $client{'su-start'} = $shell; - $shell = get_shell_parent(get_start_parent($ppid)); + 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'); } - if ($working){ - $working =~ s/^.*\///; -# if (($shell eq 'sh' || $shell eq 'sudo' || $shell eq 'su' ) && $shell ne $working){ -# $client{'su-start'} = $shell if ($shell eq 'sudo' || $shell eq 'su'); -# $shell = $working; -# } - # 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; + 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; + } + } } } - # print "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 (test_shell($shell)){ - # do nothing, just leave $shell as is - } - # note: not all programs return version data. This may miss unhandled shells! - elsif ((@app = program_data(lc($shell),lc($shell),1)) && $app[0]){ - $shell = $app[0]; - $client{'version'} = $app[1] if $app[1]; - #print "app test $shell v: $client{'version'}\n"; - } - 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: ' . $shell .' Start client version type: ', get_shell_parent(get_start_parent(getppid())), "\n"; - my $parent = get_shell_parent(get_start_parent($ppid)); - if ($parent){ - if (test_shell($parent)){ - $shell = $parent; - } - elsif ((@app = program_data(lc($parent),lc($parent),0)) && $app[0]){ - $shell = $app[0]; - $client{'version'} = $app[1] if $app[1]; + $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; } - #print "shell3: $shell version: $client{'version'}\n"; } } - else { - $client{'version'} = row_defaults('unknown-shell'); + 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; } - #print "shell not app version: $client{'version'}\n"; + } + else { + push(@warnings, "parse_edid: unknown tag $tag"); + warn "$warnings[-1]\n" if $verbose; } - $client{'version'} ||= ''; - $client{'version'} =~ s/(\(.*|-release|-version)// if $client{'version'}; - $client{'name'} = lc($shell); - $client{'name-print'} = $shell; - #print "shell4: $client{'name-print'} version: $client{'version'}\n"; - if ($extra > 2 && $working && lc($shell) ne lc($working)){ - if (@app = program_data(lc($working))){ - $client{'default-shell'} = $app[0]; - $client{'default-shell-v'} = $app[1]; - $client{'default-shell-v'} =~ s/(\(.*|-release|-version)// if $client{'default-shell-v'}; - } - else { - $client{'default-shell'} = $working; - } + } + $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}; } - else { - $client{'name'} = 'shell'; - $client{'name-print'} = 'Unknown Shell'; + 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}; } - $client{'su-start'} = 'sudo' if (!$client{'su-start'} && $ENV{'SUDO_USER'}); - eval $end if $b_log; -} -# 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 -sub test_shell { - my ($test) = @_; - # 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 .= 'psh|pwsh|pysh(ell)?|rush|sash|'; - # tested shells with no version info discovered - $shells .= 'es|rc|scsh|sh'; - return '|' . $shells if $test eq 'return'; - return ($test =~ /^($shells)$/) ? $test : ''; -} - -sub get_shell_source { - eval $start if $b_log; - my (@data); - my ($msg,$self_parent,$shell_parent) = ('','',''); - my $ppid = getppid(); - $self_parent = get_start_parent($ppid); - if ($b_log){ - $msg = ($ppid) ? "self parent: $self_parent ppid: $ppid": "self parent: undefined"; - log_data('data',$msg); - } - #print "self parent: $self_parent ppid: $ppid\n"; - if ($self_parent){ - $shell_parent = get_shell_parent($self_parent); - $client{'su-start'} = $shell_parent if ($shell_parent eq 'su' && !$client{'su-start'}); - #print "shell parent 1: $shell_parent\n"; - if ($b_log){ - $msg = ($shell_parent) ? "shell parent 1: $shell_parent": "shell parent 1: undefined"; - 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|elvish|fish|fizsh|ksh|ksh93|'; - $shells .= 'lksh|loksh|mksh|nash|oh|oil|osh|pdksh|perl|posh|'; - $shells .= 'su|sudo|tcsh|xonsh|yash|zsh'; - $shells .= test_shell('return'); - for my $i (2..4){ - if ( $shell_parent && $shell_parent =~ /^($shells)$/ ){ - # no idea why have to do script_parent action twice in su case, but you do. - $self_parent = get_start_parent($self_parent); - $shell_parent = get_shell_parent($self_parent); - #print "self::shell parent 2-${i}: $self_parent :: $shell_parent\n"; - if ($b_log){ - $msg = ($shell_parent) ? "shell parent $i: $shell_parent": "shell parent $i: undefined"; - log_data('data',$msg); + 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; } } - else { - last; - } } - # to work around a ps -p or gnome-terminal bug, which returns - # gnome-terminal- trim - off end - $shell_parent =~ s/-$// if $shell_parent; - } - if ($b_log){ - $self_parent ||= ''; - $shell_parent ||= ''; - log_data('data',"parents: self: $self_parent shell: $shell_parent"); + # 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); + } } - eval $end if $b_log; - return $shell_parent; } -# utilities for get_shell_source -# arg: 1 - parent id -sub get_start_parent { - eval $start if $b_log; - my ($parent) = @_; - return 0 if !$parent; - # ps -j -fp : bsds ps do not have -f for PPID, so we can't get the ppid - my $cmd = "ps -j -fp $parent 2>/dev/null"; - log_data('cmd',$cmd) if $b_log; - my @data = grabber($cmd); - #shift @data if @data; - my $self_parent = awk(\@data,"$parent",3,'\s+'); - eval $end if $b_log; - return $self_parent; +sub _define { + defined $_[0] ? $_[0] : 0; } -# arg: 1 - parent id -sub get_shell_parent { - eval $start if $b_log; - my ($parent) = @_; - return '' if !$parent; - my $cmd = "ps -j -p $parent 2>/dev/null"; - log_data('cmd',$cmd) if $b_log; - my @data = grabber($cmd,'','strip'); - #shift @data if @data; - my $shell_parent = awk(\@data, "$parent",-1,'\s+'); - eval $end if $b_log; - return $shell_parent; +sub _sqr { + $_[0] * $_[0]; } -# this will test against default IP like: (:0) vs full IP to determine -# ssh status. Surprisingly easy test? Cross platform -sub get_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 = check_program('who')){ - $ssh = (grabber("$program am i 2>/dev/null"))[0]; - # crude IP validation - if ($ssh && $ssh =~ /\(([:0-9a-f]{8,}|[1-9][\.0-9]{6,})\)$/){ - $b_ssh = 1; - } - } - eval $end if $b_log; - return $b_ssh; +sub _round { + int($_[0] + 0.5); +} } -sub get_tty_console_irc { - eval $start if $b_log; +## PartitionData: public methods: set(), get() +# for /proc/partitions only, see DiskDataBSD for BSD partition data. +{ +package PartitionData; + +sub set { my ($type) = @_; - return $tty_session if defined $tty_session; - if ( $type eq 'vtrn' && defined $ENV{'XDG_VTNR'} ){ - $tty_session = $ENV{'XDG_VTNR'}; + $loaded{'partition-data'} = 1; + if (my $file = $system_files{'proc-partitions'}){ + proc_data($file); } - else { - my $ppid = getppid(); - $tty_session = awk(\@ps_aux,".*$ppid.*$client{'name'}",7,'\s+'); - $tty_session =~ s/^[^[0-9]+// if $tty_session; - } - $tty_session = '' if ! defined $tty_session; - log_data('data',"conole-irc-tty:$tty_session") if $b_log; - eval $end if $b_log; - return $tty_session; } -sub get_tty_number { +# args: 0: partition name, without /dev, like sda1, sde +sub get { eval $start if $b_log; - my ($tty); - if ( defined $ENV{'XDG_VTNR'} ){ - $tty = $ENV{'XDG_VTNR'}; - } - else { - $tty = POSIX::ttyname(1); - #variants: /dev/pts/1 /dev/tty1 /dev/ttyp2 /dev/ttyra [hex number a] - $tty =~ s/.*\/[^0-9]*//g if defined $tty; + my $item = $_[0]; + return if !@proc_partitions; + my $result; + foreach my $device (@proc_partitions){ + if ($device->[3] eq $item){ + $result = $device; + last; + } } - $tty = '' if ! defined $tty; - log_data('data',"tty:$tty") if $b_log; - eval $end if $b_log; - return $tty; + eval $start if $b_log; + return ($result) ? $result : []; } -# 2:58PM up 437 days, 8:18, 3 users, load averages: 2.03, 1.72, 1.77 -# 04:29:08 up 3:18, 3 users, load average: 0,00, 0,00, 0,00 -# 10:23PM up 5 days, 16:17, 1 user, load averages: 0.85, 0.90, 1.00 -# 05:36:47 up 1 day, 3:28, 4 users, load average: 1,88, 0,98, 0,62 -# 05:36:47 up 1 day, 3 min, 4 users, load average: 1,88, 0,98, 0,62 -# 04:41:23 up 2:16, load average: 7.13, 6.06, 3.41 # root openwrt -sub get_uptime { +sub proc_data { eval $start if $b_log; - my ($days,$hours,$minutes,$uptime) = ('','','',''); - if (check_program('uptime')){ - $uptime = qx(uptime); - $uptime = trimmer($uptime); - #$uptime = '05:36:47 up 3 min, 4 users, load average: 1,88, 0,98, 0,62'; - if ($uptime && - $uptime =~ /[\S]+\s+up\s+(([0-9]+)\s+day[s]?,\s+)?(([0-9]{1,2}):([0-9]{1,2})|([0-9]+)\smin[s]?),\s+([0-9]+\s+user|load average)/){ - $days = $2 . 'd' if $2; - $days .= ' ' if ($days && ($4 || $6)); - if ($4 && $5){ - $hours = $4 . 'h '; - $minutes = $5 . 'm'; - } - elsif ($6){ - $minutes = $6 . 'm'; - - } - $uptime = $days . $hours . $minutes; - } + 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]]); } - $uptime ||= 'N/A'; eval $end if $b_log; - return $uptime; } -# note: seen instance in android where reading file hangs endlessly!!! -sub get_wakeups { - eval $start if $b_log; - return if $b_arm || $b_mips || $b_ppc; - my ($wakeups); - my $path = '/sys/power/wakeup_count'; - $wakeups = reader($path,'strip',0) if -r $path; - eval $end if $b_log; - return $wakeups; } -#### ------------------------------------------------------------------- -#### SET DATA VALUES -#### ------------------------------------------------------------------- - -# android only, for distro / OS id and machine data -sub set_build_prop { +# args: 0: pci device string; 1: pci cleaned subsystem string +sub get_pci_vendor { eval $start if $b_log; - my $path = '/system/build.prop'; - $b_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]; + 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 = ' '; } - elsif ($working[0] eq 'ro.product.screensize'){ - $build_prop{'product-screensize'} = $working[1]; + else { + last; } } - log_data('dump','%build_prop',\%build_prop) if $b_log; - print Dumper \%build_prop if $test[20]; - eval $end if $b_log; -} - -## creates arrays: @devices_audio; @devices_graphics; @devices_hwraid; -## @devices_network; @devices_timer plus @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 -## DeviceData / PCI / SOC -{ -package DeviceData; -my (@data,@devices,@files,@full_names,@pcis,@temp,@temp2,@temp3); - -my ($busid,$busid_nu,$chip_id,$content,$device,$driver,$driver_nu,$file, -$handle,$modules,$port,$rev,$temp,$type,$type_id,$vendor,$vendor_id); + # just in case we had a standalone last character after done + $vendor =~ s| [/\(\[\{a\.,-]$|| if $vendor; + eval $end if $b_log; + return $vendor; +} -sub set { +# $rows, $num by ref. +sub get_pcie_data { eval $start if $b_log; - $_[0] = 1; # check boolean passed by reference - if ( $b_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 ($b_arm || $b_mips || $b_ppc || $b_sparc){ - soc_data(); - } - } - else { - #if (1 == 1){ - if ($alerts{'pciconf'}->{'action'} eq 'use'){ - pciconf_data(); - } - elsif ($alerts{'pcidump'}->{'action'} eq 'use'){ - pcidump_data(); - } - } - if ($test[9]){ - print Data::Dumper::Dumper \@devices_audio; - 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_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); - } + 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; + } - @devices = undef; eval $end if $b_log; } -sub lspci_data { +## 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; - my ($subsystem,$subsystem_id); - @data = pci_grabber('lspci'); - #print Data::Dumper::Dumper \@data; - foreach (@data){ - #print "$_\n"; - if ($device){ - if ($_ =~ /^~$/) { - @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::cleaner($subsystem); - $subsystem = main::pci_cleaner($subsystem,'pci'); - $subsystem = main::pci_cleaner_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) - elsif ($_ =~ /^(([0-9a-f]{2,4}:)?[0-9a-f]{2}:[0-9a-f]{2})[.:]([0-9a-f]+)\s(.*)\s\[([0-9a-f]{4}):([0-9a-f]{4})\](\s\(rev\s([^\)]+)\))?/){ - $busid = $1; - $busid_nu = hex($3); - @temp = split(/:\s+/, $4); - $device = $temp[1]; - $type = $temp[0]; - $vendor_id = $5; - $chip_id = $6; - $rev = ($8)? $8 : ''; - $device = main::cleaner($device); - $temp[0] =~ /\[([^\]]+)\]$/; - $type_id = $1; - $b_hardware_raid = 1 if $type_id eq '0104'; - $type = lc($type); - $type = main::pci_cleaner($type,'pci'); - $type =~ s/\s+$//; - #print "$type\n"; - ($driver,$driver_nu,$modules,$subsystem,$subsystem_id) = ('','','','',''); - } - } - print Data::Dumper::Dumper \@devices if $test[4]; - main::log_data('dump','lspci @devices',\@devices) if $b_log; + sys_data(); eval $end if $b_log; + return $power; } -# 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 { +sub sys_data { eval $start if $b_log; - @data = pci_grabber('pciconf'); - foreach (@data){ - if ($driver){ - if ($_ =~ /^~$/) { - $vendor = main::cleaner($vendor); - $device = main::cleaner($device); - # handle possible regex in device name, like [ConnectX-3] - # and which could make matches fail - my $device_temp = main::regex_cleaner($device); - if ($vendor && $device){ - if (main::regex_cleaner($vendor) !~ /\Q$device_temp\E/i){ - $device = "$vendor $device"; + # 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->{$_}; } } - 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]; + # size is in bytes + elsif ($_ eq 'hibernate-image-size'){ + $power->{$_} = main::get_size(($power->{$_}/1024),'string') if defined $power->{$_}; } } - elsif (/^([^@]+)\@pci([0-9]{1,3}:[0-9]{1,3}:[0-9]{1,3}):([0-9]{1,3}).*class=([^\s]+)\scard=([^\s]+)\schip=([^\s]+)\srev=([^\s]+)/){ - $driver = $1; - $busid = $2; - $busid_nu = $3; - $type_id = $4; - #$vendor_id = $5; - $vendor_id = substr($6,6,4); - $chip_id = substr($6,2,4); - $rev = $7; - $driver =~ /(^[a-z]+)([0-9]+$)/; - $driver = $1; - $driver_nu = $2; - # convert to 4 character, strip off 0x, and last trailing sub sub class. - $type_id =~ s/^(0x)?([0-9a-f]{4}).*/$2/ if $type_id; - ($device,$type,$vendor) = ('','',''); - } } - print Data::Dumper::Dumper \@devices if $test[4]; - main::log_data('dump','pciconf @devices',\@devices) if $b_log; + print 'power: ', Data::Dumper::Dumper $power if $dbg[58]; + main::log_data('dump','$power',$power) if $b_log; eval $end if $b_log; } - -sub pcidump_data { - eval $start if $b_log; - @data = pci_grabber('pcidump'); - foreach (@data){ - if ($_ =~ /^~$/ && $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) = undef; - next; - } - if ($_ =~ /^([0-9a-f:]+):([0-9]+):\s([^:]+)$/i){ - $busid = $1; - $busid_nu = $2; - $device = main::cleaner($3); - } - elsif ($_ =~ /^0x[\S]{4}: Vendor ID: ([0-9a-f]{4}) Product ID: ([0-9a-f]{4})/ ){ - $vendor_id = $1; - $chip_id = $2; - } - elsif ($_ =~ /^0x[\S]{4}: Class: ([0-9a-f]{2}) Subclass: ([0-9a-f]{2}) Interface: ([0-9a-f]+) Revision: ([0-9a-f]+)/){ - $type = pci_class($1); - $type_id = "$1$2"; - } - } - print Data::Dumper::Dumper \@devices if $test[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,@working); - if ($program eq 'lspci'){ - $args = ' -knnv'; - $path = $alerts{'lspci'}->{'path'}; - $pattern = '^[0-9a-f]+:'; - } - elsif ($program eq 'pciconf'){ - $args = ' -lv'; - $path = $alerts{'pciconf'}->{'path'}; - $pattern = '^([^@]+)\@pci'; - } - elsif ($program eq 'pcidump'){ - $args = ' -v'; - $path = $alerts{'pcidump'}->{'path'}; - $pattern = '^[0-9a-f]+:'; - } - @data = main::grabber("$path $args 2>/dev/null",'','strip'); - #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/pciconf/pci-freebsd-8.2-2"; - #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/pcidump/pci-openbsd-6.1-vm.txt"; - #my $file = "$ENV{HOME}/bin/scripts/inxi/data/lspci/racermach-1-knnv.txt"; - #my $file = "$ENV{HOME}/bin/scripts/inxi/data/lspci/rk016013-knnv.txt"; - #@data = main::reader($file,'strip'); - if (@data){ - $b_pci_tool = 1 if scalar @data > 10; - foreach (@data){ - if ($_ =~ /$pattern/i){ - push(@working, '~'); - } - push(@working, $_); + +# 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]); } - push(@working, '~'); } - #print Data::Dumper::Dumper \@working; + # 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 @working; + return @full; } -sub soc_data { - eval $start if $b_log; - soc_devices_files(); - soc_devices(); - soc_devicetree(); - print Data::Dumper::Dumper \@devices if $test[4]; - main::log_data('dump','soc @devices',\@devices) if $b_log; - eval $end if $b_log; +# 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,'',''], # unverified + '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-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',0,'0','dwl',0,1,0,'',''], # unverified + '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], + '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,'',''], + 'mahogany' => ['^mahogany',0,'0','Mahogany',0,1,0,'',''], # unverified + '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,'',''], + '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 + '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',''], + '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,'',''], # Android, unverified + 'sway' => ['^sway',3,'-v','Sway',0,1,0,'',''], + 'swayfx' => ['^swayfx',0,'0','SwayFX',0,1,0,'',''], # probably same as sway, unverified + '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,'',''], # fork of 9wm, unverified + '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,'',''], # fork of 9wm, unverified + '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 + '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,'',''], # guess, unverified, 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 + 'seatd' => ['^seatd',3,'-v','seatd',0,1,0,'',''], + 'sddm' => ['^sddm',0,'0','SDDM',0,1,0,'',''], + '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,'',''], + 'busybox' => ['^busybox',0,'0','BusyBox',1,0,0,'',''], # unverified, hush/ash likely + '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 ## + 'clang' => ['clang',3,'--version','clang',1,1,0,'',''], + # 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 + ); } -# 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:NethernetT<NULL>Callwinner,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:NaudioT<NULL>Cbrcm,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:NfbT<NULL>Cbrcm,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:NgpuT<NULL>Callwinner,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' -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; - @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; + +# 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]}}; } - @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; - @temp2 = undef; - # 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; + # my $debug = Dumper \@values; + main::log_data('dump','@values',\@values) if $b_log; + return @values; } -sub soc_devices { + +# 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 (@working); - 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) = (undef,undef,undef,undef,undef); - 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]; - } + 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; } - # it's worthless, we can't use it - next if ! defined $type; - $type_id = $type; - $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); - } - 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'; - 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 ($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','@devices @temp3',\@temp3) if $b_log; - } + else { + main::log_data('data',"$app not found in path.") if $b_log; + return 0; } } - eval $end if $b_log; -} -sub assign_data { - my ($tool,$data) = @_; - if (check_graphics($data->[0],$data->[1])){ - push(@devices_graphics,[@$data]); - $b_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]); - $b_soc_audio = 1 if $tool eq 'soc'; + 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 = ''; } - if (check_bluetooth($data->[0],$data->[1])){ - push(@devices_bluetooth,[@$data]); - $b_soc_bluetooth = 1 if $tool eq 'soc'; + # 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; } - elsif (check_hwraid($data->[0],$data->[1])){ - push(@devices_hwraid,[@$data]); - $b_soc_net = 1 if $tool eq 'soc'; + # 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; } - elsif (check_network($data->[0],$data->[1])){ - push(@devices_network,[@$data]); - $b_soc_net = 1 if $tool eq 'soc'; + # note, some wm/apps send version info to stderr instead of stdout + elsif ($stderr){ + $cmd = "$app $version 2>&1"; } - elsif (check_timer($data->[0],$data->[1])){ - push(@devices_timer,[@$data]); - $b_soc_timer = 1; + else { + $cmd = "$app $version 2>/dev/null"; } - # not used at this point, -M comes before ANG - # $device_vm = check_vm($data[4]) if ( (!$b_ppc && !$b_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; + # special case, in rare instances version comes from file + if ($version ne 'file'){ + $output = main::grabber($cmd,'','strip','ref'); } - else {return 0} -} -sub check_bluetooth { - if ( ( $_[1] && length($_[1]) == 4 && $_[1] eq '0d11' ) || - ( $_[0] && $_[0] =~ /^(bluetooth)$/i )){ - return 1; + if ($b_log){ + main::log_data('data',"version: $version num: $num search: $search command: $cmd"); + main::log_data('dump','output',$output); } - else {return 0} -} -sub check_graphics { - # note: multimedia class 04 is viddeo 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; + if ($dbg[64]){ + print "::::::::::\nPD::version() cmd: $cmd\noutput:",Data::Dumper::Dumper $output; } - 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; + # 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++; + } } - else {return 0} -} -sub check_timer { - return 1 if ( $_[0] && $_[0] eq 'timer' ); + main::log_data('data',"Program version: $version_nu") if $b_log; + eval $end if $b_log; + return $version_nu; } -sub check_vm { - if ( $_[0] && $_[0] =~ /(innotek|vbox|virtualbox|vmware|qemu)/i ) { - return $1 - } - else {return ''} +# 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; } -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'; - } - 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'; - } - 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.*)$/i){ - $type = 'wifi'; +# 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"; } - # needs to catch variants like hdmi-tx but not hdmi-connector - elsif ( $type =~ /^(.*hdmi(-?tx)?)$/i){ - $type = 'hdmi'; + elsif ($program = main::check_program('pacman')){ + $data[0] = "$program -Q --info $app 2>/dev/null"; + $data[1] = '^Version'; } - elsif ($type =~ /^timer$/i){ - $type = 'timer'; + elsif ($program = main::check_program('rpm')){ + $data[0] = "$program -qi --nodigest --nosignature $app 2>/dev/null"; + $data[1] = '^Version'; } - 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', - '40' => 'coprocessor', - 'ff' => 'unassigned', - ); - my $type = (defined $classes{$id}) ? $classes{$id}: 'unhandled'; + # print "$data[0] :: $data[1]\n"; eval $end if $b_log; - return $type; + return @data; } } -sub set_dmesg_boot_data { - eval $start if $b_log; - my ($file,@temp); - my ($counter) = (0); - $b_dmesg_boot_check = 1; - if (!$b_fake_dboot){ - $file = system_files('dmesg-boot'); +## PsData +# public methods: +# set_cmd(): sets @ps_aux, @ps_cmd +# set_dm(): sets $ps_data{'dm-active'} +# set_de_wm(): sets -S/-G de/wm/comp/tools items +# set_power(): sets -I $ps_data{'power-services'} +{ +package PsData; + +sub set_cmd { + eval $start if $b_log; + my ($b_busybox,$header,$ps,@temp); + $loaded{'ps-cmd'} = 1; + my $args = 'wwaux'; + my $path = main::check_program('ps'); + my $link = readlink($path); + if ($link && $link =~ /busybox/i){ + $b_busybox = 1; + $args = ''; + } + # 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 { - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/bsd-disks-diabolus.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/freebsd-disks-solestar.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/freebsd-enceladus-1.txt"; - ## matches: toshiba: openbsd-5.6-sysctl-2.txt - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/openbsd-5.6-dmesg.boot-1.txt"; - ## matches: compaq: openbsd-5.6-sysctl-1.txt" - $file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/openbsd-dmesg.boot-1.txt"; - } - if ($file){ - return if ! -r $file; - @dmesg_boot = reader($file); - # 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 (@dmesg_boot){ - $counter++ if /^(OpenBSD|DragonFly|FreeBSD is a registered trademark)/; - last if $counter > 1; - $_ =~ s/\s*=\s*|:\s*/:/; - $_ =~ s/\"//g; - $_ =~ s/^\s+/~/; - $_ =~ s/\s\s/ /g; - $_ =~ s/^(\S+)\sat\s/$1:at /; # ada0 at ahcich0 - push(@temp, $_); - if (/^bios[0-9]:(at|vendor)/){ - push(@sysctl_machine, $_); - } - } - @dmesg_boot = @temp; - # FreeBSD: 'da*' is a USB device 'ada*' is a SATA device 'mmcsd*' is an SD card - if ($b_dm_boot_disk && @dmesg_boot){ - @dm_boot_disk = grep {/^(ad|ada|da|mmcblk|mmcsd|nvme[0-9]+n|sd|wd)[0-9]+(:|\sat\s)/} @dmesg_boot; - log_data('dump','@dm_boot_disk',\@dm_boot_disk) if $b_log; - print Dumper \@dm_boot_disk if $test[11]; - } - if ($b_dm_boot_optical && @dmesg_boot){ - @dm_boot_optical = grep {/^(cd)[0-9]+(\([^)]+\))?(:|\sat\s)/} @dmesg_boot; - log_data('dump','@dm_boot_optical',\@dm_boot_optical) if $b_log; - print Dumper \@dm_boot_optical if $test[11]; + 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. + if ($split[$ps_data{'header'}->[0]] !~ /^([\[\(]|(\S+\/|)($pattern))/i){ + push(@ps_cmd,join(' ', @split[$ps_data{'header'}->[0] .. $final])); } } - log_data('dump','@dmesg_boot',\@dmesg_boot) if $b_log; - #print Dumper \@dmesg_boot if $test[11]; + # 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; } -# note, all actual tests have already been run in check_tools so if we -# got here, we're good. -sub set_dmi_data { +# only runs when no /run type dm found +sub set_dm { eval $start if $b_log; - $_[0] = 1; # check boolean passed by reference - if ($b_fake_dmidecode || $alerts{'dmidecode'}->{'action'} eq 'use' ){ - set_dmidecode_data(); - } + # 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_dmidecode_data { +sub set_de_wm { eval $start if $b_log; - my ($content,@data,@working,$type,$handle); - if ($b_fake_dmidecode){ - my $file; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmidecode/pci-freebsd-8.2-2"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmidecode/dmidecode-loki-1.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmidecode/dmidecode-t41-1.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmidecode/dmidecode-mint-20180106.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmidecode/dmidecode-vmware-ram-1.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmidecode/dmidecode-tyan-4408.txt"; - #$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ram/dmidecode-speed-configured-1.txt"; - $file = "$ENV{'HOME'}/bin/scripts/inxi/data/ram/dmidecode-speed-configured-2.txt"; - open(my $fh, '<', $file) or die "can't open $file: $!"; - chomp(@data = <$fh>); + $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( + 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 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 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-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 + mahogany marina maze maynard motorcar newm nucleus + orbital orbment perceptia phoc 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 glx-dock gnome-panel hpanel + i3bar i3-status(-rs|-rust)? icewmtray jgmenu kdocker kicker krunner ksmoothdock + latte lavalauncher latte-dock lemonbar ltpanel luastatus lxpanel lxqt-panel + matchbox-panel mate-panel mauncher mopag nwg-(bar|dock|launchers|panel) + 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 vala-panel + wapanel waybar wbar wharf wingpanel witray wldash wmdocker 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 i3lock + kscreenlocker light-locker lockscreen lxlock mate-screensaver nwg-lock + physlock rss-glx slock swayidle swaylock ukui-screensaver unicode-screensaver + 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 + [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 + 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 + } } - else { - $content = qx($alerts{'dmidecode'}->{'path'} 2>/dev/null); - @data = split('\n', $content); + 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; } - # 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, $_); - } + 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 (/^Handle\s(0x[0-9A-Fa-f]+).*DMI\stype\s([0-9]+),.*/){ - $j = scalar @dmi; - $handle = hex($1); - $type = $2; - $b_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); + elsif ($type eq 'tool'){ + $value = $service_tool{$key}->[1]; } } - 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; - log_data('dump','@dmi',\@dmi) if $b_log; - print Dumper \@dmi if $test[2]; eval $end if $b_log; + return $value; } -sub set_ip_data { +sub process_status { eval $start if $b_log; - if ($alerts{'ip'}->{'action'} eq 'use' ){ - set_ip_addr(); + 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 ($alerts{'ifconfig'}->{'action'} eq 'use'){ - set_ifconfig(); + 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_ip_addr { +sub set { eval $start if $b_log; - my @data = grabber($alerts{'ip'}->{'path'} . " addr 2>/dev/null",'\n','strip'); - # my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/if/scope-ipaddr-1.txt"; - # my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/networking/ip-addr-blue-advance.txt"; - #my @data = reader($file,'strip') or die $!; - my ($b_skip,$broadcast,$if,$ip,@ips,$scope,$if_id,$type,@temp,@temp2); - foreach (@data){ - if (/^[0-9]/){ - #print "$_\n"; - if (@ips){ - #print "$if\n"; - @temp = ($if,[@ips]); - push(@ifs,@temp); - @ips = (); - } - @temp = split(/:\s+/, $_); - $if = $temp[1]; - if ($if eq 'lo'){ - $b_skip = 1; - $if = ''; - next; - } - $b_skip = 0; - @temp = (); - } - elsif (!$b_skip && /^inet/){ - #print "$_\n"; - @temp = split(/\s+/, $_); - ($broadcast,$ip,$scope,$if_id,$type) = ('','','','',''); - $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; - } - @temp = ($type,$ip,$broadcast,$scope,$if_id); - push(@ips,[@temp]); - #print Dumper \@ips; - } + $loaded{'service-tool'} = 1; + my ($path); + if ($path = main::check_program('systemctl')){ + # systemctl status ssh :: Loaded: / Active: + %service_tool = ('systemctl' => [$path,'systemctl']); } - #print Dumper \@ips if $test[4]; - if (@ips){ - @temp = ($if,[@ips]); - push(@ifs,@temp); + 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']); } - log_data('dump','@ifs',\@ifs) if $b_log; - print Dumper \@ifs if $test[3]; eval $end if $b_log; } +} +# $dbg[29] = 1; set_path(); print ServiceData::get('status','bluetooth'),"\n"; -sub set_ifconfig { +## 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 @data = grabber($alerts{'ifconfig'}->{'path'} . " 2>/dev/null",'\n',''); - #my @data = reader("$ENV{'HOME'}/bin/scripts/inxi/data/if/vps-ifconfig-1.txt",'') or die $!; - my ($b_skip,$broadcast,$if,@ips_bsd,$ip,@ips,$scope,$if_id,$type,@temp,@temp2); - my ($state,$speed,$duplex,$mac); - foreach (@data){ - if (/^[\S]/i){ - #print "$_\n"; - if (@ips){ - #print "here\n"; - @temp = ($if,[@ips]); - push(@ifs,@temp); - @ips = (); - } - if ($mac){ - @temp = ($if,[($state,$speed,$duplex,$mac)]); - push(@ifs_bsd,@temp); - ($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; + 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; } - $b_skip = 0; } - # lladdr openbsd - elsif (!$b_skip && $bsd_type && /^\s+(ether|media|status|lladdr)/){ - $_ =~ s/^\s+//; - # media: Ethernet 100baseTX <full-duplex> freebsd 7.3 - # media: Ethernet autoselect (1000baseT <full-duplex>) Freebsd 8.2 - # - if (/^media/){ - # openbsd: media: Ethernet autoselect (1000baseT full-duplex) - if ($bsd_type && $bsd_type eq 'openbsd'){ - $_ =~ /\s\([\S]+\s([\S]+)\)/; - $duplex = $1; - } - else { - $_ =~ /<([^>]+)>/; - $duplex = $1; + # 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; } - $_ =~ /\s\(([1-9][\S]+\s)/; - $speed = $1; - $speed =~ s/\s+$// if $speed; - } - elsif (!$mac && /^ether|lladdr/){ - $mac = (split(/\s+/, $_))[1]; } - elsif (/^status/){ - $state = (split(/\s+/, $_))[1]; + else { + $client{'version'} = main::message('unknown-shell'); } + print "6: shell not app version: $client{'version'}\n" if $b_debug; } - 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; + $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'}; } - $type = ($temp[0] eq 'inet') ? 4 : 6 ; - if (/(Bcast:|broadcast\s)([\S]+)/){ - $broadcast = $2; + else { + $client{'default-shell'} = $working; } - if (/(scopeid\s[^<]+<|Scope:|scopeid\s)([^>]+)[>]?/){ - $scope = $2; + } + } + 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)'; } - $scope = 'link' if $ip =~ /^fe80/; - @temp = ($type,$ip,$broadcast,$scope,$if_id); - push(@ips,[@temp]); - #print Dumper \@ips; + } + 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 (@ips){ - @temp = ($if,[@ips]); - push(@ifs,@temp); + if (!$client{'su-start'}){ + $client{'su-start'} = 'sudo' if $ENV{'SUDO_USER'}; + $client{'su-start'} = 'doas' if $ENV{'DOAS_USER'}; } - if ($mac){ - @temp = ($if,[($state,$speed,$duplex,$mac)]); - push(@ifs_bsd,@temp); - ($state,$speed,$duplex,$mac) = ('','','',''); + if ($parent && $parent eq 'login'){ + $client{'su-start'} = ($client{'su-start'}) ? $client{'su-start'} . ',' . $parent: $parent; } - print Dumper \@ifs if $test[3]; - print Dumper \@ifs_bsd if $test[3]; - log_data('dump','@ifs',\@ifs) if $b_log; - log_data('dump','@ifs_bsd',\@ifs_bsd) if $b_log; eval $end if $b_log; } -sub set_lsblk { +# 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; - $b_lsblk = 1; - if ($alerts{'lsblk'} && $alerts{'lsblk'}->{'path'}){ - my $cmd = $alerts{'lsblk'}->{'path'} . ' -bP --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,'; - $cmd .= 'SERIAL,MOUNTPOINT,PHY-SEC,LOG-SEC,PARTFLAGS,MAJ:MIN,PKNAME 2>/dev/null'; - 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+PARTFLAGS="([^"]*)"\s+'; - $pattern .= 'MAJ:MIN="([^"]*)"\s+PKNAME="([^"]*)"'; - my @working = main::grabber($cmd); - 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'}){ - $b_active_lvm = 1 if !$b_active_lvm && $2 && $2 eq 'lvm'; - if (!$b_active_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'))){ - $b_active_general = 1; - } - } + 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); } } } - #print Data::Dumper::Dumper \@lsblk; - main::log_data('dump','@lsblk',\@lsblk) if $b_log; + 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; } -sub set_mapper { +# args: 0: parent id +# returns SID/start ID +sub get_pppid { eval $start if $b_log; - $b_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; + 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; } - %dmmapper = reverse %mapper if %mapper; 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 : ''; } -sub set_proc_partitions { +# 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; - $b_proc_partitions = 1; - if (my $file = main::system_files('partitions')){ - @proc_partitions = main::reader($file,'strip'); - shift @proc_partitions; # get rid of headers - @proc_partitions = map { - my @temp = split(/\s+/, $_); - next if ! defined $temp[2]; - [$temp[0],$temp[1],$temp[2],$temp[3]]; - } @proc_partitions; + 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; } -sub set_ps_aux { +# If IRC: called if root for -S, -G, or if not in display for user. +sub console_irc_tty { eval $start if $b_log; - my ($header,@temp); - @ps_aux = grabber("ps aux 2>/dev/null",'','strip'); - if (@ps_aux){ - $header = shift @ps_aux; # 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); + $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'}; } - $ps_cols = $#temp; - if ($ps_cols < 10){ - my $version = qx(ps --version 2>&1); - $b_bb_ps = 1 if $version =~ /busybox/i; - } - return if !@ps_aux; # note: mips/openwrt ps has no 'a' - $_=lc for @ps_aux; # this is a super fast way to set to lower - # note: regular perl /.../inxi but sudo /.../inxi is added for sudo start - # for pinxi, we want to see the useage data for cpu/ram - @ps_aux = grep {!/\/$self_name\b/} @ps_aux if $self_name eq 'inxi'; - # this is for testing for the presence of the command - @ps_cmd = grep {!/^\[/} map { - my @split = split(/\s+/, $_); - # slice out 10th to last elements of ps aux rows - my $final = $#split; - # some stuff has a lot of data, chrome for example - $final = ($final > ($ps_cols + 2) ) ? $ps_cols + 2 : $final; - @split = @split[$ps_cols .. $final]; - join(' ', @split); - } @ps_aux; - #@ps_cmd = grep {!/^\[/} @ps_cmd; - # never, because ps loaded before option handler - print Dumper \@ps_cmd if $test[5]; + 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 set_ps_gui { +sub tty_number { eval $start if $b_log; - $b_ps_gui = 1; - my ($working,@match,@temp); - # desktops / wm (some wm also compositors) - if ($show{'system'}){ - @temp=qw(razor-desktop razor-session lxsession lxqt-session - tdelauncher tdeinit_phase1); - push(@match,@temp); - @temp=qw(3dwm 9wm afterstep aewm aewm\+\+ amiwm antiwm awesome - blackbox bspwm - cagebreak calmwm (sh|c?lisp).*clfswm (openbsd-)?cwm dwm evilwm - fluxbox flwm flwm_topside fvwm.*-crystal fvwm1 fvwm2 fvwm3 fvwm95 fvwm - i3 instantwm ion3 jbwm jwm larswm lwm - matchbox-window-manager mini musca mwm nawm notion - openbox orbital pekwm perceptia python.*qtile qtile qvwm ratpoison - sawfish scrotwm spectrwm (sh|c?lisp).*stumpwm sway - tinywm tvtwm twm - waycooler way-cooler windowlab WindowMaker wm2 wmii2 wmii wmx - xfdesktop xmonad yeahwm); - push(@match,@temp); - } - # wm: - if ($show{'system'} && $extra > 1){ - @temp=qw(budgie-wm compiz deepin-wm gala gnome-shell - twin kwin_wayland kwin_x11 kwin marco - deepin-metacity metacity metisse mir muffin deepin-mutter mutter - ukwm xfwm4 xfwm5); - push(@match,@temp); - # startx: /bin/sh /usr/bin/startx - @temp=qw(ly .*startx xinit); # possible dm values - push(@match,@temp); - } - # info: NOTE: glx-dock is cairo-dock - if ($show{'system'} && $extra > 2){ - @temp=qw(alltray awn bar bmpanel bmpanel2 budgie-panel - cairo-dock dde-dock dmenu dockbarx docker docky dzen dzen2 - fbpanel fspanel glx-dock gnome-panel hpanel i3bar icewmtray - kdocker kicker latte latte-dock lemonbar ltpanel lxpanel lxqt-panel - matchbox-panel mate-panel ourico - perlpanel plank plasma-desktop plasma-netbook polybar pypanel - razor-panel razorqt-panel stalonetray swaybar taskbar tint2 trayer - ukui-panel vala-panel wbar wharf wingpanel witray - xfce4-panel xfce5-panel xmobar yabar); - push(@match,@temp); - } - # compositors (for wayland these are also the server, note. - # for wayland always show, so always load these - if ($show{'graphic'} && $extra > 0){ - @temp=qw(3dwm asc budgie-wm compiz compton deepin-wm dwc dcompmgr - enlightenment fireplace gnome-shell grefson kmscon kwin_wayland kwin_x11 - liri marco metisse mir moblin motorcar muffin mutter - orbital papyros perceptia picom rustland sommelier sway swc - ukwm unagi unity-system-compositor - wavy waycooler way-cooler wayfire wayhouse westford weston xcompmgr); - push(@match,@temp); - } - uniq(\@match); - my $matches = join('|', @match); - foreach (@ps_cmd){ - if (/^(|[\S]*\/)($matches)(\/|\s|$)/){ - $working = $2; - push(@ps_gui, $working); # deal with duplicates with uniq + $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'}; } } - uniq(\@ps_gui) if @ps_gui; - print Dumper \@ps_gui if $test[5]; - log_data('dump','@ps_gui',\@ps_gui) if $b_log; + 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 (!$b_fake_sysctl){ + 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 = "$ENV{'HOME'}/bin/scripts/inxi/data/sysctl/obsd_6.1_sysctl_soekris6501_root.txt"; - #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sysctl/obsd_6.1sysctl_lenovot500_user.txt"; + 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 - my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sysctl/openbsd-5.6-sysctl-1.txt"; + # $file = "$fake_data_dir/bsd/sysctl/openbsd-5.6-sysctl-1.txt"; ## matches: toshiba: openbsd-5.6-dmesg.boot-1.txt - #my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sysctl/openbsd-5.6-sysctl-2.txt"; - @temp = reader($file); + # $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, $_); - # we're building these here so we can use these arrays to test - # in each feature if we will try to build the feature for bsds - if (/^hw\.sensors/ && !/^hw\.sensors\.acpi(bat|cmb)/ && !/^hw.sensors.softraid/){ - push(@sysctl_sensors, $_); - } - elsif (/^hw\.(vendor|product|version|serialno|uuid)/){ - push(@sysctl_machine, $_); - } - elsif (/^hw\.sensors\.acpi(bat|cmb)/){ - push(@sysctl_battery, $_); + 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'}); } - print Dumper \@sysctl if $test[7]; # this thing can get really long. if ($b_log){ - #main::log_data('dump','@sysctl',\@sysctl); - } - eval $end if $b_log; -} - -## @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 -# 18 - configuration - not used -## USBData + 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; +package UsbData; my (@working); -my ($b_hub,$addr_id,$bus_id,$bus_id_alpha,$chip_id,$class_id, -$device_id,$driver,$ids,$interfaces,$name,$path,$path_id,$product, -$protocol_id,$serial,$speed,$subclass_id,$type,$version,$vendor,$vendor_id,); +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; - $b_usb_check = 1; + ${$_[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 - if ((!$b_usb_sys || $b_usb_tool) && $alerts{'lsusb'}->{'action'} eq 'use' ){ + elsif ((!$force{'usb-sys'} || $force{'lsusb'}) && $alerts{'lsusb'}->{'action'} eq 'use'){ lsusb_data(); } elsif (-d '/sys/bus/usb/devices'){ sys_data('main'); } - elsif ( $alerts{'usbdevs'}->{'action'} eq 'use'){ - usbdevs_data(); + @{$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; } @@ -22835,14 +36654,21 @@ sub set { sub lsusb_data { eval $start if $b_log; my (@temp); - my @data = data_grabber('lsusb'); + my @data = usb_grabber('lsusb'); foreach (@data){ - next if /^\s*$|^Couldn't/; # expensive second call: || /UNAVAIL/ + next if /^~$|^Couldn't/; # expensive second call: || /UNAVAIL/ @working = split(/\s+/, $_); next unless defined $working[1] && defined $working[3]; $working[3] =~ s/:$//; - # Seen FreeBSD lsusb with: + # 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]); @@ -22850,8 +36676,10 @@ sub lsusb_data { $chip_id = $working[5]; @temp = @working[6..$#working]; $name = main::remove_duplicates(join(' ', @temp)); - $name = $name; - #print "$name\n"; + # $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; @@ -22866,18 +36694,128 @@ sub lsusb_data { $working[11] = ''; $working[12] = ''; $working[13] = $name; - $working[14] = ''; + $working[14] = '';# $type; $working[15] = ''; $working[16] = ''; $working[17] = ''; $working[18] = ''; - push(@usb,[@working]); - #print join("\n",@working),"\n\n=====\n"; + $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: <Apple OHCI root HUB> at usbus0, cfg=0 md=HOST spd=FULL (12Mbps) pwr=SAVE (0mA) +# ugen0.2: <MediaTek 802.11 n WLAN> 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 '<vendor defined>')){ + $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); + } } - print Data::Dumper::Dumper \@usb if $test[6]; - sys_data('lsusb') if @usb; - print Data::Dumper::Dumper \@usb if $test[6]; - main::log_data('dump','@usb: plain',\@usb) if $b_log; + 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; } @@ -22887,59 +36825,76 @@ sub lsusb_data { # port 2 powered sub usbdevs_data { eval $start if $b_log; - my ($class,$hub_id,$port,$port_value); - my ($ports,$j,$k) = (0,0,0); - my @data = data_grabber('usbdevs'); + my ($b_multi,$class,$config,$hub_id,$port,$port_value,$product_rev); + my ($ports) = (0); + my @data = usb_grabber('usbdevs'); foreach (@data){ - if (/^Controller\s\/dev\/usb([0-9]+)/){ - # $j = scalar @usb; - ($j,$ports) = (0,0); - $port_value = ''; + 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; - @working = (); } - elsif (/^addr\s([0-9]+):\s([^,]+),[^,]+,[^,]+,\s?([^,]+)\(0x([0-9a-f]{4})\),\s?([^,]+)\s?\(0x([0-9a-f]{4})\)/){ - $j = scalar @usb; - $k = $j; + 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 = $2; - $chip_id = "$4:$6"; - $name = main::remove_duplicates("$5 $3"); - #print "p1:$protocol\n"; + $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 = ''; - $working[0] = $bus_id; + version_data('bsd',\$speed_si,\$speed_iec,\$rev,\$mode); + $working[0] = $bus_id_alpha; $working[1] = $addr_id; - $working[2] = $path; + $working[2] = $path_id; $working[3] = ''; $working[4] = '09'; $working[5] = ''; $working[6] = ''; $working[7] = $chip_id; - $working[8] = $speed; + $working[8] = $rev; $working[9] = ''; - $working[10] = 0; + $working[10] = $ports; $working[13] = $name; $working[14] = 'Hub'; $working[15] = ''; $working[16] = ''; - $working[17] = ''; - $working[18] = ''; - $usb[$j] = ([@working],); - @working = (); - } - elsif (/^\s+port\s([0-9]+)\saddr\s([0-9]+):\s([^,]+),[^,]+,[^,]+,\s?([^,]+)\(0x([0-9a-f]{4})\),\s?([^,]+)\s?\(0x([0-9a-f]{4})\)/){ - $j = scalar @usb; + $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 = "$3"; - $chip_id = "$5:$7"; - $name = main::remove_duplicates("$6 $4"); - #print "p2:$protocol\n"; + $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"; - $working[0] = $bus_id; + $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] = ''; @@ -22947,81 +36902,169 @@ sub usbdevs_data { $working[5] = ''; $working[6] = ''; $working[7] = $chip_id; - $working[8] = $speed; + $working[8] = $rev; $working[9] = ''; - $working[10] = 0; + $working[10] = $ports; $working[11] = ''; $working[12] = ''; $working[13] = $name; - $working[14] = ''; + $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] = ''; - $usb[$j] = ([@working],); - $usb[$k]->[10] = $ports; - @working = (); - } - elsif (/^\s+port\s([0-9]+)\spowered/){ + $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++; - $usb[$k]->[10] = $ports; } } - if (@working){ - $j = scalar @usb; - $usb[$j] = ( - [@working], - ); - } - main::log_data('dump','@usb: usbdevs',\@usb) if $b_log; - print Data::Dumper::Dumper \@usb if $test[6]; + 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 data_grabber { +sub usb_grabber { eval $start if $b_log; my ($program) = @_; - my %args = ('lsusb' => '', 'usbdevs' => '-v'); - my (@data); - if ($b_live && !$b_fake_usbdevs){ - @data = main::grabber($alerts{$program}->{'path'} . " $args{$program} 2>/dev/null"); + 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 ($b_fake_usbdevs){ - $file = "$ENV{'HOME'}/bin/scripts/inxi/data/lsusb/bsd-usbdevs-v-1.txt"; + 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 = "$ENV{'HOME'}/bin/scripts/inxi/data/lsusb/mdmarmer-lsusb.txt"; + $file = "$fake_data_dir/usb/lsusb/mdmarmer-lsusb.txt"; } - @data = main::reader($file); + @data = main::reader($file,'strip'); } - #print Data::Dumper::Dumper \@data; + 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 @data; + return @working; } sub sys_data { eval $start if $b_log; my ($source) = @_; - my ($configuration,$ports,$usb_version); + 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 (@files){ - @uevent = main::reader("$_/uevent") if -r "$_/uevent"; - $ids = main::awk(\@uevent,'^(DEVNAME|DEVICE\b)',2,'='); - if ( $ids){ - @drivers = (); + # 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); - ($configuration,$driver,$interfaces,$name,$ports,$product,$serial,$speed, - $type,$usb_version,$vendor) = ('','','','','','','','','','',''); - #print Cwd::abs_path($_),"\n"; - #print "f1: $_\n"; - $path_id = $_; + (@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 @@ -23032,63 +37075,82 @@ sub sys_data { $bus_id_alpha = bus_id_alpha($path_id); $device_id = int($working[3]); # this will be a hex number - $class_id = sys_item("$_/bDeviceClass"); - # $subclass_id = sys_item("$_/bDeviceSubClass"); + $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("$_/[0-9]*/uevent"); - push(@drivers, uevent_data("$_/[0-9]*/*/uevent")) if !$b_hub; - $ports = sys_item("$_/maxchild") if $b_hub; + @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("$_/bNumInterfaces"); - $serial = sys_item("$_/serial"); - $usb_version = sys_item("$_/version"); - $speed = sys_item("$_/speed"); - $configuration = sys_item("$_/configuration"); + $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; $i++){ - if ($usb[$i]->[0] eq $bus_id && $usb[$i]->[1] == $device_id){ - if (!$b_hub && $usb[$i]->[13] && (!$type || $type eq '<vendor specific>' )){ - $type = check_type($usb[$i]->[13],$driver,$type); + 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 '<vendor specific>')){ + $type = check_type($usb{'main'}->[$i][13],$driver,$type); } - #print $type,"\n"; - $usb[$i]->[0] = $bus_id_alpha; - $usb[$i]->[2] = $path_id; - $usb[$i]->[3] = $_; - $usb[$i]->[4] = $class_id; - $usb[$i]->[5] = $subclass_id; - $usb[$i]->[6] = $protocol_id; - $usb[$i]->[8] = $usb_version; - $usb[$i]->[9] = $interfaces; - $usb[$i]->[10] = $ports if $ports; - if ($type && $b_hub && (!$usb[$i]->[13] || $usb[$i]->[13] =~ /^linux foundation/i )){ - $usb[$i]->[13] = "$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[$i]->[14] = $type if ($type && !$b_hub); - $usb[$i]->[15] = $driver if $driver; - $usb[$i]->[16] = $serial if $serial; - $usb[$i]->[17] = $speed if $speed; - $usb[$i]->[18] = $configuration; - #print join("\n",@{$usb[$i]}),"\n\n";# if !$b_hub; + $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("$_/idProduct"); - $vendor_id = sys_item("$_/idVendor"); + $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("$_/product"); - $product = main::cleaner($product) if $product; - $vendor = sys_item("$_/manufacturer"); - $vendor = main::cleaner($vendor) if $vendor; - if (!$b_hub && ($product || $vendor )){ + $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"; } @@ -23103,44 +37165,52 @@ sub sys_data { $name = $type; } $name = main::remove_duplicates($name) if $name; - if (!$b_hub && $name && (!$type || $type eq '<vendor specific>' )){ + if (!$b_hub && $name && (!$type || $type eq '<vendor specific>')){ $type = check_type($name,$driver,$type); } # this isn't that useful, but save in case something shows up - #if ($configuration){ + # if ($configuration){ # $name = ($name) ? "$name $configuration" : $configuration; - #} + # } $type = 'Hub' if $b_hub; - $usb[$i]->[0] = $bus_id_alpha; - $usb[$i]->[1] = $device_id; - $usb[$i]->[2] = $path_id; - $usb[$i]->[3] = $_; - $usb[$i]->[4] = $class_id; - $usb[$i]->[5] = $subclass_id; - $usb[$i]->[6] = $protocol_id; - $usb[$i]->[7] = "$vendor_id:$chip_id"; - $usb[$i]->[8] = $usb_version; - $usb[$i]->[9] = $interfaces; - $usb[$i]->[10] = $ports; - $usb[$i]->[11] = $vendor; - $usb[$i]->[12] = $product; - $usb[$i]->[13] = $name; - $usb[$i]->[14] = $type; - $usb[$i]->[15] = $driver; - $usb[$i]->[16] = $serial; - $usb[$i]->[17] = $speed; - $usb[$i]->[18] = $configuration; + $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 $test[6];; + # print "$path_id ids: $bus_id:$device_id driver: $driver ports: $ports\n==========\n"; # if $dbg[6];; } } - @usb = sort { $a->[0] cmp $b->[0] } @usb; - print Data::Dumper::Dumper \@usb if $source eq 'main' && $test[6]; - main::log_data('dump','@usb: sys',\@usb) if $source eq 'main' && $b_log; + 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 + +# Get driver, interface [type:] data sub uevent_data { my ($path) = @_; my ($interface,$interfaces,$temp,@interfaces,@drivers); @@ -23151,18 +37221,24 @@ sub uevent_data { # print "f2: $_\n"; ($interface) = (''); @working = main::reader($_) if -r $_; - #print join("\n",@working), "\n"; + # print join("\n",@working), "\n"; if (@working){ $driver = main::awk(\@working,'^DRIVER',2,'='); - $interface = main::awk(\@working,'^INTERFACE',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 '<vendor specific>'){ push(@interfaces, $interface); } # networking requires more data but this test is reliable - elsif (!@interfaces) { + elsif (!@interfaces){ $temp = $_; $temp =~ s/\/uevent$//; push(@interfaces, 'Network') if -d "$temp/net/"; @@ -23173,7 +37249,7 @@ sub uevent_data { } } } - #print "driver:$driver\n"; + # 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; @@ -23189,6 +37265,7 @@ sub uevent_data { } return @drivers; } + sub sys_item { my ($path) = @_; my ($item); @@ -23198,310 +37275,618 @@ sub sys_item { return $item; } +sub assign_usb_type { + my ($row) = @_; + # It's a hub. A device will always be the second or > 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 '<vendor specific>';} + # print @types,"\n"; + if (!@types || $types[0] eq '0' || scalar @types != 3){return '';} + elsif ($types[0] eq '255'){ return '<vendor specific>';} if (scalar @types == 3){ $class_id = $types[0]; $subclass_id = $types[1]; $protocol_id = $types[2]; } - if ($types[0] eq '1'){$type = 'Audio';} + 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';} + 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';} + 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';} - } - 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';} + 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';} + 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';} + 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 <vendor specific> if not detected + +# Device name/driver string based test, return <vendor specific> if not detected +# for linux based tests, and empty for bsd tests sub check_type { my ($name,$driver,$type) = @_; $name = lc($name); - # ntoe used but if we want to add in bsd usb audio support could be good - if ($name =~ /(audio|hifi|sound)/){ + 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 =~ /btusb/) || $name =~ /(bluetooth)/){ - $type = 'Bluetooth'; + elsif (($driver && $driver =~ /\b(btusb|ubt)\b/) || $name =~ /(bluetooth)/){ + $type = 'Bluetooth' } - elsif (($driver && $driver =~ /uvcvideo/) || $name =~ /(display|video|camera)/){ + elsif (($driver && $driver =~ /video/) || + $name =~ /(camera|display|\bdvb-t|\b(pc)?tv\bvideo|webcam)/){ $type = 'Video'; } - # ethernet/wifi test not needed because NetworkData runs its own tests on the data + 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; } -# this is used to create an alpha sortable bus id for main $usb[0] + +# 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 LINES +#### GENERATE OUTPUT ######################################################################## -#### ------------------------------------------------------------------- -#### LINE CONTROLLERS -#### ------------------------------------------------------------------- - -sub assign_data { - my ($row) = @_; - return if ! %$row; - if ($output_type eq 'screen'){ - print_data($row); - } - else { - %rows = (%rows,%$row); - } -} +## OutputGenerator +# Also creates Short, Info, and System items +{ +package OutputGenerator; +my ($items,$subs); -sub generate_lines { +sub generate { eval $start if $b_log; - my (%row,$b_pci_check,$b_dmi_check); - set_ps_aux() if ! @ps_aux; - set_sysctl_data() if $b_sysctl; + my ($item,%checks); + PsData::set_cmd() if !$loaded{'ps-cmd'}; + 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){ - # I don't think we need to see this, it's long, but leave in case we do - #main::log_data('dump','@ps_aux',\@ps_aux); - log_data('dump','@ps_cmd',\@ps_cmd); + # With logging, we already get ps wwwaux so no need to get it again here + # main::log_data('dump','@ps_aux',\@ps_aux); + main::log_data('dump','@ps_cmd',\@ps_cmd); } - if ( $show{'short'} ){ - set_dmesg_boot_data() if ($bsd_type && !$b_dmesg_boot_check); - %row = generate_short_data(); - assign_data(\%row); + print Data::Dumper::Dumper \@ps_cmd if $dbg[61]; + if ($show{'short'}){ + $item = short_output(); + assign_data($item); } else { - if ( $show{'system'} ){ - %row = generate_system_data(); - assign_data(\%row); - } - if ( $show{'machine'} ){ - set_dmi_data($b_dmi_check) if $b_dmi && !$b_dmi_check; - set_dmesg_boot_data() if ($bsd_type && !$b_dmesg_boot_check); - %row = line_handler('Machine','machine'); - assign_data(\%row); - } - if ( $show{'battery'} ){ - set_dmi_data($b_dmi_check) if $b_dmi && !$b_dmi_check; - %row = line_handler('Battery','battery'); - if (%row || $show{'battery-forced'}){ - assign_data(\%row); - } - } - if ( $show{'ram'} ){ - set_dmi_data($b_dmi_check) if $b_dmi && !$b_dmi_check; - %row = line_handler('Memory','ram'); - assign_data(\%row); - } - if ( $show{'slot'} ){ - set_dmi_data($b_dmi_check) if $b_dmi && !$b_dmi_check; - %row = line_handler('PCI Slots','slot'); - assign_data(\%row); - } - if ( $show{'cpu'} || $show{'cpu-basic'} ){ - DeviceData::set($b_pci_check) if $b_arm && !$b_pci_check; - set_dmi_data($b_dmi_check) if $b_dmi && !$b_dmi_check; - set_dmesg_boot_data() if ($bsd_type && !$b_dmesg_boot_check); + 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' ; - %row = line_handler('CPU','cpu',$arg); - assign_data(\%row); - } - if ( $show{'graphic'} ){ - USBData::set() if !$b_usb_check; - DeviceData::set($b_pci_check) if !$b_pci_check; - %row = line_handler('Graphics','graphic'); - assign_data(\%row); - } - if ( $show{'audio'} ){ - # Note: USBData is set internally in AudioData because it's only run in one case - DeviceData::set($b_pci_check) if !$b_pci_check; - %row = line_handler('Audio','audio'); - assign_data(\%row); - } - if ( $show{'network'} ){ - USBData::set() if !$b_usb_check; - DeviceData::set($b_pci_check) if !$b_pci_check; - set_ip_data() if ($show{'ip'} || ($bsd_type && $show{'network-advanced'})); - %row = line_handler('Network','network'); - assign_data(\%row); - } - if ( $show{'bluetooth'} ){ - USBData::set() if !$b_usb_check; - DeviceData::set($b_pci_check) if !$b_pci_check; - %row = line_handler('Bluetooth','bluetooth'); - assign_data(\%row); - } - if ( $show{'logical'} ){ - %row = line_handler('Logical','logical'); - assign_data(\%row); - } - if ( $show{'raid'} ){ - DeviceData::set() if !$b_pci_check; - %row = line_handler('RAID','raid'); - assign_data(\%row); - } - if ( $show{'disk'} || $show{'disk-basic'} || $show{'disk-total'} || $show{'optical'} ){ - set_dmesg_boot_data() if ($bsd_type && !$b_dmesg_boot_check); - %row = line_handler('Drives','disk'); - assign_data(\%row); - } - if ( $show{'partition'} || $show{'partition-full'}){ - %row = line_handler('Partition','partition'); - assign_data(\%row); - } - if ( $show{'swap'} ){ - %row = line_handler('Swap','swap'); - assign_data(\%row); - } - if ( $show{'unmounted'} ){ - %row = line_handler('Unmounted','unmounted'); - assign_data(\%row); - } - if ( $show{'usb'} ){ - USBData::set() if !$b_usb_check; - %row = line_handler('USB','usb'); - assign_data(\%row); - } - if ( $show{'sensor'} ){ - %row = line_handler('Sensors','sensor'); - assign_data(\%row); - } - if ( $show{'repo'} ){ - %row = line_handler('Repos','repo'); - assign_data(\%row); - } - if ( $show{'process'} ){ - %row = line_handler('Processes','process'); - assign_data(\%row); - } - if ( $show{'weather'} ){ - %row = line_handler('Weather','weather'); - assign_data(\%row); - } - if ( $show{'info'} ){ - %row = generate_info_data(); - assign_data(\%row); - } - } - if ( $output_type ne 'screen' ){ - output_handler(\%rows); - } - eval $end if $b_log; -} - -sub line_handler { - eval $start if $b_log; - my ($key,$sub,$arg) = @_; - my %subs = ( - 'audio' => \&AudioData::get, - 'battery' => \&BatteryData::get, - 'bluetooth' => \&BluetoothData::get, - 'cpu' => \&CpuData::get, - 'disk' => \&DiskData::get, - 'graphic' => \&GraphicData::get, - 'logical' => \&LogicalData::get, - 'machine' => \&MachineData::get, - 'network' => \&NetworkData::get, - 'partition' => \&PartitionData::get, - 'raid' => \&RaidData::get, - 'ram' => \&RamData::get, - 'repo' => \&RepoData::get, - 'process' => \&ProcessData::get, - 'sensor' => \&SensorData::get, - 'slot' => \&SlotData::get, - 'swap' => \&SwapData::get, - 'unmounted' => \&UnmountedData::get, - 'usb' => \&UsbData::get, - 'weather' => \&WeatherData::get, - ); - my (%data); - my $data_name = main::key($prefix++,1,0,$key); - my @rows = $subs{$sub}->($arg); - if (@rows){ - %data = ($data_name => \@rows,); + $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; - return %data; } -#### ------------------------------------------------------------------- -#### SHORT, DEBUG -#### ------------------------------------------------------------------- - -sub generate_short_data { +## Short, Info, System Items ## +sub short_output { eval $start if $b_log; my $num = 0; my $kernel_os = ($bsd_type) ? 'OS' : 'Kernel'; - get_shell_data($client{'ppid'}) if $client{'ppid'}; - my $client = $client{'name-print'}; - my $client_shell = ($b_irc) ? 'Client' : 'Shell'; - if ($client{'version'}){ - $client .= ' ' . $client{'version'}; - } my ($cpu_string,$speed,$speed_key,$type) = ('','','speed',''); - my $memory = get_memory_data('string'); - my @cpu = CpuData::get('short'); - if (scalar @cpu > 1){ - $type = ($cpu[2]) ? " (-$cpu[2]-)" : ''; + 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]"; - $cpu[4] =~ s/ MHz//; - $speed = "$cpu[4]/$cpu[6]"; + if ($cpu->[6]){ + $speed_key = "$cpu->[3]/$cpu->[5]"; + $speed = "$cpu->[4]/$cpu->[6] MHz"; } else { - $speed_key = $cpu[3]; - $speed = $cpu[4]; + $speed_key = $cpu->[3]; + $speed = "$cpu->[4] MHz"; } - $cpu[1] ||= row_defaults('cpu-model-null'); - $cpu_string = $cpu[0] . ' ' . $cpu[1] . $type; + $cpu->[1] ||= main::message('cpu-model-null'); + $cpu_string = $cpu->[0] . ' ' . $cpu->[1] . $type; } - elsif ($bsd_type) { + elsif ($bsd_type){ if ($alerts{'sysctl'}->{'action'}){ if ($alerts{'sysctl'}->{'action'} ne 'use'){ $cpu_string = "sysctl $alerts{'sysctl'}->{'action'}"; @@ -23513,22 +37898,23 @@ sub generate_short_data { } } } - my @disk = DiskData::get('short'); + $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 (@disk){ - $size = ($disk[0]->{'logical-size'}) ? $disk[0]->{'logical-size'} : $disk[0]->{'size'}; + if (ref $disk eq 'ARRAY' && @$disk){ + $size = ($disk->[0]{'logical-size'}) ? $disk->[0]{'logical-size'} : $disk->[0]{'size'}; # must be > 0 - if ($size && is_numeric($size) ){ + if ($size && main::is_numeric($size)){ $size_holder = $size; - $size = get_size($size,'string'); + $size = main::get_size($size,'string'); } - $used = $disk[0]->{'used'}; - if ($used && is_numeric($disk[0]->{'used'}) ){ - $used_holder = $disk[0]->{'used'}; - $used = get_size($used,'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){ @@ -23536,281 +37922,461 @@ sub generate_short_data { $disk_string = "$size$percent"; } else { - $size ||= row_defaults('disk-size-0'); + $size ||= main::message('disk-size-0'); $disk_string = "$used/$size"; } } - #print join('; ', @cpu), " sleep: $cpu_sleep\n"; - $memory ||= 'N/A'; - 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) => &get_kernel_data(), - main::key($num++,0,0,'Up') => &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) => &get_self_version(), - },); - my %row = ( - main::key($prefix,1,0,'SHORT') => [(@data),], - ); - eval $end if $b_log; - return %row; + 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, + }; } -#### ------------------------------------------------------------------- -#### CONSTRUCTED LINES -#### ------------------------------------------------------------------- - -sub generate_info_data { +sub info_item { eval $start if $b_log; my $num = 0; - my $gcc_alt = ''; my $running_in = ''; my $data_name = main::key($prefix++,1,0,'Info'); - my ($b_gcc,$gcc,$index); - my ($gpu_ram,$parent,$percent,$total,$used) = (0,'','','',''); - my @gccs = get_gcc_data(); - if (@gccs){ - $gcc = shift @gccs; - if ($extra > 1 && @gccs){ - $gcc_alt = join('/', @gccs); - } - $b_gcc = 1; - } - $gcc ||= 'N/A'; - get_shell_data($client{'ppid'}) if $client{'ppid'}; - my $client_shell = ($b_irc) ? 'Client' : 'Shell'; - my $client = $client{'name-print'}; - my %data = ( - $data_name => [{ - main::key($num++,0,1,'Processes') => scalar @ps_aux, - main::key($num++,1,1,'Uptime') => &get_uptime(), - },], - ); - $index = scalar(@{ $data{$data_name} } ) - 1; - if ($extra > 2){ - my $wakeups = get_wakeups(); - $data{$data_name}->[$index]{main::key($num++,0,2,'wakeups')} = $wakeups if defined $wakeups; - } - if (!$b_mem){ - my $memory = get_memory_data('splits'); - if ($memory){ - my @temp = split(':', $memory); - $gpu_ram = $temp[3] if $temp[3]; - $total = ($temp[0]) ? get_size($temp[0],'string') : 'N/A'; - $used = ($temp[1]) ? get_size($temp[1],'string') : 'N/A'; - $used .= " ($temp[2]%)" if $temp[2]; - if ($gpu_ram){ - $gpu_ram = get_size($gpu_ram,'string'); + 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; } } - $data{$data_name}->[$index]{main::key($num++,1,1,'Memory')} = $total; - $data{$data_name}->[$index]{main::key($num++,0,2,'used')} = $used; - } - if ($gpu_ram){ - $data{$data_name}->[$index]{main::key($num++,0,2,'gpu')} = $gpu_ram; } - if ( (!$b_display || $b_force_display) || $extra > 0 ){ - my %init = get_init_data(); - 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 ((!$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->{'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'}){ - $data{$data_name}->[$index]{main::key($num++,0,2,'runlevel')} = $init{'runlevel'}; + 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'}){ - my $default = ($init{'init-type'} eq 'systemd' && $init{'default'} =~ /[^0-9]$/ ) ? 'target' : 'default'; - $data{$data_name}->[$index]{main::key($num++,0,2,$default)} = $init{'default'}; + 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; } } } - if ($extra > 0 ){ - my $b_clang; - my $clang_version = ''; - if (my $path = check_program('clang')){ - $clang_version = program_version($path,'clang',3,'--version'); - $clang_version ||= 'N/A'; - $b_clang = 1; + $index++ if $extra > 0; + if ($extra > 0 && !$loaded{'package-data'}){ + my $packages = PackageData::get('inner',\$num); + + for (keys %$packages){ + $data->{$data_name}[$index]{$_} = $packages->{$_}; } - my $compiler = ($b_gcc || $b_clang) ? '': 'N/A'; - $data{$data_name}->[$index]{main::key($num++,1,1,'Compilers')} = $compiler; - if ($b_gcc){ - $data{$data_name}->[$index]{main::key($num++,1,2,'gcc')} = $gcc; - if ( $extra > 1 && $gcc_alt){ - $data{$data_name}->[$index]{main::key($num++,0,3,'alt')} = $gcc_alt; + } + 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 } } - if ($b_clang){ - $data{$data_name}->[$index]{main::key($num++,0,2,'clang')} = $clang_version; + 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'}; + } + } } } - if ($extra > 0 && !$b_pkg){ - my %packages = PackageData::get('inner',\$num); - for (keys %packages){ - $data{$data_name}->[$index]{$_} = $packages{$_}; - } - $b_pkg = 1; + # $index++ if $extra > 1 && !$loaded{'shell-data'}; + if (!$loaded{'shell-data'} && $ppid && (!$b_irc || !$client{'name-print'})){ + ShellData::set(); } - if (!$b_irc && $extra > 1 ){ - # bsds don't support -f option to get PPID - if (($b_display && !$b_force_display) && !$bsd_type){ - $parent = get_shell_source(); + 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 { - $parent = get_tty_number(); - $parent = "tty $parent" if $parent ne ''; - } - if ($parent eq 'login'){ - $client{'su-start'} = $parent if !$client{'su-start'}; - $parent = undef; + 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 defined $parent; - if ($extra > 2 && $running_in && get_ssh_status() ){ + $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'})"; + } } - if ($extra > 2 && $client{'su-start'}){ - $client .= " ($client{'su-start'})"; - } - $data{$data_name}->[$index]{main::key($num++,1,1,$client_shell)} = $client; + $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 ($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'}; + $data->{$data_name}[$index]{main::key($num++,0,2,'v')} = $client{'version'}; } - if ( $running_in ){ - $data{$data_name}->[$index]{main::key($num++,0,2,'running in')} = $running_in; + 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)} = &get_self_version(); - + $data->{$data_name}[$index]{main::key($num++,0,1,$self_name)} = main::get_self_version(); eval $end if $b_log; - return %data; + return $data; } -sub generate_system_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_info,$desktop_key,$dm_key,$toolkit,$wm) = ('','','Desktop','dm','',''); - my (@desktop_data,$desktop_version); - - my %data = ( + 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 = scalar(@{ $data{$data_name} } ) - 1; + }; + $index = 0; if ($show{'host'}){ - $data{$data_name}->[$index]{main::key($num++,0,1,'Host')} = get_hostname(); - } - $data{$data_name}->[$index]{main::key($num++,1,1,'Kernel')} = get_kernel_data(); - $data{$data_name}->[$index]{main::key($num++,0,2,'bits')} = get_kernel_bits(); + $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 = get_compiler_version(); # get compiler data - if (scalar @compiler != 2){ - @compiler = ('N/A', ''); + 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]; + $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 ($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 = get_kernel_parameters())){ - $index = scalar(@{ $data{$data_name} } ); - #print "$params\n"; - $params = apply_partition_filter('system', $params, 'label') if $use{'filter-label'}; - $params = apply_partition_filter('system', $params, 'uuid') if $use{'filter-uuid'}; - $data{$data_name}->[$index]{main::key($num++,0,2,'parameters')} = $params; - $index = scalar(@{ $data{$data_name} } ); + if ($b_admin && (my $params = KernelParameters::get())){ + # print "$params\n"; + if ($use{'filter-label'}){ + $params = main::filter_partition('system', $params, 'label'); + } + if ($use{'filter-uuid'}){ + $params = main::filter_partition('system', $params, 'uuid'); + } + $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 = DesktopEnvironment::get(); - $desktop = $desktop_data[0] if $desktop_data[0]; - $desktop_version = $desktop_data[1] if $desktop_data[1]; - $desktop .= ' ' . $desktop_version if $desktop_version; - if ($extra > 0 && $desktop_data[3]){ - #$desktop .= ' (' . $desktop_data[2]; - #$desktop .= ( $desktop_data[3] ) ? ' ' . $desktop_data[3] . ')' : ')'; - $toolkit = "$desktop_data[2] $desktop_data[3]"; - } - if ($extra > 2 && $desktop_data[4]){ - $desktop_info = $desktop_data[4]; + 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 .= ' ' . $desktop_data[6] if $extra > 2 && $desktop_data[6]; + 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)) { - my $tty = get_tty_number(); + if (!$b_display || (!$desktop && $b_root)){ + ShellData::tty_number() if !$loaded{'tty-number'}; + my $tty = $client{'tty-number'}; if (!$desktop){ - $desktop_info = ''; + $de_components = ''; } # it is defined, as '' - if ( $tty eq '' && $client{'console-irc'}){ - $tty = get_tty_console_irc('vtnr'); + 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 = "tty $tty" if $tty ne ''; $desktop_key = 'Console'; - $dm_key = 'DM'; $ind_dm = 1; $cont_desk = 0; } - $desktop ||= 'N/A'; - $data{$data_name}->[$index]{main::key($num++,$cont_desk,1,$desktop_key)} = $desktop; - if ($toolkit){ - $data{$data_name}->[$index]{main::key($num++,0,2,'tk')} = $toolkit; + else { + $dm_key = lc($dm_key); } - if ($extra > 2){ - if ($desktop_info){ - $data{$data_name}->[$index]{main::key($num++,0,2,'info')} = $desktop_info; + $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){ - $data{$data_name}->[$index]{main::key($num++,0,2,'wm')} = $wm if $wm; - my $dms = get_display_manager(); - if ($dms || $desktop_key ne 'Console'){ - $dms ||= 'N/A'; - $data{$data_name}->[$index]{main::key($num++,0,$ind_dm,$dm_key)} = $dms; + # 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 = get_tty_number(); - # $data{$data_name}->[$index]{main::key($num++,0,1,'vc')} = $tty if $tty ne ''; - #} + # 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_data = DistroData::get(); - my $distro = $distro_data[0]; - $distro ||= 'N/A'; - $data{$data_name}->[$index]{main::key($num++,1,1,$distro_key)} = $distro; - if ($extra > 0 && $distro_data[1]){ - $data{$data_name}->[$index]{main::key($num++,0,2,'base')} = $distro_data[1]; + 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; + 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, + }; +} } ####################################################################### @@ -23819,5 +38385,5 @@ sub generate_system_data { main(); ## From the End comes the Beginning -## note: this EOF is needed for smxi handling, this is what triggers the full download ok +## note: this EOF is needed for self updater, triggers the full download ok ###**EOF**### |