mirror of
https://github.com/smxi/inxi.git
synced 2024-11-16 16:21:39 +00:00
36684 lines
1.2 MiB
Executable file
36684 lines
1.2 MiB
Executable file
#!/usr/bin/env perl
|
|
## infobash: Copyright (C) 2005-2007 Michiel de Boer aka locsmif
|
|
## inxi: Copyright (C) 2008-2023 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 without /sys machine
|
|
##
|
|
## License: GNU GPL v3 or greater
|
|
##
|
|
## You should have received a copy of the GNU General Public License
|
|
## along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
##
|
|
## If you don't understand what Free Software is, please read (or reread)
|
|
## this page: http://www.gnu.org/philosophy/free-sw.html
|
|
##
|
|
## DEVS: NOTE: geany/scite folding is picky. Leave 1 space after # or it breaks!
|
|
|
|
use strict;
|
|
use warnings;
|
|
# use diagnostics;
|
|
use 5.008;
|
|
|
|
## Perl 7 things for testing: depend on Perl 5.032
|
|
# use 5.034;
|
|
# use compat::perl5; # act like Perl 5's defaults
|
|
# no feature qw(indirect);
|
|
# no multidimensional;
|
|
# no bareword::filehandles;
|
|
|
|
use Cwd qw(abs_path); # #abs_path realpath getcwd
|
|
use Data::Dumper qw(Dumper); # print_r
|
|
$Data::Dumper::Sortkeys = 1;
|
|
# NOTE: load in SystemDebugger unless encounter issues with require/import
|
|
# use File::Find;
|
|
use File::stat; # needed for Xorg.0.log file mtime comparisons
|
|
use Getopt::Long qw(GetOptions);
|
|
# Note: default auto_abbrev is enabled
|
|
Getopt::Long::Configure ('bundling', 'no_ignore_case',
|
|
'no_getopt_compat', 'no_auto_abbrev','pass_through');
|
|
use POSIX qw(ceil uname strftime ttyname);
|
|
# use bigint qw/hex/; # to handle large hex number warnings, but Perl 5.010 and later.
|
|
# use Benchmark qw(:all);_
|
|
# use Devel::Size qw(size total_size);
|
|
# use feature qw(say state); # 5.10 or newer Perl
|
|
|
|
### INITIALIZE VARIABLES ###
|
|
|
|
## INXI INFO ##
|
|
my $self_name='inxi';
|
|
my $self_version='3.3.31';
|
|
my $self_date='2023-10-31';
|
|
my $self_patch='00';
|
|
## END INXI INFO ##
|
|
|
|
my ($b_pledge,@pledges);
|
|
if (eval {require OpenBSD::Pledge}){
|
|
OpenBSD::Pledge->import();
|
|
$b_pledge = 1;
|
|
# cpath/wpath: dir/files .inxi, --debug > 9, -c 9x, -w/W;
|
|
# dns/inet: ftp upload --debug > 20; exec/proc/rpath: critical;
|
|
# prot_exec: Perl import; getpw: perl getpwuid() -c 9x, Net::FTP --debug > 20;
|
|
# stdio: default; error: debugging pledge/perl
|
|
# tested. not required: mcast pf ps recvfd sendfd tmppath tty unix vminfo;
|
|
# Pledge removal: OptionsHandler::post_process() [dns,inet,cpath,getpw,wpath];
|
|
# SelectColors::set_selection() [getpw]
|
|
@pledges = qw(cpath dns exec getpw inet proc prot_exec rpath wpath);
|
|
pledge(@pledges);
|
|
}
|
|
|
|
## Self data
|
|
my ($fake_data_dir,$self_path,$user_config_dir,$user_config_file,$user_data_dir);
|
|
|
|
## Hashes
|
|
my (%alerts,%build_prop,%client,%colors,,%cpuinfo_machine,%disks_bsd,
|
|
%dboot,%devices,%dl,%dmmapper,%force,%loaded,%mapper,%program_values,%risc,
|
|
%service_tool,%show,%sysctl,%system_files,%usb,%windows);
|
|
|
|
## System Arrays
|
|
my (@app,@cpuinfo,@dmi,@ifs,@ifs_bsd,@paths,@ps_aux,@ps_cmd,@ps_gui,
|
|
@sensors_exclude,@sensors_use,@uname);
|
|
|
|
## Disk/Logical/Partition/RAID arrays
|
|
my (@btrfs_raid,@glabel,@labels,@lsblk,@lvm,@lvm_raid,@md_raid,@partitions,
|
|
@proc_partitions,@raw_logical,@soft_raid,@swaps,@uuids,@zfs_raid);
|
|
|
|
## Debuggers
|
|
my %debugger = ('level' => 0);
|
|
my (@dbg,%fake,@t0);
|
|
my ($b_hires,$b_log,$b_log_colors,$b_log_full);
|
|
my ($end,$start,$fh_l,$log_file); # log file handle, file
|
|
my ($t1,$t2,$t3) = (0,0,0); # timers
|
|
## debug / temp tools
|
|
$debugger{'sys'} = 1;
|
|
$client{'test-konvi'} = 0;
|
|
|
|
# NOTE: redhat removed HiRes from Perl Core Modules.
|
|
if (eval {require Time::HiRes}){
|
|
Time::HiRes->import('gettimeofday','tv_interval','usleep');
|
|
$b_hires = 1;
|
|
}
|
|
@t0 = eval 'Time::HiRes::gettimeofday()' if $b_hires; # let's start it right away
|
|
|
|
## Booleans [busybox_ps not used actively]
|
|
my ($b_admin,$b_android,$b_busybox_ps,$b_display,$b_irc,$b_root);
|
|
|
|
## System
|
|
my ($bsd_type,$device_vm,$language,$os,$pci_tool) = ('','','','','');
|
|
my ($wan_url,$wl_compositors) = ('','');
|
|
my ($bits_sys,$cpu_arch,$ppid);
|
|
my ($cpu_sleep,$dl_timeout,$limit,$ps_cols,$ps_count) = (0.35,4,10,0,5);
|
|
my $sensors_cpu_nu = 0;
|
|
my ($weather_source,$weather_unit) = (100,'mi');
|
|
|
|
## Tools
|
|
my ($display,$ftp_alt);
|
|
my ($display_opt,$sudoas) = ('','');
|
|
|
|
## Output
|
|
my $extra = 0;# supported values: 0-3
|
|
my $filter_string = '<filter>';
|
|
my $line1 = "----------------------------------------------------------------------\n";
|
|
my $line2 = "======================================================================\n";
|
|
my $line3 = "----------------------------------------\n";
|
|
my ($output_file,$output_type) = ('','screen');
|
|
my $prefix = 0; # for the primary row hash key prefix
|
|
|
|
## Initialize internal hashes
|
|
# these assign a separator to non irc states. Important! Using ':' can
|
|
# trigger stupid emoticon. Note: SEP1/SEP2 from short form not used anymore.
|
|
# behaviors in output on IRC, so do not use those.
|
|
my %sep = (
|
|
's1-irc' => ':',
|
|
's1-console' => ':',
|
|
's2-irc' => '',
|
|
's2-console' => ':',
|
|
);
|
|
#$show{'host'} = 1;
|
|
my %size = (
|
|
'console' => 80, # In display, orig: 115
|
|
# Default indentation level. NOTE: actual indent is 1 greater to allow for
|
|
# spacing
|
|
'indent' => 11,
|
|
'indents' => 2,
|
|
'irc' => 100, # shorter because IRC clients have nick lists etc
|
|
'lines' => 1, # for active output line counter for -Y
|
|
'max-cols' => 0,
|
|
'max-lines' => 0,
|
|
'max-wrap' => 110,
|
|
'no-display' => 100, # No Display, orig: 130
|
|
# this will be set dynamically in set_display_size()
|
|
'term-cols' => 80, # orig: 80
|
|
'term-lines' => 40, # orig: 100
|
|
);
|
|
my %use = (
|
|
'update' => 1, # switched off/on with maintainer config ALLOW_UPDATE
|
|
'weather' => 1, # switched off/on with maintainer config ALLOW_WEATHER
|
|
);
|
|
|
|
########################################################################
|
|
#### STARTUP
|
|
########################################################################
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### MAIN
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub main {
|
|
# print Dumper \@ARGV;
|
|
eval $start if $b_log;
|
|
initialize();
|
|
## Uncomment these two values for start client debugging
|
|
# $debugger{'level'} = 3; # 3 prints timers / 10 prints to log file
|
|
# set_debugger(); # for debugging of konvi and other start client issues
|
|
## legacy method
|
|
# my $ob_start = StartClient->new();
|
|
#$ob_start->get_client_data();
|
|
StartClient::set();
|
|
# print_line(Dumper \%client);
|
|
OptionsHandler::get();
|
|
set_debugger(); # right after so it's set
|
|
CheckTools::set();
|
|
set_colors();
|
|
set_sep();
|
|
# print download_file('stdout','https://') . "\n";
|
|
OutputGenerator::generate();
|
|
eval $end if $b_log;
|
|
cleanup();
|
|
# weechat's executor plugin forced me to do this, and rightfully so,
|
|
# because else the exit code from the last command is taken..
|
|
exit 0;
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### INITIALIZE
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub initialize {
|
|
set_path();
|
|
set_user_paths();
|
|
set_basics();
|
|
set_system_files();
|
|
set_os();
|
|
Configs::set();
|
|
# set_downloader();
|
|
set_display_size();
|
|
}
|
|
|
|
## CheckTools
|
|
{
|
|
package CheckTools;
|
|
my (%commands);
|
|
|
|
sub set {
|
|
eval $start if $b_log;
|
|
set_commands();
|
|
my ($action,$program,$message,@data);
|
|
foreach my $test (keys %commands){
|
|
($action,$program) = ('use','');
|
|
$message = main::message('tool-present');
|
|
if ($commands{$test}->[1] && (
|
|
($commands{$test}->[1] eq 'linux' && $os ne 'linux') ||
|
|
($commands{$test}->[1] eq 'bsd' && $os eq 'linux'))){
|
|
$action = 'platform';
|
|
}
|
|
elsif ($program = main::check_program($test)){
|
|
# > 0 means error in shell
|
|
# my $cmd = "$program $commands{$test} >/dev/null";
|
|
# print "$cmd\n";
|
|
$pci_tool = $test if $test =~ /pci/;
|
|
# this test is not ideal because other errors can make program fail, but
|
|
# we can't test for root since could be say, wheel permissions needed
|
|
if ($commands{$test}->[0] eq 'exec-sys'){
|
|
$action = 'permissions' if system("$program $commands{$test}->[2] >/dev/null 2>&1");
|
|
}
|
|
elsif ($commands{$test}->[0] eq 'exec-string'){
|
|
@data = main::grabber("$program $commands{$test}->[2] 2>&1");
|
|
# dmidecode errors are so specific it gets its own section
|
|
# also sets custom dmidecode error messages
|
|
if ($test eq 'dmidecode'){
|
|
$action = set_dmidecode(\@data) if scalar @data < 15;
|
|
}
|
|
elsif (grep { $_ =~ /$commands{$test}->[3]/i } @data){
|
|
$action = 'permissions';
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$action = 'missing';
|
|
}
|
|
$alerts{$test}->{'action'} = $action;
|
|
$alerts{$test}->{'path'} = $program;
|
|
if ($action eq 'missing'){
|
|
$alerts{$test}->{'message'} = main::message('tool-missing-recommends',"$test");
|
|
}
|
|
elsif ($action eq 'permissions'){
|
|
$alerts{$test}->{'message'} = main::message('tool-permissions',"$test");
|
|
}
|
|
elsif ($action eq 'platform'){
|
|
$alerts{$test}->{'message'} = main::message('tool-missing-os', $uname[0] . " $test");
|
|
}
|
|
}
|
|
print Data::Dumper::Dumper \%alerts if $dbg[25];
|
|
set_fake_bsd_tools() if $fake{'bsd'};
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_dmidecode {
|
|
my ($data) = @_;
|
|
my $action = 'use';
|
|
if ($b_root){
|
|
foreach (@$data){
|
|
# don't need first line or scanning /dev/mem lines
|
|
if (/^(# dmi|Scanning)/){
|
|
next;
|
|
}
|
|
elsif ($_ =~ /No SMBIOS/i){
|
|
$action = 'smbios';
|
|
last;
|
|
}
|
|
elsif ($_ =~ /^\/dev\/mem: Operation/i){
|
|
$action = 'no-data';
|
|
last;
|
|
}
|
|
else {
|
|
$action = 'unknown-error';
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
if (grep {$_ =~ /(^\/dev\/mem: Permission|Permission denied)/i } @$data){
|
|
$action = 'permissions';
|
|
}
|
|
else {
|
|
$action = 'unknown-error';
|
|
}
|
|
}
|
|
if ($action ne 'use' && $action ne 'permissions'){
|
|
if ($action eq 'smbios'){
|
|
$alerts{'dmidecode'}->{'message'} = main::message('dmidecode-smbios');
|
|
}
|
|
elsif ($action eq 'no-data'){
|
|
$alerts{'dmidecode'}->{'message'} = main::message('dmidecode-dev-mem');
|
|
}
|
|
elsif ($action eq 'unknown-error'){
|
|
$alerts{'dmidecode'}->{'message'} = main::message('tool-unknown-error','dmidecode');
|
|
}
|
|
}
|
|
return $action;
|
|
}
|
|
|
|
sub set_commands {
|
|
# note: gnu/linux has sysctl so it may be used that for something if present
|
|
# there is lspci for bsds so doesn't hurt to check it
|
|
if (!$bsd_type){
|
|
if ($use{'pci'}){
|
|
$commands{'lspci'} = ['exec-sys','','-n'];
|
|
}
|
|
if ($use{'logical'}){
|
|
$commands{'lvs'} = ['exec-sys','',''];
|
|
}
|
|
}
|
|
else {
|
|
if ($use{'pci'}){
|
|
$commands{'pciconf'} = ['exec-sys','','-l'];
|
|
$commands{'pcictl'} = ['exec-sys','',' pci0 list'];
|
|
$commands{'pcidump'} = ['exec-sys','',''];
|
|
}
|
|
if ($use{'sysctl'}){
|
|
# note: there is a case of kernel.osrelease but it's a linux distro
|
|
$commands{'sysctl'} = ['exec-sys','','kern.osrelease'];
|
|
}
|
|
if ($use{'bsd-partition'}){
|
|
$commands{'bioctl'} = ['missing','',''];
|
|
$commands{'disklabel'} = ['missing','',''];
|
|
$commands{'fdisk'} = ['missing','',''];
|
|
$commands{'gpart'} = ['missing','',''];
|
|
}
|
|
}
|
|
if ($use{'dmidecode'}){
|
|
$commands{'dmidecode'} = ['exec-string','','-t chassis -t baseboard -t processor',''];
|
|
}
|
|
if ($use{'usb'}){
|
|
# note: lsusb ships in FreeBSD ports sysutils/usbutils
|
|
$commands{'lsusb'} = ['missing','','',''];
|
|
# we want these set for various null bsd data tests
|
|
$commands{'usbconfig'} = ['exec-string','bsd','list','permissions'];
|
|
$commands{'usbdevs'} = ['missing','bsd','',''];
|
|
}
|
|
if ($show{'bluetooth'}){
|
|
$commands{'bluetoothctl'} = ['missing','linux','',''];
|
|
# bt-adapter hangs when bluetooth service is disabled
|
|
$commands{'bt-adapter'} = ['missing','linux','',''];
|
|
# btmgmt enters its own shell with no options given
|
|
$commands{'btmgmt'} = ['missing','linux','',''];
|
|
$commands{'hciconfig'} = ['missing','linux','',''];
|
|
}
|
|
if ($show{'sensor'}){
|
|
$commands{'sensors'} = ['missing','linux','',''];
|
|
}
|
|
if ($show{'ip'} || ($bsd_type && $show{'network-advanced'})){
|
|
$commands{'ip'} = ['missing','linux','',''];
|
|
$commands{'ifconfig'} = ['missing','','',''];
|
|
}
|
|
# can't check permissions since we need to know the partition/disc
|
|
if ($use{'block-tool'}){
|
|
$commands{'blockdev'} = ['missing','linux','',''];
|
|
$commands{'lsblk'} = ['missing','linux','',''];
|
|
}
|
|
if ($use{'btrfs'}){
|
|
$commands{'btrfs'} = ['missing','linux','',''];
|
|
}
|
|
if ($use{'mdadm'}){
|
|
$commands{'mdadm'} = ['missing','linux','',''];
|
|
}
|
|
if ($use{'smartctl'}){
|
|
$commands{'smartctl'} = ['missing','','',''];
|
|
}
|
|
if ($show{'unmounted'}){
|
|
$commands{'disklabel'} = ['missing','bsd','xx'];
|
|
}
|
|
}
|
|
|
|
# only for dev/debugging BSD
|
|
sub set_fake_bsd_tools {
|
|
$system_files{'dmesg-boot'} = '/var/run/dmesg.boot' if $fake{'dboot'};
|
|
$alerts{'sysctl'}->{'action'} = 'use' if $fake{'sysctl'};
|
|
if ($fake{'pciconf'} || $fake{'pcictl'} || $fake{'pcidump'}){
|
|
$alerts{'pciconf'}->{'action'} = 'use' if $fake{'pciconf'};
|
|
$alerts{'pcictl'}->{'action'} = 'use' if $fake{'pcictl'};
|
|
$alerts{'pcidump'}->{'action'} = 'use' if $fake{'pcidump'};
|
|
$alerts{'lspci'} = {
|
|
'action' => 'missing',
|
|
'message' => 'Required program lspci not available',
|
|
};
|
|
}
|
|
if ($fake{'usbconfig'} || $fake{'usbdevs'}){
|
|
$alerts{'usbconfig'}->{'action'} = 'use' if $fake{'usbconfig'};
|
|
$alerts{'usbdevs'}->{'action'} = 'use' if $fake{'usbdevs'};
|
|
$alerts{'lsusb'} = {
|
|
'action' => 'missing',
|
|
'message' => 'Required program lsusb not available',
|
|
};
|
|
}
|
|
if ($fake{'disklabel'}){
|
|
$alerts{'disklabel'}->{'action'} = 'use';
|
|
}
|
|
}
|
|
}
|
|
|
|
sub set_basics {
|
|
### LOCALIZATION - DO NOT CHANGE! ###
|
|
# set to default LANG to avoid locales errors with , or .
|
|
# Make sure every program speaks English.
|
|
$ENV{'LANG'}='C';
|
|
$ENV{'LC_ALL'}='C';
|
|
# remember, perl uses the opposite t/f return as shell!!!
|
|
# some versions of busybox do not have tty, like openwrt
|
|
$b_irc = (check_program('tty') && system('tty >/dev/null')) ? 1 : 0;
|
|
# print "birc: $b_irc\n";
|
|
$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;
|
|
$client{'console-irc'} = 0;
|
|
$client{'dcop'} = (check_program('dcop')) ? 1 : 0;
|
|
$client{'qdbus'} = (check_program('qdbus')) ? 1 : 0;
|
|
$client{'konvi'} = 0;
|
|
$client{'name'} = '';
|
|
$client{'name-print'} = '';
|
|
$client{'su-start'} = ''; # shows sudo/su
|
|
$client{'version'} = '';
|
|
$client{'whoami'} = getpwuid($<) || '';
|
|
$colors{'default'} = 2;
|
|
$show{'partition-sort'} = 'id'; # sort order for partitions
|
|
@raw_logical = (0,0,0);
|
|
$ppid = getppid();
|
|
}
|
|
|
|
sub set_display_size {
|
|
## sometimes tput will trigger an error (mageia) if irc client
|
|
if (!$b_irc){
|
|
if (my $program = check_program('tput')){
|
|
# Arch urxvt: 'tput: unknown terminal "rxvt-unicode-256color"'
|
|
# trips error if use qx(); in FreeBSD, if you use 2>/dev/null
|
|
# it makes default value 80x24, who knows why?
|
|
chomp($size{'term-cols'} = qx{$program cols});
|
|
chomp($size{'term-lines'} = qx{$program lines});
|
|
}
|
|
# print "tc: $size{'term-cols'} cmc: $size{'console'}\n";
|
|
# double check, just in case it's missing functionality or whatever
|
|
if (!is_int($size{'term-cols'} || $size{'term-cols'} == 0)){
|
|
$size{'term-cols'} = 80;
|
|
}
|
|
if (!is_int($size{'term-lines'} || $size{'term-lines'} == 0)){
|
|
$size{'term-lines'} = 24;
|
|
}
|
|
}
|
|
# this lets you set different size for in or out of display server
|
|
if (!$b_display && $size{'no-display'}){
|
|
$size{'console'} = $size{'no-display'};
|
|
}
|
|
# term_cols is set in top globals, using tput cols
|
|
# print "tc: $size{'term-cols'} cmc: $size{'console'}\n";
|
|
if ($size{'term-cols'} < $size{'console'}){
|
|
$size{'console'} = $size{'term-cols'};
|
|
}
|
|
# adjust, some terminals will wrap if output cols == term cols
|
|
$size{'console'} = ($size{'console'} - 1);
|
|
# echo cmc: $size{'console'}
|
|
# comes after source for user set stuff
|
|
if (!$b_irc){
|
|
$size{'max-cols'} = $size{'console'};
|
|
}
|
|
else {
|
|
$size{'max-cols'} = $size{'irc'};
|
|
}
|
|
# for -V/-h overrides
|
|
$size{'max-cols-basic'} = $size{'max-cols'};
|
|
# print "tc: $size{'term-cols'} cmc: $size{'console'} cm: $size{'max-cols'}\n";
|
|
}
|
|
|
|
sub set_os {
|
|
@uname = uname();
|
|
$os = lc($uname[0]);
|
|
$cpu_arch = lc($uname[-1]);
|
|
if ($cpu_arch =~ /arm|aarch/){
|
|
$risc{'arm'} = 1;
|
|
$risc{'id'} = 'arm';}
|
|
elsif ($cpu_arch =~ /mips/){
|
|
$risc{'mips'} = 1;
|
|
$risc{'id'} = 'mips';}
|
|
elsif ($cpu_arch =~ /power|ppc/){
|
|
$risc{'ppc'} = 1;
|
|
$risc{'id'} = 'ppc';}
|
|
elsif ($cpu_arch =~ /riscv/){
|
|
$risc{'riscv'} = 1;
|
|
$risc{'id'} = 'riscv';}
|
|
elsif ($cpu_arch =~ /(sparc|sun4[uv])/){
|
|
$risc{'sparc'} = 1;
|
|
$risc{'id'} = 'sparc';}
|
|
# aarch32 mips32, i386. centaur/via/intel/amd handled in cpu
|
|
if ($cpu_arch =~ /(armv[1-7]|32|[23456]86)/){
|
|
$bits_sys = 32;
|
|
}
|
|
elsif ($cpu_arch =~ /(alpha|64|e2k|sparc_v9|sun4[uv]|ultrasparc)/){
|
|
$bits_sys = 64;
|
|
# force to string e2k, and also in case we need that ID changed
|
|
$cpu_arch = 'elbrus' if $cpu_arch =~ /e2k|elbrus/;
|
|
}
|
|
# set some less common scenarios
|
|
if ($os =~ /cygwin/){
|
|
$windows{'cygwin'} = 1;
|
|
}
|
|
elsif (-e '/usr/lib/wsl/drivers'){
|
|
$windows{'wsl'} = 1;
|
|
}
|
|
elsif (-e '/system/build.prop'){
|
|
$b_android = 1;
|
|
}
|
|
if ($os =~ /(aix|bsd|cosix|dragonfly|darwin|hp-?ux|indiana|illumos|irix|sunos|solaris|ultrix|unix)/){
|
|
if ($os =~ /openbsd/){
|
|
$os = 'openbsd';
|
|
}
|
|
elsif ($os =~ /darwin/){
|
|
$os = 'darwin';
|
|
}
|
|
# NOTE: most tests internally are against !$bsd_type
|
|
if ($os =~ /kfreebsd/){
|
|
$bsd_type = 'debian-bsd';
|
|
}
|
|
else {
|
|
$bsd_type = $os;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Sometimes users will have more PATHs local to their setup, so we want those
|
|
# too.
|
|
sub set_path {
|
|
# Extra path variable to make execute failures less likely, merged below
|
|
my (@path);
|
|
# NOTE: recent Xorg's show error if you try /usr/bin/Xorg -version but work
|
|
# if you use the /usr/lib/xorg-server/Xorg path.
|
|
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 (-d $id && !(grep {/^$id$/} @paths) && $id !~ /(game)/){
|
|
push(@paths, $id);
|
|
}
|
|
}
|
|
# print "paths: \n", join("\n", @paths),"\n";
|
|
}
|
|
|
|
sub set_sep {
|
|
if ($b_irc){
|
|
# too hard to read if no colors, so force that for users on irc
|
|
if ($colors{'scheme'} == 0){
|
|
$sep{'s1'} = $sep{'s1-console'};
|
|
$sep{'s2'} = $sep{'s2-console'};
|
|
}
|
|
else {
|
|
$sep{'s1'} = $sep{'s1-irc'};
|
|
$sep{'s2'} = $sep{'s2-irc'};
|
|
}
|
|
}
|
|
else {
|
|
$sep{'s1'} = $sep{'s1-console'};
|
|
$sep{'s2'} = $sep{'s2-console'};
|
|
}
|
|
}
|
|
|
|
# Important: -n makes it non interactive, no prompt for password
|
|
# only use doas/sudo if not root, -n option requires sudo -V 1.7 or greater.
|
|
# for some reason sudo -n with < 1.7 in Perl does not print to stderr
|
|
# sudo will just error out which is the safest course here for now,
|
|
# otherwise that interactive sudo password thing is too annoying
|
|
sub set_sudo {
|
|
if (!$b_root){
|
|
my ($path);
|
|
if (!$force{'no-doas'} && ($path = check_program('doas'))){
|
|
$sudoas = "$path -n ";
|
|
}
|
|
elsif (!$force{'no-sudo'} && ($path = check_program('sudo'))){
|
|
my @data = program_data('sudo');
|
|
$data[1] =~ s/^([0-9]+\.[0-9]+).*/$1/;
|
|
# print "sudo v: $data[1]\n";
|
|
$sudoas = "$path -n " if is_numeric($data[1]) && $data[1] >= 1.7;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub set_system_files {
|
|
my %files = (
|
|
'asound-cards' => '/proc/asound/cards',
|
|
'asound-modules' => '/proc/asound/modules',
|
|
'asound-version' => '/proc/asound/version',
|
|
'dmesg-boot' => '/var/run/dmesg.boot',
|
|
'proc-cmdline' => '/proc/cmdline',
|
|
'proc-cpuinfo' => '/proc/cpuinfo',
|
|
'proc-mdstat' => '/proc/mdstat',
|
|
'proc-meminfo' => '/proc/meminfo',
|
|
'proc-modules' => '/proc/modules', # not used
|
|
'proc-mounts' => '/proc/mounts',# not used
|
|
'proc-partitions' => '/proc/partitions',
|
|
'proc-scsi' => '/proc/scsi/scsi',
|
|
'proc-version' => '/proc/version',
|
|
# note: 'xorg-log' is set in set_xorg_log() only if -G is triggered
|
|
);
|
|
foreach (keys %files){
|
|
$system_files{$_} = (-e $files{$_}) ? $files{$_} : '';
|
|
}
|
|
}
|
|
|
|
sub set_user_paths {
|
|
my ($b_conf,$b_data);
|
|
# this needs to be set here because various options call the parent
|
|
# initialize function directly.
|
|
$self_path = $0;
|
|
$self_path =~ s/[^\/]+$//;
|
|
# print "0: $0 sp: $self_path\n";
|
|
if (defined $ENV{'XDG_CONFIG_HOME'} && $ENV{'XDG_CONFIG_HOME'}){
|
|
$user_config_dir=$ENV{'XDG_CONFIG_HOME'};
|
|
$b_conf=1;
|
|
}
|
|
elsif (-d "$ENV{'HOME'}/.config"){
|
|
$user_config_dir="$ENV{'HOME'}/.config";
|
|
$b_conf=1;
|
|
}
|
|
else {
|
|
$user_config_dir="$ENV{'HOME'}/.$self_name";
|
|
}
|
|
if (defined $ENV{'XDG_DATA_HOME'} && $ENV{'XDG_DATA_HOME'}){
|
|
$user_data_dir="$ENV{'XDG_DATA_HOME'}/$self_name";
|
|
$b_data=1;
|
|
}
|
|
elsif (-d "$ENV{'HOME'}/.local/share"){
|
|
$user_data_dir="$ENV{'HOME'}/.local/share/$self_name";
|
|
$b_data=1;
|
|
}
|
|
else {
|
|
$user_data_dir="$ENV{'HOME'}/.$self_name";
|
|
}
|
|
# note, this used to be created/checked in specific instance, but we'll just
|
|
# do it universally so it's done at script start.
|
|
if (! -d $user_data_dir){
|
|
mkdir $user_data_dir;
|
|
# system "echo", "Made: $user_data_dir";
|
|
}
|
|
if ($b_conf && -f "$ENV{'HOME'}/.$self_name/$self_name.conf"){
|
|
# system 'mv', "-f $ENV{'HOME'}/.$self_name/$self_name.conf", $user_config_dir;
|
|
# print "WOULD: Moved $self_name.conf from $ENV{'HOME'}/.$self_name to $user_config_dir\n";
|
|
}
|
|
if ($b_data && -d "$ENV{'HOME'}/.$self_name"){
|
|
# system 'mv', '-f', "$ENV{'HOME'}/.$self_name/*", $user_data_dir;
|
|
# system 'rm', '-Rf', "$ENV{'HOME'}/.$self_name";
|
|
# print "WOULD: Moved data dir $ENV{'HOME'}/.$self_name to $user_data_dir\n";
|
|
}
|
|
$fake_data_dir = "$ENV{'HOME'}/bin/scripts/inxi/data";
|
|
$log_file="$user_data_dir/$self_name.log";
|
|
# system 'echo', "$ENV{'HOME'}/.$self_name/* $user_data_dir";
|
|
# print "scd: $user_config_dir sdd: $user_data_dir \n";
|
|
}
|
|
|
|
sub set_xorg_log {
|
|
eval $start if $b_log;
|
|
my (@temp,@x_logs);
|
|
my ($file_holder,$time_holder,$x_mtime) = ('',0,0);
|
|
# NOTE: other variations may be /var/run/gdm3/... but not confirmed
|
|
# worry about we are just going to get all the Xorg logs we can find,
|
|
# and not which is 'right'. Xorg was XFree86 earlier, only in /var/log.
|
|
@temp = globber('/var/log/{Xorg,XFree86}.*.log');
|
|
push(@x_logs, @temp) if @temp;
|
|
@temp = globber('/var/lib/gdm/.local/share/xorg/Xorg.*.log');
|
|
push(@x_logs, @temp) if @temp;
|
|
@temp = globber($ENV{'HOME'} . '/.local/share/xorg/Xorg.*.log',);
|
|
push(@x_logs, @temp) if @temp;
|
|
# root will not have a /root/.local/share/xorg directory so need to use a
|
|
# user one if we can find one.
|
|
if ($b_root){
|
|
@temp = globber('/home/*/.local/share/xorg/Xorg.*.log');
|
|
push(@x_logs, @temp) if @temp;
|
|
}
|
|
foreach (@x_logs){
|
|
if (-r $_){
|
|
my $src_info = File::stat::stat("$_");
|
|
# print "$_\n";
|
|
if ($src_info){
|
|
$x_mtime = $src_info->mtime;
|
|
# print $_ . ": $x_time" . "\n";
|
|
if ($x_mtime > $time_holder){
|
|
$time_holder = $x_mtime;
|
|
$file_holder = $_;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if (!$file_holder && check_program('xset')){
|
|
my $data = qx(xset q 2>/dev/null);
|
|
foreach (split('\n', $data)){
|
|
if ($_ =~ /Log file/i){
|
|
$file_holder = get_piece($_,3);
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
print "Xorg log file: $file_holder\nLast modified: $time_holder\n" if $dbg[14];
|
|
log_data('data',"Xorg log file: $file_holder") if $b_log;
|
|
$system_files{'xorg-log'} = $file_holder;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
########################################################################
|
|
#### UTILITIES
|
|
########################################################################
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### COLORS
|
|
#### -------------------------------------------------------------------
|
|
|
|
## args: 0: the type of action, either integer, count, or full
|
|
sub get_color_scheme {
|
|
eval $start if $b_log;
|
|
my ($type) = @_;
|
|
my $color_schemes = [
|
|
[qw(EMPTY EMPTY EMPTY)],
|
|
[qw(NORMAL NORMAL NORMAL)],
|
|
# for dark OR light backgrounds
|
|
[qw(BLUE NORMAL NORMAL)],
|
|
[qw(BLUE RED NORMAL)],
|
|
[qw(CYAN BLUE NORMAL)],
|
|
[qw(DCYAN NORMAL NORMAL)],
|
|
[qw(DCYAN BLUE NORMAL)],
|
|
[qw(DGREEN NORMAL NORMAL)],
|
|
[qw(DYELLOW NORMAL NORMAL)],
|
|
[qw(GREEN DGREEN NORMAL)],
|
|
[qw(GREEN NORMAL NORMAL)],
|
|
[qw(MAGENTA NORMAL NORMAL)],
|
|
[qw(RED NORMAL NORMAL)],
|
|
# for light backgrounds
|
|
[qw(BLACK DGREY NORMAL)],
|
|
[qw(DBLUE DGREY NORMAL)],
|
|
[qw(DBLUE DMAGENTA NORMAL)],
|
|
[qw(DBLUE DRED NORMAL)],
|
|
[qw(DBLUE BLACK NORMAL)],
|
|
[qw(DGREEN DYELLOW NORMAL)],
|
|
[qw(DYELLOW BLACK NORMAL)],
|
|
[qw(DMAGENTA BLACK NORMAL)],
|
|
[qw(DCYAN DBLUE NORMAL)],
|
|
# for dark backgrounds
|
|
[qw(WHITE GREY NORMAL)],
|
|
[qw(GREY WHITE NORMAL)],
|
|
[qw(CYAN GREY NORMAL)],
|
|
[qw(GREEN WHITE NORMAL)],
|
|
[qw(GREEN YELLOW NORMAL)],
|
|
[qw(YELLOW WHITE NORMAL)],
|
|
[qw(MAGENTA CYAN NORMAL)],
|
|
[qw(MAGENTA YELLOW NORMAL)],
|
|
[qw(RED CYAN NORMAL)],
|
|
[qw(RED WHITE NORMAL)],
|
|
[qw(BLUE WHITE NORMAL)],
|
|
# miscellaneous
|
|
[qw(RED BLUE NORMAL)],
|
|
[qw(RED DBLUE NORMAL)],
|
|
[qw(BLACK BLUE NORMAL)],
|
|
[qw(BLACK DBLUE NORMAL)],
|
|
[qw(NORMAL BLUE NORMAL)],
|
|
[qw(BLUE MAGENTA NORMAL)],
|
|
[qw(DBLUE MAGENTA NORMAL)],
|
|
[qw(BLACK MAGENTA NORMAL)],
|
|
[qw(MAGENTA BLUE NORMAL)],
|
|
[qw(MAGENTA DBLUE NORMAL)],
|
|
];
|
|
eval $end if $b_log;
|
|
if ($type eq 'count'){
|
|
return scalar @$color_schemes;
|
|
}
|
|
if ($type eq 'full'){
|
|
return $color_schemes;
|
|
}
|
|
else {
|
|
# print Dumper $color_schemes->[$type];
|
|
return $color_schemes->[$type];
|
|
}
|
|
}
|
|
|
|
sub set_color_scheme {
|
|
eval $start if $b_log;
|
|
my ($scheme) = @_;
|
|
$colors{'scheme'} = $scheme;
|
|
my $index = ($b_irc) ? 1 : 0; # defaults to non irc
|
|
# NOTE: qw(...) kills the escape, it is NOT the same as using
|
|
# Literal "..", ".." despite docs saying it is.
|
|
my %color_palette = (
|
|
'EMPTY' => [ '', '' ],
|
|
'DGREY' => [ "\e[1;30m", "\x0314" ],
|
|
'BLACK' => [ "\e[0;30m", "\x0301" ],
|
|
'RED' => [ "\e[1;31m", "\x0304" ],
|
|
'DRED' => [ "\e[0;31m", "\x0305" ],
|
|
'GREEN' => [ "\e[1;32m", "\x0309" ],
|
|
'DGREEN' => [ "\e[0;32m", "\x0303" ],
|
|
'YELLOW' => [ "\e[1;33m", "\x0308" ],
|
|
'DYELLOW' => [ "\e[0;33m", "\x0307" ],
|
|
'BLUE' => [ "\e[1;34m", "\x0312" ],
|
|
'DBLUE' => [ "\e[0;34m", "\x0302" ],
|
|
'MAGENTA' => [ "\e[1;35m", "\x0313" ],
|
|
'DMAGENTA' => [ "\e[0;35m", "\x0306" ],
|
|
'CYAN' => [ "\e[1;36m", "\x0311" ],
|
|
'DCYAN' => [ "\e[0;36m", "\x0310" ],
|
|
'WHITE' => [ "\e[1;37m", "\x0300" ],
|
|
'GREY' => [ "\e[0;37m", "\x0315" ],
|
|
'NORMAL' => [ "\e[0m", "\x03" ],
|
|
);
|
|
my $color_scheme = get_color_scheme($colors{'scheme'});
|
|
$colors{'c1'} = $color_palette{$color_scheme->[0]}[$index];
|
|
$colors{'c2'} = $color_palette{$color_scheme->[1]}[$index];
|
|
$colors{'cn'} = $color_palette{$color_scheme->[2]}[$index];
|
|
# print Dumper \@scheme;
|
|
# print "$colors{'c1'}here$colors{'c2'} we are!$colors{'cn'}\n";
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_colors {
|
|
eval $start if $b_log;
|
|
# it's already been set with -c 0-43
|
|
if (exists $colors{'c1'}){
|
|
return 1;
|
|
}
|
|
# This let's user pick their color scheme. For IRC, only shows the color
|
|
# schemes, no interactive. The override value only will be placed in user
|
|
# config files. /etc/inxi.conf can also override
|
|
if (exists $colors{'selector'}){
|
|
my $ob_selector = SelectColors->new($colors{'selector'});
|
|
$ob_selector->select_schema();
|
|
return 1;
|
|
}
|
|
# set the default, then override as required
|
|
my $color_scheme = $colors{'default'};
|
|
# these are set in user configs
|
|
if (defined $colors{'global'}){
|
|
$color_scheme = $colors{'global'};
|
|
}
|
|
else {
|
|
if ($b_irc){
|
|
if (defined $colors{'irc-virt-term'} && $b_display && $client{'console-irc'}){
|
|
$color_scheme = $colors{'irc-virt-term'};
|
|
}
|
|
elsif (defined $colors{'irc-console'} && !$b_display){
|
|
$color_scheme = $colors{'irc-console'};
|
|
}
|
|
elsif (defined $colors{'irc-gui'}){
|
|
$color_scheme = $colors{'irc-gui'};
|
|
}
|
|
}
|
|
else {
|
|
if (defined $colors{'console'} && !$b_display){
|
|
$color_scheme = $colors{'console'};
|
|
}
|
|
elsif (defined $colors{'virt-term'}){
|
|
$color_scheme = $colors{'virt-term'};
|
|
}
|
|
}
|
|
}
|
|
# force 0 for | or > output, all others prints to irc or screen
|
|
if (!$b_irc && !$force{'colors'} && ! -t STDOUT){
|
|
$color_scheme = 0;
|
|
}
|
|
set_color_scheme($color_scheme);
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## SelectColors
|
|
{
|
|
package SelectColors;
|
|
my (@data,%configs,%status);
|
|
my ($type,$w_fh);
|
|
my $safe_color_count = 12; # null/normal + default color group
|
|
my $count = 0;
|
|
|
|
# args: 0: type
|
|
sub new {
|
|
my $class = shift;
|
|
($type) = @_;
|
|
my $self = {};
|
|
return bless $self, $class;
|
|
}
|
|
|
|
sub select_schema {
|
|
eval $start if $b_log;
|
|
assign_selectors();
|
|
main::set_color_scheme(0);
|
|
set_status();
|
|
start_selector();
|
|
create_color_selections();
|
|
if (!$b_irc){
|
|
Configs::check_file();
|
|
get_selection();
|
|
}
|
|
else {
|
|
print_irc_message();
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_status {
|
|
$status{'console'} = (defined $colors{'console'}) ? "Set: $colors{'console'}" : 'Not Set';
|
|
$status{'virt-term'} = (defined $colors{'virt-term'}) ? "Set: $colors{'virt-term'}" : 'Not Set';
|
|
$status{'irc-console'} = (defined $colors{'irc-console'}) ? "Set: $colors{'irc-console'}" : 'Not Set';
|
|
$status{'irc-gui'} = (defined $colors{'irc-gui'}) ? "Set: $colors{'irc-gui'}" : 'Not Set';
|
|
$status{'irc-virt-term'} = (defined $colors{'irc-virt-term'}) ? "Set: $colors{'irc-virt-term'}" : 'Not Set';
|
|
$status{'global'} = (defined $colors{'global'}) ? "Set: $colors{'global'}" : 'Not Set';
|
|
}
|
|
|
|
sub assign_selectors {
|
|
if ($type == 94){
|
|
$configs{'variable'} = 'CONSOLE_COLOR_SCHEME';
|
|
$configs{'selection'} = 'console';
|
|
}
|
|
elsif ($type == 95){
|
|
$configs{'variable'} = 'VIRT_TERM_COLOR_SCHEME';
|
|
$configs{'selection'} = 'virt-term';
|
|
}
|
|
elsif ($type == 96){
|
|
$configs{'variable'} = 'IRC_COLOR_SCHEME';
|
|
$configs{'selection'} = 'irc-gui';
|
|
}
|
|
elsif ($type == 97){
|
|
$configs{'variable'} = 'IRC_X_TERM_COLOR_SCHEME';
|
|
$configs{'selection'} = 'irc-virt-term';
|
|
}
|
|
elsif ($type == 98){
|
|
$configs{'variable'} = 'IRC_CONS_COLOR_SCHEME';
|
|
$configs{'selection'} = 'irc-console';
|
|
}
|
|
elsif ($type == 99){
|
|
$configs{'variable'} = 'GLOBAL_COLOR_SCHEME';
|
|
$configs{'selection'} = 'global';
|
|
}
|
|
}
|
|
|
|
sub start_selector {
|
|
my $whoami = getpwuid($<) || "unknown???";
|
|
if (!$b_irc){
|
|
@data = (
|
|
[ 0, '', '', "Welcome to $self_name! Please select the default
|
|
$configs{'selection'} color scheme."],
|
|
);
|
|
}
|
|
push(@data,
|
|
[ 0, '', '', "Because there is no way to know your $configs{'selection'}
|
|
foreground/background colors, you can set your color preferences from
|
|
color scheme option list below:"],
|
|
[ 0, '', '', "0 is no colors; 1 is neutral."],
|
|
[ 0, '', '', "After these, there are 4 sets:"],
|
|
[ 0, '', '', "1-dark^or^light^backgrounds; 2-light^backgrounds;
|
|
3-dark^backgrounds; 4-miscellaneous"],
|
|
[ 0, '', '', ""],
|
|
);
|
|
if (!$b_irc){
|
|
push(@data,
|
|
[ 0, '', '', "Please note that this will set the $configs{'selection'}
|
|
preferences only for user: $whoami"],
|
|
);
|
|
}
|
|
push(@data,
|
|
[ 0, '', '', "$line1"],
|
|
);
|
|
main::print_basic(\@data);
|
|
@data = ();
|
|
}
|
|
|
|
sub create_color_selections {
|
|
my $spacer = '^^'; # printer removes double spaces, but replaces ^ with ' '
|
|
$count = (main::get_color_scheme('count') - 1);
|
|
foreach my $i (0 .. $count){
|
|
if ($i > 9){
|
|
$spacer = '^';
|
|
}
|
|
if ($configs{'selection'} =~ /^(global|irc-gui|irc-console|irc-virt-term)$/ && $i > $safe_color_count){
|
|
last;
|
|
}
|
|
main::set_color_scheme($i);
|
|
push(@data,
|
|
[0, '', '', "$i)$spacer$colors{'c1'}Card:$colors{'c2'}^nVidia^GT218
|
|
$colors{'c1'}Display^Server$colors{'c2'}^x11^(X.Org^1.7.7)$colors{'cn'}"],
|
|
);
|
|
}
|
|
main::print_basic(\@data);
|
|
@data = ();
|
|
main::set_color_scheme(0);
|
|
}
|
|
|
|
sub get_selection {
|
|
my $number = $count + 1;
|
|
@data = (
|
|
[0, '', '', ($number++) . ")^Remove all color settings. Restore $self_name default."],
|
|
[0, '', '', ($number++) . ")^Continue, no changes or config file setting."],
|
|
[0, '', '', ($number++) . ")^Exit, use another terminal, or set manually."],
|
|
[0, '', '', "$line1"],
|
|
[0, '', '', "Simply type the number for the color scheme that looks best to your
|
|
eyes for your $configs{'selection'} settings and hit <ENTER>. NOTE: You can bring this
|
|
option list up by starting $self_name with option: -c plus one of these numbers:"],
|
|
[0, '', '', "94^-^console,^not^in^desktop^-^$status{'console'}"],
|
|
[0, '', '', "95^-^terminal,^desktop^-^$status{'virt-term'}"],
|
|
[0, '', '', "96^-^irc,^gui,^desktop^-^$status{'irc-gui'}"],
|
|
[0, '', '', "97^-^irc,^desktop,^in^terminal^-^$status{'irc-virt-term'}"],
|
|
[0, '', '', "98^-^irc,^not^in^desktop^-^$status{'irc-console'}"],
|
|
[0, '', '', "99^-^global^-^$status{'global'}"],
|
|
[0, '', '', ""],
|
|
[0, '', '', "Your selection(s) will be stored here: $user_config_file"],
|
|
[0, '', '', "Global overrides all individual color schemes. Individual
|
|
schemes remove the global setting."],
|
|
[0, '', '', "$line1"],
|
|
);
|
|
main::print_basic(\@data);
|
|
@data = ();
|
|
chomp(my $response = <STDIN>);
|
|
if (!main::is_int($response) || $response > ($count + 3)){
|
|
@data = (
|
|
[0, '', '', "Error - Invalid Selection. You entered this: $response. Hit <ENTER> to continue."],
|
|
[0, '', '', "$line1"],
|
|
);
|
|
main::print_basic(\@data);
|
|
my $response = <STDIN>;
|
|
start_selector();
|
|
create_color_selections();
|
|
get_selection();
|
|
}
|
|
else {
|
|
process_selection($response);
|
|
}
|
|
if ($b_pledge){
|
|
@pledges = grep {$_ ne 'getpw'} @pledges;
|
|
OpenBSD::Pledge::pledge(@pledges);
|
|
}
|
|
}
|
|
|
|
sub process_selection {
|
|
my $response = shift;
|
|
if ($response == ($count + 3)){
|
|
@data = (
|
|
[0, '', '', "Ok, exiting $self_name now. You can set the colors later."],
|
|
);
|
|
main::print_basic(\@data);
|
|
exit 0;
|
|
}
|
|
elsif ($response == ($count + 2)){
|
|
@data = (
|
|
[0, '', '', "Ok, continuing $self_name unchanged."],
|
|
[0, '', '', "$line1"],
|
|
);
|
|
main::print_basic(\@data);
|
|
if (defined $colors{'console'} && !$b_display){
|
|
main::set_color_scheme($colors{'console'});
|
|
}
|
|
if (defined $colors{'virt-term'}){
|
|
main::set_color_scheme($colors{'virt-term'});
|
|
}
|
|
else {
|
|
main::set_color_scheme($colors{'default'});
|
|
}
|
|
}
|
|
elsif ($response == ($count + 1)){
|
|
@data = (
|
|
[0, '', '', "Removing all color settings from config file now..."],
|
|
[0, '', '', "$line1"],
|
|
);
|
|
main::print_basic(\@data);
|
|
delete_all_config_colors();
|
|
main::set_color_scheme($colors{'default'});
|
|
}
|
|
else {
|
|
main::set_color_scheme($response);
|
|
@data = (
|
|
[0, '', '', "Updating config file for $configs{'selection'} color scheme now..."],
|
|
[0, '', '', "$line1"],
|
|
);
|
|
main::print_basic(\@data);
|
|
if ($configs{'selection'} eq 'global'){
|
|
delete_all_colors();
|
|
}
|
|
else {
|
|
delete_global_color();
|
|
}
|
|
set_config_color_scheme($response);
|
|
}
|
|
}
|
|
|
|
sub delete_all_colors {
|
|
my @file_lines = main::reader($user_config_file);
|
|
open($w_fh, '>', $user_config_file) or main::error_handler('open', $user_config_file, $!);
|
|
foreach (@file_lines){
|
|
if ($_ !~ /^(CONSOLE_COLOR_SCHEME|GLOBAL_COLOR_SCHEME|IRC_COLOR_SCHEME|IRC_CONS_COLOR_SCHEME|IRC_X_TERM_COLOR_SCHEME|VIRT_TERM_COLOR_SCHEME)/){
|
|
print {$w_fh} "$_";
|
|
}
|
|
}
|
|
close $w_fh;
|
|
}
|
|
|
|
sub delete_global_color {
|
|
my @file_lines = main::reader($user_config_file);
|
|
open($w_fh, '>', $user_config_file) or main::error_handler('open', $user_config_file, $!);
|
|
foreach (@file_lines){
|
|
if ($_ !~ /^GLOBAL_COLOR_SCHEME/){
|
|
print {$w_fh} "$_";
|
|
}
|
|
}
|
|
close $w_fh;
|
|
}
|
|
|
|
sub set_config_color_scheme {
|
|
my $value = shift;
|
|
my @file_lines = main::reader($user_config_file);
|
|
my $b_found = 0;
|
|
open($w_fh, '>', $user_config_file) or main::error_handler('open', $user_config_file, $!);
|
|
foreach (@file_lines){
|
|
if ($_ =~ /^$configs{'variable'}/){
|
|
$_ = "$configs{'variable'}=$value";
|
|
$b_found = 1;
|
|
}
|
|
print $w_fh "$_\n";
|
|
}
|
|
if (!$b_found){
|
|
print $w_fh "$configs{'variable'}=$value\n";
|
|
}
|
|
close $w_fh;
|
|
}
|
|
|
|
sub print_irc_message {
|
|
@data = (
|
|
[ 0, '', '', "$line1"],
|
|
[ 0, '', '', "After finding the scheme number you like, simply run this again
|
|
in a terminal to set the configuration data file for your irc client. You can
|
|
set color schemes for the following: start inxi with -c plus:"],
|
|
[ 0, '', '', "94 (console,^not^in^desktop^-^$status{'console'})"],
|
|
[ 0, '', '', "95 (terminal, desktop^-^$status{'virt-term'})"],
|
|
[ 0, '', '', "96 (irc,^gui,^desktop^-^$status{'irc-gui'})"],
|
|
[ 0, '', '', "97 (irc,^desktop,^in terminal^-^$status{'irc-virt-term'})"],
|
|
[ 0, '', '', "98 (irc,^not^in^desktop^-^$status{'irc-console'})"],
|
|
[ 0, '', '', "99 (global^-^$status{'global'})"]
|
|
);
|
|
main::print_basic(\@data);
|
|
exit 0;
|
|
}
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### CONFIGS
|
|
#### -------------------------------------------------------------------
|
|
|
|
## Configs
|
|
# public: set() check_file()
|
|
{
|
|
package Configs;
|
|
|
|
sub set {
|
|
my ($b_show) = @_;
|
|
my ($b_files,$key, $val,@config_files);
|
|
# removed legacy kde @$configs test which never worked
|
|
@config_files = (
|
|
qq(/etc/$self_name.conf),
|
|
qq(/etc/$self_name.d/$self_name.conf),
|
|
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, '<', "$_");
|
|
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);
|
|
if (!$b_show){
|
|
process_item($key,$val);
|
|
}
|
|
else {
|
|
print $line3 if !$b_configs;
|
|
print "$key=$val\n";
|
|
$b_configs = 1;
|
|
}
|
|
# print "f: $file key: $key val: $val\n";
|
|
}
|
|
close $fh;
|
|
if ($b_show && !$b_configs){
|
|
print "No configuration items found in file.\n";
|
|
}
|
|
}
|
|
return $b_files if $b_show;
|
|
}
|
|
|
|
sub show {
|
|
print "Showing current active/set configurations, by file. Last overrides previous.\n";
|
|
my $b_files = set(1);
|
|
print $line1;
|
|
if ($b_files){
|
|
print "All done! Everything look good? If not, fix it.\n";
|
|
}
|
|
else {
|
|
print "No configuration files found. Is that what you expected?\n";
|
|
}
|
|
exit 0;
|
|
}
|
|
|
|
# note: someone managed to make a config file with corrupted values, so check
|
|
# int explicitly, don't assume it was done correctly.
|
|
# args: 0: key; 1: value
|
|
sub process_item {
|
|
my ($key,$val) = @_;
|
|
|
|
## UTILITIES ##
|
|
if ($key eq 'ALLOW_UPDATE' || $key eq 'B_ALLOW_UPDATE'){
|
|
$use{'update'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'ALLOW_WEATHER' || $key eq 'B_ALLOW_WEATHER'){
|
|
$use{'weather'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'CPU_SLEEP'){
|
|
$cpu_sleep = $val if main::is_numeric($val)}
|
|
elsif ($key eq 'DL_TIMEOUT'){
|
|
$dl_timeout = $val if main::is_int($val)}
|
|
elsif ($key eq 'DOWNLOADER'){
|
|
if ($val =~ /^(curl|fetch|ftp|perl|wget)$/){
|
|
# this dumps all the other data and resets %dl for only the
|
|
# desired downloader.
|
|
$val = main::set_perl_downloader($val);
|
|
%dl = ('dl' => $val, $val => 1);
|
|
}}
|
|
elsif ($key eq 'FAKE_DATA_DIR'){
|
|
$fake_data_dir = $val}
|
|
elsif ($key eq 'FILTER_STRING'){
|
|
$filter_string = $val}
|
|
elsif ($key eq 'LANGUAGE'){
|
|
$language = $val if $val =~ /^(en)$/}
|
|
elsif ($key eq 'LIMIT'){
|
|
$limit = $val if main::is_int($val)}
|
|
elsif ($key eq 'OUTPUT_TYPE'){
|
|
$output_type = $val if $val =~ /^(json|screen|xml)$/}
|
|
elsif ($key eq 'NO_DIG'){
|
|
$force{'no-dig'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'NO_DOAS'){
|
|
$force{'no-doas'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'NO_HTML_WAN'){
|
|
$force{'no-html-wan'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'NO_SUDO'){
|
|
$force{'no-sudo'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'PARTITION_SORT'){
|
|
if ($val =~ /^(dev-base|fs|id|label|percent-used|size|uuid|used)$/){
|
|
$show{'partition-sort'} = $val;
|
|
}}
|
|
elsif ($key eq 'PS_COUNT'){
|
|
$ps_count = $val if main::is_int($val) }
|
|
elsif ($key eq 'SENSORS_CPU_NO'){
|
|
$sensors_cpu_nu = $val if main::is_int($val)}
|
|
elsif ($key eq 'SENSORS_EXCLUDE'){
|
|
@sensors_exclude = split(/\s*,\s*/, $val) if $val}
|
|
elsif ($key eq 'SENSORS_USE'){
|
|
@sensors_use = split(/\s*,\s*/, $val) if $val}
|
|
elsif ($key eq 'SHOW_HOST' || $key eq 'B_SHOW_HOST'){
|
|
if (main::is_int($val)){
|
|
$show{'host'} = $val;
|
|
$show{'no-host'} = 1 if !$show{'host'};
|
|
}
|
|
}
|
|
elsif ($key eq 'USB_SYS'){
|
|
$force{'usb-sys'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'WAN_IP_URL'){
|
|
if ($val =~ /^(ht|f)tp[s]?:\//i){
|
|
$wan_url = $val;
|
|
$force{'no-dig'} = 1;
|
|
}
|
|
}
|
|
elsif ($key eq 'WEATHER_SOURCE'){
|
|
$weather_source = $val if main::is_int($val)}
|
|
elsif ($key eq 'WEATHER_UNIT'){
|
|
$val = lc($val) if $val;
|
|
if ($val && $val =~ /^(c|f|cf|fc|i|m|im|mi)$/){
|
|
my %units = ('c'=>'m','f'=>'i','cf'=>'mi','fc'=>'im');
|
|
$val = $units{$val} if defined $units{$val};
|
|
$weather_unit = $val;
|
|
}
|
|
}
|
|
|
|
## COLORS/SEP ##
|
|
elsif ($key eq 'CONSOLE_COLOR_SCHEME'){
|
|
$colors{'console'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'GLOBAL_COLOR_SCHEME'){
|
|
$colors{'global'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'IRC_COLOR_SCHEME'){
|
|
$colors{'irc-gui'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'IRC_CONS_COLOR_SCHEME'){
|
|
$colors{'irc-console'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'IRC_X_TERM_COLOR_SCHEME'){
|
|
$colors{'irc-virt-term'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'VIRT_TERM_COLOR_SCHEME'){
|
|
$colors{'virt-term'} = $val if main::is_int($val)}
|
|
# note: not using the old short SEP1/SEP2
|
|
elsif ($key eq 'SEP1_IRC'){
|
|
$sep{'s1-irc'} = $val}
|
|
elsif ($key eq 'SEP1_CONSOLE'){
|
|
$sep{'s1-console'} = $val}
|
|
elsif ($key eq 'SEP2_IRC'){
|
|
$sep{'s2-irc'} = $val}
|
|
elsif ($key eq 'SEP2_CONSOLE'){
|
|
$sep{'s2-console'} = $val}
|
|
|
|
## SIZES ##
|
|
elsif ($key eq 'COLS_MAX_CONSOLE'){
|
|
$size{'console'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'COLS_MAX_IRC'){
|
|
$size{'irc'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'COLS_MAX_NO_DISPLAY'){
|
|
$size{'no-display'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'INDENT'){
|
|
$size{'indent'} = $val if main::is_int($val)}
|
|
elsif ($key eq 'INDENTS'){
|
|
$filter_string = $val if main::is_int($val)}
|
|
elsif ($key eq 'LINES_MAX'){
|
|
if ($val =~ /^-?\d+$/ && $val >= -1){
|
|
if ($val == 0){
|
|
$size{'max-lines'} = $size{'term-lines'};}
|
|
elsif ($val == -1){
|
|
$use{'output-block'} = 1;}
|
|
else {
|
|
$size{'max-lines'} = $val;}
|
|
}}
|
|
elsif ($key eq 'MAX_WRAP' || $key eq 'WRAP_MAX' || $key eq 'INDENT_MIN'){
|
|
$size{'max-wrap'} = $val if main::is_int($val)}
|
|
# print "mc: key: $key val: $val\n";
|
|
# print Dumper (keys %size) . "\n";
|
|
}
|
|
|
|
sub check_file {
|
|
$user_config_file = "$user_config_dir/$self_name.conf";
|
|
if (! -f $user_config_file){
|
|
open(my $fh, '>', $user_config_file) or
|
|
main::error_handler('create', $user_config_file, $!);
|
|
}
|
|
}
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### DEBUGGERS
|
|
#### -------------------------------------------------------------------
|
|
|
|
# called in the initial -@ 10 program args setting so we can get logging
|
|
# as soon as possible # will have max 3 files, inxi.log, inxi.1.log,
|
|
# inxi.2.log
|
|
sub begin_logging {
|
|
return 1 if $fh_l; # if we want to start logging for testing before options
|
|
my $log_file_2="$user_data_dir/$self_name.1.log";
|
|
my $log_file_3="$user_data_dir/$self_name.2.log";
|
|
my $data = '';
|
|
$end='main::log_data("fe", (caller(1))[3], "");';
|
|
$start='main::log_data("fs", (caller(1))[3], \@_);';
|
|
#$t3 = tv_interval ($t0, [gettimeofday]);
|
|
$t3 = eval 'Time::HiRes::tv_interval (\@t0, [Time::HiRes::gettimeofday()]);' if $b_hires;
|
|
# print Dumper $@;
|
|
my $now = strftime "%Y-%m-%d %H:%M:%S", localtime;
|
|
return if $debugger{'timers'};
|
|
# do the rotation if logfile exists
|
|
if (-f $log_file){
|
|
# copy if present second to third
|
|
if (-f $log_file_2){
|
|
rename $log_file_2, $log_file_3 or error_handler('rename', "$log_file_2 -> $log_file_3", "$!");
|
|
}
|
|
# then copy initial to second
|
|
rename $log_file, $log_file_2 or error_handler('rename', "$log_file -> $log_file_2", "$!");
|
|
}
|
|
# now create the logfile
|
|
# print "Opening log file for reading: $log_file\n";
|
|
open($fh_l, '>', $log_file) or error_handler(4, $log_file, "$!");
|
|
# and echo the start data
|
|
$data = $line2;
|
|
$data .= "START $self_name LOGGING:\n";
|
|
$data .= "NOTE: HiRes timer not available.\n" if !$b_hires;
|
|
$data .= "$now\n";
|
|
$data .= "Elapsed since start: $t3\n";
|
|
$data .= "n: $self_name v: $self_version p: $self_patch d: $self_date\n";
|
|
$data .= '@paths:' . joiner(\@paths, '::', 'unset') . "\n";
|
|
$data .= $line2;
|
|
|
|
print $fh_l $data;
|
|
}
|
|
|
|
# NOTE: no logging available until get_parameters is run, since that's what
|
|
# sets logging # in order to trigger earlier logging manually set $b_log
|
|
# to true in top variables.
|
|
# args: 0: type [fs|fe|cat|dump|raw]; 1: function name OR data to log;
|
|
# [2: function args OR hash/array ref]
|
|
sub log_data {
|
|
return if !$b_log;
|
|
my ($one, $two, $three) = @_;
|
|
my ($args,$data,$timer) = ('','','');
|
|
my $spacer = ' ';
|
|
# print "1: $one 2: $two 3: $three\n";
|
|
if ($one eq 'fs'){
|
|
if (ref $three eq 'ARRAY'){
|
|
# print Data::Dumper::Dumper $three;
|
|
$args = "\n${spacer}Args: " . joiner($three, '; ', 'unset');
|
|
}
|
|
else {
|
|
$args = "\n${spacer}Args: None";
|
|
}
|
|
# $t1 = [gettimeofday];
|
|
#$t3 = tv_interval ($t0, [gettimeofday]);
|
|
$t3 = eval 'Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()])' if $b_hires;
|
|
# print Dumper $@;
|
|
$data = "Start: Function: $two$args\n${spacer}Elapsed: $t3\n";
|
|
$spacer='';
|
|
$timer = $data if $debugger{'timers'};
|
|
}
|
|
elsif ($one eq 'fe'){
|
|
# print 'timer:', Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()]),"\n";
|
|
#$t3 = tv_interval ($t0, [gettimeofday]);
|
|
eval '$t3 = Time::HiRes::tv_interval(\@t0, [Time::HiRes::gettimeofday()])' if $b_hires;
|
|
# print Dumper $t3;
|
|
$data = "${spacer}Elapsed: $t3\nEnd: Function: $two\n";
|
|
$spacer='';
|
|
$timer = $data if $debugger{'timers'};
|
|
}
|
|
elsif ($one eq 'cat'){
|
|
if ($b_log_full){
|
|
foreach my $file ($two){
|
|
my $contents = do { local(@ARGV, $/) = $file; <> }; # or: qx(cat $file)
|
|
$data = "$data${line3}Full file data: $file\n\n$contents\n$line3\n";
|
|
}
|
|
$spacer='';
|
|
}
|
|
}
|
|
elsif ($one eq 'cmd'){
|
|
$data = "Command: $two\n";
|
|
$data .= qx($two);
|
|
}
|
|
elsif ($one eq 'data'){
|
|
$data = "$two\n";
|
|
}
|
|
elsif ($one eq 'dump'){
|
|
$data = "$two:\n";
|
|
if (ref $three eq 'HASH'){
|
|
$data .= Data::Dumper::Dumper $three;
|
|
}
|
|
elsif (ref $three eq 'ARRAY'){
|
|
# print Data::Dumper::Dumper $three;
|
|
$data .= Data::Dumper::Dumper $three;
|
|
}
|
|
else {
|
|
$data .= Data::Dumper::Dumper $three;
|
|
}
|
|
$data .= "\n";
|
|
# print $data;
|
|
}
|
|
elsif ($one eq 'raw'){
|
|
if ($b_log_full){
|
|
$data = "\n${line3}Raw System Data:\n\n$two\n$line3";
|
|
$spacer='';
|
|
}
|
|
}
|
|
else {
|
|
$data = "$two\n";
|
|
}
|
|
if ($debugger{'timers'}){
|
|
print $timer if $timer;
|
|
}
|
|
# print "d: $data";
|
|
elsif ($data){
|
|
print $fh_l "$spacer$data";
|
|
}
|
|
}
|
|
|
|
sub set_debugger {
|
|
user_debug_test_1() if $debugger{'test-1'};
|
|
if ($debugger{'level'} >= 20){
|
|
error_handler('not-in-irc', 'debug data generator') if $b_irc;
|
|
my $option = ($debugger{'level'} > 22) ? 'main-full' : 'main';
|
|
$debugger{'gz'} = 1 if ($debugger{'level'} == 22 || $debugger{'level'} == 24);
|
|
my $ob_sys = SystemDebugger->new($option);
|
|
$ob_sys->run_debugger();
|
|
$ob_sys->upload_file($ftp_alt) if $debugger{'level'} > 20;
|
|
exit 0;
|
|
}
|
|
elsif ($debugger{'level'} >= 10 && $debugger{'level'} <= 12){
|
|
$b_log = 1;
|
|
if ($debugger{'level'} == 11){
|
|
$b_log_full = 1;
|
|
}
|
|
elsif ($debugger{'level'} == 12){
|
|
$b_log_colors = 1;
|
|
}
|
|
begin_logging();
|
|
}
|
|
elsif ($debugger{'level'} <= 3){
|
|
if ($debugger{'level'} == 3){
|
|
$b_log = 1;
|
|
$debugger{'timers'} = 1;
|
|
begin_logging();
|
|
}
|
|
else {
|
|
$end = '';
|
|
$start = '';
|
|
}
|
|
}
|
|
}
|
|
|
|
## SystemDebugger
|
|
{
|
|
package SystemDebugger;
|
|
my $option = 'main';
|
|
my ($data_dir,$debug_dir,$debug_gz,$parse_src,$upload) = ('','','','','');
|
|
my @content;
|
|
my $b_debug = 0;
|
|
my $b_delete_dir = 1;
|
|
|
|
# args: 0: type; 1: upload
|
|
sub new {
|
|
my $class = shift;
|
|
($option) = @_;
|
|
my $self = {};
|
|
# print "$f\n";
|
|
# print "$option\n";
|
|
return bless $self, $class;
|
|
}
|
|
|
|
sub run_debugger {
|
|
print "Starting $self_name debugging data collector...\n";
|
|
check_required_items();
|
|
create_debug_directory();
|
|
print "Note: for dmidecode, smartctl, lvm data you must be root.\n" if !$b_root;
|
|
print $line3;
|
|
if (!$b_debug){
|
|
audio_data();
|
|
bluetooth_data();
|
|
disk_data();
|
|
display_data();
|
|
network_data();
|
|
perl_modules();
|
|
system_data();
|
|
}
|
|
system_files();
|
|
print $line3;
|
|
if (!$b_debug){
|
|
# note: android has unreadable /sys, but -x and -r tests pass
|
|
# main::globber('/sys/*') &&
|
|
if ($debugger{'sys'} && main::count_dir_files('/sys')){
|
|
build_tree('sys');
|
|
# kernel crash, not sure what creates it, for ppc, as root
|
|
if ($debugger{'sys'} && ($debugger{'sys-force'} || !$b_root || !$risc{'ppc'})){
|
|
sys_traverse_data();
|
|
}
|
|
}
|
|
else {
|
|
print "Skipping /sys data collection.\n";
|
|
}
|
|
print $line3;
|
|
# note: proc has some files that are apparently kernel processes, I've tried
|
|
# filtering them out but more keep appearing, so only run proc debugger if not root
|
|
if (!$debugger{'no-proc'} && (!$b_root || $debugger{'proc'}) && -d '/proc' && main::count_dir_files('/proc')){
|
|
build_tree('proc');
|
|
proc_traverse_data();
|
|
}
|
|
else {
|
|
print "Skipping /proc data collection.\n";
|
|
}
|
|
print $line3;
|
|
}
|
|
run_self();
|
|
print $line3;
|
|
compress_dir();
|
|
}
|
|
|
|
sub check_required_items {
|
|
print "Loading required debugger Perl File:: modules... \n";
|
|
# Fedora/Redhat doesn't include File::Find File::Copy in
|
|
# core modules. why? Or rather, they deliberately removed them.
|
|
if (main::check_perl_module('File::Find')){
|
|
File::Find->import;
|
|
}
|
|
else {
|
|
main::error_handler('required-module', 'File', 'File::Find');
|
|
}
|
|
if (main::check_perl_module('File::Copy')){
|
|
File::Copy->import;
|
|
}
|
|
else {
|
|
main::error_handler('required-module', 'File', 'File::Copy');
|
|
}
|
|
if (main::check_perl_module('File::Spec::Functions')){
|
|
File::Spec::Functions->import;
|
|
}
|
|
else {
|
|
main::error_handler('required-module', 'File', 'File::Spec::Functions');
|
|
}
|
|
if ($debugger{'level'} > 20){
|
|
if (main::check_perl_module('Net::FTP')){
|
|
Net::FTP->import;
|
|
}
|
|
else {
|
|
main::error_handler('required-module', 'Net', 'Net::FTP');
|
|
}
|
|
}
|
|
print "Checking basic core system programs exist... \n";
|
|
if ($debugger{'level'} > 19){
|
|
# astoundingly, rhel 9 and variants are shipping without tar in minimal install
|
|
if (!main::check_program('tar')){
|
|
main::error_handler('required-program', 'tar', 'debugger');
|
|
}
|
|
}
|
|
}
|
|
|
|
sub create_debug_directory {
|
|
my $host = main::get_hostname();
|
|
$host =~ s/ /-/g;
|
|
$host = 'no-host' if !$host || $host eq 'N/A';
|
|
my ($alt_string,$root_string) = ('','');
|
|
# note: Time::Piece was introduced in perl 5.9.5
|
|
my ($sec,$min,$hour,$mday,$mon,$year) = localtime;
|
|
$year = $year+1900;
|
|
$mon += 1;
|
|
if (length($sec) == 1){$sec = "0$sec";}
|
|
if (length($min) == 1){$min = "0$min";}
|
|
if (length($hour) == 1){$hour = "0$hour";}
|
|
if (length($mon) == 1){$mon = "0$mon";}
|
|
if (length($mday) == 1){$mday = "0$mday";}
|
|
my $today = "$year-$mon-${mday}_$hour$min$sec";
|
|
# my $date = strftime "-%Y-%m-%d_", localtime;
|
|
if ($b_root){
|
|
$root_string = '-root';
|
|
}
|
|
my $id = ($debugger{'id'}) ? '-' . $debugger{'id'}: '';
|
|
$alt_string = '-' . uc($risc{'id'}) if %risc;
|
|
$alt_string .= "-BSD-$bsd_type" if $bsd_type;
|
|
$alt_string .= '-ANDROID' if $b_android;
|
|
$alt_string .= '-CYGWIN' if $windows{'cygwin'}; # could be windows arm?
|
|
$alt_string .= '-WSL' if $windows{'wsl'}; # could be windows arm?
|
|
$debug_dir = "$self_name$alt_string-$host$id-$today$root_string-$self_version-$self_patch";
|
|
$debug_gz = "$debug_dir.tar.gz";
|
|
$data_dir = "$user_data_dir/$debug_dir";
|
|
if (-d $data_dir){
|
|
unlink $data_dir or main::error_handler('remove', "$data_dir", "$!");
|
|
}
|
|
mkdir $data_dir or main::error_handler('mkdir', "$data_dir", "$!");
|
|
if (-e "$user_data_dir/$debug_gz"){
|
|
#rmdir "$user_data_dir$debug_gz" or main::error_handler('remove', "$user_data_dir/$debug_gz", "$!");
|
|
print "Failed removing leftover directory:\n$user_data_dir$debug_gz error: $?" if system('rm','-rf',"$user_data_dir$debug_gz");
|
|
}
|
|
print "Debugger data going into:\n$data_dir\n";
|
|
}
|
|
|
|
sub compress_dir {
|
|
print "Creating tar.gz compressed file of this material...\n";
|
|
print "File: $debug_gz\n";
|
|
system("cd $user_data_dir; tar -czf $debug_gz $debug_dir");
|
|
print "Removing $data_dir...\n";
|
|
#rmdir $data_dir or print "failed removing: $data_dir error: $!\n";
|
|
return 1 if !$b_delete_dir;
|
|
if (system('rm','-rf',$data_dir)){
|
|
print "Failed removing: $data_dir\nError: $?\n";
|
|
}
|
|
else {
|
|
print "Directory removed.\n";
|
|
}
|
|
}
|
|
|
|
# NOTE: incomplete, don't know how to ever find out
|
|
# what sound server is actually running, and is in control
|
|
sub audio_data {
|
|
my (%data,@files,@files2);
|
|
print "Collecting audio data...\n";
|
|
my @cmds = (
|
|
['aplay', '--version'], # alsa
|
|
['aplay', '-l'], # alsa devices
|
|
['aplay', '-L'], # alsa list of features, can detect active sound server
|
|
['artsd', '-v'], # aRts
|
|
['esd', '-v'], # EsounD, to stderr
|
|
['nasd', '-V'], # NAS
|
|
['jackd', '--version'], # JACK
|
|
['pactl', '--version'], # pulseaudio
|
|
['pactl', 'info'], # pulseaudio, check if running as server: Server Name:
|
|
['pactl', 'list'], # pulseaudio
|
|
['pipewire', '--version'], # pipewire
|
|
['pipewire-alsa', '--version'], # pipewire-alsa - just config files
|
|
['pipewire-pulse', '--version'], # pipewire-pulse
|
|
['pulseaudio', '--version'], # PulseAudio
|
|
['pw-jack', '--version'], # pipewire-jack
|
|
['pw-cli', 'ls'], # pipewire, check if running as server
|
|
['pw-cli', 'info all'],
|
|
);
|
|
run_commands(\@cmds,'audio');
|
|
@files = main::globber('/proc/asound/card*/codec*');
|
|
if (@files){
|
|
my $asound = qx(head -n 1 /proc/asound/card*/codec* 2>&1);
|
|
$data{'proc-asound-codecs'} = $asound;
|
|
}
|
|
else {
|
|
$data{'proc-asound-codecs'} = undef;
|
|
}
|
|
write_data(\%data,'audio');
|
|
@files = (
|
|
'/proc/asound/cards',
|
|
'/proc/asound/version',
|
|
);
|
|
@files2 = main::globber('/proc/asound/*/usbid');
|
|
push(@files,@files2) if @files2;
|
|
copy_files(\@files,'audio');
|
|
}
|
|
|
|
sub bluetooth_data {
|
|
print "Collecting bluetooth data...\n";
|
|
# no warnings 'uninitialized';
|
|
my @cmds = (
|
|
['btmgmt','info'],
|
|
['hciconfig','-a'], # no version
|
|
#['hcidump',''], # hangs sometimes
|
|
['hcitool','dev'],
|
|
['rfkill','--output-all'],
|
|
);
|
|
# these hang if bluetoothd not enabled
|
|
if (@ps_cmd && (grep {m|/bluetoothd|} @ps_cmd)){
|
|
push(@cmds,
|
|
['bt-adapter','--list'], # no version
|
|
['bt-adapter','--info'],
|
|
['bluetoothctl','--version'],
|
|
['bluetoothctl','--list'],
|
|
['bluetoothctl','--show']
|
|
);
|
|
}
|
|
run_commands(\@cmds,'bluetooth');
|
|
}
|
|
|
|
## NOTE: >/dev/null 2>&1 is sh, and &>/dev/null is bash, fix this
|
|
# ls -w 1 /sysrs > tester 2>&1
|
|
sub disk_data {
|
|
my (%data,@files,@files2);
|
|
print "Collecting dev, label, disk, uuid data, df...\n";
|
|
@files = (
|
|
'/etc/fstab',
|
|
'/etc/mtab',
|
|
'/proc/devices',
|
|
'/proc/mdstat',
|
|
'/proc/mounts',
|
|
'/proc/partitions',
|
|
'/proc/scsi/scsi',
|
|
'/proc/sys/dev/cdrom/info',
|
|
);
|
|
# very old systems
|
|
if (-d '/proc/ide/'){
|
|
my @ides = main::globber('/proc/ide/*/*');
|
|
push(@files, @ides) if @ides;
|
|
}
|
|
else {
|
|
push(@files, '/proc-ide-directory');
|
|
}
|
|
copy_files(\@files, 'disk');
|
|
my @cmds = (
|
|
['blockdev', '--version'],
|
|
['blockdev', '--report'],
|
|
['btrfs', 'fi show'], # no version
|
|
['btrfs', 'filesystem show'],
|
|
['btrfs', 'filesystem show --mounted'],
|
|
# ['btrfs', 'filesystem show --all-devices'],
|
|
['df', '-h -T'], # no need for version, and bsd doesn't have its
|
|
['df', '-h'],
|
|
['df', '-k'],
|
|
['df', '-k -P'],
|
|
['df', '-k -T'],
|
|
['df', '-k -T -P'],
|
|
['df', '-k -T -P -a'],
|
|
['df', '-P'],
|
|
['dmsetup', 'ls --tree'],
|
|
['findmnt', ''],
|
|
['findmnt', '--df --no-truncate'],
|
|
['findmnt', '--list --no-truncate'],
|
|
['gpart', 'list'], # no version
|
|
['gpart', 'show'],
|
|
['gpart', 'status'],
|
|
['ls', '-l /dev'],# core util, don't need version
|
|
# block is for mmcblk / arm devices
|
|
['ls', '-l /dev/block'],
|
|
['ls', '-l /dev/block/bootdevice'],
|
|
['ls', '-l /dev/block/bootdevice/by-name'],
|
|
['ls', '-l /dev/disk'],
|
|
['ls', '-l /dev/disk/by-id'],
|
|
['ls', '-l /dev/disk/by-label'],
|
|
['ls', '-l /dev/disk/by-partlabel'],
|
|
['ls', '-l /dev/disk/by-partuuid'],
|
|
['ls', '-l /dev/disk/by-path'],
|
|
['ls', '-l /dev/disk/by-uuid'],
|
|
# http://comments.gmane.org/gmane.linux.file-systems.zfs.user/2032
|
|
['ls', '-l /dev/disk/by-wwn'],
|
|
['ls', '-l /dev/mapper'],
|
|
['lsblk', '--version'], # important since lsblk has been changing output
|
|
['lsblk', '-fs'],
|
|
['lsblk', '-fsr'],
|
|
['lsblk', '-fsP'],
|
|
['lsblk', '-a'],
|
|
['lsblk', '-aP'],
|
|
['lsblk', '-ar'],
|
|
['lsblk', '-p'],
|
|
['lsblk', '-pr'],
|
|
['lsblk', '-pP'],
|
|
['lsblk', '-r'],
|
|
['lsblk', '-r --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,MOUNTPOINT,PHY-SEC,LOG-SEC,PARTFLAGS'],
|
|
['lsblk', '-rb --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,MOUNTPOINT,PHY-SEC,LOG-SEC,PARTFLAGS'],
|
|
['lsblk', '-rb --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,SERIAL,MOUNTPOINT,PHY-SEC,LOG-SEC,PARTFLAGS,MAJ:MIN,PKNAME'],
|
|
['lsblk', '-Pb --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE'],
|
|
['lsblk', '-Pb --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,SERIAL,MOUNTPOINT,PHY-SEC,LOG-SEC,PARTFLAGS'],
|
|
# this should always be the live command used internally:
|
|
['lsblk', '-bP --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,SERIAL,MOUNTPOINT,PHY-SEC,LOG-SEC,PARTFLAGS,MAJ:MIN,PKNAME'],
|
|
['lvdisplay', '--version'],
|
|
['lvdisplay', '-c'],
|
|
['lvdisplay', '-cv'],
|
|
['lvdisplay', '-cv --segments'],
|
|
['lvdisplay', '-m --segments'],
|
|
['lvdisplay', '-ma --segments'],
|
|
['lvs', '--version'],
|
|
['lvs', '--separator :'],
|
|
['lvs', '--separator : --segments'],
|
|
['lvs', '-o +devices --separator : --segments'],
|
|
['lvs', '-o +devices -v --separator : --segments'],
|
|
['lvs', '-o +devices -av --separator : --segments'],
|
|
['lvs', '-o +devices -aPv --separator : --segments'],
|
|
# LSI raid https://hwraid.le-vert.net/wiki/LSIMegaRAIDSAS
|
|
['megacli', '-AdpAllInfo -aAll'], # no version
|
|
['megacli', '-LDInfo -L0 -a0'],
|
|
['megacli', '-PDList -a0'],
|
|
['megaclisas-status', ''], # no version
|
|
['megaraidsas-status', ''],
|
|
['megasasctl', ''],
|
|
['mount', ''],
|
|
['nvme', 'present'], # no version
|
|
['pvdisplay', '--version'],
|
|
['pvdisplay', '-c'],
|
|
['pvdisplay', '-cv'],
|
|
['pvdisplay', '-m'],
|
|
['pvdisplay', '-ma'],
|
|
['pvs', '--version'],
|
|
['pvs', '--separator :'],
|
|
['pvs', '--separator : --segments'],
|
|
['pvs', '-a --separator : --segments'],
|
|
['pvs', '-av --separator : --segments'],
|
|
['pvs', '-aPv --separator : --segments -o +pv_major,pv_minor'],
|
|
['pvs', '-v --separator : --segments'],
|
|
['pvs', '-Pv --separator : --segments'],
|
|
['pvs', '--segments -o pv_name,pv_size,seg_size,vg_name,lv_name,lv_size,seg_pe_ranges'],
|
|
['readlink', '/dev/root'], # coreutils, don't need version
|
|
['swapon', '-s'], # coreutils, don't need version
|
|
# 3ware-raid
|
|
['tw-cli', 'info'],
|
|
['vgdisplay', ''],
|
|
['vgdisplay', '-v'],
|
|
['vgdisplay', '-c'],
|
|
['vgdisplay', '-vc'],
|
|
['vgs', '--separator :'], # part of lvm, don't need version
|
|
['vgs', '-av --separator :'],
|
|
['vgs', '-aPv --separator :'],
|
|
['vgs', '-v --separator :'],
|
|
['vgs', '-o +pv_name --separator :'],
|
|
['zfs', 'list'],
|
|
['zpool', 'list'], # don't use version, might not be supported in linux
|
|
['zpool', 'list -v'],
|
|
);
|
|
run_commands(\@cmds,'disk');
|
|
@cmds = (
|
|
['atacontrol', 'list'],
|
|
['camcontrol', 'devlist'],
|
|
['camcontrol', 'devlist -v'],
|
|
['geom', 'part list'],
|
|
['glabel', 'status'],
|
|
['gpart', 'list'], # gpart in linux/bsd but do it here again
|
|
['gpart', 'show'],
|
|
['gpart', 'status'],
|
|
['swapctl', '-l -k'],
|
|
['swapctl', '-l -k'],
|
|
['vmstat', ''],
|
|
['vmstat', '-H'],
|
|
);
|
|
run_commands(\@cmds,'disk-bsd');
|
|
}
|
|
|
|
sub display_data {
|
|
my (%data,@files,@files2);
|
|
my $working = '';
|
|
if (!$b_display){
|
|
print "Warning: only some of the data collection can occur if you are not in X\n";
|
|
main::toucher("$data_dir/display-data-warning-user-not-in-x");
|
|
}
|
|
if ($b_root){
|
|
print "Warning: only some of the data collection can occur if you are running as Root user\n";
|
|
main::toucher("$data_dir/display-data-warning-root-user");
|
|
}
|
|
print "Collecting Xorg log and xorg.conf files...\n";
|
|
if (-d "/etc/X11/xorg.conf.d/"){
|
|
@files = main::globber("/etc/X11/xorg.conf.d/*");
|
|
}
|
|
else {
|
|
@files = ('/xorg-conf-d');
|
|
}
|
|
# keep this updated to handle all possible locations we know about for Xorg.0.log
|
|
# not using $system_files{'xorg-log'} for now though it would be best to know what file is used
|
|
main::set_xorg_log();
|
|
push(@files, '/var/log/Xorg.0.log');
|
|
push(@files, '/var/lib/gdm/.local/share/xorg/Xorg.0.log');
|
|
push(@files, $ENV{'HOME'} . '/.local/share/xorg/Xorg.0.log');
|
|
push(@files, $system_files{'xorg-log'}) if $system_files{'xorg-log'};
|
|
push(@files, '/etc/X11/XFCconfig-4'); # very old format for xorg.conf
|
|
push(@files, '/etc/X11/xorg.conf');
|
|
copy_files(\@files,'display-xorg');
|
|
print "Collecting X, xprop, glxinfo, xrandr, xdpyinfo data, Wayland info...\n";
|
|
%data = (
|
|
'desktop-session' => $ENV{'DESKTOP_SESSION'},
|
|
'display' => $ENV{'DISPLAY'},
|
|
'gdmsession' => $ENV{'GDMSESSION'},
|
|
'gnome-desktop-session-id' => $ENV{'GNOME_DESKTOP_SESSION_ID'},
|
|
'kde-full-session' => $ENV{'KDE_FULL_SESSION'},
|
|
'kde-session-version' => $ENV{'KDE_SESSION_VERSION'},
|
|
'vdpau-driver' => $ENV{'VDPAU_DRIVER'},
|
|
'xdg-current-desktop' => $ENV{'XDG_CURRENT_DESKTOP'},
|
|
'xdg-session-desktop' => $ENV{'XDG_SESSION_DESKTOP'},
|
|
'xdg-vtnr' => $ENV{'XDG_VTNR'},
|
|
# wayland data collectors:
|
|
'wayland-display' => $ENV{'WAYLAND_DISPLAY'},
|
|
'xdg-session-type' => $ENV{'XDG_SESSION_TYPE'},
|
|
'gdk-backend' => $ENV{'GDK_BACKEND'},
|
|
'qt-qpa-platform' => $ENV{'QT_QPA_PLATFORM'},
|
|
'clutter-backend' => $ENV{'CLUTTER_BACKEND'},
|
|
'sdl-videodriver' => $ENV{'SDL_VIDEODRIVER'},
|
|
# program display values
|
|
'size-cols-max' => $size{'max-cols'},
|
|
'size-indent' => $size{'indent'},
|
|
'size-lines-max' => $size{'max-lines'},
|
|
'size-wrap-width' => $size{'max-wrap'},
|
|
);
|
|
write_data(\%data,'display');
|
|
my @cmds = (
|
|
# kde 5/plasma desktop 5, this is maybe an extra package and won't be used
|
|
['about-distro',''],
|
|
['aticonfig','--adapter=all --od-gettemperature'],
|
|
['clinfo',''],
|
|
['clinfo','--list'],
|
|
['clinfo','--raw'], # machine friendly
|
|
['eglinfo',''],
|
|
['eglinfo','-B'],
|
|
['es2_info',''],
|
|
['glxinfo',''],
|
|
['glxinfo','-B'],
|
|
['kded','--version'],
|
|
['kded1','--version'],
|
|
['kded2','--version'],
|
|
['kded3','--version'],
|
|
['kded4','--version'],
|
|
['kded5','--version'],
|
|
['kded6','--version'],
|
|
['kded7','--version'],
|
|
['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',''], # not packaged as far as I know yet
|
|
['weston-info',''],
|
|
['wmctrl','-m'],
|
|
['weston','--version'],
|
|
['wlr-randr',''],
|
|
['xdpyinfo',''],
|
|
['xdriinfo',''],
|
|
['Xorg','-version'],
|
|
['xprop','-root'],
|
|
['xrandr',''],
|
|
['Xvesa','-version'],
|
|
['Xvesa','-listmodes'],
|
|
['Xwayland','-version'],
|
|
);
|
|
run_commands(\@cmds,'display');
|
|
}
|
|
|
|
sub network_data {
|
|
print "Collecting networking data...\n";
|
|
# no warnings 'uninitialized';
|
|
my @cmds = (
|
|
['ifconfig',''], # no version maybe in bsd, --version in linux
|
|
['ip','-Version'],
|
|
['ip','addr'],
|
|
['ip','-s link'],
|
|
);
|
|
run_commands(\@cmds,'network');
|
|
}
|
|
|
|
sub perl_modules {
|
|
print "Collecting Perl module data (this can take a while)...\n";
|
|
my @modules;
|
|
my ($dirname,$holder,$mods,$value) = ('','','','');
|
|
my $filename = 'perl-modules.txt';
|
|
my @inc;
|
|
foreach (sort @INC){
|
|
# some BSD installs have '.' n @INC path
|
|
if (-d $_ && $_ ne '.'){
|
|
$_ =~ s/\/$//; # just in case, trim off trailing slash
|
|
$value .= "EXISTS: $_\n";
|
|
push(@inc, $_);
|
|
}
|
|
else {
|
|
$value .= "ABSENT: $_\n";
|
|
}
|
|
}
|
|
main::writer("$data_dir/perl-inc-data.txt",$value);
|
|
File::Find::find({ wanted => sub {
|
|
push(@modules, File::Spec->canonpath($_)) if /\.pm\z/
|
|
}, no_chdir => 1 }, @inc);
|
|
@modules = sort @modules;
|
|
foreach (@modules){
|
|
my $dir = $_;
|
|
$dir =~ s/[^\/]+$//;
|
|
if (!$holder || $holder ne $dir){
|
|
$holder = $dir;
|
|
$value = "DIR: $dir\n";
|
|
$_ =~ s/^$dir//;
|
|
$value .= " $_\n";
|
|
}
|
|
else {
|
|
$value = $_;
|
|
$value =~ s/^$dir//;
|
|
$value = " $value\n";
|
|
}
|
|
$mods .= $value;
|
|
}
|
|
open(my $fh, '>', "$data_dir/$filename");
|
|
print $fh $mods;
|
|
close $fh;
|
|
}
|
|
|
|
sub system_data {
|
|
print "Collecting system data...\n";
|
|
# has to run here because if null, error, list constructor throws fatal error
|
|
my $ksh = qx(ksh -c 'printf \%s "\$KSH_VERSION"' 2>/dev/null);
|
|
my %data = (
|
|
'cc' => $ENV{'CC'},
|
|
# @(#)MIRBSD KSH R56 2018/03/09: ksh and mksh
|
|
'ksh-version' => $ksh, # shell, not env, variable
|
|
'manpath' => $ENV{'MANPATH'},
|
|
'path' => $ENV{'PATH'},
|
|
'shell' => $ENV{'SHELL'},
|
|
'xdg-config-home' => $ENV{'XDG_CONFIG_HOME'},
|
|
'xdg-config-dirs' => $ENV{'XDG_CONFIG_DIRS'},
|
|
'xdg-data-home' => $ENV{'XDG_DATA_HOME'},
|
|
'xdg-data-dirs' => $ENV{'XDG_DATA_DIRS'},
|
|
);
|
|
my @files = main::globber('/usr/bin/gcc*');
|
|
if (@files){
|
|
$data{'gcc-versions'} = join("\n", @files);
|
|
}
|
|
else {
|
|
$data{'gcc-versions'} = undef;
|
|
}
|
|
@files = main::globber('/sys/*');
|
|
if (@files){
|
|
$data{'sys-tree-ls-1-basic'} = join("\n", @files);
|
|
}
|
|
else {
|
|
$data{'sys-tree-ls-1-basic'} = undef;
|
|
}
|
|
write_data(\%data,'system');
|
|
# bsd tools http://cb.vu/unixtoolbox.xhtml
|
|
my @cmds = (
|
|
# general
|
|
['sysctl', '-a'],
|
|
['sysctl', '-b kern.geom.conftxt'],
|
|
['sysctl', '-b kern.geom.confxml'],
|
|
['usbdevs','-v'],
|
|
# freebsd
|
|
['ofwdump','-a'], # arm / soc
|
|
['ofwdump','-ar'], # arm / soc
|
|
['pciconf','-l -cv'],
|
|
['pciconf','-vl'],
|
|
['pciconf','-l'],
|
|
['usbconfig','dump_device_desc'],
|
|
['usbconfig','list'], # needs root, sigh... why?
|
|
# openbsd
|
|
['ofctl',''], # arm / soc, need to see data sample of this
|
|
['pcidump',''],
|
|
['pcidump','-v'],
|
|
# netbsd
|
|
['kldstat',''],
|
|
['pcictl','pci0 list'],
|
|
['pcictl','pci0 list -N'],
|
|
['pcictl','pci0 list -n'],
|
|
# sunos
|
|
['prtdiag',''],
|
|
['prtdiag','-v'],
|
|
);
|
|
run_commands(\@cmds,'system-bsd');
|
|
# diskinfo -v <disk>
|
|
# fdisk <disk>
|
|
@cmds = (
|
|
['clang','--version'],
|
|
# only for prospective ram feature data collection: requires i2c-tools and module eeprom loaded
|
|
['decode-dimms',''],
|
|
['dmidecode','--version'],
|
|
['dmidecode',''],
|
|
['dmesg',''],
|
|
['gcc','--version'],
|
|
['getconf','-a'],
|
|
['getconf','-l'], # openbsd
|
|
['initctl','list'],
|
|
['ipmi-sensors','-V'], # version
|
|
['ipmi-sensors',''],
|
|
['ipmi-sensors','--output-sensor-thresholds'],
|
|
['ipmitool','-V'],# version
|
|
['ipmitool','sensor'],
|
|
['lscpu',''],# part of util-linux
|
|
['lsmem',''],
|
|
['lsmem','--all'],
|
|
['lspci','--version'],
|
|
['lspci',''],
|
|
['lspci','-k'],
|
|
['lspci','-n'],
|
|
['lspci','-nn'],
|
|
['lspci','-nnk'],
|
|
['lspci','-nnkv'],# returns ports
|
|
['lspci','-nnv'],
|
|
['lspci','-mm'],
|
|
['lspci','-mmk'],
|
|
['lspci','-mmkv'],
|
|
['lspci','-mmv'],
|
|
['lspci','-mmnn'],
|
|
['lspci','-v'],
|
|
['lsusb','--version'],
|
|
['lsusb',''],
|
|
['lsusb','-t'],
|
|
['lsusb','-v'],
|
|
['ps','aux'],
|
|
['ps','-e'],
|
|
['ps','-p 1'],
|
|
['runlevel',''],
|
|
['rc-status','-a'],
|
|
['rc-status','-l'],
|
|
['rc-status','-r'],
|
|
['sensors','--version'],
|
|
['sensors',''],
|
|
['sensors','-j'],
|
|
['sensors','-u'],
|
|
# leaving this commented out to remind that some systems do not
|
|
# support strings --version, but will just simply hang at that command
|
|
# which you can duplicate by simply typing: strings then hitting enter.
|
|
# ['strings','--version'],
|
|
['strings','present'],
|
|
['sysctl','-a'],
|
|
['systemctl','--version'],
|
|
['systemctl','get-default'],
|
|
['systemctl','list-units'],
|
|
['systemctl','list-units --type=target'],
|
|
['systemd-detect-virt',''],
|
|
['uname','-a'],
|
|
['upower','-e'],
|
|
['uptime',''],
|
|
['vcgencmd','get_mem arm'],
|
|
['vcgencmd','get_mem gpu'],
|
|
);
|
|
run_commands(\@cmds,'system');
|
|
my $glob = '/sys/devices/system/cpu/';
|
|
$glob .= '{cpufreq,cpu*/topology,cpu*/cpufreq,cpu*/cache/index*,smt,';
|
|
$glob .= 'vulnerabilities}/*';
|
|
get_glob('sys','cpu',$glob);
|
|
@files = main::globber('/dev/bus/usb/*/*');
|
|
copy_files(\@files, 'system');
|
|
}
|
|
|
|
sub system_files {
|
|
print "Collecting system files data...\n";
|
|
my (%data,@files,@files2);
|
|
@files = RepoItem::get($data_dir);
|
|
copy_files(\@files, 'repo');
|
|
# chdir "/etc";
|
|
@files = main::globber('/etc/*[-_]{[rR]elease,[vV]ersion,issue}*');
|
|
push(@files, '/etc/issue','
|
|
/etc/lsb-release',
|
|
'/etc/os-release',
|
|
'/system/build.prop', # android data file, requires rooted
|
|
'/var/log/installer/oem-id'); # ubuntu only for oem installs?
|
|
copy_files(\@files,'system-distro');
|
|
@files = main::globber('/etc/upstream[-_]{[rR]elease,[vV]ersion}/*');
|
|
copy_files(\@files,'system-distro');
|
|
@files = main::globber('/etc/calamares/branding/*/branding.desc');
|
|
copy_files(\@files,'system-distro');
|
|
@files = (
|
|
'/etc/systemd/system/default.target',
|
|
'/proc/1/comm',
|
|
'/proc/cmdline',
|
|
'/proc/cpuinfo',
|
|
'/proc/iomem',
|
|
'/proc/meminfo',
|
|
'/proc/modules',
|
|
'/proc/net/arp',
|
|
'/proc/version',
|
|
);
|
|
@files2=main::globber('/sys/class/power_supply/*/uevent');
|
|
if (@files2){
|
|
push(@files,@files2);
|
|
}
|
|
else {
|
|
push(@files, '/sys-class-power-supply-empty');
|
|
}
|
|
copy_files(\@files, 'system');
|
|
@files = (
|
|
'/etc/make.conf',
|
|
'/etc/src.conf',
|
|
'/var/run/dmesg.boot',
|
|
);
|
|
copy_files(\@files,'system-bsd');
|
|
@files = main::globber('/sys/devices/system/cpu/vulnerabilities/*');
|
|
copy_files(\@files,'security');
|
|
}
|
|
|
|
## SELF EXECUTE FOR LOG/OUTPUT
|
|
sub run_self {
|
|
print "Creating $self_name output file now. This can take a few seconds...\n";
|
|
print "Starting $self_name from: $self_path\n";
|
|
my $args = '-FERfJLrploudma --slots --pkg --edid';
|
|
my $a = ($debugger{'arg'}) ? ' ' . $debugger{'arg'} : '';
|
|
my $i = ($option eq 'main-full')? ' -i' : '';
|
|
my $z = ($debugger{'filter'}) ? ' -z' : '';
|
|
my $w = ($debugger{'width'}) ? $debugger{'width'} : 120;
|
|
$args = $debugger{'arg-use'} if $debugger{'arg-use'};
|
|
$args = "$args$a$i$z --debug 10 -y $w";
|
|
my $arg_string = $args;
|
|
$arg_string =~ s/\s//g;
|
|
my $self_file = "$data_dir/$self_name$arg_string.txt";
|
|
my $cmd = "$self_path/$self_name $args > $self_file 2>&1";
|
|
# print "Args: $args\nArg String: $arg_string\n";exit;
|
|
system($cmd);
|
|
copy($log_file, "$data_dir") or main::error_handler('copy-failed', "$log_file", "$!");
|
|
system("$self_path/$self_name --recommends -y 120 > $data_dir/$self_name-recommends-120.txt 2>&1");
|
|
}
|
|
|
|
## UTILITIES COPY/CMD/WRITE
|
|
sub copy_files {
|
|
my ($files_ref,$type,$alt_dir) = @_;
|
|
my ($absent,$error,$good,$name,$unreadable);
|
|
my $directory = ($alt_dir) ? $alt_dir : $data_dir;
|
|
my $working = ($type ne 'proc') ? "$type-file-": '';
|
|
foreach (@$files_ref){
|
|
$name = $_;
|
|
$name =~ s/^\///;
|
|
$name =~ s/\//~/g;
|
|
# print "$name\n" if $type eq 'proc';
|
|
$name = "$directory/$working$name";
|
|
$good = $name . '.txt';
|
|
$absent = $name . '-absent';
|
|
$error = $name . '-error';
|
|
$unreadable = $name . '-unreadable';
|
|
# proc have already been tested for readable/exists
|
|
if ($type eq 'proc' || -e $_){
|
|
print "F:$_\n" if $type eq 'proc' && $debugger{'proc-print'};
|
|
if ($type eq 'proc' || -r $_){
|
|
copy($_,"$good") or main::toucher($error);
|
|
}
|
|
else {
|
|
main::toucher($unreadable);
|
|
}
|
|
}
|
|
else {
|
|
main::toucher($absent);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub run_commands {
|
|
my ($cmds,$type) = @_;
|
|
my $holder = '';
|
|
my ($name,$cmd,$args);
|
|
foreach my $rows (@$cmds){
|
|
if (my $program = main::check_program($rows->[0])){
|
|
if ($rows->[1] eq 'present'){
|
|
$name = "$data_dir/$type-cmd-$rows->[0]-present";
|
|
main::toucher($name);
|
|
}
|
|
else {
|
|
$args = $rows->[1];
|
|
$args =~ s/\s|--|\/|=/-/g; # for:
|
|
$args =~ s/--/-/g;# strip out -- that result from the above
|
|
$args =~ s/^-//g;
|
|
$args = "-$args" if $args;
|
|
$name = "$data_dir/$type-cmd-$rows->[0]$args.txt";
|
|
$cmd = "$program $rows->[1] >$name 2>&1";
|
|
system($cmd);
|
|
}
|
|
}
|
|
else {
|
|
if ($holder ne $rows->[0]){
|
|
$name = "$data_dir/$type-cmd-$rows->[0]-absent";
|
|
main::toucher($name);
|
|
$holder = $rows->[0];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub get_glob {
|
|
my ($type,$id,$glob) = @_;
|
|
my @files = main::globber($glob);
|
|
return if !@files;
|
|
my ($item,@result);
|
|
foreach (sort @files){
|
|
next if -d $_;
|
|
if (-r $_) {
|
|
$item = main::reader($_,'strip',0);
|
|
}
|
|
else {
|
|
$item = main::message('root-required');
|
|
}
|
|
$item = main::message('undefined') if !defined $item;
|
|
push(@result,$_ . '::' . $item);
|
|
}
|
|
# print Data::Dumper::Dumper \@result;
|
|
main::writer("$data_dir/$type-data-$id-glob.txt",\@result);
|
|
}
|
|
|
|
sub write_data {
|
|
my ($data_ref, $type) = @_;
|
|
my ($empty,$error,$fh,$good,$name,$undefined,$value);
|
|
foreach (keys %$data_ref){
|
|
$value = $data_ref->{$_};
|
|
$name = "$data_dir/$type-data-$_";
|
|
$good = $name . '.txt';
|
|
$empty = $name . '-empty';
|
|
$error = $name . '-error';
|
|
$undefined = $name . '-undefined';
|
|
if (defined $value){
|
|
if ($value || $value eq '0'){
|
|
open($fh, '>', $good) or main::toucher($error);
|
|
print $fh "$value";
|
|
}
|
|
else {
|
|
main::toucher($empty);
|
|
}
|
|
}
|
|
else {
|
|
main::toucher($undefined);
|
|
}
|
|
}
|
|
}
|
|
|
|
## TOOLS FOR DIRECTORY TREE/LS/TRAVERSE; UPLOADER
|
|
sub build_tree {
|
|
my ($which) = @_;
|
|
if ($which eq 'sys' && main::check_program('tree')){
|
|
print "Constructing /$which tree data...\n";
|
|
my $dirname = '/sys';
|
|
my $cmd;
|
|
system("tree -a -L 10 /sys > $data_dir/sys-data-tree-full-10.txt");
|
|
opendir(my $dh, $dirname) or main::error_handler('open-dir',"$dirname", "$!");
|
|
my @files = readdir($dh);
|
|
closedir $dh;
|
|
foreach (@files){
|
|
next if /^\./;
|
|
$cmd = "tree -a -L 10 $dirname/$_ > $data_dir/sys-data-tree-$_-10.txt";
|
|
# print "$cmd\n";
|
|
system($cmd);
|
|
}
|
|
}
|
|
print "Constructing /$which ls data...\n";
|
|
if ($which eq 'sys'){
|
|
directory_ls($which,1);
|
|
directory_ls($which,2);
|
|
directory_ls($which,3);
|
|
directory_ls($which,4);
|
|
}
|
|
elsif ($which eq 'proc'){
|
|
directory_ls('proc',1);
|
|
directory_ls('proc',2,'[a-z]');
|
|
# don't want the /proc/self or /proc/thread-self directories, those are
|
|
# too invasive
|
|
#directory_ls('proc',3,'[a-z]');
|
|
#directory_ls('proc',4,'[a-z]');
|
|
}
|
|
}
|
|
|
|
# include is basic regex for ls path syntax, like [a-z]
|
|
sub directory_ls {
|
|
my ($dir,$depth,$include) = @_;
|
|
$include ||= '';
|
|
my ($exclude) = ('');
|
|
# we do NOT want to see anything in self or thread-self!!
|
|
# $exclude = 'I self -I thread-self' if $dir eq 'proc';
|
|
my $cmd = do {
|
|
if ($depth == 1){ "ls -l $exclude /$dir/$include 2>/dev/null" }
|
|
elsif ($depth == 2){ "ls -l $exclude /$dir/$include*/ 2>/dev/null" }
|
|
elsif ($depth == 3){ "ls -l $exclude /$dir/$include*/*/ 2>/dev/null" }
|
|
elsif ($depth == 4){ "ls -l $exclude /$dir/$include*/*/*/ 2>/dev/null" }
|
|
elsif ($depth == 5){ "ls -l $exclude /$dir/$include*/*/*/*/ 2>/dev/null" }
|
|
elsif ($depth == 6){ "ls -l $exclude /$dir/$include*/*/*/*/*/ 2>/dev/null" }
|
|
};
|
|
my @working;
|
|
my $output = '';
|
|
my ($type);
|
|
my $result = qx($cmd);
|
|
open(my $ch, '<', \$result) or main::error_handler('open-data',"$cmd", "$!");
|
|
while (my $line = <$ch>){
|
|
chomp($line);
|
|
$line =~ s/^\s+|\s+$//g;
|
|
@working = split(/\s+/, $line);
|
|
$working[0] ||= '';
|
|
if (scalar @working > 7){
|
|
if ($working[0] =~ /^d/){
|
|
$type = "d - ";
|
|
}
|
|
elsif ($working[0] =~ /^l/){
|
|
$type = "l - ";
|
|
}
|
|
elsif ($working[0] =~ /^c/){
|
|
$type = "c - ";
|
|
}
|
|
else {
|
|
$type = "f - ";
|
|
}
|
|
$working[9] ||= '';
|
|
$working[10] ||= '';
|
|
$output = $output . " $type$working[8] $working[9] $working[10]\n";
|
|
}
|
|
elsif ($working[0] !~ /^total/){
|
|
$output = $output . $line . "\n";
|
|
}
|
|
}
|
|
close $ch;
|
|
my $file = "$data_dir/$dir-data-ls-$depth.txt";
|
|
open(my $fh, '>', $file) or main::error_handler('create',"$file", "$!");
|
|
print $fh $output;
|
|
close $fh;
|
|
# print "$output\n";
|
|
}
|
|
|
|
sub proc_traverse_data {
|
|
print "Building /proc file list...\n";
|
|
# get rid pointless error:Can't cd to (/sys/kernel/) debug: Permission denied
|
|
#no warnings 'File::Find';
|
|
no warnings;
|
|
$parse_src = 'proc';
|
|
File::Find::find(\&wanted, "/proc");
|
|
process_proc_traverse();
|
|
@content = ();
|
|
}
|
|
|
|
sub process_proc_traverse {
|
|
my ($data,$fh,$result,$row,$sep);
|
|
my $proc_dir = "$data_dir/proc";
|
|
print "Adding /proc files...\n";
|
|
mkdir $proc_dir or main::error_handler('mkdir', "$proc_dir", "$!");
|
|
# @content = sort @content;
|
|
copy_files(\@content,'proc',$proc_dir);
|
|
# foreach (@content){print "$_\n";}
|
|
}
|
|
|
|
sub sys_traverse_data {
|
|
print "Building /sys file list...\n";
|
|
# get rid pointless error:Can't cd to (/sys/kernel/) debug: Permission denied
|
|
#no warnings 'File::Find';
|
|
no warnings;
|
|
$parse_src = 'sys';
|
|
File::Find::find(\&wanted, "/sys");
|
|
process_sys_traverse();
|
|
@content = ();
|
|
}
|
|
|
|
sub process_sys_traverse {
|
|
my ($data,$fh,$result,$row,$sep);
|
|
my $filename = "sys-data-parse.txt";
|
|
print "Parsing /sys files...\n";
|
|
# no sorts, we want the order it comes in
|
|
# @content = sort @content;
|
|
foreach (@content){
|
|
$data='';
|
|
$sep='';
|
|
my $b_fh = 1;
|
|
print "F:$_\n" if $debugger{'sys-print'};
|
|
open($fh, '<', $_) or $b_fh = 0;
|
|
# needed for removing -T test and root
|
|
if ($b_fh){
|
|
while ($row = <$fh>){
|
|
chomp($row);
|
|
$data .= $sep . '"' . $row . '"';
|
|
$sep=', ';
|
|
}
|
|
}
|
|
else {
|
|
$data = '<unreadable>';
|
|
}
|
|
$result .= "$_:[$data]\n";
|
|
# print "$_:[$data]\n"
|
|
}
|
|
# print scalar @content . "\n";
|
|
open($fh, '>', "$data_dir/$filename");
|
|
print $fh $result;
|
|
close $fh;
|
|
# print $fh "$result";
|
|
}
|
|
|
|
# perl compiler complains on start if prune = 1 used only once, so either
|
|
# do $File::Find::prune = 1 if !$File::Find::prune; OR use no warnings 'once'
|
|
sub wanted {
|
|
# note: we want these directories pruned before the -d test so find
|
|
# doesn't try to read files inside of the directories
|
|
if ($parse_src eq 'proc'){
|
|
if ($File::Find::name =~ m!^/proc/[0-9]+! ||
|
|
# /proc/registry is from cygwin, we never want to see that
|
|
$File::Find::name =~ m!^/proc/(irq|spl|sys|reg)! ||
|
|
# these choke on sudo/root: kmsg kcore kpage and we don't want keys or kallsyms
|
|
$File::Find::name =~ m!^/proc/k! ||
|
|
$File::Find::name =~ m!^/proc/bus/pci!){
|
|
$File::Find::prune = 1;
|
|
return;
|
|
}
|
|
}
|
|
elsif ($parse_src eq 'sys'){
|
|
# note: a new file in 4.11 /sys can hang this, it is /parameter/ then
|
|
# a few variables. Since inxi does not need to see that file, we will
|
|
# not use it.
|
|
if ($File::Find::name =~ m!/(kernel/|trace/|parameters|debug)!){
|
|
$File::Find::prune = 1;
|
|
}
|
|
}
|
|
return if -d; # not directory
|
|
return unless -e; # Must exist
|
|
return unless -f; # Must be file
|
|
return unless -r; # Must be readable
|
|
if ($parse_src eq 'sys'){
|
|
# print $File::Find::name . "\n";
|
|
# block maybe: cfgroup\/
|
|
# picdec\/|, wait_for_fb_sleep/wake is an odroid thing caused hang
|
|
# wakeup_count also fails for android, but works fine on regular systems
|
|
return if $risc{'arm'} && $File::Find::name =~ m!^/sys/power/(wait_for_fb_|wakeup_count$)!;
|
|
# do not need . files or __ starting files
|
|
return if $File::Find::name =~ m!/\.[a-z]!;
|
|
# pp_num_states: amdgpu driver bug; android: wakeup_count
|
|
return if $File::Find::name =~ m!/pp_num_states$!;
|
|
# comment this one out if you experience hangs or if
|
|
# we discover syntax of foreign language characters
|
|
# Must be ascii like. This is questionable and might require further
|
|
# investigation, it is removing some characters that we might want
|
|
# NOTE: this made a bunch of files on arm systems unreadable so we handle
|
|
# the readable tests in copy_files()
|
|
# return unless -T;
|
|
}
|
|
elsif ($parse_src eq 'proc'){
|
|
return if $File::Find::name =~ m!(/mb_groups|debug)$!;
|
|
}
|
|
# print $File::Find::name . "\n";
|
|
push(@content, $File::Find::name);
|
|
return;
|
|
}
|
|
|
|
# args: 0: path to file to be uploaded; 1: optional: alternate ftp upload url
|
|
# NOTE: must be in format: ftp.site.com/incoming
|
|
sub upload_file {
|
|
my ($self, $ftp_url) = @_;
|
|
my ($ftp, $domain, $host, $user, $pass, $dir, $error);
|
|
$ftp_url ||= main::get_defaults('ftp-upload');
|
|
$ftp_url =~ s/\/$//g; # trim off trailing slash if present
|
|
my @url = split('/', $ftp_url);
|
|
my $file_path = "$user_data_dir/$debug_gz";
|
|
$host = $url[0];
|
|
$dir = $url[1];
|
|
$domain = $host;
|
|
$domain =~ s/^ftp\.//;
|
|
$user = "anonymous";
|
|
$pass = "anonymous\@$domain";
|
|
print $line3;
|
|
print "Uploading to: $ftp_url\n";
|
|
# print "$host $domain $dir $user $pass\n";
|
|
print "File to be uploaded:\n$file_path\n";
|
|
if ($host && ($file_path && -e $file_path)){
|
|
# NOTE: important: must explicitly set to passive true/1
|
|
$ftp = Net::FTP->new($host, Debug => 0, Passive => 1) || main::error_handler('ftp-connect', $ftp->message);
|
|
$ftp->login($user, $pass) || main::error_handler('ftp-login', $ftp->message);
|
|
$ftp->binary();
|
|
$ftp->cwd($dir);
|
|
print "Connected to FTP server.\n";
|
|
$ftp->put($file_path) || main::error_handler('ftp-upload', $ftp->message);
|
|
$ftp->quit;
|
|
print "Uploaded file successfully!\n";
|
|
print $ftp->message;
|
|
if ($debugger{'gz'}){
|
|
print "Removing debugger gz file:\n$file_path\n";
|
|
unlink $file_path or main::error_handler('remove',"$file_path", "$!");
|
|
print "File removed.\n";
|
|
}
|
|
print "Debugger data generation and upload completed. Thank you for your help.\n";
|
|
}
|
|
else {
|
|
main::error_handler('ftp-bad-path', "$file_path");
|
|
}
|
|
}
|
|
}
|
|
|
|
# random tests for various issues
|
|
sub user_debug_test_1 {
|
|
# open(my $duped, '>&', STDOUT);
|
|
# local *STDOUT = $duped;
|
|
# my $item = POSIX::strftime("%c", localtime);
|
|
# print "Testing character encoding handling. Perl IO data:\n";
|
|
# print(join(', ', PerlIO::get_layers(STDOUT)), "\n");
|
|
# print "Without binmode: ", $item,"\n";
|
|
# binmode STDOUT,":utf8";
|
|
# print "With binmode: ", $item,"\n";
|
|
# print "Perl IO data:\n";
|
|
# print(join(', ', PerlIO::get_layers(STDOUT)), "\n");
|
|
# close $duped;
|
|
}
|
|
|
|
# see docs/optimization.txt
|
|
sub ram_use {
|
|
my ($name, $ref) = @_;
|
|
printf "%-25s %5d %5d\n", $name, size($ref), total_size($ref);
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### DOWNLOADER
|
|
#### -------------------------------------------------------------------
|
|
|
|
# args: 0: download type; 1: url; 2: file; 3: [ua type string]
|
|
sub download_file {
|
|
my ($type, $url, $file,$ua) = @_;
|
|
my ($cmd,$args,$timeout) = ('','','');
|
|
my $debug_data = '';
|
|
my $result = 1;
|
|
$ua = ($ua && $dl{'ua'}) ? $dl{'ua'} . $ua : '';
|
|
$dl{'no-ssl'} ||= '';
|
|
$dl{'spider'} ||= '';
|
|
$file ||= 'N/A'; # to avoid debug error
|
|
if (!$dl{'dl'}){
|
|
return 0;
|
|
}
|
|
if ($dl{'timeout'}){
|
|
$timeout = "$dl{'timeout'}$dl_timeout";
|
|
}
|
|
# print "$dl{'no-ssl'}\n";
|
|
# print "$dl{'dl'}\n";
|
|
# tiny supports spider sort of
|
|
## NOTE: 1 is success, 0 false for Perl
|
|
if ($dl{'dl'} eq 'tiny'){
|
|
$cmd = "Using tiny: type: $type \nurl: $url \nfile: $file";
|
|
$result = get_file_http_tiny($type,$url,$file,$ua);
|
|
$debug_data = ($type ne 'stdout') ? $result : 'Success: stdout data not null.';
|
|
}
|
|
# But: 0 is success, and 1 is false for these
|
|
# when strings are returned, they will be taken as true
|
|
# urls must be " quoted in case special characters present
|
|
else {
|
|
if ($type eq 'stdout'){
|
|
$args = $dl{'stdout'};
|
|
$cmd = "$dl{'dl'} $dl{'no-ssl'} $ua $timeout $args \"$url\" $dl{'null'}";
|
|
$result = qx($cmd);
|
|
$debug_data = ($result) ? 'Success: stdout data not null.' : 'Download resulted in null data!';
|
|
}
|
|
elsif ($type eq 'file'){
|
|
$args = $dl{'file'};
|
|
$cmd = "$dl{'dl'} $dl{'no-ssl'} $ua $timeout $args $file \"$url\" $dl{'null'}";
|
|
system($cmd);
|
|
$result = ($?) ? 0 : 1; # reverse these into Perl t/f
|
|
$debug_data = $result;
|
|
}
|
|
elsif ($dl{'dl'} eq 'wget' && $type eq 'spider'){
|
|
$cmd = "$dl{'dl'} $dl{'no-ssl'} $ua $timeout $dl{'spider'} \"$url\"";
|
|
system($cmd);
|
|
$result = ($?) ? 0 : 1; # reverse these into Perl t/f
|
|
$debug_data = $result;
|
|
}
|
|
}
|
|
print "-------\nDownloader Data:\n$cmd\nResult: $debug_data\n" if $dbg[1];
|
|
log_data('data',"$cmd\nResult: $result") if $b_log;
|
|
return $result;
|
|
}
|
|
|
|
sub get_file_http_tiny {
|
|
my ($type,$url,$file,$ua) = @_;
|
|
$ua = ($ua && $dl{'ua'}) ? $dl{'ua'} . $ua: '';
|
|
my %headers = ($ua) ? ('agent' => $ua) : undef;
|
|
my $tiny = HTTP::Tiny->new(%headers);
|
|
# note: default is no verify, so default here actually is to verify unless overridden
|
|
$tiny->verify_SSL => 1 if !$use{'no-ssl'};
|
|
my $response = $tiny->get($url);
|
|
my $return = 1;
|
|
my $debug = 0;
|
|
my $fh;
|
|
$file ||= 'N/A';
|
|
log_data('dump','%{$response}',$response) if $b_log;
|
|
# print Dumper $response;
|
|
if (!$response->{'success'}){
|
|
my $content = $response->{'content'};
|
|
$content ||= "N/A\n";
|
|
my $msg = "Failed to connect to server/file!\n";
|
|
$msg .= "Response: ${content}Downloader: HTTP::Tiny URL: $url\nFile: $file";
|
|
log_data('data',$msg) if $b_log;
|
|
print error_defaults('download-error',$msg) if $dbg[1];
|
|
$return = 0;
|
|
}
|
|
else {
|
|
if ($debug){
|
|
print "$response->{success}\n";
|
|
print "$response->{status} $response->{reason}\n";
|
|
while (my ($key, $value) = each %{$response->{'headers'}}){
|
|
for (ref $value eq "ARRAY" ? @$value : $value){
|
|
print "$key: $_\n";
|
|
}
|
|
}
|
|
}
|
|
if ($type eq "stdout" || $type eq "ua-stdout"){
|
|
$return = $response->{'content'};
|
|
}
|
|
elsif ($type eq "spider"){
|
|
# do nothing, just use the return value
|
|
}
|
|
elsif ($type eq "file"){
|
|
open($fh, ">", $file);
|
|
print $fh $response->{'content'}; # or die "can't write to file!\n";
|
|
close $fh;
|
|
}
|
|
}
|
|
return $return;
|
|
}
|
|
|
|
sub set_downloader {
|
|
eval $start if $b_log;
|
|
my $quiet = '';
|
|
my $ua_raw = 's-tools/' . $self_name . '-';
|
|
$dl{'no-ssl'} = '';
|
|
$dl{'null'} = '';
|
|
$dl{'spider'} = '';
|
|
# we only want to use HTTP::Tiny if it's present in user system.
|
|
# It is NOT part of core modules. IO::Socket::SSL is also required
|
|
# For some https connections so only use tiny as option if both present
|
|
if ($dl{'tiny'}){
|
|
# this only for -U 4, grab file with ftp to avoid unsupported SSL issues
|
|
if ($use{'ftp-download'}){
|
|
$dl{'tiny'} = 0;
|
|
}
|
|
elsif (check_perl_module('HTTP::Tiny') && check_perl_module('IO::Socket::SSL')){
|
|
HTTP::Tiny->import;
|
|
IO::Socket::SSL->import;
|
|
$dl{'tiny'} = 1;
|
|
}
|
|
else {
|
|
$dl{'tiny'} = 0;
|
|
}
|
|
}
|
|
# print $dl{'tiny'} . "\n";
|
|
if ($dl{'tiny'}){
|
|
$dl{'dl'} = 'tiny';
|
|
$dl{'file'} = '';
|
|
$dl{'stdout'} = '';
|
|
$dl{'timeout'} = '';
|
|
$dl{'ua'} = $ua_raw;
|
|
}
|
|
elsif ($dl{'curl'} && check_program('curl')){
|
|
$quiet = '-s ' if !$dbg[1];
|
|
$dl{'dl'} = 'curl';
|
|
$dl{'file'} = " -L ${quiet}-o ";
|
|
$dl{'no-ssl'} = ' --insecure';
|
|
$dl{'stdout'} = " -L ${quiet}";
|
|
$dl{'timeout'} = ' -y ';
|
|
$dl{'ua'} = ' -A ' . $ua_raw;
|
|
}
|
|
elsif ($dl{'wget'} && check_program('wget')){
|
|
$quiet = '-q ' if !$dbg[1];
|
|
$dl{'dl'} = 'wget';
|
|
$dl{'file'} = " ${quiet}-O ";
|
|
$dl{'no-ssl'} = ' --no-check-certificate';
|
|
$dl{'spider'} = " ${quiet}--spider";
|
|
$dl{'stdout'} = " $quiet -O -";
|
|
$dl{'timeout'} = ' -T ';
|
|
$dl{'ua'} = ' -U ' . $ua_raw;
|
|
}
|
|
elsif ($dl{'fetch'} && check_program('fetch')){
|
|
$quiet = '-q ' if !$dbg[1];
|
|
$dl{'dl'} = 'fetch';
|
|
$dl{'file'} = " ${quiet}-o ";
|
|
$dl{'no-ssl'} = ' --no-verify-peer';
|
|
$dl{'stdout'} = " ${quiet}-o -";
|
|
$dl{'timeout'} = ' -T ';
|
|
$dl{'ua'} = ' --user-agent=' . $ua_raw;
|
|
}
|
|
# at least openbsd/netbsd
|
|
elsif ($bsd_type && check_program('ftp')){
|
|
$dl{'dl'} = 'ftp';
|
|
$dl{'file'} = ' -o ';
|
|
$dl{'null'} = ' 2>/dev/null';
|
|
$dl{'stdout'} = ' -o - ';
|
|
$dl{'timeout'} = '';
|
|
$dl{'ua'} = ' -U ' . $ua_raw;
|
|
}
|
|
else {
|
|
$dl{'dl'} = '';
|
|
}
|
|
# $use{'no-ssl' is set to 1 with --no-ssl, when false, unset to ''
|
|
$dl{'no-ssl'} = '' if !$use{'no-ssl'};
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_perl_downloader {
|
|
my ($downloader) = @_;
|
|
$downloader =~ s/perl/tiny/;
|
|
return $downloader;
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### ERROR HANDLER
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub error_handler {
|
|
eval $start if $b_log;
|
|
my ($err,$one,$two) = @_;
|
|
my ($b_help,$b_recommends);
|
|
my ($b_exit,$errno) = (1,0);
|
|
my $message = do {
|
|
if ($err eq 'empty'){ 'empty value' }
|
|
## Basic rules
|
|
elsif ($err eq 'not-in-irc'){
|
|
$errno=1; "You can't run option $one in an IRC client!" }
|
|
## Internal/external options
|
|
elsif ($err eq 'bad-arg'){
|
|
$errno=10; $b_help=1; "Unsupported value: $two for option: $one" }
|
|
elsif ($err eq 'bad-arg-int'){
|
|
$errno=11; "Bad internal argument: $one" }
|
|
elsif ($err eq 'distro-block'){
|
|
$errno=20; "Option: $one has been disabled by the $self_name distribution maintainer." }
|
|
elsif ($err eq 'option-feature-incomplete'){
|
|
$errno=21; "Option: '$one' feature: '$two' has not been implemented yet." }
|
|
elsif ($err eq 'unknown-option'){
|
|
$errno=22; $b_help=1; "Unsupported option: $one" }
|
|
## Data
|
|
elsif ($err eq 'open-data'){
|
|
$errno=32; "Error opening data for reading: $one \nError: $two" }
|
|
elsif ($err eq 'download-error'){
|
|
$errno=33; "Error downloading file with $dl{'dl'}: $one \nError: $two" }
|
|
## Files:
|
|
elsif ($err eq 'copy-failed'){
|
|
$errno=40; "Error copying file: $one \nError: $two" }
|
|
elsif ($err eq 'create'){
|
|
$errno=41; "Error creating file: $one \nError: $two" }
|
|
elsif ($err eq 'downloader-error'){
|
|
$errno=42; "Error downloading file: $one \nfor download source: $two" }
|
|
elsif ($err eq 'file-corrupt'){
|
|
$errno=43; "Downloaded file is corrupted: $one" }
|
|
elsif ($err eq 'mkdir'){
|
|
$errno=44; "Error creating directory: $one \nError: $two" }
|
|
elsif ($err eq 'open'){
|
|
$errno=45; $b_exit=0; "Error opening file: $one \nError: $two" }
|
|
elsif ($err eq 'open-dir'){
|
|
$errno=46; "Error opening directory: $one \nError: $two" }
|
|
elsif ($err eq 'output-file-bad'){
|
|
$errno=47; "Value for --output-file must be full path, a writable directory, \nand include file name. Path: $two" }
|
|
elsif ($err eq 'not-writable'){
|
|
$errno=48; "The file: $one is not writable!" }
|
|
elsif ($err eq 'open-dir-failed'){
|
|
$errno=49; "The directory: $one failed to open with error: $two" }
|
|
elsif ($err eq 'remove'){
|
|
$errno=50; "Failed to remove file: $one Error: $two" }
|
|
elsif ($err eq 'rename'){
|
|
$errno=51; "There was an error moving files: $one\nError: $two" }
|
|
elsif ($err eq 'write'){
|
|
$errno=52; "Failed writing file: $one - Error: $two!" }
|
|
elsif ($err eq 'dir-missing'){
|
|
$errno=53; "Directory supplied for option $one does not exist:\n $two" }
|
|
## Downloaders
|
|
elsif ($err eq 'missing-downloader'){
|
|
$errno=60; "Downloader program $two could not be located on your system." }
|
|
elsif ($err eq 'missing-perl-downloader'){
|
|
$errno=61; $b_recommends=1; "Perl downloader missing required module." }
|
|
## FTP
|
|
elsif ($err eq 'ftp-bad-path'){
|
|
$errno=70; "Unable to locate for FTP upload file:\n$one" }
|
|
elsif ($err eq 'ftp-connect'){
|
|
$errno=71; "There was an error with connection to ftp server: $one" }
|
|
elsif ($err eq 'ftp-login'){
|
|
$errno=72; "There was an error with login to ftp server: $one" }
|
|
elsif ($err eq 'ftp-upload'){
|
|
$errno=73; "There was an error with upload to ftp server: $one" }
|
|
## Modules
|
|
elsif ($err eq 'required-module'){
|
|
$errno=80; $b_recommends=1; "The required $one Perl module is not installed:\n$two" }
|
|
## Programs
|
|
elsif ($err eq 'required-program'){
|
|
$errno=90; "Required program '$one' could not be located on your system.\nNeeded for: $two" }
|
|
## DEFAULT
|
|
else {
|
|
$errno=255; "Error handler ERROR!! Unsupported options: $err!"}
|
|
};
|
|
print_line("Error $errno: $message\n");
|
|
if ($b_help){
|
|
print_line("Check -h for correct parameters.\n");
|
|
}
|
|
if ($b_recommends){
|
|
print_line("See --recommends for more information.\n");
|
|
}
|
|
eval $end if $b_log;
|
|
exit $errno if $b_exit && !$debugger{'no-exit'};
|
|
}
|
|
|
|
sub error_defaults {
|
|
my ($type,$one) = @_;
|
|
$one ||= '';
|
|
my %errors = (
|
|
'download-error' => "Download Failure:\n$one\n",
|
|
);
|
|
return $errors{$type};
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### RECOMMENDS
|
|
#### -------------------------------------------------------------------
|
|
|
|
## CheckRecommends
|
|
{
|
|
package CheckRecommends;
|
|
my ($item_data,@modules,@pms);
|
|
|
|
sub run {
|
|
main::error_handler('not-in-irc', 'recommends') if $b_irc;
|
|
my (@data,@rows);
|
|
my $rows = [];
|
|
my $line = main::make_line();
|
|
@pms = get_pms();
|
|
set_item_data();
|
|
basic_data($rows,$line);
|
|
if (!$bsd_type){
|
|
check_items($rows,'required system directories',$line);
|
|
}
|
|
check_items($rows,'recommended system programs',$line);
|
|
check_items($rows,'recommended display information programs',$line);
|
|
check_items($rows,'recommended downloader programs',$line);
|
|
if (!$bsd_type){
|
|
check_items($rows,'recommended kernel modules',$line);
|
|
}
|
|
check_items($rows,'recommended Perl modules',$line);
|
|
check_items($rows,'recommended directories',$line);
|
|
check_items($rows,'recommended files',$line);
|
|
push(@$rows,
|
|
['0', '', '', "$line"],
|
|
['0', '', '', "Ok, all done with the checks. Have a nice day."],
|
|
['0', '', '', ''],
|
|
);
|
|
# print Data::Dumper::Dumper $rows;
|
|
main::print_basic($rows);
|
|
exit 0; # shell true
|
|
}
|
|
|
|
sub basic_data {
|
|
my ($rows,$line) = @_;
|
|
my (@data,@rows);
|
|
$extra = 1; # needed for shell version
|
|
ShellData::set();
|
|
my $client = $client{'name-print'};
|
|
$client .= ' ' . $client{'version'} if $client{'version'};
|
|
my $default_shell = 'N/A';
|
|
if ($ENV{'SHELL'}){
|
|
$default_shell = $ENV{'SHELL'};
|
|
$default_shell =~ s/.*\///;
|
|
}
|
|
my $sh = main::check_program('sh');
|
|
my $sh_real = Cwd::abs_path($sh);
|
|
push(@$rows,
|
|
['0', '', '', "$self_name will now begin checking for the programs it needs
|
|
to operate."],
|
|
['0', '', '', ""],
|
|
['0', '', '', "Check $self_name --help or the man page (man $self_name)
|
|
to see what options are available."],
|
|
['0', '', '', "$line"],
|
|
['0', '', '', "Test: core tools:"],
|
|
['0', '', '', ""],
|
|
['0', '', '', "Perl version: ^$]"],
|
|
['0', '', '', "Current shell: " . $client],
|
|
['0', '', '', "Default shell: " . $default_shell],
|
|
['0', '', '', "sh links to: $sh_real"],
|
|
);
|
|
if (scalar @pms == 0){
|
|
push(@$rows,['0', '', '', "Package manager(s): No supported PM(s) detected"]);
|
|
}
|
|
elsif (scalar @pms == 1){
|
|
push(@$rows,['0', '', '', "Package manager: $pms[0]"]);
|
|
}
|
|
else {
|
|
push(@$rows,['0', '', '', "Package managers detected:"]);
|
|
foreach my $pm (@pms){
|
|
push(@$rows,['0', '', '', " pm: $pm"]);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub check_items {
|
|
my ($rows,$type,$line) = @_;
|
|
my (@data,@missing,$row,$result,@unreadable);
|
|
my ($b_dir,$b_file,$b_kernel_module,$b_perl_module,$b_program,$item);
|
|
my ($about,$extra,$extra2,$extra3,$extra4,$info_os) = ('','','','','','info');
|
|
if ($type eq 'required system directories'){
|
|
@data = qw(/proc /sys);
|
|
$b_dir = 1;
|
|
$item = 'Directory';
|
|
}
|
|
elsif ($type eq 'recommended system programs'){
|
|
if ($bsd_type){
|
|
@data = qw(camcontrol dig disklabel dmidecode doas fdisk file glabel gpart
|
|
ifconfig ipmi-sensors ipmitool pciconfig pcidump pcictl smartctl sudo
|
|
sysctl tree upower uptime usbconfig usbdevs);
|
|
$info_os = 'info-bsd';
|
|
}
|
|
else {
|
|
@data = qw(blockdev bt-adapter btmgmt dig dmidecode doas fdisk file
|
|
fruid_print hciconfig hddtemp ifconfig ip ipmitool ipmi-sensors lsblk
|
|
lsusb lvs mdadm modinfo runlevel sensors smartctl strings sudo tree upower
|
|
uptime);
|
|
}
|
|
$b_program = 1;
|
|
$item = 'Program';
|
|
$extra2 = "Note: IPMI sensors are generally only found on servers. To access
|
|
that data, you only need one of the ipmi items.";
|
|
}
|
|
elsif ($type eq 'recommended display information programs'){
|
|
if ($bsd_type){
|
|
@data = qw(eglinfo glxinfo vulkaninfo wmctrl xdpyinfo xprop xdriinfo
|
|
xrandr);
|
|
$info_os = 'info-bsd';
|
|
}
|
|
else {
|
|
@data = qw(eglinfo glxinfo vulkaninfo wmctrl xdpyinfo xprop xdriinfo
|
|
xrandr);
|
|
}
|
|
$b_program = 1;
|
|
$item = 'Program';
|
|
}
|
|
elsif ($type eq 'recommended downloader programs'){
|
|
if ($bsd_type){
|
|
@data = qw(curl dig fetch ftp wget);
|
|
$info_os = 'info-bsd';
|
|
}
|
|
else {
|
|
@data = qw(curl dig wget);
|
|
}
|
|
$b_program = 1;
|
|
$extra = ' (You only need one of these)';
|
|
$extra2 = "Perl HTTP::Tiny is the default downloader tool if IO::Socket::SSL is present.
|
|
See --help --alt 40-44 options for how to override default downloader(s) in case of issues. ";
|
|
$extra3 = "If dig is installed, it is the default for WAN IP data.
|
|
Strongly recommended. Dig is fast and accurate.";
|
|
$extra4 = ". However, you really only need dig in most cases. All systems should have ";
|
|
$extra4 .= "at least one of the downloader options present.";
|
|
$item = 'Program';
|
|
}
|
|
elsif ($type eq 'recommended Perl modules'){
|
|
@data = qw(File::Copy File::Find File::Spec::Functions HTTP::Tiny IO::Socket::SSL
|
|
Time::HiRes JSON::PP Cpanel::JSON::XS JSON::XS XML::Dumper Net::FTP);
|
|
if ($bsd_type && $bsd_type eq 'openbsd'){
|
|
push(@data, qw(OpenBSD::Pledge OpenBSD::Unveil));
|
|
}
|
|
$b_perl_module = 1;
|
|
$item = 'Perl Module';
|
|
$extra = ' (Optional)';
|
|
$extra2 = "None of these are strictly required, but if you have them all,
|
|
you can eliminate some recommended non Perl programs from the install. ";
|
|
$extra3 = "HTTP::Tiny and IO::Socket::SSL must both be present to use as a
|
|
downloader option. For json export Cpanel::JSON::XS is preferred over
|
|
JSON::XS, but JSON::PP is in core modules. To run --debug 20-22 File::Copy,
|
|
File::Find, and File::Spec::Functions must be present (most distros have
|
|
these in Core Modules).
|
|
";
|
|
}
|
|
elsif ($type eq 'recommended kernel modules'){
|
|
@data = qw(amdgpu drivetemp nouveau radeon);
|
|
@modules = main::lister('/sys/module/');
|
|
$b_kernel_module = 1;
|
|
$extra2 = "GPU modules are only needed if applicable. NVMe drives do not need drivetemp
|
|
but other types do.";
|
|
$extra3 = "To load a module: modprobe <module-name> - To permanently load
|
|
add to /etc/modules or /etc/modules-load.d/modules.conf (check your system
|
|
paths for exact file/directory names).";
|
|
$item = 'Kernel Module';
|
|
}
|
|
elsif ($type eq 'recommended directories'){
|
|
if ($bsd_type){
|
|
@data = qw(/dev);
|
|
}
|
|
else {
|
|
@data = qw(/dev /dev/disk/by-id /dev/disk/by-label /dev/disk/by-path
|
|
/dev/disk/by-uuid /sys/class/dmi/id /sys/class/hwmon);
|
|
}
|
|
$b_dir = 1;
|
|
$item = 'Directory';
|
|
}
|
|
elsif ($type eq 'recommended files'){
|
|
if ($bsd_type){
|
|
@data = qw(/var/run/dmesg.boot /var/log/Xorg.0.log);
|
|
}
|
|
else {
|
|
@data = qw(/etc/lsb-release /etc/os-release /proc/asound/cards
|
|
/proc/asound/version /proc/cpuinfo /proc/mdstat /proc/meminfo /proc/modules
|
|
/proc/mounts /proc/scsi/scsi /var/log/Xorg.0.log);
|
|
}
|
|
$b_file = 1;
|
|
$item = 'File';
|
|
$extra2 = "Note that not all of these are used by every system,
|
|
so if one is missing it's usually not a big deal.";
|
|
}
|
|
push(@$rows,
|
|
['0', '', '', "$line" ],
|
|
['0', '', '', "Test: $type$extra:" ],
|
|
['0', '', '', ''],
|
|
);
|
|
if ($extra2){
|
|
push(@$rows,
|
|
['0', '', '', $extra2],
|
|
['0', '', '', '']);
|
|
}
|
|
if ($extra3){
|
|
push(@$rows,
|
|
['0', '', '', $extra3],
|
|
['0', '', '', '']);
|
|
}
|
|
foreach my $item (@data){
|
|
undef $about;
|
|
my $info = $item_data->{$item};
|
|
$about = $info->{$info_os};
|
|
if (($b_dir && -d $item) || ($b_file && -r $item) ||
|
|
($b_program && main::check_program($item)) ||
|
|
($b_perl_module && main::check_perl_module($item)) ||
|
|
($b_kernel_module && @modules && (grep {/^$item$/} @modules))){
|
|
$result = 'Present';
|
|
}
|
|
elsif ($b_file && -f $item){
|
|
$result = 'Unreadable';
|
|
push(@unreadable, "$item");
|
|
}
|
|
else {
|
|
$result = 'Missing';
|
|
push(@missing,"$item");
|
|
if (($b_program || $b_perl_module) && @pms){
|
|
my @install;
|
|
foreach my $pm (@pms){
|
|
$info->{$pm} ||= 'N/A';
|
|
push(@install," $pm: $info->{$pm}");
|
|
}
|
|
push(@missing,@install);
|
|
}
|
|
}
|
|
$row = make_row($item,$about,$result);
|
|
push(@$rows, ['0', '', '', $row]);
|
|
}
|
|
push(@$rows, ['0', '', '', '']);
|
|
if (@missing){
|
|
push(@$rows, ['0', '', '', "The following $type are missing$extra4:"]);
|
|
foreach (@missing){
|
|
push(@$rows, ['0', '', '', $_]);
|
|
}
|
|
}
|
|
if (@unreadable){
|
|
push(@$rows, ['0', '', '', "The following $type are not readable: "]);
|
|
foreach (@unreadable){
|
|
push(@$rows, ['0', '', '', "$item: $_"]);
|
|
}
|
|
}
|
|
if (!@missing && !@unreadable){
|
|
push(@$rows, ['0', '', '', "All $type are present"]);
|
|
}
|
|
}
|
|
|
|
sub set_item_data {
|
|
$item_data = {
|
|
## Directory Data ##
|
|
'/dev' => {
|
|
'info' => '-l,-u,-o,-p,-P,-D disk partition data',
|
|
},
|
|
'/dev/disk/by-id' => {
|
|
'info' => '-D serial numbers',
|
|
},
|
|
'/dev/disk/by-path' => {
|
|
'info' => '-D extra data',
|
|
},
|
|
'/dev/disk/by-label' => {
|
|
'info' => '-l,-o,-p,-P partition labels',
|
|
},
|
|
'/dev/disk/by-uuid' => {
|
|
'info' => '-u,-o,-p,-P partition uuid',
|
|
},
|
|
'/proc' => {
|
|
'info' => '',
|
|
},
|
|
'/sys' => {
|
|
'info' => '',
|
|
},
|
|
'/sys/class/dmi/id' => {
|
|
'info' => '-M system, motherboard, bios',
|
|
},
|
|
'/sys/class/hwmon' => {
|
|
'info' => '-s sensor data (fallback if no lm-sensors)',
|
|
},
|
|
## File Data ##
|
|
'/etc/lsb-release' => {
|
|
'info' => '-S distro version data (older version)',
|
|
},
|
|
'/etc/os-release' => {
|
|
'info' => '-S distro version data (newer version)',
|
|
},
|
|
'/proc/asound/cards' => {
|
|
'info' => '-A sound card data',
|
|
},
|
|
'/proc/asound/version' => {
|
|
'info' => '-A ALSA data',
|
|
},
|
|
'/proc/cpuinfo' => {
|
|
'info' => '-C cpu data',
|
|
},
|
|
'/proc/mdstat' => {
|
|
'info' => '-R mdraid data (if you use dm-raid)',
|
|
},
|
|
'/proc/meminfo' => {
|
|
'info' => '-I,-tm, -m memory data',
|
|
},
|
|
'/proc/modules' => {
|
|
'info' => '-G module data (sometimes)',
|
|
},
|
|
'/proc/mounts' => {
|
|
'info' => '-P,-p partition advanced data',
|
|
},
|
|
'/proc/scsi/scsi' => {
|
|
'info' => '-D Advanced hard disk data (used rarely)',
|
|
},
|
|
'/var/log/Xorg.0.log' => {
|
|
'info' => '-G graphics driver load status',
|
|
},
|
|
'/var/run/dmesg.boot' => {
|
|
'info' => '-D,-d disk data',
|
|
},
|
|
## Kernel Module Data ##
|
|
'amdgpu' => {
|
|
'info' => '-s, -G AMD GPU sensor data (newer GPUs)',
|
|
'info-bsd' => '',
|
|
},
|
|
'drivetemp' => {
|
|
'info' => '-Dx drive temperature (kernel >= 5.6)',
|
|
'info-bsd' => '',
|
|
},
|
|
'nouveau' => {
|
|
'info' => '-s, -G Nvidia GPU sensor data (if using free driver)',
|
|
'info-bsd' => '',
|
|
},
|
|
'radeon' => {
|
|
'info' => '-s, -G AMD GPU sensor data (older GPUs)',
|
|
'info-bsd' => '',
|
|
},
|
|
## START PACKAGE MANAGER BLOCK ##
|
|
# BSD only tools do not list package manager install names
|
|
## Programs-System ##
|
|
# Note: see inxi-perl branch for details: docs/inxi-custom-recommends.txt
|
|
# System Tools
|
|
'blockdev' => {
|
|
'info' => '--admin -p/-P (filesystem blocksize)',
|
|
'info-bsd' => '',
|
|
'apt' => 'util-linux',
|
|
'pacman' => 'util-linux',
|
|
'pkgtool' => 'util-linux',
|
|
'rpm' => 'util-linux',
|
|
},
|
|
'bt-adapter' => {
|
|
'info' => '-E bluetooth data (if no hciconfig, btmgmt)',
|
|
'info-bsd' => '',
|
|
'apt' => 'bluez-tools',
|
|
'pacman' => 'bluez-tools',
|
|
'pkgtool' => '', # needs to be built by user
|
|
'rpm' => 'bluez-tools',
|
|
},
|
|
'btmgmt' => {
|
|
'info' => '-E bluetooth data (if no hciconfig)',
|
|
'info-bsd' => '',
|
|
'apt' => 'bluez',
|
|
'pacman' => 'bluez-utils',
|
|
'pkgtool' => '', # needs to be built by user
|
|
'rpm' => 'bluez',
|
|
},
|
|
'curl' => {
|
|
'info' => '-i (if no dig); -w,-W; -U',
|
|
'info-bsd' => '-i (if no dig); -w,-W; -U',
|
|
'apt' => 'curl',
|
|
'pacman' => 'curl',
|
|
'pkgtool' => 'curl',
|
|
'rpm' => 'curl',
|
|
},
|
|
'camcontrol' => {
|
|
'info' => '',
|
|
'info-bsd' => '-R; -D; -P. Get actual gptid /dev path',
|
|
},
|
|
'dig' => {
|
|
'info' => '-i wlan IP',
|
|
'info-bsd' => '-i wlan IP',
|
|
'apt' => 'dnsutils',
|
|
'pacman' => 'dnsutils',
|
|
'pkgtool' => 'bind',
|
|
'rpm' => 'bind-utils',
|
|
},
|
|
'disklabel' => {
|
|
'info' => '',
|
|
'info-bsd' => '-j, -p, -P; -R; -o (Open/NetBSD+derived)',
|
|
},
|
|
'dmidecode' => {
|
|
'info' => '-M if no sys machine data; -m',
|
|
'info-bsd' => '-M if null sysctl; -m; -B if null sysctl',
|
|
'apt' => 'dmidecode',
|
|
'pacman' => 'dmidecode',
|
|
'pkgtool' => 'dmidecode',
|
|
'rpm' => 'dmidecode',
|
|
},
|
|
'doas' => {
|
|
'info' => '-Dx hddtemp-user; -o file-user (alt for sudo)',
|
|
'info-bsd' => '-Dx hddtemp-user; -o file-user',
|
|
'apt' => 'doas',
|
|
'pacman' => 'doas',
|
|
'pkgtool' => ' opendoas',
|
|
'rpm' => 'doas',
|
|
},
|
|
'fdisk' => {
|
|
'info' => '-D partition scheme (fallback)',
|
|
'info-bsd' => '-D partition scheme',
|
|
'apt' => 'fdisk',
|
|
'pacman' => 'util-linux',
|
|
'pkgtool' => 'util-linux',
|
|
'rpm' => 'util-linux',
|
|
},
|
|
'fetch' => {
|
|
'info' => '',
|
|
'info-bsd' => '-i (if no dig); -w,-W; -U',
|
|
},
|
|
'file' => {
|
|
'info' => '-o unmounted file system (if no lsblk)',
|
|
'info-bsd' => '-o unmounted file system',
|
|
'apt' => 'file',
|
|
'pacman' => 'file',
|
|
'pkgtool' => 'file',
|
|
'rpm' => 'file',
|
|
},
|
|
'ftp' => {
|
|
'info' => '',
|
|
'info-bsd' => '-i (if no dig); -w,-W; -U',
|
|
},
|
|
'fruid_print' => {
|
|
'info' => '-M machine data, Elbrus only',
|
|
'info-bsd' => '',
|
|
'apt' => '',
|
|
'pacman' => '',
|
|
'pkgtool' => '',
|
|
'rpm' => '',
|
|
},
|
|
'glabel' => {
|
|
'info' => '',
|
|
'info-bsd' => '-R; -D; -P. Get actual gptid /dev path',
|
|
},
|
|
'gpart' => {
|
|
'info' => '',
|
|
'info-bsd' => '-p,-P; -R; -o (FreeBSD+derived)',
|
|
},
|
|
'hciconfig' => {
|
|
'info' => '-E bluetooth data (deprecated, good report)',
|
|
'info-bsd' => '',
|
|
'apt' => 'bluez',
|
|
'pacman' => 'bluez-utils-compat (frugalware: bluez-utils)',
|
|
'pkgtool' => 'bluez',
|
|
'rpm' => 'bluez-utils',
|
|
},
|
|
'hddtemp' => {
|
|
'info' => '-Dx show hdd temp, if no drivetemp module',
|
|
'info-bsd' => '-Dx show hdd temp',
|
|
'apt' => 'hddtemp',
|
|
'pacman' => 'hddtemp',
|
|
'pkgtool' => 'hddtemp',
|
|
'rpm' => 'hddtemp',
|
|
},
|
|
'ifconfig' => {
|
|
'info' => '-i ip LAN (deprecated)',
|
|
'info-bsd' => '-i ip LAN',
|
|
'apt' => 'net-tools',
|
|
'pacman' => 'net-tools',
|
|
'pkgtool' => 'net-tools',
|
|
'rpm' => 'net-tools',
|
|
},
|
|
'ip' => {
|
|
'info' => '-i ip LAN',
|
|
'info-bsd' => '',
|
|
'apt' => 'iproute',
|
|
'pacman' => 'iproute2',
|
|
'pkgtool' => 'iproute2',
|
|
'rpm' => 'iproute',
|
|
},
|
|
'ipmi-sensors' => {
|
|
'info' => '-s IPMI sensors (servers)',
|
|
'info-bsd' => '',
|
|
'apt' => 'freeipmi-tools',
|
|
'pacman' => 'freeipmi',
|
|
'pkgtool' => 'freeipmi',
|
|
'rpm' => 'freeipmi',
|
|
},
|
|
'ipmitool' => {
|
|
'info' => '-s IPMI sensors (servers)',
|
|
'info-bsd' => '-s IPMI sensors (servers)',
|
|
'apt' => 'ipmitool',
|
|
'pacman' => 'ipmitool',
|
|
'pkgtool' => 'ipmitool',
|
|
'rpm' => 'ipmitool',
|
|
},
|
|
'lsblk' => {
|
|
'info' => '-L LUKS/bcache; -o unmounted file system (best option)',
|
|
'info-bsd' => '-o unmounted file system',
|
|
'apt' => 'util-linux',
|
|
'pacman' => 'util-linux',
|
|
'pkgtool' => 'util-linux',
|
|
'rpm' => 'util-linux-ng',
|
|
},
|
|
'lvs' => {
|
|
'info' => '-L LVM data',
|
|
'info-bsd' => '',
|
|
'apt' => 'lvm2',
|
|
'pacman' => 'lvm2',
|
|
'pkgtool' => 'lvm2',
|
|
'rpm' => 'lvm2',
|
|
},
|
|
'lsusb' => {
|
|
'info' => '-A usb audio; -J (optional); -N usb networking',
|
|
'info-bsd' => '',
|
|
'apt' => 'usbutils',
|
|
'pacman' => 'usbutils',
|
|
'pkgtool' => 'usbutils',
|
|
'rpm' => 'usbutils',
|
|
},
|
|
'mdadm' => {
|
|
'info' => '-Ra advanced mdraid data',
|
|
'info-bsd' => '',
|
|
'apt' => 'mdadm',
|
|
'pacman' => 'mdadm',
|
|
'pkgtool' => 'mdadm',
|
|
'rpm' => 'mdadm',
|
|
},
|
|
'modinfo' => {
|
|
'info' => 'Ax; -Nx module version',
|
|
'info-bsd' => '',
|
|
'apt' => 'module-init-tools',
|
|
'pacman' => 'module-init-tools',
|
|
'pkgtool' => 'kmod (earlier: module-init-tools)',
|
|
'rpm' => 'module-init-tools',
|
|
},
|
|
'pciconfig' => {
|
|
'info' => '',
|
|
'info-bsd' => '-A,-E,-G,-N pci devices (FreeBSD+derived)',
|
|
},
|
|
'pcictl' => {
|
|
'info' => '',
|
|
'info-bsd' => '-A,-E,-G,-N pci devices (NetBSD+derived)',
|
|
},
|
|
'pcidump' => {
|
|
'info' => '',
|
|
'info-bsd' => '-A,-E,-G,-N pci devices (OpenBSD+derived, doas/su)',
|
|
},
|
|
'runlevel' => {
|
|
'info' => '-I fallback to Perl',
|
|
'info-bsd' => '',
|
|
'apt' => 'systemd or sysvinit',
|
|
'pacman' => 'systemd',
|
|
'pkgtool' => 'sysvinit',
|
|
'rpm' => 'systemd or sysvinit',
|
|
},
|
|
'sensors' => {
|
|
'info' => '-s sensors output (optional, /sys supplies most)',
|
|
'info-bsd' => '',
|
|
'apt' => 'lm-sensors',
|
|
'pacman' => 'lm-sensors',
|
|
'pkgtool' => 'lm_sensors',
|
|
'rpm' => 'lm-sensors',
|
|
},
|
|
'smartctl' => {
|
|
'info' => '-Da advanced data',
|
|
'info-bsd' => '-Da advanced data',
|
|
'apt' => 'smartmontools',
|
|
'pacman' => 'smartmontools',
|
|
'pkgtool' => 'smartmontools',
|
|
'rpm' => 'smartmontools',
|
|
},
|
|
'strings' => {
|
|
'info' => '-I sysvinit version',
|
|
'info-bsd' => '',
|
|
'apt' => 'binutils',
|
|
'pacman' => 'binutils',
|
|
'pkgtool' => 'binutils',
|
|
'rpm' => 'binutils',
|
|
},
|
|
'sudo' => {
|
|
'info' => '-Dx hddtemp-user; -o file-user (try doas!)',
|
|
'info-bsd' => '-Dx hddtemp-user; -o file-user (alt for doas)',
|
|
'apt' => 'sudo',
|
|
'pacman' => 'sudo',
|
|
'pkgtool' => 'sudo',
|
|
'rpm' => 'sudo',
|
|
},
|
|
'sysctl' => {
|
|
'info' => '',
|
|
'info-bsd' => '-C; -I; -m; -tm',
|
|
},
|
|
'tree' => {
|
|
'info' => '--debugger 20,21 /sys tree',
|
|
'info-bsd' => '--debugger 20,21 /sys tree',
|
|
'apt' => 'tree',
|
|
'pacman' => 'tree',
|
|
'pkgtool' => 'tree',
|
|
'rpm' => 'tree',
|
|
},
|
|
'upower' => {
|
|
'info' => '-sx attached device battery info',
|
|
'info-bsd' => '-sx attached device battery info',
|
|
'apt' => 'upower',
|
|
'pacman' => 'upower',
|
|
'pkgtool' => 'upower',
|
|
'rpm' => 'upower',
|
|
},
|
|
'uptime' => {
|
|
'info' => '-I uptime',
|
|
'info-bsd' => '-I uptime',
|
|
'apt' => 'procps',
|
|
'pacman' => 'procps',
|
|
'pkgtool' => 'procps',
|
|
'rpm' => 'procps',
|
|
},
|
|
'usbconfig' => {
|
|
'info' => '',
|
|
'info-bsd' => '-A; -E; -G; -J; -N; (FreeBSD+derived, doas/su)',
|
|
},
|
|
'usbdevs' => {
|
|
'info' => '',
|
|
'info-bsd' => '-A; -E; -G; -J; -N; (Open/NetBSD+derived)',
|
|
},
|
|
'wget' => {
|
|
'info' => '-i (if no dig); -w,-W; -U',
|
|
'info-bsd' => '-i (if no dig); -w,-W; -U',
|
|
'apt' => 'wget',
|
|
'pacman' => 'wget',
|
|
'pkgtool' => 'wget',
|
|
'rpm' => 'wget',
|
|
},
|
|
## Programs-Display ##
|
|
'eglinfo' => {
|
|
'info' => '-G X11/Wayland EGL info',
|
|
'info-bsd' => '-G X11/Wayland EGL info',
|
|
'apt' => 'mesa-utils (or: mesa-utils-extra)',
|
|
'pacman' => 'mesa-demos',
|
|
'pkgtool' => 'mesa',
|
|
'rpm' => 'egl-utils (SUSE: Mesa-demo-egl)',
|
|
},
|
|
'glxinfo' => {
|
|
'info' => '-G X11 GLX info',
|
|
'info-bsd' => '-G X11 GLX info',
|
|
'apt' => 'mesa-utils',
|
|
'pacman' => 'mesa-demos',
|
|
'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)',
|
|
},
|
|
'wmctrl' => {
|
|
'info' => '-S active window manager (fallback)',
|
|
'info-bsd' => '-S active window manager (fallback)',
|
|
'apt' => 'wmctrl',
|
|
'pacman' => 'wmctrl',
|
|
'pkgtool' => 'wmctrl',
|
|
'rpm' => 'wmctrl',
|
|
},
|
|
'xdpyinfo' => {
|
|
'info' => '-G (X) Screen resolution, dpi; -Ga Screen size',
|
|
'info-bsd' => '-G (X) Screen resolution, dpi; -Ga Screen size',
|
|
'apt' => 'X11-utils',
|
|
'pacman' => 'xorg-xdpyinfo',
|
|
'pkgtool' => 'xdpyinfo',
|
|
'rpm' => 'xorg-x11-utils (SUSE/Fedora: xdpyinfo)',
|
|
},
|
|
'xdriinfo' => {
|
|
'info' => '-G (X) DRI driver (if missing, fallback to Xorg log)',
|
|
'info-bsd' => '-G (X) DRI driver (if missing, fallback to Xorg log',
|
|
'apt' => 'X11-utils',
|
|
'pacman' => 'xorg-xdriinfo',
|
|
'pkgtool' => 'xdriinfo',
|
|
'rpm' => 'xorg-x11-utils (SUSE/Fedora: xdriinfo)',
|
|
},
|
|
'xprop' => {
|
|
'info' => '-S (X) desktop data',
|
|
'info-bsd' => '-S (X) desktop data',
|
|
'apt' => 'X11-utils',
|
|
'pacman' => 'xorg-xprop',
|
|
'pkgtool' => 'xprop',
|
|
'rpm' => 'x11-utils (Fedora/SUSE: xprop)',
|
|
},
|
|
'xrandr' => {
|
|
'info' => '-G (X) monitors(s) resolution; -Ga monitor data',
|
|
'info-bsd' => '-G (X) monitors(s) resolution; -Ga monitor data',
|
|
'apt' => 'x11-xserver-utils',
|
|
'pacman' => 'xrandr',
|
|
'pkgtool' => 'xrandr',
|
|
'rpm' => 'x11-server-utils (SUSE/Fedora: xrandr)',
|
|
},
|
|
## Perl Modules ##
|
|
'Cpanel::JSON::XS' => {
|
|
'info' => '-G wayland, --output json (faster).',
|
|
'info-bsd' => '-G wayland, --output json (faster).',
|
|
'apt' => 'libcpanel-json-xs-perl',
|
|
'pacman' => 'perl-cpanel-json-xs',
|
|
'pkgtool' => 'perl-Cpanel-JSON-XS',
|
|
'rpm' => 'perl-Cpanel-JSON-XS',
|
|
},
|
|
'File::Copy' => {
|
|
'info' => '--debug 20-22 - required for debugger.',
|
|
'info-bsd' => '--debug 20-22 - required for debugger.',
|
|
'apt' => 'Core Modules',
|
|
'pacman' => 'Core Modules',
|
|
'pkgtool' => 'Core Modules',
|
|
'rpm' => 'perl-File-Copy',
|
|
},
|
|
'File::Find' => {
|
|
'info' => '--debug 20-22 - required for debugger.',
|
|
'info-bsd' => '--debug 20-22 - required for debugger.',
|
|
'apt' => 'Core Modules',
|
|
'pacman' => 'Core Modules',
|
|
'pkgtool' => 'Core Modules',
|
|
'rpm' => 'perl-File-Find',
|
|
},
|
|
'File::Spec::Functions' => {
|
|
'info' => '--debug 20-22 - required for debugger.',
|
|
'info-bsd' => '--debug 20-22 - required for debugger.',
|
|
'apt' => 'Core Modules',
|
|
'pacman' => 'Core Modules',
|
|
'pkgtool' => 'Core Modules',
|
|
'rpm' => 'Core Modules',
|
|
},
|
|
'HTTP::Tiny' => {
|
|
'info' => '-U; -w,-W; -i (if dig not installed).',
|
|
'info-bsd' => '-U; -w,-W; -i (if dig not installed)',
|
|
'apt' => 'libhttp-tiny-perl (Core Modules >= 5.014)',
|
|
'pacman' => 'Core Modules',
|
|
'pkgtool' => 'perl-http-tiny (Core Modules >= 5.014)',
|
|
'rpm' => 'Perl-http-tiny',
|
|
},
|
|
'IO::Socket::SSL' => {
|
|
'info' => '-U; -w,-W; -i (if dig not installed).',
|
|
'info-bsd' => '-U; -w,-W; -i (if dig not installed)',
|
|
'apt' => 'libio-socket-ssl-perl',
|
|
'pacman' => 'perl-io-socket-ssl',
|
|
'pkgtool' => 'perl-IO-Socket-SSL', # maybe in core modules
|
|
'rpm' => 'perl-IO-Socket-SSL',
|
|
},
|
|
'JSON::PP' => {
|
|
'info' => '-G wayland, --output json (in CoreModules, slower).',
|
|
'info-bsd' => '-G wayland, --output json (in CoreModules, slower).',
|
|
'apt' => 'libjson-pp-perl (Core Modules >= 5.014)',
|
|
'pacman' => 'perl-json-pp (Core Modules >= 5.014)',
|
|
'pkgtool' => 'Core Modules >= 5.014',
|
|
'rpm' => 'perl-JSON-PP',
|
|
},
|
|
'JSON::XS' => {
|
|
'info' => '-G wayland, --output json (legacy).',
|
|
'info-bsd' => '-G wayland, --output json (legacy).',
|
|
'apt' => 'libjson-xs-perl',
|
|
'pacman' => 'perl-json-xs',
|
|
'pkgtool' => 'perl-JSON-XS',
|
|
'rpm' => 'perl-JSON-XS',
|
|
},
|
|
'Net::FTP' => {
|
|
'info' => '--debug 21,22',
|
|
'info-bsd' => '--debug 21,22',
|
|
'apt' => 'Core Modules',
|
|
'pacman' => 'Core Modules',
|
|
'pkgtool' => 'Core Modules',
|
|
'rpm' => 'Core Modules',
|
|
},
|
|
'OpenBSD::Pledge' => {
|
|
'info' => "$self_name Perl pledge support.",
|
|
'info-bsd' => "$self_name Perl pledge support.",
|
|
},
|
|
'OpenBSD::Unveil' => {
|
|
'info' => "Experimental: $self_name Perl unveil support.",
|
|
'info-bsd' => "Experimental: $self_name Perl unveil support.",
|
|
},
|
|
'Time::HiRes' => {
|
|
'info' => '-C cpu sleep (not required); --debug timers',
|
|
'info-bsd' => '-C cpu sleep (not required); --debug timers',
|
|
'apt' => 'Core Modules',
|
|
'pacman' => 'Core Modules',
|
|
'pkgtool' => 'Core Modules',
|
|
'rpm' => 'perl-Time-HiRes',
|
|
},
|
|
'XML::Dumper' => {
|
|
'info' => '--output xml - Crude and raw.',
|
|
'info-bsd' => '--output xml - Crude and raw.',
|
|
'apt' => 'libxml-dumper-perl',
|
|
'pacman' => 'perl-xml-dumper',
|
|
'pkgtool' => '', # package does not appear to exist
|
|
'rpm' => 'perl-XML-Dumper',
|
|
},
|
|
## END PACKAGE MANAGER BLOCK ##
|
|
};
|
|
}
|
|
|
|
sub get_pms {
|
|
my @pms = ();
|
|
# support maintainers of other pm types using custom lists
|
|
if (main::check_program('dpkg')){
|
|
push(@pms,'apt');
|
|
}
|
|
if (main::check_program('pacman')){
|
|
push(@pms,'pacman');
|
|
}
|
|
# assuming netpkg uses installpkg as backend
|
|
if (main::check_program('installpkg')){
|
|
push(@pms,'pkgtool');
|
|
}
|
|
# rpm needs to go last because it's sometimes available on other pm systems
|
|
if (main::check_program('rpm')){
|
|
push(@pms,'rpm');
|
|
}
|
|
return @pms;
|
|
}
|
|
|
|
# note: end will vary, but should always be treated as longest value possible.
|
|
# expected values: Present/Missing
|
|
sub make_row {
|
|
my ($start,$middle,$end) = @_;
|
|
my ($dots,$line,$sep) = ('','',': ');
|
|
foreach (0 .. ($size{'max-cols'} - 16 - length("$start$middle"))){
|
|
$dots .= '.';
|
|
}
|
|
$line = "$start$sep$middle$dots $end";
|
|
return $line;
|
|
}
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### TOOLS
|
|
#### -------------------------------------------------------------------
|
|
|
|
# Duplicates the functionality of awk to allow for one liner
|
|
# type data parsing. note: -1 corresponds to awk NF
|
|
# args: 0: array of data; 1: search term; 2: field result; 3: separator
|
|
# correpsonds to: awk -F='separator' '/search/ {print $2}' <<< @data
|
|
# array is sent by reference so it must be dereferenced
|
|
# NOTE: if you just want the first row, pass it \S as search string
|
|
# NOTE: if $num is undefined, it will skip the second step
|
|
sub awk {
|
|
eval $start if $b_log;
|
|
my ($ref,$search,$num,$sep) = @_;
|
|
my ($result);
|
|
# print "search: $search\n";
|
|
return if !@$ref || !$search;
|
|
foreach (@$ref){
|
|
next if !defined $_;
|
|
if (/$search/i){
|
|
$result = $_;
|
|
$result =~ s/^\s+|\s+$//g;
|
|
last;
|
|
}
|
|
}
|
|
if ($result && defined $num){
|
|
$sep ||= '\s+';
|
|
$num-- if $num > 0; # retain the negative values as is
|
|
$result = (split(/$sep/, $result))[$num];
|
|
$result =~ s/^\s+|,|\s+$//g if $result;
|
|
}
|
|
eval $end if $b_log;
|
|
return $result;
|
|
}
|
|
|
|
# 0: Perl module to check
|
|
sub check_perl_module {
|
|
my ($module) = @_;
|
|
my $b_present = 0;
|
|
eval "require $module";
|
|
$b_present = 1 if !$@;
|
|
return $b_present;
|
|
}
|
|
|
|
# args: 0: string or path to search gneerated @paths data for.
|
|
# note: a few nano seconds are saved by using raw $_[0] for program
|
|
sub check_program {
|
|
(grep { return "$_/$_[0]" if -e "$_/$_[0]"} @paths)[0];
|
|
}
|
|
|
|
sub cleanup {
|
|
# maybe add in future: , $fh_c, $fh_j, $fh_x
|
|
foreach my $fh ($fh_l){
|
|
if ($fh){
|
|
close $fh;
|
|
}
|
|
}
|
|
}
|
|
|
|
# args: 0,1: version numbers to compare by turning them to strings
|
|
# note that the structure of the two numbers is expected to be fairly
|
|
# similar, otherwise it may not work perfectly.
|
|
sub compare_versions {
|
|
my ($one,$two) = @_;
|
|
if ($one && !$two){return $one;}
|
|
elsif ($two && !$one){return $two;}
|
|
elsif (!$one && !$two){return}
|
|
my ($pad1,$pad2) = ('','');
|
|
$pad1 = join('', map {$_ = sprintf("%04s", $_);$_ } split(/[._-]/, $one));
|
|
$pad2 = join('', map {$_ = sprintf("%04s", $_);$_ } split(/[._-]/, $two));
|
|
# print "p1:$pad1 p2:$pad2\n";
|
|
if ($pad1 ge $pad2){return $one}
|
|
elsif ($pad2 gt $pad1){return $two}
|
|
}
|
|
|
|
# some things randomly use hex with 0x starter, return always integer
|
|
# warning: perl will generate a 32 bit too big number warning if you pass it
|
|
# random values that exceed 2^32 in hex, even if the base system is 64 bit.
|
|
# sample: convert_hex(0x000b0000000b);
|
|
sub convert_hex {
|
|
return (defined $_[0] && $_[0] =~ /^0x/) ? hex($_[0]) : $_[0];
|
|
}
|
|
|
|
# returns count of files in directory, if 0, dir is empty
|
|
sub count_dir_files {
|
|
return unless -d $_[0];
|
|
opendir(my $dh, $_[0]) or error_handler('open-dir-failed', "$_[0]", $!);
|
|
my $count = grep { ! /^\.{1,2}/ } readdir($dh); # strips out . and ..
|
|
closedir $dh;
|
|
return $count;
|
|
}
|
|
|
|
# args: 0: the string to get piece of
|
|
# 1: the position in string, starting at 1 for 0 index.
|
|
# 2: the separator, default is ' '
|
|
sub get_piece {
|
|
eval $start if $b_log;
|
|
my ($string, $num, $sep) = @_;
|
|
$num--;
|
|
$sep ||= '\s+';
|
|
$string =~ s/^\s+|\s+$//g;
|
|
my @temp = split(/$sep/, $string);
|
|
eval $end if $b_log;
|
|
if (exists $temp[$num]){
|
|
$temp[$num] =~ s/,//g;
|
|
return $temp[$num];
|
|
}
|
|
}
|
|
|
|
# args: 0: command to turn into an array; 1: optional: splitter;
|
|
# 2: optionsl, strip and clean data
|
|
# similar to reader() except this creates an array of data
|
|
# by lines from the command arg
|
|
sub grabber {
|
|
eval $start if $b_log;
|
|
my ($cmd,$split,$strip,$type) = @_;
|
|
$type ||= 'arr';
|
|
$split ||= "\n";
|
|
my @rows;
|
|
if ($strip){
|
|
for (split(/$split/, qx($cmd))){
|
|
next if /^\s*(#|$)/;
|
|
$_ =~ s/^\s+|\s+$//g;
|
|
push(@rows,$_);
|
|
}
|
|
}
|
|
else {
|
|
@rows = split(/$split/, qx($cmd));
|
|
}
|
|
eval $end if $b_log;
|
|
return ($type eq 'arr') ? @rows : \@rows;
|
|
}
|
|
|
|
# args: 0: string value to glob
|
|
sub globber {
|
|
eval $start if $b_log;
|
|
my @files = <$_[0]>;
|
|
eval $end if $b_log;
|
|
return @files;
|
|
}
|
|
|
|
# arg MUST be quoted when inserted, otherwise perl takes it for a hex number
|
|
sub is_hex {
|
|
return (defined $_[0] && $_[0] =~ /^0x/) ? 1 : 0;
|
|
}
|
|
|
|
## NOTE: for perl pre 5.012 length(undef) returns warning
|
|
# receives string, returns boolean 1 if integer
|
|
sub is_int {
|
|
return 1 if (defined $_[0] && length($_[0]) &&
|
|
length($_[0]) == ($_[0] =~ tr/0123456789//));
|
|
}
|
|
|
|
# receives string, returns true/1 if >= 0 numeric. tr/// 4x faster than regex
|
|
sub is_numeric {
|
|
return 1 if (defined $_[0] && ($_[0] =~ tr/0123456789//) >= 1 &&
|
|
length($_[0]) == ($_[0] =~ tr/0123456789.//) && ($_[0] =~ tr/.//) <= 1);
|
|
}
|
|
|
|
# gets array ref, which may be undefined, plus join string
|
|
# this helps avoid debugger print errors when we are printing arrays
|
|
# which we don't know are defined or not null.
|
|
# args: 0: array ref; 1: join string; 2: default value, optional
|
|
sub joiner {
|
|
my ($arr,$join,$default) = @_;
|
|
$default ||= '';
|
|
my $string = '';
|
|
foreach (@$arr){
|
|
if (defined $_){
|
|
$string .= $_ . $join;
|
|
}
|
|
else {
|
|
$string .= $default . $join;
|
|
}
|
|
}
|
|
return $string;
|
|
}
|
|
|
|
# gets directory file list
|
|
sub lister {
|
|
return if ! -d $_[0];
|
|
opendir my $dir, $_[0] or return;
|
|
my @list = readdir $dir;
|
|
@list = grep {!/^(\.|\.\.)$/} @list if @list;
|
|
closedir $dir;
|
|
return @list;
|
|
}
|
|
# checks for 1 of 3 perl json modules. All three have same encode_json,
|
|
# decode_json() methods.
|
|
sub load_json {
|
|
eval $start if $b_log;
|
|
$loaded{'json'} = 1;
|
|
# recommended, but not in core modules
|
|
if (check_perl_module('Cpanel::JSON::XS')){
|
|
Cpanel::JSON::XS->import(qw(encode_json decode_json));
|
|
# my $new = Cpanel::JSON::XS->new;
|
|
$use{'json'} = {'type' => 'cpanel-json-xs',
|
|
'encode' => \&Cpanel::JSON::XS::encode_json,
|
|
'decode' => \&Cpanel::JSON::XS::decode_json,};
|
|
# $use{'json'} = {'type' => 'cpanel-json-xs',
|
|
# 'new-json' => \Cpanel::JSON::XS->new()};
|
|
}
|
|
# somewhat legacy, not in perl modules
|
|
elsif (check_perl_module('JSON::XS')){
|
|
JSON::XS->import;
|
|
$use{'json'} = {'type' => 'json-xs',
|
|
'encode' => \&JSON::XS::encode_json,
|
|
'decode' => \&JSON::XS::decode_json};
|
|
}
|
|
# perl, in core modules as of 5.14
|
|
elsif (check_perl_module('JSON::PP')){
|
|
JSON::PP->import;
|
|
$use{'json'} = {'type' => 'json-pp',
|
|
'encode' => \&JSON::PP::encode_json,
|
|
'decode' => \&JSON::PP::decode_json};
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# returns array of: 0: program print name 1: program version
|
|
# args: 0: program values id; 1: program version string;
|
|
# 2: $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 ##
|
|
'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
|
|
'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',0,'0','Cage',0,1,0,'',''], # unverified
|
|
'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
|
|
'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
|
|
'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, yet?
|
|
'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,'',''],
|
|
'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?
|
|
'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
|
|
'hyprland' => ['^hyprland',0,'0','Hyprland',0,1,0,'',''], # unverified
|
|
'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,'--version','JWM',0,1,0,'',''],
|
|
'kded' => ['^KDE( Development Platform)?:',2,'--version','KDE',0,1,0,'\sDevelopment Platform',''],
|
|
'kded1' => ['^KDE( Development Platform)?:',2,'--version','KDE',0,1,0,'\sDevelopment Platform',''],
|
|
'kded2' => ['^KDE( Development Platform)?:',2,'--version','KDE',0,1,0,'\sDevelopment Platform',''],
|
|
'kded3' => ['^KDE( Development Platform)?:',2,'--version','KDE',0,1,0,'\sDevelopment Platform',''],
|
|
'kded4' => ['^KDE( Development Platform)?:',2,'--version','KDE',0,1,0,'\sDevelopment Platform',''],
|
|
'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
|
|
'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
|
|
'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-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,'',''],
|
|
'maze' => ['^maze',0,'0','Maze',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
|
|
'moblin' => ['^moblin',0,'0','moblin',0,1,0,'',''],# unverified
|
|
'monsterwm' => ['^monsterwm',0,'0','monsterwm',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
|
|
'newm' => ['^newm',0,'0','newm',0,1,0,'',''], # unverified
|
|
'notion' => ['^.',1,'--version','Notion',0,1,0,'',''],
|
|
'nscde' => ['^nscde',0,'0','NsCDE',0,1,0,'',''], # unverified
|
|
'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
|
|
'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,'',''],
|
|
'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
|
|
'sawfish' => ['^sawfish',3,'--version','Sawfish',0,1,0,'',''],
|
|
'scrotwm' => ['^scrotwm.*welcome.*',5,'-v','scrotwm',0,1,1,'',''],
|
|
'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.*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
|
|
'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
|
|
'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',0,'0','Weston',0,1,0,'',''], # unverified
|
|
'windowlab' => ['^windowlab',2,'-about','WindowLab',0,1,0,'',''],
|
|
'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[[:space:]]*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
|
|
'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[[:space:]]version',5,'--version','Xfce',0,1,0,'',''],
|
|
# command: xfdesktop
|
|
'xfdesktop-toolkit' => ['Built[[:space:]]with[[:space:]]GTK',4,'--version','Gtk',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
|
|
'xfwm4' => ['xfwm4? version',5,'--version','xfwm',0,1,0,'^^\s+',''],
|
|
'xfwm5' => ['xfwm5? version',5,'--version','xfwm',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
|
|
## 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) ##
|
|
'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, maybe xlogin
|
|
'emptty' => ['^emptty',0,'0','EMPTTY',0,1,0,'',''], # unverified
|
|
'entrance' => ['^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,'',''],
|
|
'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,'',''],
|
|
'mlogin' => ['^mlogin',0,'0','mlogin',0,1,0,'',''], # unverified
|
|
'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
|
|
'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,'',''],
|
|
'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,'',''],
|
|
'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, probably clogin
|
|
## 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,'',''],
|
|
## 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
|
|
# args: 0: 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: 0: desktop/app command for --version; 1: search string;
|
|
# 2: space print number; 3: [optional] version arg: -v, version, etc;
|
|
# 4: [optional] exit first find 0/1; 5: [optional] 0/1 stderr output;
|
|
# 6: replace regex; 7: 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 {
|
|
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';
|
|
}
|
|
elsif ($program = check_program('rpm')){
|
|
$data[0] = "$program -qi --nodigest --nosignature $app 2>/dev/null";
|
|
$data[1] = '^Version';
|
|
}
|
|
# print "$data[0] :: $data[1]\n";
|
|
eval $end if $b_log;
|
|
return @data;
|
|
}
|
|
|
|
# args: 0: full file path, returns array of file lines;
|
|
# 1: optionsl, strip and clean data;
|
|
# 2: optional: undef|arr|ref|index return specific index, if it exists, else undef
|
|
# note: chomp has to chomp the entire action, not just <$fh>
|
|
sub reader {
|
|
eval $start if $b_log;
|
|
my ($file,$strip,$type) = @_;
|
|
return if !$file || ! -r $file; # not all OS respect -r tests!!
|
|
$type = 'arr' if !defined $type;
|
|
my ($error,@rows);
|
|
open(my $fh, '<', $file) or $error = $!; # $fh always non null, even on error
|
|
if ($error){
|
|
error_handler('open', $file, $error);
|
|
}
|
|
else {
|
|
chomp(@rows = <$fh>);
|
|
close $fh;
|
|
if (@rows && $strip){
|
|
my @temp;
|
|
for (@rows){
|
|
next if /^\s*(#|$)/;
|
|
$_ =~ s/^\s+|\s+$//g;
|
|
push(@temp,$_);
|
|
}
|
|
@rows = @temp;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows if $type eq 'arr';
|
|
return \@rows if $type eq 'ref';
|
|
# note: returns undef scalar value if $rows[index] does not exist
|
|
return $rows[$type];
|
|
}
|
|
|
|
# args: 0: the file to create if not exists
|
|
sub toucher {
|
|
my $file = shift;
|
|
if (! -e $file){
|
|
open(my $fh, '>', $file) or error_handler('create', $file, $!);
|
|
}
|
|
}
|
|
|
|
# calling it trimmer to avoid conflicts with existing trim stuff
|
|
# args: 0: string to be right left trimmed. Also slices off \n so no chomp needed
|
|
# this thing is super fast, no need to log its times etc, 0.0001 seconds or less
|
|
sub trimmer {
|
|
# eval $start if $b_log;
|
|
my ($str) = @_;
|
|
$str =~ s/^\s+|\s+$|\n$//g;
|
|
# eval $end if $b_log;
|
|
return $str;
|
|
}
|
|
|
|
# args: 0: array, by ref, modifying by ref
|
|
# send array, assign to hash, changed array by reference, uniq values only.
|
|
sub uniq {
|
|
my %seen;
|
|
@{$_[0]} = grep !$seen{$_}++, @{$_[0]};
|
|
}
|
|
|
|
# args: 0: file full path to write to; 1: array ref or scalar of data to write.
|
|
# note: turning off strict refs so we can pass it a scalar or an array reference.
|
|
sub writer {
|
|
my ($path, $content) = @_;
|
|
my ($contents);
|
|
no strict 'refs';
|
|
# print Dumper $content, "\n";
|
|
if (ref $content eq 'ARRAY'){
|
|
$contents = join("\n", @$content); # or die "failed with error $!";
|
|
}
|
|
else {
|
|
$contents = $content;
|
|
}
|
|
open(my $fh, ">", $path) or error_handler('open',"$path", "$!");
|
|
print $fh $contents;
|
|
close $fh;
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### UPDATER
|
|
#### -------------------------------------------------------------------
|
|
|
|
# args: 0: type to return
|
|
sub get_defaults {
|
|
my ($type) = @_;
|
|
my %defaults = (
|
|
'ftp-upload' => 'ftp.smxi.org/incoming',
|
|
'inxi-branch-1' => 'https://codeberg.org/smxi/inxi/raw/one/',
|
|
'inxi-branch-2' => 'https://codeberg.org/smxi/inxi/raw/two/',
|
|
"$self_name-dev" => 'https://smxi.org/in/',
|
|
"$self_name-dev-ftp" => 'ftp://ftp.smxi.org/outgoing/',
|
|
"inxi-main" => 'https://codeberg.org/smxi/inxi/raw/master/',
|
|
'pinxi-main' => 'https://codeberg.org/smxi/pinxi/raw/master/',
|
|
);
|
|
if ($defaults{$type}){
|
|
return $defaults{$type};
|
|
}
|
|
else {
|
|
error_handler('bad-arg-int', $type);
|
|
}
|
|
}
|
|
|
|
# args: 0: download url, not including file name; 1: string to print out
|
|
# 2: update type option
|
|
# note that 0 must end in / to properly construct the url path
|
|
sub update_me {
|
|
eval $start if $b_log;
|
|
my ($self_download,$download_id) = @_;
|
|
my $downloader_error=1;
|
|
my $file_contents='';
|
|
my $output = '';
|
|
$self_path =~ s/\/$//; # dirname sometimes ends with /, sometimes not
|
|
$self_download =~ s/\/$//; # dirname sometimes ends with /, sometimes not
|
|
my $full_self_path = "$self_path/$self_name";
|
|
if ($b_irc){
|
|
error_handler('not-in-irc', "-U/--update")
|
|
}
|
|
if (! -w $full_self_path){
|
|
error_handler('not-writable', "$self_name", '');
|
|
}
|
|
$output .= "Starting $self_name self updater.\n";
|
|
$output .= "Using $dl{'dl'} as downloader.\n";
|
|
$output .= "Currently running $self_name version number: $self_version\n";
|
|
$output .= "Current version patch number: $self_patch\n";
|
|
$output .= "Current version release date: $self_date\n";
|
|
$output .= "Updating $self_name in $self_path using $download_id as download source...\n";
|
|
print $output;
|
|
$output = '';
|
|
$self_download = "$self_download/$self_name";
|
|
$file_contents = download_file('stdout', $self_download);
|
|
# then do the actual download
|
|
if ($file_contents){
|
|
# make sure the whole file got downloaded and is in the variable
|
|
print "Validating downloaded data...\n";
|
|
if ($file_contents =~ /###\*\*EOF\*\*###/){
|
|
open(my $fh, '>', $full_self_path);
|
|
print $fh $file_contents or error_handler('write', $full_self_path, "$!");
|
|
close $fh;
|
|
qx(chmod +x '$self_path/$self_name');
|
|
set_version_data();
|
|
$output .= "Successfully updated to $download_id version: $self_version\n";
|
|
$output .= "New $download_id version patch number: $self_patch\n";
|
|
$output .= "New $download_id version release date: $self_date\n";
|
|
$output .= "To run the new version, just start $self_name again.\n";
|
|
$output .= "$line3\n";
|
|
print $output;
|
|
$output = '';
|
|
if ($use{'man'}){
|
|
update_man($self_download,$download_id);
|
|
}
|
|
else {
|
|
print "Skipping man download because branch version is being used.\n";
|
|
}
|
|
exit 0;
|
|
}
|
|
else {
|
|
error_handler('file-corrupt', "$self_name");
|
|
}
|
|
}
|
|
# now run the error handlers on any downloader failure
|
|
else {
|
|
error_handler('download-error', $self_download, $download_id);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub update_man {
|
|
eval $start if $b_log;
|
|
my ($self_download,$download_id) = @_;
|
|
my $man_file_location = set_man_location();
|
|
my $man_file_path = "$man_file_location/$self_name.1" ;
|
|
my ($file_contents,$man_file_url,$output,$program) = ('','','','');
|
|
print "Starting download of man page file now.\n";
|
|
if (! -d $man_file_location){
|
|
print "The required man directory was not detected on your system.\n";
|
|
print "Unable to continue: $man_file_location\n";
|
|
return 0;
|
|
}
|
|
if (! -w $man_file_location){
|
|
print "Cannot write to $man_file_location! Root privileges required.\n";
|
|
print "Unable to continue: $man_file_location\n";
|
|
return 0;
|
|
}
|
|
if (-f "/usr/share/man/man8/inxi.8.gz"){
|
|
print "Updating man page location to man1.\n";
|
|
rename "/usr/share/man/man8/inxi.8.gz", "$man_file_location/inxi.1.gz";
|
|
if (check_program('mandb')){
|
|
system('mandb');
|
|
}
|
|
}
|
|
if (!($program = check_program('gzip'))){
|
|
print "Required program gzip not found. Unable to install man page.\n";
|
|
return 0;
|
|
}
|
|
# first choice is inxi.1/pinxi.1 from gh, second from smxi.org
|
|
$man_file_url = $self_download . '.1';
|
|
print "Updating $self_name.1 in $man_file_location\n";
|
|
print "using $download_id branch as download source\n";
|
|
print "Downloading man page file...\n";
|
|
print "Download URL: $man_file_url\n" if $dbg[1];
|
|
$file_contents = download_file('stdout', $man_file_url);
|
|
if ($file_contents){
|
|
# make sure the whole file got downloaded and is in the variable
|
|
print "Download successful. Validating downloaded man file data...\n";
|
|
if ($file_contents =~ m|\.\\" EOF|){
|
|
print "Contents validated. Writing to man location...\n";
|
|
open(my $fh, '>', $man_file_path);
|
|
print $fh $file_contents or error_handler('write', $man_file_path, "$!");
|
|
close $fh;
|
|
print "Writing successful. Compressing file...\n";
|
|
system("$program -9 -f $man_file_path > $man_file_path.gz");
|
|
my $err = $?;
|
|
if ($err > 0){
|
|
print "Oh no! Something went wrong compressing the man file!\n";
|
|
print "Error: $err\n";
|
|
}
|
|
else {
|
|
print "Download, install, and compression of man page successful.\n";
|
|
print "Check to make sure it works: man $self_name\n";
|
|
}
|
|
}
|
|
else {
|
|
error_handler('file-corrupt', "$self_name.1");
|
|
}
|
|
}
|
|
# now run the error handlers on any downloader failure
|
|
else {
|
|
error_handler('download-error', $man_file_url, $download_id);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_man_location {
|
|
my $location='';
|
|
my $default_location='/usr/share/man/man1';
|
|
my $man_paths=qx(man --path 2>/dev/null);
|
|
my $man_local='/usr/local/share/man';
|
|
my $b_use_local=0;
|
|
if ($man_paths && $man_paths =~ /$man_local/){
|
|
$b_use_local=1;
|
|
}
|
|
# for distro installs
|
|
if (-f "$default_location/inxi.1.gz"){
|
|
$location=$default_location;
|
|
}
|
|
else {
|
|
if ($b_use_local){
|
|
if (! -d "$man_local/man1"){
|
|
mkdir "$man_local/man1";
|
|
}
|
|
$location="$man_local/man1";
|
|
}
|
|
}
|
|
if (!$location){
|
|
$location=$default_location;
|
|
}
|
|
return $location;
|
|
}
|
|
|
|
# update for updater output version info
|
|
# note, this is only now used for self updater function so it can get
|
|
# the values from the UPDATED file, NOT the running program!
|
|
sub set_version_data {
|
|
open(my $fh, '<', "$self_path/$self_name");
|
|
while (my $row = <$fh>){
|
|
chomp($row);
|
|
$row =~ s/'|;//g;
|
|
if ($row =~ /^my \$self_name/){
|
|
$self_name = (split('=', $row))[1];
|
|
}
|
|
elsif ($row =~ /^my \$self_version/){
|
|
$self_version = (split('=', $row))[1];
|
|
}
|
|
elsif ($row =~ /^my \$self_date/){
|
|
$self_date = (split('=', $row))[1];
|
|
}
|
|
elsif ($row =~ /^my \$self_patch/){
|
|
$self_patch = (split('=', $row))[1];
|
|
}
|
|
elsif ($row =~ /^## END INXI INFO/){
|
|
last;
|
|
}
|
|
}
|
|
close $fh;
|
|
}
|
|
|
|
########################################################################
|
|
#### OPTIONS HANDLER / VERSION
|
|
########################################################################
|
|
|
|
## OptionsHandler
|
|
{
|
|
package OptionsHandler;
|
|
# note: had %trigger local but tripped odd perl 5.008 failures unless global
|
|
# so moved to %use and %show globals.
|
|
my ($self_download,$download_id);
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
$show{'short'} = 1;
|
|
Getopt::Long::GetOptions (
|
|
'a|admin' => sub {
|
|
$b_admin = 1;},
|
|
'A|audio' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'audio'} = 1;},
|
|
'b|basic' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'battery'} = 1;
|
|
$show{'cpu-basic'} = 1;
|
|
$show{'raid-basic'} = 1;
|
|
$show{'disk-total'} = 1;
|
|
$show{'graphic'} = 1;
|
|
$show{'graphic-basic'} = 1;
|
|
$show{'info'} = 1;
|
|
$show{'machine'} = 1;
|
|
$show{'network'} = 1;
|
|
$show{'system'} = 1;},
|
|
'B|battery' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'battery'} = 1;
|
|
$show{'battery-forced'} = 1;},
|
|
'c|color:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg >= 0 && $arg < main::get_color_scheme('count')){
|
|
main::set_color_scheme($arg);
|
|
}
|
|
elsif ($arg >= 94 && $arg <= 99){
|
|
$colors{'selector'} = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'C|cpu' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'cpu'} = 1;},
|
|
'config|configs|configuration|configurations' => sub {
|
|
$show{'configs'} = 1;},
|
|
'd|disk-full|optical' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'disk'} = 1;
|
|
$show{'optical'} = 1;},
|
|
'D|disk' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'disk'} = 1;},
|
|
'E|bluetooth' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'bluetooth'} = 1;
|
|
$show{'bluetooth-forced'} = 1;},
|
|
'edid' => sub {
|
|
$b_admin = 1;
|
|
$show{'short'} = 0;
|
|
$show{'edid'} = 1;
|
|
$show{'graphic'} = 1;
|
|
$show{'graphic-full'} = 1;},
|
|
'f|flags|flag' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'cpu'} = 1;
|
|
$show{'cpu-flag'} = 1;},
|
|
'F|full' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'audio'} = 1;
|
|
$show{'battery'} = 1;
|
|
$show{'bluetooth'} = 1;
|
|
$show{'cpu'} = 1;
|
|
$show{'disk'} = 1;
|
|
$show{'graphic'} = 1;
|
|
$show{'graphic-basic'} = 1;
|
|
$show{'graphic-full'} = 1;
|
|
$show{'info'} = 1;
|
|
$show{'machine'} = 1;
|
|
$show{'network'} = 1;
|
|
$show{'network-advanced'} = 1;
|
|
$show{'partition'} = 1;
|
|
$show{'raid'} = 1;
|
|
$show{'sensor'} = 1;
|
|
$show{'swap'} = 1;
|
|
$show{'system'} = 1;},
|
|
'gpu|nvidia|nv' => sub {
|
|
$b_admin = 1;
|
|
$show{'short'} = 0;
|
|
$show{'graphic'} = 1;
|
|
$show{'graphic-full'} = 1;},
|
|
'G|graphics|graphic' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'graphic'} = 1;
|
|
$show{'graphic-basic'} = 1;
|
|
$show{'graphic-full'} = 1;},
|
|
'h|help|?' => sub {
|
|
$show{'help'} = 1;},
|
|
'i|ip' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'ip'} = 1;
|
|
$show{'network'} = 1;
|
|
$show{'network-advanced'} = 1;
|
|
$use{'downloader'} = 1 if ! main::check_program('dig');},
|
|
'I|info' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'info'} = 1;},
|
|
'j|swap|swaps' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'swap'} = 1;},
|
|
'J|usb' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'usb'} = 1;},
|
|
'l|labels|label' => sub {
|
|
$show{'label'} = 1;},
|
|
'limit:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg != 0){
|
|
$limit = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg',$opt,$arg);
|
|
}},
|
|
'L|logical|lvm' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'logical'} = 1;},
|
|
'm|memory' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'ram'} = 1;},
|
|
'memory-modules|mm' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'ram'} = 1;
|
|
$show{'ram-modules'} = 1;},
|
|
'memory-short|ms' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'ram'} = 1;
|
|
$show{'ram-short'} = 1;},
|
|
'M|machine' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'machine'} = 1;},
|
|
'n|network-advanced' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'network'} = 1;
|
|
$show{'network-advanced'} = 1;},
|
|
'N|network' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'network'} = 1;},
|
|
'o|unmounted' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'unmounted'} = 1;},
|
|
'p|partition-full|partitions-full' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'partition'} = 0;
|
|
$show{'partition-full'} = 1;},
|
|
'P|partitions|partition' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'partition'} = 1;},
|
|
'partition-sort:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg =~ /^(dev-base|fs|id|label|percent-used|size|uuid|used)$/){
|
|
$show{'partition-sort'} = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg',$opt,$arg);
|
|
}},
|
|
'r|repos|repo' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'repo'} = 1;},
|
|
'R|raid' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'raid'} = 1;
|
|
$show{'raid-forced'} = 1;},
|
|
's|sensors|sensor' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'sensor'} = 1;},
|
|
'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;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg',$opt,$arg);
|
|
}},
|
|
'slots|slot' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'slot'} = 1;},
|
|
'S|system' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'system'} = 1;},
|
|
't|processes|process:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
$show{'short'} = 0;
|
|
$arg ||= 'cm';
|
|
my $num = $arg;
|
|
$num =~ s/^[cm]+// if $num;
|
|
if ($arg =~ /^([cm]+)([0-9]+)?$/ && (!$num || $num =~ /^\d+/)){
|
|
$show{'process'} = 1;
|
|
if ($arg =~ /c/){
|
|
$show{'ps-cpu'} = 1;
|
|
}
|
|
if ($arg =~ /m/){
|
|
$show{'ps-mem'} = 1;
|
|
}
|
|
$ps_count = $num if $num;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg',$opt,$arg);
|
|
}},
|
|
'u|uuid' => sub {
|
|
$show{'uuid'} = 1;},
|
|
'v|verbosity:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
$show{'short'} = 0;
|
|
if ($arg =~ /^[0-8]$/){
|
|
if ($arg == 0){
|
|
$show{'short'} = 1;
|
|
}
|
|
if ($arg >= 1){
|
|
$show{'cpu-basic'} = 1;
|
|
$show{'disk-total'} = 1;
|
|
$show{'graphic'} = 1;
|
|
$show{'graphic-basic'} = 1;
|
|
$show{'info'} = 1;
|
|
$show{'system'} = 1;
|
|
}
|
|
if ($arg >= 2){
|
|
$show{'battery'} = 1;
|
|
$show{'disk-basic'} = 1;
|
|
$show{'raid-basic'} = 1;
|
|
$show{'machine'} = 1;
|
|
$show{'network'} = 1;
|
|
}
|
|
if ($arg >= 3){
|
|
$show{'network-advanced'} = 1;
|
|
$show{'cpu'} = 1;
|
|
$extra = 1;
|
|
}
|
|
if ($arg >= 4){
|
|
$show{'disk'} = 1;
|
|
$show{'partition'} = 1;
|
|
}
|
|
if ($arg >= 5){
|
|
$show{'audio'} = 1;
|
|
$show{'bluetooth'} = 1;
|
|
$show{'graphic-full'} = 1;
|
|
$show{'label'} = 1;
|
|
$show{'optical-basic'} = 1;
|
|
$show{'raid'} = 1;
|
|
$show{'ram'} = 1;
|
|
$show{'sensor'} = 1;
|
|
$show{'swap'} = 1;
|
|
$show{'uuid'} = 1;
|
|
}
|
|
if ($arg >= 6){
|
|
$show{'optical'} = 1;
|
|
$show{'partition-full'} = 1;
|
|
$show{'unmounted'} = 1;
|
|
$show{'usb'} = 1;
|
|
$extra = 2;
|
|
}
|
|
if ($arg >= 7){
|
|
$use{'downloader'} = 1 if !main::check_program('dig');
|
|
$show{'battery-forced'} = 1;
|
|
$show{'bluetooth-forced'} = 1;
|
|
$show{'cpu-flag'} = 1;
|
|
$show{'ip'} = 1;
|
|
$show{'logical'} = 1;
|
|
$show{'raid-forced'} = 1;
|
|
$extra = 3;
|
|
}
|
|
if ($arg >= 8){
|
|
$b_admin = 1;
|
|
# $use{'downloader'} = 1; # only if weather
|
|
$force{'pkg'} = 1;
|
|
$show{'edid'} = 1;
|
|
$show{'process'} = 1;
|
|
$show{'ps-cpu'} = 1;
|
|
$show{'ps-mem'} = 1;
|
|
$show{'repo'} = 1;
|
|
$show{'slot'} = 1;
|
|
# $show{'weather'} = 1;
|
|
}
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg',$opt,$arg);
|
|
}},
|
|
'V|version' => sub {
|
|
$show{'version'} = 1;},
|
|
'version-short|vs' => sub {
|
|
$show{'version-short'} = 1;},
|
|
'w|weather' => sub {
|
|
my ($opt) = @_;
|
|
$show{'short'} = 0;
|
|
$use{'downloader'} = 1;
|
|
if ($use{'weather'}){
|
|
$show{'weather'} = 1;
|
|
}
|
|
else {
|
|
main::error_handler('distro-block', $opt);
|
|
}},
|
|
'W|weather-location:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
$arg ||= '';
|
|
$arg =~ s/\s//g;
|
|
$show{'short'} = 0;
|
|
$use{'downloader'} = 1;
|
|
if ($use{'weather'}){
|
|
if ($arg){
|
|
$show{'weather'} = 1;
|
|
$show{'weather-location'} = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg',$opt,$arg);
|
|
}
|
|
}
|
|
else {
|
|
main::error_handler('distro-block', $opt);
|
|
}},
|
|
'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;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg',$opt,$arg);
|
|
}},
|
|
'weather-unit:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
$arg ||= '';
|
|
$arg =~ s/\s//g;
|
|
$arg = lc($arg) if $arg;
|
|
if ($arg && $arg =~ /^(c|f|cf|fc|i|m|im|mi)$/){
|
|
my %units = ('c'=>'m','f'=>'i','cf'=>'mi','fc'=>'im');
|
|
$arg = $units{$arg} if defined $units{$arg};
|
|
$weather_unit = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg',$opt,$arg);
|
|
}},
|
|
'x|extra:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg > 0){
|
|
$extra = $arg;
|
|
}
|
|
else {
|
|
$extra++;
|
|
}},
|
|
'y|width:i' => sub {
|
|
my ($opt, $arg) = @_;
|
|
if (defined $arg && $arg == -1){
|
|
$arg = 2000;
|
|
}
|
|
# note: :i creates 0 value if not supplied even though means optional
|
|
elsif (!$arg){
|
|
$arg = 80;
|
|
}
|
|
if ($arg =~ /\d/ && ($arg == 1 || $arg >= 60)){
|
|
$size{'max-cols-basic'} = $arg if $arg != 1;
|
|
$size{'max-cols'} = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'Y|height|less:i' => sub {
|
|
my ($opt, $arg) = @_;
|
|
main::error_handler('not-in-irc', '-Y/--height') if $b_irc;
|
|
if ($arg >= -3){
|
|
if ($arg >= 0){
|
|
$size{'max-lines'} = ($arg) ? $arg: $size{'term-lines'};
|
|
}
|
|
elsif ($arg == -1) {
|
|
$use{'output-block'} = 1;
|
|
}
|
|
elsif ($arg == -2) {
|
|
$force{'colors'} = 1;
|
|
}
|
|
# unset conifiguration set max height
|
|
else {
|
|
$size{'max-lines'} = 0;
|
|
}
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'z|filter' => sub {
|
|
$use{'filter'} = 1;},
|
|
'filter-all|za' => sub {
|
|
$use{'filter'} = 1;
|
|
$use{'filter-label'} = 1;
|
|
$use{'filter-uuid'} = 1;
|
|
$use{'filter-vulnerabilities'} = 1;},
|
|
'filter-label|zl' => sub {
|
|
$use{'filter-label'} = 1;},
|
|
'Z|filter-override|no-filter' => sub {
|
|
$use{'filter-override'} = 1;},
|
|
'filter-uuid|zu' => sub {
|
|
$use{'filter-uuid'} = 1;},
|
|
'filter-v|filter-vulnerabilities|zv' => sub {
|
|
$use{'filter-vulnerabilities'} = 1;},
|
|
## Start non data options
|
|
'alt:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg == 40){
|
|
$dl{'tiny'} = 0;
|
|
$use{'downloader'} = 1;}
|
|
elsif ($arg == 41){
|
|
$dl{'curl'} = 0;
|
|
$use{'downloader'} = 1;}
|
|
elsif ($arg == 42){
|
|
$dl{'fetch'} = 0;
|
|
$use{'downloader'} = 1;}
|
|
elsif ($arg == 43){
|
|
$dl{'wget'} = 0;
|
|
$use{'downloader'} = 1;}
|
|
elsif ($arg == 44){
|
|
$dl{'curl'} = 0;
|
|
$dl{'fetch'} = 0;
|
|
$dl{'wget'} = 0;
|
|
$use{'downloader'} = 1;}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
# set --arm flag separately since android can be on different platforms
|
|
'android' => sub {
|
|
$b_android = 1;},
|
|
'arm' => sub {
|
|
undef %risc;
|
|
$risc{'id'} = 'arm';
|
|
$risc{'arm'} = 1;},
|
|
'bsd:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg =~ /^(darwin|dragonfly|freebsd|openbsd|netbsd)$/i){
|
|
$bsd_type = lc($arg);
|
|
$fake{'bsd'} = 1;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}
|
|
},
|
|
'bt-tool:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg =~ /^(bluetoothctl|bt-adapter|btmgmt|hciconfig|rfkill)$/i){
|
|
$force{lc($arg)} = 1;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}
|
|
},
|
|
'cygwin' => sub {
|
|
$windows{'cygwin'} = 1;},
|
|
'dbg:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg !~ /^\d+(,\d+)*$/){
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}
|
|
for (split(',',$arg)){
|
|
$dbg[$_] = 1;
|
|
}},
|
|
'debug:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg =~ /^[1-3]|1[0-3]|2[0-4]$/){
|
|
$debugger{'level'} = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'debug-arg:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg && $arg =~ /^--?[a-z]/ig){
|
|
$debugger{'arg'} = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'debug-arg-use:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
print "$arg\n";
|
|
if ($arg && $arg =~ /^--?[a-z]/ig){
|
|
$debugger{'arg-use'} = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'debug-filter|debug-z' => sub {
|
|
$debugger{'filter'} = 1 },
|
|
'debug-id:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg){
|
|
$debugger{'id'} = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'debug-no-eps' => sub {
|
|
$debugger{'no-exit'} = 1;
|
|
$debugger{'no-proc'} = 1;
|
|
$debugger{'sys'} = 0;
|
|
},
|
|
'debug-no-exit' => sub {
|
|
$debugger{'no-exit'} = 1 },
|
|
'debug-no-proc' => sub {
|
|
$debugger{'no-proc'} = 1;},
|
|
'debug-no-sys' => sub {
|
|
$debugger{'sys'} = 0;},
|
|
'debug-proc' => sub {
|
|
$debugger{'proc'} = 1;},
|
|
'debug-proc-print' => sub {
|
|
$debugger{'proc-print'} = 1;},
|
|
'debug-sys-print' => sub {
|
|
$debugger{'sys-print'} = 1;},
|
|
'debug-test-1' => sub {
|
|
$debugger{'test-1'} = 1;},
|
|
'debug-width|debug-y:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
$arg ||= 80;
|
|
if ($arg =~ /^\d+$/ && ($arg == 1 || $arg >= 80)){
|
|
$debugger{'width'} = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'debug-zy|debug-yz:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
$arg ||= 80;
|
|
if ($arg =~ /^\d+$/ && ($arg == 1 || $arg >= 80)){
|
|
$debugger{'width'} = $arg;
|
|
$debugger{'filter'} = 1;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'dig' => sub {
|
|
$force{'no-dig'} = 0;},
|
|
'display:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg =~ /^:?([0-9\.]+)?$/){
|
|
$display=$arg;
|
|
$display ||= ':0';
|
|
$display = ":$display" if $display !~ /^:/;
|
|
$b_display = ($b_root) ? 0 : 1;
|
|
$force{'display'} = 1;
|
|
$display_opt = "-display $display";
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'dmi|dmidecode' => sub {
|
|
$force{'dmidecode'} = 1;},
|
|
'downloader:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
$arg = lc($arg);
|
|
if ($arg =~ /^(curl|fetch|ftp|perl|wget)$/){
|
|
if ($arg eq 'perl' && (!main::check_perl_module('HTTP::Tiny') ||
|
|
!main::check_perl_module('IO::Socket::SSL'))){
|
|
main::error_handler('missing-perl-downloader', $opt, $arg);
|
|
}
|
|
elsif (!main::check_program($arg)){
|
|
main::error_handler('missing-downloader', $opt, $arg);
|
|
}
|
|
else {
|
|
# this dumps all the other data and resets %dl for only the
|
|
# desired downloader.
|
|
$arg = main::set_perl_downloader($arg);
|
|
%dl = ('dl' => $arg, $arg => 1);
|
|
$use{'downloader'} = 1;
|
|
}
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'fake:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg){
|
|
my $wl = 'bluetooth|compiler|cpu|dboot|dmidecode|egl|elbrus|glx|';
|
|
$wl .= 'iomem|ip-if|ipmi|logical|lspci|partitions|pciconf|pcictl|pcidump|';
|
|
$wl .= 'raid-btrfs|raid-hw|raid-lvm|raid-md|raid-soft|raid-zfs|';
|
|
$wl .= 'sensors|sensors-sys|swaymsg|sys-mem|sysctl|uptime|usbconfig|';
|
|
$wl .= 'usbdevs|vmstat|vulkan|wl-info|wlr-randr|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 .= 'usb-sys|vmstat|wayland|wmctrl';
|
|
for (split(',',$arg)){
|
|
if ($_ =~ /\b($wl)\b/){
|
|
$force{lc($1)} = 1;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $_);
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'ftp:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
# pattern: ftp.x.x/x
|
|
if ($arg =~ /^ftp\..+\..+\/[^\/]+$/){
|
|
$ftp_alt = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'hddtemp' => sub {
|
|
$force{'hddtemp'} = 1;},
|
|
'host|hostname' => sub {
|
|
$show{'host'} = 1;
|
|
$show{'no-host'} = 0;},
|
|
'html-wan' => sub {
|
|
$force{'no-html-wan'} = 0;},
|
|
'ifconfig' => sub {
|
|
$force{'ifconfig'} = 1;},
|
|
'indent:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg >= 11){
|
|
$size{'indent'} = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'indents:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg >= 0 && $arg < 11){
|
|
$size{'indents'} = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'irc' => sub {
|
|
$b_irc = 1;},
|
|
'man' => sub {
|
|
$use{'yes-man'} = 1;},
|
|
'max-wrap|wrap-max|indent-min:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg >= 0){
|
|
$size{'max-wrap'} = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'mips' => sub {
|
|
undef %risc;
|
|
$risc{'id'} = 'mips';
|
|
$risc{'mips'} = 1;},
|
|
'no-dig' => sub {
|
|
$force{'no-dig'} = 1;},
|
|
'no-doas' => sub {
|
|
$force{'no-doas'} = 1;},
|
|
'no-host|no-hostname' => sub {
|
|
$show{'host'} = 0;
|
|
$show{'no-host'} = 1;},
|
|
'no-html-wan' => sub {
|
|
$force{'no-html-wan'}= 1;},
|
|
'no-man' => sub {
|
|
$use{'no-man'} = 0;},
|
|
'no-ssl' => sub {
|
|
$use{'no-ssl'} = 1;},
|
|
'no-sudo' => sub {
|
|
$force{'no-sudo'} = 1;},
|
|
'output|export:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg =~ /^(json|screen|xml)$/){
|
|
$output_type = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'output-file|export-file:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg){
|
|
if ($arg eq 'print' || main::check_output_path($arg)){
|
|
$output_file = $arg;
|
|
}
|
|
else {
|
|
main::error_handler('output-file-bad', $opt, $arg);
|
|
}
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'pkg|rpm' => sub {
|
|
$force{'pkg'} = 1;},
|
|
'ppc' => sub {
|
|
undef %risc;
|
|
$risc{'id'} = 'ppc';
|
|
$risc{'ppc'} = 1;},
|
|
'recommends' => sub {
|
|
$show{'recommends'} = 1;},
|
|
'riscv' => sub {
|
|
undef %risc;
|
|
$risc{'id'} = 'riscv';
|
|
$risc{'riscv'} = 1;},
|
|
'sensors-default' => sub {
|
|
$use{'sensors-default'} = 1;},
|
|
'sensors-exclude:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg){
|
|
@sensors_exclude = split(/\s*,\s*/, $arg);
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg',$opt,$arg);
|
|
}},
|
|
'sensors-sys' => sub {
|
|
$force{'sensors-sys'} = 1;},
|
|
'sensors-use:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg){
|
|
@sensors_use = split(/\s*,\s*/, $arg);
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg',$opt,$arg);
|
|
}},
|
|
'sparc' => sub {
|
|
undef %risc;
|
|
$risc{'id'} = 'sparc';
|
|
$risc{'sparc'} = 1;},
|
|
'sys-debug' => sub {
|
|
$debugger{'sys-force'} = 1;},
|
|
'tty' => sub { # workaround for ansible/scripts running this
|
|
$b_irc = 0;},
|
|
'U|update:s' => sub { # 1,2,3,4 OR http://myserver/path/inxi
|
|
my ($opt,$arg) = @_;
|
|
process_updater($opt,$arg);},
|
|
'usb-sys' => sub {
|
|
$force{'usb-sys'} = 1;},
|
|
'usb-tool' => sub {
|
|
$force{'lsusb'} = 1;},
|
|
'wan-ip-url:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg && $arg =~ /^(f|ht)tp[s]?:\/\//){
|
|
$wan_url = $arg;
|
|
$force{'no-dig'} = 1;
|
|
}
|
|
else {
|
|
main::error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'wayland|wl' => sub {
|
|
$force{'wayland'} = 1;},
|
|
'wm|wmctrl' => sub {
|
|
$force{'wmctrl'} = 1;},
|
|
'wsl' => sub {
|
|
$windows{'wsl'} = 1;},
|
|
'<>' => sub {
|
|
my ($opt) = @_;
|
|
main::error_handler('unknown-option', "$opt", "");}
|
|
); # or error_handler('unknown-option', "@ARGV", '');
|
|
# run all these after so that we can change widths, downloaders, etc
|
|
# print Data::Dumper::Dumper \%trigger;
|
|
post_process();
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
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'};
|
|
if ($b_pledge){
|
|
my $b_update;
|
|
# if -c 9x, remove in SelectColors::set_selection(), else remove here
|
|
if (!$colors{'selector'} && $debugger{'level'} < 21){
|
|
@pledges = grep {$_ ne 'getpw'} @pledges;
|
|
$b_update = 1;
|
|
}
|
|
if ($debugger{'level'} < 21){ # remove ftp upload
|
|
@pledges = grep {!/(dns|inet)/} @pledges;
|
|
$b_update = 1;
|
|
}
|
|
# not writing/creating .inxi data dirs colors selector launches set_color()
|
|
if (!$show{'weather'} && !$colors{'selector'} && $debugger{'level'} < 10 &&
|
|
$output_type eq 'screen'){
|
|
@pledges = grep {!/(cpath|wpath)/} @pledges;
|
|
$b_update = 1;
|
|
}
|
|
OpenBSD::Pledge::pledge(@pledges) if $b_update;
|
|
}
|
|
if ($output_type){
|
|
if ($output_type ne 'screen' && !$output_file){
|
|
main::error_handler('bad-arg', '--output', '--output-file not provided');
|
|
}
|
|
}
|
|
if (($show{'label'} || $show{'uuid'}) && !$show{'partition'} &&
|
|
!$show{'partition-full'} && !$show{'swap'} && !$show{'unmounted'}){
|
|
main::error_handler('bad-arg', '-l/-u', 'missing required option(s) -j, -o, -p, -P');
|
|
}
|
|
$extra = 3 if $b_admin;
|
|
# this turns off basic for F/v graphic output levels.
|
|
if ($show{'graphic-basic'} && $show{'graphic-full'} && $extra > 1){
|
|
$show{'graphic-basic'} = 0;
|
|
}
|
|
if ($force{'rpm'}){
|
|
$force{'pkg'} = 1;
|
|
delete $force{'rpm'};
|
|
}
|
|
if ($use{'sensors-default'}){
|
|
@sensors_exclude = ();
|
|
@sensors_use = ();
|
|
}
|
|
if ($show{'short'} || $show{'disk'} || $show{'disk-basic'} || $show{'disk-total'} ||
|
|
$show{'logical'} || $show{'partition'} || $show{'partition-full'} || $show{'raid'} ||
|
|
$show{'unmounted'}){
|
|
$use{'block-tool'} = 1;
|
|
}
|
|
if ($show{'short'} || $show{'raid'} || $show{'disk'} || $show{'disk-total'} ||
|
|
$show{'disk-basic'} || $show{'unmounted'}){
|
|
$use{'btrfs'} = 1;
|
|
$use{'mdadm'} = 1;
|
|
}
|
|
if ($b_admin && $show{'disk'}){
|
|
$use{'smartctl'} = 1;
|
|
}
|
|
# triggers may extend to -D, -pP
|
|
if ($show{'short'} || $show{'logical'} || $show{'raid'} || $show{'disk'} ||
|
|
$show{'disk-total'} || $show{'disk-basic'} || $show{'unmounted'}){
|
|
$use{'logical'} = 1;
|
|
}
|
|
main::set_sudo() if ($show{'unmounted'} || ($extra > 0 && $show{'disk'}));
|
|
if ($use{'filter-override'}){
|
|
$use{'filter'} = 0;
|
|
$use{'filter-label'} = 0;
|
|
$use{'filter-uuid'} = 0;
|
|
$use{'filter-vulnerabilities'} = 0;
|
|
}
|
|
# override for things like -b or -v2 to -v3
|
|
$show{'cpu-basic'} = 0 if $show{'cpu'};
|
|
$show{'optical-basic'} = 0 if $show{'optical'};
|
|
$show{'partition'} = 0 if $show{'partition-full'};
|
|
$show{'host'} = 0 if $show{'no-host'};
|
|
$show{'host'} = 1 if ($show{'host'} || (!$use{'filter'} && !$show{'no-host'}));
|
|
if ($show{'disk'} || $show{'optical'}){
|
|
$show{'disk-basic'} = 0;
|
|
$show{'disk-total'} = 0;
|
|
}
|
|
if ($show{'ram'} || $show{'slot'} ||
|
|
($show{'cpu'} && ($extra > 1 || $bsd_type)) ||
|
|
(($bsd_type || $force{'dmidecode'}) && ($show{'machine'} || $show{'battery'}))){
|
|
$use{'dmidecode'} = 1;
|
|
}
|
|
if ($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 show_options {
|
|
error_handler('not-in-irc', 'help') if $b_irc;
|
|
my $rows = [];
|
|
my $line = make_line();
|
|
my $color_scheme_count = get_color_scheme('count') - 1;
|
|
my $partition_string='partition';
|
|
my $partition_string_u='Partition';
|
|
my $flags = (%risc || $bsd_type) ? 'features' : 'flags' ;
|
|
if ($bsd_type){
|
|
$partition_string='slice';
|
|
$partition_string_u='Slice';
|
|
}
|
|
# fit the line to the screen!
|
|
push(@$rows,
|
|
['0', '', '', "$self_name supports the following options. For more detailed
|
|
information, see man^$self_name. If you start $self_name with no arguments,
|
|
it will display a short system summary."],
|
|
['0', '', '', ''],
|
|
['0', '', '', "You can use these options alone or together,
|
|
to show or add the item(s) you want to see: A, B, C, D, 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, --edid, --slots.
|
|
If you use them with -v [level], -b or -F, $self_name will add the requested
|
|
lines to the output."],
|
|
['0', '', '', '' ],
|
|
['0', '', '', "Examples:^$self_name^-v4^-c6 OR $self_name^-bDc^6 OR
|
|
$self_name^-FzjJxy^80"],
|
|
['0', '', '', $line ],
|
|
['0', '', '', "See Filter Options for output filtering, Output Control Options
|
|
for colors, sizing, output changes, Extra Data Options to extend Main output,
|
|
Additional Options and Advanced Options for less common situations."],
|
|
['0', '', '', $line ],
|
|
['0', '', '', "Main Feature Options:"],
|
|
['1', '-A', '--audio', "Audio/sound devices(s), driver; active sound APIs and
|
|
servers."],
|
|
['1', '-b', '--basic', "Basic output, short form. Same as $self_name^-v^2."],
|
|
['1', '-B', '--battery', "System battery info, including charge, condition
|
|
voltage (if critical), plus extra info (if battery present/detected)."],
|
|
['1', '-C', '--cpu', "CPU output (if each item available): basic topology,
|
|
model, type (see man for types), cache, average CPU speed, min/max speeds,
|
|
per core clock speeds."],
|
|
['1', '-d', '--disk-full, --optical', "Optical drive data (and floppy disks,
|
|
if present). Triggers -D."],
|
|
['1', '-D', '--disk', "Hard Disk info, including total storage and details
|
|
for each disk. Disk total used percentage includes swap ${partition_string}
|
|
size(s)."],
|
|
['1', '-E', '--bluetooth', "Show bluetooth device data and report, if
|
|
available. Shows state, address, IDs, version info."],
|
|
['1', '', '--edid', "Full graphics data, triggers -a, -G. Add monitor chroma,
|
|
full modelines (if > 2), EDID errors and warnings, if present."],
|
|
['1', '-f', '--flags', "All CPU $flags. Triggers -C. Not shown with -F to
|
|
avoid spamming."],
|
|
['1', '-F', '--full', "Full output. Includes all Upper Case line letters
|
|
(except -J, -W) plus --swap, -s and -n. Does not show extra verbose options
|
|
such as -d -f -i -J -l -m -o -p -r -t -u -x, unless specified."],
|
|
['1', '', '--gpu', "Deprecated. Triggers -Ga."],
|
|
['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 (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, type (e.g. DDR3), size, speed. Also shows
|
|
System RAM report, and removes Memory report from -I or -tm."],
|
|
['1', '', '--memory-modules,--mm', "Memory (RAM) data. Exclude empty module slots."],
|
|
['1', '', '--memory-short,--ms', "Memory (RAM) data. Show only short Memory RAM
|
|
report, number of arrays, slots, modules, and RAM type."],
|
|
['1', '-M', '--machine', "Machine data. Device type (desktop, server, laptop,
|
|
VM etc.), motherboard, BIOS and, if present, system builder (e.g. Lenovo).
|
|
Shows UEFI/BIOS/UEFI [Legacy]. Older systems/kernels without the required /sys
|
|
data can use dmidecode instead, run as root. Dmidecode can be forced with
|
|
--dmidecode"],
|
|
['1', '-n', '--network-advanced', "Advanced Network device info. Triggers -N.
|
|
Shows interface, speed, MAC id, state, etc. "],
|
|
['1', '-N', '--network', "Network device(s), driver."],
|
|
['1', '-o', '--unmounted', "Unmounted $partition_string info (includes UUID
|
|
and Label if available). Shows file system type if you have lsblk installed
|
|
(Linux) or, for BSD/GNU Linux, if 'file' installed and you are root or if
|
|
you have added to /etc/sudoers (sudo v. 1.7 or newer)(or try doas)."],
|
|
['1', '', '', "Example: ^<username>^ALL^=^NOPASSWD:^/usr/bin/file^"],
|
|
['1', '-p', '--partitions-full', "Full $partition_string information (-P plus
|
|
all other detected ${partition_string}s)."],
|
|
['1', '-P', '--partitions', "Basic $partition_string info. Shows, if detected:
|
|
/ /boot /home /opt /tmp /usr /usr/home /var /var/log /var/tmp. Swap
|
|
${partition_string}s show if --swap is not used. Use -p to see all
|
|
mounted ${partition_string}s."],
|
|
['1', '-r', '--repos', "Distro repository data. Supported repo types: APK,
|
|
APT, CARDS, EOPKG, NETPKG, NIX, PACMAN, PACMAN-G2, PISI, PKG (BSDs), PORTAGE,
|
|
PORTS (BSDs), SBOPKG, SBOUI, SCRATCHPKG, SLACKPKG, SLAPT_GET, SLPKG, 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."],
|
|
['1', '-s', '--sensors', "Sensors output (if sensors installed/configured):
|
|
mobo/CPU/GPU temp; detected fan speeds. Nvidia shows screen number for > 1
|
|
screen. IPMI sensors if present."],
|
|
['1', '', '--slots', "PCI slots: type, speed, status. Requires root."],
|
|
['1', '-S', '--system', "System info: host name, kernel, desktop environment
|
|
(if in X/Wayland), distro."],
|
|
['1', '-t', '--processes', "Processes. Requires extra options: c (CPU), m
|
|
(memory), cm (CPU+memory). If followed by numbers 1-x, shows that number
|
|
of processes for each type (default: 5; if in IRC, max: 5). "],
|
|
['1', '', '', "Make sure that there is no space between letters and
|
|
numbers (e.g.^-t^cm10)."],
|
|
['1', '-u', '--uuid', "$partition_string_u UUIDs. Use with -j, -o, -p, -P."],
|
|
['1', '-v', '--verbosity', "Set $self_name verbosity level (0-8).
|
|
Should not be used with -b or -F. Example: $self_name^-v^4"],
|
|
['2', '0', '', "Same as: $self_name"],
|
|
['2', '1', '', "Basic verbose, -S + basic CPU + -G + basic Disk + -I."],
|
|
['2', '2', '', "Networking device (-N), Machine (-M), Battery (-B; if
|
|
present), and, if present, basic RAID (devices only; notes if inactive). Same
|
|
as $self_name^-b"],
|
|
['2', '3', '', "Advanced CPU (-C), battery (-B), network (-n);
|
|
triggers -x. "],
|
|
['2', '4', '', "$partition_string_u size/used data (-P) for
|
|
(if present) /, /home, /var/, /boot. Shows full disk data (-D). "],
|
|
['2', '5', '', "Audio device (-A), sensors (-s), memory/RAM (-m),
|
|
bluetooth (if present), $partition_string label^(-l), full swap (-j),
|
|
UUID^(-u), short form of optical drives, RAID data (if present)."],
|
|
['2', '6', '', "Full $partition_string (-p),
|
|
unmounted $partition_string (-o), optical drive (-d), USB (-J),
|
|
full RAID; triggers -xx."],
|
|
['2', '7', '', "Network IP data (-i), bluetooth, logical (-L),
|
|
RAID forced, full CPU $flags; triggers -xxx."],
|
|
['2', '8', '', "Everything available, including advanced gpu EDID (--edid)
|
|
data, repos (-r), processes (-tcm), PCI slots (--slots); triggers
|
|
admin (-a)."],
|
|
);
|
|
# if distro maintainers don't want the weather feature disable it
|
|
if ($use{'weather'}){
|
|
push(@$rows,
|
|
['1', '-w', '--weather', "Local weather data/time. To check an alternate
|
|
location, see -W. NO AUTOMATED QUERIES OR EXCESSIVE USE ALLOWED!"],
|
|
['1', '-W', '--weather-location', "[location] Supported options for
|
|
[location]: 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)."],
|
|
);
|
|
}
|
|
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."],
|
|
['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', '', '--limit', "[-1; 1-x] Set max output limit of IP addresses for -i
|
|
(default 10; -1 removes limit)."],
|
|
['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', '', '--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', '', '--separator, --sep', "[key:value separator character]. Change
|
|
separator character(s) for key: value pairs."],
|
|
['1', '-y', '--width', "[empty|-1|1|60-xxx] Output line width max. Overrides
|
|
IRC/Terminal settings or actual widths. If no integer give, defaults to 80.
|
|
-1 removes line lengths. 1 switches output to 1 key/value pair per line.
|
|
Example:^inxi^-y^130"],
|
|
['1', '-Y', '--height', "[empty|-3-xxx] Output height control. Similar to
|
|
'less' command except colors preserved, defaults to console/terminal height.
|
|
-1 shows 1 primary Item: at a time; -2 retains color on redirect/piping (to
|
|
less -R); -3 removes configuration value; 0 or -Y sets to detected terminal
|
|
height. Greater than 0 shows x lines at a time."],
|
|
['0', '', '', "$line"],
|
|
['0', '', '', "Extra Data Options:"],
|
|
['1', '-x', '--extra', "Adds the following extra data (only works with
|
|
verbose or line output, not short form):"],
|
|
['2', '-A', '', "Specific vendor/product information (if relevant);
|
|
PCI/USB ID of device; Version/port(s)/driver version (if available);
|
|
inactive sound servers/APIs."],
|
|
['2', '-B', '', "Current/minimum voltage, vendor/model, status (if available);
|
|
attached devices (e.g. wireless mouse, keyboard, if present)."],
|
|
['2', '-C', '', "L1/L3 cache (if most Linux, or if root and dmidecode
|
|
installed); smt if disabled, CPU $flags (short list, use -f to see full list);
|
|
Highest core speed (if > 1 core); CPU boost (turbo) enabled/disabled, if
|
|
present; Bogomips on CPU; CPU microarchitecture + revision (if found, or
|
|
unless --admin, then shows as 'stepping')."],
|
|
['2', '-d', '', "Extra optical drive features data; adds rev version to
|
|
optical drive."],
|
|
['2', '-D', '', "HDD temp with disk data. Kernels >= 5.6: enable module
|
|
drivetemp if not enabled. Older systems require hddtemp, run as
|
|
as superuser, or as user if you have added hddtemp to /etc/sudoers
|
|
(sudo v. 1.7 or newer)(or try doas).
|
|
Example:^<username>^ALL^=^NOPASSWD:^/usr/sbin/hddtemp"],
|
|
['2', '-E', '', "PCI/USB Bus ID of device, driver version,
|
|
LMP version."],
|
|
['2', '-G', '', "GPU arch (AMD/Intel/Nvidia only); Specific vendor/product
|
|
information (if relevant); PCI/USB ID of device; Screen number GPU is running
|
|
on (Nvidia only); device temp (Linux, if found); APIs: EGL: active/inactive
|
|
platforms; OpenGL: direct rendering status (in X); Vulkan device counts."],
|
|
['2', '-i', '', "For IPv6, show additional scope addresses: Global, Site,
|
|
Temporary, Unknown. See --limit for large counts of IP addresses."],
|
|
['2', '-I', '', "Default system 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/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,--memory-modules', '', "Max memory module size (if available)."],
|
|
['2', '-N', '', "Specific vendor/product information (if relevant);
|
|
PCI/USB ID of device; Version/port(s)/driver version (if available); device
|
|
temperature (Linux, if found)."],
|
|
['2', '-o,-p,-P', '', "Add mapped: name if partition mapped."],
|
|
['2', '-r', '', "Packages, see -Ix."],
|
|
['2', '-R', '', "md-raid: second RAID Info line with extra data:
|
|
blocks, chunk size, bitmap (if present). Resync line, shows blocks
|
|
synced/total blocks. Hardware RAID driver version, bus-ID."],
|
|
['2', '-s', '', "Basic voltages (ipmi, lm-sensors if present): 12v, 5v, 3.3v,
|
|
vbat."],
|
|
['2', '-S', '', "Kernel gcc version; system base of distro (if relevant
|
|
and detected)"],
|
|
['2', '', '--slots', "Adds BusID for slot."],
|
|
['2', '-t', '', "Adds memory use output to CPU (-xt c), and CPU use to
|
|
memory (-xt m)."],
|
|
);
|
|
if ($use{'weather'}){
|
|
push(@$rows,
|
|
['2', '-w,-W', '', "Wind speed and direction, humidity, pressure,
|
|
and time zone, if available."]);
|
|
}
|
|
push(@$rows,
|
|
['0', '', '', ''],
|
|
['1', '-xx', '--extra 2', "Show extra, extra data (only works with verbose
|
|
or line output, not short form):"],
|
|
['2', '-A', '', "Chip vendor:product ID for each audio device; PCIe speed,
|
|
lanes (if found); USB rev, speed, lanes (if found); sound server/api helper
|
|
daemons/plugins."],
|
|
['2', '-B', '', "Power used, in watts; serial number."],
|
|
['2', '-D', '', "Disk transfer speed; NVMe lanes; USB rev, speed, lanes (if
|
|
found); Disk serial number; LVM volume group free space (if available); disk
|
|
duid (some BSDs)."],
|
|
['2', '-E', '', "Chip vendor:product ID, LMP subversion; PCIe speed, lanes
|
|
(if found); USB rev, speed, lanes (if found)."],
|
|
['2', '-G', '', "Chip vendor:product ID for each video device; Output ports,
|
|
used and empty; PCIe speed, lanes (if found); USB rev, speed, lanes (if
|
|
found); Xorg: Xorg compositor; alternate Xorg drivers (if available. Alternate
|
|
means driver is on automatic driver check list of Xorg for the device vendor,
|
|
but is not installed on system); Xorg Screen data: ID, s-res, dpi; Monitors:
|
|
ID, position (if > 1), resolution, dpi, model, diagonal; APIs: EGL: per
|
|
platform report; OpenGL: ES version, device-ID, display-ID (if not found in
|
|
Display line); Vulkan: per device report."],
|
|
['2', '-I', '', "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); memory array voltage (legacy, rare); module voltage (if
|
|
available)."],
|
|
['2', '-M', '', "Chassis info, 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; slot voltage, if available."],
|
|
);
|
|
if ($use{'weather'}){
|
|
push(@$rows,
|
|
['2', '-w,-W', '', "Snow, rain, precipitation, (last observed hour),
|
|
cloud cover, wind chill, dew point, heat index, if available."]
|
|
);
|
|
}
|
|
push(@$rows,
|
|
['0', '', '', ''],
|
|
['1', '-xxx', '--extra 3', "Show extra, extra, extra data (only works
|
|
with verbose or line output, not short form):"],
|
|
['2', '-A', '', "Serial number, class ID."],
|
|
['2', '-B', '', "Chemistry, cycles, location (if available)."],
|
|
['2', '-C', '', "CPU voltage, external clock speed (if root and dmidecode
|
|
installed); smt status, if available."],
|
|
['2', '-D', '', "Firmware rev. if available; partition scheme, in some cases;
|
|
disk type, rotation rpm (if available)."],
|
|
['2', '-E', '', "Serial number, class ID, bluetooth device class ID, HCI
|
|
version and revision."],
|
|
['2', '-G', '', "Device serial number, class ID; Xorg Screen size, diag;
|
|
Monitors: hz, size, modes, serial, scale, modes (max/min); APIs: EGL: hardware
|
|
driver info; Vulkan: layer count, device hardware vendor."],
|
|
['2', '-I', '', "For '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; adds wakeups: (from suspend) to Uptime."],
|
|
['2', '-J', '', "If present: Devices: serial number, interface count, max
|
|
power."],
|
|
['2', '-m,--memory-modules', '', "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', '-N', '', "Serial number, class ID."],
|
|
['2', '-R', '', "zfs-raid: portion allocated (used) by RAID devices/arrays.
|
|
md-raid: system md-raid support types (kernel support, read ahead, RAID
|
|
events). Hardware RAID rev, ports, specific vendor/product information."],
|
|
['2', '-S', '', "Kernel clocksource; 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, virtual terminal number."],
|
|
);
|
|
if ($use{'weather'}){
|
|
push(@$rows,
|
|
['2', '-w,-W', '', "Location (uses -z/irc filter), weather observation
|
|
time, altitude, sunrise/sunset, if available."]
|
|
);
|
|
}
|
|
push(@$rows,
|
|
['0', '', '', ''],
|
|
['1', '-a', '--admin', "Adds advanced sys admin data (only works with
|
|
verbose or line output, not short form); check man page for explanations!;
|
|
also sets --extra=3:"],
|
|
['2', '-A', '', "If available: list of alternate kernel modules/drivers
|
|
for device(s); PCIe lanes-max: gen, speed, lanes (if relevant); USB mode (if
|
|
found); list of installed tools for servers."],
|
|
['2', '-C', '', "If available: microarchitecture level (64 bit AMD/Intel
|
|
only).CPU generation, process node, built years; CPU socket type, base/boost
|
|
speeds (dmidecode+root/sudo/doas required); Full topology line, with 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 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."],
|
|
['2', '-n,-N', '', "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."],
|
|
['2', '', '--slots', "If available: slot bus ID children."],
|
|
);
|
|
push(@$rows,
|
|
[0, '', '', "$line"],
|
|
[0, '', '', "Additional Options:"],
|
|
['1', '--config', '--configuration', "Show active configurations, by file(s).
|
|
Last item listed overrides previous."],
|
|
['1', '-h', '--help', "This help menu."],
|
|
['1', '', '--recommends', "Checks $self_name application dependencies +
|
|
recommends, and directories, then shows what package(s) you need to install
|
|
to add support for that feature."],
|
|
);
|
|
if ($use{'update'}){
|
|
push(@$rows,
|
|
['1', '-U', '--update', "Auto-update $self_name. Will also install/update
|
|
man page. Note: if you installed as root, you must be root to update,
|
|
otherwise user is fine. Man page installs require root. No arguments
|
|
downloads from main $self_name git repo."],
|
|
['1', '', '', "Use alternate sources for updating $self_name"],
|
|
['3', '3', '', "Get the dev server (smxi.org) version."],
|
|
['3', '4', '', "Get the dev server (smxi.org) FTP version. Use if SSL issues
|
|
and --no-ssl doesn't work."],
|
|
['2', '<http|https|ftp>', '', "Get a version of $self_name from your own
|
|
server. Use the full download path, e.g.
|
|
^$self_name^-U ^https://myserver.com/inxi"],
|
|
);
|
|
}
|
|
push(@$rows,
|
|
['1', '-V', '--version', "Prints full $self_name version info then exits."],
|
|
['1', '', '--version-short,--vs', "Prints 1 line $self_name version info. Can
|
|
be used with other line options."],
|
|
['0', '', '', "$line"],
|
|
['0', '', '', "Advanced Options:"],
|
|
['1', '', '--alt', "Trigger for various advanced options:"],
|
|
['2', '40', '', "Bypass Perl as a downloader option."],
|
|
['2', '41', '', "Bypass Curl as a downloader option."],
|
|
['2', '42', '', "Bypass Fetch as a downloader option."],
|
|
['2', '43', '', "Bypass Wget as a downloader option."],
|
|
['2', '44', '', "Bypass Curl, Fetch, and Wget as downloader options. Forces
|
|
Perl if HTTP::Tiny present."],
|
|
['1', '', '--bt-tool', "[bt-adapter btmgmt hciconfig rfkill] Force use of
|
|
given tool 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(@$rows,
|
|
['1', '', '--man', "Install correct man version for dev branch (-U 3) or
|
|
pinxi using -U."],
|
|
);
|
|
}
|
|
push(@$rows,
|
|
['1', '', '--no-dig', "Skip dig for WAN IP checks, use downloader program."],
|
|
['1', '', '--no-doas', "Skip internal program use of doas features (not
|
|
related to starting $self_name with doas)."],
|
|
['1', '', '--no-html-wan', "Skip HTML IP sources for WAN IP checks, use dig
|
|
only, or nothing if --no-dig."],
|
|
);
|
|
if ($use{'update'}){
|
|
push(@$rows,
|
|
['1', '', '--no-man', "Disable man install for all -U update actions."],
|
|
);
|
|
}
|
|
push(@$rows,
|
|
['1', '', '--no-ssl', "Skip SSL certificate checks for all downloader actions
|
|
(Wget/Fetch/Curl/Perl-HTTP::Tiny)."],
|
|
['1', '', '--no-sudo', "Skip internal program use of sudo features (not
|
|
related to starting $self_name with sudo)."],
|
|
['1', '', '--rpm', "Force use of disabled package manager counts for packages
|
|
feature with -rx/-Ix. RPM disabled by default due to 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. See -Z for disabling output filters
|
|
as well."],
|
|
['1', '', '--usb-sys', "Force USB data to use only /sys as data source (Linux
|
|
only)."],
|
|
['1', '', '--usb-tool', "Force USB data to use lsusb as data source [default]
|
|
(Linux only)."],
|
|
['1', '', '--wan-ip-url', "[URL] Skips dig, uses supplied URL for WAN IP (-i).
|
|
URL output must end in the IP address. See man.
|
|
Example:^$self_name^-i^--wan-ip-url^https://yoursite.com/remote-ip"],
|
|
['1', '', '--wm', "Force wm: to use wmctrl as data source. Default uses ps."],
|
|
['0', '', '', $line ],
|
|
['0', '', '', "Debugging Options:"],
|
|
['1', '', '--dbg', "[1-xx[,1-xx]] Comma separated list of debugger numbers.
|
|
Each triggers specific debugger[s]. See man page or docs."],
|
|
['2', '1', '', "Show downloader output. Turns off quiet mode."],
|
|
['1', '', '--debug', "[1-3|10|11|20-22] Triggers debugging modes."],
|
|
['2', '1-3', '', "On screen debugger output."],
|
|
['2', '10', '', "Basic logging."],
|
|
['2', '11', '', "Full file/system info logging."],
|
|
['1', '', ,'', "The following create a tar.gz file of system data, plus
|
|
$self_name output. To automatically upload debugger data tar.gz file to
|
|
ftp.smxi.org: $self_name^--debug^21"],
|
|
['2', '20', '', "Full system data collection: /sys; xorg conf and log data,
|
|
xrandr, xprop, xdpyinfo, glxinfo etc.; data from dev, disks,
|
|
${partition_string}s, etc."],
|
|
['2', '21', '', "Upload debugger dataset to $self_name debugger server
|
|
automatically, removes debugger data directory, leaves tar.gz debugger file."],
|
|
['2', '22', '', "Upload debugger dataset to $self_name debugger server
|
|
automatically, removes debugger data directory and debugger tar.gz file."],
|
|
# ['1', '', '--debug-filter', "Add -z flag to debugger $self_name optiions."],
|
|
['1', '', '--debug-id', "[short-string] Add given string to debugger file
|
|
name. Helps identify source of debugger dataset. Use with --debug 20-22."],
|
|
['1', '', '--debug-proc', "Force debugger parsing of /proc as sudo/doas/root."],
|
|
['1', '', '--debug-proc-print', "To locate file that /proc debugger hangs on."],
|
|
['1', '', '--debug-no-exit', "Skip exit on error to allow completion."],
|
|
['1', '', '--debug-no-proc', "Skip /proc debugging in case of a hang."],
|
|
['1', '', '--debug-no-sys', "Skip /sys debugging in case of a hang."],
|
|
['1', '', '--debug-sys', "Force PowerPC debugger parsing of /sys as
|
|
sudo/doas/root."],
|
|
['1', '', '--debug-sys-print', "To locate file that /sys debugger hangs on."],
|
|
['1', '', '--ftp', "Use with --debugger 21 to trigger an alternate FTP server
|
|
for upload. Format:^[ftp.xx.xx/yy]. Must include a remote directory to upload
|
|
to. Example:^$self_name^--debug^21^--ftp^ftp.myserver.com/incoming"],
|
|
['0', '', '', "$line"],
|
|
);
|
|
print_basic($rows);
|
|
exit 0; # shell true
|
|
}
|
|
|
|
sub show_version {
|
|
# if not in PATH could be either . or directory name, no slash starting
|
|
my $working_path=$self_path;
|
|
my ($link,$self_string);
|
|
my $rows = [];
|
|
Cwd->import('getcwd'); # no point loading this on top use, we only use getcwd here
|
|
if ($working_path eq '.'){
|
|
$working_path = getcwd();
|
|
}
|
|
elsif ($working_path !~ /^\//){
|
|
$working_path = getcwd() . "/$working_path";
|
|
}
|
|
$working_path =~ s%/$%%;
|
|
# handle if it's a symbolic link, rare, but can happen with directories
|
|
# in irc clients which would only matter if user starts inxi with -! 30 override
|
|
# in irc client
|
|
if (-l "$working_path/$self_name"){
|
|
$link="$working_path/$self_name";
|
|
$working_path = readlink "$working_path/$self_name";
|
|
$working_path =~ s/[^\/]+$//;
|
|
}
|
|
# strange output /./ ending, but just trim it off, I don't know how it happens
|
|
$working_path =~ s%/\./%/%;
|
|
push(@$rows, [ 0, '', '', "$self_name $self_version-$self_patch ($self_date)"]);
|
|
if (!$b_irc && !$show{'version-short'}){
|
|
push(@$rows, [ 0, '', '', '']);
|
|
my $year = (split/-/, $self_date)[0];
|
|
push(@$rows,
|
|
[ 0, '', '', "Copyright^(C)^2008-$year^Harald^Hope^aka^h2"],
|
|
[ 0, '', '', "Forked from Infobash 3.02: Copyright^(C)^2005-2007^Michiel^de^Boer^aka^locsmif." ],
|
|
[ 0, '', '', "Using Perl version: $]"],
|
|
[ 0, '', '', "Program Location: $working_path" ],
|
|
);
|
|
if ($link){
|
|
push(@$rows, [ 0, '', '', "Started via symbolic link: $link" ]);
|
|
}
|
|
push(@$rows,
|
|
[ 0, '', '', '' ],
|
|
[ 0, '', '', "Website:^https://codeberg.org/smxi/inxi^or^https://smxi.org/" ],
|
|
[ 0, '', '', "IRC:^irc.oftc.net channel:^#smxi" ],
|
|
[ 0, '', '', "Forums:^https://techpatterns.com/forums/forum-33.html" ],
|
|
[ 0, '', '', '' ],
|
|
[ 0, '', '', "This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by the Free Software
|
|
Foundation; either version 3 of the License, or (at your option) any later version.
|
|
(https://www.gnu.org/licenses/gpl.html)" ]
|
|
);
|
|
}
|
|
print_basic($rows);
|
|
exit 0 if !$show{'version-short'} || $show{'short'}; # shell true
|
|
}
|
|
|
|
########################################################################
|
|
#### STARTUP DATA
|
|
########################################################################
|
|
|
|
## StartClient
|
|
{
|
|
package StartClient;
|
|
# use warnings;
|
|
# use strict;
|
|
my $pppid = '';
|
|
|
|
# NOTE: there's no reason to create an object, we can just access
|
|
# the features statically.
|
|
# args: none
|
|
# sub new {
|
|
# my $class = shift;
|
|
# my $self = {};
|
|
# # print "$f\n";
|
|
# # print "$type\n";
|
|
# return bless $self, $class;
|
|
# }
|
|
|
|
sub set {
|
|
eval $start if $b_log;
|
|
main::set_ps_aux() if !$loaded{'ps-aux'};
|
|
# $b_irc = 1; # for testing, like cli konvi start which shows as tty
|
|
if (!$b_irc){
|
|
# we'll run ShellData::set() for -I, but only then
|
|
}
|
|
else {
|
|
$use{'filter'} = 1;
|
|
get_client_name();
|
|
if ($client{'konvi'} == 1 || $client{'konvi'} == 3){
|
|
set_konvi_data();
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_client_name {
|
|
eval $start if $b_log;
|
|
my $client_name = '';
|
|
# print "$ppid\n";
|
|
if ($ppid && -e "/proc/$ppid/exe"){
|
|
$client_name = lc(readlink "/proc/$ppid/exe");
|
|
$client_name =~ s/^.*\///;
|
|
if ($client_name =~ /^(bash|csh|dash|fish|sh|python.*|perl.*|zsh)$/){
|
|
$pppid = (main::grabber("ps -wwp $ppid -o ppid"))[1];
|
|
# my @temp = (main::grabber("ps -wwp $ppid -o ppid 2>/dev/null"))[1];
|
|
$pppid =~ s/^\s+|\s+$//g;
|
|
$client_name =~ s/[0-9\.]+$//; # clean things like python2.7
|
|
if ($pppid && -f "/proc/$pppid/exe"){
|
|
$client_name = lc(readlink "/proc/$pppid/exe");
|
|
$client_name =~ s/^.*\///;
|
|
$client{'native'} = 0;
|
|
}
|
|
}
|
|
$client{'name'} = $client_name;
|
|
get_client_version();
|
|
# print "c:$client_name p:$pppid\n";
|
|
# print "$client{'name-print'}\n";
|
|
}
|
|
else {
|
|
if (!check_modern_konvi()){
|
|
$client_name = (main::grabber("ps -wwp $ppid 2>/dev/null"))[1];
|
|
if ($client_name){
|
|
my @data = split(/\s+/, $client_name);
|
|
if ($bsd_type){
|
|
$client_name = lc($data[4]);
|
|
}
|
|
# gnu/linux uses last value
|
|
else {
|
|
$client_name = lc($data[-1]);
|
|
}
|
|
$client_name =~ s/.*\|-(|)//;
|
|
$client_name =~ s/[0-9\.]+$//; # clean things like python2.7
|
|
$client{'name'} = $client_name;
|
|
$client{'native'} = 1;
|
|
get_client_version();
|
|
}
|
|
else {
|
|
$client{'name'} = "PPID='$ppid' - Empty?";
|
|
}
|
|
}
|
|
}
|
|
if ($b_log){
|
|
my $string = "Client: $client{'name'} :: version: $client{'version'} :: 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 (@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{'name-print'} = $app[3];
|
|
$client{'console-irc'} = $app[4];
|
|
}
|
|
if ($client{'name'} =~ /^(bash|csh|fish|dash|sh|zsh)$/){
|
|
$client{'name-print'} = 'shell wrapper';
|
|
$client{'console-irc'} = 1;
|
|
}
|
|
elsif ($client{'name'} eq 'bitchx'){
|
|
@data = main::grabber("$client{'name'} -v");
|
|
$string = awk(\@data,'Version');
|
|
if ($string){
|
|
$string =~ s/[()]|bitchx-//g;
|
|
@data = split(/\s+/, $string);
|
|
$_=lc for @data;
|
|
$client{'version'} = ($data[1] eq 'version') ? $data[2] : $data[1];
|
|
}
|
|
}
|
|
# 'hexchat' => ['',0,'','HexChat',0,0], # special
|
|
# the hexchat author decided to make --version/-v return a gtk dialogue box, lol...
|
|
# so we need to read the actual config file for hexchat. Note that older hexchats
|
|
# used xchat config file, so test first for default, then legacy. Because it's possible
|
|
# for this file to be user edited, doing some extra checks here.
|
|
elsif ($client{'name'} eq 'hexchat'){
|
|
if (-f '~/.config/hexchat/hexchat.conf'){
|
|
@data = main::reader('~/.config/hexchat/hexchat.conf','strip');
|
|
}
|
|
elsif (-f '~/.config/hexchat/xchat.conf'){
|
|
@data = main::reader('~/.config/hexchat/xchat.conf','strip');
|
|
}
|
|
if (@data){
|
|
$client{'version'} = main::awk(\@data,'version',2,'\s*=\s*');
|
|
}
|
|
# fingers crossed, hexchat won't open gui!!
|
|
if (!$client{'version'}){
|
|
@data = main::grabber("$client{'name'} --version 2>/dev/null");
|
|
$client{'version'} = main::awk(\@data,'hexchat',2,'\s+');
|
|
}
|
|
$client{'name-print'} = 'HexChat';
|
|
}
|
|
# note: see legacy inxi konvi logic if we need to restore any of the legacy code.
|
|
elsif ($client{'name'} eq 'konversation'){
|
|
$client{'konvi'} = (!$client{'native'}) ? 2 : 1;
|
|
}
|
|
elsif ($client{'name'} =~ /quassel/i){
|
|
@data = main::grabber("$client{'name'} -v 2>/dev/null");
|
|
foreach (@data){
|
|
if ($_ =~ /^Quassel IRC:/){
|
|
$client{'version'} = (split(/\s+/, $_))[2];
|
|
last;
|
|
}
|
|
elsif ($_ =~ /quassel\s[v]?[0-9]/){
|
|
$client{'version'} = (split(/\s+/, $_))[1];
|
|
last;
|
|
}
|
|
}
|
|
$client{'version'} ||= '(pre v0.4.1)?';
|
|
}
|
|
# then do some perl type searches, do this last since it's a wildcard search
|
|
elsif ($client{'name'} =~ /^(perl.*|ksirc|dsirc)$/){
|
|
my $cmdline = main::get_cmdline();
|
|
# Dynamic runpath detection is too complex with KSirc, because KSirc is started from
|
|
# kdeinit. /proc/<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.
|
|
# Then, KSirc runs dsirc as the perl irc script and wraps around it. When /exec is executed,
|
|
# dsirc is the program that runs inxi, therefore that is the parent process that we see.
|
|
# You can imagine how hosed I am if I try to make inxi find out dynamically with which path
|
|
# KSirc was run by browsing up the process tree in /proc. That alone is straightjacket material.
|
|
# (KSirc sucks anyway ;)
|
|
foreach (@$cmdline){
|
|
if ($_ =~ /dsirc/){
|
|
$client{'version'} = main::program_version('ksirc','KSirc:',2,'-v',0,0);
|
|
$client{'name'} = 'ksirc';
|
|
$client{'name-print'} = 'KSirc';
|
|
}
|
|
}
|
|
$client{'console-irc'} = 1;
|
|
perl_python_client();
|
|
}
|
|
elsif ($client{'name'} =~ /python/){
|
|
perl_python_client();
|
|
}
|
|
# NOTE: these must be empirically determined, not all events that
|
|
# show no tty are actually IRC. tmux is not a vt, but runs inside one
|
|
if (!$client{'name-print'}){
|
|
my $wl_terms = 'alacritty|altyo|\bate\b|black-screen|conhost|doas|evilvte|';
|
|
$wl_terms .= 'foot|germinal|guake|havoc|hyper|kate|kitty|kmscon|konsole|';
|
|
$wl_terms .= 'login|macwise|minicom|putty|rxvt|sakura|securecrt|';
|
|
$wl_terms .= 'shellinabox|^st$|sudo|term|tilda|tilix|tmux|tym|wayst|xiki|';
|
|
$wl_terms .= 'yaft|yakuake|\bzoc\b';
|
|
my $wl_clients = 'ansible|chef|run-parts|slurm|sshd';
|
|
my $whitelist = "$wl_terms|$wl_clients";
|
|
# print "$client{'name'}\n";
|
|
if ($client{'name'} =~ /($whitelist)/i){
|
|
if ($client{'name'} =~ /($wl_terms)/i){
|
|
ShellData::set();
|
|
}
|
|
else {
|
|
$client{'name-print'} = $client{'name'};
|
|
}
|
|
$b_irc = 0;
|
|
$use{'filter'} = 0;
|
|
}
|
|
else {
|
|
$client{'name-print'} = 'Unknown Client: ' . $client{'name'};
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_cmdline {
|
|
eval $start if $b_log;
|
|
my @cmdline;
|
|
my $i = 0;
|
|
if (! -e "/proc/$ppid/cmdline"){
|
|
return 1;
|
|
}
|
|
local $\ = '';
|
|
open(my $fh, '<', "/proc/$ppid/cmdline") or
|
|
print_line("Open /proc/$ppid/cmdline failed: $!");
|
|
my @rows = <$fh>;
|
|
close $fh;
|
|
foreach (@rows){
|
|
push(@cmdline, $_);
|
|
$i++;
|
|
last if $i > 31;
|
|
}
|
|
if ($i == 0){
|
|
$cmdline[0] = $rows[0];
|
|
$i = ($cmdline[0]) ? 1 : 0;
|
|
}
|
|
main::log_data('string',"cmdline: @cmdline count: $i") if $b_log;
|
|
eval $end if $b_log;
|
|
return [@cmdline];
|
|
}
|
|
|
|
sub perl_python_client {
|
|
eval $start if $b_log;
|
|
return 1 if $client{'version'};
|
|
# 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]);
|
|
$client{'name'} = 'konversation';
|
|
$client{'name-print'} = $app[3];
|
|
$client{'console-irc'} = $app[4];
|
|
}
|
|
## NOTE: supybot only appears in ps aux using 'SHELL' command; the 'CALL' command
|
|
## gives the user system irc priority, and you don't see supybot listed, so use SHELL
|
|
elsif (!$b_display &&
|
|
(main::check_program('supybot') ||
|
|
main::check_program('gribble') || main::check_program('limnoria')) &&
|
|
(grep { $_ =~ /supybot/ } @ps_cmd)){
|
|
@app = main::program_values('supybot');
|
|
$client{'version'} = main::program_version('supybot',$app[0],$app[1],$app[2],$app[5],$app[6]);
|
|
if ($client{'version'}){
|
|
if (grep { $_ =~ /gribble/ } @ps_cmd){
|
|
$client{'name'} = 'gribble';
|
|
$client{'name-print'} = 'Gribble';
|
|
}
|
|
if (grep { $_ =~ /limnoria/ } @ps_cmd){
|
|
$client{'name'} = 'limnoria';
|
|
$client{'name-print'} = 'Limnoria';
|
|
}
|
|
else {
|
|
$client{'name'} = 'supybot';
|
|
$client{'name-print'} = 'Supybot';
|
|
}
|
|
}
|
|
else {
|
|
$client{'name'} = 'supybot';
|
|
$client{'name-print'} = 'Supybot';
|
|
}
|
|
$client{'console-irc'} = 1;
|
|
}
|
|
else {
|
|
$client{'name-print'} = "Unknown $client{'name'} client";
|
|
}
|
|
if ($b_log){
|
|
my $string = "namep: $client{'name-print'} name: $client{'name'} version: $client{'version'}";
|
|
main::log_data('data',$string);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# Try to infer the use of Konversation >= 1.2, which shows $PPID improperly
|
|
# no known method of finding Konvi >= 1.2 as parent process, so we look to see if it is running,
|
|
# and all other irc clients are not running. As of 2014-03-25 this isn't used in my cases
|
|
sub check_modern_konvi {
|
|
eval $start if $b_log;
|
|
return 0 if !$client{'qdbus'};
|
|
my ($b_modern_konvi,$konvi,$konvi_version,$pid) = (0,'','','');
|
|
# main::log_data('data',"name: $client{'name'} :: qdb: $client{'qdbus'} :: version: $client{'version'} :: konvi: $client{'konvi'} :: PPID: $ppid") if $b_log;
|
|
# sabayon uses /usr/share/apps/konversation as path
|
|
# Paths not checked for BSDs to see what they are.
|
|
if (-d '/usr/share/kde4/apps/konversation' || -d '/usr/share/apps/konversation'){
|
|
# much faster test, added 2022, newer konvis support
|
|
# can also query qdbus to see if it's running, but that's a subshell and grep
|
|
if ($ENV{'PYTHONPATH'} && $ENV{'PYTHONPATH'} =~ /konversation/i){
|
|
$konvi = 'konversation';
|
|
}
|
|
# was -session, then -qwindowtitle; cli start, nothing, just konversation$
|
|
elsif ($pid = main::awk(\@ps_aux,'konversation( -|$)',2,'\s+')){
|
|
main::log_data('data',"pid: $pid") if $b_log;
|
|
if (-e "/proc/$pid/exe"){
|
|
$konvi = readlink("/proc/$pid/exe");
|
|
$konvi =~ s/^.*\///; # basename
|
|
}
|
|
}
|
|
# print "$pid $konvi\n";
|
|
if ($konvi){
|
|
@app = main::program_values('konversation');
|
|
$konvi_version = main::program_version($konvi,$app[0],$app[1],$app[2],$app[5],$app[6]);
|
|
$client{'console-irc'} = $app[4];
|
|
$client{'konvi'} = 3;
|
|
$client{'name'} = 'konversation';
|
|
$client{'name-print'} = $app[3];
|
|
$client{'version'} = $konvi_version;
|
|
# note: we need to change this back to a single dot number, like 1.3, not 1.3.2
|
|
my @temp = split('\.', $konvi_version);
|
|
$konvi_version = $temp[0] . "." . $temp[1];
|
|
if ($konvi_version > 1.1){
|
|
$b_modern_konvi = 1;
|
|
}
|
|
}
|
|
}
|
|
main::log_data('data',"name: $client{'name'} name print: $client{'name-print'}
|
|
qdb: $client{'qdbus'} version: $konvi_version konvi: $konvi PID: $pid") if $b_log;
|
|
main::log_data('data',"b_is_qt4: $b_modern_konvi") if $b_log;
|
|
## for testing this module
|
|
# my $ppid = getppid();
|
|
# system('qdbus org.kde.konversation', '/irc', 'say', $client{'dserver'}, $client{'dtarget'},
|
|
# "getpid_dir: verNum: $konvi_version pid: $pid ppid: $ppid");
|
|
# print "verNum: $konvi_version pid: $pid ppid: $ppid\n";
|
|
eval $end if $b_log;
|
|
return $b_modern_konvi;
|
|
}
|
|
|
|
sub set_konvi_data {
|
|
eval $start if $b_log;
|
|
# https://userbase.kde.org/Konversation/Scripts/Scripting_guide
|
|
if ($client{'konvi'} == 3){
|
|
$client{'dserver'} = shift @ARGV;
|
|
$client{'dtarget'} = shift @ARGV;
|
|
$client{'dobject'} = 'default';
|
|
}
|
|
elsif ($client{'konvi'} == 1){
|
|
$client{'dport'} = shift @ARGV;
|
|
$client{'dserver'} = shift @ARGV;
|
|
$client{'dtarget'} = shift @ARGV;
|
|
$client{'dobject'} = 'Konversation';
|
|
}
|
|
# for some reason this logic hiccups on multiple spaces between args
|
|
@ARGV = grep { $_ ne '' } @ARGV;
|
|
eval $end if $b_log;
|
|
}
|
|
}
|
|
|
|
########################################################################
|
|
#### OUTPUT
|
|
########################################################################
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### CLEANERS, FILTERS, AND TOOLS
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub clean {
|
|
my ($item) = @_;
|
|
return $item if !$item;# handle cases where it was 0 or '' or undefined
|
|
# note: |nee trips engineering, but I don't know why nee was filtered
|
|
$item =~ s/chipset|company|components|computing|computer|corporation|communications|electronics?|electric(al)?|group|incorporation|industrial|international|limited|\bnee\b|<?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 clean_arm {
|
|
my ($item) = @_;
|
|
$item =~ s/(\([^\(]*Device Tree[^\)]*\))//gi;
|
|
$item =~ s/^\s+|\s+$//g;
|
|
$item =~ s/\s\s+/ /g;
|
|
return $item;
|
|
}
|
|
|
|
sub clean_characters {
|
|
my ($data) = @_;
|
|
# 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;
|
|
$data =~ s/[:\47]|\\[a-z]|\n|,|\"|\*|\||\+|\[\s\]|n\/a|\s\s+/ /g;
|
|
$data =~ s/\(\s*\)//;
|
|
$data =~ s/^\s+|\s+$//g;
|
|
return $data;
|
|
}
|
|
|
|
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;
|
|
return $item;
|
|
}
|
|
|
|
sub clean_dmi {
|
|
my ($string) = @_;
|
|
$string = clean_unset($string,'AssetTagNum|^Base Board .*|^Chassis .*|' .
|
|
'Manufacturer.*| Or Motherboard|\bOther\b.*|PartNum.*|SerNum|' .
|
|
'^System .*|^0x[0]+$');
|
|
$string =~ s/\bbios\b|\bacpi\b//gi;
|
|
$string =~ s/http:\/\/www.abit.com.tw\//Abit/i;
|
|
$string =~ s/^[\s'"]+|[\s'"]+$//g;
|
|
$string =~ s/\s\s+/ /g;
|
|
$string = remove_duplicates($string) if $string;
|
|
return $string;
|
|
}
|
|
|
|
sub clean_pci {
|
|
my ($string,$type) = @_;
|
|
# print "st1 $type:$string\n";
|
|
my $filter = 'and\ssubsidiaries|compatible\scontroller|licensed\sby|';
|
|
$filter .= '\b(device|controller|connection|multimedia)\b|\([^)]+\)';
|
|
# \[[^\]]+\]$| not trimming off ending [...] initial type filters removes end
|
|
$filter = '\[[^\]]+\]$|' . $filter if $type eq 'pci';
|
|
$string =~ s/($filter)//ig;
|
|
$string =~ s/^[\s'"]+|[\s'"]+$//g;
|
|
$string =~ s/\s\s+/ /g;
|
|
# print "st2 $type:$string\n";
|
|
$string = remove_duplicates($string) if $string;
|
|
return $string;
|
|
}
|
|
|
|
sub clean_pci_subsystem {
|
|
my ($string) = @_;
|
|
# we only need filters for features that might use vendor, -AGN
|
|
my $filter = 'and\ssubsidiaries|adapter|(hd\s)?audio|definition|desktop|ethernet|';
|
|
$filter .= 'gigabit|graphics|hdmi(\/[\S]+)?|high|integrated|licensed\sby|';
|
|
$filter .= 'motherboard|network|onboard|raid|pci\s?express';
|
|
$string =~ s/\b($filter)\b//ig;
|
|
$string =~ s/^[\s'"]+|[\s'"]+$//g;
|
|
$string =~ s/\s\s+/ /g;
|
|
return $string;
|
|
}
|
|
|
|
# Use sparingly, but when we need regex type stuff
|
|
# stripped out for reliable string compares, it's better.
|
|
# sometimes the pattern comes from unknown strings
|
|
# which can contain regex characters, get rid of those
|
|
sub clean_regex {
|
|
my ($string) = @_;
|
|
return if !$string;
|
|
$string =~ s/(\{|\}|\(|\)|\[|\]|\|)/ /g;
|
|
$string =~ s/^\s+|\s+$//g;
|
|
$string =~ s/\s\s+/ /g;
|
|
return $string;
|
|
}
|
|
|
|
# args: 0: string; 1: optional, if you want to add custom filter to defaults
|
|
sub clean_unset {
|
|
my ($string,$extra) = @_;
|
|
my $cleaner = '^(\.)+$|Bad Index|default string|\[?empty\]?|\bnone\b|N\/A|^not |';
|
|
$cleaner .= 'not set|OUT OF SPEC|To be filled|O\.?E\.?M|undefine|unknow|unspecif';
|
|
$cleaner .= '|' . $extra if $extra;
|
|
$string =~ s/.*($cleaner).*//i;
|
|
return $string;
|
|
}
|
|
|
|
sub filter {
|
|
my ($string) = @_;
|
|
if ($string){
|
|
if ($use{'filter'} && $string ne message('root-required')){
|
|
$string = $filter_string;
|
|
}
|
|
}
|
|
else {
|
|
$string = 'N/A';
|
|
}
|
|
return $string;
|
|
}
|
|
|
|
# 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);
|
|
$type ||= '';
|
|
$empty ||= '';
|
|
return $empty if !defined $size;
|
|
if (!is_numeric($size)){
|
|
$data[0] = $size;
|
|
$data[1] = '';
|
|
}
|
|
elsif ($size > 1024**5){
|
|
$data[0] = sprintf("%.2f",$size/1024**5);
|
|
$data[1] = 'EiB';
|
|
}
|
|
elsif ($size > 1024**4){
|
|
$data[0] = sprintf("%.2f",$size/1024**4);
|
|
$data[1] = 'PiB';
|
|
}
|
|
elsif ($size > 1024**3){
|
|
$data[0] = sprintf("%.2f",$size/1024**3);
|
|
$data[1] = 'TiB';
|
|
}
|
|
elsif ($size > 1024**2){
|
|
$data[0] = sprintf("%.2f",$size/1024**2);
|
|
$data[1] = 'GiB';
|
|
}
|
|
elsif ($size > 1024){
|
|
$data[0] = sprintf("%.1f",$size/1024);
|
|
$data[1] = 'MiB';
|
|
}
|
|
else {
|
|
$data[0] = sprintf("%.0f",$size);
|
|
$data[1] = 'KiB';
|
|
}
|
|
$data[0] += 0 if $data[1]; # trim trailing 0s
|
|
# note: perl throws strict error if you try to convert string to int
|
|
# $data[0] = int($data[0]) if $b_int && $data[0];
|
|
if ($type eq 'string'){
|
|
return ($data[1]) ? join(' ', @data) : $size;
|
|
}
|
|
else {
|
|
return @data;
|
|
}
|
|
}
|
|
|
|
# not used, but keeping logic for now
|
|
sub increment_starters {
|
|
my ($key,$indexes) = @_;
|
|
my $result = $key;
|
|
if (defined $indexes->{$key}){
|
|
$indexes->{$key}++;
|
|
$result = "$key-$indexes->{$key}";
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
sub make_line {
|
|
my $line = '';
|
|
foreach (0 .. $size{'max-cols-basic'} - 2){
|
|
$line .= '-';
|
|
}
|
|
return $line;
|
|
}
|
|
|
|
# args: 0: type; 1: info [optional]; 2: info [optional]
|
|
sub message {
|
|
my ($type,$id,$id2) = @_;
|
|
$id ||= '';
|
|
$id2 ||= '';
|
|
my %message = (
|
|
'arm-cpu-f' => 'Use -f option to see features',
|
|
'audio-server-on-pipewire-pulse' => 'off (using pipewire-pulse)',
|
|
'audio-server-process-on' => 'active (process)',
|
|
'audio-server-root-na' => 'n/a (root, process)',
|
|
'audio-server-root-on' => 'active (root, process)',
|
|
'battery-data' => 'No system battery data found. Is one present?',
|
|
'battery-data-bsd' => 'No battery data found. Try with --dmidecode',
|
|
'battery-data-sys' => 'No /sys data found.',
|
|
'bluetooth-data' => 'No bluetooth data found.',
|
|
'bluetooth-down' => "tool can't run",
|
|
'cpu-bugs-null' => 'No CPU vulnerability/bugs data available.',
|
|
'cpu-model-null' => 'Model N/A',
|
|
'cpu-speeds' => 'No per core speed data found.',
|
|
'cpu-speeds-bsd' => 'No OS support for core speeds.',
|
|
'darwin-feature' => 'Feature not supported iu Darwin/OSX.',
|
|
'dev' => 'Feature under development',
|
|
'device-data' => 'No device data found.',
|
|
'disk-data' => 'No disk data found.',
|
|
'disk-data-bsd' => 'No disk data found.',
|
|
'disk-size-0' => 'Total N/A',
|
|
'display-driver-na' => 'X driver n/a', # legacy, leave for now
|
|
'display-driver-na-try-root' => 'X driver n/a, try sudo/root',
|
|
'display-server' => 'No display server data found. Headless machine?',
|
|
'dmesg-boot-permissions' => 'dmesg.boot permissions',
|
|
'dmesg-boot-missing' => 'dmesg.boot not found',
|
|
'dmidecode-dev-mem' => 'dmidecode is not allowed to read /dev/mem',
|
|
'dmidecode-smbios' => 'No SMBIOS data for dmidecode to process',
|
|
'edid-revision' => "invalid EDID revision: $id",
|
|
'edid-sync' => "bad sync value: $id",
|
|
'edid-version' => "invalid EDID version: $id",
|
|
'egl-null' => 'No EGL data available.',
|
|
'egl-missing' => 'EGL data requires eglinfo. Check --recommends.',
|
|
'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-glxinfo-missing' => 'GL data unavailable in console, glxinfo missing.',
|
|
'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-null' => 'No GL data available.',
|
|
'glx-value-empty' => 'Unset. Missing GL driver?',
|
|
'glxinfo-missing' => 'Unable to show GL data. glxinfo is missing.',
|
|
'IP' => "No $id found. Connected to web? SSL issues?",
|
|
'IP-dig' => "No $id found. Connected to web? SSL issues? Try --no-dig",
|
|
'IP-no-dig' => "No $id found. Connected to web? SSL issues? Try enabling dig",
|
|
'logical-data' => 'No logical block device data found.',
|
|
'logical-data-bsd' => "Logical block device feature unsupported in $id.",
|
|
'machine-data' => 'No machine data: try newer kernel.',
|
|
'machine-data-bsd' => 'No machine data: Is dmidecode installed? Try -M --dmidecode.',
|
|
'machine-data-dmidecode' => 'No machine data: try newer kernel. Is dmidecode installed? Try -M --dmidecode.',
|
|
'machine-data-force-dmidecode' => 'No machine data: try newer kernel. Is dmidecode installed? Try -M --dmidecode.',
|
|
'machine-data-fruid' => 'No machine data: Is fruid_print installed?',
|
|
'monitor-console' => 'N/A in console',
|
|
'monitor-id' => 'not-matched',
|
|
'monitor-na' => 'N/A',
|
|
'monitor-wayland' => 'no compositor data',
|
|
'note-check' => 'check',
|
|
'note-est' => 'est.',
|
|
'note-not-reliable' => 'not reliable',
|
|
'nv-current' => "current (as of $id)",
|
|
'nv-current-eol' => "current (as of $id; EOL~$id2)",
|
|
'nv-legacy-active' => "legacy-active (EOL~$id)",
|
|
'nv-legacy-eol' => "legacy (EOL~$id)",
|
|
'optical-data' => 'No optical or floppy data found.',
|
|
'optical-data-bsd' => 'No optical or floppy data found.',
|
|
'output-control' => "-:: 'Enter' to continue to next block. Any key + 'Enter' to exit:",
|
|
'output-control-exit' => 'Exiting output. Have a nice day.',
|
|
'output-limit' => "Output throttled. IPs: $id; Limit: $limit; Override: --limit [1-x;-1 all]",
|
|
'package-data' => 'No packages detected. Unsupported package manager?',
|
|
'partition-data' => 'No partition data found.',
|
|
'partition-hidden' => 'N/A (hidden?)',
|
|
'pci-advanced-data' => 'bus/chip ids n/a',
|
|
'pci-card-data' => 'No PCI device data found.',
|
|
'pci-card-data-root' => 'PCI device data requires root.',
|
|
'pci-slot-data' => 'No PCI Slot data found.',
|
|
'pm-rpm-disabled' => 'see --rpm',
|
|
'ps-data-null' => 'No process data available.',
|
|
'raid-data' => 'No RAID data found.',
|
|
'ram-data' => 'No RAM data found.',
|
|
'ram-data-complete' => 'For complete report, try with --dmidecode',
|
|
'ram-data-dmidecode' => 'No RAM data found. Try with --dmidecode',
|
|
'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',# gdm only
|
|
'screen-wayland' => 'no compositor data',
|
|
'screen-xvesa' => 'no Xvesa data',
|
|
'sensor-data-bsd' => "$id sensor data found but not usable.",
|
|
'sensor-data-bsd-ok' => 'No sensor data found. Are data sources present?',
|
|
'sensor-data-bsd-unsupported' => 'Sensor data not available. Unsupported BSD variant.',
|
|
'sensor-data-ipmi' => 'No ipmi sensor data found.',
|
|
'sensor-data-ipmi-root' => 'Unable to run ipmi sensors. Root privileges required.',
|
|
'sensors-data-linux' => 'No sensor data found. Missing /sys/class/hwmon, lm-sensors.',
|
|
'sensor-data-lm-sensors' => 'No sensor data found. Is lm-sensors configured?',
|
|
'sensor-data-sys' => 'No sensor data found in /sys/class/hwmon.',
|
|
'sensor-data-sys-lm' => 'No sensor data found using /sys/class/hwmon or lm-sensors.',
|
|
'smartctl-command' => 'A mandatory SMART command failed. Various possible causes.',
|
|
'smartctl-open' => 'Unable to open device. Wrong device ID given?',
|
|
'smartctl-udma-crc' => 'Bad cable/connection?',
|
|
'smartctl-usb' => 'Unknown USB bridge. Flash drive/Unsupported enclosure?',
|
|
'stopped' => 'stopped',
|
|
'swap-admin' => 'No admin swap data available.',
|
|
'swap-data' => 'No swap data was found.',
|
|
'tool-missing-basic' => "<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?",
|
|
'tool-missing-recommends' => "Required tool $id not installed. Check --recommends",
|
|
'tool-missing-required' => "Required program $id not available",
|
|
'tool-permissions' => "Unable to run $id. Root privileges required.",
|
|
'tool-present' => 'Present and working',
|
|
'tool-unknown-error' => "Unknown $id error. Unable to generate data.",
|
|
'tools-missing' => "This feature requires one of these tools: $id",
|
|
'tools-missing-bsd' => "This feature requires one of these tools: $id",
|
|
'undefined' => '<undefined>',
|
|
'unmounted-data' => 'No unmounted partitions found.',
|
|
'unmounted-data-bsd' => "Unmounted partition feature unsupported in $id.",
|
|
'unmounted-file' => 'No /proc/partitions file found.',
|
|
'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-null' => 'No Vulkan data available.',
|
|
'weather-error' => "Error: $id",
|
|
'weather-null' => "No $id found. Internet connection working?",
|
|
'xvesa-null' => 'No Xvesa VBE/GOP data found.',
|
|
);
|
|
return $message{$type};
|
|
}
|
|
|
|
# args: 0: string of range types (2-5; 3 4; 3,4,2-12) to generate single regex
|
|
# string for
|
|
sub regex_range {
|
|
return if ! defined $_[0];
|
|
my @processed;
|
|
foreach my $item (split(/[,\s]+/,$_[0])){
|
|
if ($item =~ /(\d+)-(\d+)/){
|
|
$item = join('|',($1..$2));
|
|
}
|
|
push(@processed,$item);
|
|
}
|
|
return join('|',@processed);
|
|
}
|
|
|
|
# Handles duplicates occuring anywhere in string
|
|
sub remove_duplicates {
|
|
my ($string) = @_;
|
|
return if !$string;
|
|
my (%holder,@temp);
|
|
foreach (split(/\s+/, $string)){
|
|
if (!$holder{lc($_)}){
|
|
push(@temp, $_);
|
|
$holder{lc($_)} = 1;
|
|
}
|
|
}
|
|
$string = join(' ', @temp);
|
|
return $string;
|
|
}
|
|
|
|
# args: 0: string to turn to KiB integer value.
|
|
# Convert string passed to KB, based on GB/MB/TB id
|
|
# NOTE: 1 [K 1000; kB: 1000; KB 1024; KiB 1024] bytes
|
|
# The logic will turn false MB to M for this tool
|
|
# Hopefully one day sizes will all be in KiB type units
|
|
sub translate_size {
|
|
my ($working) = @_;
|
|
my ($size,$unit) = (0,'');
|
|
# print ":$working:\n";
|
|
return if !defined $working;
|
|
my $math = ($working =~ /B$/) ? 1000: 1024;
|
|
if ($working =~ /^([0-9\.]+)\s*([kKMGTPE])i?B?$/i){
|
|
$size = $1;
|
|
$unit = uc($2);
|
|
}
|
|
if ($unit eq 'K'){
|
|
$size = $1;
|
|
}
|
|
elsif ($unit eq 'M'){
|
|
$size = $1 * $math;
|
|
}
|
|
elsif ($unit eq 'G'){
|
|
$size = $1 * $math**2;
|
|
}
|
|
elsif ($unit eq 'T'){
|
|
$size = $1 * $math**3;
|
|
}
|
|
elsif ($unit eq 'P'){
|
|
$size = $1 * $math**4;
|
|
}
|
|
elsif ($unit eq 'E'){
|
|
$size = $1 * $math**5;
|
|
}
|
|
$size = int($size) if $size;
|
|
return $size;
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### GENERATE OUTPUT
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub check_output_path {
|
|
my ($path) = @_;
|
|
my ($b_good,$dir,$file);
|
|
$dir = $path;
|
|
$dir =~ s/([^\/]+)$//;
|
|
$file = $1;
|
|
# print "file: $file : dir: $dir\n";
|
|
$b_good = 1 if (-d $dir && -w $dir && $dir =~ /^\// && $file);
|
|
return $b_good;
|
|
}
|
|
|
|
# Passing along hash ref
|
|
sub output_handler {
|
|
my ($data) = @_;
|
|
# print Dumper \%data;
|
|
if ($output_type eq 'screen'){
|
|
print_data($data);
|
|
}
|
|
elsif ($output_type eq 'json'){
|
|
generate_json($data);
|
|
}
|
|
elsif ($output_type eq 'xml'){
|
|
generate_xml($data);
|
|
}
|
|
}
|
|
|
|
# Passing along hash ref
|
|
# NOTE: file has already been set and directory verified
|
|
sub generate_json {
|
|
eval $start if $b_log;
|
|
my ($data) = @_;
|
|
my ($json);
|
|
my $b_debug = 0;
|
|
my ($b_cpanel,$b_valid);
|
|
error_handler('not-in-irc', 'help') if $b_irc;
|
|
print Dumper $data if $b_debug;
|
|
load_json() if !$loaded{'json'};
|
|
print Data::Dumper::Dumper $use{'json'} if $b_debug;
|
|
if ($use{'json'}){
|
|
# ${$use{'json'}->{'new'}}->canonical(1);
|
|
# $json = ${$use{'json'}->{'new'}}->json_encode($data);
|
|
# ${$use{'json'}->{'new-json'}}->canonical(1);
|
|
# $json = ${$use{'json'}->{'new-json'}}->encode_json($data);
|
|
$json = &{$use{'json'}->{'encode'}}($data);
|
|
}
|
|
else {
|
|
error_handler('required-module', 'json', 'JSON::PP, Cpanel::JSON::XS or JSON::XS');
|
|
}
|
|
if ($json){
|
|
#$json =~ s/"[0-9]+#/"/g;
|
|
if ($output_file eq 'print'){
|
|
#$json =~ s/\}/}\n/g;
|
|
print "$json";
|
|
}
|
|
else {
|
|
print_line("Writing JSON data to: $output_file\n");
|
|
open(my $fh, '>', $output_file) or error_handler('open',$output_file,"$!");
|
|
print $fh "$json";
|
|
close $fh;
|
|
print_line("Data written successfully.\n");
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# NOTE: So far xml is substantially more difficult than json, so
|
|
# using a crude dumper rather than making a nice xml file, but at
|
|
# least xml has some output now.
|
|
sub generate_xml {
|
|
eval $start if $b_log;
|
|
my ($data) = @_;
|
|
my ($xml);
|
|
my $b_debug = 0;
|
|
error_handler('not-in-irc', 'help') if $b_irc;
|
|
# print Dumper $data if $b_debug;
|
|
if (check_perl_module('XML::Dumper')){
|
|
XML::Dumper->import;
|
|
$xml = XML::Dumper::pl2xml($data);
|
|
#$xml =~ s/"[0-9]+#/"/g;
|
|
if ($output_file eq 'print'){
|
|
print "$xml";
|
|
}
|
|
else {
|
|
print_line("Writing XML data to: $output_file\n");
|
|
open(my $fh, '>', $output_file) or error_handler('open',$output_file,"$!");
|
|
print $fh "$xml";
|
|
close $fh;
|
|
print_line("Data written successfully.\n");
|
|
}
|
|
}
|
|
else {
|
|
error_handler('required-module', 'xml', 'XML::Dumper');
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub key {
|
|
return sprintf("%03d#%s#%s#%s", $_[0],$_[1],$_[2],$_[3]);
|
|
}
|
|
|
|
sub output_control {
|
|
print message('output-control');
|
|
chomp(my $response = <STDIN>);
|
|
if (!$response){
|
|
$size{'lines'} = 1;
|
|
}
|
|
else {
|
|
print message('output-control-exit'), "\n";
|
|
exit 0;
|
|
}
|
|
}
|
|
|
|
sub print_basic {
|
|
my ($data) = @_;
|
|
my $indent = 18;
|
|
my $indent_static = 18;
|
|
my $indent1_static = 5;
|
|
my $indent2_static = 8;
|
|
my $indent1 = 5;
|
|
my $indent2 = 8;
|
|
my $length = @$data;
|
|
my ($start,$i,$j,$line);
|
|
my $width = $size{'max-cols-basic'};
|
|
if ($width > 110){
|
|
$indent_static = 22;
|
|
}
|
|
elsif ($width < 90){
|
|
$indent_static = 15;
|
|
}
|
|
# print $length . "\n";
|
|
for my $i (0 .. $#$data){
|
|
# print "0: $data->[$i][0]\n";
|
|
if ($data->[$i][0] == 0){
|
|
$indent = 0;
|
|
$indent1 = 0;
|
|
$indent2 = 0;
|
|
}
|
|
elsif ($data->[$i][0] == 1){
|
|
$indent = $indent_static;
|
|
$indent1 = $indent1_static;
|
|
$indent2= $indent2_static;
|
|
}
|
|
elsif ($data->[$i][0] == 2){
|
|
$indent = ($indent_static + 7);
|
|
$indent1 = ($indent_static + 5);
|
|
$indent2 = 0;
|
|
}
|
|
$data->[$i][3] =~ s/\n/ /g;
|
|
$data->[$i][3] =~ s/\s+/ /g;
|
|
if ($data->[$i][1] && $data->[$i][2]){
|
|
$data->[$i][1] = $data->[$i][1] . ', ';
|
|
}
|
|
$start = sprintf("%${indent1}s%-${indent2}s",$data->[$i][1],$data->[$i][2]);
|
|
if ($indent > 1 && (length($start) > ($indent - 1))){
|
|
$line = sprintf("%-${indent}s\n", "$start");
|
|
print_line($line);
|
|
$start = '';
|
|
# print "1-print.\n";
|
|
}
|
|
if (($indent + length($data->[$i][3])) < $width){
|
|
$data->[$i][3] =~ s/\^/ /g;
|
|
$line = sprintf("%-${indent}s%s\n", "$start", $data->[$i][3]);
|
|
print_line($line);
|
|
# print "2-print.\n";
|
|
}
|
|
else {
|
|
my $holder = '';
|
|
my $sep = ' ';
|
|
# note: special case, split ' ' trims leading, trailing spaces,
|
|
# then splits like awk, on one or more white spaces.
|
|
foreach my $word (split(' ', $data->[$i][3])){
|
|
# print "$word\n";
|
|
if (($indent + length($holder) + length($word)) < $width){
|
|
$word =~ s/\^/ /g;
|
|
$holder .= $word . $sep;
|
|
# print "3-hold.\n";
|
|
}
|
|
# elsif (($indent + length($holder) + length($word)) >= $width){
|
|
else {
|
|
$line = sprintf("%-${indent}s%s\n", "$start", $holder);
|
|
print_line($line);
|
|
$start = '';
|
|
$word =~ s/\^/ /g;
|
|
$holder = $word . $sep;
|
|
# print "4-print-hold.\n";
|
|
}
|
|
}
|
|
if ($holder !~ /^[ ]*$/){
|
|
$line = sprintf("%-${indent}s%s\n", "$start", $holder);
|
|
print_line($line);
|
|
# print "5-print-last.\n";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# This has to get a hash of hashes, at least for now. Because perl does not
|
|
# retain insertion order, I use a prefix for each hash key to force sorts.
|
|
sub print_data {
|
|
my ($data) = @_;
|
|
my ($counter,$length,$split_count) = (0,0,0);
|
|
my ($hash_id,$holder,$holder2,$start,$start2,$start_holder) = ('','','','','','');
|
|
my $indent = $size{'indent'};
|
|
my (%ids);
|
|
my ($b_container,$b_ni2,$key,$line,$val2,$val3);
|
|
# these 2 sets are single logic items
|
|
my $b_single = ($size{'max-cols'} == 1) ? 1: 0;
|
|
my ($b_row1,$indent_2,$indent_use,$indentx) = (1,0,0,0);
|
|
# $size{'max-cols'} = 88;
|
|
# NOTE: indent < 11 would break the output badly in some cases
|
|
if ($size{'max-cols'} < $size{'max-wrap'} || $size{'indent'} < 11){
|
|
$indent = $size{'indents'};
|
|
}
|
|
foreach my $key1 (sort { substr($a,0,3) <=> substr($b,0,3) } keys %$data){
|
|
$key = (split('#', $key1))[3];
|
|
$b_row1 = 1;
|
|
if ($key ne 'SHORT'){
|
|
$start = sprintf("$colors{'c1'}%-${indent}s$colors{'cn'}","$key$sep{'s1'}");
|
|
if ($use{'output-block'}){
|
|
output_control() if $use{'output-block'} > 1;
|
|
$use{'output-block'}++;
|
|
}
|
|
$start_holder = $key;
|
|
$indent_2 = $indent + $size{'indents'};
|
|
$b_ni2 = ($start_holder eq 'Info') ? 1 : 0;
|
|
if ($indent < 10){
|
|
$line = "$start\n";
|
|
print_line($line);
|
|
$start = '';
|
|
$line = '';
|
|
}
|
|
}
|
|
else {
|
|
$indent = 0;
|
|
}
|
|
next if ref($data->{$key1}) ne 'ARRAY';
|
|
# Line starters that will be -x incremented always
|
|
# It's a tiny bit faster manually resetting rather than using for loop
|
|
%ids = (
|
|
'Array' => 1, # RAM or RAID
|
|
'Battery' => 1,
|
|
'Card' => 1,
|
|
'Device' => 1,
|
|
'Floppy' => 1,
|
|
'Hardware' => 1, # hardware raid report
|
|
'Hub' => 1,
|
|
'ID' => 1,
|
|
'IF-ID' => 1,
|
|
'LV' => 1,
|
|
'Monitor' => 1,
|
|
'Optical' => 1,
|
|
'Screen' => 1,
|
|
'Server' => 1, # was 'Sound Server'
|
|
'variant' => 1, # arm > 1 cpu type
|
|
);
|
|
foreach my $val1 (@{$data->{$key1}}){
|
|
if (ref($val1) eq 'HASH'){
|
|
if (!$b_single){
|
|
$indent_use = $length = ($b_row1 && $key !~ /^(Features)$/) ? $indent : $indent_2;
|
|
}
|
|
($counter,$b_row1,$split_count) = (0,1,0);
|
|
foreach my $key2 (sort {substr($a,0,3) <=> substr($b,0,3)} keys %$val1){
|
|
($hash_id,$b_container,$indentx,$key) = (split('#', $key2));
|
|
if (!$b_single){
|
|
$indent_use = ($b_row1 || $b_ni2) ? $indent: $indent_2;
|
|
}
|
|
# print "m-1: r1: $b_row1 iu: $indent_use\n";
|
|
if ($start_holder eq 'Graphics' && $key eq 'Screen'){
|
|
$ids{'Monitor'} = 1;
|
|
}
|
|
elsif ($start_holder eq 'Memory' && $key eq 'Array'){
|
|
$ids{'Device'} = 1;
|
|
}
|
|
elsif ($start_holder eq 'RAID' && $key eq 'Device'){
|
|
$ids{'Array'} = 1;
|
|
}
|
|
elsif ($start_holder eq 'USB' && $key eq 'Hub'){
|
|
$ids{'Device'} = 1;
|
|
}
|
|
elsif ($start_holder eq 'Logical' && $key eq 'Device'){
|
|
$ids{'LV'} = 1;
|
|
}
|
|
if ($counter == 0 && defined $ids{$key}){
|
|
$key .= '-' . $ids{$key}++;
|
|
}
|
|
$val2 = $val1->{$key2};
|
|
# we have to handle cases where $val2 is 0
|
|
if (!$b_single && $val2 || $val2 eq '0'){
|
|
$val2 .= " ";
|
|
}
|
|
# See: Use of implicit split to @_ is deprecated. Only get this
|
|
# warning in Perl 5.08 oddly enough. ie, no: scalar (split(...));
|
|
my @values = split(/\s+/, $val2);
|
|
$split_count = scalar @values;
|
|
# print "sc: $split_count l: " . (length("$key$sep{'s2'} $val2") + $indent_use), " val2: $val2\n";
|
|
if (!$b_single &&
|
|
(length("$key$sep{'s2'} $val2") + $length) <= $size{'max-cols'}){
|
|
# print "h-1: r1: $b_row1 iu: $indent_use\n";
|
|
$length += length("$key$sep{'s2'} $val2");
|
|
$holder .= "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val2";
|
|
}
|
|
# Handle case where the key/value pair is > max, and where there are
|
|
# a lot of terms, like cpu flags, raid types supported. Raid can have
|
|
# the last row have a lot of devices, or many raid types. But we don't
|
|
# want to wrap things like: 3.45 MiB (6.3%)
|
|
elsif (!$b_single && $split_count > 2 && length($val2) > 24 &&
|
|
!defined $ids{$key} &&
|
|
(length("$key$sep{'s2'} $val2") + $indent_use + $length) > $size{'max-cols'}){
|
|
# print "m-2 r1: $b_row1 iu: $indent_use\n";
|
|
$val3 = shift @values;
|
|
$start2 = "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val3 ";
|
|
# Case where not first item in line, but when key+first word added,
|
|
# is wider than max width.
|
|
if ($holder &&
|
|
($length + length("$key$sep{'s2'} $val3")) > $size{'max-cols'}){
|
|
# print "p-1a r1: $b_row1 iu: $indent_use\n";
|
|
$holder =~ s/\s+$//;
|
|
$line = sprintf("%-${indent_use}s%s$colors{'cn'}\n","$start","$holder");
|
|
print_line($line);
|
|
$b_row1 = 0;
|
|
$start = '';
|
|
$holder = '';
|
|
$length = $indent_use;
|
|
}
|
|
$length += length("$key$sep{'s2'} $val3 ");
|
|
# print scalar @values,"\n";
|
|
foreach (@values){
|
|
# my $l = (length("$_ ") + $length);
|
|
# print "$l\n";
|
|
$indent_use = ($b_row1 || $b_ni2) ? $indent : $indent_2;
|
|
if ((length("$_ ") + $length) < $size{'max-cols'}){
|
|
# print "h-2: r1: $b_row1 iu: $indent_use\n";
|
|
# print "a\n";
|
|
if ($start2){
|
|
$holder2 .= "$start2$_ ";
|
|
$start2 = '';
|
|
}
|
|
else {
|
|
$holder2 .= "$_ ";
|
|
}
|
|
$length += length("$_ ");
|
|
}
|
|
else {
|
|
# print "p-1b: r1: $b_row1 iu: $indent_use\n";
|
|
if ($start2){
|
|
$holder2 = "$start2$holder2";
|
|
}
|
|
else {
|
|
$holder2 = "$colors{'c2'}$holder2";
|
|
}
|
|
# print "xx:$holder";
|
|
$holder2 =~ s/\s+$//;
|
|
$line = sprintf("%-${indent_use}s%s$colors{'cn'}\n","$start","$holder$holder2");
|
|
print_line($line);
|
|
# make sure wrapped value is indented correctly!
|
|
$b_row1 = 0;
|
|
$indent_use = ($b_row1) ? $indent : $indent_2;
|
|
$holder = '';
|
|
$holder2 = "$_ ";
|
|
# print "h2: $holder2\n";
|
|
$length = length($holder2) + $indent_use;
|
|
$start2 = '';
|
|
$start = '';
|
|
}
|
|
}
|
|
# We don't want to start a new line, continue until full length.
|
|
if ($holder2 !~ /^\s*$/){
|
|
# print "p-2: r1: $b_row1 iu: $indent_use\n";
|
|
$holder2 = "$colors{'c2'}$holder2";
|
|
$holder = $holder2;
|
|
$b_row1 = 0;
|
|
$holder2 = '';
|
|
$start2 = '';
|
|
$start = '';
|
|
}
|
|
}
|
|
# NOTE: only these and the last fallback are used for b_single output
|
|
else {
|
|
if ($holder){
|
|
# print "p-3: r1: $b_row1 iu: $indent_use\n";
|
|
$holder =~ s/\s+$//;
|
|
$line = sprintf("%-${indent_use}s%s$colors{'cn'}\n",$start,"$holder");
|
|
$length = length("$key$sep{'s2'} $val2") + $indent_use;
|
|
print_line($line);
|
|
$b_row1 = 0;
|
|
$start = '';
|
|
}
|
|
else {
|
|
# print "h-3a: r1: $b_row1 iu: $indent_use\n";
|
|
$length = $indent_use;
|
|
}
|
|
if ($b_single){
|
|
$indent_use = ($indent * $indentx);
|
|
}
|
|
else {
|
|
$indent_use = ($b_row1 || $b_ni2) ? $indent: $indent_2;
|
|
}
|
|
$holder = "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val2";
|
|
# print "h-3b: r1: $b_row1 iu: $indent_use\n";
|
|
}
|
|
$counter++;
|
|
}
|
|
if ($holder !~ /^\s*$/){
|
|
# print "p-4: r1: $b_row1 iu: $indent_use\n";
|
|
$holder =~ s/\s+$//;
|
|
$line = sprintf("%-${indent_use}s%s$colors{'cn'}\n",$start,"$start2$holder");
|
|
print_line($line);
|
|
$b_row1 = 0;
|
|
$holder = '';
|
|
$length = 0;
|
|
$start = '';
|
|
}
|
|
}
|
|
# Only for repos currently
|
|
elsif (ref($val1) eq 'ARRAY'){
|
|
# print "p-5: r1: $b_row1 iu: $indent_use\n";
|
|
my $num = 0;
|
|
my ($l1,$l2);
|
|
$indent_use = $indent_2;
|
|
foreach my $item (@$val1){
|
|
$num++;
|
|
if ($size{'max-lines'}){
|
|
$l1 = length("$num$sep{'s2'} $item") + $indent_use;
|
|
# Cut down the line string until it's short enough to fit in term
|
|
if ($l1 > $size{'term-cols'}){
|
|
$l2 = length("$num$sep{'s2'} ") + $indent_use + 6;
|
|
# print "$l1 $size{'term-cols'} $l2 $num $indent_use\n";
|
|
$item = substr($item,0,$size{'term-cols'} - $l2) . '[...]';
|
|
}
|
|
}
|
|
$line = "$colors{'c1'}$num$sep{'s2'} $colors{'c2'}$item$colors{'cn'}";
|
|
$line = sprintf("%-${indent_use}s%s\n","","$line");
|
|
print_line($line);
|
|
}
|
|
|
|
}
|
|
}
|
|
# We want a space between data blocks for single
|
|
print_line("\n") if $b_single;
|
|
}
|
|
}
|
|
|
|
sub print_line {
|
|
my ($line) = @_;
|
|
if ($b_irc && $client{'test-konvi'}){
|
|
$client{'konvi'} = 3;
|
|
$client{'dobject'} = 'Konversation';
|
|
}
|
|
if ($client{'konvi'} == 1 && $client{'dcop'}){
|
|
# konvi doesn't seem to like \n characters, it just prints them literally
|
|
$line =~ s/\n//g;
|
|
#qx('dcop "$client{'dport'}" "$client{'dobject'}" say "$client{'dserver'}" "$client{'dtarget'}" "$line 1");
|
|
system('dcop', $client{'dport'}, $client{'dobject'}, 'say', $client{'dserver'}, $client{'dtarget'}, "$line 1");
|
|
}
|
|
elsif ($client{'konvi'} == 3 && $client{'qdbus'}){
|
|
# print $line;
|
|
$line =~ s/\n//g;
|
|
#qx(qdbus org.kde.konversation /irc say "$client{'dserver'}" "$client{'dtarget'}" "$line");
|
|
system('qdbus', 'org.kde.konversation', '/irc', 'say', $client{'dserver'}, $client{'dtarget'}, $line);
|
|
}
|
|
else {
|
|
# print "tl: $size{'term-lines'} ml: $size{'max-lines'} l:$size{'lines'}\n";
|
|
if ($size{'max-lines'}){
|
|
# -y1 + -Y can result in start of output scrolling off screen if terminal
|
|
# wrapped lines happen.
|
|
if ((($size{'max-lines'} >= $size{'term-lines'}) &&
|
|
$size{'max-lines'} == $size{'lines'}) ||
|
|
($size{'max-lines'} < $size{'term-lines'} &&
|
|
$size{'max-lines'} + 1 == $size{'lines'})){
|
|
output_control();
|
|
}
|
|
}
|
|
print $line;
|
|
$size{'lines'}++ if $size{'max-lines'};
|
|
}
|
|
}
|
|
|
|
########################################################################
|
|
#### ITEM PROCESSORS
|
|
########################################################################
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### ITEM GENERATORS
|
|
#### -------------------------------------------------------------------
|
|
|
|
## AudioItem
|
|
{
|
|
package AudioItem;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my $rows = [];
|
|
my $num = 0;
|
|
if (%risc && !$use{'soc-audio'} && !$use{'pci-tool'}){
|
|
my $key = 'Message';
|
|
@$rows = ({
|
|
main::key($num++,0,1,$key) => main::message('risc-pci',$risc{'id'})
|
|
});
|
|
}
|
|
else {
|
|
device_output($rows);
|
|
}
|
|
if (((%risc && !$use{'soc-audio'} && !$use{'pci-tool'}) || !@$rows) &&
|
|
(my $file = $system_files{'asound-cards'})){
|
|
asound_output($rows,$file);
|
|
}
|
|
usb_output($rows);
|
|
# note: for servers often no audio, so we don't care about pci specific
|
|
if (!@$rows){
|
|
my $key = 'Message';
|
|
my $type = 'device-data';
|
|
if ($pci_tool && $alerts{$pci_tool}->{'action'} eq 'permissions'){
|
|
$type = 'pci-card-data-root';
|
|
}
|
|
@$rows = ({main::key($num++,0,1,$key) => main::message($type,'')});
|
|
}
|
|
sound_output($rows);
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub device_output {
|
|
eval $start if $b_log;
|
|
return if !$devices{'audio'};
|
|
my $rows = $_[0];
|
|
my ($j,$num) = (0,1);
|
|
foreach my $row (@{$devices{'audio'}}){
|
|
$num = 1;
|
|
$j = scalar @$rows;
|
|
my $driver = $row->[9];
|
|
$driver ||= 'N/A';
|
|
my $device = $row->[4];
|
|
$device = ($device) ? main::clean_pci($device,'output') : 'N/A';
|
|
# have seen absurdly verbose card descriptions, with non related data etc
|
|
if (length($device) > 85 || $size{'max-cols'} < 110){
|
|
$device = main::filter_pci_long($device);
|
|
}
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $device,
|
|
});
|
|
if ($extra > 0 && $use{'pci-tool'} && $row->[12]){
|
|
my $item = main::get_pci_vendor($row->[4],$row->[12]);
|
|
$rows->[$j]{main::key($num++,0,2,'vendor')} = $item if $item;
|
|
}
|
|
$rows->[$j]{main::key($num++,1,2,'driver')} = $driver;
|
|
if ($extra > 0 && !$bsd_type){
|
|
if ($row->[9]){
|
|
my $version = main::get_module_version($row->[9]);
|
|
$rows->[$j]{main::key($num++,0,3,'v')} = $version if $version;
|
|
}
|
|
}
|
|
if ($b_admin && $row->[10]){
|
|
$row->[10] = main::get_driver_modules($row->[9],$row->[10]);
|
|
$rows->[$j]{main::key($num++,0,3,'alternate')} = $row->[10] if $row->[10];
|
|
}
|
|
if ($extra > 0){
|
|
my $bus_id = (!$row->[2] && !$row->[3]) ? 'N/A' : "$row->[2].$row->[3]";
|
|
if ($extra > 1 && $bus_id ne 'N/A'){
|
|
main::get_pcie_data($bus_id,$j,$rows,\$num);
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'bus-ID')} = $bus_id;
|
|
}
|
|
if ($extra > 1){
|
|
my $chip_id = main::get_chip_id($row->[5],$row->[6]);
|
|
$rows->[$j]{main::key($num++,0,2,'chip-ID')} = $chip_id;
|
|
if ($extra > 2 && $row->[1]){
|
|
$rows->[$j]{main::key($num++,0,2,'class-ID')} = $row->[1];
|
|
}
|
|
}
|
|
# print "$row->[0]\n";
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# this handles fringe cases where there is no card on pcibus,
|
|
# but there is a card present. I don't know the exact architecture
|
|
# involved but I know this situation exists on at least one old machine.
|
|
sub asound_output {
|
|
eval $start if $b_log;
|
|
my ($file,$rows) = @_;
|
|
my ($device,$driver,$j,$num) = ('','',0,1);
|
|
my @asound = main::reader($file);
|
|
foreach (@asound){
|
|
# filtering out modems and usb devices like webcams, this might get a
|
|
# usb audio card as well, this will take some trial and error
|
|
if (!/modem|usb/i && /^\s*[0-9]/){
|
|
$num = 1;
|
|
my @working = split(/:\s*/, $_);
|
|
# now let's get 1 2
|
|
$working[1] =~ /(.*)\s+-\s+(.*)/;
|
|
$device = $2;
|
|
$driver = $1;
|
|
if ($device){
|
|
$j = scalar @$rows;
|
|
$driver ||= 'N/A';
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $device,
|
|
main::key($num++,1,2,'driver') => $driver,
|
|
});
|
|
if ($extra > 0){
|
|
my $version = main::get_module_version($driver);
|
|
$rows->[$j]{main::key($num++,0,3,'v')} = $version if $version;
|
|
$rows->[$j]{main::key($num++,0,2,'message')} = main::message('pci-advanced-data','');
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# print Data::Dumper:Dumper $rows;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub usb_output {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my (@ids,$path_id,$product,@temp2);
|
|
my ($j,$num) = (0,1);
|
|
return if !$usb{'audio'};
|
|
foreach my $row (@{$usb{'audio'}}){
|
|
$num = 1;
|
|
$j = scalar @$rows;
|
|
# make sure to reset, or second device trips last flag
|
|
($path_id,$product) = ('','');
|
|
$product = main::clean($row->[13]) if $row->[13];
|
|
$product ||= 'N/A';
|
|
$row->[15] ||= 'N/A';
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $product,
|
|
main::key($num++,0,2,'driver') => $row->[15],
|
|
main::key($num++,1,2,'type') => 'USB',
|
|
});
|
|
if ($extra > 0){
|
|
# print "$j \n";
|
|
if ($extra > 1){
|
|
$row->[8] ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'rev')} = $row->[8];
|
|
if ($row->[17]){
|
|
$rows->[$j]{main::key($num++,0,3,'speed')} = $row->[17];
|
|
}
|
|
if ($row->[24]){
|
|
$rows->[$j]{main::key($num++,0,3,'lanes')} = $row->[24];
|
|
}
|
|
if ($b_admin && $row->[22]){
|
|
$rows->[$j]{main::key($num++,0,3,'mode')} = $row->[22];
|
|
}
|
|
}
|
|
$path_id = $row->[2] if $row->[2];
|
|
$rows->[$j]{main::key($num++,0,2,'bus-ID')} = "$path_id:$row->[1]";
|
|
if ($extra > 1){
|
|
$row->[7] ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'chip-ID')} = $row->[7];
|
|
}
|
|
if ($extra > 2){
|
|
if (defined $row->[5] && $row->[5] ne ''){
|
|
$rows->[$j]{main::key($num++,0,2,'class-ID')} = "$row->[4]$row->[5]";
|
|
}
|
|
if ($row->[16]){
|
|
$rows->[$j]{main::key($num++,0,2,'serial')} = main::filter($row->[16]);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub sound_output {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my ($key,$program,$value);
|
|
my ($j,$num) = (0,0);
|
|
foreach my $server (@{sound_data()}){
|
|
next if $extra < 1 && (!$server->[3] || $server->[3] !~ /^(active|.*api)/);
|
|
$j = scalar @$rows;
|
|
$server->[2] ||= 'N/A';
|
|
$server->[3] ||= 'N/A';
|
|
push(@$rows, {
|
|
main::key($num++,1,1,$server->[0]) => $server->[1],
|
|
main::key($num++,0,2,'v') => $server->[2],
|
|
main::key($num++,0,2,'status') => $server->[3],
|
|
});
|
|
if ($extra > 1 && defined $server->[4] && ref $server->[4] eq 'ARRAY'){
|
|
my $b_multi = (scalar @{$server->[4]} > 1) ? 1: 0;
|
|
my $b_start;
|
|
my $k = 0;
|
|
foreach my $item (@{$server->[4]}){
|
|
if ($item->[2] eq 'daemon'){
|
|
$key = 'status';
|
|
$value = $item->[3];
|
|
}
|
|
else {
|
|
$key = 'type';
|
|
$value = $item->[2];
|
|
}
|
|
if (!$b_multi){
|
|
$rows->[$j]{main::key($num++,1,2,$item->[0])} = $item->[1];
|
|
$rows->[$j]{main::key($num++,0,3,$key)} = $value;
|
|
}
|
|
else {
|
|
$rows->[$j]{main::key($num++,1,2,$item->[0])} = '' if !$b_start;
|
|
$b_start = 1;
|
|
$k++;
|
|
$rows->[$j]{main::key($num++,1,3,$k)} = $item->[1];
|
|
$rows->[$j]{main::key($num++,0,4,$key)} = $value;
|
|
}
|
|
}
|
|
}
|
|
if ($b_admin){
|
|
# Let long lines wrap for high tool counts, but best avoid too many tools
|
|
my $join = (defined $server->[5] && length(join(',',@{$server->[5]})) > 40) ? ', ': ',';
|
|
my $val = (defined $server->[5]) ? join($join,@{$server->[5]}) : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'tools')} = $val;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# see docs/inxi-audio.txt for unused or alternate helpers/tools
|
|
sub sound_data {
|
|
eval $start if $b_log;
|
|
my ($config,$helpers,$name,$program,$status,$test,$tools,$type,$version);
|
|
my $data = [];
|
|
## API Types ##
|
|
# not yet, user lib: || main::globber('/usr/lib*{,/*}/libasound.so*')
|
|
# the config test is expensive but will only trigger on servers with no audio
|
|
# devices. Checks if kernel was compiled with SND_ items, even if no devices.
|
|
if (!$bsd_type && -r "/boot/config-$uname[2]"){
|
|
$config = "/boot/config-$uname[2]";
|
|
}
|
|
if ($system_files{'asound-version'} ||
|
|
($config && (grep {/^CONFIG_SND_/} @{main::reader($config,'','ref')}))){
|
|
$name = 'ALSA';
|
|
$type = 'API';
|
|
# always true until find better test for inactive API test
|
|
if ($system_files{'asound-version'}){
|
|
# avoid possible second line if compiled by user
|
|
my $content = main::reader($system_files{'asound-version'},'',0);
|
|
# we want the string after driver version for old and new ALSA
|
|
# some alsa strings have the build date in (...) after Version
|
|
if ($content =~ /Driver Version (\S+)(\s|\.?$)/){
|
|
$version = $1;
|
|
$version =~ s/\.$//; # trim off period
|
|
}
|
|
$status = 'kernel-api';
|
|
}
|
|
else {
|
|
$status = 'inactive';
|
|
$version = $uname[2];
|
|
$version =~ s/^k//; # avoid double kk possible result
|
|
$version = 'k' . $version;
|
|
}
|
|
if ($extra > 1){
|
|
$test = [['osspd','daemon'],['aoss','oss-emulator'],
|
|
['apulse','pulse-emulator'],];
|
|
$helpers = sound_helpers($test);
|
|
}
|
|
if ($b_admin){
|
|
$test = [qw(alsactl alsamixer alsamixergui amixer)];
|
|
$tools = sound_tools($test);
|
|
}
|
|
push(@$data,[$type,$name,$version,$status,$helpers,$tools]);
|
|
($status,$version,$helpers,$tools) = ('','',undef,undef);
|
|
}
|
|
# sndstat file may be removed in linux oss, but ossinfo part of oss4-base
|
|
# alsa oss compat driver will create /dev/sndstat in linux however
|
|
# Note: kernel compile: SOUND_OSS
|
|
if ((-e '/dev/sndstat' && !$system_files{'asound-version'}) ||
|
|
main::check_program('ossinfo')){
|
|
$name = 'OSS';
|
|
# not a great test, but ok for now, check on current Linux, seems unlikely
|
|
# to find OSS on OpenBSD in general.
|
|
if ($bsd_type){
|
|
$status = (-e '/dev/sndstat') ? 'kernel-api' : 'inactive';
|
|
}
|
|
else {
|
|
$status = (-e '/dev/sndstat') ? 'active' : 'off?';
|
|
}
|
|
$type = 'API'; # not strictly an API on linux, but almost nobody uses it.
|
|
# not certain to be cross distro, Debian/Ubuntu at least.
|
|
if (-e '/etc/oss4/version.dat'){
|
|
$version = main::reader('/etc/oss4/version.dat','',0);
|
|
}
|
|
elsif ($sysctl{'audio'}){
|
|
$version = (grep {/^hw.snd.version:/} @{$sysctl{'audio'}})[0];
|
|
$version = (split(/:\s*/,$version),1)[1] if $version;
|
|
$version =~ s|/.*$|| if $version;
|
|
}
|
|
if ($extra > 1){
|
|
# virtual_oss freebsd, not verified; osspd-alsa/pulseaudio no path exec
|
|
$test = [['virtual_oss','daemon'],['virtual_equalizer','plugin']];
|
|
$helpers = sound_helpers($test);
|
|
}
|
|
if ($b_admin){
|
|
# *mixer are FreeBSD tools
|
|
$test = [qw(dsbmixer mixer ossctl ossinfo ossmix ossxmix vmixctl)];
|
|
$tools = sound_tools($test);
|
|
}
|
|
push(@$data,[$type,$name,$version,$status,$helpers,$tools]);
|
|
($status,$version,$helpers,$tools) = ('','',undef,undef);
|
|
}
|
|
if ($program = main::check_program('sndiod')){
|
|
if ($bsd_type){
|
|
push(@$data, ['API','sndio',undef,'sound-api',undef,undef]);
|
|
}
|
|
$name = 'sndiod';
|
|
# verified: accurate
|
|
$status = (grep {/sndiod/} @ps_cmd) ? 'active': 'off';
|
|
$type = 'Server';
|
|
# $version: no known method
|
|
if ($b_admin){
|
|
$test = [qw(aucat midicat mixerctl sndioctl)];
|
|
$tools = sound_tools($test);
|
|
}
|
|
push(@$data,[$type,$name,$version,$status,$helpers,$tools]);
|
|
($status,$version,$helpers,$tools) = ('','',undef,undef);
|
|
}
|
|
## Servers ##
|
|
if ($program = main::check_program('artsd')){
|
|
$name = 'aRts';
|
|
$status = (grep {/artsd/} @ps_cmd) ? 'active': 'off';
|
|
$type = 'Server';
|
|
$version = main::program_version($program,'^artsd',2,'-v',1);
|
|
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 = 'EsounD';
|
|
$status = (grep {/\besd\b/} @ps_cmd) ? 'active': 'off';
|
|
$type = 'Server';
|
|
$version = main::program_version($program,'^Esound',3,'--version',1,1);
|
|
# 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 = 'JACK';
|
|
$status = jack_status();
|
|
$type = 'Server';
|
|
$version = main::program_version($program,'^jackd',3,'--version',1);
|
|
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 = 'NAS';
|
|
$status = (grep {/(^|\/)nasd/} @ps_cmd) ? 'active': 'off';
|
|
$type = 'Server';
|
|
$version = main::program_version($program,'^Network Audio',5,'-V',1);
|
|
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 = 'PipeWire';
|
|
$status = pipewire_status();
|
|
$type = 'Server';
|
|
$version = main::program_version($program,'^Compiled with libpipe',4,'--version',1);
|
|
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 = 'PulseAudio';
|
|
$status = pulse_status($program);
|
|
$type = 'Server';
|
|
$version = main::program_version($program,'^pulseaudio',2,'--version',1);
|
|
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 = 'RoarAudio';
|
|
$status = (grep {/roard/} @ps_cmd) ? 'active': 'off';
|
|
$type = 'Server';
|
|
# no version so far
|
|
if ($extra > 1){
|
|
$test = [['roarplaylistd','daemon'],['roarify','pulse/viff-emulation']];
|
|
$helpers = sound_helpers($test);
|
|
}
|
|
if ($b_admin){
|
|
$test = [qw(roarcat roarctl)];
|
|
$tools = sound_tools($test);
|
|
}
|
|
push(@$data,[$type,$name,$version,$status,$helpers,$tools]);
|
|
($status,$version,$helpers,$tools) = ('','',undef,undef);
|
|
}
|
|
main::log_data('dump','sound data: @$data',$data) if $b_log;
|
|
print 'Sound data: ', Data::Dumper::Dumper $data if $dbg[26];
|
|
eval $end if $b_log;
|
|
return $data;
|
|
}
|
|
|
|
# assume if jackd running we have active jack, update if required
|
|
sub jack_status {
|
|
eval $start if $b_log;
|
|
my $status;
|
|
if (grep {/jackd/} @ps_cmd){
|
|
if (my $program = main::check_program('jack_control')){
|
|
system("$program status > /dev/null 2>&1");
|
|
# 0 means running, always, else 1.
|
|
if ($? == 0){
|
|
$status = 'active';
|
|
}
|
|
else {
|
|
$status = ($b_root) ? main::message('audio-server-root-na') : 'off';
|
|
}
|
|
}
|
|
$status = main::message('audio-server-process-on') if !$status;
|
|
}
|
|
else {
|
|
$status = 'off';
|
|
}
|
|
eval $end if $b_log;
|
|
return $status;
|
|
}
|
|
|
|
# pipewire is complicated, it can be there and running without being active server
|
|
# This is NOT verified as valid true/yes case!!
|
|
sub pipewire_status {
|
|
eval $start if $b_log;
|
|
my ($b_process,$program,$status,@data);
|
|
if (grep {/(^|\/)pipewire(d|\s|:|$)/} @ps_cmd){
|
|
# note: if pipewire was stopped but not masked, pw-cli can start service so
|
|
# only use if pipewire process already running
|
|
if ($program = main::check_program('pw-cli')){
|
|
@data = qx($program ls 2>/dev/null);
|
|
main::log_data('dump','pw-cli @data', \@data) if $b_log;
|
|
print 'pw-cli: ', Data::Dumper::Dumper \@data if $dbg[52];
|
|
if (@data){
|
|
$status = (grep {/media\.class\s*=\s*"(Audio|Midi)/i} @data) ? 'active' : 'off';
|
|
}
|
|
elsif ($b_root){
|
|
$status = main::message('audio-server-root-na');
|
|
}
|
|
}
|
|
$status = main::message('audio-server-process-on') if !$status;
|
|
}
|
|
else {
|
|
$status = 'off';
|
|
}
|
|
eval $end if $b_log;
|
|
return $status;
|
|
}
|
|
|
|
# pulse might be running through pipewire
|
|
sub pulse_status {
|
|
eval $start if $b_log;
|
|
my $program = $_[0];
|
|
my ($status,@data);
|
|
if (grep {/(^|\/)pulseaudiod?\b/} @ps_cmd){
|
|
# this is almost certainly not needed, but keep for now
|
|
system("$program --check > /dev/null 2>&1");
|
|
# 0 means running, always, other could be an error.
|
|
if ($? == 0){
|
|
$status = 'active';
|
|
}
|
|
else {
|
|
$status = ($b_root) ? main::message('audio-server-root-on') : 'off';
|
|
}
|
|
}
|
|
else {
|
|
# can't use pactl info test because starts pulseaudio/pipewire if unmasked
|
|
if (main::check_program('pipewire-pulse') &&
|
|
(grep {/(^|\/)pipewire-pulse/} @ps_cmd)){
|
|
$status = main::message('audio-server-on-pipewire-pulse');
|
|
}
|
|
else {
|
|
$status = 'off';
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $status;
|
|
}
|
|
|
|
sub sound_helpers {
|
|
eval $start if $b_log;
|
|
my $test = $_[0];
|
|
my ($helpers,$name,$status,$key);
|
|
foreach my $item (@$test){
|
|
if (main::check_program($item->[0]) ||
|
|
(defined $item->[2] && main::globber($item->[2]))){
|
|
$name = $item->[0];
|
|
$key = 'with';
|
|
# these are active/off daemons unless not a daemon
|
|
if ($item->[1] eq 'daemon'){
|
|
$status = (grep {/$item->[0]/} @ps_cmd) ? 'active':'off' ;
|
|
}
|
|
else {
|
|
$status = $item->[1];
|
|
}
|
|
push(@$helpers,[$key,$name,$item->[1],$status]);
|
|
}
|
|
}
|
|
# push(@$helpers, ['with','pipewire-pulse','daemon','active'],['with','pw-jack','plugin']);
|
|
# push(@$helpers, ['with','pipewire-pulse','daemon','active']);
|
|
eval $end if $b_log;
|
|
# print Data::Dumper::Dumper $helpers;
|
|
return $helpers;
|
|
}
|
|
|
|
sub sound_tools {
|
|
eval $start if $b_log;
|
|
my $test = $_[0];
|
|
my $tools;
|
|
foreach my $item (@$test){
|
|
if (main::check_program($item)){
|
|
push(@$tools,$item);
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
# print Data::Dumper::Dumper $tools;
|
|
return $tools;
|
|
}
|
|
}
|
|
|
|
## BatteryItem
|
|
{
|
|
package BatteryItem;
|
|
my (@upower_items,$b_upower,$upower);
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my ($key1,$val1);
|
|
my $battery = {};
|
|
my $rows = [];
|
|
my $num = 0;
|
|
if ($force{'dmidecode'}){
|
|
if ($alerts{'dmidecode'}->{'action'} ne 'use'){
|
|
$key1 = $alerts{'dmidecode'}->{'action'};
|
|
$val1 = $alerts{'dmidecode'}->{'message'};
|
|
$key1 = ucfirst($key1);
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1});
|
|
}
|
|
else {
|
|
battery_data_dmi($battery);
|
|
if (!%$battery){
|
|
if ($show{'battery-forced'}){
|
|
$key1 = 'Message';
|
|
$val1 = main::message('battery-data','');
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1});
|
|
}
|
|
}
|
|
else {
|
|
battery_output($rows,$battery);
|
|
}
|
|
}
|
|
}
|
|
elsif ($bsd_type && ($sysctl{'battery'} || $show{'battery-forced'})){
|
|
battery_data_sysctl($battery) if $sysctl{'battery'};
|
|
if (!%$battery){
|
|
if ($show{'battery-forced'}){
|
|
$key1 = 'Message';
|
|
$val1 = main::message('battery-data-bsd','');
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1});
|
|
}
|
|
}
|
|
else {
|
|
battery_output($rows,$battery);
|
|
}
|
|
}
|
|
elsif (-d '/sys/class/power_supply/'){
|
|
battery_data_sys($battery);
|
|
if (!%$battery){
|
|
if ($show{'battery-forced'}){
|
|
$key1 = 'Message';
|
|
$val1 = main::message('battery-data','');
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1});
|
|
}
|
|
}
|
|
else {
|
|
battery_output($rows,$battery);
|
|
}
|
|
}
|
|
else {
|
|
if ($show{'battery-forced'}){
|
|
$key1 = 'Message';
|
|
$val1 = (!$bsd_type) ? main::message('battery-data-sys'): main::message('battery-data-bsd');
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1});
|
|
}
|
|
}
|
|
(@upower_items,$b_upower,$upower) = ();
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
# alarm capacity capacity_level charge_full charge_full_design charge_now
|
|
# cycle_count energy_full energy_full_design energy_now location manufacturer model_name
|
|
# power_now present serial_number status technology type voltage_min_design voltage_now
|
|
# 0: name - battery id, not used
|
|
# 1: status
|
|
# 2: present
|
|
# 3: technology
|
|
# 4: cycle_count
|
|
# 5: voltage_min_design
|
|
# 6: voltage_now
|
|
# 7: power_now
|
|
# 8: energy_full_design
|
|
# 9: energy_full
|
|
# 10: energy_now
|
|
# 11: capacity
|
|
# 12: capacity_level
|
|
# 13: of_orig
|
|
# 14: model_name
|
|
# 15: manufacturer
|
|
# 16: serial_number
|
|
# 17: location
|
|
sub battery_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$battery) = @_;
|
|
my ($key);
|
|
my $num = 0;
|
|
my $j = 0;
|
|
# print Data::Dumper::Dumper $battery;
|
|
foreach $key (sort keys %$battery){
|
|
$num = 0;
|
|
my ($charge,$condition,$model,$serial,$status) = ('','','','','');
|
|
my ($chemistry,$cycles,$location) = ('','','');
|
|
next if !$battery->{$key}{'purpose'} || $battery->{$key}{'purpose'} ne 'primary';
|
|
# $battery->{$key}{''};
|
|
# we need to handle cases where charge or energy full is 0
|
|
if (defined $battery->{$key}{'energy_now'} && $battery->{$key}{'energy_now'} ne ''){
|
|
$charge = "$battery->{$key}{'energy_now'} Wh";
|
|
if ($battery->{$key}{'energy_full'} &&
|
|
main::is_numeric($battery->{$key}{'energy_full'})){
|
|
my $percent = sprintf("%.1f", $battery->{$key}{'energy_now'}/$battery->{$key}{'energy_full'}*100);
|
|
$charge .= ' (' . $percent . '%)';
|
|
}
|
|
}
|
|
# better than nothing, shows the charged percent
|
|
elsif (defined $battery->{$key}{'capacity'} && $battery->{$key}{'capacity'} ne ''){
|
|
$charge = $battery->{$key}{'capacity'} . '%'
|
|
}
|
|
else {
|
|
$charge = 'N/A';
|
|
}
|
|
if ($battery->{$key}{'energy_full'} || $battery->{$key}{'energy_full_design'}){
|
|
$battery->{$key}{'energy_full_design'} ||= 'N/A';
|
|
$battery->{$key}{'energy_full'} = (defined $battery->{$key}{'energy_full'} &&
|
|
$battery->{$key}{'energy_full'} ne '') ? $battery->{$key}{'energy_full'} : 'N/A';
|
|
$condition = "$battery->{$key}{'energy_full'}/$battery->{$key}{'energy_full_design'} Wh";
|
|
if ($battery->{$key}{'of_orig'}){
|
|
$condition .= " ($battery->{$key}{'of_orig'}%)";
|
|
}
|
|
}
|
|
$condition ||= 'N/A';
|
|
$j = scalar @$rows;
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'ID') => $key,
|
|
main::key($num++,0,2,'charge') => $charge,
|
|
main::key($num++,0,2,'condition') => $condition,
|
|
});
|
|
if ($extra > 2){
|
|
if ($battery->{$key}{'power_now'}){
|
|
$rows->[$j]{main::key($num++,0,2,'power')} = sprintf('%0.1f W',($battery->{$key}{'power_now'}/10**6));
|
|
}
|
|
}
|
|
if ($extra > 0 || ($battery->{$key}{'voltage_now'} &&
|
|
$battery->{$key}{'voltage_min_design'} &&
|
|
($battery->{$key}{'voltage_now'} - $battery->{$key}{'voltage_min_design'}) < 0.5)){
|
|
$battery->{$key}{'voltage_now'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,1,2,'volts')} = $battery->{$key}{'voltage_now'};
|
|
if ($battery->{$key}{'voltage_now'} ne 'N/A' || $battery->{$key}{'voltage_min_design'}){
|
|
$battery->{$key}{'voltage_min_design'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'min')} = $battery->{$key}{'voltage_min_design'};
|
|
}
|
|
}
|
|
if ($extra > 0){
|
|
if ($battery->{$key}{'manufacturer'} || $battery->{$key}{'model_name'}){
|
|
if ($battery->{$key}{'manufacturer'} && $battery->{$key}{'model_name'}){
|
|
$model = "$battery->{$key}{'manufacturer'} $battery->{$key}{'model_name'}";
|
|
}
|
|
elsif ($battery->{$key}{'manufacturer'}){
|
|
$model = $battery->{$key}{'manufacturer'};
|
|
}
|
|
elsif ($battery->{$key}{'model_name'}){
|
|
$model = $battery->{$key}{'model_name'};
|
|
}
|
|
}
|
|
else {
|
|
$model = 'N/A';
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'model')} = $model;
|
|
if ($extra > 2){
|
|
$chemistry = ($battery->{$key}{'technology'}) ? $battery->{$key}{'technology'}: 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'type')} = $chemistry;
|
|
}
|
|
if ($extra > 1){
|
|
$serial = main::filter($battery->{$key}{'serial_number'});
|
|
$rows->[$j]{main::key($num++,0,2,'serial')} = $serial;
|
|
}
|
|
$status = ($battery->{$key}{'status'}) ? $battery->{$key}{'status'}: 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'status')} = $status;
|
|
if ($extra > 2){
|
|
if ($battery->{$key}{'cycle_count'}){
|
|
$rows->[$j]{main::key($num++,0,2,'cycles')} = $battery->{$key}{'cycle_count'};
|
|
}
|
|
if ($battery->{$key}{'location'}){
|
|
$rows->[$j]{main::key($num++,0,2,'location')} = $battery->{$key}{'location'};
|
|
}
|
|
}
|
|
}
|
|
$battery->{$key} = undef;
|
|
}
|
|
# print Data::Dumper::Dumper \%$battery;
|
|
# now if there are any devices left, print them out, excluding Mains
|
|
if ($extra > 0){
|
|
$upower = main::check_program('upower');
|
|
foreach $key (sort keys %$battery){
|
|
$num = 0;
|
|
next if !defined $battery->{$key} || $battery->{$key}{'purpose'} eq 'mains';
|
|
my ($charge,$model,$serial,$percent,$status,$vendor) = ('','','','','','');
|
|
$j = scalar @$rows;
|
|
my $upower_data = ($upower) ? upower_data($key) : {};
|
|
if ($upower_data->{'percent'}){
|
|
$charge = $upower_data->{'percent'};
|
|
}
|
|
elsif ($battery->{$key}{'capacity_level'} &&
|
|
lc($battery->{$key}{'capacity_level'}) ne 'unknown'){
|
|
$charge = $battery->{$key}{'capacity_level'};
|
|
}
|
|
else {
|
|
$charge = 'N/A';
|
|
}
|
|
$model = $battery->{$key}{'model_name'} if $battery->{$key}{'model_name'};
|
|
$vendor = $battery->{$key}{'manufacturer'} if $battery->{$key}{'manufacturer'};
|
|
if ($vendor || $model){
|
|
if ($vendor && $model){
|
|
$model = "$vendor $model";
|
|
}
|
|
elsif ($vendor){
|
|
$model = $vendor;
|
|
}
|
|
}
|
|
else {
|
|
$model = 'N/A';
|
|
}
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $key,
|
|
main::key($num++,0,2,'model') => $model,
|
|
},);
|
|
if ($extra > 1){
|
|
$serial = main::filter($battery->{$key}{'serial_number'});
|
|
$rows->[$j]{main::key($num++,0,2,'serial')} = $serial;
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'charge')} = $charge;
|
|
if ($extra > 2 && $upower_data->{'rechargeable'}){
|
|
$rows->[$j]{main::key($num++,0,2,'rechargeable')} = $upower_data->{'rechargeable'};
|
|
}
|
|
$status = ($battery->{$key}{'status'}) ? $battery->{$key}{'status'}: 'N/A' ;
|
|
$rows->[$j]{main::key($num++,0,2,'status')} = $status;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# charge: mAh energy: Wh
|
|
sub battery_data_sys {
|
|
eval $start if $b_log;
|
|
my $battery = $_[0];
|
|
my ($b_ma,$file,$id,$item,$path,$value);
|
|
my $num = 0;
|
|
my @batteries = main::globber("/sys/class/power_supply/*");
|
|
# note: there is no 'location' file, but dmidecode has it
|
|
# 'type' is generic, like: Battery, Mains
|
|
# capacity_level is a string, like: Normal
|
|
my @items = qw(alarm capacity capacity_level charge_full charge_full_design
|
|
charge_now constant_charge_current constant_charge_current_max cycle_count
|
|
energy_full energy_full_design energy_now location manufacturer model_name
|
|
power_now present scope serial_number status technology type voltage_min_design
|
|
voltage_now);
|
|
foreach $item (@batteries){
|
|
$b_ma = 0;
|
|
$id = $item;
|
|
$id =~ s%/sys/class/power_supply/%%g;
|
|
foreach $file (@items){
|
|
$path = "$item/$file";
|
|
# android shows some files only root readable
|
|
$value = (-r $path) ? main::reader($path,'',0): '';
|
|
# mains, plus in psu
|
|
if ($file eq 'type' && $value && lc($value) ne 'battery'){
|
|
$battery->{$id}{'purpose'} = 'mains';
|
|
}
|
|
if ($value){
|
|
$value = main::trimmer($value);
|
|
if ($file eq 'voltage_min_design'){
|
|
$value = sprintf("%.1f", $value/1000000);
|
|
}
|
|
elsif ($file eq 'voltage_now'){
|
|
$value = sprintf("%.1f", $value/1000000);
|
|
}
|
|
elsif ($file eq 'energy_full_design'){
|
|
$value = $value/1000000;
|
|
}
|
|
elsif ($file eq 'energy_full'){
|
|
$value = $value/1000000;
|
|
}
|
|
elsif ($file eq 'energy_now'){
|
|
$value = sprintf("%.1f", $value/1000000);
|
|
}
|
|
# note: the following 3 were off, 100000 instead of 1000000
|
|
# why this is, I do not know. I did not document any reason for that
|
|
# so going on assumption it is a mistake.
|
|
# CHARGE is mAh, which are converted to Wh by: mAh x voltage.
|
|
# Note: voltage fluctuates so will make results vary slightly.
|
|
elsif ($file eq 'charge_full_design'){
|
|
$value = $value/1000000;
|
|
$b_ma = 1;
|
|
}
|
|
elsif ($file eq 'charge_full'){
|
|
$value = $value/1000000;
|
|
$b_ma = 1;
|
|
}
|
|
elsif ($file eq 'charge_now'){
|
|
$value = $value/1000000;
|
|
$b_ma = 1;
|
|
}
|
|
elsif ($file eq 'manufacturer'){
|
|
$value = main::clean_dmi($value);
|
|
}
|
|
elsif ($file eq 'model_name'){
|
|
$value = main::clean_dmi($value);
|
|
}
|
|
# Valid values: Unknown,Charging,Discharging,Not charging,Full
|
|
# don't use clean_unset because Not charging is a valid value.
|
|
elsif ($file eq 'status'){
|
|
$value = lc($value);
|
|
$value =~ s/unknown//;
|
|
|
|
}
|
|
}
|
|
elsif ($b_root && -e $path && ! -r $path){
|
|
$value = main::message('root-required');
|
|
}
|
|
$battery->{$id}{$file} = $value;
|
|
# print "$battery->{$id}{$file}\n";
|
|
}
|
|
# note, too few data sets, there could be sbs-charger but not sure
|
|
if (!$battery->{$id}{'purpose'}){
|
|
# NOTE: known ids: BAT[0-9] CMB[0-9]. arm may be like: sbs- sbm- but just check
|
|
# if the energy/charge values exist for this item, if so, it's a battery, if not,
|
|
# it's a device.
|
|
if ($id =~ /^(BAT|CMB).*$/i ||
|
|
($battery->{$id}{'energy_full'} || $battery->{$id}{'charge_full'} ||
|
|
$battery->{$id}{'energy_now'} || $battery->{$id}{'charge_now'} ||
|
|
$battery->{$id}{'energy_full_design'} || $battery->{$id}{'charge_full_design'}) ||
|
|
$battery->{$id}{'voltage_min_design'} || $battery->{$id}{'voltage_now'}){
|
|
$battery->{$id}{'purpose'} = 'primary';
|
|
}
|
|
else {
|
|
$battery->{$id}{'purpose'} = 'device';
|
|
}
|
|
}
|
|
# note:voltage_now fluctuates, which will make capacity numbers change a bit
|
|
# if any of these values failed, the math will be wrong, but no way to fix that
|
|
# tests show more systems give right capacity/charge with voltage_min_design
|
|
# than with voltage_now
|
|
if ($b_ma && $battery->{$id}{'voltage_min_design'}){
|
|
if ($battery->{$id}{'charge_now'}){
|
|
$battery->{$id}{'energy_now'} = $battery->{$id}{'charge_now'} * $battery->{$id}{'voltage_min_design'};
|
|
}
|
|
if ($battery->{$id}{'charge_full'}){
|
|
$battery->{$id}{'energy_full'} = $battery->{$id}{'charge_full'}*$battery->{$id}{'voltage_min_design'};
|
|
}
|
|
if ($battery->{$id}{'charge_full_design'}){
|
|
$battery->{$id}{'energy_full_design'} = $battery->{$id}{'charge_full_design'} * $battery->{$id}{'voltage_min_design'};
|
|
}
|
|
}
|
|
if ($battery->{$id}{'energy_now'} && $battery->{$id}{'energy_full'}){
|
|
$battery->{$id}{'capacity'} = 100 * $battery->{$id}{'energy_now'}/$battery->{$id}{'energy_full'};
|
|
$battery->{$id}{'capacity'} = sprintf("%.1f", $battery->{$id}{'capacity'});
|
|
}
|
|
if ($battery->{$id}{'energy_full_design'} && $battery->{$id}{'energy_full'}){
|
|
$battery->{$id}{'of_orig'} = 100 * $battery->{$id}{'energy_full'}/$battery->{$id}{'energy_full_design'};
|
|
$battery->{$id}{'of_orig'} = sprintf("%.1f", $battery->{$id}{'of_orig'});
|
|
}
|
|
if ($battery->{$id}{'energy_now'}){
|
|
$battery->{$id}{'energy_now'} = sprintf("%.1f", $battery->{$id}{'energy_now'});
|
|
}
|
|
if ($battery->{$id}{'energy_full_design'}){
|
|
$battery->{$id}{'energy_full_design'} = sprintf("%.1f",$battery->{$id}{'energy_full_design'});
|
|
}
|
|
if ($battery->{$id}{'energy_full'}){
|
|
$battery->{$id}{'energy_full'} = sprintf("%.1f", $battery->{$id}{'energy_full'});
|
|
}
|
|
}
|
|
print Data::Dumper::Dumper $battery if $dbg[33];
|
|
main::log_data('dump','sys: %$battery',$battery) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub battery_data_sysctl {
|
|
eval $start if $b_log;
|
|
my $battery = $_[0];
|
|
my ($id);
|
|
for (@{$sysctl{'battery'}}){
|
|
if (/^(hw\.sensors\.)acpi([^\.]+)(\.|:)/){
|
|
$id = uc($2);
|
|
}
|
|
if (/volt[^:]+:([0-9\.]+)\s+VDC\s+\(voltage\)/){
|
|
$battery->{$id}{'voltage_min_design'} = $1;
|
|
}
|
|
elsif (/volt[^:]+:([0-9\.]+)\s+VDC\s+\(current voltage\)/){
|
|
$battery->{$id}{'voltage_now'} = $1;
|
|
}
|
|
elsif (/watthour[^:]+:([0-9\.]+)\s+Wh\s+\(design capacity\)/){
|
|
$battery->{$id}{'energy_full_design'} = $1;
|
|
}
|
|
elsif (/watthour[^:]+:([0-9\.]+)\s+Wh\s+\(last full capacity\)/){
|
|
$battery->{$id}{'energy_full'} = $1;
|
|
}
|
|
elsif (/watthour[^:]+:([0-9\.]+)\s+Wh\s+\(remaining capacity\)/){
|
|
$battery->{$id}{'energy_now'} = $1;
|
|
}
|
|
elsif (/amphour[^:]+:([0-9\.]+)\s+Ah\s+\(design capacity\)/){
|
|
$battery->{$id}{'charge_full_design'} = $1;
|
|
}
|
|
elsif (/amphour[^:]+:([0-9\.]+)\s+Ah\s+\(last full capacity\)/){
|
|
$battery->{$id}{'charge_full'} = $1;
|
|
}
|
|
elsif (/amphour[^:]+:([0-9\.]+)\s+Ah\s+\(remaining capacity\)/){
|
|
$battery->{$id}{'charge_now'} = $1;
|
|
}
|
|
elsif (/raw[^:]+:[0-9\.]+\s+\((battery) ([^\)]+)\)/){
|
|
$battery->{$id}{'status'} = $2;
|
|
}
|
|
elsif (/^acpi[\S]+:at [^:]+:\s*$id\s+/i){
|
|
if (/\s+model\s+(.*?)\s*/){
|
|
$battery->{$id}{'model_name'} = main::clean_dmi($1);
|
|
}
|
|
if (/\s*serial\s+([\S]*?)\s*/){
|
|
$battery->{$id}{'serial_number'} = main::clean_unset($1,'^(0x)0+$');
|
|
}
|
|
if (/\s*type\s+(.*?)\s*/){
|
|
$battery->{$id}{'technology'} = $1;
|
|
}
|
|
if (/\s*oem\s+(.*)/){
|
|
$battery->{$id}{'manufacturer'} = main::clean_dmi($1);
|
|
}
|
|
}
|
|
}
|
|
# then do the condition/charge percent math
|
|
for my $id (keys %$battery){
|
|
$battery->{$id}{'purpose'} = 'primary';
|
|
# CHARGE is Ah, which are converted to Wh by: Ah x voltage.
|
|
if ($battery->{$id}{'voltage_min_design'}){
|
|
if ($battery->{$id}{'charge_now'}){
|
|
$battery->{$id}{'energy_now'} = $battery->{$id}{'charge_now'} * $battery->{$id}{'voltage_min_design'};
|
|
}
|
|
if ($battery->{$id}{'charge_full'}){
|
|
$battery->{$id}{'energy_full'} = $battery->{$id}{'charge_full'}*$battery->{$id}{'voltage_min_design'};
|
|
}
|
|
if ($battery->{$id}{'charge_full_design'}){
|
|
$battery->{$id}{'energy_full_design'} = $battery->{$id}{'charge_full_design'} * $battery->{$id}{'voltage_min_design'};
|
|
}
|
|
}
|
|
if ($battery->{$id}{'energy_full_design'} && $battery->{$id}{'energy_full'}){
|
|
$battery->{$id}{'of_orig'} = 100 * $battery->{$id}{'energy_full'}/$battery->{$id}{'energy_full_design'};
|
|
$battery->{$id}{'of_orig'} = sprintf("%.1f", $battery->{$id}{'of_orig'});
|
|
}
|
|
if ($battery->{$id}{'energy_now'} && $battery->{$id}{'energy_full'}){
|
|
$battery->{$id}{'capacity'} = 100 * $battery->{$id}{'energy_now'}/$battery->{$id}{'energy_full'};
|
|
$battery->{$id}{'capacity'} = sprintf("%.1f", $battery->{$id}{'capacity'});
|
|
}
|
|
if ($battery->{$id}{'energy_now'}){
|
|
$battery->{$id}{'energy_now'} = sprintf("%.1f", $battery->{$id}{'energy_now'});
|
|
}
|
|
if ($battery->{$id}{'energy_full'}){
|
|
$battery->{$id}{'energy_full'} = sprintf("%.1f", $battery->{$id}{'energy_full'});
|
|
}
|
|
if ($battery->{$id}{'energy_full_design'}){
|
|
$battery->{$id}{'energy_full_design'} = sprintf("%.1f", $battery->{$id}{'energy_full_design'});
|
|
}
|
|
}
|
|
print Data::Dumper::Dumper $battery if $dbg[33];
|
|
main::log_data('dump','dmi: %$battery',$battery) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# note, dmidecode does not have charge_now or charge_full
|
|
sub battery_data_dmi {
|
|
eval $start if $b_log;
|
|
my $battery = $_[0];
|
|
my ($id);
|
|
my $i = 0;
|
|
foreach my $row (@dmi){
|
|
# Portable Battery
|
|
if ($row->[0] == 22){
|
|
$id = "BAT$i";
|
|
$i++;
|
|
$battery->{$id}{'purpose'} = 'primary';
|
|
# skip first three row, we don't need that data
|
|
foreach my $item (@$row[3 .. $#$row]){
|
|
my @value = split(/:\s+/, $item);
|
|
next if !$value[0];
|
|
if ($value[0] eq 'Location'){
|
|
$battery->{$id}{'location'} = $value[1]}
|
|
elsif ($value[0] eq 'Manufacturer'){
|
|
$battery->{$id}{'manufacturer'} = main::clean_dmi($value[1])}
|
|
elsif ($value[0] =~ /Chemistry/){
|
|
$battery->{$id}{'technology'} = $value[1]}
|
|
elsif ($value[0] =~ /Serial Number/){
|
|
$battery->{$id}{'serial_number'} = $value[1]}
|
|
elsif ($value[0] =~ /^Name/){
|
|
$battery->{$id}{'model_name'} = main::clean_dmi($value[1])}
|
|
elsif ($value[0] eq 'Design Capacity'){
|
|
$value[1] =~ s/\s*mwh$//i;
|
|
$battery->{$id}{'energy_full_design'} = sprintf("%.1f", $value[1]/1000);
|
|
}
|
|
elsif ($value[0] eq 'Design Voltage'){
|
|
$value[1] =~ s/\s*mv$//i;
|
|
$battery->{$id}{'voltage_min_design'} = sprintf("%.1f", $value[1]/1000);
|
|
}
|
|
}
|
|
if ($battery->{$id}{'energy_now'} && $battery->{$id}{'energy_full'}){
|
|
$battery->{$id}{'capacity'} = 100 * $battery->{$id}{'energy_now'} / $battery->{$id}{'energy_full'};
|
|
$battery->{$id}{'capacity'} = sprintf("%.1f%", $battery->{$id}{'capacity'});
|
|
}
|
|
if ($battery->{$id}{'energy_full_design'} && $battery->{$id}{'energy_full'}){
|
|
$battery->{$id}{'of_orig'} = 100 * $battery->{$id}{'energy_full'} / $battery->{$id}{'energy_full_design'};
|
|
$battery->{$id}{'of_orig'} = sprintf("%.0f%", $battery->{$id}{'of_orig'});
|
|
}
|
|
}
|
|
elsif ($row->[0] > 22){
|
|
last;
|
|
}
|
|
}
|
|
print Data::Dumper::Dumper $battery if $dbg[33];
|
|
main::log_data('dump','dmi: %$battery',$battery) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub upower_data {
|
|
my ($id) = @_;
|
|
eval $start if $b_log;
|
|
my $data = {};
|
|
if (!$b_upower && $upower){
|
|
@upower_items = main::grabber("$upower -e",'','strip');
|
|
$b_upower = 1;
|
|
}
|
|
if ($upower && @upower_items){
|
|
foreach (@upower_items){
|
|
if ($_ =~ /$id/){
|
|
my @working = main::grabber("$upower -i $_",'','strip');
|
|
foreach my $row (@working){
|
|
my @temp = split(/\s*:\s*/, $row);
|
|
if ($temp[0] eq 'percentage'){
|
|
$data->{'percent'} = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'rechargeable'){
|
|
$data->{'rechargeable'} = $temp[1];
|
|
}
|
|
}
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
main::log_data('dump','upower: %$data',$data) if $b_log;
|
|
eval $end if $b_log;
|
|
return $data;
|
|
}
|
|
}
|
|
|
|
## BluetoothItem
|
|
{
|
|
package BluetoothItem;
|
|
my ($b_bluetooth,$b_hci_error,$b_hci,$b_rfk,$b_service);
|
|
my ($service);
|
|
my (%hci);
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my $rows = [];
|
|
my $num = 0;
|
|
if ($fake{'bluetooth'} || (@ps_cmd && (grep {m|/bluetoothd\b|} @ps_cmd))){
|
|
$b_bluetooth = 1;
|
|
}
|
|
# note: rapi 4 has pci bus
|
|
if (%risc && !$use{'soc-bluetooth'} && !$use{'pci-tool'}){
|
|
# do nothing, but keep the test conditions to force
|
|
# the non risc case to always run
|
|
# my $key = 'Message';
|
|
# @$rows = ({
|
|
# main::key($num++,0,1,$key) => main::message('risc-pci',$risc{'id'})
|
|
# });
|
|
}
|
|
else {
|
|
device_output($rows);
|
|
}
|
|
usb_output($rows);
|
|
if (!@$rows){
|
|
if ($show{'bluetooth-forced'}){
|
|
my $key = 'Message';
|
|
@$rows = ({main::key($num++,0,1,$key) => main::message('bluetooth-data')});
|
|
}
|
|
}
|
|
# if there are any unhandled hci items print them out
|
|
if (%hci){
|
|
advanced_output($rows,'check','');
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub device_output {
|
|
eval $start if $b_log;
|
|
return if !$devices{'bluetooth'};
|
|
my $rows = $_[0];
|
|
my ($bus_id);
|
|
my ($j,$num) = (0,1);
|
|
foreach my $row (@{$devices{'bluetooth'}}){
|
|
$num = 1;
|
|
$bus_id = '';
|
|
$j = scalar @$rows;
|
|
my $driver = ($row->[9]) ? $row->[9] : 'N/A';
|
|
my $device = $row->[4];
|
|
$device = ($device) ? main::clean_pci($device,'output') : 'N/A';
|
|
# have seen absurdly verbose card descriptions, with non related data etc
|
|
if (length($device) > 85 || $size{'max-cols'} < 110){
|
|
$device = main::filter_pci_long($device);
|
|
}
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $device,
|
|
},);
|
|
if ($extra > 0 && $use{'pci-tool'} && $row->[12]){
|
|
my $item = main::get_pci_vendor($row->[4],$row->[12]);
|
|
$rows->[$j]{main::key($num++,0,2,'vendor')} = $item if $item;
|
|
}
|
|
$rows->[$j]{main::key($num++,1,2,'driver')} = $driver;
|
|
if ($extra > 0 && $row->[9] && !$bsd_type){
|
|
my $version = main::get_module_version($row->[9]);
|
|
$rows->[$j]{main::key($num++,0,3,'v')} = $version if $version;
|
|
}
|
|
if ($b_admin && $row->[10]){
|
|
$row->[10] = main::get_driver_modules($row->[9],$row->[10]);
|
|
$rows->[$j]{main::key($num++,0,3,'alternate')} = $row->[10] if $row->[10];
|
|
}
|
|
if ($extra > 0){
|
|
$bus_id = (!$row->[2] && !$row->[3]) ? 'N/A' : "$row->[2].$row->[3]";
|
|
if ($extra > 1 && $bus_id ne 'N/A'){
|
|
main::get_pcie_data($bus_id,$j,$rows,\$num);
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'bus-ID')} = $bus_id;
|
|
}
|
|
if ($extra > 1){
|
|
my $chip_id = main::get_chip_id($row->[5],$row->[6]);
|
|
$rows->[$j]{main::key($num++,0,2,'chip-ID')} = $chip_id;
|
|
if ($extra > 2 && $row->[1]){
|
|
$rows->[$j]{main::key($num++,0,2,'class-ID')} = $row->[1];
|
|
}
|
|
}
|
|
# weird serial rpi bt
|
|
if ($use{'soc-bluetooth'}){
|
|
# /sys/devices/platform/soc/fe201000.serial/
|
|
$bus_id = "$row->[6].$row->[1]" if defined $row->[1] && defined $row->[6];
|
|
}
|
|
else {
|
|
# only theoretical, never seen one
|
|
$bus_id = "$row->[2].$row->[3]" if defined $row->[2] && defined $row->[3];
|
|
}
|
|
advanced_output($rows,'pci',$bus_id) if $bus_id;
|
|
# print "$row->[0]\n";
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub usb_output {
|
|
eval $start if $b_log;
|
|
return if !$usb{'bluetooth'};
|
|
my $rows = $_[0];
|
|
my ($path_id,$product);
|
|
my ($j,$num) = (0,1);
|
|
foreach my $row (@{$usb{'bluetooth'}}){
|
|
# print Data::Dumper::Dumper $row;
|
|
$num = 1;
|
|
$j = scalar @$rows;
|
|
# makre sure to reset, or second device trips last flag
|
|
($path_id,$product) = ('','');
|
|
$product = main::clean($row->[13]) if $row->[13];
|
|
$product ||= 'N/A';
|
|
$row->[15] ||= 'N/A';
|
|
$path_id = $row->[2] if $row->[2];
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $product,
|
|
main::key($num++,1,2,'driver') => $row->[15],
|
|
},);
|
|
if ($extra > 0 && $row->[15] && !$bsd_type){
|
|
my $version = main::get_module_version($row->[15]);
|
|
$rows->[$j]{main::key($num++,0,3,'v')} = $version if $version;
|
|
}
|
|
$rows->[$j]{main::key($num++,1,2,'type')} = 'USB';
|
|
if ($extra > 0){
|
|
if ($extra > 1){
|
|
$row->[8] ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'rev')} = $row->[8];
|
|
if ($row->[17]){
|
|
$rows->[$j]{main::key($num++,0,3,'speed')} = $row->[17];
|
|
}
|
|
if ($row->[24]){
|
|
$rows->[$j]{main::key($num++,0,3,'lanes')} = $row->[24];
|
|
}
|
|
if ($b_admin && $row->[22]){
|
|
$rows->[$j]{main::key($num++,0,3,'mode')} = $row->[22];
|
|
}
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'bus-ID')} = "$path_id:$row->[1]";
|
|
if ($extra > 1){
|
|
$row->[7] ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'chip-ID')} = $row->[7];
|
|
}
|
|
if ($extra > 2){
|
|
if (defined $row->[5] && $row->[5] ne ''){
|
|
$rows->[$j]{main::key($num++,0,2,'class-ID')} = "$row->[4]$row->[5]";
|
|
}
|
|
if ($row->[16]){
|
|
$rows->[$j]{main::key($num++,0,2,'serial')} = main::filter($row->[16]);
|
|
}
|
|
}
|
|
}
|
|
advanced_output($rows,'usb',$path_id) if $path_id;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub advanced_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$type,$bus_id) = @_;
|
|
my (@temp);
|
|
my ($j,$num,$k,$l,$m,$n,$address,$id,$note,$tool) = (0,1,2,3,4,5,'','','','');
|
|
set_bluetooth_data(\$tool);
|
|
# print "bid: $bus_id\n";
|
|
if ($type ne 'check'){
|
|
@temp = main::globber('/sys/class/bluetooth/*');
|
|
@temp = map {$_ = Cwd::abs_path($_);$_} @temp if @temp;
|
|
# print Data::Dumper::Dumper \@temp;
|
|
@temp = grep {/$bus_id/} @temp if @temp;
|
|
@temp = map {$_ =~ s|^/.*/||;$_;} @temp if @temp;
|
|
# print Data::Dumper::Dumper \@temp;
|
|
}
|
|
elsif ($type eq 'check' && %hci){
|
|
@temp = keys %hci;
|
|
$id = '-ID';
|
|
($k,$l,$m,$n) = (1,2,3,4);
|
|
}
|
|
if (@temp && %hci){
|
|
if ($hci{'alert'}){
|
|
if (keys %hci == 1){
|
|
check_service(); # sets $service
|
|
$j = scalar @$rows;
|
|
$rows->[$j]{main::key($num++,1,$k,'Report')} = $tool;
|
|
$rows->[$j]{main::key($num++,0,$l,'bt-service')} = $service;
|
|
$rows->[$j]{main::key($num++,0,$l,'note')} = $hci{'alert'};
|
|
}
|
|
else {
|
|
$note = $hci{'alert'};
|
|
}
|
|
delete $hci{'alert'};
|
|
}
|
|
foreach my $item (@temp){
|
|
if ($hci{$item}){
|
|
$j = scalar @$rows;
|
|
push(@$rows,{
|
|
main::key($num++,1,$k,'Report' . $id) => $tool,
|
|
},);
|
|
if ($note){
|
|
$rows->[$j]{main::key($num++,0,$l,'note')} = $note;
|
|
}
|
|
# synthesize for rfkill
|
|
if (!$hci{$item}->{'state'}){
|
|
$hci{$item}->{'state'} = ($b_bluetooth) ? 'up' : 'down';
|
|
}
|
|
$rows->[$j]{main::key($num++,0,$l,'ID')} = $item;
|
|
if (defined $hci{$item}->{'rf-index'} &&
|
|
($extra > 0 || $hci{$item}->{'state'} eq 'down')){
|
|
$rows->[$j]{main::key($num++,0,$m,'rfk-id')} = $hci{$item}->{'rf-index'};
|
|
}
|
|
$rows->[$j]{main::key($num++,1,$l,'state')} = $hci{$item}->{'state'};
|
|
# this only appears for hciconfig, bt-adapter does not run without bt service
|
|
if (!$b_bluetooth || $hci{$item}->{'state'} eq 'down'){
|
|
if (!$b_bluetooth || $hci{$item}->{'state'} eq 'down'){
|
|
check_service(); # sets $service
|
|
$rows->[$j]{main::key($num++,0,$m,'bt-service')} = $service;
|
|
}
|
|
if ($hci{$item}->{'hard-blocked'}){
|
|
$rows->[$j]{main::key($num++,1,$m,'rfk-block')} = '';
|
|
$rows->[$j]{main::key($num++,0,$n,'hardware')} = $hci{$item}->{'hard-blocked'};
|
|
$rows->[$j]{main::key($num++,0,$n,'software')} = $hci{$item}->{'soft-blocked'};
|
|
}
|
|
}
|
|
if (!$hci{$item}->{'address'} && $tool eq 'rfkill'){
|
|
$address = main::message('recommends');
|
|
}
|
|
else {
|
|
$address = main::filter($hci{$item}->{'address'});
|
|
}
|
|
$rows->[$j]{main::key($num++,0,$l,'address')} = $address;
|
|
# lmp/hci version only hciconfig
|
|
if ($hci{$item}->{'bt-version'}){
|
|
$rows->[$j]{main::key($num++,0,$l,'bt-v')} = $hci{$item}->{'bt-version'};
|
|
}
|
|
if ($extra > 0 && defined $hci{$item}->{'lmp-version'}){
|
|
$rows->[$j]{main::key($num++,0,$l,'lmp-v')} = $hci{$item}->{'lmp-version'};
|
|
if ($extra > 1 && $hci{$item}->{'lmp-subversion'}){
|
|
$rows->[$j]{main::key($num++,0,$m,'sub-v')} = $hci{$item}->{'lmp-subversion'};
|
|
}
|
|
}
|
|
if ($extra > 0 && defined $hci{$item}->{'hci-version'} &&
|
|
($extra > 2 || !$hci{$item}->{'lmp-version'} ||
|
|
($hci{$item}->{'lmp-version'} &&
|
|
$hci{$item}->{'lmp-version'} ne $hci{$item}->{'hci-version'}))){
|
|
$rows->[$j]{main::key($num++,0,$l,'hci-v')} = $hci{$item}->{'hci-version'};
|
|
if ($extra > 1 && $hci{$item}->{'hci-revision'}){
|
|
$rows->[$j]{main::key($num++,0,$m,'rev')} = $hci{$item}->{'hci-revision'};
|
|
}
|
|
}
|
|
if ($b_admin &&
|
|
($hci{$item}->{'discoverable'} || $hci{$item}->{'pairable'})){
|
|
$rows->[$j]{main::key($num++,1,$l,'status')} = '';
|
|
if ($hci{$item}->{'discoverable'}){
|
|
$rows->[$j]{main::key($num++,1,$m,'discoverable')} = $hci{$item}->{'discoverable'};
|
|
if ($hci{$item}->{'discovering'}){
|
|
$rows->[$j]{main::key($num++,1,$n,'active')} = $hci{$item}->{'discovering'};
|
|
}
|
|
}
|
|
if ($hci{$item}->{'pairable'}){
|
|
$rows->[$j]{main::key($num++,0,$m,'pairing')} = $hci{$item}->{'pairable'};
|
|
}
|
|
}
|
|
if ($extra > 2 && $hci{$item}->{'class'}){
|
|
$rows->[$j]{main::key($num++,0,$l,'class-ID')} = $hci{$item}->{'class'};
|
|
}
|
|
# this data only from hciconfig
|
|
if ($b_admin && ($hci{$item}->{'acl-mtu'} || $hci{$item}->{'sco-mtu'} ||
|
|
$hci{$item}->{'link-policy'})){
|
|
$j = scalar @$rows;
|
|
push(@$rows,{
|
|
main::key($num++,1,$l,'Info') => '',
|
|
},);
|
|
if ($hci{$item}->{'acl-mtu'}){
|
|
$rows->[$j]{main::key($num++,0,$m,'acl-mtu')} = $hci{$item}->{'acl-mtu'};
|
|
}
|
|
if ($hci{$item}->{'sco-mtu'}){
|
|
$rows->[$j]{main::key($num++,0,$m,'sco-mtu')} = $hci{$item}->{'sco-mtu'};
|
|
}
|
|
if ($hci{$item}->{'link-policy'}){
|
|
$rows->[$j]{main::key($num++,0,$m,'link-policy')} = $hci{$item}->{'link-policy'};
|
|
}
|
|
if ($hci{$item}->{'link-mode'}){
|
|
$rows->[$j]{main::key($num++,0,$m,'link-mode')} = $hci{$item}->{'link-mode'};
|
|
}
|
|
if ($hci{$item}->{'service-classes'}){
|
|
$rows->[$j]{main::key($num++,0,$m,'service-classes')} = $hci{$item}->{'service-classes'};
|
|
}
|
|
}
|
|
delete $hci{$item};
|
|
}
|
|
}
|
|
}
|
|
# since $rows is ref, we need to just check if no $j were set.
|
|
if (!$j && !$b_hci_error && ($alerts{'hciconfig'}->{'action'} ne 'use' &&
|
|
$alerts{'bt-adapter'}->{'action'} ne 'use' &&
|
|
$alerts{'btmgmt'}->{'action'} ne 'use')){
|
|
my $key = 'Report';
|
|
my $value = '';
|
|
if ($alerts{'hciconfig'}->{'action'} eq 'platform' ||
|
|
$alerts{'bt-adapter'}->{'action'} eq 'platform' ||
|
|
$alerts{'btmgmt'}->{'action'} eq 'platform'){
|
|
$value = main::message('tool-missing-os','bluetooth');
|
|
}
|
|
else {
|
|
$value = main::message('tools-missing','hciconfig/bt-adapter');
|
|
}
|
|
push(@$rows,{
|
|
main::key($num++,0,1,$key) => $value,
|
|
},);
|
|
$b_hci_error = 1;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# note: echo 'show' | bluetoothctl outputs everything but hciX ID, and is fast
|
|
# args: 0: $tool, by ref
|
|
sub set_bluetooth_data {
|
|
eval $start if $b_log;
|
|
if (!$b_hci && !$force{'bt-adapter'} && !$force{'btmgmt'} &&
|
|
!$force{'rfkill'} &&
|
|
($fake{'bluetooth'} || $alerts{'hciconfig'}->{'action'} eq 'use')){
|
|
hciconfig_data();
|
|
${$_[0]} = 'hciconfig';
|
|
}
|
|
elsif (!$b_hci && !$force{'rfkill'} && !$force{'bt-adapter'} &&
|
|
($fake{'bluetooth'} || $alerts{'btmgmt'}->{'action'} eq 'use')){
|
|
btmgmt_data();
|
|
${$_[0]} = 'btmgmt';
|
|
}
|
|
elsif (!$b_hci && !$force{'rfkill'} &&
|
|
($fake{'bluetooth'} || $alerts{'bt-adapter'}->{'action'} eq 'use')){
|
|
bt_adapter_data();
|
|
${$_[0]} = 'bt-adapter';
|
|
}
|
|
if (!$b_rfk && ($fake{'bluetooth'} || -e '/sys/class/bluetooth/')){
|
|
rfkill_data();
|
|
${$_[0]} = 'rfkill' if !${$_[0]};
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub bt_adapter_data {
|
|
eval $start if $b_log;
|
|
$b_hci = 1;
|
|
my (@data,$id);
|
|
if ($fake{'bluetooth'}){
|
|
my $file;
|
|
$file = "";
|
|
@data = main::reader($file,'strip');
|
|
}
|
|
else {
|
|
if ($b_bluetooth){
|
|
my $cmd = "$alerts{'bt-adapter'}->{'path'} --info 2>/dev/null";
|
|
@data = main::grabber($cmd,'','strip');
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \@data;
|
|
main::log_data('dump','@data', \@data) if $b_log;
|
|
foreach (@data){
|
|
my @working = split(/:\s*/,$_);
|
|
# print Data::Dumper::Dumper \@working;
|
|
next if ! @working;
|
|
if ($working[0] =~ /^\[([^\]]+)\]/){
|
|
$id = $1;
|
|
}
|
|
elsif ($working[0] eq 'Address'){
|
|
$hci{$id}->{'address'} = join(':',@working[1 .. $#working]);
|
|
}
|
|
elsif ($working[0] eq 'Class' && $working[1] =~ /^0x0*(\S+)/){
|
|
$hci{$id}->{'class'} = $1;
|
|
}
|
|
elsif ($working[0] eq 'Powered'){
|
|
$hci{$id}->{'state'} = ($working[1] =~ /^(1|yes)\b/) ? 'up': 'down';
|
|
}
|
|
elsif ($working[0] eq 'Discoverable'){
|
|
$hci{$id}->{'discoverable'} = ($working[1] =~ /^(1|yes)\b/) ? 'yes': 'no';
|
|
}
|
|
elsif ($working[0] eq 'Pairable'){
|
|
$hci{$id}->{'pairable'} = ($working[1] =~ /^(1|yes)\b/) ? 'yes': 'no';
|
|
}
|
|
elsif ($working[0] eq 'Discovering'){
|
|
$hci{$id}->{'discovering'} = ($working[1] =~ /^(1|yes)\b/) ? 'yes': 'no';
|
|
}
|
|
}
|
|
if (!@data && !$b_bluetooth){
|
|
$hci{'alert'} = main::message('bluetooth-down');
|
|
}
|
|
print 'bt-adapter: ', Data::Dumper::Dumper \%hci if $dbg[27];
|
|
main::log_data('dump','%hci', \%hci) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub btmgmt_data {
|
|
eval $start if $b_log;
|
|
$b_hci = 1;
|
|
my (@data,$id);
|
|
if ($fake{'bluetooth'}){
|
|
my $file;
|
|
$file = "$ENV{'HOME'}/bin/scripts/inxi/data/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 = "$ENV{'HOME'}/bin/scripts/inxi/data/bluetooth/hciconfig-a-2.txt";
|
|
@data = main::reader($file,'strip');
|
|
}
|
|
else {
|
|
my $cmd = "$alerts{'hciconfig'}->{'path'} -a 2>/dev/null";
|
|
@data = main::grabber($cmd,'', 'strip');
|
|
}
|
|
# print Data::Dumper::Dumper \@data;
|
|
main::log_data('dump','@data', \@data) if $b_log;
|
|
foreach (@data){
|
|
if (/^(hci[0-9]+):\s+Type:\s+(.*)\s+Bus:\s+([\S]+)/){
|
|
$id = $1;
|
|
$hci{$id} = {
|
|
'type'=> $2,
|
|
'bus' => $3,
|
|
};
|
|
}
|
|
elsif (/^BD Address:\s+([0-9A-F:]*)\s+ACL\s+MTU:\s+([0-9:]+)\s+SCO MTU:\s+([0-9:]+)/){
|
|
$hci{$id}->{'address'} = $1;
|
|
$hci{$id}->{'acl-mtu'} = $2;
|
|
$hci{$id}->{'sco-mtu'} = $3;
|
|
}
|
|
elsif (/^(UP|DOWN).*/){
|
|
$hci{$id}->{'state'} = lc($1);
|
|
}
|
|
elsif (/^Class:\s+0x0*(\S+)/){
|
|
$hci{$id}->{'class'} = $1;
|
|
}
|
|
# HCI Version: 4.0 (0x6) Revision: 0x1000
|
|
# HCI Version: 6.6 Revision: 0x1000 [don't know if this exists]
|
|
# HCI Version: (0x7) Revision: 0x3101
|
|
elsif (/^HCI Version:\s+(([0-9\.]+)\s+)?\(0x([0-9a-f]+)\)\s+Revision:\s+0x([0-9a-f]+)/i){
|
|
$hci{$id}->{'hci-revision'} = $4;
|
|
if (defined $3){
|
|
$hci{$id}->{'bt-version'} = bluetooth_version(hex($3));
|
|
$hci{$id}->{'hci-version'} = hex($3);
|
|
$hci{$id}->{'hci-version-hex'} = $3;
|
|
}
|
|
}
|
|
# LMP Version: 4.0 (0x6) Subversion: 0x220e
|
|
# LMP Version: 6.6 Revision: 0x1000 [don't know if this exists]
|
|
# LMP Version: (0x7) Subversion: 0x1
|
|
elsif (/^LMP Version:\s+(([0-9\.]+)\s+)?\(0x([0-9a-f]+)\)\s+Subversion:\s+0x([0-9a-f]+)/i){
|
|
$hci{$id}->{'lmp-subversion'} = $4;
|
|
$hci{$id}->{'bt-version'} = bluetooth_version(hex($3));
|
|
$hci{$id}->{'lmp-version'} = hex($3);
|
|
$hci{$id}->{'lmp-version-hex'} = $3;
|
|
}
|
|
elsif (/^Link policy:\s+(.*)/){
|
|
$hci{$id}->{'link-policy'} = lc($1);
|
|
}
|
|
elsif (/^Link mode:\s+(.*)/){
|
|
$hci{$id}->{'link-mode'} = lc($1);
|
|
}
|
|
elsif (/^Service Classes?:\s+(.+)/){
|
|
$hci{$id}->{'service-classes'} = main::clean_unset(lc($1));
|
|
}
|
|
}
|
|
print 'hciconfig: ', Data::Dumper::Dumper \%hci if $dbg[27];
|
|
main::log_data('dump','%hci', \%hci) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub rfkill_data {
|
|
eval $start if $b_log;
|
|
$b_rfk = 1;
|
|
my (@data,$id,$value);
|
|
if ($fake{'bluetooth'}){
|
|
my $file;
|
|
$file = "";
|
|
@data = main::reader($file,'strip');
|
|
}
|
|
else {
|
|
# /state is the state of rfkill, NOT bluetooth!
|
|
@data = main::globber('/sys/class/bluetooth/hci*/rfkill*/{hard,index,soft}');
|
|
}
|
|
# print Data::Dumper::Dumper \@data;
|
|
main::log_data('dump','@data', \@data) if $b_log;
|
|
foreach (@data){
|
|
$id = (split(/\//,$_))[4];
|
|
if (m|/soft$|){
|
|
$value = main::reader($_,'strip',0);
|
|
$hci{$id}->{'soft-blocked'} = ($value) ? 'yes': 'no';
|
|
$hci{$id}->{'state'} = 'down' if $hci{$id}->{'soft-blocked'} eq 'yes';
|
|
}
|
|
elsif (m|/hard$|){
|
|
$value = main::reader($_,'strip',0);
|
|
$hci{$id}->{'hard-blocked'} = ($value) ? 'yes': 'no';
|
|
$hci{$id}->{'state'} = 'down' if $hci{$id}->{'hard-blocked'} eq 'yes';
|
|
}
|
|
elsif (m|/index$|){
|
|
$value = main::reader($_,'strip',0);
|
|
$hci{$id}->{'rf-index'} = $value;
|
|
}
|
|
}
|
|
print 'rfkill: ', Data::Dumper::Dumper \%hci if $dbg[27];
|
|
main::log_data('dump','%hci', \%hci) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub check_service {
|
|
eval $start if $b_log;
|
|
if (!$b_service){
|
|
$service = ServiceData::get('status','bluetooth');
|
|
$service ||= 'N/A';
|
|
$b_service = 1;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# args: 0: lmp versoin - could be hex, but probably decimal, like 6.6
|
|
sub bluetooth_version {
|
|
eval $start if $b_log;
|
|
my ($lmp) = @_;
|
|
return if !defined $lmp;
|
|
return if !main::is_numeric($lmp);
|
|
$lmp = int($lmp);
|
|
# Conveniently, LMP starts with 0, so perfect for array indexes.
|
|
# 6.0 is coming, but might be 5.5 first, nobody knows.
|
|
my @bt = qw(1.0b 1.1 1.2 2.0 2.1 3.0 4.0 4.1 4.2 5.0 5.1 5.2 5.3 5.4);
|
|
return $bt[$lmp];
|
|
eval $end if $b_log;
|
|
}
|
|
}
|
|
|
|
## CpuItem
|
|
{
|
|
package CpuItem;
|
|
my ($type);
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
($type) = @_;
|
|
my $rows = [];
|
|
if ($type eq 'short' || $type eq 'basic'){
|
|
# note, for short form, just return the raw data, not the processed output
|
|
my $cpu = short_data();
|
|
if ($type eq 'basic'){
|
|
short_output($rows,$cpu);
|
|
}
|
|
else {
|
|
$rows = $cpu;
|
|
}
|
|
}
|
|
else {
|
|
full_output($rows);
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
## OUTPUT HANDLERS ##
|
|
sub full_output {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my $num = 0;
|
|
my ($b_speeds,$core_speeds_value,$cpu);
|
|
my $sleep = $cpu_sleep * 1000000;
|
|
if (my $file = $system_files{'proc-cpuinfo'}){
|
|
$cpu = cpuinfo_data($file);
|
|
}
|
|
elsif ($bsd_type){
|
|
my ($key1,$val1) = ('','');
|
|
if ($alerts{'sysctl'}){
|
|
if ($alerts{'sysctl'}->{'action'} eq 'use'){
|
|
# $key1 = 'Status';
|
|
# $val1 = main::message('dev');
|
|
$cpu = sysctl_data();
|
|
}
|
|
else {
|
|
$key1 = ucfirst($alerts{'sysctl'}->{'action'});
|
|
$val1 = $alerts{'sysctl'}->{'message'};
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1});
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
my $properties = cpu_properties($cpu);
|
|
my $type = ($properties->{'cpu-type'}) ? $properties->{'cpu-type'}: '';
|
|
my $j = scalar @$rows;
|
|
$cpu->{'model_name'} ||= 'N/A';
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Info') => $properties->{'topology-string'},
|
|
main::key($num++,0,2,'model') => $cpu->{'model_name'},
|
|
},);
|
|
if ($cpu->{'system-cpus'}){
|
|
my %system_cpus = %{$cpu->{'system-cpus'}};
|
|
my $i = 1;
|
|
my $counter = (%system_cpus && scalar keys %system_cpus > 1) ? '-' : '';
|
|
foreach my $key (keys %system_cpus){
|
|
$counter = '-' . $i++ if $counter;
|
|
$rows->[$j]{main::key($num++,0,2,'variant'.$counter)} = $key;
|
|
}
|
|
}
|
|
if ($b_admin && $properties->{'socket'}){
|
|
if ($properties->{'upgrade'}){
|
|
$rows->[$j]{main::key($num++,1,2,'socket')} = $properties->{'socket'} . ' (' . $properties->{'upgrade'} . ')';
|
|
$rows->[$j]{main::key($num++,0,3,'note')} = main::message('note-check');
|
|
}
|
|
else {
|
|
$rows->[$j]{main::key($num++,0,2,'socket')} = $properties->{'socket'};
|
|
}
|
|
}
|
|
$properties->{'bits-sys'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'bits')} = $properties->{'bits-sys'};
|
|
if ($type){
|
|
$rows->[$j]{main::key($num++,0,2,'type')} = $type;
|
|
if (!$properties->{'topology-full'} && $cpu->{'smt'} && ($extra > 2 ||
|
|
($extra > 0 && $cpu->{'smt'} eq 'disabled'))){
|
|
$rows->[$j]{main::key($num++,0,2,'smt')} = $cpu->{'smt'};
|
|
}
|
|
}
|
|
if ($extra > 0){
|
|
$cpu->{'arch'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,1,2,'arch')} = $cpu->{'arch'};
|
|
if ($cpu->{'arch-note'}){
|
|
$rows->[$j]{main::key($num++,0,3,'note')} = $cpu->{'arch-note'};
|
|
}
|
|
if ($b_admin && $cpu->{'gen'}){
|
|
$rows->[$j]{main::key($num++,0,3,'gen')} = $cpu->{'gen'};
|
|
}
|
|
if ($b_admin && $properties->{'arch-level'}){
|
|
$rows->[$j]{main::key($num++,1,2,'level')} = $properties->{'arch-level'}[0];
|
|
if ($properties->{'arch-level'}[1]){
|
|
$rows->[$j]{main::key($num++,0,3,'note')} = $properties->{'arch-level'}[1];
|
|
}
|
|
}
|
|
if ($b_admin){
|
|
if ($cpu->{'year'}){
|
|
$rows->[$j]{main::key($num++,0,2,'built')} = $cpu->{'year'};
|
|
}
|
|
if ($cpu->{'process'}){
|
|
$rows->[$j]{main::key($num++,0,2,'process')} = $cpu->{'process'};
|
|
}
|
|
}
|
|
# note: had if arch, but stepping can be defined where arch failed, stepping can be 0
|
|
if (!$b_admin && (defined $cpu->{'stepping'} || defined $cpu->{'revision'})){
|
|
my $rev = main::get_defined($cpu->{'stepping'},$cpu->{'revision'});
|
|
$rows->[$j]{main::key($num++,0,2,'rev')} = $rev;
|
|
}
|
|
}
|
|
if ($b_admin){
|
|
$rows->[$j]{main::key($num++,0,2,'family')} = hex_and_decimal($cpu->{'family'});
|
|
$rows->[$j]{main::key($num++,0,2,'model-id')} = hex_and_decimal($cpu->{'model-id'});
|
|
if (defined $cpu->{'stepping'}){
|
|
$rows->[$j]{main::key($num++,0,2,'stepping')} = hex_and_decimal($cpu->{'stepping'});
|
|
}
|
|
elsif (defined $cpu->{'revision'}){
|
|
$rows->[$j]{main::key($num++,0,2,'rev')} = $cpu->{'revision'};
|
|
}
|
|
if (!%risc && $cpu->{'type'} ne 'elbrus'){
|
|
$cpu->{'microcode'} = ($cpu->{'microcode'}) ? '0x' . $cpu->{'microcode'} : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'microcode')} = $cpu->{'microcode'};
|
|
}
|
|
}
|
|
# note, risc cpus are using l1, L2, L3 more often, but if risc and no L2, skip
|
|
if ($properties->{'topology-string'} && (($extra > 1 &&
|
|
($properties->{'l1-cache'} || $properties->{'l3-cache'})) ||
|
|
(!%risc || $properties->{'l2-cache'}) || $properties->{'cache'})){
|
|
full_output_caches($j,$properties,\$num,$rows);
|
|
}
|
|
# all tests already done to load this, admin, etc
|
|
if ($properties->{'topology-full'}){
|
|
$j = scalar @$rows;
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Topology') => '',
|
|
},);
|
|
my ($id,$var) = (2,'');
|
|
if (scalar @{$properties->{'topology-full'}} > 1){
|
|
$var = 'variant';
|
|
$id = 3;
|
|
}
|
|
foreach my $topo (@{$properties->{'topology-full'}}){
|
|
if ($var){
|
|
$rows->[$j]{main::key($num++,1,2,'variant')} = '';
|
|
}
|
|
my $x = ($size{'max-cols'} == 1 || $output_type ne 'screen') ? '' : 'x';
|
|
$rows->[$j]{main::key($num++,0,$id,'cpus')} = $topo->{'cpus'} . $x;
|
|
$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);
|
|
}
|
|
my $speeds = $cpu->{'processors'};
|
|
my $core_key = (defined $speeds && scalar @{$speeds} > 1) ? 'cores' : 'core';
|
|
my $speed_key = ($properties->{'speed-key'}) ? $properties->{'speed-key'}: 'Speed';
|
|
my $min_max = ($properties->{'min-max'}) ? $properties->{'min-max'}: 'N/A';
|
|
my $min_max_key = ($properties->{'min-max-key'}) ? $properties->{'min-max-key'}: 'min/max';
|
|
my $speed = '';
|
|
if (!$properties->{'avg-speed-key'}){
|
|
$speed = (defined $properties->{'speed'}) ? $properties->{'speed'}: 'N/A';
|
|
}
|
|
# Aren't able to get per core speeds in BSDs. Why don't they support this?
|
|
if (defined $speeds && @$speeds){
|
|
# only if defined and not 0
|
|
if (grep {$_} @{$speeds}){
|
|
$core_speeds_value = '';
|
|
$b_speeds = 1;
|
|
}
|
|
else {
|
|
my $id = ($bsd_type) ? 'cpu-speeds-bsd' : 'cpu-speeds';
|
|
$core_speeds_value = main::message($id);
|
|
}
|
|
}
|
|
else {
|
|
$core_speeds_value = main::message('cpu-speeds');
|
|
}
|
|
$j = scalar @$rows;
|
|
push(@$rows, {
|
|
main::key($num++,1,1,$speed_key) => $speed,
|
|
});
|
|
if ($properties->{'avg-speed-key'}){
|
|
$rows->[$j]{main::key($num++,0,2,$properties->{'avg-speed-key'})} = $properties->{'speed'};
|
|
if ($extra > 0 && $properties->{'high-speed-key'}){
|
|
$rows->[$j]{main::key($num++,0,2,$properties->{'high-speed-key'})} = $cpu->{'high-freq'};
|
|
}
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,$min_max_key)} = $min_max;
|
|
if ($extra > 0 && defined $cpu->{'boost'}){
|
|
$rows->[$j]{main::key($num++,0,2,'boost')} = $cpu->{'boost'};
|
|
}
|
|
if ($b_admin && $properties->{'dmi-speed'} && $properties->{'dmi-max-speed'}){
|
|
$rows->[$j]{main::key($num++,0,2,'base/boost')} = $properties->{'dmi-speed'} . '/' . $properties->{'dmi-max-speed'};
|
|
}
|
|
if ($b_admin && ($cpu->{'governor'} || $cpu->{'scaling-driver'})){
|
|
$rows->[$j]{main::key($num++,1,2,'scaling')} = '';
|
|
$cpu->{'driver'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'driver')} = $cpu->{'scaling-driver'};
|
|
$cpu->{'governor'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'governor')} = $cpu->{'governor'};
|
|
# only set if different from cpu min/max
|
|
if ($cpu->{'scaling-min-max'} && $cpu->{'scaling-min-max-key'}){
|
|
$rows->[$j]{main::key($num++,0,3,$cpu->{'scaling-min-max-key'})} = $cpu->{'scaling-min-max'};
|
|
}
|
|
}
|
|
if ($extra > 2){
|
|
if ($properties->{'volts'}){
|
|
$rows->[$j]{main::key($num++,0,2,'volts')} = $properties->{'volts'} . ' V';
|
|
}
|
|
if ($properties->{'ext-clock'}){
|
|
$rows->[$j]{main::key($num++,0,2,'ext-clock')} = $properties->{'ext-clock'};
|
|
}
|
|
}
|
|
$rows->[$j]{main::key($num++,1,2,$core_key)} = $core_speeds_value;
|
|
my $i = 1;
|
|
# if say 96 0 speed cores, no need to print all those 0s
|
|
if ($b_speeds){
|
|
foreach (@{$speeds}){
|
|
$rows->[$j]{main::key($num++,0,3,$i++)} = $_;
|
|
}
|
|
}
|
|
if ($extra > 0 && !$bsd_type){
|
|
my $bogomips = ($cpu->{'bogomips'} &&
|
|
main::is_numeric($cpu->{'bogomips'})) ? int($cpu->{'bogomips'}) : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'bogomips')} = $bogomips;
|
|
}
|
|
if (($extra > 0 && !$show{'cpu-flag'}) || $show{'cpu-flag'}){
|
|
my @flags = ($cpu->{'flags'}) ? split(/\s+/, $cpu->{'flags'}) : ();
|
|
my $flag_key = (%risc || $bsd_type) ? 'Features': 'Flags';
|
|
my $flag = 'N/A';
|
|
if (!$show{'cpu-flag'}){
|
|
if (@flags){
|
|
# failure to read dmesg.boot: dmesg.boot permissions; then short -Cx list flags
|
|
@flags = grep {/^(dmesg.boot|permissions|avx[2-9]?|ht|lm|nx|pae|pni|(sss|ss)e([2-9])?([a-z])?(_[0-9])?|svm|vmx)$/} @flags;
|
|
@flags = map {s/pni/sse3/; $_} @flags if @flags;
|
|
@flags = sort @flags;
|
|
}
|
|
# only ARM has Features, never seen them for MIPS/PPC/SPARC/RISCV, but check
|
|
if ($risc{'arm'} && $flag eq 'N/A'){
|
|
$flag = main::message('arm-cpu-f');
|
|
}
|
|
}
|
|
if (@flags){
|
|
@flags = sort @flags;
|
|
$flag = join(' ', @flags);
|
|
}
|
|
push(@$rows, {
|
|
main::key($num++,0,1,$flag_key) => $flag,
|
|
},);
|
|
}
|
|
if ($b_admin){
|
|
my $value = '';
|
|
if (!defined $cpu->{'bugs-hash'}){
|
|
if ($cpu->{'bugs-string'}){
|
|
my @proc_bugs = split(/\s+/, $cpu->{'bugs-string'});
|
|
@proc_bugs = sort @proc_bugs;
|
|
$value = join(' ', @proc_bugs);
|
|
}
|
|
else {
|
|
$value = main::message('cpu-bugs-null');
|
|
}
|
|
}
|
|
if ($use{'filter-vulnerabilities'} &&
|
|
(defined $cpu->{'bugs-hash'} || $cpu->{'bugs-string'})){
|
|
$value = $filter_string;
|
|
undef $cpu->{'bugs-hash'};
|
|
}
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Vulnerabilities') => $value,
|
|
},);
|
|
if (defined $cpu->{'bugs-hash'}){
|
|
$j = scalar @$rows;
|
|
foreach my $key (sort keys %{$cpu->{'bugs-hash'}}){
|
|
$rows->[$j]{main::key($num++,1,2,'Type')} = $key;
|
|
$rows->[$j]{main::key($num++,0,3,$cpu->{'bugs-hash'}->{$key}[0])} = $cpu->{'bugs-hash'}->{$key}[1];
|
|
$j++;
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# $num, $rows passed by reference
|
|
sub full_output_caches {
|
|
eval $start if $b_log;
|
|
my ($j,$properties,$num,$rows) = @_;
|
|
my $value = '';
|
|
if (!$properties->{'l1-cache'} && !$properties->{'l2-cache'} &&
|
|
!$properties->{'l3-cache'}){
|
|
$value = ($properties->{'cache'}) ? $properties->{'cache'} : 'N/A';
|
|
}
|
|
$rows->[$j]{main::key($$num++,1,2,'cache')} = $value;
|
|
if ($extra > 0 && $properties->{'l1-cache'}){
|
|
$rows->[$j]{main::key($$num++,2,3,'L1')} = $properties->{'l1-cache'};
|
|
if ($b_admin && ($properties->{'l1d-desc'} || $properties->{'l1i-desc'})){
|
|
my $desc = '';
|
|
if ($properties->{'l1d-desc'}){
|
|
$desc .= 'd-' . $properties->{'l1d-desc'};
|
|
}
|
|
if ($properties->{'l1i-desc'}){
|
|
$desc .= '; ' if $desc;
|
|
$desc .= 'i-' . $properties->{'l1i-desc'};
|
|
}
|
|
$rows->[$j]{main::key($$num++,0,4,'desc')} = $desc;
|
|
}
|
|
}
|
|
# $rows->[$j]{main::key($$num++,1,$l,$key)} = $support;
|
|
if (!$value){
|
|
$properties->{'l2-cache'} = ($properties->{'l2-cache'}) ? $properties->{'l2-cache'} : 'N/A';
|
|
$rows->[$j]{main::key($$num++,1,3,'L2')} = $properties->{'l2-cache'};
|
|
if ($b_admin && $properties->{'l2-desc'}){
|
|
$rows->[$j]{main::key($$num++,0,4,'desc')} = $properties->{'l2-desc'};
|
|
}
|
|
}
|
|
if ($extra > 0 && $properties->{'l3-cache'}){
|
|
$rows->[$j]{main::key($$num++,1,3,'L3')} = $properties->{'l3-cache'};
|
|
if ($b_admin && $properties->{'l3-desc'}){
|
|
$rows->[$j]{main::key($$num++,0,4,'desc')} = $properties->{'l3-desc'};
|
|
}
|
|
}
|
|
if ($properties->{'cache-check'}){
|
|
$rows->[$j]{main::key($$num++,0,3,'note')} = $properties->{'cache-check'};
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub short_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$cpu) = @_;
|
|
my $num = 0;
|
|
$cpu->[1] ||= main::message('cpu-model-null');
|
|
$cpu->[2] ||= 'N/A';
|
|
push(@$rows,{
|
|
main::key($num++,1,1,'Info') => $cpu->[0] . ' ' . $cpu->[1] . ' [' . $cpu->[2] . ']'
|
|
#main::key($num++,0,2,'type') => $cpu->[2],
|
|
});
|
|
if ($extra > 0){
|
|
$rows->[0]{main::key($num++,1,2,'arch')} = $cpu->[8];
|
|
if ($cpu->[9]){
|
|
$rows->[0]{main::key($num++,0,3,'note')} = $cpu->[9];
|
|
}
|
|
}
|
|
my $value = ($cpu->[7]) ? '' : $cpu->[4];
|
|
$rows->[0]{main::key($num++,1,2,$cpu->[3])} = $value;
|
|
if ($cpu->[7]){
|
|
$rows->[0]{main::key($num++,0,3,$cpu->[7])} = $cpu->[4];
|
|
}
|
|
if ($cpu->[6]){
|
|
$rows->[0]{main::key($num++,0,3,$cpu->[5])} = $cpu->[6];
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## SHORT OUTPUT DATA ##
|
|
sub short_data {
|
|
eval $start if $b_log;
|
|
my $num = 0;
|
|
my ($cpu,$data,%speeds);
|
|
my $sys = '/sys/devices/system/cpu/cpufreq/policy0';
|
|
# NOTE: : Permission denied, ie, this is not always readable
|
|
# /sys/devices/system/cpu/cpu0/cpufreq/cpuinfo_cur_freq
|
|
if (my $file = $system_files{'proc-cpuinfo'}){
|
|
$cpu = cpuinfo_data($file);
|
|
}
|
|
elsif ($bsd_type){
|
|
my ($key1,$val1) = ('','');
|
|
if ($alerts{'sysctl'}){
|
|
if ($alerts{'sysctl'}->{'action'} eq 'use'){
|
|
# $key1 = 'Status';
|
|
# $val1 = main::message('dev');
|
|
$cpu = sysctl_data($type);
|
|
}
|
|
else {
|
|
$key1 = ucfirst($alerts{'sysctl'}->{'action'});
|
|
$val1 = $alerts{'sysctl'}->{'message'};
|
|
$data = ({main::key($num++,0,1,$key1) => $val1,});
|
|
return $data;
|
|
}
|
|
}
|
|
}
|
|
# $cpu{'cur-freq'} = $cpu[0]->{'core-id'}[0]{'speed'};
|
|
$data = prep_short_data($cpu);
|
|
eval $end if $b_log;
|
|
return $data;
|
|
}
|
|
|
|
sub prep_short_data {
|
|
eval $start if $b_log;
|
|
my ($cpu_data) = @_;
|
|
my $properties = cpu_properties($cpu_data);
|
|
my ($cpu,$speed_key,$speed,$type) = ('','speed',0,'');
|
|
$cpu = $cpu_data->{'model_name'} if $cpu_data->{'model_name'};
|
|
$type = $properties->{'cpu-type'} if $properties->{'cpu-type'};
|
|
$speed_key = $properties->{'speed-key'} if $properties->{'speed-key'};
|
|
$speed = $properties->{'speed'} if $properties->{'speed'};
|
|
my $result = [
|
|
$properties->{'topology-string'},
|
|
$cpu,
|
|
$type,
|
|
$speed_key,
|
|
$speed,
|
|
$properties->{'min-max-key'},
|
|
$properties->{'min-max'},
|
|
$properties->{'avg-speed-key'},
|
|
];
|
|
if ($extra > 0){
|
|
$cpu_data->{'arch'} ||= 'N/A';
|
|
$result->[8] = $cpu_data->{'arch'};
|
|
$result->[9] = $cpu_data->{'arch-note'};
|
|
}
|
|
eval $end if $b_log;
|
|
return $result;
|
|
}
|
|
|
|
## PRIMARY DATA GENERATORS ##
|
|
sub cpuinfo_data {
|
|
eval $start if $b_log;
|
|
my ($file)= @_;
|
|
my ($cpu,$arch,$note,$temp);
|
|
# has to be set above fake cpu section
|
|
set_cpu_data(\$cpu);
|
|
# 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 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 (-e '/sys/devices/system/cpu/'){
|
|
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}';
|
|
}
|
|
my ($error,$file,$key,%working,%freq,@value);
|
|
foreach (main::globber($glob)){
|
|
next if ! -r $_;
|
|
undef $error;
|
|
# $fh always non null, even on error
|
|
open(my $fh, '<', $_) or $error = $!;
|
|
if (!$error){
|
|
m%/sys/devices/system/cpu/cpu(\d+)/cpufreq/(affected_cpus|(cpuinfo|scaling)_cur_freq)%;
|
|
$key = $1;
|
|
$file = $2;
|
|
chomp(@value = <$fh>);
|
|
close $fh;
|
|
if ($file eq 'affected_cpus'){
|
|
# chomp seems to turn undefined into '', not sure why
|
|
$working{$key}->[0] = $value[0] if $value[0] ne '';
|
|
}
|
|
else {
|
|
$working{$key}->[1] = clean_speed($value[0],'khz');
|
|
}
|
|
}
|
|
}
|
|
if (%working){
|
|
foreach (keys %working){
|
|
$freq{sprintf("%04d",$_)} = $working{$_}->[1] if defined $working{$_}->[0];
|
|
}
|
|
$cpu->{'sys-freq'} = \%freq if %freq;
|
|
}
|
|
}
|
|
cpuinfo_data_grabber($file,\$cpu->{'type'}) if !$loaded{'cpuinfo'};
|
|
$cpu->{'type'} = cpu_vendor($cpu_arch) if $cpu_arch eq 'elbrus'; # already set to lower
|
|
my ($core_count,$proc_count,$speed) = (0,0,0);
|
|
my ($b_block_1) = (1);
|
|
# need to prime for arm cpus, which do not have physical/core ids usually
|
|
# level 0 is phys id, level 1 is die id, level 2 is core id
|
|
# note, there con be a lot of processors, 32 core HT would have 64, for example.
|
|
foreach my $block (@cpuinfo){
|
|
# get the repeated data for CPUs, after assign the dynamic per core data
|
|
next if !$block;
|
|
if ($b_block_1){
|
|
$b_block_1 = 0;
|
|
# this may also kick in for centaur/via types, but no data available, guess
|
|
if (!$cpu->{'type'} && $block->{'vendor_id'}){
|
|
$cpu->{'type'} = cpu_vendor($block->{'vendor_id'});
|
|
}
|
|
# PPC can use 'cpu', MIPS 'cpu model'
|
|
$temp = main::get_defined($block->{'model name'},$block->{'cpu'},
|
|
$block->{'cpu model'});
|
|
if ($temp){
|
|
$cpu->{'model_name'} = $temp;
|
|
$cpu->{'model_name'} = main::clean($cpu->{'model_name'});
|
|
$cpu->{'model_name'} = clean_cpu($cpu->{'model_name'});
|
|
if ($risc{'arm'} || $cpu->{'model_name'} =~ /ARM|AArch/i){
|
|
$cpu->{'type'} = 'arm';
|
|
if ($cpu->{'model_name'} =~ /(.*)\srev\s([\S]+)\s(\(([\S]+)\))?/){
|
|
$cpu->{'model_name'} = $1;
|
|
$cpu->{'stepping'} = $2;
|
|
if ($4){
|
|
$cpu->{'arch'} = $4;
|
|
if ($cpu->{'model_name'} !~ /\Q$cpu->{'arch'}\E/i){
|
|
$cpu->{'model_name'} .= ' ' . $cpu->{'arch'};
|
|
}
|
|
}
|
|
# print "p0:\n";
|
|
}
|
|
}
|
|
elsif ($risc{'mips'} || $cpu->{'model_name'} =~ /mips/i){
|
|
$cpu->{'type'} = 'mips';
|
|
}
|
|
}
|
|
$temp = main::get_defined($block->{'architecture'},
|
|
$block->{'cpu family'},$block->{'cpu architecture'});
|
|
if ($temp){
|
|
if ($temp =~ /^\d+$/){
|
|
# translate integers to hex
|
|
$cpu->{'family'} = uc(sprintf("%x",$temp));
|
|
}
|
|
elsif ($risc{'arm'}){
|
|
$cpu->{'arch'} = $temp;
|
|
}
|
|
}
|
|
# note: stepping and ARM cpu revision are integers
|
|
$temp = main::get_defined($block->{'stepping'},$block->{'cpu revision'});
|
|
# can be 0, but can be 'unknown'
|
|
if (defined $temp ||
|
|
($cpu->{'type'} eq 'elbrus' && defined $block->{'revision'})){
|
|
$temp = $block->{'revision'} if defined $block->{'revision'};
|
|
if ($temp =~ /^\d+$/){
|
|
$cpu->{'stepping'} = uc(sprintf("%x",$temp));
|
|
}
|
|
}
|
|
# PPC revision is a string, but elbrus revision is hex
|
|
elsif (defined $block->{'revision'}){
|
|
$cpu->{'revision'} = $block->{'revision'};
|
|
}
|
|
# this is hex so uc for cpu arch id. raspi 4 has Model rather than Hardware
|
|
if (defined $block->{'model'}){
|
|
# can be 0, but can be 'unknown'
|
|
$cpu->{'model-id'} = uc(sprintf("%x",$block->{'model'}));
|
|
}
|
|
if ($block->{'cpu variant'}){
|
|
$cpu->{'model-id'} = uc($block->{'cpu variant'});
|
|
$cpu->{'model-id'} =~ s/^0X//;
|
|
}
|
|
# this is per cpu, not total if > 1 pys cpus
|
|
if (!$cpu->{'cores'} && $block->{'cpu cores'}){
|
|
$cpu->{'cores'} = $block->{'cpu cores'};
|
|
}
|
|
## this is only for -C full cpu output
|
|
if ($type eq 'full'){
|
|
# note: in cases where only cache is there, don't guess, it can be L1,
|
|
# L2, or L3, but never all of them added togehter, so give up.
|
|
if ($block->{'cache size'} &&
|
|
$block->{'cache size'} =~ /(\d+\s*[KMG])i?B?$/){
|
|
$cpu->{'cache'} = main::translate_size($1);
|
|
}
|
|
if ($block->{'l1 cache size'} &&
|
|
$block->{'l1 cache size'} =~ /(\d+\s*[KMG])i?B?$/){
|
|
$cpu->{'l1-cache'} = main::translate_size($1);
|
|
}
|
|
if ($block->{'l2 cache size'} &&
|
|
$block->{'l2 cache size'} =~ /(\d+\s*[KMG])i?B?$/){
|
|
$cpu->{'l2-cache'} = main::translate_size($1);
|
|
}
|
|
if ($block->{'l3 cache size'} &&
|
|
$block->{'l3 cache size'} =~ /(\d+\s*[KMG])i?B?$/){
|
|
$cpu->{'l3-cache'} = main::translate_size($1);
|
|
}
|
|
$temp = main::get_defined($block->{'flags'} || $block->{'features'});
|
|
if ($temp){
|
|
$cpu->{'flags'} = $temp;
|
|
}
|
|
if ($b_admin){
|
|
# note: not used unless maybe /sys data missing?
|
|
if ($block->{'bugs'}){
|
|
$cpu->{'bugs-string'} = $block->{'bugs'};
|
|
}
|
|
# unlike family and model id, microcode appears to be hex already
|
|
if ($block->{'microcode'}){
|
|
if ($block->{'microcode'} =~ /0x/){
|
|
$cpu->{'microcode'} = uc($block->{'microcode'});
|
|
$cpu->{'microcode'} =~ s/^0X//;
|
|
}
|
|
else {
|
|
$cpu->{'microcode'} = uc(sprintf("%x",$block->{'microcode'}));
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# These occurs in a separate block with E2C3, last in cpuinfo blocks,
|
|
# otherwise per block in E8C variants
|
|
if ($cpu->{'type'} eq 'elbrus' && (!$cpu->{'l1i-cache'} &&
|
|
!$cpu->{'l1d-cache'} && !$cpu->{'l2-cache'} && !$cpu->{'l3-cache'})){
|
|
# note: cache0 is L1i and cache1 L1d. cp_caches_fallback handles
|
|
if ($block->{'cache0'} &&
|
|
$block->{'cache0'} =~ /size\s*=\s*(\d+)K\s/){
|
|
$cpu->{'l1i-cache'} = $1;
|
|
}
|
|
if ($block->{'cache1'} &&
|
|
$block->{'cache1'} =~ /size\s*=\s*(\d+)K\s/){
|
|
$cpu->{'l1d-cache'} = $1;
|
|
}
|
|
if ($block->{'cache2'} &&
|
|
$block->{'cache2'} =~ /size\s*=\s*(\d+)(K|M)\s/){
|
|
$cpu->{'l2-cache'} = ($2 eq 'M') ? ($1*1024) : $1;
|
|
}
|
|
if ($block->{'cache3'} &&
|
|
$block->{'cache3'} =~ /size\s*=\s*(\d+)(K|M)\s/){
|
|
$cpu->{'l3-cache'} = ($2 eq 'M') ? ($1*1024) : $1;
|
|
}
|
|
}
|
|
## Start incrementers
|
|
$temp = main::get_defined($block->{'cpu mhz'},$block->{'clock'});
|
|
if ($temp){
|
|
$speed = clean_speed($temp);
|
|
push(@{$cpu->{'processors'}},$speed);
|
|
}
|
|
# new arm shows bad bogomip value, so don't use it, however, ancient
|
|
# cpus, intel 486, can have super low bogomips, like 33.17
|
|
if ($extra > 0 && $block->{'bogomips'} && ((%risc &&
|
|
$block->{'bogomips'} > 50) || !%risc)){
|
|
$cpu->{'bogomips'} += $block->{'bogomips'};
|
|
}
|
|
# just to get core counts for ARM/MIPS/PPC systems
|
|
if (defined $block->{'processor'} && !$temp){
|
|
if ($block->{'processor'} =~ /^\d+$/){
|
|
push(@{$cpu->{'processors'}},0);
|
|
}
|
|
}
|
|
# note: for alder lake, could vary, depending on if e or p core but we
|
|
# only care aobut the highest value for crude logic here
|
|
if ($block->{'siblings'} &&
|
|
(!$cpu->{'siblings'} || $block->{'siblings'} > $cpu->{'siblings'})){
|
|
$cpu->{'siblings'} = $block->{'siblings'};
|
|
}
|
|
# Ignoring trying to catch dies with $block->{'physical id'},
|
|
# that's too buggy for cpuinfo
|
|
if (defined $block->{'core id'}){
|
|
# https://www.pcworld.com/article/3214635/components-processors/ryzen-threadripper-review-we-test-amds-monster-cpu.html
|
|
my $phys = (defined $block->{'physical id'}) ? $block->{'physical id'}: 0;
|
|
my $die_id = 0;
|
|
if (!grep {$_ eq $block->{'core id'}} @{$cpu->{'ids'}->[$phys][$die_id]}){
|
|
push(@{$cpu->{'ids'}->[$phys][$die_id]},$block->{'core id'});
|
|
}
|
|
}
|
|
}
|
|
undef @cpuinfo; # we're done with it, dump it
|
|
undef %cpuinfo_machine;
|
|
if (%risc){
|
|
if (!$cpu->{'type'}){
|
|
$cpu->{'type'} = $risc{'id'};
|
|
}
|
|
if (!$bsd_type){
|
|
my $system_cpus = system_cpu_name();
|
|
$cpu->{'system-cpus'} = $system_cpus if %$system_cpus;
|
|
}
|
|
}
|
|
main::log_data('dump','%$cpu',$cpu) if $b_log;
|
|
print Data::Dumper::Dumper $cpu if $dbg[8];
|
|
eval $end if $b_log;
|
|
return $cpu;
|
|
}
|
|
|
|
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
|
|
if ($fake{'cpu'}){
|
|
## CPU sys/cpuinfo pairs:
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/android-pocom3-fake-cpuinfo.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/arm-pine64-cpuinfo-1.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/arm-riscyslack2-cpuinfo-1.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/ppc-stuntkidz~cpuinfo.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/riscv-unmatched-2021~cpuinfo-1.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/x86-brickwizard-atom-n270~cpuinfo-1.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/x86-amd-phenom-chrisretusn-cpuinfo-1.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/x86-drgibbon-intel-i7-cpuinfo.txt";
|
|
## ARM/MIPS
|
|
# $file = "$fake_data_dir/cpu/arm/arm-4-core-pinebook-1.txt";
|
|
# $file = "$fake_data_dir/cpu/arm/armv6-single-core-1.txt";
|
|
# $file = "$fake_data_dir/cpu/arm/armv7-dual-core-1.txt";
|
|
# $file = "$fake_data_dir/cpu/arm/armv7-new-format-model-name-single-core.txt";
|
|
# $file = "$fake_data_dir/cpu/arm/arm-2-die-96-core-rk01.txt";
|
|
# $file = "$fake_data_dir/cpu/arm/arm-shevaplug-1.2ghz.txt";
|
|
# $file = "$fake_data_dir/cpu/mips/mips-mainusg-cpuinfo.txt";
|
|
# $file = "$fake_data_dir/cpu/ppc/ppc-debian-ppc64-cpuinfo.txt";
|
|
## x86
|
|
# $file = "$fake_data_dir/cpu/amd/16-core-32-mt-ryzen.txt";
|
|
# $file = "$fake_data_dir/cpu/amd/2-16-core-epyc-abucodonosor.txt";
|
|
# $file = "$fake_data_dir/cpu/amd/2-core-probook-antix.txt";
|
|
# $file = "$fake_data_dir/cpu/amd/4-core-jean-antix.txt";
|
|
# $file = "$fake_data_dir/cpu/amd/4-core-althlon-mjro.txt";
|
|
# $file = "$fake_data_dir/cpu/amd/4-core-apu-vc-box.txt";
|
|
# $file = "$fake_data_dir/cpu/amd/4-core-a10-5800k-1.txt";
|
|
# $file = "$fake_data_dir/cpu/intel/1-core-486-fourtysixandtwo.txt";
|
|
# $file = "$fake_data_dir/cpu/intel/2-core-ht-atom-bruh.txt";
|
|
# $file = "$fake_data_dir/cpu/intel/core-2-i3.txt";
|
|
# $file = "$fake_data_dir/cpu/intel/8-core-i7-damentz64.txt";
|
|
# $file = "$fake_data_dir/cpu/intel/2-10-core-xeon-ht.txt";
|
|
# $file = "$fake_data_dir/cpu/intel/4-core-xeon-fake-dual-die-zyanya.txt";
|
|
# $file = "$fake_data_dir/cpu/intel/2-core-i5-fake-dual-die-hek.txt";
|
|
# $file = "$fake_data_dir/cpu/intel/2-1-core-xeon-vm-vs2017.txt";
|
|
# $file = "$fake_data_dir/cpu/intel/4-1-core-xeon-vps-frodo1.txt";
|
|
# $file = "$fake_data_dir/cpu/intel/4-6-core-xeon-no-mt-lathander.txt";
|
|
## Elbrus
|
|
# $cpu_type = 'elbrus'; # uncomment to test elbrus
|
|
# $file = "$fake_data_dir/cpu/elbrus/elbrus-2c3/cpuinfo.txt";
|
|
# $file = "$fake_data_dir/cpu/elbrus/1xE1C-8.txt";
|
|
# $file = "$fake_data_dir/cpu/elbrus/1xE2CDSP-4.txt";
|
|
# $file = "$fake_data_dir/cpu/elbrus/1xE2S4-3-monocub.txt";
|
|
# $file = "$fake_data_dir/cpu/elbrus/1xMBE8C-7.txt";
|
|
# $file = "$fake_data_dir/cpu/elbrus/4xEL2S4-3.txt";
|
|
# $file = "$fake_data_dir/cpu/elbrus/4xE8C-7.txt";
|
|
# $file = "$fake_data_dir/cpu/elbrus/4xE2CDSP-4.txt";
|
|
# $file = "$fake_data_dir/cpu/elbrus/cpuinfo.e8c2.txt";
|
|
}
|
|
my $raw = main::reader($file,'','ref');
|
|
@$raw = map {$_ =~ s/^\s*$/~~~/;$_;} @$raw;
|
|
push(@$raw,'~~~') if @$raw;
|
|
my ($b_processor,$key,$value);
|
|
my ($i) = (0);
|
|
my @key_tests = ('firmware','hardware','mmu','model','motherboard',
|
|
'platform','system type','timebase');
|
|
foreach my $row (@$raw){
|
|
($key,$value) = split(/\s*:\s*/,$row,2);
|
|
next if !defined $key;
|
|
# ARM: 'Hardware' can appear in processor block; system type (mips)
|
|
# ARM: CPU revision; machine: Revision/PPC: revision (CPU implied)
|
|
# orangepi3 has Hardware/Processor embedded in processor block
|
|
if (%risc && ((grep {lc($key) eq $_} @key_tests) ||
|
|
(!$risc{'ppc'} && lc($key) eq 'revision'))){
|
|
$b_processor = 0;
|
|
}
|
|
else {
|
|
$b_processor = 1;
|
|
}
|
|
if ($b_processor){
|
|
if ($key eq '~~~'){
|
|
$i++;
|
|
next;
|
|
}
|
|
# A small handful of ARM devices use Processor instead of 'model name'
|
|
# Processor : AArch64 Processor rev 4 (aarch64)
|
|
# Processor : Feroceon 88FR131 rev 1 (v5l)
|
|
$key = ($key eq 'Processor') ? 'model name' : lc($key);
|
|
$cpuinfo[$i]->{$key} = $value;
|
|
}
|
|
else {
|
|
next if $cpuinfo_machine{lc($key)};
|
|
$cpuinfo_machine{lc($key)} = $value;
|
|
}
|
|
}
|
|
if ($b_log){
|
|
main::log_data('dump','@cpuinfo',\@cpuinfo);
|
|
main::log_data('dump','%cpuinfo_machine',\%cpuinfo_machine);
|
|
}
|
|
if ($dbg[41]){
|
|
print Data::Dumper::Dumper \@cpuinfo;
|
|
print Data::Dumper::Dumper \%cpuinfo_machine;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub 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'){
|
|
$speed = clean_speed($cpu->{'cpufreq'}{'scaling_cur_freq'},'khz');
|
|
}
|
|
}
|
|
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'});
|
|
}
|
|
}
|
|
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 (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'});
|
|
}
|
|
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'});
|
|
}
|
|
}
|
|
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'});
|
|
}
|
|
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 (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 (defined $cpu->{'cpufreq'}{'scaling_driver'}){
|
|
$cpu_sys->{'cpus'}{$phys_id}{'scaling-driver'} = $cpu->{'cpufreq'}{'scaling_driver'};
|
|
}
|
|
}
|
|
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'};
|
|
}
|
|
# 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);
|
|
}
|
|
}
|
|
}
|
|
if (defined $cpu_sys->{'data'}{'cpufreq-boost'} &&
|
|
$cpu_sys->{'data'}{'cpufreq-boost'} =~ /^[01]$/){
|
|
if ($cpu_sys->{'data'}{'cpufreq-boost'}){
|
|
$cpu_sys->{'data'}{'cpufreq-boost'} = 'enabled';
|
|
}
|
|
else {
|
|
$cpu_sys->{'data'}{'cpufreq-boost'} = 'disabled';
|
|
}
|
|
}
|
|
# cpuinfo_max_freq:["2000000"] cpuinfo_max_freq:["1500000"]
|
|
# cpuinfo_min_freq:["200000"]
|
|
if (@ci_freq_max){
|
|
$cpu_sys->{'data'}{'speeds'}{'max-freq'} = join(':',@ci_freq_max);
|
|
}
|
|
if (@ci_freq_min){
|
|
$cpu_sys->{'data'}{'speeds'}{'min-freq'} = join(':',@ci_freq_min);
|
|
}
|
|
# also handle off chance that cpuinfo_min/max not set, but scaling_min/max there
|
|
if (@sc_freq_max){
|
|
$cpu_sys->{'data'}{'speeds'}{'scaling-max-freq'} = join(':',@sc_freq_max);
|
|
if (!$cpu_sys->{'data'}{'speeds'}{'max-freq'}){
|
|
$cpu_sys->{'data'}{'speeds'}{'max-freq'} = $cpu_sys->{'data'}{'speeds'}{'scaling-max-freq'};
|
|
}
|
|
}
|
|
if (@sc_freq_min){
|
|
$cpu_sys->{'data'}{'speeds'}{'scaling-min-freq'} = join(':',@sc_freq_min);
|
|
if (!$cpu_sys->{'data'}{'speeds'}{'min-freq'}){
|
|
$cpu_sys->{'data'}{'speeds'}{'min-freq'} = $cpu_sys->{'data'}{'speeds'}{'scaling-min-freq'};
|
|
}
|
|
}
|
|
# this corrects a bug we see sometimes in min/max frequencies
|
|
if ((scalar @ci_freq_max < 2 && scalar @ci_freq_min < 2) &&
|
|
(defined $cpu_sys->{'data'}{'speeds'}{'min-freq'} &&
|
|
defined $cpu_sys->{'data'}{'speeds'}{'max-freq'}) &&
|
|
($cpu_sys->{'data'}{'speeds'}{'min-freq'} > $cpu_sys->{'data'}{'speeds'}{'max-freq'} ||
|
|
$cpu_sys->{'data'}{'speeds'}{'min-freq'} == $cpu_sys->{'data'}{'speeds'}{'max-freq'})){
|
|
$cpu_sys->{'data'}{'speeds'}{'min-freq'} = 0;
|
|
}
|
|
main::log_data('dump','%$cpu_sys',$cpu_sys) if $b_log;
|
|
print 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);
|
|
# this data has to match the data in cpuinfo grabber fake cpu, and remember
|
|
# to use --arm flag if arm tests
|
|
if ($fake{'cpu'}){
|
|
# my $file;
|
|
## CPU sys/cpuinfo pairs:
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/android-pocom3-fake-sys.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/arm-pine64-sys-1.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/arm-riscyslack2-sys-1.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/ppc-stuntkidz~sys.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/riscv-unmatched-2021~sys-1.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/x86-brickwizard-atom-n270~sys-1.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/x86-amd-phenom-chrisretusn-sys-1.txt";
|
|
# $file = "$fake_data_dir/cpu/sys-ci-pairs/x86-drgibbon-intel-i7-sys.txt";
|
|
# @files = main::reader($file);
|
|
}
|
|
# There's a massive time hit reading full globbed set of files, so grab and
|
|
# read only what we need.
|
|
else {
|
|
my $glob = '/sys/devices/system/cpu/{';
|
|
if ($dbg[43]){
|
|
$glob .= 'cpufreq,cpu*/topology,cpu*/cpufreq,cpu*/cache/index*,smt,vulnerabilities}/*';
|
|
}
|
|
else {
|
|
$glob .= 'cpu*/topology/{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 .= '}';
|
|
}
|
|
@files = main::globber($glob);
|
|
}
|
|
main::log_data('dump','@files',\@files) if $b_log;
|
|
print Data::Dumper::Dumper \@files if $dbg[40];
|
|
my ($b_bug,$b_cache,$b_freq,$b_topo,$b_main);
|
|
my $working = {};
|
|
my ($main_id,$main_key,$holder,$id,$item,$key) = ('','','','','','');
|
|
# need to return hash reference on failure or old systems complain
|
|
return $working if !@files;
|
|
foreach (sort @files){
|
|
if ($fake{'cpu'}){
|
|
($_,$item) = split(/::/,$_,2);
|
|
}
|
|
else {
|
|
next if -d $_ || ! -e $_;
|
|
undef $item;
|
|
}
|
|
$key = $_;
|
|
$key =~ m|/([^/]+)/([^/]+)$|;
|
|
my ($key_1,$key_2) = ($1,$2);
|
|
if (m|/cpu(\d+)/|){
|
|
if (!$holder || $1 ne $holder){
|
|
$id = sprintf("%04d",$1);
|
|
$holder = $1;
|
|
}
|
|
$b_bug = 0;
|
|
$b_cache = 0;
|
|
$b_freq = 0;
|
|
$b_main = 0;
|
|
$b_topo = 0;
|
|
if ($key_1 eq 'cpufreq'){
|
|
$b_freq = 1;
|
|
$main_key = $key_2;
|
|
$key = $key_1;
|
|
}
|
|
elsif ($key_1 eq 'topology'){
|
|
$b_topo = 1;
|
|
$main_key = $key_2;
|
|
$key = $key_1;
|
|
}
|
|
elsif ($key_1 =~ /^index(\d+)$/){
|
|
$b_cache = 1;
|
|
$main_key = $key_2;
|
|
$main_id = sprintf("%02d",$1);
|
|
$key = 'cache';
|
|
}
|
|
}
|
|
elsif ($key_1 eq 'vulnerabilities'){
|
|
$id = $key_1;
|
|
$key = $key_2;
|
|
$b_bug = 1;
|
|
$b_cache = 0;
|
|
$b_main = 0;
|
|
$b_freq = 0;
|
|
$b_topo = 0;
|
|
$main_key = '';
|
|
$main_id = '';
|
|
}
|
|
else {
|
|
$id = $key_1 . '-' . $key_2;
|
|
$b_bug = 0;
|
|
$b_cache = 0;
|
|
$b_main = 1;
|
|
$b_freq = 0;
|
|
$b_topo = 0;
|
|
$main_key = '';
|
|
$main_id = '';
|
|
}
|
|
if (!$fake{'cpu'}){
|
|
if (-r $_) {
|
|
my $error;
|
|
# significantly faster to skip reader() and do it directly
|
|
# $fh always non null, even on error
|
|
open(my $fh, '<', $_) or $error = $!;
|
|
if (!$error){
|
|
chomp(my @value = <$fh>);
|
|
close $fh;
|
|
$item = $value[0];
|
|
}
|
|
# $item = main::reader($_,'strip',0);
|
|
}
|
|
else {
|
|
$item = main::message('root-required');
|
|
}
|
|
$item = main::message('undefined') if !defined $item;
|
|
}
|
|
# print "$key_1 :: $key_2 :: $item\n";
|
|
if ($b_main){
|
|
$working->{'data'}{$id} = $item;
|
|
}
|
|
elsif ($b_bug){
|
|
my $type = ($item =~ /^Mitigation:/) ? 'mitigation': 'status';
|
|
$item =~ s/Mitigation: //;
|
|
$working->{'data'}{$id}{$key} = [$type,$item];
|
|
}
|
|
elsif ($b_cache){
|
|
$working->{'cpus'}{$id}{$key}{$main_id}{$main_key} = $item;
|
|
}
|
|
elsif ($b_freq || $b_topo){
|
|
$working->{'cpus'}{$id}{$key}{$main_key} = $item;
|
|
}
|
|
}
|
|
main::log_data('dump','%$working',$working) if $b_log;
|
|
print Data::Dumper::Dumper $working if $dbg[39];
|
|
eval $end if $b_log;
|
|
return $working;
|
|
}
|
|
|
|
sub sysctl_data {
|
|
eval $start if $b_log;
|
|
my ($cpu,@line,%speeds,@working);
|
|
my ($sep) = ('');
|
|
my ($die_holder,$die_id,$phys_holder,$phys_id,$proc_count,$speed) = (0,0,0,0,0,0,0);
|
|
set_cpu_data(\$cpu);
|
|
@{$sysctl{'cpu'}} = () if !$sysctl{'cpu'}; # don't want error next!
|
|
foreach (@{$sysctl{'cpu'}}){
|
|
@line = split(/\s*:\s*/, $_);
|
|
next if !$line[0];
|
|
# darwin shows machine, like MacBook7,1, not cpu
|
|
# machdep.cpu.brand_string: Intel(R) Core(TM)2 Duo CPU P8600 @ 2.40GHz
|
|
if (($bsd_type ne 'darwin' && $line[0] eq 'hw.model') ||
|
|
$line[0] eq 'machdep.cpu.brand_string'){
|
|
# cut L2 cache/cpu max speed out of model string, if available
|
|
# openbsd 5.6: AMD Sempron(tm) Processor 3400+ ("AuthenticAMD" 686-class, 256KB L2 cache)
|
|
# openbsd 6.x has Lx cache data in dmesg.boot
|
|
# freebsd 10: hw.model: AMD Athlon(tm) II X2 245 Processor
|
|
$line[1] = main::clean($line[1]);
|
|
$line[1] = clean_cpu($line[1]);
|
|
if ($line[1] =~ /([0-9]+)[\s-]*([KM]B)\s+L2 cache/i){
|
|
my $multiplier = ($2 eq 'MB') ? 1024: 1;
|
|
$cpu->{'l2-cache'} = $1 * $multiplier;
|
|
}
|
|
if ($line[1] =~ /([^0-9\.][0-9\.]+)[\s-]*[MG]Hz/){
|
|
$cpu->{'max-freq'} = $1;
|
|
if ($cpu->{'max-freq'} =~ /MHz/i){
|
|
$cpu->{'max-freq'} =~ s/[\s-]*MHz//;
|
|
$cpu->{'max-freq'} = clean_speed($cpu->{'max-freq'},'mhz');
|
|
}
|
|
elsif ($cpu->{'max-freq'} =~ /GHz/){
|
|
$cpu->{'max-freq'} =~ s/[\s-]*GHz//i;
|
|
$cpu->{'max-freq'} = $cpu->{'max-freq'} / 1000;
|
|
$cpu->{'max-freq'} = clean_speed($cpu->{'max-freq'},'mhz');
|
|
}
|
|
}
|
|
if ($line[1] =~ /\)$/){
|
|
$line[1] =~ s/\s*\(.*\)$//;
|
|
}
|
|
$cpu->{'model_name'} = $line[1];
|
|
$cpu->{'type'} = cpu_vendor($line[1]);
|
|
}
|
|
# NOTE: hw.l1icachesize: hw.l1dcachesize: ; in bytes, apparently
|
|
elsif ($line[0] eq 'hw.l1dcachesize'){
|
|
$cpu->{'l1d-cache'} = $line[1]/1024;
|
|
}
|
|
elsif ($line[0] eq 'hw.l1icachesize'){
|
|
$cpu->{'l1i-cache'} = $line[1]/1024;
|
|
}
|
|
elsif ($line[0] eq 'hw.l2cachesize'){
|
|
$cpu->{'l2-cache'} = $line[1]/1024;
|
|
}
|
|
elsif ($line[0] eq 'hw.l3cachesize'){
|
|
$cpu->{'l3-cache'} = $line[1]/1024;
|
|
}
|
|
# hw.smt: openbsd
|
|
elsif ($line[0] eq 'hw.smt'){
|
|
$cpu->{'smt'} = ($line[1]) ? 'enabled' : 'disabled';
|
|
}
|
|
# htl: maybe freebsd, never seen, 1 is disabled, sigh...
|
|
elsif ($line[0] eq 'machdep.hlt_logical_cpus'){
|
|
$cpu->{'smt'} = ($line[1]) ? 'disabled' : 'enabled';
|
|
}
|
|
# this is in mghz in samples
|
|
elsif (!$cpu->{'cur-freq'} &&
|
|
($line[0] eq 'hw.clockrate' || $line[0] eq 'hw.cpuspeed')){
|
|
$cpu->{'cur-freq'} = $line[1];
|
|
}
|
|
# these are in hz: 2400000000
|
|
elsif ($line[0] eq 'hw.cpufrequency'){
|
|
$cpu->{'cur-freq'} = $line[1]/1000000;
|
|
}
|
|
elsif ($line[0] eq 'hw.busfrequency_min'){
|
|
$cpu->{'min-freq'} = $line[1]/1000000;
|
|
}
|
|
elsif ($line[0] eq 'hw.busfrequency_max'){
|
|
$cpu->{'max-freq'} = $line[1]/1000000;
|
|
}
|
|
# FB seems to call freq something other than clock speed, unreliable
|
|
# eg: 1500 Mhz real shows as 2400 freq, which is wrong
|
|
# elsif ($line[0] =~ /^dev\.cpu\.([0-9]+)\.freq$/){
|
|
# $speed = clean_speed($line[1]);
|
|
# $cpu->{'processors'}->[$1] = $speed;
|
|
# }
|
|
# weird FB thing, freq can be wrong, so just count the cores and call it
|
|
# done.
|
|
elsif ($line[0] =~ /^dev\.cpu\.([0-9]+)\./ &&
|
|
(!$cpu->{'processors'} || !defined $cpu->{'processors'}->[$1])){
|
|
$cpu->{'processors'}->[$1] = undef;
|
|
}
|
|
elsif ($line[0] eq 'machdep.cpu.vendor'){
|
|
$cpu->{'type'} = cpu_vendor($line[1]);
|
|
}
|
|
# darwin only?
|
|
elsif ($line[0] eq 'machdep.cpu.features'){
|
|
$cpu->{'flags'} = lc($line[1]);
|
|
}
|
|
# is this per phys or total?
|
|
elsif ($line[0] eq 'hw.ncpu'){
|
|
$cpu->{'cores'} = $line[1];
|
|
}
|
|
# Freebsd does some voltage hacking to actually run at lowest listed
|
|
# frequencies. The cpu does not actually support all the speeds output
|
|
# here but works in freebsd. Disabled this, the freq appear to refer to
|
|
# something else, not cpu clock. Remove XXX to enable
|
|
elsif ($line[0] eq 'dev.cpu.0.freq_levelsXXX'){
|
|
$line[1] =~ s/^\s+|\/[0-9]+|\s+$//g;
|
|
if ($line[1] =~ /[0-9]+\s+[0-9]+/){
|
|
# get rid of -1 in FB: 2400/-1 2200/-1 2000/-1 1800/-1
|
|
$line[1] =~ s|/-1||g;
|
|
my @temp = split(/\s+/, $line[1]);
|
|
$cpu->{'max-freq'} = $temp[0];
|
|
$cpu->{'min-freq'} = $temp[-1];
|
|
$cpu->{'scalings'} = \@temp;
|
|
}
|
|
}
|
|
# Disabled w/XXX. this is almost certainly bad data, should not be used
|
|
elsif (!$cpu->{'cur-freq'} && $line[0] eq 'dev.cpu.0.freqXXX'){
|
|
$cpu->{'cur-freq'} = $line[1];
|
|
}
|
|
# the following have only been seen in DragonflyBSD data but thumbs up!
|
|
elsif ($line[0] eq 'hw.cpu_topology.members'){
|
|
my @temp = split(/\s+/, $line[1]);
|
|
my $count = scalar @temp;
|
|
$count-- if $count > 0;
|
|
# no way to get per processor speeds yet, so assign 0 to each
|
|
foreach (0 .. $count){
|
|
$cpu->{'processors'}->[$_] = 0;
|
|
}
|
|
}
|
|
elsif ($line[0] eq 'hw.cpu_topology.cpu1.physical_siblings'){
|
|
# string, like: cpu0 cpu1
|
|
my @temp = split(/\s+/, $line[1]);
|
|
$cpu->{'siblings'} = scalar @temp;
|
|
}
|
|
# increment by 1 for every new physical id we see. These are in almost all
|
|
# cases separate cpus, not separate dies within a single cpu body.
|
|
# This needs DATA!! Almost certainly wrong!!
|
|
elsif ($line[0] eq 'hw.cpu_topology.cpu0.physical_id'){
|
|
if ($phys_holder != $line[1]){
|
|
$phys_id++;
|
|
$phys_holder = $line[1];
|
|
push(@{$cpu->{'ids'}->[$phys_id][$die_id]},0);
|
|
}
|
|
}
|
|
elsif ($line[0] eq 'hw.cpu_topology.cpu0.core_id'){
|
|
$cpu->{'ids'}->[$phys_id][$line[1]] = $speed;
|
|
}
|
|
}
|
|
if (!$cpu->{'flags'} || !$cpu->{'family'}){
|
|
my $dmesg_boot = 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;
|
|
}
|
|
|
|
## 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 (/^~Origin:(.+?)[\s,]+(Id|Family|Model|Stepping)/){
|
|
$type = cpu_vendor($1);
|
|
if (/\bId\s*=\s*(0x)?([0-9a-f]+)\b/){
|
|
$microcode = ($1) ? uc($2) : $2;
|
|
}
|
|
if (/\bFamily\s*=\s*(0x)?([a-f0-9]+)\b/){
|
|
$family = ($1) ? uc($2) : $2;
|
|
}
|
|
if (/\bModel\s*=\s*(0x)?([a-f0-9]+)\b/){
|
|
$model = ($1) ? uc($2) : $2;
|
|
}
|
|
# they don't seem to use hex for steppings, so convert it
|
|
if (/\bStepping\s*=\s*(0x)?([0-9a-f]+)\b/){
|
|
$stepping = (!$1) ? uc(sprintf("%X",$2)) : $2;
|
|
}
|
|
}
|
|
elsif (/^cpu0:.*?[0-9\.]+\s?MHz:\sspeeds:\s(.*?)\s?MHz/){
|
|
@scalings = split(/[,\s]+/,$1);
|
|
$min_freq = $scalings[-1];
|
|
$max_freq = $scalings[0];
|
|
}
|
|
# 2 core MT Intel Core/Rzyen similar, use smt 0 as trigger to count:
|
|
# cpu2:smt 0, core 1, package 0
|
|
# cpu3:smt 1, core 1, package 0
|
|
## but: older AMD Athlon 2 core:
|
|
# cpu0:smt 0, core 0, package 0
|
|
# cpu0:smt 0, core 0, package 1
|
|
elsif (/cpu([0-9]+):smt\s([0-9]+),\score\s([0-9]+)(,\spackage\s([0-9]+))?/){
|
|
$siblings = $1 + 1;
|
|
$cores += 1 if $2 == 0;
|
|
}
|
|
}
|
|
if ($flags){
|
|
$flags =~ s/\s+/ /g;
|
|
$flags =~ s/^\s+|\s+$//g;
|
|
}
|
|
}
|
|
else {
|
|
if ($file && ! -r $file){
|
|
$flags = main::message('dmesg-boot-permissions');
|
|
}
|
|
}
|
|
my $values = {
|
|
'cores' => $cores,
|
|
'family' => $family,
|
|
'flags' => $flags,
|
|
'l1d-cache' => $l1d,
|
|
'l1i-cache' => $l1i,
|
|
'l2-cache' => $l2,
|
|
'l3-cache' => $l3,
|
|
'max-freq' => $max_freq,
|
|
'microcode' => $microcode,
|
|
'min-freq' => $min_freq,
|
|
'model-id' => $model,
|
|
'scalings' => \@scalings,
|
|
'siblings' => $siblings,
|
|
'stepping' => $stepping,
|
|
'type' => $type,
|
|
};
|
|
print Data::Dumper::Dumper $values if $dbg[27];
|
|
eval $end if $b_log;
|
|
return $values;
|
|
}
|
|
|
|
sub dmidecode_data {
|
|
eval $start if $b_log;
|
|
my $dmi_data = {'L1' => 0, 'L2' => 0,'L3' => 0, 'phys-cnt' => 0,
|
|
'ext-clock' => undef, 'socket' => undef, 'speed' => undef,
|
|
'max-speed' => undef, 'upgrade' => undef, 'volts' => undef};
|
|
return $dmi_data if !@dmi;
|
|
my ($id,$amount,$socket,$upgrade);
|
|
foreach my $item (@dmi){
|
|
next if ref $item ne 'ARRAY';
|
|
next if ($item->[0] < 4 || $item->[0] == 5 || $item->[0] == 6);
|
|
last if $item->[0] > 7;
|
|
if ($item->[0] == 7){
|
|
# skip first three rows, we don't need that data
|
|
# seen very bad data, L2 labeled L3, and random phantom type 7 caches
|
|
($id,$amount) = ('',0);
|
|
# Configuration: Disabled, Not Socketed, Level 2
|
|
next if $item->[4] =~ /^Configuration:.*Disabled/i;
|
|
# labels have to be right before the block, otherwise exiting sub errors
|
|
DMI:
|
|
foreach my $value (@$item[3 .. $#$item]){
|
|
next if $value =~ /^~/;
|
|
# variants: L3 - Cache; L3 Cache; L3-cache; L2 CACHE; CPU Internal L1
|
|
if ($value =~ /^Socket Designation:.*? (L[1-3])\b/){
|
|
$id = lc($1);
|
|
}
|
|
# some cpus only show Socket Designation: Internal cache
|
|
elsif (!$id && $value =~ /^Configuration:.* Level.*?([1-3])\b/){
|
|
if ($value !~ /Disabled/i){
|
|
$id = "l$1";
|
|
}
|
|
}
|
|
# NOTE: cache is in KiB or MiB but they call it kB or MB
|
|
# so we send translate_size k or M which trips KiB/MiB mode
|
|
# if disabled can be 0.
|
|
elsif ($id && $value =~ /^Installed Size:\s+(.*?[kKM])i?B$/){
|
|
# Config..Disabled test should have gotten this, but just in case 0 size
|
|
next DMI if !$1;
|
|
$amount = main::translate_size($1);
|
|
}
|
|
if ($id && $amount){
|
|
$dmi_data->{$id} = $amount;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
# note: for multi cpu systems, we're hoping that these values are
|
|
# the same for each cpu, which in most pc situations they will be,
|
|
# and most ARM etc won't be using dmi data here anyway.
|
|
# Older dmidecode appear to have unreliable Upgrade outputs
|
|
elsif ($item->[0] == 4){
|
|
# skip first three row,s we don't need that data
|
|
($socket,$upgrade) = ();
|
|
$dmi_data->{'phys-cnt'}++; # try to catch bsds without physical cpu count
|
|
foreach my $value (@$item[3 .. $#$item]){
|
|
next if $value =~ /^~/;
|
|
# note: on single cpu systems, Socket Designation shows socket type,
|
|
# but on multi, shows like, CPU1; CPU Socket #2; Socket 0; so check values a bit.
|
|
# Socket Designation: Intel(R) Core(TM) i5-3470 CPU @ 3.20GHz
|
|
# Sometimes shows as CPU Socket...
|
|
if ($value =~ /^Socket Designation:\s*(CPU\s*Socket|Socket)?[\s-]*(.*)$/i){
|
|
$upgrade = main::clean_dmi($2) if $2 !~ /(cpu|[mg]hz|onboard|socket|@|^#?[0-9]$)/i;
|
|
# print "$socket_temp\n";
|
|
}
|
|
# normally we prefer this value, but sometimes it's garbage
|
|
# older systems often show: Upgrade: ZIF Socket which is a generic term, legacy
|
|
elsif ($value =~ /^Upgrade:\s*(CPU\s*Socket|Socket)?[\s-]*(.*)$/i){
|
|
# print "$2\n";
|
|
$socket = main::clean_dmi($2) if $2 !~ /(ZIF|\bslot\b)/i;
|
|
}
|
|
# seen: Voltage: 5.0 V 2.9 V
|
|
elsif ($value =~ /^Voltage:\s*([0-9\.]+)\s*(V|Volts)?\b/i){
|
|
$dmi_data->{'volts'} = main::clean_dmi($1);
|
|
}
|
|
elsif ($value =~ /^Current Speed:\s*([0-9\.]+)\s*([MGK]Hz)?\b/i){
|
|
$dmi_data->{'speed'} = main::clean_dmi($1);
|
|
}
|
|
elsif ($value =~ /^Max Speed:\s*([0-9\.]+)\s*([MGK]Hz)?\b/i){
|
|
$dmi_data->{'max-speed'} = main::clean_dmi($1);
|
|
}
|
|
elsif ($value =~ /^External Clock:\s*([0-9\.]+\s*[MGK]Hz)\b/){
|
|
$dmi_data->{'ext-clock'} = main::clean_dmi($1);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# Seen older cases where Upgrade: Other value exists
|
|
if ($socket || $upgrade){
|
|
if ($socket && $upgrade){
|
|
undef $upgrade if $socket eq $upgrade;
|
|
}
|
|
elsif ($upgrade){
|
|
$socket = $upgrade;
|
|
undef $upgrade;
|
|
}
|
|
$dmi_data->{'socket'} = $socket;
|
|
$dmi_data->{'upgrade'} = $upgrade;
|
|
}
|
|
main::log_data('dump','%$dmi_data',$dmi_data) if $b_log;
|
|
print Data::Dumper::Dumper $dmi_data if $dbg[27];
|
|
eval $end if $b_log;
|
|
return $dmi_data;
|
|
}
|
|
|
|
## 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'});
|
|
}
|
|
}
|
|
## 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 $_;
|
|
}
|
|
}
|
|
# 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";
|
|
}
|
|
}
|
|
# 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'};
|
|
}
|
|
else {
|
|
$cpu->{'dies'} = $counts->{'dies'};
|
|
}
|
|
}
|
|
# this is an attempt to fix the amd family 15 bug with reported cores vs actual cores
|
|
# NOTE: amd A6-4400M APU 2 core reports: cores: 1 siblings: 2
|
|
# NOTE: AMD A10-5800K APU 4 core reports: cores: 2 siblings: 4
|
|
if (!$counts->{'cpu-cores'}){
|
|
if ($cpu->{'cores'} && !$counts->{'cores'} ||
|
|
$cpu->{'cores'} >= $counts->{'cores'}){
|
|
$counts->{'cpu-cores'} = $cpu->{'cores'};
|
|
}
|
|
elsif ($counts->{'cores'} > $cpu->{'cores'}){
|
|
$counts->{'cpu-cores'} = $counts->{'cores'};
|
|
}
|
|
}
|
|
# print "cpu-c:$counts->{'cpu-cores'}\n";
|
|
# $counts->{'cpu-cores'} = $cpu->{'cores'};
|
|
# like, intel core duo
|
|
# NOTE: sadly, not all core intel are HT/MT, oh well...
|
|
# xeon may show wrong core / physical id count, if it does, fix it. A xeon
|
|
# may show a repeated core id : 0 which gives a fake num_of_cores=1
|
|
if ($tests->{'intel'}){
|
|
if ($cpu->{'siblings'} && $cpu->{'siblings'} > 1 &&
|
|
$cpu->{'cores'} && $cpu->{'cores'} > 1){
|
|
if ($cpu->{'siblings'}/$cpu->{'cores'} == 1){
|
|
$tests->{'intel'} = 0;
|
|
$tests->{'ht'} = 0;
|
|
}
|
|
else {
|
|
$counts->{'cpu-cores'} = ($cpu->{'siblings'}/2);
|
|
$tests->{'ht'} = 1;
|
|
}
|
|
}
|
|
}
|
|
# ryzen is made out of blocks of 2, 4, or 8 core dies...
|
|
if ($tests->{'ryzen'}){
|
|
$counts->{'cpu-cores'} = $cpu->{'cores'};
|
|
# note: posix ceil isn't present in Perl for some reason, deprecated?
|
|
my $working = $counts->{'cpu-cores'} / 8;
|
|
my @temp = split('\.', $working);
|
|
$cpu->{'dies'} = ($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;
|
|
}
|
|
}
|
|
# 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;
|
|
}
|
|
|
|
# all values passed by reference so no need for returns
|
|
sub cp_data_sys {
|
|
eval $start if $b_log;
|
|
my ($cpu,$cpu_sys,$caches,$counts) = @_;
|
|
my (@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','');
|
|
}
|
|
if ($cpu_sys->{'data'}{'speeds'}{'all'}){
|
|
$counts->{'processors'} = scalar @{$cpu_sys->{'data'}{'speeds'}{'all'}};
|
|
}
|
|
if (defined $cpu_sys->{'data'}{'smt-active'}){
|
|
if ($cpu_sys->{'data'}{'smt-active'}){
|
|
$cpu->{'smt'} = 'enabled';
|
|
}
|
|
# values: on/off/notsupported/notimplemented
|
|
elsif (defined $cpu_sys->{'data'}{'smt-control'} &&
|
|
$cpu_sys->{'data'}{'smt-control'} =~ /^not/){
|
|
$cpu->{'smt'} = main::message('unsupported');
|
|
}
|
|
else {
|
|
$cpu->{'smt'} = 'disabled';
|
|
}
|
|
}
|
|
my $i = 0;
|
|
my (@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++;
|
|
}
|
|
}
|
|
$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;
|
|
}
|
|
|
|
sub cp_sys_caches {
|
|
eval $start if $b_log;
|
|
my ($sys_caches,$caches,$id,$id_di) = @_;
|
|
my $cache_id = ($id_di) ? $id_di: $id;
|
|
my %cache_desc;
|
|
if ($sys_caches->{$cache_id}){
|
|
# print Data::Dumper::Dumper $cpu_sys->{'cpus'};
|
|
foreach (@{$sys_caches->{$cache_id}}){
|
|
# android seen to have cache data without size item
|
|
next if !defined $_;
|
|
$caches->{$cache_id} += $_;
|
|
$cache_desc{$_}++ if $b_admin;
|
|
}
|
|
$caches->{$id} += $caches->{$id_di} if $id_di;
|
|
$caches->{$cache_id . '-desc'} = cp_cache_desc(\%cache_desc) if $b_admin;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## 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 ($counts,$cpu,$caches,$cache_check) = @_;
|
|
# L1 Cache
|
|
if ($cpu->{'l1-cache'}){
|
|
$caches->{'l1'} = $cpu->{'l1-cache'} * $counts->{'cores-multiplier'};
|
|
}
|
|
else {
|
|
if ($cpu->{'l1d-cache'}){
|
|
$caches->{'l1d-desc'} = $counts->{'cores-multiplier'} . 'x';
|
|
$caches->{'l1d-desc'} .= main::get_size($cpu->{'l1d-cache'},'string');
|
|
$caches->{'l1'} += $cpu->{'l1d-cache'} * $counts->{'cores-multiplier'};
|
|
}
|
|
if ($cpu->{'l1i-cache'}){
|
|
$caches->{'l1i-desc'} = $counts->{'cores-multiplier'} . 'x';
|
|
$caches->{'l1i-desc'} .= main::get_size($cpu->{'l1i-cache'},'string');
|
|
$caches->{'l1'} += $cpu->{'l1i-cache'} * $counts->{'cores-multiplier'};
|
|
}
|
|
}
|
|
# L2 Cache
|
|
# If summed by dmidecode or from cpu_sys don't use this
|
|
if ($cpu->{'l2-cache'}){
|
|
# the only possible change for bsds is if dmidecode method gives phy counts
|
|
# Looks like Intel on bsd shows L2 per core, not total. Note: Pentium N3540
|
|
# uses 2(not 4)xL2 cache size for 4 cores, sigh... you just can't win...
|
|
if ($bsd_type){
|
|
$caches->{'l2'} = $cpu->{'l2-cache'} * $counts->{'cores-multiplier'};
|
|
}
|
|
# AMD SOS chips appear to report full L2 cache per cpu
|
|
elsif ($cpu->{'type'} eq 'amd' && ($cpu->{'family'} eq '14' ||
|
|
$cpu->{'family'} eq '15' || $cpu->{'family'} eq '16')){
|
|
$caches->{'l2'} = $cpu->{'l2-cache'};
|
|
}
|
|
elsif ($cpu->{'type'} ne 'intel'){
|
|
$caches->{'l2'} = $cpu->{'l2-cache'} * $counts->{'cpu-cores'};
|
|
}
|
|
# note: this handles how intel reports L2, total instead of per core like
|
|
# AMD does when cpuinfo sourced, when caches sourced, is per core as expected
|
|
else {
|
|
$caches->{'l2'} = $cpu->{'l2-cache'};
|
|
}
|
|
}
|
|
# l3 Cache - usually per physical cpu, but some rzyen will have per ccx.
|
|
if ($cpu->{'l3-cache'}){
|
|
$caches->{'l3'} = $cpu->{'l3-cache'};
|
|
}
|
|
# don't do anything with it, we have no ideaw if it's L1, L2, or L3, generic
|
|
# cpuinfo fallback, it's junk data essentially, and will show as cache:
|
|
# only use this fallback if no cache data was found
|
|
if ($cpu->{'cache'} && !$caches->{'l1'} && !$caches->{'l2'} &&
|
|
!$caches->{'l3'}){
|
|
$caches->{'cache'} = $cpu->{'cache'};
|
|
$$cache_check = main::message('note-check');
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## START CPU ARCH ##
|
|
sub cp_cpu_arch {
|
|
eval $start if $b_log;
|
|
my ($type,$family,$model,$stepping,$name) = @_;
|
|
# we can get various random strings for rev/stepping, particularly for arm,ppc
|
|
# but we want stepping to be integer for math comparisons, so convert, or set
|
|
# to 0 so it won't break anything.
|
|
if (defined $stepping && $stepping =~ /^[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";
|
|
# Note: AMD family is not Ext fam . fam but rather Ext-fam + fam.
|
|
# But model is Ext model . model...
|
|
if ($type eq 'amd'){
|
|
if ($family eq '3'){
|
|
$arch = 'Am386';
|
|
$process = 'AMD 900-1500nm';
|
|
$year = '1991-92';
|
|
}
|
|
elsif ($family eq '4'){
|
|
if ($model =~ /^(3|7|8|9|A)$/){
|
|
$arch = 'Am486';
|
|
$process = 'AMD 350-700nm';
|
|
$year = '1993-95';}
|
|
elsif ($model =~ /^(E|F)$/){
|
|
$arch = 'Am5x86';
|
|
$process = 'AMD 350nm';
|
|
$year = '1995-99';}
|
|
}
|
|
elsif ($family eq '5'){
|
|
## verified
|
|
if ($model =~ /^(0|1|2|3)$/){
|
|
$arch = 'K5';
|
|
$process = 'AMD 350nm';
|
|
$year = '1996-97';}
|
|
elsif ($model =~ /^(6)$/){
|
|
$arch = 'K6';
|
|
$process = 'AMD 350nm';
|
|
$year = '1997-98';}
|
|
elsif ($model =~ /^(7)$/){
|
|
$arch = 'K6';
|
|
$process = 'AMD 250nm';
|
|
$year = '1997-98';}
|
|
elsif ($model =~ /^(8)$/){
|
|
$arch = 'K6-2';
|
|
$process = 'AMD 250nm';
|
|
$year = '1998-2003';}
|
|
elsif ($model =~ /^(9)$/){
|
|
$arch = 'K6-3';
|
|
$process = 'AMD 250nm';
|
|
$year = '1999-2003';}
|
|
elsif ($model =~ /^(D)$/){
|
|
$arch = 'K6-3';
|
|
$process = 'AMD 180nm';
|
|
$year = '1999-2003';}
|
|
## unverified
|
|
elsif ($model =~ /^(A)$/){
|
|
$arch = 'K6 Geode';
|
|
$process = 'AMD 150-350nm';
|
|
$year = '1999';} # dates uncertain, 1999 start
|
|
## fallback
|
|
else {
|
|
$arch = 'K6';
|
|
$process = 'AMD 250-350nm';
|
|
$year = '1999-2003';}
|
|
}
|
|
elsif ($family eq '6'){
|
|
## verified
|
|
if ($model =~ /^(1)$/){
|
|
$arch = 'K7'; # 1:2:argon
|
|
$process = 'AMD 250nm';
|
|
$year = '1999-2001';}
|
|
elsif ($model =~ /^(2|3|4|6)$/){
|
|
# 3:0:duron;3:1:spitfire;4:2,4:thunderbird; 6:2:Palomino, duron; 2:1:Pluto
|
|
$arch = 'K7';
|
|
$process = 'AMD 180nm';
|
|
$year = '2000-01';}
|
|
elsif ($model =~ /^(7|8|A)$/){
|
|
$arch = 'K7'; # 7:0,1:Morgan;8:1:thoroughbred,duron-applebred; A:0:barton
|
|
$process = 'AMD 130nm';
|
|
$year = '2002-04';}
|
|
## fallback
|
|
else {
|
|
$arch = 'K7';
|
|
$process = 'AMD 130-180nm';
|
|
$year = '2003-14';}
|
|
}
|
|
# note: family F K8 needs granular breakdowns, was a long lived family
|
|
elsif ($family eq 'F'){
|
|
## verified
|
|
# check: B|E|F
|
|
if ($model =~ /^(4|5|7|8|B|C|E|F)$/){
|
|
# 4:0:clawhammer;5:8:sledgehammer;8:2,4:8:dubin;7:A;C:0:NewCastle;
|
|
$arch = 'K8';
|
|
$process = 'AMD 130nm';
|
|
$year = '2004-05';}
|
|
# check: 14|17|18|1B|25|48|4B|5D
|
|
elsif ($model =~ /^(14|15|17|18|1B|1C|1F|21|23|24|25|27|28|2C|2F|37|3F|41|43|48|4B|4C|4F|5D|5F|C1)$/){
|
|
# 1C:0,2C:2:Palermo;21:0,2,23:2:denmark;1F:0:winchester;2F:2:Venice;
|
|
# 27:1,37:2:san diego;28:1,3F:2:Manchester;23:2:Toledo;$F:2,5F:2,3:Orleans;
|
|
# 5F:2:Manila?;37:2;C1:3:windsor fx;43:2,3:santa ana;41:2:santa rosa;
|
|
# 4C:2:Keene;2C:2:roma;24:2:newark
|
|
$arch = 'K8';
|
|
$process = 'AMD 90nm';
|
|
$year = '2004-06';}
|
|
elsif ($model =~ /^(68|6B|6C|6F|7C|7F)$/){
|
|
$arch = 'K8'; # 7F:1,2:Lima; 68:1,6B:1,2:Brisbane;6F:2:conesus;7C:2:sherman
|
|
$process = 'AMD 65nm';
|
|
$year = '2005-08';}
|
|
## fallback
|
|
else {
|
|
$arch = 'K8';
|
|
$process = 'AMD 65-130nm';
|
|
$year = '2004-2008';}
|
|
}
|
|
# K9 was planned but skipped
|
|
elsif ($family eq '10'){ # 1F
|
|
## verified
|
|
if ($model =~ /^(2)$/){
|
|
$arch = 'K10'; # 2:2:budapest;2:1,3:barcelona
|
|
$process = 'AMD 65nm';
|
|
$year = '2007-08';}
|
|
elsif ($model =~ /^(4|5|6|8|9|A)$/){
|
|
# 4:2:Suzuka;5:2,3:propus;6:2:Regor;8:0:Istanbul;9:1:maranello
|
|
$arch = 'K10';
|
|
$process = 'AMD 45nm';
|
|
$year = '2009-13';}
|
|
## fallback
|
|
else {
|
|
$arch = 'K10';
|
|
$process = 'AMD 45-65nm';
|
|
$year = '2007-13';}
|
|
}
|
|
# very loose, all stepping 1: covers athlon x2, sempron, turion x2
|
|
# years unclear, could be 2005 start, or 2008
|
|
elsif ($family eq '11'){ # 2F
|
|
if ($model =~ /^(3)$/){
|
|
$arch = 'K11 Turion X2'; # mix of K8/K10
|
|
$note = $check;
|
|
$process = 'AMD 65-90nm';
|
|
$year = ''; }
|
|
}
|
|
# might also need cache handling like 14/16
|
|
elsif ($family eq '12'){ # 3F
|
|
if ($model =~ /^(1)$/){
|
|
$arch = 'K12 Fusion'; # K10 based apu, llano
|
|
$process = 'GF 32nm';
|
|
$year = '2011';} # check years
|
|
else {
|
|
$arch = 'K12 Fusion';
|
|
$process = 'GF 32nm';
|
|
$year = '2011';} # check years
|
|
}
|
|
# SOC, apu
|
|
elsif ($family eq '14'){ # 5F
|
|
if ($model =~ /^(1|2)$/){
|
|
$arch = 'Bobcat';
|
|
$process = 'GF 40nm';
|
|
$year = '2011-13';}
|
|
else {
|
|
$arch = 'Bobcat';
|
|
$process = 'GF 40nm';
|
|
$year = '2011-13';}
|
|
}
|
|
elsif ($family eq '15'){ # 6F
|
|
# note: only model 1 confirmd
|
|
if ($model =~ /^(0|1|3|4|5|6|7|8|9|A|B|C|D|E|F)$/){
|
|
$arch = 'Bulldozer';
|
|
$process = 'GF 32nm';
|
|
$year = '2011';}
|
|
# note: only 2,10,13 confirmed
|
|
elsif ($model =~ /^(2|10|11|12|13|14|15|16|17|18|19|1A|1B|1C|1D|1E|1F)$/){
|
|
$arch = 'Piledriver';
|
|
$process = 'GF 32nm';
|
|
$year = '2012-13';}
|
|
# note: only 30,38 confirmed
|
|
elsif ($model =~ /^(30|31|32|33|34|35|36|37|38|39|3A|3B|3C|3D|3E|3F)$/){
|
|
$arch = 'Steamroller';
|
|
$process = 'GF 28nm';
|
|
$year = '2014';}
|
|
# note; only 60,65,70 confirmed
|
|
elsif ($model =~ /^(60|61|62|63|64|65|66|67|68|69|6A|6B|6C|6D|6E|6F|70|71|72|73|74|75|76|77|78|79|7A|7B|7C|7D|7E|7F)$/){
|
|
$arch = 'Excavator';
|
|
$process = 'GF 28nm';
|
|
$year = '2015';}
|
|
else {
|
|
$arch = 'Bulldozer';
|
|
$process = 'GF 32nm';
|
|
$year = '2011-12';}
|
|
}
|
|
# SOC, apu
|
|
elsif ($family eq '16'){ # 7F
|
|
if ($model =~ /^(0|1|2|3|4|5|6|7|8|9|A|B|C|D|E|F)$/){
|
|
$arch = 'Jaguar';
|
|
$process = 'GF 28nm';
|
|
$year = '2013-14';}
|
|
elsif ($model =~ /^(30|31|32|33|34|35|36|37|38|39|3A|3B|3C|3D|3E|3F)$/){
|
|
$arch = 'Puma';
|
|
$process = 'GF 28nm';
|
|
$year = '2014-15';}
|
|
else {
|
|
$arch = 'Jaguar';
|
|
$process = 'GF 28nm';
|
|
$year = '2013-14';}
|
|
}
|
|
elsif ($family eq '17'){ # 8F
|
|
# can't find stepping/model for no ht 2x2 core/die models, only first ones
|
|
if ($model =~ /^(1|11|20)$/){
|
|
$arch = 'Zen';
|
|
$process = 'GF 14nm';
|
|
$year = '2017-19';}
|
|
# Seen: stepping 1 is Zen+ Ryzen 7 3750H. But stepping 1 Zen is: Ryzen 3 3200U
|
|
# AMD Ryzen 3 3200G is stepping 1, Zen+
|
|
# Unknown if stepping 0 is Zen or either.
|
|
elsif ($model =~ /^(18)$/){
|
|
$arch = 'Zen/Zen+';
|
|
$gen = '1';
|
|
$process = 'GF 12nm';
|
|
$note = $check;
|
|
$year = '2019';}
|
|
# shares model 8 with zen, stepping unknown
|
|
elsif ($model =~ /^(8)$/){
|
|
$arch = 'Zen+';
|
|
$gen = '2';
|
|
$process = 'GF 12nm';
|
|
$year = '2018-21';}
|
|
# used this but it didn't age well: ^(2[0123456789ABCDEF]|
|
|
elsif ($model =~ /^(3.|4.|5.|6.|7.|8.|9.|A.)$/){
|
|
$arch = 'Zen 2';
|
|
$gen = '3';
|
|
$process = 'TSMC n7 (7nm)'; # some consumer maybe GF 14nm
|
|
$year = '2020-22';}
|
|
else {
|
|
$arch = 'Zen';
|
|
$note = $check;
|
|
$process = '7-14nm';
|
|
$year = '';}
|
|
}
|
|
# Joint venture between AMD and Chinese companies. Type amd? or hygon?
|
|
elsif ($family eq '18'){ # 9F
|
|
# model 0, zen 1
|
|
$arch = 'Zen (Hygon Dhyana)';
|
|
$gen = '1';
|
|
$process = 'GF 14nm';
|
|
$year = '';}
|
|
elsif ($family eq '19'){ # AF
|
|
# zen 4 raphael, phoenix 1 use n5 I believe
|
|
# Epyc Bergamo zen4c 4nm, only few full model IDs, update when appear
|
|
# zen4c is for cloud hyperscale
|
|
if ($model =~ /^(78)$/){
|
|
$arch = 'Zen 4c';
|
|
$gen = '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+';}
|
|
}
|
|
# Roadmap: check to verify, AMD is usually closer to target than Intel
|
|
# Epyc 4 genoa: zen 4, nm, 2022+ (dec 2022), cxl-1.1,pcie-5, ddr-5
|
|
}
|
|
# we have no advanced data for ARM cpus, this is an area that could be improved?
|
|
elsif ($type eq 'arm'){
|
|
if ($family ne ''){
|
|
$arch="ARMv$family";}
|
|
else {
|
|
$arch='ARM';}
|
|
}
|
|
# elsif ($type eq 'ppc'){
|
|
# $arch='PPC';
|
|
# }
|
|
# aka VIA
|
|
elsif ($type eq 'centaur'){
|
|
if ($family eq '5'){
|
|
if ($model =~ /^(4)$/){
|
|
$arch = 'WinChip C6';
|
|
$process = '250nm';
|
|
$year = '';}
|
|
elsif ($model =~ /^(8)$/){
|
|
$arch = 'WinChip 2';
|
|
$process = '250nm';
|
|
$year = '';}
|
|
elsif ($model =~ /^(9)$/){
|
|
$arch = 'WinChip 3';
|
|
$process = '250nm';
|
|
$year = '';}
|
|
}
|
|
elsif ($family eq '6'){
|
|
if ($model =~ /^(6)$/){
|
|
$arch = 'Via Cyrix III (WinChip 5)';
|
|
$process = '150nm'; # guess
|
|
$year = '';}
|
|
elsif ($model =~ /^(7|8)$/){
|
|
$arch = 'Via C3';
|
|
$process = '150nm';
|
|
$year = '';}
|
|
elsif ($model =~ /^(9)$/){
|
|
$arch = 'Via C3-2';
|
|
$process = '130nm';
|
|
$year = '';}
|
|
elsif ($model =~ /^(A|D)$/){
|
|
$arch = 'Via C7';
|
|
$process = '90nm';
|
|
$year = '';}
|
|
elsif ($model =~ /^(F)$/){
|
|
if ($stepping <= 1){
|
|
$arch = 'Via CN Nano (Isaah)';}
|
|
elsif ($stepping <= 2){
|
|
$arch = 'Via Nano (Isaah)';}
|
|
elsif ($stepping <= 10){
|
|
$arch = 'Via Nano (Isaah)';}
|
|
elsif ($stepping <= 12){
|
|
$arch = 'Via Isaah';}
|
|
elsif ($stepping <= 13){
|
|
$arch = 'Via Eden';}
|
|
elsif ($stepping <= 14){
|
|
$arch = 'Zhaoxin ZX';}
|
|
$process = '90nm'; # guess
|
|
$year = '';}
|
|
}
|
|
elsif ($family eq '7'){
|
|
if ($model =~ /^(1.|3.)$/){
|
|
$arch = 'Zhaoxin ZX';
|
|
$process = '90nm'; # guess
|
|
$year = '';
|
|
}
|
|
}
|
|
}
|
|
# note, to test uncoment $cpu{'type'} = Elbrus in proc/cpuinfo logic
|
|
# ExpLicit Basic Resources Utilization Scheduling
|
|
elsif ($type eq 'elbrus'){
|
|
# E8CB
|
|
if ($family eq '4'){
|
|
if ($model eq '1'){
|
|
$arch = 'Elbrus 2000 (gen-1)';
|
|
$process = 'Mikron 130nm';
|
|
$year = '2005';}
|
|
elsif ($model eq '2'){
|
|
$arch = 'Elbrus-S (gen-2)';
|
|
$process = 'Mikron 90nm';
|
|
$year = '2010';}
|
|
elsif ($model eq '3'){
|
|
$arch = 'Elbrus-4C (gen-3)';
|
|
$process = 'TSMC 65nm';
|
|
$year = '2014';}
|
|
elsif ($model eq '4'){
|
|
$arch = 'Elbrus-2C+ (gen-2)';
|
|
$process = 'Mikron 90nm';
|
|
$year = '2011';}
|
|
elsif ($model eq '6'){
|
|
$arch = 'Elbrus-2CM (gen-2)';
|
|
$note = $check;
|
|
$process = 'Mikron 90nm';
|
|
$year = '2011 (?)';}
|
|
elsif ($model eq '7'){
|
|
if ($stepping >= 2){
|
|
$arch = 'Elbrus-8C1 (gen-4)';
|
|
$process = 'TSMC 28nm';
|
|
$year = '2016';}
|
|
else {
|
|
$arch = 'Elbrus-8C (gen-4)';
|
|
$process = 'TSMC 28nm';
|
|
$year = '2016';}
|
|
} # note: stepping > 1 may be 8C1
|
|
elsif ($model eq '8'){
|
|
$arch = 'Elbrus-1C+ (gen-4)';
|
|
$process = 'TSMC 40nm';
|
|
$year = '2016';}
|
|
# 8C2 morphed out of E8CV, but the two were the same die
|
|
elsif ($model eq '9'){
|
|
$arch = 'Elbrus-8CV/8C2 (gen-4/5)';
|
|
$process = 'TSMC 28nm';
|
|
$note = $check;
|
|
$year = '2016/2020';}
|
|
elsif ($model eq 'A'){
|
|
$arch = 'Elbrus-12C (gen-6)';
|
|
$process = 'TSMC 16nm';
|
|
$year = '2021+';}
|
|
elsif ($model eq 'B'){
|
|
$arch = 'Elbrus-16C (gen-6)';
|
|
$process = 'TSMC 16nm';
|
|
$year = '2021+';}
|
|
elsif ($model eq 'C'){
|
|
$arch = 'Elbrus-2C3 (gen-6)';
|
|
$process = 'TSMC 16nm';
|
|
$year = '2021+';}
|
|
else {
|
|
$arch = 'Elbrus-??';;
|
|
$note = $check;
|
|
$year = '';}
|
|
}
|
|
elsif ($family eq '5'){
|
|
if ($model eq '9'){
|
|
$arch = 'Elbrus-8C2 (gen-4)';
|
|
$process = 'TSMC 28nm';
|
|
$year = '2020';}
|
|
else {
|
|
$arch = 'Elbrus-??';
|
|
$note = $check;
|
|
$process = '';
|
|
$year = '';}
|
|
}
|
|
elsif ($family eq '6'){
|
|
if ($model eq 'A'){
|
|
$arch = 'Elbrus-12C (gen-6)';
|
|
$process = 'TSMC 16nm';
|
|
$year = '2021+';}
|
|
elsif ($model eq 'B'){
|
|
$arch = 'Elbrus-16C (gen-6)';
|
|
$process = 'TSMC 16nm';
|
|
$year = '2021+';}
|
|
elsif ($model eq 'C'){
|
|
$arch = 'Elbrus-2C3 (gen-6)';
|
|
$process = 'TSMC 16nm';
|
|
$year = '2021+';}
|
|
# elsif ($model eq '??'){
|
|
# $arch = 'Elbrus-32C (gen-7)';
|
|
# $process = '?? 7nm';
|
|
# $year = '2025';}
|
|
else {
|
|
$arch = 'Elbrus-??';
|
|
$note = $check;
|
|
$process = '';
|
|
$year = '';}
|
|
}
|
|
else {
|
|
$arch = 'Elbrus-??';
|
|
$note = $check;
|
|
}
|
|
}
|
|
elsif ($type eq 'intel'){
|
|
if ($family eq '4'){
|
|
if ($model =~ /^(0|1|2)$/){
|
|
$arch = 'i486';
|
|
$process = '1000nm'; # 33mhz
|
|
$year = '1989-98';}
|
|
elsif ($model =~ /^(3)$/){
|
|
$arch = 'i486';
|
|
$process = '800nm'; # 66mhz
|
|
$year = '1992-98';}
|
|
elsif ($model =~ /^(4|5|6|7|8|9)$/){
|
|
$arch = 'i486';
|
|
$process = '600nm'; # 100mhz
|
|
$year = '1993-98';}
|
|
else {
|
|
$arch = 'i486';
|
|
$process = '600-1000nm';
|
|
$year = '1989-98';}
|
|
}
|
|
# 1993-2000
|
|
elsif ($family eq '5'){
|
|
# verified
|
|
if ($model =~ /^(1)$/){
|
|
$arch = 'P5';
|
|
$process = 'Intel 800nm'; # 1:3,5,7:800
|
|
$year = '1993-94';}
|
|
elsif ($model =~ /^(2)$/){
|
|
$arch = 'P5'; # 2:5:MMX
|
|
# 2:C:350[or 600]; 2:1,4,5,6:600;but:
|
|
if ($stepping > 9){
|
|
$process = 'Intel 350nm';
|
|
$year = '1996-2000';}
|
|
else {
|
|
$process = 'Intel 600nm';
|
|
$year = '1993-95';}
|
|
}
|
|
elsif ($model =~ /^(4)$/){
|
|
$arch = 'P5';
|
|
$process = 'Intel 350nm'; # MMX. 4:3:P55C
|
|
$year = '1997';}
|
|
# unverified
|
|
elsif ($model =~ /^(3|7)$/){
|
|
$arch = 'P5'; # 7:0:MMX
|
|
$process = 'Intel 350-600nm';
|
|
$year = '';}
|
|
elsif ($model =~ /^(8)$/){
|
|
$arch = 'P5';
|
|
$process = 'Intel 350-600nm'; # MMX
|
|
$year = '';}
|
|
elsif ($model =~ /^(9|A)$/){
|
|
$arch = 'Lakemont';
|
|
$process = 'Intel 350nm';
|
|
$year = '';}
|
|
# fallback
|
|
else {
|
|
$arch = 'P5';
|
|
$process = 'Intel 350-600nm'; # MMX
|
|
$year = '1994-2000';}
|
|
}
|
|
elsif ($family eq '6'){
|
|
if ($model =~ /^(1)$/){
|
|
$arch = 'P6 Pro';
|
|
$process = 'Intel 350nm';
|
|
$year = '';}
|
|
elsif ($model =~ /^(3)$/){
|
|
$arch = 'P6 II Klamath';
|
|
$process = 'Intel 350nm';
|
|
$year = '';}
|
|
elsif ($model =~ /^(5)$/){
|
|
$arch = 'P6 II Deschutes';
|
|
$process = 'Intel 250nm';
|
|
$year = '';}
|
|
elsif ($model =~ /^(6)$/){
|
|
$arch = 'P6 II Mendocino';
|
|
$process = 'Intel 250nm'; # 6:5:P6II-celeron-mendo
|
|
$year = '1999';}
|
|
elsif ($model =~ /^(7)$/){
|
|
$arch = 'P6 III Katmai';
|
|
$process = 'Intel 250nm';
|
|
$year = '1999';}
|
|
elsif ($model =~ /^(8)$/){
|
|
$arch = 'P6 III Coppermine';
|
|
$process = 'Intel 180nm';
|
|
$year = '1999';}
|
|
elsif ($model =~ /^(9)$/){
|
|
$arch = 'M Banias'; # Pentium M
|
|
$process = 'Intel 130nm';
|
|
$year = '2003';}
|
|
elsif ($model =~ /^(A)$/){
|
|
$arch = 'P6 III Xeon';
|
|
$process = 'Intel 180-250nm';
|
|
$year = '1999';}
|
|
elsif ($model =~ /^(B)$/){
|
|
$arch = 'P6 III Tualitin'; # 6:B:1,4
|
|
$process = 'Intel 130nm';
|
|
$year = '2001';}
|
|
elsif ($model =~ /^(D)$/){
|
|
$arch = 'M Dothan'; # Pentium M
|
|
$process = 'Intel 90nm';
|
|
$year = '2003-05';}
|
|
elsif ($model =~ /^(E)$/){
|
|
$arch = 'M Yonah';
|
|
$process = 'Intel 65nm';
|
|
$year = '2006-08';}
|
|
elsif ($model =~ /^(F|16)$/){
|
|
$arch = 'Core2 Merom'; # 16:1:conroe-l[65nm]
|
|
$process = 'Intel 65nm';
|
|
$year = '2006-09';}
|
|
elsif ($model =~ /^(15)$/){
|
|
$arch = 'M Tolapai'; # pentium M system on chip
|
|
$process = 'Intel 90nm';
|
|
$year = '2008';}
|
|
elsif ($model =~ /^(17)$/){
|
|
$arch = 'Penryn'; # 17:A:Core 2,Celeron-wolfdale,yorkfield
|
|
$process = 'Intel 45nm';
|
|
$year = '2008';}
|
|
# had 25 also, but that's westmere, at least for stepping 2
|
|
elsif ($model =~ /^(1A|1E|1F|2C|2E|2F)$/){
|
|
$arch = 'Nehalem';
|
|
$process = 'Intel 45nm';
|
|
$year = '2008-10';}
|
|
elsif ($model =~ /^(1C|26)$/){
|
|
$arch = 'Bonnell';
|
|
$process = 'Intel 45nm';
|
|
$year = '2008-13';} # atom Bonnell? 27?
|
|
elsif ($model =~ /^(1D)$/){
|
|
$arch = 'Penryn';
|
|
$process = 'Intel 45nm';
|
|
$year = '2007-08';}
|
|
# 25 may be nahelem in a stepping, check. Stepping 2 is westmere
|
|
elsif ($model =~ /^(25|2C|2F)$/){
|
|
$arch = 'Westmere'; # die shrink of nehalem
|
|
$process = 'Intel 32nm';
|
|
$year = '2010-11';}
|
|
elsif ($model =~ /^(27|35|36)$/){
|
|
$arch = 'Saltwell';
|
|
$process = 'Intel 32nm';
|
|
$year = '2011-13';}
|
|
elsif ($model =~ /^(2A|2D)$/){
|
|
$arch = 'Sandy Bridge';
|
|
$process = 'Intel 32nm';
|
|
$year = '2010-12';}
|
|
elsif ($model =~ /^(37|4A|4D|5A|5D)$/){
|
|
$arch = 'Silvermont';
|
|
$process = 'Intel 22nm';
|
|
$year = '2013-15';}
|
|
elsif ($model =~ /^(3A|3E)$/){
|
|
$arch = 'Ivy Bridge';
|
|
$process = 'Intel 22nm';
|
|
$year = '2012-15';}
|
|
elsif ($model =~ /^(3C|3F|45|46)$/){
|
|
$arch = 'Haswell';
|
|
$process = 'Intel 22nm';
|
|
$year = '2013-15';}
|
|
elsif ($model =~ /^(3D|47|4F|56)$/){
|
|
$arch = 'Broadwell';
|
|
$process = 'Intel 14nm';
|
|
$year = '2015-18';}
|
|
elsif ($model =~ /^(4C)$/){
|
|
$arch = 'Airmont';
|
|
$process = 'Intel 14nm';
|
|
$year = '2015-17';}
|
|
elsif ($model =~ /^(4E)$/){
|
|
$arch = 'Skylake';
|
|
$process = 'Intel 14nm';
|
|
$year = '2015';}
|
|
# need to find stepping for these, guessing stepping 4 is last for SL
|
|
elsif ($model =~ /^(55)$/){
|
|
if ($stepping >= 5 && $stepping <= 7){
|
|
$arch = 'Cascade Lake';
|
|
$process = 'Intel 14nm';
|
|
$year = '2019';}
|
|
elsif ($stepping >= 8){
|
|
$arch = 'Cooper Lake'; # 55:A:14nm
|
|
$process = 'Intel 14nm';
|
|
$year = '2020';}
|
|
else {
|
|
$arch = 'Skylake';
|
|
$process = 'Intel 14nm';
|
|
$year = '';}}
|
|
elsif ($model =~ /^(57)$/){
|
|
$arch = 'Knights Landing';
|
|
$process = 'Intel 14nm';
|
|
$year = '2016+';}
|
|
elsif ($model =~ /^(5C|5F)$/){
|
|
$arch = 'Goldmont';
|
|
$process = 'Intel 14nm';
|
|
$year = '2016';}
|
|
elsif ($model =~ /^(5E)$/){
|
|
$arch = 'Skylake-S';
|
|
$process = 'Intel 14nm';
|
|
$year = '2015';}
|
|
elsif ($model =~ /^(66|67)$/){
|
|
$arch = 'Cannon Lake';
|
|
$process = 'Intel 10nm';
|
|
$year = '2018';}
|
|
# 6 are servers, 7 not
|
|
elsif ($model =~ /^(6A|6C|7D|7E|9F)$/){
|
|
$arch = 'Ice Lake';
|
|
$process = 'Intel 10nm';
|
|
$year = '2019-21';}
|
|
elsif ($model =~ /^(7A)$/){
|
|
$arch = 'Goldmont Plus';
|
|
$process = 'Intel 14nm';
|
|
$year = '2017';}
|
|
elsif ($model =~ /^(85)$/){
|
|
$arch = 'Knights Mill';
|
|
$process = 'Intel 14nm';
|
|
$year = '2017-19';}
|
|
elsif ($model =~ /^(86)$/){
|
|
$arch = 'Tremont Snow Ridge'; # embedded
|
|
$process = 'Intel 10nm';
|
|
$year = '2020';}
|
|
elsif ($model =~ /^(87)$/){
|
|
$arch = 'Tremont Parker Ridge'; # embedded
|
|
$process = 'Intel 10nm';
|
|
$year = '2022';}
|
|
elsif ($model =~ /^(8A)$/){
|
|
$arch = 'Tremont Lakefield';
|
|
$process = 'Intel 10nm';
|
|
$year = '2020';} # ?
|
|
elsif ($model =~ /^(96)$/){
|
|
$arch = 'Tremont Elkhart Lake';
|
|
$process = 'Intel 10nm';
|
|
$year = '2020';} # ?
|
|
elsif ($model =~ /^(8C|8D)$/){
|
|
$arch = 'Tiger Lake';
|
|
$process = 'Intel 10nm';
|
|
$year = '2020';}
|
|
elsif ($model =~ /^(8E)$/){
|
|
# can be AmberL or KabyL
|
|
if ($stepping == 9){
|
|
$arch = 'Amber/Kaby Lake';
|
|
$note = $check;
|
|
$process = 'Intel 14nm';
|
|
$year = '2017';}
|
|
elsif ($stepping == 10){
|
|
$arch = 'Coffee Lake';
|
|
$process = 'Intel 14nm';
|
|
$year = '2017';}
|
|
elsif ($stepping == 11){
|
|
$arch = 'Whiskey Lake';
|
|
$process = 'Intel 14nm';
|
|
$year = '2018';}
|
|
# can be WhiskeyL or CometL
|
|
elsif ($stepping == 12){
|
|
$arch = 'Comet/Whiskey Lake';
|
|
$note = $check;
|
|
$process = 'Intel 14nm';
|
|
$year = '2018';}
|
|
# note: had it as > 13, but 0xC seems to be CL
|
|
elsif ($stepping >= 13){
|
|
$arch = 'Comet Lake'; # 10 gen
|
|
$process = 'Intel 14nm';
|
|
$year = '2019-20';}
|
|
# NOTE: not enough info to lock this down
|
|
else {
|
|
$arch = 'Kaby Lake';
|
|
$note = $check;
|
|
$process = 'Intel 14nm';
|
|
$year = '~2018-20';}
|
|
}
|
|
elsif ($model =~ /^(8F)$/){
|
|
$arch = 'Sapphire Rapids';
|
|
$process = 'Intel 7 (10nm ESF)';
|
|
$year = '2023+';} # server
|
|
elsif ($model =~ /^(97|9A|9C|BE)$/){
|
|
$arch = 'Alder Lake'; # socket LG 1700
|
|
$process = 'Intel 7 (10nm ESF)';
|
|
$year = '2021+';}
|
|
elsif ($model =~ /^(9E)$/){
|
|
if ($stepping == 9){
|
|
$arch = 'Kaby Lake';
|
|
$process = 'Intel 14nm';
|
|
$year = '2018';}
|
|
elsif ($stepping >= 10 && $stepping <= 13){
|
|
$arch = 'Coffee Lake'; # 9E:A,B,C,D
|
|
$process = 'Intel 14nm';
|
|
$year = '2018';}
|
|
else {
|
|
$arch = 'Kaby Lake';
|
|
$note = $check;
|
|
$process = 'Intel 14nm';
|
|
$year = '2018';}
|
|
}
|
|
elsif ($model =~ /^(A5|A6)$/){
|
|
$arch = 'Comet Lake'; # 10 gen; stepping 0-5
|
|
$process = 'Intel 14nm';
|
|
$year = '2020';}
|
|
elsif ($model =~ /^(A7|A8)$/){
|
|
$arch = 'Rocket Lake'; # 11 gen; stepping 1
|
|
$process = 'Intel 14nm';
|
|
$year = '2021+';}
|
|
# More info: comet: shares family/model, need to find stepping numbers
|
|
# Coming: meteor lake; granite rapids; emerald rapids, diamond rapids
|
|
## IDS UNKNOWN, release late 2022
|
|
elsif ($model =~ /^(AA|AB|AC|B5)$/){
|
|
$arch = 'Meteor Lake'; # 14 gen
|
|
$process = 'Intel 4 (7nm)';
|
|
$year = '2023+';}
|
|
elsif ($model =~ /^(AD|AE)$/){
|
|
$arch = 'Granite Rapids'; # ?
|
|
$process = 'Intel 3 (7nm+)'; # 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+';} # check when actually in production
|
|
# Meteor Lake-S maybe cancelled, replaced by arrow
|
|
elsif ($model =~ /^(C5|C6)$/){
|
|
$arch = 'Arrow Lake'; # 14 gn
|
|
# 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 =~ /^(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 - 14 gen, TSMC 3nm (corei3-5)/Intel 20A 2nm (core i5-9), 2024
|
|
# Lunar Lake - 15 gen, Intel 18A (1.8nm), 2024-5
|
|
# Panther Lake - 15 gen, ?, late 2025, cougar cove Xe3 Celestial GPU architecture
|
|
# Beast Lake - 16 gen, ?, 2026?
|
|
# Nova Lake - 16 gen, Intel 18A (1.8nm), 2026
|
|
}
|
|
# itanium 1 family 7 all recalled
|
|
elsif ($family eq 'B'){
|
|
if ($model =~ /^(0)$/){
|
|
$arch = 'Knights Ferry';
|
|
$process = 'Intel 45nm';
|
|
$year = '2010-11';}
|
|
if ($model =~ /^(1)$/){
|
|
$arch = 'Knights Corner';
|
|
$process = 'Intel 22nm';
|
|
$year = '2012-13';}
|
|
}
|
|
# pentium 4
|
|
elsif ($family eq 'F'){
|
|
if ($model =~ /^(0|1)$/){
|
|
$arch = 'Netburst Willamette';
|
|
$process = 'Intel 180nm';
|
|
$year = '2000-01';}
|
|
elsif ($model =~ /^(2)$/){
|
|
if ($stepping <= 4 || $stepping > 6){
|
|
$arch = 'Netburst Northwood';}
|
|
elsif ($stepping == 5){
|
|
$arch = 'Netburst Gallatin';}
|
|
else {
|
|
$arch = 'Netburst';}
|
|
$process = 'Intel 130nm';
|
|
$year = '2002-03';}
|
|
elsif ($model =~ /^(3)$/){
|
|
$arch = 'Netburst Prescott';
|
|
$process = 'Intel 90nm';
|
|
$year = '2004-06';} # 6? Nocona
|
|
elsif ($model =~ /^(4)$/){
|
|
# these are vague, and same stepping can have > 1 core names
|
|
if ($stepping < 10){
|
|
$arch = 'Netburst Prescott'; # 4:1,9:prescott
|
|
$process = 'Intel 90nm';
|
|
$year = '2004-06';}
|
|
else {
|
|
$arch = 'Netburst Smithfield';
|
|
$process = 'Intel 90nm';
|
|
$year = '2005-06';} # 6? Nocona
|
|
}
|
|
elsif ($model =~ /^(6)$/){
|
|
$arch = 'Netburst Presler'; # 6:2,4,5:presler
|
|
$process = 'Intel 65nm';
|
|
$year = '2006';}
|
|
else {
|
|
$arch = 'Netburst';
|
|
$process = 'Intel 90-180nm';
|
|
$year = '2000-06';}
|
|
}
|
|
# this is not going to e accurate, WhiskyL or Kaby L can ID as Skylake
|
|
# but if it's a new cpu microarch not handled yet, it may give better
|
|
# than nothing result. This is intel only
|
|
# This is probably the gcc/clang -march/-mtune value, which is not
|
|
# necessarily the same as actual microarch, and varies between gcc/clang versions
|
|
if (!$arch){
|
|
my $file = '/sys/devices/cpu/caps/pmu_name';
|
|
$arch = main::reader($file,'strip',0) if -r $file;
|
|
$note = $check if $arch;
|
|
}
|
|
# gen 1 had no gen, only 3 digits: Core i5-661 Core i5-655K; Core i5 M 520
|
|
# EXCEPT gen 1: Core i7-720QM Core i7-740QM Core i7-840QM
|
|
# 2nd: Core i5-2390T Core i7-11700F Core i5-8400
|
|
# 2nd variants: Core i7-1165G7
|
|
if ($name){
|
|
if ($name =~ /\bi[357][\s-]([A-Z][\s-]?)?(\d{3}([^\d]|\b)|[78][24]00M)/){
|
|
$gen = ($gen) ? "$gen (core 1)": 'core 1';
|
|
}
|
|
elsif ($name =~ /\bi[3579][\s-]([A-Z][\s-]?)?([2-9]|1[0-4])(\d{3}|\d{2}[A-Z]\d)/){
|
|
$gen = ($gen) ? "$gen (core $2)" : "core $2";
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return [$arch,$note,$process,$gen,$year];
|
|
}
|
|
## END CPU ARCH ##
|
|
|
|
# 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);
|
|
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 {
|
|
my @alpha = qw(single dual triple quad);
|
|
$string = $alpha[$cores-1] . ' core';
|
|
}
|
|
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 {
|
|
${$_[0]} = {
|
|
'arch' => '',
|
|
'avg-freq' => 0, # MHz
|
|
'bogomips' => 0,
|
|
'cores' => 0,
|
|
'cur-freq' => 0, # MHz
|
|
'dies' => 0,
|
|
'family' => '',
|
|
'flags' => '',
|
|
'ids' => [],
|
|
'l1-cache' => 0, # store in KB
|
|
'l2-cache' => 0, # store in KB
|
|
'l3-cache' => 0, # store in KB
|
|
'max-freq' => 0, # MHz
|
|
'min-freq' => 0, # MHz
|
|
'model_name' => '',
|
|
'processors' => [],
|
|
'scalings' => [],
|
|
'siblings' => 0,
|
|
'type' => '',
|
|
};
|
|
}
|
|
|
|
sub system_cpu_name {
|
|
eval $start if $b_log;
|
|
my ($compat,@working);
|
|
my $cpus = {};
|
|
if (@working = main::globber('/sys/firmware/devicetree/base/cpus/cpu@*/compatible')){
|
|
foreach my $file (@working){
|
|
$compat = main::reader($file,'',0);
|
|
next if $compat =~ /timer/; # seen on android
|
|
# these can have non printing ascii... why? As long as we only have the
|
|
# splits for: null 00/start header 01/start text 02/end text 03
|
|
$compat = (split(/\x01|\x02|\x03|\x00/, $compat))[0] if $compat;
|
|
$compat = (split(/,\s*/, $compat))[-1] if $compat;
|
|
$cpus->{$compat} = ($cpus->{$compat}) ? ++$cpus->{$compat}: 1;
|
|
}
|
|
}
|
|
# synthesize it, [4] will be like: cortex-a15-timer; sunxi-timer
|
|
# so far all with this directory show soc name, not cpu name for timer
|
|
elsif (! -d '/sys/firmware/devicetree/base' && $devices{'timer'}){
|
|
foreach my $working (@{$devices{'timer'}}){
|
|
next if $working->[0] ne 'timer' || !$working->[4] || $working->[4] =~ /timer-mem$/;
|
|
$working->[4] =~ s/(-system)?-timer$//;
|
|
$compat = $working->[4];
|
|
$cpus->{$compat} = ($cpus->{$compat}) ? ++$cpus->{$compat}: 1;
|
|
}
|
|
}
|
|
main::log_data('dump','%$cpus',$cpus) if $b_log;
|
|
eval $end if $b_log;
|
|
return $cpus;
|
|
}
|
|
|
|
## CLEANERS/OUTPUT HANDLERS ##
|
|
# MHZ - cell cpus
|
|
sub clean_speed {
|
|
my ($speed,$opt) = @_;
|
|
# 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 clean_cpu {
|
|
my ($cpu) = @_;
|
|
return if !$cpu;
|
|
my $filters = '@|cpu |cpu deca|([0-9]+|single|dual|two|triple|three|tri|quad|four|';
|
|
$filters .= 'penta|five|hepta|six|hexa|seven|octa|eight|multi)[ -]core|';
|
|
$filters .= 'ennea|genuine|multi|processor|single|triple|[0-9\.]+ *[MmGg][Hh][Zz]';
|
|
$cpu =~ s/$filters//ig;
|
|
$cpu =~ s/\s\s+/ /g;
|
|
$cpu =~ s/^\s+|\s+$//g;
|
|
return $cpu;
|
|
}
|
|
|
|
sub hex_and_decimal {
|
|
my ($data) = @_;
|
|
$data = '' if !defined $data;
|
|
if ($data =~ /\S/){
|
|
# only handle if a short hex number!! No need to prepend 0x to 0-9
|
|
if ($data =~ /^[0-9a-f]{1,3}$/i && hex($data) ne $data){
|
|
$data .= ' (' . hex($data) . ')';
|
|
$data = '0x' . $data;
|
|
}
|
|
}
|
|
else {
|
|
$data = 'N/A';
|
|
}
|
|
return $data;
|
|
}
|
|
}
|
|
|
|
## DriveItem
|
|
{
|
|
package DriveItem;
|
|
my ($b_hddtemp,$b_nvme,$smartctl_missing,$vendors);
|
|
my ($hddtemp,$nvme) = ('','');
|
|
my (@by_id,@by_path);
|
|
my ($debugger_dir);
|
|
# main::writer("$debugger_dir/system-repo-data-urpmq.txt",\@data2) if $debugger_dir;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my ($type) = @_;
|
|
$type ||= 'standard';
|
|
my ($key1,$val1);
|
|
my $rows = [];
|
|
my $num = 0;
|
|
my $data = drive_data($type);
|
|
# NOTE:
|
|
if (@$data){
|
|
if ($type eq 'standard'){
|
|
storage_output($rows,$data);
|
|
drive_output($rows,$data) if $show{'disk'};
|
|
if ($bsd_type && !$dboot{'disk'} && $type eq 'standard' && $show{'disk'}){
|
|
$key1 = 'Drive Report';
|
|
my $file = $system_files{'dmesg-boot'};
|
|
if ($file && ! -r $file){
|
|
$val1 = main::message('dmesg-boot-permissions');
|
|
}
|
|
elsif (!$file){
|
|
$val1 = main::message('dmesg-boot-missing');
|
|
}
|
|
else {
|
|
$val1 = main::message('disk-data-bsd');
|
|
}
|
|
push(@$rows,{main::key($num++,0,1,$key1) => $val1,});
|
|
}
|
|
}
|
|
# used by short form, raw data returned
|
|
else {
|
|
$rows = $data;
|
|
# print Data::Dumper::Dumper $rows;
|
|
}
|
|
}
|
|
else {
|
|
$key1 = 'Message';
|
|
$val1 = main::message('disk-data');
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1});
|
|
}
|
|
if (!@$rows){
|
|
$key1 = 'Message';
|
|
$val1 = main::message('disk-data');
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1});
|
|
}
|
|
# push(@rows,@data);
|
|
if ($show{'optical'} || $show{'optical-basic'}){
|
|
OpticalItem::get($rows);
|
|
}
|
|
($b_hddtemp,$b_nvme,$hddtemp,$nvme,$vendors) = ();
|
|
(@by_id,@by_path) = ();
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub storage_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$disks) = @_;
|
|
my ($num,$j) = (0,0);
|
|
my ($size,$size_value,$used) = ('','','');
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Local Storage') => '',
|
|
});
|
|
# print Data::Dumper::Dumper $disks;
|
|
$size = main::get_size($disks->[0]{'size'},'string','N/A');
|
|
if ($disks->[0]{'logical-size'}){
|
|
$rows->[$j]{main::key($num++,1,2,'total')} = '';
|
|
$rows->[$j]{main::key($num++,0,3,'raw')} = $size;
|
|
$size = main::get_size($disks->[0]{'logical-size'},'string');
|
|
$size_value = $disks->[0]{'logical-size'};
|
|
# print Data::Dumper::Dumper $disks;
|
|
$rows->[$j]{main::key($num++,1,3,'usable')} = $size;
|
|
}
|
|
else {
|
|
$size_value = $disks->[0]{'size'} if $disks->[0]{'size'};
|
|
$rows->[$j]{main::key($num++,0,2,'total')} = $size;
|
|
}
|
|
$used = main::get_size($disks->[0]{'used'},'string','N/A');
|
|
if ($extra > 0 && $disks->[0]{'logical-free'}){
|
|
$size = main::get_size($disks->[0]{'logical-free'},'string');
|
|
$rows->[$j]{main::key($num++,0,4,'lvm-free')} = $size;
|
|
}
|
|
if (($size_value && $size_value =~ /^[0-9]/) &&
|
|
($used && $disks->[0]{'used'} =~ /^[0-9]/)){
|
|
$used = $used . ' (' . sprintf("%0.1f", $disks->[0]{'used'}/$size_value*100) . '%)';
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'used')} = $used;
|
|
shift @$disks;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub drive_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$disks) = @_;
|
|
# print Data::Dumper::Dumper $disks;
|
|
my ($b_smart_permissions,$block,$smart_age,$smart_basic,$smart_fail);
|
|
my ($num,$j) = (0,0);
|
|
my ($id,$model,$size) = ('','','');
|
|
# note: specific smartctl non-missing errors handled inside loop
|
|
if ($smartctl_missing){
|
|
$j = scalar @$rows;
|
|
$rows->[$j]{main::key($num++,0,1,'SMART Message')} = $smartctl_missing;
|
|
}
|
|
elsif ($b_admin){
|
|
my $result = smartctl_fields();
|
|
($smart_age,$smart_basic,$smart_fail) = @$result;
|
|
}
|
|
foreach my $row (sort { $a->{'id'} cmp $b->{'id'} } @$disks){
|
|
($id,$model,$size) = ('','','');
|
|
$num = 1;
|
|
$model = ($row->{'model'}) ? $row->{'model'}: 'N/A';
|
|
$id = ($row->{'id'}) ? "/dev/$row->{'id'}":'N/A';
|
|
$size = ($row->{'size'}) ? main::get_size($row->{'size'},'string') : 'N/A';
|
|
# print Data::Dumper::Dumper $disks;
|
|
$j = scalar @$rows;
|
|
if (!$b_smart_permissions && $row->{'smart-permissions'}){
|
|
$b_smart_permissions = 1;
|
|
$rows->[$j]{main::key($num++,0,1,'SMART Message')} = $row->{'smart-permissions'};
|
|
$j = scalar @$rows;
|
|
}
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'ID') => $id,
|
|
});
|
|
if ($b_admin && $row->{'maj-min'}){
|
|
$rows->[$j]{main::key($num++,0,2,'maj-min')} = $row->{'maj-min'};
|
|
}
|
|
|
|
if ($row->{'vendor'}){
|
|
$rows->[$j]{main::key($num++,0,2,'vendor')} = $row->{'vendor'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'model')} = $model;
|
|
if ($row->{'drive-vendor'}){
|
|
$rows->[$j]{main::key($num++,0,2,'drive vendor')} = $row->{'drive-vendor'};
|
|
}
|
|
if ($row->{'drive-model'}){
|
|
$rows->[$j]{main::key($num++,0,2,'drive model')} = $row->{'drive-model'};
|
|
}
|
|
if ($row->{'family'}){
|
|
$rows->[$j]{main::key($num++,0,2,'family')} = $row->{'family'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'size')} = $size;
|
|
if ($b_admin && $row->{'block-physical'}){
|
|
$rows->[$j]{main::key($num++,1,2,'block-size')} = '';
|
|
$rows->[$j]{main::key($num++,0,3,'physical')} = "$row->{'block-physical'} B";
|
|
$block = ($row->{'block-logical'}) ? "$row->{'block-logical'} B" : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'logical')} = $block;
|
|
}
|
|
if ($row->{'type'}){
|
|
$rows->[$j]{main::key($num++,1,2,'type')} = $row->{'type'};
|
|
if ($extra > 1 && $row->{'type'} eq 'USB' && $row->{'abs-path'} &&
|
|
$usb{'disk'}){
|
|
foreach my $device (@{$usb{'disk'}}){
|
|
if ($device->[8] && $device->[26] &&
|
|
$row->{'abs-path'} =~ /^$device->[26]/){
|
|
$rows->[$j]{main::key($num++,0,3,'rev')} = $device->[8];
|
|
if ($device->[17]){
|
|
$rows->[$j]{main::key($num++,0,3,'spd')} = $device->[17];
|
|
}
|
|
if ($device->[24]){
|
|
$rows->[$j]{main::key($num++,0,3,'lanes')} = $device->[24];
|
|
}
|
|
if ($b_admin && $device->[22]){
|
|
$rows->[$j]{main::key($num++,0,3,'mode')} = $device->[22];
|
|
}
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if ($extra > 1 && $row->{'speed'}){
|
|
if ($row->{'sata'}){
|
|
$rows->[$j]{main::key($num++,0,2,'sata')} = $row->{'sata'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'speed')} = $row->{'speed'};
|
|
$rows->[$j]{main::key($num++,0,2,'lanes')} = $row->{'lanes'} if $row->{'lanes'};
|
|
}
|
|
if ($extra > 2){
|
|
$row->{'tech'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,1,2,'tech')} = $row->{'tech'};
|
|
if ($row->{'rotation'}){
|
|
$rows->[$j]{main::key($num++,0,2,'rpm')} = $row->{'rotation'};
|
|
}
|
|
}
|
|
if ($extra > 1){
|
|
if (!$row->{'serial'} && $alerts{'bioctl'} &&
|
|
$alerts{'bioctl'}->{'action'} eq 'permissions'){
|
|
$row->{'serial'} = main::message('root-required');
|
|
}
|
|
else {
|
|
$row->{'serial'} = main::filter($row->{'serial'});
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'serial')} = $row->{'serial'};
|
|
if ($row->{'drive-serial'}){
|
|
$rows->[$j]{main::key($num++,0,2,'drive serial')} = main::filter($row->{'drive-serial'});
|
|
}
|
|
if ($row->{'firmware'}){
|
|
$rows->[$j]{main::key($num++,0,2,'fw-rev')} = $row->{'firmware'};
|
|
}
|
|
if ($row->{'drive-firmware'}){
|
|
$rows->[$j]{main::key($num++,0,2,'drive-rev')} = $row->{'drive-firmware'};
|
|
}
|
|
}
|
|
if ($extra > 0 && $row->{'temp'}){
|
|
$rows->[$j]{main::key($num++,0,2,'temp')} = $row->{'temp'} . ' C';
|
|
}
|
|
if ($extra > 1 && $alerts{'bioctl'}){
|
|
if (!$row->{'duid'} && $alerts{'bioctl'}->{'action'} eq 'permissions'){
|
|
$rows->[$j]{main::key($num++,0,2,'duid')} = main::message('root-required');
|
|
}
|
|
elsif ($row->{'duid'}){
|
|
$rows->[$j]{main::key($num++,0,2,'duid')} = main::filter($row->{'duid'});
|
|
}
|
|
}
|
|
# Extra level tests already done
|
|
if (defined $row->{'partition-table'}){
|
|
$rows->[$j]{main::key($num++,0,2,'scheme')} = $row->{'partition-table'};
|
|
}
|
|
if ($row->{'smart'} || $row->{'smart-error'}){
|
|
$j = scalar @$rows;
|
|
## Basic SMART and drive info ##
|
|
smart_output('basic',$smart_basic,$row,$j,\$num,$rows);
|
|
## Old-Age errors ##
|
|
smart_output('age',$smart_age,$row,$j,\$num,$rows);
|
|
## Pre-Fail errors ##
|
|
smart_output('fail',$smart_fail,$row,$j,\$num,$rows);
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# args: $num and $rows passed by reference
|
|
sub smart_output {
|
|
eval $start if $b_log;
|
|
my ($type,$smart_data,$row,$j,$num,$rows) = @_;
|
|
my ($b_found);
|
|
my ($l,$m,$p) = ($type eq 'basic') ? (2,3,0) : (3,4,0);
|
|
my ($m_h,$p_h) = ($m,$p);
|
|
for (my $i = 0; $i < scalar @$smart_data;$i++){
|
|
if ($row->{$smart_data->[$i][0]}){
|
|
if (!$b_found){
|
|
my ($key,$support) = ('','');
|
|
if ($type eq 'basic'){
|
|
$support = ($row->{'smart'}) ? $row->{'smart'}: $row->{'smart-error'};
|
|
$key = $smart_data->[$i][1];
|
|
}
|
|
elsif ($type eq 'age'){$key = 'Old-Age';}
|
|
elsif ($type eq 'fail'){$key = 'Pre-Fail';}
|
|
$rows->[$j]{main::key($$num++,1,$l,$key)} = $support;
|
|
$b_found = 1;
|
|
next if $type eq 'basic';
|
|
}
|
|
if ($type ne 'basic'){
|
|
if ($smart_data->[$i][0] =~ /-a[vr]?$/){
|
|
($p,$m) = (1,$m_h);
|
|
}
|
|
elsif ($smart_data->[$i][0] =~ /-[ftvw]$/){
|
|
($p,$m) = (0,5);
|
|
}
|
|
else {
|
|
($p,$m) = ($p_h,$m_h);
|
|
}
|
|
}
|
|
$rows->[$j]{main::key($$num++,$p,$m,$smart_data->[$i][1])} = $row->{$smart_data->[$i][0]};
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub drive_data {
|
|
eval $start if $b_log;
|
|
my ($type) = @_;
|
|
my ($data,@devs);
|
|
my $num = 0;
|
|
my ($used) = (0);
|
|
PartitionItem::set_partitions() if !$loaded{'set-partitions'};
|
|
RaidItem::raid_data() if !$loaded{'raid'};
|
|
# see docs/inxi-partitions.txt > FILE SYSTEMS for more on remote/fuse fs
|
|
my $fs_skip = PartitionItem::get_filters('fs-exclude');
|
|
foreach my $row (@partitions){
|
|
# don't count remote/distributed/union type fs towards used
|
|
next if ($row->{'fs'} && $row->{'fs'} =~ /^$fs_skip$/);
|
|
# don't count non partition swap
|
|
next if ($row->{'swap-type'} && $row->{'swap-type'} ne 'partition');
|
|
# in some cases, like redhat, mounted cdrom/dvds show up in partition data
|
|
next if ($row->{'dev-base'} && $row->{'dev-base'} =~ /^sr[0-9]+$/);
|
|
# this is used for specific cases where bind, or incorrect multiple mounts
|
|
# to same partitions, or btrfs sub volume mounts, is present. The value is
|
|
# searched for an earlier appearance of that partition and if it is present,
|
|
# the data is not added into the partition used size.
|
|
if ($row->{'dev-base'} !~ /^(\/\/|:\/)/ && !(grep {/$row->{'dev-base'}/} @devs)){
|
|
$used += $row->{'used'} if $row->{'used'};
|
|
push(@devs, $row->{'dev-base'});
|
|
}
|
|
}
|
|
if (!$bsd_type){
|
|
$data = proc_data($used);
|
|
}
|
|
else {
|
|
$data = bsd_data($used);
|
|
}
|
|
if ($b_admin){
|
|
if ($alerts{'smartctl'} && $alerts{'smartctl'}->{'action'} eq 'use'){
|
|
smartctl_data($data);
|
|
}
|
|
else {
|
|
$smartctl_missing = $alerts{'smartctl'}->{'message'};
|
|
}
|
|
}
|
|
print Data::Dumper::Dumper $data if $dbg[13];
|
|
main::log_data('data',"used: $used") if $b_log;
|
|
eval $end if $b_log;
|
|
return $data;
|
|
}
|
|
|
|
sub proc_data {
|
|
eval $start if $b_log;
|
|
my ($used) = @_;
|
|
my (@drives);
|
|
my ($b_hdx,$logical_size,$size) = (0,0,0);
|
|
PartitionData::set() if !$bsd_type && !$loaded{'partition-data'};
|
|
foreach my $row (@proc_partitions){
|
|
if ($row->[-1] =~ /^(fio[a-z]+|[hsv]d[a-z]+|(ada|mmcblk|n[b]?d|nvme[0-9]+n)[0-9]+)$/){
|
|
$b_hdx = 1 if $row->[-1] =~ /^hd[a-z]/;
|
|
push(@drives, {
|
|
'firmware' => '',
|
|
'id' => $row->[-1],
|
|
'maj-min' => $row->[0] . ':' . $row->[1],
|
|
'model' => '',
|
|
'serial' => '',
|
|
'size' => $row->[2],
|
|
'spec' => '',
|
|
'speed' => '',
|
|
'temp' => '',
|
|
'type' => '',
|
|
'vendor' => '',
|
|
});
|
|
}
|
|
# See http://lanana.org/docs/device-list/devices-2.6+.txt for major numbers used below
|
|
# See https://www.mjmwired.net/kernel/Documentation/devices.txt for kernel 4.x device numbers
|
|
# if ($row->[0] =~ /^(3|22|33|8)$/ && $row->[1] % 16 == 0) {
|
|
# $size += $row->[2];
|
|
# }
|
|
# special case from this data: 8 0 156290904 sda
|
|
# 43 0 48828124 nbd0
|
|
# note: known starters: vm: 252/253/254; grsec: 202; nvme: 259 mmcblk: 179
|
|
# Note: with > 1 nvme drives, the minor number no longer passes the modulus tests,
|
|
# It appears to just increase randomly from the first 0 minor of the first nvme to
|
|
# nvme partitions to next nvme, so it only passes the test for the first nvme drive.
|
|
# note: 66 16 9766436864 sdah ; 65 240 9766436864 sdaf[maybe special case when double letters?
|
|
# Check /proc/devices for major number matches
|
|
if ($row->[0] =~ /^(3|8|22|33|43|6[5-9]|7[12]|12[89]|13[0-5]|179|202|252|253|254|259)$/ &&
|
|
$row->[-1] =~ /(mmcblk[0-9]+|n[b]?d[0-9]+|nvme[0-9]+n[0-9]+|fio[a-z]+|[hsv]d[a-z]+)$/ &&
|
|
($row->[1] % 16 == 0 || $row->[1] % 16 == 8 || $row->[-1] =~ /(nvme[0-9]+n[0-9]+)$/)){
|
|
$size += $row->[2];
|
|
}
|
|
}
|
|
# raw_logical[0] is total of all logical raid/lvm found
|
|
# raw_logical[1] is total of all components found. If this totally fails,
|
|
# and we end up with raw logical less than used, give up
|
|
if (@raw_logical && $raw_logical[0] && (!$used || $raw_logical[0] > $used)){
|
|
$logical_size = ($size - $raw_logical[1] + $raw_logical[0]);
|
|
}
|
|
# print Data::Dumper::Dumper \@drives;
|
|
main::log_data('data',"size: $size") if $b_log;
|
|
my $result = [{
|
|
'logical-size' => $logical_size,
|
|
'logical-free' => $raw_logical[2],
|
|
'size' => $size,
|
|
'used' => $used,
|
|
}];
|
|
# print Data::Dumper::Dumper \@data;
|
|
if ($show{'disk'}){
|
|
unshift(@drives,@$result);
|
|
# print 'drives:', Data::Dumper::Dumper \@drives;
|
|
$result = proc_data_advanced($b_hdx,\@drives);
|
|
}
|
|
main::log_data('dump','@$result',$result) if $b_log;
|
|
print Data::Dumper::Dumper $result if $dbg[24];
|
|
eval $end if $b_log;
|
|
return $result;
|
|
}
|
|
|
|
sub proc_data_advanced {
|
|
eval $start if $b_log;
|
|
my ($b_hdx,$drives) = @_;
|
|
my ($i) = (0);
|
|
my ($disk_data,$scsi,@temp,@working);
|
|
my ($pt_cmd) = ('unset');
|
|
my ($block_type,$file,$firmware,$model,$path,
|
|
$partition_scheme,$serial,$vendor,$working_path);
|
|
@by_id = main::globber('/dev/disk/by-id/*');
|
|
# these do not contain any useful data, no serial or model name
|
|
# wwn-0x50014ee25fb50fc1 and nvme-eui.0025385b71b07e2e
|
|
# scsi-SATA_ST980815A_ simply repeats ata-ST980815A_; same with scsi-0ATA_WDC_WD5000L31X
|
|
# we also don't need the partition items
|
|
my $pattern = '^\/dev\/disk\/by-id\/(md-|lvm-|dm-|wwn-|nvme-eui|raid-|scsi-([0-9]ATA|SATA))|-part[0-9]+$';
|
|
@by_id = grep {!/$pattern/} @by_id if @by_id;
|
|
# print join("\n", @by_id), "\n";
|
|
@by_path = main::globber('/dev/disk/by-path/*');
|
|
## check for all ide type drives, non libata, only do it if hdx is in array
|
|
## this is now being updated for new /sys type paths, this may handle that ok too
|
|
## skip the first rows in the loops since that's the basic size/used data
|
|
if ($b_hdx){
|
|
for ($i = 1; $i < scalar @$drives; $i++){
|
|
$file = "/proc/ide/$drives->[$i]{'id'}/model";
|
|
if ($drives->[$i]{'id'} =~ /^hd[a-z]/ && -e $file){
|
|
$model = main::reader($file,'strip',0);
|
|
$drives->[$i]{'model'} = $model;
|
|
}
|
|
}
|
|
}
|
|
# scsi stuff
|
|
if ($file = $system_files{'proc-scsi'}){
|
|
$scsi = scsi_data($file);
|
|
}
|
|
# print 'drives:', Data::Dumper::Dumper $drives;
|
|
for ($i = 1; $i < scalar @$drives; $i++){
|
|
#next if $drives->[$i]{'id'} =~ /^hd[a-z]/;
|
|
($block_type,$firmware,$model,$partition_scheme,
|
|
$serial,$vendor,$working_path) = ('','','','','','','');
|
|
# print "$drives->[$i]{'id'}\n";
|
|
$disk_data = disk_data_by_id("/dev/$drives->[$i]{'id'}");
|
|
main::log_data('dump','@$disk_data', $disk_data) if $b_log;
|
|
if ($drives->[$i]{'id'} =~ /[sv]d[a-z]/){
|
|
$block_type = 'sdx';
|
|
$working_path = "/sys/block/$drives->[$i]{'id'}/device/";
|
|
}
|
|
elsif ($drives->[$i]{'id'} =~ /mmcblk/){
|
|
$block_type = 'mmc';
|
|
$working_path = "/sys/block/$drives->[$i]{'id'}/device/";
|
|
}
|
|
elsif ($drives->[$i]{'id'} =~ /nvme/){
|
|
$block_type = 'nvme';
|
|
# this results in:
|
|
# /sys/devices/pci0000:00/0000:00:03.2/0000:06:00.0/nvme/nvme0/nvme0n1
|
|
# but we want to go one level down so slice off trailing nvme0n1
|
|
$working_path = Cwd::abs_path("/sys/block/$drives->[$i]{'id'}");
|
|
$working_path =~ s/nvme[^\/]*$//;
|
|
}
|
|
if ($working_path){
|
|
$drives->[$i]{'abs-path'} = Cwd::abs_path($working_path);
|
|
}
|
|
main::log_data('data',"working path: $working_path") if $b_log;
|
|
if ($b_admin && -e "/sys/block/"){
|
|
($drives->[$i]{'block-logical'},$drives->[$i]{'block-physical'}) = @{block_data($drives->[$i]{'id'})};
|
|
}
|
|
if ($block_type && $scsi && @$scsi && @by_id && ! -e "${working_path}model" &&
|
|
! -e "${working_path}name"){
|
|
## ok, ok, it's incomprehensible, search /dev/disk/by-id for a line that contains the
|
|
# discovered disk name AND ends with the correct identifier, sdx
|
|
# get rid of whitespace for some drive names and ids, and extra data after - in name
|
|
SCSI:
|
|
foreach my $row (@$scsi){
|
|
if ($row->{'model'}){
|
|
$row->{'model'} = (split(/\s*-\s*/,$row->{'model'}))[0];
|
|
foreach my $id (@by_id){
|
|
if ($id =~ /$row->{'model'}/ && "/dev/$drives->[$i]{'id'}" eq Cwd::abs_path($id)){
|
|
$drives->[$i]{'firmware'} = $row->{'firmware'};
|
|
$drives->[$i]{'model'} = $row->{'model'};
|
|
$drives->[$i]{'vendor'} = $row->{'vendor'};
|
|
last SCSI;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# note: an entire class of model names gets truncated by /sys so that should be the last
|
|
# in priority re tests.
|
|
elsif ((!@$disk_data || !$disk_data->[0]) && $block_type){
|
|
# NOTE: while path ${working_path}vendor exists, it contains junk value, like: ATA
|
|
$path = "${working_path}model";
|
|
if (-r $path){
|
|
$model = main::reader($path,'strip',0);
|
|
$drives->[$i]{'model'} = $model if $model;
|
|
}
|
|
elsif ($block_type eq 'mmc' && -r "${working_path}name"){
|
|
$path = "${working_path}name";
|
|
$model = main::reader($path,'strip',0);
|
|
$drives->[$i]{'model'} = $model if $model;
|
|
}
|
|
}
|
|
if (!$drives->[$i]{'model'} && @$disk_data){
|
|
$drives->[$i]{'model'} = $disk_data->[0] if $disk_data->[0];
|
|
$drives->[$i]{'vendor'} = $disk_data->[1] if $disk_data->[1];
|
|
}
|
|
# maybe rework logic if find good scsi data example, but for now use this
|
|
elsif ($drives->[$i]{'model'} && !$drives->[$i]{'vendor'}){
|
|
$drives->[$i]{'model'} = main::clean_disk($drives->[$i]{'model'});
|
|
my $result = disk_vendor($drives->[$i]{'model'},'');
|
|
$drives->[$i]{'model'} = $result->[1] if $result->[1];
|
|
$drives->[$i]{'vendor'} = $result->[0] if $result->[0];
|
|
}
|
|
if ($working_path){
|
|
$path = "${working_path}removable";
|
|
if (-r $path && main::reader($path,'strip',0)){
|
|
$drives->[$i]{'type'} = 'Removable' ; # 0/1 value
|
|
}
|
|
}
|
|
my $peripheral = peripheral_data($drives->[$i]{'id'});
|
|
# note: we only want to update type if we found a peripheral, otherwise preserve value
|
|
$drives->[$i]{'type'} = $peripheral if $peripheral;
|
|
# print "type:$drives->[$i]{'type'}\n";
|
|
if ($extra > 0){
|
|
$drives->[$i]{'temp'} = hdd_temp("$drives->[$i]{'id'}");
|
|
if ($extra > 1){
|
|
my $speed_data = drive_speed($drives->[$i]{'id'});
|
|
# only assign if defined / not 0
|
|
$drives->[$i]{'speed'} = $speed_data->[0] if $speed_data->[0];
|
|
$drives->[$i]{'lanes'} = $speed_data->[1] if $speed_data->[1];
|
|
if (@$disk_data && $disk_data->[2]){
|
|
$drives->[$i]{'serial'} = $disk_data->[2];
|
|
}
|
|
else {
|
|
$path = "${working_path}serial";
|
|
if (-r $path){
|
|
$serial = main::reader($path,'strip',0);
|
|
$drives->[$i]{'serial'} = $serial if $serial;
|
|
}
|
|
}
|
|
if ($extra > 2 && !$drives->[$i]{'firmware'}){
|
|
my @fm = ('rev','fmrev','firmware_rev'); # 0 ~ default; 1 ~ mmc; 2 ~ nvme
|
|
foreach my $firmware (@fm){
|
|
$path = "${working_path}$firmware";
|
|
if (-r $path){
|
|
$drives->[$i]{'firmware'} = main::reader($path,'strip',0);
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if ($extra > 2){
|
|
my $result = disk_data_advanced($pt_cmd,$drives->[$i]{'id'});
|
|
$pt_cmd = $result->[0];
|
|
$drives->[$i]{'partition-table'} = uc($result->[1]) if $result->[1];
|
|
if ($result->[2]){
|
|
$drives->[$i]{'rotation'} = $result->[2];
|
|
$drives->[$i]{'tech'} = 'HDD';
|
|
}
|
|
elsif (($block_type && $block_type ne 'sdx') ||
|
|
# note: this case could conceivabley be wrong for a spun down HDD
|
|
(defined $result->[2] && $result->[2] eq '0') ||
|
|
($drives->[$i]{'model'} &&
|
|
$drives->[$i]{'model'} =~ /(flash|mmc|msata|\bm[\.-]?2\b|nvme|ssd|solid\s?state)/i)){
|
|
$drives->[$i]{'tech'} = 'SSD';
|
|
}
|
|
}
|
|
}
|
|
main::log_data('dump','$drives',$drives) if $b_log;
|
|
print Data::Dumper::Dumper $drives if $dbg[24];
|
|
eval $end if $b_log;
|
|
return $drives;
|
|
}
|
|
|
|
# camcontrol identify <device> |grep ^serial (this might be (S)ATA specific)
|
|
# smartcl -i <device> |grep ^Serial
|
|
# see smartctl; camcontrol devlist; gptid status;
|
|
sub bsd_data {
|
|
eval $start if $b_log;
|
|
my ($used) = @_;
|
|
my (@drives,@softraid,@temp);
|
|
my ($i,$logical_size,$size,$working) = (0,0,0,0);
|
|
my $file = $system_files{'dmesg-boot'};
|
|
DiskDataBSD::set() if !$loaded{'disk-data-bsd'};
|
|
# we don't want non dboot disk data from gpart or disklabel
|
|
if ($file && ! -r $file){
|
|
$size = main::message('dmesg-boot-permissions');
|
|
}
|
|
elsif (!$file){
|
|
$size = main::message('dmesg-boot-missing');
|
|
}
|
|
elsif (%disks_bsd){
|
|
if ($sysctl{'softraid'}){
|
|
@softraid = map {$_ =~ s/.*\(([^\)]+)\).*/$1/;$_} @{$sysctl{'softraid'}};
|
|
}
|
|
foreach my $id (sort keys %disks_bsd){
|
|
next if !$disks_bsd{$id} || !$disks_bsd{$id}->{'size'};
|
|
$drives[$i]->{'id'} = $id;
|
|
$drives[$i]->{'firmware'} = '';
|
|
$drives[$i]->{'temp'} = '';
|
|
$drives[$i]->{'type'} = '';
|
|
$drives[$i]->{'vendor'} = '';
|
|
$drives[$i]->{'block-logical'} = $disks_bsd{$id}->{'block-logical'};
|
|
$drives[$i]->{'block-physical'} = $disks_bsd{$id}->{'block-physical'};
|
|
$drives[$i]->{'partition-table'} = $disks_bsd{$id}->{'scheme'};
|
|
$drives[$i]->{'serial'} = $disks_bsd{$id}->{'serial'};
|
|
$drives[$i]->{'size'} = $disks_bsd{$id}->{'size'};
|
|
# don't count OpenBSD RAID/CRYPTO virtual disks!
|
|
if ($drives[$i]->{'size'} && (!@softraid || !(grep {$id eq $_} @softraid))){
|
|
$size += $drives[$i]->{'size'} if $drives[$i]->{'size'};
|
|
}
|
|
$drives[$i]->{'spec'} = $disks_bsd{$id}->{'spec'};
|
|
$drives[$i]->{'speed'} = $disks_bsd{$id}->{'speed'};
|
|
$drives[$i]->{'type'} = $disks_bsd{$id}->{'type'};
|
|
# generate the synthetic model/vendor data
|
|
$drives[$i]->{'model'} = $disks_bsd{$id}->{'model'};
|
|
if ($drives[$i]->{'model'}){
|
|
my $result = disk_vendor($drives[$i]->{'model'},'');
|
|
$drives[$i]->{'vendor'} = $result->[0] if $result->[0];
|
|
$drives[$i]->{'model'} = $result->[1] if $result->[1];
|
|
}
|
|
if ($disks_bsd{$id}->{'duid'}){
|
|
$drives[$i]->{'duid'} = $disks_bsd{$id}->{'duid'};
|
|
}
|
|
if ($disks_bsd{$id}->{'partition-table'}){
|
|
$drives[$i]->{'partition-table'} = $disks_bsd{$id}->{'partition-table'};
|
|
}
|
|
$i++;
|
|
}
|
|
# raw_logical[0] is total of all logical raid/lvm found
|
|
# raw_logical[1] is total of all components found. If this totally fails,
|
|
# and we end up with raw logical less than used, give up
|
|
if (@raw_logical && $size && $raw_logical[0] &&
|
|
(!$used || $raw_logical[0] > $used)){
|
|
$logical_size = ($size - $raw_logical[1] + $raw_logical[0]);
|
|
}
|
|
if (!$size){
|
|
$size = main::message('data-bsd');
|
|
}
|
|
}
|
|
my $result = [{
|
|
'logical-size' => $logical_size,
|
|
'logical-free' => $raw_logical[2],
|
|
'size' => $size,
|
|
'used' => $used,
|
|
}];
|
|
#main::log_data('dump','$data',\@data) if $b_log;
|
|
if ($show{'disk'}){
|
|
push(@$result,@drives);
|
|
# print 'data:', Data::Dumper::Dumper \@data;
|
|
}
|
|
main::log_data('dump','$result',$result) if $b_log;
|
|
print Data::Dumper::Dumper $result if $dbg[24];
|
|
eval $end if $b_log;
|
|
return $result;
|
|
}
|
|
|
|
# return indexes: 0 - age; 1 - basic; 2 - fail
|
|
# make sure to update if fields added in smartctl_data()
|
|
sub smartctl_fields {
|
|
eval $start if $b_log;
|
|
my $data = [
|
|
[ # age
|
|
['smart-gsense-error-rate-ar','g-sense error rate'],
|
|
['smart-media-wearout-a','media wearout'],
|
|
['smart-media-wearout-t','threshold'],
|
|
['smart-media-wearout-f','alert'],
|
|
['smart-multizone-errors-av','write error rate'],
|
|
['smart-multizone-errors-t','threshold'],
|
|
['smart-udma-crc-errors-ar','UDMA CRC errors'],
|
|
['smart-udma-crc-errors-f','alert'],
|
|
],
|
|
[ # basic
|
|
['smart','SMART'],
|
|
['smart-error','SMART Message'],
|
|
['smart-support','state'],
|
|
['smart-status','health'],
|
|
['smart-power-on-hours','on'],
|
|
['smart-cycles','cycles'],
|
|
['smart-units-read','read-units'],
|
|
['smart-units-written','written-units'],
|
|
['smart-read','read'],
|
|
['smart-written','written'],
|
|
],
|
|
[ # fail
|
|
['smart-end-to-end-av','end-to-end'],
|
|
['smart-end-to-end-t','threshold'],
|
|
['smart-end-to-end-f','alert'],
|
|
['smart-raw-read-error-rate-av','read error rate'],
|
|
['smart-raw-read-error-rate-t','threshold'],
|
|
['smart-raw-read-error-rate-f','alert'],
|
|
['smart-reallocated-sectors-av','reallocated sector'],
|
|
['smart-reallocated-sectors-t','threshold'],
|
|
['smart-reallocated-sectors-f','alert'],
|
|
['smart-retired-blocks-av','retired block'],
|
|
['smart-retired-blocks-t','threshold'],
|
|
['smart-retired-blocks-f','alert'],
|
|
['smart-runtime-bad-block-av','runtime bad block'],
|
|
['smart-runtime-bad-block-t','threshold'],
|
|
['smart-runtime-bad-block-f','alert'],
|
|
['smart-seek-error-rate-av', 'seek error rate'],
|
|
['smart-seek-error-rate-t', 'threshold'],
|
|
['smart-seek-error-rate-f', 'alert'],
|
|
['smart-spinup-time-av','spin-up time'],
|
|
['smart-spinup-time-t','threshold'],
|
|
['smart-spinup-time-f','alert'],
|
|
['smart-ssd-life-left-av','life left'],
|
|
['smart-ssd-life-left-t','threshold'],
|
|
['smart-ssd-life-left-f','alert'],
|
|
['smart-unused-reserve-block-av','unused reserve block'],
|
|
['smart-unused-reserve-block-t','threshold'],
|
|
['smart-unused-reserve-block-f','alert'],
|
|
['smart-used-reserve-block-av','used reserve block'],
|
|
['smart-used-reserve-block-t','threshold'],
|
|
['smart-used-reserve-block-f','alert'],
|
|
['smart-unknown-1-a','attribute'],
|
|
['smart-unknown-1-v','value'],
|
|
['smart-unknown-1-w','worst'],
|
|
['smart-unknown-1-t','threshold'],
|
|
['smart-unknown-1-f','alert'],
|
|
['smart-unknown-2-a','attribute'],
|
|
['smart-unknown-2-v','value'],
|
|
['smart-unknown-2-w','worst'],
|
|
['smart-unknown-2-t','threshold'],
|
|
['smart-unknown-2-f','alert'],
|
|
['smart-unknown-3-a','attribute'],
|
|
['smart-unknown-3-v','value'],
|
|
['smart-unknown-3-w','worst'],
|
|
['smart-unknown-3-t','threshold'],
|
|
['smart-unknown-4-f','alert'],
|
|
['smart-unknown-4-a','attribute'],
|
|
['smart-unknown-4-v','value'],
|
|
['smart-unknown-4-w','worst'],
|
|
['smart-unknown-4-t','threshold'],
|
|
['smart-unknown-4-f','alert'],
|
|
['smart-unknown-5-f','alert'],
|
|
['smart-unknown-5-a','attribute'],
|
|
['smart-unknown-5-v','value'],
|
|
['smart-unknown-5-w','worst'],
|
|
['smart-unknown-5-t','threshold'],
|
|
['smart-unknown-5-f','alert'],
|
|
]
|
|
];
|
|
eval $end if $b_log;
|
|
return $data;
|
|
}
|
|
|
|
sub smartctl_data {
|
|
eval $start if $b_log;
|
|
my ($data) = @_;
|
|
my ($b_attributes,$b_intel,$b_kingston,$cmd,%holder,$id,@working,@result,@split);
|
|
my ($splitter,$num,$a,$f,$r,$t,$v,$w,$y) = (':\s*',0,0,8,1,5,3,4,6); # $y is type, $t threshold, etc
|
|
for (my $i = 0; $i < scalar @$data; $i++){
|
|
next if !$data->[$i]{'id'};
|
|
($b_attributes,$b_intel,$b_kingston,$splitter,$num,$a,$r) = (0,0,0,':\s*',0,0,1);
|
|
%holder = ();
|
|
# print $data->[$i]{'id'},"\n";
|
|
# m2 nvme failed on nvme0n1 drive id:
|
|
$id = $data->[$i]{'id'};
|
|
$id =~ s/n[0-9]+$// if $id =~ /^nvme/;
|
|
# openbsd needs the 'c' partition, which is the entire disk
|
|
$id .= 'c' if $bsd_type && $bsd_type eq 'openbsd';
|
|
$cmd = $alerts{'smartctl'}->{'path'} . " -AHi /dev/" . $id . ' 2>/dev/null';
|
|
@result = main::grabber("$cmd", '', 'strip');
|
|
main::log_data('dump','@result', \@result) if $b_log; # log before cleanup
|
|
@result = grep {!/^(smartctl|Copyright|==)/} @result;
|
|
print 'Drive:/dev/' . $id . ":\n", Data::Dumper::Dumper\@result if $dbg[12];
|
|
if (scalar @result < 5){
|
|
if (grep {/failed: permission denied/i} @result){
|
|
$data->[$i]{'smart-permissions'} = main::message('tool-permissions','smartctl');
|
|
}
|
|
elsif (grep {/unknown usb bridge/i} @result){
|
|
$data->[$i]{'smart-error'} = main::message('smartctl-usb');
|
|
}
|
|
# can come later in output too
|
|
elsif (grep {/A mandatory SMART command failed/i} @result){
|
|
$data->[$i]{'smart-error'} = main::message('smartctl-command');
|
|
}
|
|
elsif (grep {/open device.*Operation not supported by device/i} @result){
|
|
$data->[$i]{'smart-error'} = main::message('smartctl-open');
|
|
}
|
|
else {
|
|
$data->[$i]{'smart-error'} = main::message('tool-unknown-error','smartctl');
|
|
}
|
|
next;
|
|
}
|
|
else {
|
|
foreach my $row (@result){
|
|
if ($row =~ /^ID#/){
|
|
$splitter = '\s+';
|
|
$b_attributes = 1;
|
|
$a = 1;
|
|
$r = 9;
|
|
next;
|
|
}
|
|
@split = split(/$splitter/, $row);
|
|
next if !$b_attributes && ! defined $split[$r];
|
|
# some cases where drive not in db threshhold will be: ---
|
|
# value is usually 0 padded which confuses perl. However this will
|
|
# make subsequent tests easier, and will strip off leading 0s
|
|
if ($b_attributes){
|
|
$split[$t] = (main::is_numeric($split[$t])) ? int($split[$t]) : 0;
|
|
$split[$v] = (main::is_numeric($split[$v])) ? int($split[$v]) : 0;
|
|
}
|
|
# can occur later in output so retest it here
|
|
if ($split[$a] =~ /A mandatory SMART command failed/i){
|
|
$data->[$i]{'smart-error'} = main::message('smartctl-command');
|
|
}
|
|
## DEVICE INFO ##
|
|
if ($split[$a] eq 'Device Model'){
|
|
$b_intel = 1 if $split[$r] =~/\bintel\b/i;
|
|
$b_kingston = 1 if $split[$r] =~/kingston/i;
|
|
# usb/firewire/thunderbolt enclosure id method
|
|
if ($data->[$i]{'type'}){
|
|
my $result = disk_vendor("$split[$r]");
|
|
if ($data->[$i]{'model'} && $data->[$i]{'model'} ne $result->[1]){
|
|
$data->[$i]{'drive-model'} = $result->[1];
|
|
}
|
|
if ($data->[$i]{'vendor'} && $data->[$i]{'vendor'} ne $result->[0]){
|
|
$data->[$i]{'drive-vendor'} = $result->[0];
|
|
}
|
|
}
|
|
# fallback for very corner cases where primary model id failed
|
|
if (!$data->[$i]{'model'} && $split[$r]){
|
|
my $result = disk_vendor("$split[$r]");
|
|
$data->[$i]{'model'} = $result->[1] if $result->[1];
|
|
$data->[$i]{'vendor'} = $result->[0] if $result->[0] && !$data->[$i]{'vendor'};
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'Model Family'){
|
|
my $result = disk_vendor("$split[$r]");
|
|
$data->[$i]{'family'} = $result->[1] if $result->[1];
|
|
# $data->[$i]{'family'} =~ s/$data->[$i]{'vendor'}\s*// if $data->[$i]{'vendor'};
|
|
}
|
|
elsif ($split[$a] eq 'Firmware Version'){
|
|
# 01.01A01 vs 1A01
|
|
if ($data->[$i]{'firmware'} && $split[$r] !~ /$data->[$i]{'firmware'}/){
|
|
$data->[$i]{'drive-firmware'} = $split[$r];
|
|
}
|
|
elsif (!$data->[$i]{'firmware'}){
|
|
$data->[$i]{'firmware'} = $split[$r];
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'Rotation Rate'){
|
|
if ($split[$r] !~ /^Solid/){
|
|
$data->[$i]{'rotation'} = $split[$r];
|
|
$data->[$i]{'rotation'} =~ s/\s*rpm$//i;
|
|
$data->[$i]{'tech'} = 'HDD';
|
|
}
|
|
else {
|
|
$data->[$i]{'tech'} = 'SSD';
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'Serial Number'){
|
|
if (!$data->[$i]{'serial'}){
|
|
$data->[$i]{'serial'} = $split[$r];
|
|
}
|
|
elsif ($data->[$i]{'type'} && $split[$r] ne $data->[$i]{'serial'}){
|
|
$data->[$i]{'drive-serial'} = $split[$r];
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'SATA Version is'){
|
|
if ($split[$r] =~ /SATA ([0-9.]+), ([0-9.]+ [^\s]+)(\(current: ([1-9.]+ [^\s]+)\))?/){
|
|
$data->[$i]{'sata'} = $1;
|
|
$data->[$i]{'speed'} = $2 if !$data->[$i]{'speed'};
|
|
}
|
|
}
|
|
# seen both Size and Sizes. Linux will usually have both, BSDs not physical
|
|
elsif ($split[$a] =~ /^Sector Sizes?$/){
|
|
if ($data->[$i]{'type'} || !$data->[$i]{'block-logical'} || !$data->[$i]{'block-physical'}){
|
|
if ($split[$r] =~ m|^([0-9]+) bytes logical/physical|){
|
|
$data->[$i]{'block-logical'} = $1;
|
|
$data->[$i]{'block-physical'} = $1;
|
|
}
|
|
# 512 bytes logical, 4096 bytes physical
|
|
elsif ($split[$r] =~ m|^([0-9]+) bytes logical, ([0-9]+) bytes physical|){
|
|
$data->[$i]{'block-logical'} = $1;
|
|
$data->[$i]{'block-physical'} = $2;
|
|
}
|
|
}
|
|
}
|
|
## SMART STATUS/HEALTH ##
|
|
elsif ($split[$a] eq 'SMART support is'){
|
|
if ($split[$r] =~ /^(Available|Unavailable) /){
|
|
$data->[$i]{'smart'} = $1;
|
|
$data->[$i]{'smart'} = ($data->[$i]{'smart'} eq 'Unavailable') ? 'no' : 'yes';
|
|
}
|
|
elsif ($split[$r] =~ /^(Enabled|Disabled)/){
|
|
$data->[$i]{'smart-support'} = lc($1);
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'SMART overall-health self-assessment test result'){
|
|
$data->[$i]{'smart-status'} = $split[$r];
|
|
# seen nvme that only report smart health, not smart support
|
|
$data->[$i]{'smart'} = 'yes' if !$data->[$i]{'smart'};
|
|
}
|
|
|
|
## DEVICE CONDITION: temp/read/write/power on/cycles ##
|
|
# Attributes data fields, sometimes are same syntax as info block:...
|
|
elsif ($split[$a] eq 'Power_Cycle_Count' || $split[$a] eq 'Power Cycles'){
|
|
$data->[$i]{'smart-cycles'} = $split[$r] if $split[$r];
|
|
}
|
|
elsif ($split[$a] eq 'Power_On_Hours' || $split[$a] eq 'Power On Hours' ||
|
|
$split[$a] eq 'Power_On_Hours_and_Msec'){
|
|
if ($split[$r]){
|
|
$split[$r] =~ s/,//;
|
|
# trim off: h+0m+00.000s which is useless and at times empty anyway
|
|
$split[$r] =~ s/h\+.*$// if $split[$a] eq 'Power_On_Hours_and_Msec';
|
|
# $split[$r] = 43;
|
|
if ($split[$r] =~ /^([0-9]+)$/){
|
|
if ($1 > 9000){
|
|
$data->[$i]{'smart-power-on-hours'} = int($1/(24*365)) . 'y ' . int($1/24)%365 . 'd ' . $1%24 . 'h';
|
|
}
|
|
elsif ($1 > 100){
|
|
$data->[$i]{'smart-power-on-hours'} = int($1/24) . 'd ' . $1%24 . 'h';
|
|
}
|
|
else {
|
|
$data->[$i]{'smart-power-on-hours'} = $split[$r] . ' hrs';
|
|
}
|
|
}
|
|
else {
|
|
$data->[$i]{'smart-power-on-hours'} = $split[$r];
|
|
}
|
|
}
|
|
}
|
|
# 'Airflow_Temperature_Cel' like: 29 (Min/Max 14/43) so can't use -1 index
|
|
# Temperature like 29 Celsisu
|
|
elsif ($split[$a] eq 'Temperature_Celsius' || $split[$a] eq 'Temperature' ||
|
|
$split[$a] eq 'Airflow_Temperature_Cel'){
|
|
if (!$data->[$i]{'temp'} && $split[$r]){
|
|
$data->[$i]{'temp'} = $split[$r];
|
|
}
|
|
}
|
|
## DEVICE USE: Reads/Writes ##
|
|
elsif ($split[$a] eq 'Data Units Read'){
|
|
$data->[$i]{'smart-units-read'} = $split[$r];
|
|
}
|
|
elsif ($split[$a] eq 'Data Units Written'){
|
|
$data->[$i]{'smart-units-written'} = $split[$r];
|
|
}
|
|
elsif ($split[$a] eq 'Host_Reads_32MiB'){
|
|
$split[$r] = $split[$r] * 32 * 1024;
|
|
$data->[$i]{'smart-read'} = main::get_size($split[$r],'string');
|
|
}
|
|
elsif ($split[$a] eq 'Host_Writes_32MiB'){
|
|
$split[$r] = $split[$r] * 32 * 1024;
|
|
$data->[$i]{'smart-written'} = main::get_size($split[$r],'string');
|
|
}
|
|
elsif ($split[$a] eq 'Lifetime_Reads_GiB'){
|
|
$data->[$i]{'smart-read'} = $split[$r] . ' GiB';
|
|
}
|
|
elsif ($split[$a] eq 'Lifetime_Writes_GiB'){
|
|
$data->[$i]{'smart-written'} = $split[$r] . ' GiB';
|
|
}
|
|
elsif ($split[$a] eq 'Total_LBAs_Read'){
|
|
if (main::is_numeric($split[$r])){
|
|
# blocks in bytes, so convert to KiB, the internal unit here
|
|
# reports in 32MiB units, sigh
|
|
if ($b_intel){
|
|
$split[$r] = $split[$r] * 32 * 1024;
|
|
}
|
|
# reports in 1 GiB units, sigh
|
|
elsif ($b_kingston){
|
|
$split[$r] = $split[$r] * 1024 * 1024;
|
|
}
|
|
# rare fringe cases, cygwin run as user, block size will not be found
|
|
# this is what it's supposed to refer to
|
|
elsif ($data->[$i]{'block-logical'}) {
|
|
$split[$r] = int($data->[$i]{'block-logical'} * $split[$r] / 1024);
|
|
}
|
|
if ($b_intel || $b_kingston || $data->[$i]{'block-logical'}){
|
|
$data->[$i]{'smart-read'} = main::get_size($split[$r],'string');
|
|
}
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'Total_LBAs_Written'){
|
|
if (main::is_numeric($split[$r]) && $data->[$i]{'block-logical'}){
|
|
# blocks in bytes, so convert to KiB, the internal unit here
|
|
# reports in 32MiB units, sigh
|
|
if ($b_intel){
|
|
$split[$r] = $split[$r] * 32 * 1024;
|
|
}
|
|
# reports in 1 GiB units, sigh
|
|
elsif ($b_kingston){
|
|
$split[$r] = $split[$r] * 1024 * 1024;
|
|
}
|
|
# rare fringe cases, cygwin run as user, block size will not be found
|
|
# this is what it's supposed to refer to, in byte blocks
|
|
elsif ($data->[$i]{'block-logical'}) {
|
|
$split[$r] = int($data->[$i]{'block-logical'} * $split[$r] / 1024);
|
|
}
|
|
if ($b_intel || $b_kingston || $data->[$i]{'block-logical'}){
|
|
$data->[$i]{'smart-written'} = main::get_size($split[$r],'string');
|
|
}
|
|
}
|
|
}
|
|
## DEVICE OLD AGE ##
|
|
# 191 G-Sense_Error_Rate 0x0032 001 001 000 Old_age Always - 291
|
|
elsif ($split[$a] eq 'G-Sense_Error_Rate'){
|
|
# $data->[$i]{'smart-media-wearout'} = $split[$r];
|
|
if ($b_attributes && $split[$r] > 100){
|
|
$data->[$i]{'smart-gsense-error-rate-ar'} = $split[$r];
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'Media_Wearout_Indicator'){
|
|
# $data->[$i]{'smart-media-wearout'} = $split[$r];
|
|
# seen case where they used hex numbers because values
|
|
# were in 47 billion range in hex. You can't hand perl an unquoted
|
|
# hex number that is > 2^32 without tripping a perl warning
|
|
if ($b_attributes && $split[$r] && !main::is_hex("$split[$r]") && $split[$r] > 0){
|
|
$data->[$i]{'smart-media-wearout-av'} = $split[$v];
|
|
$data->[$i]{'smart-media-wearout-t'} = $split[$t];
|
|
$data->[$i]{'smart-media-wearout-f'} = $split[$f] if $split[$f] ne '-';
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'Multi_Zone_Error_Rate'){
|
|
# note: all t values are 0 that I have seen
|
|
if (($split[$v] - $split[$t]) < 50){
|
|
$data->[$i]{'smart-multizone-errors-av'} = $split[$v];
|
|
$data->[$i]{'smart-multizone-errors-t'} = $split[$v];
|
|
}
|
|
|
|
}
|
|
elsif ($split[$a] eq 'UDMA_CRC_Error_Count'){
|
|
if (main::is_numeric($split[$r]) && $split[$r] > 50){
|
|
$data->[$i]{'smart-udma-crc-errors-ar'} = $split[$r];
|
|
$data->[$i]{'smart-udma-crc-errors-f'} = main::message('smartctl-udma-crc') if $split[$r] > 500;
|
|
}
|
|
}
|
|
|
|
## DEVICE PRE-FAIL ##
|
|
elsif ($split[$a] eq 'Available_Reservd_Space'){
|
|
# $data->[$i]{'smart-available-reserved-space'} = $split[$r];
|
|
if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){
|
|
$data->[$i]{'smart-available-reserved-space-av'} = $split[$v];
|
|
$data->[$i]{'smart-available-reserved-space-t'} = $split[$t];
|
|
$data->[$i]{'smart-available-reserved-space-f'} = $split[$f] if $split[$f] ne '-';
|
|
}
|
|
}
|
|
## nvme splits these into two field/value sets
|
|
elsif ($split[$a] eq 'Available Spare'){
|
|
$split[$r] =~ s/%$//;
|
|
$holder{'spare'} = int($split[$r]) if main::is_numeric($split[$r]);
|
|
}
|
|
elsif ($split[$a] eq 'Available Spare Threshold'){
|
|
$split[$r] =~ s/%$//;
|
|
if ($holder{'spare'} && main::is_numeric($split[$r]) && $split[$r]/$holder{'spare'} > 0.92){
|
|
$data->[$i]{'smart-available-reserved-space-ar'} = $holder{'spare'};
|
|
$data->[$i]{'smart-available-reserved-space-t'} = int($split[$r]);
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'End-to-End_Error'){
|
|
if ($b_attributes && int($split[$r]) > 0 && $split[$t]){
|
|
$data->[$i]{'smart-end-to-end-av'} = $split[$v];
|
|
$data->[$i]{'smart-end-to-end-t'} = $split[$t];
|
|
$data->[$i]{'smart-end-to-end-f'} = $split[$f] if $split[$f] ne '-';
|
|
}
|
|
}
|
|
# seen raw value: 0/8415644
|
|
elsif ($split[$a] eq 'Raw_Read_Error_Rate'){
|
|
if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){
|
|
$data->[$i]{'smart-raw-read-error-rate-av'} = $split[$v];
|
|
$data->[$i]{'smart-raw-read-error-rate-t'} = $split[$t];
|
|
$data->[$i]{'smart-raw-read-error-rate-f'} = $split[$f] if $split[$f] ne '-';
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'Reallocated_Sector_Ct'){
|
|
if ($b_attributes && int($split[$r]) > 0 && $split[$t]){
|
|
$data->[$i]{'smart-reallocated-sectors-av'} = $split[$v];
|
|
$data->[$i]{'smart-reallocated-sectors-t'} = $split[$t];
|
|
$data->[$i]{'smart-reallocated-sectors-f'} = $split[$f] if $split[$f] ne '-';
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'Retired_Block_Count'){
|
|
if ($b_attributes && int($split[$r]) > 0 && $split[$t]){
|
|
$data->[$i]{'smart-retired-blocks-av'} = $split[$v];
|
|
$data->[$i]{'smart-retired-blocks-t'} = $split[$t];
|
|
$data->[$i]{'smart-retired-blocks-f'} = $split[$f] if $split[$f] ne '-';
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'Runtime_Bad_Block'){
|
|
if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){
|
|
$data->[$i]{'smart-runtime-bad-block-av'} = $split[$v];
|
|
$data->[$i]{'smart-runtime-bad-block-t'} = $split[$t];
|
|
$data->[$i]{'smart-runtime-bad-block-f'} = $split[$f] if $split[$f] ne '-';
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'Seek_Error_Rate'){
|
|
# value 72; threshold either 000 or 30
|
|
if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){
|
|
$data->[$i]{'smart-seek-error-rate-av'} = $split[$v];
|
|
$data->[$i]{'smart-seek-error-rate-t'} = $split[$t];
|
|
$data->[$i]{'smart-seek-error-rate-f'} = $split[$f] if $split[$f] ne '-';
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'Spin_Up_Time'){
|
|
# raw will always be > 0 on spinning disks
|
|
if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){
|
|
$data->[$i]{'smart-spinup-time-av'} = $split[$v];
|
|
$data->[$i]{'smart-spinup-time-t'} = $split[$t];
|
|
$data->[$i]{'smart-spinup-time-f'} = $split[$f] if $split[$f] ne '-';
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'SSD_Life_Left'){
|
|
# raw will always be > 0 on spinning disks
|
|
if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){
|
|
$data->[$i]{'smart-ssd-life-left-av'} = $split[$v];
|
|
$data->[$i]{'smart-ssd-life-left-t'} = $split[$t];
|
|
$data->[$i]{'smart-ssd-life-left-f'} = $split[$f] if $split[$f] ne '-';
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'Unused_Rsvd_Blk_Cnt_Tot'){
|
|
# raw will always be > 0 on spinning disks
|
|
if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){
|
|
$data->[$i]{'smart-unused-reserve-block-av'} = $split[$v];
|
|
$data->[$i]{'smart-unused-reserve-block-t'} = $split[$t];
|
|
$data->[$i]{'smart-unused-reserve-block-f'} = $split[$f] if $split[$f] ne '-';
|
|
}
|
|
}
|
|
elsif ($split[$a] eq 'Used_Rsvd_Blk_Cnt_Tot'){
|
|
# raw will always be > 0 on spinning disks
|
|
if ($b_attributes && $split[$v] && $split[$t] && $split[$t]/$split[$v] > 0.92){
|
|
$data->[$i]{'smart-used-reserve-block-av'} = $split[$v];
|
|
$data->[$i]{'smart-used-reserve-block-t'} = $split[$t];
|
|
$data->[$i]{'smart-used-reserve-block-f'} = $split[$f] if $split[$f] ne '-';
|
|
}
|
|
}
|
|
elsif ($b_attributes){
|
|
if ($split[$y] eq 'Pre-fail' && ($split[$f] ne '-' ||
|
|
($split[$t] && $split[$v] && $split[$t]/$split[$v] > 0.92))){
|
|
$num++;
|
|
$data->[$i]{'smart-unknown-' . $num . '-a'} = $split[$a];
|
|
$data->[$i]{'smart-unknown-' . $num . '-v'} = $split[$v];
|
|
$data->[$i]{'smart-unknown-' . $num . '-w'} = $split[$v];
|
|
$data->[$i]{'smart-unknown-' . $num . '-t'} = $split[$t];
|
|
$data->[$i]{'smart-unknown-' . $num . '-f'} = $split[$f] if $split[$f] ne '-';
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
print Data::Dumper::Dumper $data if $dbg[19];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# check for usb/firewire/[and thunderbolt when data found]
|
|
sub peripheral_data {
|
|
eval $start if $b_log;
|
|
my ($id) = @_;
|
|
my ($type) = ('');
|
|
# print "$id here\n";
|
|
if (@by_id){
|
|
foreach (@by_id){
|
|
if ("/dev/$id" eq Cwd::abs_path($_)){
|
|
# print "$id here\n";
|
|
if (/usb-/i){
|
|
$type = 'USB';
|
|
}
|
|
elsif (/ieee1394-/i){
|
|
$type = 'FireWire';
|
|
}
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
# note: sometimes with wwn- numbering usb does not appear in by-id but it does in by-path
|
|
if (!$type && @by_path){
|
|
foreach (@by_path){
|
|
if ("/dev/$id" eq Cwd::abs_path($_)){
|
|
if (/usb-/i){
|
|
$type = 'USB';
|
|
}
|
|
elsif (/ieee1394--/i){
|
|
$type = 'FireWire';
|
|
}
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $type;
|
|
}
|
|
|
|
sub disk_data_advanced {
|
|
eval $start if $b_log;
|
|
my ($set_cmd,$id) = @_;
|
|
my ($cmd,$pt,$program,@data);
|
|
my $advanced = [];
|
|
if ($set_cmd ne 'unset'){
|
|
$advanced->[0] = $set_cmd;
|
|
}
|
|
else {
|
|
# runs as user, but is SLOW: udisksctl info -b /dev/sda
|
|
# line: org.freedesktop.UDisks2.PartitionTable:
|
|
# Type: dos
|
|
if ($program = main::check_program('udevadm')){
|
|
$advanced->[0] = "$program info -q property -n ";
|
|
}
|
|
elsif ($b_root && -e "/lib/udev/udisks-part-id"){
|
|
$advanced->[0] = "/lib/udev/udisks-part-id /dev/";
|
|
}
|
|
elsif ($b_root && ($program = main::check_program('fdisk'))){
|
|
$advanced->[0] = "$program -l /dev/";
|
|
}
|
|
if (!$advanced->[0]){
|
|
$advanced->[0] = 'na'
|
|
}
|
|
}
|
|
if ($advanced->[0] ne 'na'){
|
|
$cmd = "$advanced->[0]$id 2>&1";
|
|
main::log_data('cmd',$cmd) if $b_log;
|
|
@data = main::grabber($cmd);
|
|
# for pre ~ 2.30 fdisk did not show gpt, but did show gpt scheme error, so
|
|
# if no gpt match, it's dos = mbr
|
|
if ($cmd =~ /fdisk/){
|
|
foreach (@data){
|
|
if (/^WARNING:\s+GPT/){
|
|
$advanced->[1] = 'gpt';
|
|
last;
|
|
}
|
|
elsif (/^Disklabel\stype:\s*(.+)/i){
|
|
$advanced->[1] = $1;
|
|
last;
|
|
}
|
|
}
|
|
$advanced->[1] = 'dos' if !$advanced->[1];
|
|
}
|
|
else {
|
|
foreach (@data){
|
|
if (/^(UDISKS_PARTITION_TABLE_SCHEME|ID_PART_TABLE_TYPE)/){
|
|
my @working = split('=', $_);
|
|
$advanced->[1] = $working[1];
|
|
}
|
|
elsif (/^ID_ATA_ROTATION_RATE_RPM/){
|
|
my @working = split('=', $_);
|
|
$advanced->[2] = $working[1];
|
|
}
|
|
last if defined $advanced->[1] && defined $advanced->[2];
|
|
}
|
|
}
|
|
$advanced->[1] = 'mbr' if $advanced->[1] && lc($advanced->[1]) eq 'dos';
|
|
}
|
|
eval $end if $b_log;
|
|
return $advanced;
|
|
}
|
|
|
|
sub scsi_data {
|
|
eval $start if $b_log;
|
|
my ($file) = @_;
|
|
my @temp = main::reader($file);
|
|
my $scsi = [];
|
|
my ($firmware,$model,$vendor) = ('','','');
|
|
foreach (@temp){
|
|
if (/Vendor:\s*(.*)\s+Model:\s*(.*)\s+Rev:\s*(.*)/i){
|
|
$vendor = $1;
|
|
$model = $2;
|
|
$firmware = $3;
|
|
}
|
|
if (/Type:/i){
|
|
if (/Type:\s*Direct-Access/i){
|
|
push(@$scsi, {
|
|
'vendor' => $vendor,
|
|
'model' => $model,
|
|
'firmware' => $firmware,
|
|
});
|
|
}
|
|
else {
|
|
($firmware,$model,$vendor) = ('','','');
|
|
}
|
|
}
|
|
}
|
|
main::log_data('dump','@$scsi', $scsi) if $b_log;
|
|
eval $end if $b_log;
|
|
return $scsi;
|
|
}
|
|
|
|
# @b_id has already been cleaned of partitions, wwn-, nvme-eui
|
|
sub disk_data_by_id {
|
|
eval $start if $b_log;
|
|
my ($device) = @_;
|
|
my ($model,$serial,$vendor) = ('','','');
|
|
my $disk_data = [];
|
|
foreach (@by_id){
|
|
if ($device eq Cwd::abs_path($_)){
|
|
my @data = split('_', $_);
|
|
last if scalar @data < 2; # scsi-3600508e000000000876995df43efa500
|
|
$serial = pop @data if @data;
|
|
# usb-PNY_USB_3.0_FD_3715202280-0:0
|
|
$serial =~ s/-[0-9]+:[0-9]+$//;
|
|
$model = join(' ', @data);
|
|
# get rid of the ata-|nvme-|mmc- etc
|
|
$model =~ s/^\/dev\/disk\/by-id\/([^-]+-)?//;
|
|
$model = main::clean_disk($model);
|
|
my $result = disk_vendor($model,$serial);
|
|
$vendor = $result->[0] if $result->[0];
|
|
$model = $result->[1] if $result->[1];
|
|
# print $device, '::', Cwd::abs_path($_),'::', $model, '::', $vendor, '::', $serial, "\n";
|
|
@$disk_data = ($model,$vendor,$serial);
|
|
last;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $disk_data;
|
|
}
|
|
|
|
## START DISK VENDOR BLOCK ##
|
|
# 0 - match pattern; 1 - replace pattern; 2 - vendor print; 3 - serial pattern
|
|
sub set_disk_vendors {
|
|
eval $start if $b_log;
|
|
$vendors = [
|
|
## MOST LIKELY/COMMON MATCHES ##
|
|
['(Crucial|^(C[34]00$|(C300-)?CTF|(FC)?CT|DDAC|M4(\b|SSD))|-CT|Gizmo!)','Crucial','Crucial',''],
|
|
# H10 HBRPEKNX0202A NVMe INTEL 512GB
|
|
['(\bINTEL\b|^(SSD(PAM|SA2)|HBR|(MEM|SSD)PEB?K|SSD(MCE|S[AC])))','\bINTEL\b','Intel',''],
|
|
# 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 HM
|
|
['(SAMSUNG|^(AWMB|[BC]DS20|[BC]WB|BJ[NT]|[BC]GND|CJ[NT]|CKT|CUT|[DG]3 Station|DUO\b|DUT|EB\dMW|GE4S5|[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|SD(S[S]?[ADQ]|SL\d+G|SU\d|\sUltra)|SDW[1-9]|SE\d{2}|SEM[1-9]|\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[numbers] excludes other ST starting devices
|
|
['([S]?SEAGATE|^((Barra|Fire)Cuda|BUP|EM\d{3}|Expansion|(ATA\s|HDD\s)?ST\d{2}|5AS|X[AFP])|Backup(\+|\s?Plus)\s?(Hub)?|DS2\d|Expansion Desk|FreeAgent|GoFlex|INIC|IronWolf|OneTouch|Slim\s?BK)','[S]?SEAGATE','Seagate',''],
|
|
['^(WD|WL[0]9]|Western Digital|My (Book|Passport)|\d*LPCX|Elements|easystore|EA[A-Z]S|EARX|EFRX|EZRX|\d*EAVS|G[\s-]Drive|i HTS|0JD|JP[CV]|MD0|M000|\d+(BEV|(00)?AAK|AAV|AZL|EA[CD]S)|PC\sSN|SN530|SPZX|3200[AB]|2500[BJ]|20G2|5000[AB]|6400[AB]|7500[AB]|00[ABL][A-Z]{2}|SSC\b)','(^WDC|Western\s?Digital)','Western Digital',''],
|
|
# rare cases WDC is in middle of string
|
|
['(\bWDC\b|1002FAEX)','','Western Digital',''],
|
|
|
|
## THEN BETTER KNOWN ONES ##
|
|
['^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',''],
|
|
# Force MP500
|
|
['^(Corsair|Force\s|(Flash\s*)?(Survivor|Voyager)|Neutron|Padlock)','^Corsair','Corsair',''],
|
|
['^(FUJITSU|MJA|MH[RTVWYZ]\d|MP|MAP\d|F\d00s?-)','^FUJITSU','Fujitsu',''],
|
|
# MAB3045SP shows as HP or Fujitsu, probably HP branded fujitsu
|
|
['^(MAB\d)','^(HP\b|FUJITSU)','Fujitsu/HP',''],
|
|
# note: 2012: wdc bought hgst
|
|
['^(DKR|HGST|Touro|54[15]0|7250|HC[CT]\d)','^HGST','HGST (Hitachi)',''], # HGST HUA
|
|
['^((ATA\s)?Hitachi|HCS|HD[PST]|DK\d|IC|(HDD\s)?HT|HU|HMS|HDE|0G\d|IHAT)','Hitachi','Hitachi',''],
|
|
# vb: VB0250EAVER but clashes with vbox; HP_SSD_S700_120G ;GB0500EAFYL GB starter too generic?
|
|
['^(HP\b|c350|DF\d|EG0\d{3}|EX9\d\d|G[BJ]\d|F[BK]|0-9]|HC[CPY]\d|MM\d{4}|[MV]B[0-6]|PSS|VO0|VK0|v\d{3}[bgorw]$|x\d{3}[w]$|XR\d{4})','^HP','HP',''],
|
|
['^(Lexar|LSD|JumpDrive|JD\s?Firefly|LX\d|WorkFlow)','^Lexar','Lexar',''], # mmc-LEXAR_0xb016546c; JD Firefly;
|
|
# these must come before maxtor because STM
|
|
['^STmagic','^STmagic','STmagic',''],
|
|
['^(STMicro|SMI|CBA)','^(STMicroelectronics|SMI)','SMI (STMicroelectronics)',''],
|
|
# note M2 M3 is usually maxtor, but can be samsung. Can conflict with Team: TM\d{4}|
|
|
['^(MAXTOR|Atlas|4R\d{2}|E0\d0L|L(250|500)|[KL]0[1-9]|Y\d{3}[A-Z]|STM\d|F\d{3}L)','^MAXTOR','Maxtor',''],
|
|
# OCZSSD2-2VTXE120G is OCZ-VERTEX2_3.5
|
|
['^(OCZ|Agility|APOC|D2|DEN|DEN|DRSAK|EC188|FTNC|GFGC|MANG|MMOC|NIMC|NIMR|PSIR|RALLY2|TALOS2|TMSC|TRSAK|VERTEX|Trion|Onyx|Vector[\s-]?15)','^OCZ[\s-]','OCZ',''],
|
|
['^(OWC|Aura|Mercury[\s-]?(Electra|Extreme))','^OWC\b','OWC',''],
|
|
['^(Philips|GoGear)','^Philips','Philips',''],
|
|
['^PIONEER','^PIONEER','Pioneer',''],
|
|
['^(PNY|Hook\s?Attache|SSD2SC|(SSD7?)?EP7|CS\d{3}|Elite\s?P)','^PNY\s','PNY','','^PNY'],
|
|
# note: get rid of: M[DGK] becasue mushkin starts with MK
|
|
# note: seen: KXG50ZNV512G NVMe TOSHIBA 512GB | THNSN51T02DUK NVMe TOSHIBA 1024GB
|
|
['(TOSHIBA|TransMemory|KBG4|^((A\s)?DT01A|M[GKQ]\d|HDW|SA\d{2}G$|(008|016|032|064|128)G[379E][0-9A]$|[S]?TOS|THN)|0930|KSG\d)','S?(TOSHIBA|0930)','Toshiba',''], # scsi-STOSHIBA_STOR.E_EDITION_
|
|
|
|
## LAST: THEY ARE SHORT AND COULD LEAD TO FALSE ID, OR ARE UNLIKELY ##
|
|
# unknown: AL25744_12345678; ADP may be usb 2.5" adapter; udisk unknown: Z1E6FTKJ 00AAKS
|
|
# SSD2SC240G726A10 MRS020A128GTS25C EHSAJM0016GB
|
|
['^2[\s-]?Power','^2[\s-]?Power','2-Power',''],
|
|
['^(3ware|9650SE)','^3ware','3ware (controller)',''],
|
|
['^5ACE','^5ACE','5ACE',''], # could be seagate: ST316021 5ACE
|
|
['^(Aar(vex)?|AX\d{2})','^AARVEX','AARVEX',''],
|
|
['^(AbonMax|ASU\d)','^AbonMax','AbonMax',''],
|
|
['^Acasis','^Acasis','Acasis (hub)',''],
|
|
['^Acclamator','^Acclamator','Acclamator',''],
|
|
['^(Actions|HS USB Flash|10d6)','^(Actions|10d6)','Actions',''],
|
|
['^(A-?DATA|ED\d{3}|NH01|Swordfish|SU\d{3}|SX\d{3}|XM\d{2})','^A-?DATA','ADATA',''],
|
|
['^Addlink','^Addlink','Addlink',''],
|
|
['^(ADplus|SuperVer\b)','^ADplus','ADplus',''],
|
|
['^ADTRON','^ADTRON','Adtron',''],
|
|
['^(Advantech|SQF)','^Advantech','Advantech',''],
|
|
['^AEGO','^AEGO','AEGO',''],
|
|
['^AFOX','^AFOX','AFOX',''],
|
|
['^AFTERSHOCK','^AFTERSHOCK','AFTERSHOCK',''],
|
|
['^(Agile|AGI)','^(AGI|Agile\s?Gear\s?Int[a-z]*)','AGI',''],
|
|
['^Aigo','^Aigo','Aigo',''],
|
|
['^AirDisk','^AirDisk','AirDisk',''],
|
|
['^Aireye','^Aireye','Aireye',''],
|
|
['^Alcatel','^Alcatel','Alcatel',''],
|
|
['^(Alcor(\s?Micro)?|058F)','^(Alcor(\s?Micro)?|058F)','Alcor Micro',''],
|
|
['^Alfawise','^Alfawise','Alfawise',''],
|
|
['(^ALKETRON|FireWizard)','^ALKETRON','ALKETRON',''],
|
|
['^Android','^Android','Android',''],
|
|
['^ANACOMDA','^ANACOMDA','ANACOMDA',''],
|
|
['^Ant[\s_-]?Esports','^Ant[\s_-]?Esports','Ant Esports',''],
|
|
['^Anucell','^Anucell','Anucell',''],
|
|
['^Apotop','^Apotop','Apotop',''],
|
|
# must come before AP|Apacer
|
|
['^(APPLE|iPod|SSD\sSM\d+[CEGT])','^APPLE','Apple',''],
|
|
['^(AP|Apacer)','^Apacer','Apacer',''],
|
|
['^(Apricom|SATAWire)','^Apricom','Apricom',''],
|
|
['^(A-?RAM|ARSSD)','^A-?RAM','A-RAM',''],
|
|
['^Arch','^Arch(\s*Memory)?','Arch Memory',''],
|
|
['^(Asenno|AS[1-9])','^Asenno','Asenno',''],
|
|
['^Asgard','^Asgard','Asgard',''],
|
|
['^(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|WR20)','^BHT','BHT',''],
|
|
['^(Big\s?Reservoir|B[RG][_\s-])','^Big\s?Reservoir','Big Reservoir',''],
|
|
['^BIOSTAR','^BIOSTAR','Biostar',''],
|
|
['^BIWIN','^BIWIN','BIWIN',''],
|
|
['^Blackpcs','^Blackpcs','Blackpcs',''],
|
|
['^(BlitzWolf|BW-?PSSD)','^BlitzWolf','BlitzWolf',''],
|
|
['^(BlueRay|SDM\d)','^BlueRay','BlueRay',''],
|
|
['^Bory','^Bory','Bory',''],
|
|
['^Braveeagle','^Braveeagle','BraveEagle',''],
|
|
['^(BUFFALO|BSC)','^BUFFALO','Buffalo',''], # usb: BSCR05TU2
|
|
['^Bugatek','^Bugatek','Bugatek',''],
|
|
['^Bulldozer','^Bulldozer','Bulldozer',''],
|
|
['^BUSlink','^BUSlink','BUSlink',''],
|
|
['^(Canon|MP49)','^Canon','Canon',''],
|
|
['^Centerm','^Centerm','Centerm',''],
|
|
['^(Centon|DS pro)','^Centon','Centon',''],
|
|
['^(CFD|CSSD)','^CFD','CFD',''],
|
|
['^CHIPAL','^CHIPAL','CHIPAL',''],
|
|
['^(Chipsbank|CHIPSBNK)','^Chipsbank','Chipsbank',''],
|
|
['^(Chipfancie)','^Chipfancier','Chipfancier',''],
|
|
['^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',''],
|
|
['^(Disney|PIX[\s]?JR)','^Disney','Disney',''],
|
|
['^(Doggo|DQ-|Sendisk|Shenchu)','^(doggo|Sendisk(.?Shenchu)?|Shenchu(.?Sendisk)?)','Doggo (SENDISK/Shenchu)',''],
|
|
['^(Dogfish|M\.2 2242|Shark)','^Dogfish(\s*Technology)?','Dogfish Technology',''],
|
|
['^DragonDiamond','^DragonDiamond','DragonDiamond',''],
|
|
['^(DREVO\b|X1\s\d+[GT])','^DREVO','Drevo',''],
|
|
['^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',''],
|
|
['^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',''],
|
|
['^Fanxiang','^Fanxiang','Fanxiang',''],
|
|
['^(Faspeed|K3[\s-])','^Faspeed','Faspeed',''],
|
|
['^FASTDISK','^FASTDISK','FASTDISK',''],
|
|
['^Festtive','^Festtive','Festtive',''],
|
|
['^FiiO','^FiiO','FiiO',''],
|
|
['^(FIKWOT|FS\d{3})','^FIKWOT','Kikwot',''],
|
|
['^Fordisk','^Fordisk','Fordisk',''],
|
|
# FK0032CAAZP/FB160C4081 FK or FV can be HP but can be other things
|
|
['^(FORESEE|B[123]0)|P900F|S900M','^FORESEE','Foresee',''],
|
|
['^Founder','^Founder','Founder',''],
|
|
['^(FOXLINE|FLD)','^FOXLINE','Foxline',''], # russian vendor?
|
|
['^(GALAX\b|Gamer\s?L|TA\dD|Gamer[\s-]?V)','^GALAX','GALAX',''],
|
|
['^Freecom','^Freecom(\sFreecom)?','Freecom',''],
|
|
['^(FronTech)','^FronTech','Frontech',''],
|
|
['^(Fuhler|FL-D\d{3})','^Fuhler','Fuhler',''],
|
|
['^Gaiver','^Gaiver','Gaiver',''],
|
|
['^Galaxy\b','^Galaxy','Galaxy',''],
|
|
['^Gamer[_\s-]?Black','^Gamer[_\s-]?Black','Gamer Black',''],
|
|
['^(Garmin|Fenix|Nuvi|Zumo)','^Garmin','Garmin',''],
|
|
['^Geil','^Geil','Geil',''],
|
|
['^GelL','^GelL','GelL',''], # typo for Geil? GelL ZENITH R3 120GB
|
|
['^(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',''],
|
|
['^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|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-]*Tech(nology)?','G-Technology',''],
|
|
['^(Gudga|GIM\d+|GVR\d)','^Gudga','Gudga',''],
|
|
['^(Hajaan|HS[1-9])','^Haajan','Haajan',''],
|
|
['^Haizhide','^Haizhide','Haizhide',''],
|
|
['^(Hama|FlashPen\s?Fancy)','^Hama','Hama',''],
|
|
['^(Hanye|Q60)','^Hanye','Hanye',''],
|
|
['^HDC','^HDC\b','HDC',''],
|
|
['^Hectron','^Hectron','Hectron',''],
|
|
['^HEMA','^HEMA','HEMA',''],
|
|
['(HEORIADY|^HX-0)','^HEORIADY','HEORIADY',''],
|
|
['^(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',''],
|
|
['^Hypertec','^Hypertec','Hypertec',''],
|
|
['^HyperX','^HyperX','HyperX',''],
|
|
['^(HYSSD|HY-)','^HYSSD','HYSSD',''],
|
|
['^(Hyundai|C2S\d|Sapphire)','^Hyundai','Hyundai',''],
|
|
['^(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|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',''],
|
|
['^Intaiel','^Intaiel','Intaiel',''],
|
|
['^(INM|Integral|V\s?Series)','^Integral(\s?Memory)?','Integral Memory',''],
|
|
['^(lntenso|Intenso|(Alu|Basic|Business|Micro|c?Mobile|Premium|Rainbow|Slim|Speed|Twister|Ultra) Line|Rainbow)','^Intenso','Intenso',''],
|
|
['^(I-?O Data|HDCL)','^I-?O Data','I-O Data',''],
|
|
['^(INO-|i\.?norys)','^i\.?norys','i.norys',''],
|
|
['^(Integrated[\s-]?Technology|IT\d+)','^Integrated[\s-]?Technology','Integrated Technology',''],
|
|
['^(Iomega|ZIP\b|Clik!)','^Iomega','Iomega',''],
|
|
['^(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',''],
|
|
['^KINGCOMP','^KINGCOMP','KingComp',''],
|
|
['(KingDian|^NGF|S(280|400))','KingDian','KingDian',''],
|
|
['^(Kingfast|TYFS)','^Kingfast','Kingfast',''],
|
|
['^KingMAX','^KingMAX','KingMAX',''],
|
|
['^Kingrich','^Kingrich','Kingrich',''],
|
|
['^Kingsand','^Kingsand','Kingsand',''],
|
|
['KING\s?SHA\s?RE','KING\s?SHA\s?RE','KingShare',''],
|
|
['^(KingSpec|ACSC|C3000|KS[DQ]|MSH|N[ET]-\d|P3$|P4\b|PA[_-]?(18|25)|Q-180|T-(3260|64|128)|Z(\d\s|F\d))','^KingSpec','KingSpec',''],
|
|
['^KingSSD','^KingSSD','KingSSD',''],
|
|
# kingwin docking, not actual drive
|
|
['^(EZD|EZ-Dock)','','Kingwin Docking Station',''],
|
|
['^Kingwin','^Kingwin','Kingwin',''],
|
|
['^KLLISRE','^KLLISRE','KLLISRE',''],
|
|
['(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',''],
|
|
['^LANTIC','^LANTIC','Lantic',''],
|
|
['^Lapcare','^Lapcare','Lapcare',''],
|
|
['^(Lazos|L-?ISS)','^Lazos','Lazos',''],
|
|
['^LDLC','^LDLC','LDLC',''],
|
|
# LENSE30512GMSP34MEAT3TA / UMIS RPITJ256PED2MWX
|
|
['^(LEN|UMIS|Think)','^Lenovo','Lenovo',''],
|
|
['^RPFT','','Lenovo O.E.M.',''],
|
|
# JAJS300M120C JAJM600M256C JAJS600M1024C JAJS600M256C JAJMS600M128G
|
|
['^(Leven|JAJ[MS])','^Leven','Leven',''],
|
|
['^(LEQIXIANG)','^LEQIXIANG','Leqixiang',''],
|
|
['^(LG\b|Xtick)','^LG','LG',''],
|
|
['(LITE[-\s]?ON[\s-]?IT)','LITE[-]?ON[\s-]?IT','LITE-ON IT',''], # LITEONIT_LSS-24L6G
|
|
# PH6-CE240-L; CL1-3D256-Q11 NVMe LITEON 256GB
|
|
['(LITE[-\s]?ON|^PH[1-9]|^DMT|^CV\d-|L(8[HT]|AT|C[HST]|JH|M[HST]|S[ST])-|^S900)','LITE[-]?ON','LITE-ON',''],
|
|
['^LONDISK','^LONDISK','LONDISK',''],
|
|
['^Longline','^Longline','Longline',''],
|
|
['^LuminouTek','^LuminouTek','LuminouTek',''],
|
|
['^(LSI|MegaRAID)','^LSI\b','LSI',''],
|
|
['^(M-Systems|DiskOnKey)','^M-Systems','M-Systems',''],
|
|
['^(Mach\s*Xtreme|MXSSD|MXU|MX[\s-])','^Mach\s*Xtreme','Mach Xtreme',''],
|
|
['^(MacroVIP|MV(\d|GLD))','^MacroVIP','MacroVIP',''], # maybe MV alone
|
|
['^Mainic','^Mainic','Mainic',''],
|
|
['^(MARSHAL\b|MAL\d)','^MARSHAL','Marshal',''],
|
|
['^Maxell','^Maxell','Maxell',''],
|
|
['^Maximus','^Maximus','Maximus',''],
|
|
['^MAXIO','^MAXIO','Maxio',''],
|
|
['^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\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\d)','^Motile','Motile',''],
|
|
['^(Motorola|XT\d{4}|Moto[\s-]?[EG])','^Motorola','Motorola',''],
|
|
['^Moweek','^Moweek','Moweek',''],
|
|
['^Move[\s-]?Speed','^Move[\s-]?Speed','Move Speed',''],
|
|
#MRMAD4B128GC9M2C
|
|
['^(MRMA|Memoright)','^Memoright','Memoright',''],
|
|
['^MSI\b','^MSI\b','MSI',''],
|
|
['^MTASE','^MTASE','MTASE',''],
|
|
['^MTRON','^MTRON','MTRON',''],
|
|
['^(MyDigitalSSD|BP[4X])','^MyDigitalSSD','MyDigitalSSD',''], # BP4 = BulletProof4
|
|
['^(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
|
|
['^ODYS','^ODYS','ODYS',''],
|
|
['^Olympus','^Olympus','Olympus',''],
|
|
['^Orico','^Orico','Orico',''],
|
|
['^Ortial','^Ortial','Ortial',''],
|
|
['^OSC','^OSC\b','OSC',''],
|
|
['^(Ovation)','^Ovation','Ovation',''],
|
|
['^oyunkey','^oyunkey','Oyunkey',''],
|
|
['^PALIT','PALIT','Palit',''], # ssd
|
|
['^Panram','^Panram','Panram',''], # ssd
|
|
['^(Parker|TP00)','^Parker','Parker',''],
|
|
['^(Pasoul|OASD)','^Pasoul','Pasoul',''],
|
|
['^(Patriot|PS[8F]|P2\d{2}|PBT|VPN|Viper|Burst|Blast|Blaze|Pyro|Ignite)','^Patriot([-\s]?Memory)?','Patriot',''],#Viper M.2 VPN100
|
|
['^PERC\b','','Dell PowerEdge RAID Card',''], # ssd
|
|
['(PHISON[\s-]?|ESR\d)','PHISON[\s-]?','Phison',''],# E12-256G-PHISON-SSD-B3-BB1
|
|
['^(Pichau[\s-]?Gaming|PG\d{2})','^Pichau[\s-]?Gaming','Pichau Gaming',''],
|
|
['^Pioneer','Pioneer','Pioneer',''],
|
|
['^Platinet','Platinet','Platinet',''],
|
|
['^(PLEXTOR|PX-)','^PLEXTOR','Plextor',''],
|
|
['^(Polion)','^Polion','Polion',''],
|
|
['^(PQI|Intelligent\s?Stick|Cool\s?Drive)','^PQI','PQI',''],
|
|
['^(Premiertek|QSSD|Quaroni)','^Premiertek','Premiertek',''],
|
|
['^(-?Pretec|UltimateGuard)','-?Pretec','Pretec',''],
|
|
['^(Prolific)','^Prolific( Technolgy Inc\.)?','Prolific',''],
|
|
# PS3109S9 is the result of an error condition with ssd controller: Phison PS3109
|
|
['^PUSKILL','^PUSKILL','Puskill',''],
|
|
['QEMU','^\d*QEMU( QEMU)?','QEMU',''], # 0QUEMU QEMU HARDDISK
|
|
['(^Quantum|Fireball)','^Quantum','Quantum',''],
|
|
['(^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',''],
|
|
['^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',''],
|
|
['^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
|
|
['^(Sea\s?Tech|Transformer)','^Sea\s?Tech','Sea Tech',''],
|
|
['^SigmaTel','^SigmaTel','SigmaTel',''],
|
|
# DIAMOND_040_GB
|
|
['^(SILICON\s?MOTION|SM\d|090c)','^(SILICON\s?MOTION|090c)','Silicon Motion',''],
|
|
['(Silicon[\s-]?Power|^SP[CP]C|^Silicon|^Diamond|^HasTopSunlightpeed)','Silicon[\s-]?Power','Silicon Power',''],
|
|
# simple drive could also maybe be hgst
|
|
['^(Simple\s?Tech|Simple[\s-]?Drive)','^Simple\s?Tech','SimpleTech',''],
|
|
['^(Simmtronics?|S[79]\d{2}|ZipX)','^Simmtronics?','Simmtronics',''],
|
|
['^SINTECHI?','^SINTECHI?','SinTech (adapter)',''],
|
|
['^SiS\b','^SiS','SiS',''],
|
|
['Smartbuy','\s?Smartbuy','Smartbuy',''], # SSD Smartbuy 60GB; mSata Smartbuy 3
|
|
# HFS128G39TND-N210A; seen nvme with name in middle
|
|
['(SK\s?HYNIX|^HF[MS]|^H[BC]G|^BC\d{3}|^SC[234]\d\d\sm?SATA)','\s?SK\s?HYNIX','SK Hynix',''],
|
|
['(hynix|^HAG\d|h[BC]8aP|PC\d{3})','hynix','Hynix',''],# nvme middle of string, must be after sk hynix
|
|
['^SH','','Smart Modular Tech.',''],
|
|
['^Skill','^Skill','Skill',''],
|
|
['^(SMART( Storage Systems)?|TX)','^(SMART( Storage Systems)?)','Smart Storage Systems',''],
|
|
['^Sobetter','^Sobetter','Sobetter',''],
|
|
['^Solidata','^Solidata','Solidata',''],
|
|
['^(SOLIDIGM|SSDPFK)','^SOLIDIGM\b','solidgm',''],
|
|
['^(Sony|IM9|Microvalut|S[FR]-)','^Sony','Sony',''],
|
|
['^(SSSTC|CL1-)','^SSSTC','SSSTC',''],
|
|
['^(SST|SG[AN])','^SST\b','SST',''],
|
|
['^STE[CK]','^STE[CK]','sTec',''], # wd bought this one
|
|
['^STORFLY','^STORFLY','StorFly',''],
|
|
['\dSUN\d','^SUN(\sMicrosystems)?','Sun Microsystems',''],
|
|
['^Sundisk','^Sundisk','Sundisk',''],
|
|
['^SUNEAST','^SUNEAST','SunEast',''],
|
|
['^SuperMicro','^SuperMicro','SuperMicro',''],
|
|
['^Supersonic','^Supersonic','Supersonic',''],
|
|
['^SuperSSpeed','^SuperSSpeed','SuperSSpeed',''],
|
|
# NOTE: F[MNETU] not reliable, g.skill starts with FM too:
|
|
# Seagate ST skips STT.
|
|
['^(Super\s*Talent|STT|F[HTZ]M\d|PicoDrive|Teranova)','','Super Talent',''],
|
|
['^(SF|Swissbit)','^Swissbit','Swissbit',''],
|
|
# ['^(SUPERSPEED)','^SUPERSPEED','SuperSpeed',''], # superspeed is a generic term
|
|
['^(SXMicro|NF8)','^SXMicro','SXMicro',''],
|
|
['^Taisu','^Taisu','Taisu',''],
|
|
['^(TakeMS|ColorLine)','^TakeMS','TakeMS',''],
|
|
['^Tammuz','^Tammuz','Tammuz',''],
|
|
['^TANDBERG','^TANDBERG','Tanberg',''],
|
|
['^(TC[\s-]*SUNBOW|X3\s\d+[GT])','^TC[\s-]*SUNBOW','TCSunBow',''],
|
|
['^(TDK|TF[1-9]\d|LoR)','^TDK','TDK',''],
|
|
['^TEAC','^TEAC','TEAC',''],
|
|
['^(TEAM|T[\s-]?Create|CX[12]\b|L\d\s?Lite|T\d{3,}[A-Z]|TM\d|(Dark\s?)?L3\b|T[\s-]?Force)','^TEAM(\s*Group)?','TeamGroup',''],
|
|
['^(Teclast|CoolFlash)','^Teclast','Teclast',''],
|
|
['^(tecmiyo)','^tecmiyo','TECMIYO',''],
|
|
['^Teelkoou','^Teelkoou','Teelkoou',''],
|
|
['^Tele2','^Tele2','Tele2',''],
|
|
['^Teleplan','^Teleplan','Teleplan',''],
|
|
['^TEUTONS','^TEUTONS','TEUTONS',''],
|
|
['^(Textorm)','^Textorm','Textorm',''], # B5 too short
|
|
['^(T(&|\s?and\s?)?G\d{3})','^T&G\b','T&G',''],
|
|
['^THU','^THU','THU',''],
|
|
['^Tiger[\s_-]?Jet','^Tiger[\s_-]?Jet','TigerJet',''],
|
|
['^Tigo','^Tigo','Tigo',''],
|
|
['^(Timetec|35TT)','^Timetec','Timetec',''],
|
|
['^TKD','^TKD','TKD',''],
|
|
['^TopSunligt','^TopSunligt','TopSunligt',''], # is this a typo? hard to know
|
|
['^TopSunlight','^TopSunlight','TopSunlight',''],
|
|
['^TOROSUS','^TOROSUS','Torosus',''],
|
|
['(Transcend|^((SSD\s|F)?TS|EZEX|USDU)|1307|JetDrive|JetFlash)','\b(Transcend|1307)\b','Transcend',''],
|
|
['^(TrekStor|DS (maxi|pocket)|DataStation)','^TrekStor','TrekStor',''],
|
|
['^Turbox','^Turbox','Turbox',''],
|
|
['^(TwinMOS|TW\d)','^TwinMOS','TwinMOS',''],
|
|
# note: udisk means usb disk, it's not a vendor ID
|
|
['^UDinfo','^UDinfo','UDinfo',''],
|
|
['^UMAX','^UMAX','UMAX',''],
|
|
['^(UMIS|RP[IJ]TJ)','^UMIS','UMIS',''],
|
|
['^USBTech','^USBTech','USBTech',''],
|
|
['^(UNIC2)','^UNIC2','UNIC2',''],
|
|
['^(UG|Unigen)','^Unigen','Unigen',''],
|
|
['^(UNITEK)','^UNITEK','UNITEK',''],
|
|
['^(USBest|UT16)','^USBest','USBest',''],
|
|
['^(OOS[1-9]|Utania)','Utania','Utania',''],
|
|
['^U-TECH','U-TECH','U-Tech',''],
|
|
['^(Value\s?Tech|VTP\d)','^Value\s?Tech','ValueTech',''],
|
|
['^VBOX','','VirtualBox',''],
|
|
['^(Veno|Scorp)','^Veno','Veno',''],
|
|
['^(Verbatim|STORE\s?\'?N\'?\s?(FLIP|GO)|Vi[1-9]|OTG\s?Tiny)','^Verbatim','Verbatim',''],
|
|
['^V-GEN','^V-GEN','V-Gen',''],
|
|
['^V[\s-]?(7|Seven)','^V[\s-]?(7|Seven)\b','VSeven',''],
|
|
['^(Victorinox|Swissflash)','^Victorinox','Victorinox',''],
|
|
['^(Visipro|SDVP)','^Visipro','Visipro',''],
|
|
['^VISIONTEK','^VISIONTEK','VisionTek',''],
|
|
['^VMware','^VMware','VMware',''],
|
|
['^(Vseky|Vaseky|V8\d{2})','^Vaseky','Vaseky',''], # ata-Vseky_V880_350G_
|
|
['^(Walgreen|Infinitive)','^Walgreen','Walgreen',''],
|
|
['^Walram','^Walram','WALRAM',''],
|
|
['^Walton','^Walton','Walton',''],
|
|
['^(Wearable|Air-?Stash)','^Wearable','Wearable',''],
|
|
['^Wellcomm','^Wellcomm','Wellcomm',''],
|
|
['^(wicgtyp|N[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',''],
|
|
['^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',''],
|
|
['^(YUCUN|R880)','^YUCUN','YUCUN',''],
|
|
['^(ZALMAN|ZM\b)','^ZALMAN','Zalman',''],
|
|
# Zao/J.Zau: marvell ssd controller
|
|
['^ZXIC','^ZXIC','ZXIC',''],
|
|
['^(Zebronics|ZEB)','^Zebronics','Zebronics',''],
|
|
['^Zenfast','^Zenfast','Zenfast',''],
|
|
['^Zenith','^Zenith','Zenith',''],
|
|
['^ZEUSLAP','^ZEUSLAP','ZEUSLAP',''],
|
|
['^ZEUSS','^ZEUSS','Zeuss',''],
|
|
['^(Zheino|CHN|CNM)','^Zheino','Zheino',''],
|
|
['^(Zotac|ZTSSD)','^Zotac','Zotac',''],
|
|
['^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 disk_vendor {
|
|
eval $start if $b_log;
|
|
my ($model,$serial) = @_;
|
|
my ($vendor) = ('');
|
|
return if !$model;
|
|
# 0 - match pattern; 1 - replace pattern; 2 - vendor print; 3 - serial pattern
|
|
# Data URLs: inxi-resources.txt Section: DriveItem device_vendor()
|
|
# $model = 'H10 HBRPEKNX0202A NVMe INTEL 512GB';
|
|
# $model = 'SD Ultra 3D 1TB';
|
|
set_disk_vendors() if !$vendors;
|
|
# prefilter this one, some usb enclosurs and wrong master/slave hdd show default
|
|
$model =~ s/^Initio[\s_]//i;
|
|
foreach my $row (@$vendors){
|
|
if ($model =~ /$row->[0]/i || ($row->[3] && $serial && $serial =~ /$row->[3]/)){
|
|
$vendor = $row->[2];
|
|
# Usually we want to assign N/A at output phase, maybe do this logic there?
|
|
if ($row->[1]){
|
|
if ($model !~ m/$row->[1]$/i){
|
|
$model =~ s/$row->[1]//i;
|
|
}
|
|
else {
|
|
$model = 'N/A';
|
|
}
|
|
}
|
|
$model =~ s/^[\/\[\s_-]+|[\/\s_-]+$//g;
|
|
$model =~ s/\s\s/ /g;
|
|
last;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return [$vendor,$model];
|
|
}
|
|
|
|
# Normally hddtemp requires root, but you can set user rights in /etc/sudoers.
|
|
# args: 0: /dev/<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 !$force{'hddtemp'} && -e "/sys/block/$device";
|
|
if (!$hdd_temp){
|
|
$device = "/dev/$device";
|
|
if ($device =~ /nvme/i){
|
|
if (!$b_nvme){
|
|
$b_nvme = 1;
|
|
if ($path = main::check_program('nvme')){
|
|
$nvme = $path;
|
|
}
|
|
}
|
|
if ($nvme){
|
|
$device =~ s/n[0-9]//;
|
|
@data = main::grabber("$sudoas$nvme smart-log $device 2>/dev/null");
|
|
foreach (@data){
|
|
my @row = split(/\s*:\s*/, $_);
|
|
next if !$row[0];
|
|
# other rows may have: Temperature sensor 1 :
|
|
if ($row[0] eq 'temperature'){
|
|
$row[1] =~ s/\s*C//;
|
|
$hdd_temp = $row[1];
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
if (!$b_hddtemp){
|
|
$b_hddtemp = 1;
|
|
if ($path = main::check_program('hddtemp')){
|
|
$hddtemp = $path;
|
|
}
|
|
}
|
|
if ($hddtemp){
|
|
$hdd_temp = (main::grabber("$sudoas$hddtemp -nq -u C $device 2>/dev/null"))[0];
|
|
}
|
|
}
|
|
$hdd_temp =~ s/\s?(Celsius|C)$// if $hdd_temp;
|
|
}
|
|
eval $end if $b_log;
|
|
return $hdd_temp;
|
|
}
|
|
|
|
sub hdd_temp_sys {
|
|
eval $start if $b_log;
|
|
my ($device) = @_;
|
|
my ($hdd_temp,$hdd_temp_alt,%sensors,@data,@working);
|
|
my ($holder,$index) = ('','');
|
|
my $path = "/sys/block/$device/device";
|
|
my $path_trimmed = Cwd::abs_path("/sys/block/$device");
|
|
# slice out the part of path that gives us hwmon in earlier kernel drivetemp
|
|
$path_trimmed =~ s%/(block|nvme)/.*$%% if $path_trimmed;
|
|
print "device: $device path: $path\n path_trimmed: $path_trimmed\n" if $dbg[21];
|
|
return if ! -e $path && (!$path_trimmed || ! -e "$path_trimmed/hwmon");
|
|
# first type, trimmed block,nvme (ata and nvme), 5.9 kernel:
|
|
# /sys/devices/pci0000:10/0000:10:08.1/0000:16:00.2/ata8/host7/target7:0:0/7:0:0:0/hwmon/hwmon5/
|
|
# /sys/devices/pci0000:10/0000:10:01.2/0000:13:00.0/hwmon/hwmon0/ < nvme
|
|
# /sys/devices/pci0000:00/0000:00:01.3/0000:01:00.1/ata2/host1/target1:0:0/1:0:0:0/hwmon/hwmon3/
|
|
# second type, 5.10+ kernel:
|
|
# /sys/devices/pci0000:20/0000:20:03.1/0000:21:00.0/nvme/nvme0/nvme0n1/device/hwmon1
|
|
# /sys/devices/pci0000:00/0000:00:08.1/0000:0b:00.2/ata12/host11/target11:0:0/11:0:0:0/block/sdd/device/hwmon/hwmon1
|
|
# we don't want these items: crit|max|min|lowest|highest
|
|
# original kernel 5.8/9 match for nvme and sd, 5.10+ match for sd
|
|
if (-e "$path_trimmed/hwmon/"){
|
|
@data = main::globber("$path_trimmed/hwmon/hwmon*/temp*_{input,label}");
|
|
}
|
|
# this case only happens if path_trimmed case isn't there, but leave in case
|
|
elsif (-e "$path/hwmon/"){
|
|
@data = main::globber("$path/hwmon/hwmon*/temp*_{input,label}");
|
|
}
|
|
# current match for nvme, but fails for 5.8/9 kernel nvme
|
|
else {
|
|
@data = main::globber("$path/hwmon*/temp*_{input,label}");
|
|
}
|
|
# seeing long lag to read temp input files for some reason
|
|
foreach (sort @data){
|
|
# print "file: $_\n";
|
|
# print(main::reader($_,'',0),"\n");
|
|
$path = $_;
|
|
# cleanup everything in front of temp, the path
|
|
$path =~ s/^.*\///;
|
|
@working = split('_', $path);
|
|
if ($holder ne $working[0]){
|
|
$holder = $working[0];
|
|
}
|
|
$sensors{$holder}->{$working[1]} = main::reader($_,'strip',0);
|
|
}
|
|
return if !%sensors;
|
|
if (keys %sensors == 1){
|
|
if ($sensors{$holder}->{'input'} && main::is_numeric($sensors{$holder}->{'input'})){
|
|
$hdd_temp = $sensors{$holder}->{'input'};
|
|
}
|
|
}
|
|
else {
|
|
# nvme drives can have > 1 temp types, but composite is the one we want if there
|
|
foreach (keys %sensors){
|
|
next if !$sensors{$_}->{'input'} || !main::is_numeric($sensors{$_}->{'input'});
|
|
if ($sensors{$_}->{'label'} && $sensors{$_}->{'label'} eq 'Composite'){
|
|
$hdd_temp = $sensors{$_}->{'input'};
|
|
last;
|
|
}
|
|
else{
|
|
$hdd_temp_alt = $sensors{$_}->{'input'};
|
|
}
|
|
}
|
|
$hdd_temp = $hdd_temp_alt if !defined $hdd_temp && defined $hdd_temp_alt;
|
|
}
|
|
$hdd_temp = sprintf("%.1f", $hdd_temp/1000) if $hdd_temp;
|
|
main::log_data('data',"device: $device temp: $hdd_temp") if $b_log;
|
|
main::log_data('dump','%sensors',\%sensors) if $b_log;
|
|
print Data::Dumper::Dumper \%sensors if $dbg[21];
|
|
eval $end if $b_log;
|
|
return $hdd_temp;
|
|
}
|
|
|
|
# args: 0: block id
|
|
sub block_data {
|
|
eval $start if $b_log;
|
|
my ($id) = @_;
|
|
# 0: logical block size 1: disk physical block size/partition block size;
|
|
my ($block_log,$block_size) = (0,0);
|
|
# my $path_size = "/sys/block/$id/size";
|
|
my $path_log_block = "/sys/block/$id/queue/logical_block_size";
|
|
my $path_phy_block = "/sys/block/$id/queue/physical_block_size";
|
|
# legacy system path
|
|
if (! -e $path_phy_block && -e "/sys/block/$id/queue/hw_sector_size"){
|
|
$path_phy_block = "/sys/block/$id/queue/hw_sector_size";
|
|
}
|
|
$block_log = main::reader($path_log_block,'',0) if -r $path_log_block;
|
|
$block_size = main::reader($path_phy_block,'',0) if -r $path_phy_block;
|
|
# print "l-b: $block_log p-b: $block_size raw: $size_raw\n";
|
|
my $blocks = [$block_log,$block_size];
|
|
main::log_data('dump','@blocks',$blocks) if $b_log;
|
|
eval $end if $b_log;
|
|
return $blocks;
|
|
}
|
|
|
|
sub drive_speed {
|
|
eval $start if $b_log;
|
|
my ($device) = @_;
|
|
my ($b_nvme,$lanes,$speed);
|
|
my $working = Cwd::abs_path("/sys/class/block/$device");
|
|
# print "$working\n";
|
|
if ($working){
|
|
my ($id);
|
|
# slice out the ata id:
|
|
# /sys/devices/pci0000:00:11.0/ata1/host0/target0:
|
|
if ($working =~ /^.*\/ata([0-9]+)\/.*/){
|
|
$id = $1;
|
|
}
|
|
# /sys/devices/pci0000:00/0000:00:05.0/virtio1/block/vda
|
|
elsif ($working =~ /^.*\/virtio([0-9]+)\/.*/){
|
|
$id = $1;
|
|
}
|
|
# /sys/devices/pci0000:10/0000:10:01.2/0000:13:00.0/nvme/nvme0/nvme0n1
|
|
elsif ($working =~ /^.*\/(nvme[0-9]+)\/.*/){
|
|
$id = $1;
|
|
$b_nvme = 1;
|
|
}
|
|
# do host last because the strings above might have host as well as their search item
|
|
# 0000:00:1f.2/host3/target3: increment by 1 sine ata starts at 1, but host at 0
|
|
elsif ($working =~ /^.*\/host([0-9]+)\/.*/){
|
|
$id = $1 + 1 if defined $1;
|
|
}
|
|
# print "$working $id\n";
|
|
if (defined $id){
|
|
if ($b_nvme){
|
|
$working = "/sys/class/nvme/$id/device/max_link_speed";
|
|
$speed = main::reader($working,'',0) if -r $working;
|
|
if (defined $speed && $speed =~ /([0-9\.]+)\sGT\/s/){
|
|
$speed = $1;
|
|
# pcie1: 2.5 GT/s; pcie2: 5.0 GT/s; pci3: 8 GT/s
|
|
# NOTE: PCIe 3 stopped using the 8b/10b encoding but a sample pcie3 nvme has
|
|
# rated speed of GT/s * .8 anyway. GT/s * (128b/130b)
|
|
$speed = ($speed <= 5) ? $speed * .8 : $speed * 128/130;
|
|
$speed = sprintf("%.1f",$speed) if $speed;
|
|
$working = "/sys/class/nvme/$id/device/max_link_width";
|
|
$lanes = main::reader($working,'',0) if -r $working;
|
|
$lanes ||= 1;
|
|
# https://www.edn.com/electronics-news/4380071/What-does-GT-s-mean-anyway-
|
|
# https://www.anandtech.com/show/2412/2
|
|
# http://www.tested.com/tech/457440-theoretical-vs-actual-bandwidth-pci-express-and-thunderbolt/
|
|
# PCIe 1,2 use “8b/10b” encoding: eight bits are encoded into a 10-bit symbol
|
|
# PCIe 3,4,5 use "128b/130b" encoding: 128 bits are encoded into a 130 bit symbol
|
|
$speed = ($speed * $lanes) . " Gb/s";
|
|
}
|
|
}
|
|
else {
|
|
$working = "/sys/class/ata_link/link$id/sata_spd";
|
|
$speed = main::reader($working,'',0) if -r $working;
|
|
$speed = main::clean_disk($speed) if $speed;
|
|
$speed =~ s/Gbps/Gb\/s/ if $speed;
|
|
}
|
|
}
|
|
}
|
|
# print "$working $speed\n";
|
|
eval $end if $b_log;
|
|
return [$speed,$lanes];
|
|
}
|
|
}
|
|
|
|
## GraphicItem
|
|
{
|
|
package GraphicItem;
|
|
my ($b_primary,$b_wayland_data,%graphics,%mesa_drivers,
|
|
$monitor_ids,$monitor_map);
|
|
my ($gpu_amd,$gpu_intel,$gpu_nv);
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my $rows = [];
|
|
my $num = 0;
|
|
if (%risc && !$use{'soc-gfx'} && !$use{'pci-tool'}){
|
|
my $key = 'Message';
|
|
@$rows = ({
|
|
main::key($num++,0,1,$key) => main::message('risc-pci',$risc{'id'})
|
|
});
|
|
}
|
|
else {
|
|
device_output($rows);
|
|
($gpu_amd,$gpu_intel,$gpu_nv) = ();
|
|
if (!@$rows){
|
|
my $key = 'Message';
|
|
my $message = '';
|
|
my $type = 'pci-card-data';
|
|
if ($pci_tool && $alerts{$pci_tool}->{'action'} eq 'permissions'){
|
|
$type = 'pci-card-data-root';
|
|
}
|
|
elsif (!$bsd_type && !%risc && !$pci_tool &&
|
|
$alerts{'lspci'}->{'action'} &&
|
|
$alerts{'lspci'}->{'action'} eq 'missing'){
|
|
$message = $alerts{'lspci'}->{'message'};
|
|
}
|
|
$message = main::message($type,'') if !$message;
|
|
@$rows = ({
|
|
main::key($num++,0,1,$key) => $message
|
|
});
|
|
}
|
|
}
|
|
# note: not perfect, but we need usb gfx to show for all types, soc, pci, etc
|
|
usb_output($rows);
|
|
display_output($rows);
|
|
display_api($rows);
|
|
(%graphics,$monitor_ids,$monitor_map) = ();
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
## DEVICE OUTPUT ##
|
|
sub device_output {
|
|
eval $start if $b_log;
|
|
return if !$devices{'graphics'};
|
|
my $rows = $_[0];
|
|
my ($j,$num) = (0,1);
|
|
my ($bus_id);
|
|
set_monitors_sys() if !$monitor_ids && -e '/sys/class/drm';
|
|
foreach my $row (@{$devices{'graphics'}}){
|
|
$num = 1;
|
|
# print "$row->[0] $row->[3]\n";
|
|
# not using 3D controller yet, needs research: |3D controller |display controller
|
|
# note: this is strange, but all of these can be either a separate or the same
|
|
# card. However, by comparing bus id, say: 00:02.0 we can determine that the
|
|
# cards are either the same or different. We want only the .0 version as a valid
|
|
# card. .1 would be for example: Display Adapter with bus id x:xx.1, not the right one
|
|
next if $row->[3] != 0;
|
|
# print "$row->[0] $row->[3]\n";
|
|
$j = scalar @$rows;
|
|
my $device = main::trimmer($row->[4]);
|
|
($bus_id) = ();
|
|
$device = ($device) ? main::clean_pci($device,'output') : 'N/A';
|
|
# have seen absurdly verbose card descriptions, with non related data etc
|
|
if (length($device) > 85 || $size{'max-cols'} < 110){
|
|
$device = main::filter_pci_long($device);
|
|
}
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $device,
|
|
},);
|
|
if ($extra > 0 && $use{'pci-tool'} && $row->[12]){
|
|
my $item = main::get_pci_vendor($row->[4],$row->[12]);
|
|
$rows->[$j]{main::key($num++,0,2,'vendor')} = $item if $item;
|
|
}
|
|
push(@{$graphics{'gpu-drivers'}},$row->[9]) if $row->[9];
|
|
my $driver = ($row->[9]) ? $row->[9]:'N/A';
|
|
$rows->[$j]{main::key($num++,1,2,'driver')} = $driver;
|
|
if ($row->[9] && !$bsd_type){
|
|
my $version = main::get_module_version($row->[9]);
|
|
$version ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'v')} = $version;
|
|
}
|
|
if ($b_admin && $row->[10]){
|
|
$row->[10] = main::get_driver_modules($row->[9],$row->[10]);
|
|
$rows->[$j]{main::key($num++,0,3,'alternate')} = $row->[10] if $row->[10];
|
|
}
|
|
if ($extra > 0 && $row->[5] && $row->[6] &&
|
|
$row->[5] =~ /^(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){
|
|
$bus_id = (!$row->[2] && !$row->[3]) ? 'N/A' : "$row->[2].$row->[3]";
|
|
if ($extra > 1 && $bus_id ne 'N/A'){
|
|
main::get_pcie_data($bus_id,$j,$rows,\$num,'gpu');
|
|
}
|
|
if ($extra > 1 && $monitor_ids){
|
|
port_output($bus_id,$j,$rows,\$num);
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'bus-ID')} = $bus_id;
|
|
}
|
|
if ($extra > 1){
|
|
my $chip_id = main::get_chip_id($row->[5],$row->[6]);
|
|
$rows->[$j]{main::key($num++,0,2,'chip-ID')} = $chip_id;
|
|
}
|
|
if ($extra > 2 && $row->[1]){
|
|
$rows->[$j]{main::key($num++,0,2,'class-ID')} = $row->[1];
|
|
}
|
|
if (!$bsd_type && $extra > 0 && $bus_id ne 'N/A' && $bus_id =~ /\.0$/){
|
|
my $temp = main::get_device_temp($bus_id);
|
|
if ($temp){
|
|
$rows->[$j]{main::key($num++,0,2,'temp')} = $temp . ' C';
|
|
}
|
|
}
|
|
# print "$row->[0]\n";
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub usb_output {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my (@ids,$driver,$path_id,$product,@temp2);
|
|
my ($j,$num) = (0,1);
|
|
return if !$usb{'graphics'};
|
|
foreach my $row (@{$usb{'graphics'}}){
|
|
# these tests only work for /sys based usb data for now
|
|
$num = 1;
|
|
$j = scalar @$rows;
|
|
# make sure to reset, or second device trips last flag
|
|
($driver,$path_id,$product) = ('','','');
|
|
$product = main::clean($row->[13]) if $row->[13];
|
|
$driver = $row->[15] if $row->[15];
|
|
$path_id = $row->[2] if $row->[2];
|
|
$product ||= 'N/A';
|
|
# note: for real usb video out, no generic drivers? webcams may have one though
|
|
if (!$driver){
|
|
if ($row->[14] eq 'audio-video'){
|
|
$driver = 'N/A';
|
|
}
|
|
else {
|
|
$driver = 'N/A';
|
|
}
|
|
}
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $product,
|
|
main::key($num++,0,2,'driver') => $driver,
|
|
main::key($num++,1,2,'type') => 'USB',
|
|
},);
|
|
if ($extra > 0){
|
|
if ($extra > 1){
|
|
$row->[8] ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'rev')} = $row->[8];
|
|
if ($row->[17]){
|
|
$rows->[$j]{main::key($num++,0,3,'speed')} = $row->[17];
|
|
}
|
|
if ($row->[24]){
|
|
$rows->[$j]{main::key($num++,0,3,'lanes')} = $row->[24];
|
|
}
|
|
if ($b_admin && $row->[22]){
|
|
$rows->[$j]{main::key($num++,0,3,'mode')} = $row->[22];
|
|
}
|
|
}
|
|
my $bus_id = "$path_id:$row->[1]";
|
|
if ($monitor_ids){
|
|
port_output($bus_id,$j,$rows,\$num);
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'bus-ID')} = $bus_id;
|
|
if ($extra > 1){
|
|
$row->[7] ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'chip-ID')} = $row->[7];
|
|
}
|
|
if ($extra > 2){
|
|
if (defined $row->[5] && $row->[5] ne ''){
|
|
$rows->[$j]{main::key($num++,0,2,'class-ID')} = "$row->[4]$row->[5]";
|
|
}
|
|
if ($row->[16]){
|
|
$rows->[$j]{main::key($num++,0,2,'serial')} = main::filter($row->[16]);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# args: $rows, $num by ref
|
|
sub port_output {
|
|
my ($bus_id,$j,$rows,$num) = @_;
|
|
my (@connected,@disabled,@empty);
|
|
foreach my $id (keys %$monitor_ids){
|
|
next if !$monitor_ids->{$id}{'status'};
|
|
if ($monitor_ids->{$id}{'path'} =~ m|\Q$bus_id/drm/\E|){
|
|
# status can be: connected|disconnected|unknown
|
|
if ($monitor_ids->{$id}{'status'} eq 'connected'){
|
|
if ($monitor_ids->{$id}{'enabled'} eq 'enabled'){
|
|
push(@connected,$id);
|
|
}
|
|
else {
|
|
push(@disabled,$id);
|
|
}
|
|
}
|
|
else {
|
|
push(@empty,$id);
|
|
}
|
|
}
|
|
}
|
|
if (@connected || @empty || @disabled){
|
|
my ($off,$active,$unused);
|
|
my $split = ','; # add space if many to allow for wrapping
|
|
$rows->[$j]{main::key($$num++,1,2,'ports')} = '';
|
|
$split = ', ' if scalar @connected > 3;
|
|
$active = (@connected) ? join($split,sort @connected) : 'none';
|
|
$rows->[$j]{main::key($$num++,0,3,'active')} = $active;
|
|
if (@disabled){
|
|
$split = (scalar @disabled > 3) ? ', ' : ',';
|
|
$off = join($split,sort @disabled);
|
|
$rows->[$j]{main::key($$num++,0,3,'off')} = $off;
|
|
}
|
|
$split = (scalar @empty > 3) ? ', ' : ',';
|
|
$unused = (@empty) ? join($split,sort @empty) : 'none';
|
|
$rows->[$j]{main::key($$num++,0,3,'empty')} = $unused;
|
|
}
|
|
}
|
|
|
|
## DISPLAY OUTPUT ##
|
|
sub display_output(){
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my ($num,$j) = (0,scalar @$rows);
|
|
# note: these may not always be set, they won't be out of X, for example
|
|
display_protocol();
|
|
# get rid of all inactive or disabled monitor port ids
|
|
set_active_monitors() if $monitor_ids;
|
|
$graphics{'protocol'} = 'wayland' if $force{'wayland'};
|
|
# note, since the compositor is the server with wayland, always show it
|
|
if ($extra > 1 || $graphics{'protocol'} eq 'wayland'){
|
|
set_compositor_data();
|
|
}
|
|
if ($b_display){
|
|
# Add compositors as data sources found
|
|
if ($graphics{'protocol'} eq 'wayland'){
|
|
display_data_wayland();
|
|
}
|
|
if (!$b_wayland_data){
|
|
display_data_x() if !$force{'wayland'};
|
|
}
|
|
}
|
|
else {
|
|
$graphics{'tty'} = tty_data();
|
|
}
|
|
# no xdpyinfo installed
|
|
# undef $graphics{'x-server'};
|
|
# Completes X server data if no previous detections, tests/adds xwayland
|
|
display_server_data();
|
|
if (!defined $graphics{'display-id'} && defined $ENV{'DISPLAY'}){
|
|
$graphics{'display-id'} = $ENV{'DISPLAY'};
|
|
}
|
|
# print Data::Dumper::Dumper $graphics{'x-server'};
|
|
# print Data::Dumper::Dumper \%graphics;
|
|
if (%graphics){
|
|
my ($driver_note,$resolution,$server_string) = ('','','');
|
|
my ($b_screen_monitors,$x_drivers);
|
|
$x_drivers = display_drivers_x() if !$force{'wayland'};
|
|
# 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){
|
|
$server_string = main::message('display-server');
|
|
push(@$rows,{
|
|
main::key($num++,1,1,'Display') => '',
|
|
main::key($num++,0,2,'server') => $server_string,
|
|
});
|
|
}
|
|
else {
|
|
$server_string ||= 'N/A';
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Display') => $graphics{'protocol'},
|
|
main::key($num++,1,2,'server') => $server_string,
|
|
});
|
|
if ($graphics{'x-server'} && $graphics{'x-server'}->[0][1]){
|
|
$rows->[$j]{main::key($num++,0,3,'v')} = $graphics{'x-server'}->[0][1];
|
|
}
|
|
if ($graphics{'x-server'} && $graphics{'x-server'}->[1][0]){
|
|
$rows->[$j]{main::key($num++,1,3,'with')} = $graphics{'x-server'}->[1][0];
|
|
if ($graphics{'x-server'}->[1][1]){
|
|
$rows->[$j]{main::key($num++,0,4,'v')} = $graphics{'x-server'}->[1][1];
|
|
}
|
|
}
|
|
if ($graphics{'compositors'}){
|
|
if (scalar @{$graphics{'compositors'}} == 1){
|
|
$rows->[$j]{main::key($num++,1,2,'compositor')} = $graphics{'compositors'}->[0][0];
|
|
if ($graphics{'compositors'}->[0][1]){
|
|
$rows->[$j]{main::key($num++,0,3,'v')} = $graphics{'compositors'}->[0][1];
|
|
}
|
|
}
|
|
else {
|
|
my $i =1;
|
|
$rows->[$j]{main::key($num++,1,2,'compositors')} = '';
|
|
foreach (@{$graphics{'compositors'}}){
|
|
$rows->[$j]{main::key($num++,1,3,$i)} = $_->[0];
|
|
if ($_->[1]){
|
|
$rows->[$j]{main::key($num++,0,4,'v')} = $_->[1];
|
|
}
|
|
$i++;
|
|
}
|
|
}
|
|
}
|
|
# note: if no xorg log, and if wayland, there will be no xorg drivers,
|
|
# obviously, so we use the driver(s) found in the card section.
|
|
# Those come from lspci kernel drivers so should be no xorg/wayland issues.
|
|
if (!@$x_drivers || !$x_drivers->[0]){
|
|
# Fallback: specific case: in Arch/Manjaro gdm run systems, Xorg.0.log is
|
|
# located inside this directory, which is not readable unless you are root
|
|
# Normally Arch gdm log is here: ~/.local/share/xorg/Xorg.1.log
|
|
if (!$graphics{'protocol'} || $graphics{'protocol'} ne 'wayland'){
|
|
# Problem: as root, wayland has no info anyway, including wayland detection.
|
|
if (-e '/var/lib/gdm' && !$b_root){
|
|
if ($graphics{'gpu-drivers'}){
|
|
$driver_note = main::message('display-driver-na-try-root');
|
|
}
|
|
else {
|
|
$driver_note = main::message('root-suggested');
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# if xvesa, will always have display-driver set
|
|
if ($graphics{'xvesa'} && $graphics{'display-driver'}){
|
|
$rows->[$j]{main::key($num++,0,2,'driver')} = join(',',@{$graphics{'display-driver'}});
|
|
}
|
|
else {
|
|
my $gpu_drivers = gpu_drivers_sys('all');
|
|
my $note_indent = 4;
|
|
if (@$gpu_drivers || $graphics{'dri-drivers'} || @$x_drivers){
|
|
$rows->[$j]{main::key($num++,1,2,'driver')} = '';
|
|
# The only wayland setups with x drivers have xorg, transitional that is.
|
|
if (@$x_drivers){
|
|
$rows->[$j]{main::key($num++,1,3,'X')} = '';
|
|
my $driver = ($x_drivers->[0]) ? join(',',@{$x_drivers->[0]}) : 'N/A';
|
|
$rows->[$j]{main::key($num++,1,4,'loaded')} = $driver;
|
|
if ($x_drivers->[1]){
|
|
$rows->[$j]{main::key($num++,0,4,'unloaded')} = join(',',@{$x_drivers->[1]});
|
|
}
|
|
if ($x_drivers->[2]){
|
|
$rows->[$j]{main::key($num++,0,4,'failed')} = join(',',@{$x_drivers->[2]});
|
|
}
|
|
if ($extra > 1 && $x_drivers->[3]){
|
|
$rows->[$j]{main::key($num++,0,4,'alternate')} = join(',',@{$x_drivers->[3]});
|
|
}
|
|
}
|
|
if ($graphics{'dri-drivers'}){
|
|
# note: if want to exclude if matches gpu/x driver, loop through and test.
|
|
# Here using all dri drivers found.
|
|
$rows->[$j]{main::key($num++,1,3,'dri')} = join(',',@{$graphics{'dri-drivers'}});
|
|
}
|
|
my $drivers;
|
|
if (@$gpu_drivers){
|
|
$drivers = join(',',@$gpu_drivers);
|
|
}
|
|
else {
|
|
$drivers = ($graphics{'gpu-drivers'}) ? join(',',@{$graphics{'gpu-drivers'}}): 'N/A';
|
|
}
|
|
$rows->[$j]{main::key($num++,1,3,'gpu')} = $drivers;
|
|
}
|
|
else {
|
|
$note_indent = 3;
|
|
$rows->[$j]{main::key($num++,1,2,'driver')} = 'N/A';
|
|
}
|
|
if ($driver_note){
|
|
$rows->[$j]{main::key($num++,0,$note_indent,'note')} = $driver_note;
|
|
}
|
|
}
|
|
}
|
|
if (!$show{'graphic-basic'} && $extra > 1 && $graphics{'display-rect'}){
|
|
$rows->[$j]{main::key($num++,0,2,'d-rect')} = $graphics{'display-rect'};
|
|
}
|
|
if (!$show{'graphic-basic'} && $extra > 1){
|
|
if (defined $graphics{'display-id'}){
|
|
$rows->[$j]{main::key($num++,0,2,'display-ID')} = $graphics{'display-id'};
|
|
}
|
|
if (defined $graphics{'display-screens'}){
|
|
$rows->[$j]{main::key($num++,0,2,'screens')} = $graphics{'display-screens'};
|
|
}
|
|
if (defined $graphics{'display-default-screen'} &&
|
|
$graphics{'display-screens'} && $graphics{'display-screens'} > 1){
|
|
$rows->[$j]{main::key($num++,0,2,'default screen')} = $graphics{'display-default-screen'};
|
|
}
|
|
}
|
|
if ($graphics{'no-screens'}){
|
|
my $res = (!$show{'graphic-basic'} && $extra > 1 && !$graphics{'xvesa'}) ? 'note' : 'resolution';
|
|
$rows->[$j]{main::key($num++,0,2,$res)} = $graphics{'no-screens'};
|
|
}
|
|
elsif ($graphics{'screens'}){
|
|
my ($diag,$dpi,$hz,$size);
|
|
my ($m_count,$basic_count,$screen_count) = (0,0,0);
|
|
my $s_count = ($graphics{'screens'}) ? scalar @{$graphics{'screens'}}: 0;
|
|
foreach my $main (@{$graphics{'screens'}}){
|
|
$m_count = scalar keys %{$main->{'monitors'}} if $main->{'monitors'};
|
|
$screen_count++;
|
|
($diag,$dpi,$hz,$resolution,$size) = ();
|
|
$j++ if !$show{'graphic-basic'};
|
|
if (!$show{'graphic-basic'} || $m_count == 0){
|
|
if (!$show{'graphic-basic'} && defined $main->{'screen'}){
|
|
$rows->[$j]{main::key($num++,1,2,'Screen')} = $main->{'screen'};
|
|
}
|
|
if ($main->{'res-x'} && $main->{'res-y'}){
|
|
$resolution = $main->{'res-x'} . 'x' . $main->{'res-y'};
|
|
if ($main->{'hz'} && $show{'graphic-basic'}){
|
|
$resolution .= '~' . $main->{'hz'} . 'Hz';
|
|
}
|
|
}
|
|
$resolution ||= 'N/A';
|
|
if ($s_count == 1 || !$show{'graphic-basic'}){
|
|
$rows->[$j]{main::key($num++,0,3,'s-res')} = $resolution;
|
|
}
|
|
elsif ($show{'graphic-basic'}){
|
|
$rows->[$j]{main::key($num++,0,3,'s-res')} = '' if $screen_count == 1;
|
|
$rows->[$j]{main::key($num++,0,3,$screen_count)} = $resolution;
|
|
}
|
|
if ($main->{'s-dpi'} && (!$show{'graphic-basic'} && $extra > 1)){
|
|
$rows->[$j]{main::key($num++,0,3,'s-dpi')} = $main->{'s-dpi'};
|
|
}
|
|
if (!$show{'graphic-basic'} && $extra > 2){
|
|
if ($main->{'size-missing'}){
|
|
$rows->[$j]{main::key($num++,0,3,'s-size')} = $main->{'size-missing'};
|
|
}
|
|
else {
|
|
if ($main->{'size-x'} && $main->{'size-y'}){
|
|
$size = $main->{'size-x'} . 'x' . $main->{'size-y'} .
|
|
'mm ('. $main->{'size-x-i'} . 'x' . $main->{'size-y-i'} . '")';
|
|
$rows->[$j]{main::key($num++,0,3,'s-size')} = $size;
|
|
}
|
|
if ($main->{'diagonal'}){
|
|
$diag = $main->{'diagonal-m'} . 'mm ('. $main->{'diagonal'} . '")';
|
|
$rows->[$j]{main::key($num++,0,3,'s-diag')} = $diag;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if ($main->{'monitors'}){
|
|
# print $basic_count . '::' . $m_count, "\n";
|
|
$b_screen_monitors = 1;
|
|
if ($show{'graphic-basic'}){
|
|
monitors_output_basic('screen',$main->{'monitors'},
|
|
$main->{'s-dpi'},$j,$rows,\$num);
|
|
}
|
|
else {
|
|
monitors_output_full('screen',$main->{'monitors'},
|
|
\$j,$rows,\$num);
|
|
}
|
|
}
|
|
elsif (!$show{'graphic-basic'} && $graphics{'no-monitors'}){
|
|
$rows->[$j]{main::key($num++,0,4,'monitors')} = $graphics{'no-monitors'};
|
|
}
|
|
}
|
|
}
|
|
elsif (!$b_display){
|
|
$graphics{'tty'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'tty')} = $graphics{'tty'};
|
|
}
|
|
# fallback, if no xrandr/xdpyinfo, if wayland, if console. Note we've
|
|
# deleted each key used in advanced_monitor_data() so those won't show again
|
|
if (!$b_screen_monitors && $monitor_ids && %$monitor_ids){
|
|
if ($show{'graphic-basic'}){
|
|
monitors_output_basic('monitor',$monitor_ids,'',$j,$rows,\$num);
|
|
}
|
|
else {
|
|
monitors_output_full('monitor',$monitor_ids,\$j,$rows,\$num);
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub monitors_output_basic {
|
|
eval $start if $b_log;
|
|
my ($type,$monitors,$s_dpi,$j,$row,$num) = @_;
|
|
my ($dpi,$resolution);
|
|
my ($basic_count,$m_count) = (0,scalar keys %{$monitors});
|
|
foreach my $key (sort keys %{$monitors}){
|
|
if ($type eq 'monitor' && (!$monitors->{$key}{'res-x'} ||
|
|
!$monitors->{$key}{'res-y'})){
|
|
next;
|
|
}
|
|
($dpi,$resolution) = ();
|
|
$basic_count++;
|
|
if ($monitors->{$key}{'res-x'} && $monitors->{$key}{'res-y'}){
|
|
$resolution = $monitors->{$key}{'res-x'} . 'x' . $monitors->{$key}{'res-y'};
|
|
}
|
|
# using main, not monitor, dpi because we want xorg dpi, not physical screen dpi
|
|
$dpi = $s_dpi if $resolution && $extra > 1 && $s_dpi;
|
|
if ($monitors->{$key}{'hz'} && $resolution){
|
|
$resolution .= '~' . $monitors->{$key}{'hz'} . 'Hz';
|
|
}
|
|
$resolution ||= 'N/A';
|
|
if ($basic_count == 1 && $m_count == 1){
|
|
$row->[$j]{main::key($$num++,0,2,'resolution')} = $resolution;
|
|
}
|
|
else {
|
|
if ($basic_count == 1){
|
|
$row->[$j]{main::key($$num++,1,2,'resolution')} = '';
|
|
}
|
|
$row->[$j]{main::key($$num++,0,3,$basic_count)} = $resolution;
|
|
}
|
|
if (!$show{'graphic-basic'} && $m_count == $basic_count && $dpi){
|
|
$row->[$j]{main::key($$num++,0,2,'s-dpi')} = $dpi;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# args: $j, $row, $num passed by ref
|
|
sub monitors_output_full {
|
|
eval $start if $b_log;
|
|
my ($type,$monitors,$j,$rows,$num) = @_;
|
|
my ($b_no_size,$resolution);
|
|
my ($m1,$m2,$m3,$m4) = ($type eq 'screen') ? (3,4,5,6) : (2,3,4,5);
|
|
# note: in case where mapped id != sys id, the key will not match 'monitor'
|
|
foreach my $key (sort keys %{$monitors}){
|
|
$$j++;
|
|
$rows->[$$j]{main::key($$num++,1,$m1,'Monitor')} = $monitors->{$key}{'monitor'};
|
|
if ($monitors->{$key}{'monitor-mapped'}){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'mapped')} = $monitors->{$key}{'monitor-mapped'};
|
|
}
|
|
if ($monitors->{$key}{'disabled'}){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'note')} = $monitors->{$key}{'disabled'};
|
|
}
|
|
if ($monitors->{$key}{'position'}){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'pos')} = $monitors->{$key}{'position'};
|
|
}
|
|
if ($monitors->{$key}{'model'}){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'model')} = $monitors->{$key}{'model'};
|
|
}
|
|
elsif ($monitors->{$key}{'model-id'}){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'model-id')} = $monitors->{$key}{'model-id'};
|
|
}
|
|
if ($extra > 2 && $monitors->{$key}{'serial'}){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'serial')} = main::filter($monitors->{$key}{'serial'});
|
|
}
|
|
if ($b_admin && $monitors->{$key}{'build-date'}){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'built')} = $monitors->{$key}{'build-date'};
|
|
}
|
|
if ($monitors->{$key}{'res-x'} || $monitors->{$key}{'res-y'} ||
|
|
$monitors->{$key}{'hz'} || $monitors->{$key}{'size-x'} ||
|
|
$monitors->{$key}{'size-y'}){
|
|
if ($monitors->{$key}{'res-x'} && $monitors->{$key}{'res-y'}){
|
|
$resolution = $monitors->{$key}{'res-x'} . 'x' . $monitors->{$key}{'res-y'};
|
|
}
|
|
$resolution ||= 'N/A';
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'res')} = $resolution;
|
|
}
|
|
else {
|
|
if ($b_display){
|
|
$resolution = main::message('monitor-na');
|
|
}
|
|
else {
|
|
$resolution = main::message('monitor-console');
|
|
}
|
|
$b_no_size = 1;
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'size-res')} = $resolution;
|
|
}
|
|
if ($extra > 2 && $monitors->{$key}{'hz'}){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'hz')} = $monitors->{$key}{'hz'};
|
|
}
|
|
if ($monitors->{$key}{'dpi'}){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'dpi')} = $monitors->{$key}{'dpi'};
|
|
}
|
|
if ($b_admin && $monitors->{$key}{'gamma'}){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'gamma')} = $monitors->{$key}{'gamma'};
|
|
}
|
|
if ($show{'edid'} && $monitors->{$key}{'colors'}){
|
|
$rows->[$$j]{main::key($$num++,1,$m2,'chroma')} = '';
|
|
$rows->[$$j]{main::key($$num++,1,$m3,'red')} = '';
|
|
$rows->[$$j]{main::key($$num++,0,$m4,'x')} = $monitors->{$key}{'colors'}{'red_x'};
|
|
$rows->[$$j]{main::key($$num++,0,$m4,'y')} = $monitors->{$key}{'colors'}{'red_y'};
|
|
$rows->[$$j]{main::key($$num++,1,$m3,'green')} = '';
|
|
$rows->[$$j]{main::key($$num++,0,$m4,'x')} = $monitors->{$key}{'colors'}{'green_x'};
|
|
$rows->[$$j]{main::key($$num++,0,$m4,'y')} = $monitors->{$key}{'colors'}{'green_y'};
|
|
$rows->[$$j]{main::key($$num++,1,$m3,'blue')} = '';
|
|
$rows->[$$j]{main::key($$num++,0,$m4,'x')} = $monitors->{$key}{'colors'}{'blue_x'};
|
|
$rows->[$$j]{main::key($$num++,0,$m4,'y')} = $monitors->{$key}{'colors'}{'blue_y'};
|
|
$rows->[$$j]{main::key($$num++,1,$m3,'white')} = '';
|
|
$rows->[$$j]{main::key($$num++,0,$m4,'x')} = $monitors->{$key}{'colors'}{'white_x'};
|
|
$rows->[$$j]{main::key($$num++,0,$m4,'y')} = $monitors->{$key}{'colors'}{'white_y'};
|
|
}
|
|
if ($extra > 2 && $monitors->{$key}{'scale'}){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'scale')} = $monitors->{$key}{'scale'};
|
|
}
|
|
if ($extra > 2 && $monitors->{$key}{'size-x'} && $monitors->{$key}{'size-y'}){
|
|
my $size = $monitors->{$key}{'size-x'} . 'x' . $monitors->{$key}{'size-y'} .
|
|
'mm ('. $monitors->{$key}{'size-x-i'} . 'x' . $monitors->{$key}{'size-y-i'} . '")';
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'size')} = $size;
|
|
}
|
|
if ($monitors->{$key}{'diagonal'}){
|
|
my $diag = $monitors->{$key}{'diagonal-m'} . 'mm ('. $monitors->{$key}{'diagonal'} . '")';
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'diag')} = $diag;
|
|
}
|
|
elsif ($b_display && !$b_no_size && !$monitors->{$key}{'size-x'} &&
|
|
!$monitors->{$key}{'size-y'}){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'size')} = main::message('monitor-na');;
|
|
}
|
|
if ($b_admin && $monitors->{$key}{'ratio'}){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'ratio')} = $monitors->{$key}{'ratio'};
|
|
}
|
|
if ($extra > 2){
|
|
if (!$monitors->{$key}{'modes'} || !@{$monitors->{$key}{'modes'}}){
|
|
$monitors->{$key}{'modes'} = ['N/A'];
|
|
}
|
|
my $cnt = scalar @{$monitors->{$key}{'modes'}};
|
|
if ($cnt == 1 || ($cnt > 2 && $show{'edid'})){
|
|
$rows->[$$j]{main::key($$num++,0,$m2,'modes')} = join(', ', @{$monitors->{$key}{'modes'}});
|
|
}
|
|
else {
|
|
$rows->[$$j]{main::key($$num++,1,$m2,'modes')} = '';
|
|
$rows->[$$j]{main::key($$num++,0,$m3,'max')} = ${$monitors->{$key}{'modes'}}[0];
|
|
$rows->[$$j]{main::key($$num++,0,$m3,'min')} = ${$monitors->{$key}{'modes'}}[-1];
|
|
}
|
|
}
|
|
if ($show{'edid'}){
|
|
if ($monitors->{$key}{'edid-errors'}){
|
|
$$j++;
|
|
my $cnt = 1;
|
|
$rows->[$$j]{main::key($$num++,1,$m2,'EDID-Errors')} = '';
|
|
foreach my $err (@{$monitors->{$key}{'edid-errors'}}){
|
|
$rows->[$$j]{main::key($$num++,0,$m3,$cnt)} = $err;
|
|
$cnt++;
|
|
}
|
|
}
|
|
if ($monitors->{$key}{'edid-warnings'}){
|
|
$$j++;
|
|
my $cnt = 1;
|
|
$rows->[$$j]{main::key($$num++,1,$m2,'EDID-Warnings')} = '';
|
|
foreach my $warn (@{$monitors->{$key}{'edid-warnings'}}){
|
|
$rows->[$$j]{main::key($$num++,0,$m3,$cnt)} = $warn;
|
|
$cnt++;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# we only want to see gpu drivers for wayland since otherwise it's x drivers.
|
|
# if ($b_display && $b_admin && $graphics{'protocol'} &&
|
|
# $graphics{'protocol'} eq 'wayland' && $monitors->{$key}{'drivers'}){
|
|
# $driver = join(',',@{$monitors->{$key}{'drivers'}});
|
|
# $rows->[$j]{main::key($$num++,0,$m2,'driver')} = $driver;
|
|
# }
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## DISPLAY API ##
|
|
|
|
# API Output #
|
|
|
|
# GLX/OpenGL EGL Vulkan XVesa
|
|
sub display_api {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
# print ("$b_display : $b_root\n");
|
|
# xvesa is absolute, if it's there, it works in or out of display
|
|
if ($graphics{'xvesa'}){
|
|
xvesa_output($rows);
|
|
return;
|
|
}
|
|
my ($b_egl,$b_egl_print,$b_glx,$b_glx_print,$b_vulkan,$api,$program,$type);
|
|
my $gl = {};
|
|
if ($fake{'egl'} || ($program = main::check_program('eglinfo'))){
|
|
gl_data('egl',$program,$rows,$gl);
|
|
$b_egl = 1;
|
|
}
|
|
if ($fake{'glx'} || ($program = main::check_program('glxinfo'))){
|
|
gl_data('glx',$program,$rows,$gl) if $b_display;
|
|
$b_glx = 1;
|
|
}
|
|
# Note: we let gl/egl output handle null or root null data issues
|
|
if ($gl->{'glx'}){
|
|
process_glx_data($gl->{'glx'},$b_glx);
|
|
}
|
|
# egl/vulkan give data out of display, and for root
|
|
# if ($b_egl}){
|
|
if ($b_egl && ($show{'graphic-full'} || !$gl->{'glx'})){
|
|
egl_output($rows,$gl);
|
|
$b_egl_print = 1;
|
|
}
|
|
# fill in whatever was missing from eglinfo, or if legacy system/no eglinfo
|
|
# if ($b_glx || $gl->{'glx'}){
|
|
if (($show{'graphic-full'} && ($b_glx || $gl->{'glx'})) ||
|
|
(!$show{'graphic-full'} && !$b_egl_print && ($b_glx || $gl->{'glx'}))){
|
|
opengl_output($rows,$gl);
|
|
$b_glx = 1;
|
|
$b_glx_print = 1;
|
|
}
|
|
# if ($fake{'vulkan'} || ($program = main::check_program('vulkaninfo'))){
|
|
if (($fake{'vulkan'} || ($program = main::check_program('vulkaninfo'))) &&
|
|
($show{'graphic-full'} || (!$b_egl_print && !$b_glx_print))){
|
|
vulkan_output($program,$rows);
|
|
$b_vulkan = 1;
|
|
}
|
|
if ($show{'graphic-full'} || (!$b_egl_print && !$b_glx_print)){
|
|
# remember, sudo/root usually has empty $DISPLAY as well
|
|
if ($b_display){
|
|
# first do positive tests, won't be set for sudo/root
|
|
if (!$b_glx && $graphics{'protocol'} eq 'x11'){
|
|
$api = 'OpenGL';
|
|
$type = 'glxinfo-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 = 'glxinfo-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-console-glxinfo-missing';
|
|
}
|
|
elsif (!$b_egl && main::check_program('Xwayland')){
|
|
$api = 'EGL';
|
|
$type = 'egl-console-missing';
|
|
}
|
|
# we don't know what it is, headless system, non xwayland wayland
|
|
elsif (!$b_egl && !$b_glx && !$b_vulkan) {
|
|
$api = 'N/A';
|
|
$type = 'gfx-api-console';
|
|
}
|
|
}
|
|
no_data_output($api,$type,$rows) if $type;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub no_data_output {
|
|
eval $start if $b_log;
|
|
my ($api,$type,$rows) = @_;
|
|
my $num = 0;
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'API') => $api,
|
|
main::key($num++,0,2,'Message') => main::message($type)
|
|
});
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub egl_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$gl) = @_;
|
|
if (!$gl->{'egl'}){
|
|
my $api = 'EGL';
|
|
my $type = 'egl-null';
|
|
no_data_output($api,$type,$rows);
|
|
return 0;
|
|
}
|
|
my ($i,$j,$num) = (0,scalar @$rows,0);
|
|
my ($value);
|
|
my $ref;
|
|
my $data = $gl->{'egl'}{'data'};
|
|
my $plat = $gl->{'egl'}{'platforms'};
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'API') => 'EGL',
|
|
});
|
|
if ($extra < 2){
|
|
$value = ($data->{'versions'}) ? join(',',sort keys %{$data->{'versions'}}): 'N/A';
|
|
}
|
|
else {
|
|
$value = ($data->{'version'}) ? $data->{'version'}: 'N/A';
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'v')} = $value;
|
|
if ($extra < 2){
|
|
$value = ($data->{'drivers'}) ? join(',',sort keys %{$data->{'drivers'}}): 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'drivers')} = $value;
|
|
$value = ($data->{'platforms'}{'active'}) ? join(',',@{$data->{'platforms'}{'active'}}) : 'N/A';
|
|
if ($extra < 1){
|
|
$rows->[$j]{main::key($num++,0,2,'platforms')} = $value;
|
|
}
|
|
else {
|
|
$rows->[$j]{main::key($num++,1,2,'platforms')} = '';
|
|
$rows->[$j]{main::key($num++,0,3,'active')} = $value;
|
|
$value = ($data->{'platforms'}{'inactive'}) ? join(',',@{$data->{'platforms'}{'inactive'}}) : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'inactive')} = $value;
|
|
}
|
|
}
|
|
else {
|
|
if ($extra > 2 && $data->{'hw'}){
|
|
$i = 0;
|
|
$rows->[$j]{main::key($num++,1,2,'hw')} = '';
|
|
foreach my $key (sort keys %{$data->{'hw'}}){
|
|
$value = ($key ne $data->{'hw'}{$key}) ? $data->{'hw'}{$key} . ' ' . $key: $key;
|
|
$rows->[$j]{main::key($num++,0,3,'drv')} = $value;
|
|
}
|
|
}
|
|
$rows->[$j]{main::key($num++,1,2,'platforms')} = '';
|
|
$data->{'version'} ||= 0;
|
|
$i = 0;
|
|
foreach my $key (sort keys %$plat){
|
|
next if !$plat->{$key}{'status'} || $plat->{$key}{'status'} eq 'inactive';
|
|
if ($key eq 'device'){
|
|
foreach my $id (sort keys %{$plat->{$key}}){
|
|
next if ref $plat->{$key}{$id} ne 'HASH';
|
|
$rows->[$j]{main::key($num++,1,3,$key)} = $id;
|
|
$ref = $plat->{$key}{$id}{'egl'};
|
|
egl_advanced_output($rows,$ref,\$num,$j,4,$data->{'version'});
|
|
}
|
|
}
|
|
else {
|
|
$rows->[$j]{main::key($num++,1,3,$key)} = '';
|
|
$ref = $plat->{$key}{'egl'};
|
|
egl_advanced_output($rows,$ref,\$num,$j,4,$data->{'version'});
|
|
}
|
|
}
|
|
if (!$data->{'platforms'}{'active'}){
|
|
$rows->[$j]{main::key($num++,0,3,'active')} = 'N/A';
|
|
}
|
|
if ($data->{'platforms'}{'inactive'}){
|
|
$rows->[$j]{main::key($num++,0,3,'inactive')} = join(',',@{$data->{'platforms'}{'inactive'}});
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# args: 0: $rows; 1: data ref; 2: \$num; 3: $j; 4: indent; 5: $b_plat_v
|
|
sub egl_advanced_output {
|
|
my ($rows,$ref,$num,$j,$ind,$version) = @_;
|
|
my $value;
|
|
# version is set to 0 for math
|
|
if ($version && (!$ref->{'version'} || $version != $ref->{'version'})){
|
|
$value = ($ref->{'version'}) ? $ref->{'version'} : 'N/A';
|
|
$rows->[$j]{main::key($$num++,0,$ind,'egl')} = $value;
|
|
undef $value;
|
|
}
|
|
if ($ref->{'driver'}){
|
|
$value = $ref->{'driver'};
|
|
}
|
|
else {
|
|
if ($ref->{'vendor'} && $ref->{'vendor'} ne 'mesa'){
|
|
$value = $ref->{'vendor'};
|
|
}
|
|
$value ||= 'N/A';
|
|
}
|
|
$rows->[$j]{main::key($$num++,0,$ind,'drv')} = $value;
|
|
}
|
|
|
|
sub opengl_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$gl) = @_;
|
|
# egl will have set $glx if present
|
|
if (!$gl->{'glx'}){
|
|
my $api = 'OpenGL';
|
|
my $type;
|
|
if ($b_display){
|
|
$type = ($b_root) ? 'glx-display-root': 'glx-null';
|
|
}
|
|
else {
|
|
$type = ($b_root) ? 'glx-console-root' : 'glx-console-try';
|
|
}
|
|
no_data_output($api,$type,$rows);
|
|
return 0;
|
|
}
|
|
my ($j,$num) = (scalar @$rows,0);
|
|
my $value;
|
|
# print join("\n", %$gl),"\n";
|
|
my $glx = $gl->{'glx'};
|
|
$glx->{'opengl'}{'version'} ||= 'N/A';
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'API') => 'OpenGL',
|
|
main::key($num++,0,2,'v') => $glx->{'opengl'}{'version'},
|
|
});
|
|
if ($glx->{'opengl'}{'compatibility'}{'version'}){
|
|
$rows->[$j]{main::key($num++,0,2,'compat-v')} = $glx->{'opengl'}{'compatibility'}{'version'};
|
|
}
|
|
if ($glx->{'opengl'}{'vendor'}){
|
|
$rows->[$j]{main::key($num++,1,2,'vendor')} = $glx->{'opengl'}{'vendor'};
|
|
$glx->{'opengl'}{'driver'}{'version'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'v')} = $glx->{'opengl'}{'driver'}{'version'};
|
|
}
|
|
if ($extra > 0 && $glx->{'glx-version'}){
|
|
$rows->[$j]{main::key($num++,0,2,'glx-v')} = $glx->{'glx-version'};
|
|
}
|
|
if ($extra > 1 && $glx->{'es'}{'version'}){
|
|
$rows->[$j]{main::key($num++,0,2,'es-v')} = $glx->{'es'}{'version'};;
|
|
}
|
|
if ($glx->{'note'}){
|
|
$rows->[$j]{main::key($num++,0,2,'note')} = $glx->{'note'};
|
|
}
|
|
if ($extra > 0 && (!$glx->{'note'} || $glx->{'direct-render'})){
|
|
$glx->{'direct-render'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'direct-render')} = $glx->{'direct-render'};
|
|
}
|
|
if (!$glx->{'note'} || $glx->{'opengl'}{'renderer'}){
|
|
$glx->{'opengl'}{'renderer'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'renderer')} = $glx->{'opengl'}{'renderer'};
|
|
}
|
|
if ($extra > 1 && $glx->{'info'}){
|
|
if ($glx->{'info'}{'vendor-id'} && $glx->{'info'}{'device-id'}){
|
|
$value = $glx->{'info'}{'vendor-id'} . ':' . $glx->{'info'}{'device-id'};
|
|
$rows->[$j]{main::key($num++,0,2,'device-ID')} = $value;
|
|
}
|
|
if ($b_admin && $glx->{'info'}{'device-memory'}){
|
|
$rows->[$j]{main::key($num++,1,2,'memory')} = $glx->{'info'}{'device-memory'};
|
|
if ($glx->{'info'}{'unified-memory'}){
|
|
$rows->[$j]{main::key($num++,0,3,'unified')} = $glx->{'info'}{'unified-memory'};
|
|
}
|
|
}
|
|
# display id depends on xdpyinfo in Display line, which may not be present,
|
|
if (!$graphics{'display-id'} && $glx->{'display-id'} && $extra > 1){
|
|
$rows->[$j]{main::key($num++,0,2,'display-ID')} = $glx->{'display-id'};
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub vulkan_output {
|
|
eval $start if $b_log;
|
|
my ($program,$rows) = @_;
|
|
my $vulkan = {};
|
|
vulkan_data($program,$vulkan);
|
|
if (!%$vulkan){
|
|
my $api = 'Vulkan';
|
|
my $type = 'vulkan-null';
|
|
no_data_output($api,$type,$rows);
|
|
return 0;
|
|
}
|
|
my $num = 0;
|
|
my $j = scalar @$rows;
|
|
my ($value);
|
|
my $data = $vulkan->{'data'};
|
|
my $devices = $vulkan->{'devices'};
|
|
$data->{'version'} ||= 'N/A';
|
|
push(@$rows,{
|
|
main::key($num++,1,1,'API') => 'Vulkan',
|
|
main::key($num++,0,2,'v') => $data->{'version'},
|
|
});
|
|
# this will be expanded with -a to a full device report
|
|
if ($extra < 2){
|
|
$value = ($data->{'drivers'}) ? join(',',@{$data->{'drivers'}}): 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'drivers')} = $value;
|
|
}
|
|
if ($extra > 2){
|
|
$data->{'layers'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'layers')} = $data->{'layers'};
|
|
}
|
|
if (!$b_admin){
|
|
$value = ($data->{'surfaces'}) ? join(',',@{$data->{'surfaces'}}) : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'surfaces')} = $value;
|
|
}
|
|
if ($extra > 0){
|
|
if (!$devices){
|
|
$rows->[$j]{main::key($num++,0,2,'devices')} = 'N/A';
|
|
}
|
|
else {
|
|
if ($extra < 2){
|
|
$value = scalar keys %{$devices};
|
|
$rows->[$j]{main::key($num++,0,2,'devices')} = $value;
|
|
}
|
|
else {
|
|
foreach my $id (sort keys %$devices){
|
|
$rows->[$j]{main::key($num++,1,2,'device')} = $id;
|
|
$devices->{$id}{'device-type'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'type')} = $devices->{$id}{'device-type'};
|
|
if ((($extra == 3 && !$b_admin) ||
|
|
($extra > 2 && !$devices->{$id}{'device-name'})) &&
|
|
$devices->{$id}{'hw'} && $devices->{$id}{'hw'} ne 'nvidia'){
|
|
$rows->[$j]{main::key($num++,0,3,'hw')} = $devices->{$id}{'hw'};
|
|
}
|
|
if ($b_admin){
|
|
$value = ($devices->{$id}{'device-name'}) ?
|
|
$devices->{$id}{'device-name'}: 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'name')} = $value;
|
|
}
|
|
if ($extra > 1){
|
|
if ($devices->{$id}{'driver-name'}){
|
|
$value = $devices->{$id}{'driver-name'};
|
|
if ($devices->{$id}{'mesa'} && $value ne 'mesa'){
|
|
$value = 'mesa ' . $value;
|
|
}
|
|
$rows->[$j]{main::key($num++,1,3,'driver')} = $value;
|
|
if ($b_admin && $devices->{$id}{'driver-info'}){
|
|
$rows->[$j]{main::key($num++,0,4,'v')} = $devices->{$id}{'driver-info'};
|
|
}
|
|
}
|
|
else {
|
|
$rows->[$j]{main::key($num++,0,3,'driver')} = 'N/A';
|
|
}
|
|
$value = ($devices->{$id}{'device-id'} && $devices->{$id}{'vendor-id'}) ?
|
|
$devices->{$id}{'vendor-id'} . ':' . $devices->{$id}{'device-id'} : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'device-ID')} = $value;
|
|
if ($b_admin){
|
|
$value = ($devices->{$id}{'surfaces'}) ?
|
|
join(',',@{$devices->{$id}{'surfaces'}}): 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'surfaces')} = $value;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub xvesa_output {
|
|
eval $start if $b_log;
|
|
my ($rows) = @_;
|
|
my ($controller,$dac,$interface,$ram,$source,$version);
|
|
# note: goes to stderr, not stdout
|
|
my @data = main::grabber($graphics{'xvesa'} . ' -listmodes 2>&1');
|
|
my $j = scalar @$rows;
|
|
my $num = 0;
|
|
# gop replaced uga, both for uefi
|
|
# WARNING! Never seen a GOP type UEFI, needs more data
|
|
if ($data[0] && $data[0] =~ /^(VBE|GOP|UGA)\s+version\s+(\S+)\s\(([^)]+)\)/i){
|
|
$interface = $1;
|
|
$version = $2;
|
|
$source = $3;
|
|
}
|
|
if ($data[1] && $data[1] =~ /^DAC is ([^,]+), controller is ([^,]+)/i){
|
|
$dac = $1;
|
|
$controller = $2;
|
|
}
|
|
if ($data[2] && $data[2] =~ /^Total memory:\s+(\d+)\s/i){
|
|
$ram = $1;
|
|
$ram = main::get_size($ram,'string');
|
|
}
|
|
if (!$interface){
|
|
$rows->[$j]{main::key($num++,1,1,'API')} = 'VBE/GOP';
|
|
$rows->[$j]{main::key($num++,0,2,'Message')} = main::message('xvesa-null');
|
|
}
|
|
else {
|
|
$rows->[$j]{main::key($num++,1,1,'API')} = $interface;
|
|
$rows->[$j]{main::key($num++,0,2,'v')} = ($version) ? $version : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'source')} = ($source) ? $source : 'N/A';
|
|
if ($dac){
|
|
$rows->[$j]{main::key($num++,0,2,'dac')} = $dac;
|
|
$rows->[$j]{main::key($num++,0,2,'controller')} = $controller;
|
|
}
|
|
if ($ram){
|
|
$rows->[$j]{main::key($num++,0,2,'ram')} = $ram;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# API Data #
|
|
sub gl_data {
|
|
eval $start if $b_log;
|
|
my ($source,$program,$rows,$gl) = @_;
|
|
my ($b_opengl,$msg);
|
|
my ($gl_data,$results) = ([],[]);
|
|
# only check these if no eglinfo or eglinfo had no opengl data
|
|
$b_opengl = 1 if ($source eq 'egl' || !$gl->{'glx'});
|
|
# NOTE: glxinfo -B is not always available, unfortunately
|
|
if ($dbg[56] || $b_log){
|
|
$msg = "${line1}GL Source: $source\n${line3}";
|
|
print $msg if $dbg[56];
|
|
push(@$results,$msg) if $b_log;
|
|
}
|
|
if ($source eq 'glx'){
|
|
if (!$fake{'glx'}){
|
|
$gl_data = main::grabber("$program $display_opt 2>/dev/null",'','','ref');
|
|
}
|
|
else {
|
|
my $file;
|
|
# $file = "$fake_data_dir/graphics/glxinfo/glxinfo-2012-nvidia-glx1.4.txt";
|
|
# $file = "$fake_data_dir/graphics/glxinfo/glxinfo-ssh-centos.txt";
|
|
# $file = "$fake_data_dir/graphics/glxinfo/glxiinfo-t420-intel-1.txt";
|
|
# $file = "$fake_data_dir/graphics/glxinfo/glxinfo-mali-allwinner-lima-1.txt";
|
|
# $file = "$fake_data_dir/graphics/glxinfo/glxinfo-partial-intel-5500-1.txt";
|
|
# $file = "$fake_data_dir/graphics/glxinfo/glxinfo-vbox-debian-etch-1.txt";
|
|
$file = "$fake_data_dir/graphics/glxinfo/glxinfo-x11-neomagic-lenny-1.txt";
|
|
# $file = "$fake_data_dir/graphics/glxinfo/glxinfo-nvidia-gl4.6-chr.txt";
|
|
# $file = "$fake_data_dir/graphics/glxinfo/glxinfo-intel-atom-dell_studio-bm.txt";
|
|
# $file = "$fake_data_dir/graphics/glxinfo/glxinfo-asus_1025c-atom-bm.txt";
|
|
# $file = "$fake_data_dir/graphics/glxinfo/glxinfo-2011-nvidia-glx1.4.txt";
|
|
$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";
|
|
$gl_data = main::reader($file,'','ref');
|
|
}
|
|
}
|
|
# print join("\n", @$gl_data),"\n";
|
|
if (!$gl_data || !@$gl_data){
|
|
if ($dbg[56] || $b_log){
|
|
$msg = "No data found for GL Source: $source" if $dbg[56];
|
|
print "$msg\n" if $dbg[56];
|
|
push(@$results,$msg) if $b_log;
|
|
}
|
|
return 0;
|
|
}
|
|
# some error cases have only a few top value but not empty
|
|
elsif ($source eq 'glx' && scalar @$gl_data > 5){
|
|
$gl->{'glx'}{'source'} = $source;
|
|
}
|
|
set_mesa_drivers() if $source eq 'egl' && !%mesa_drivers;
|
|
my ($b_device,$b_platform,$b_mem_info,$b_rend_info,$device,$platform,
|
|
$value,$value2,@working);
|
|
foreach my $line (@$gl_data){
|
|
next if (!$b_rend_info && !$b_mem_info) && $line =~ /^(\s|0x)/;
|
|
if (($b_rend_info || $b_mem_info) && $line =~ /^\S/){
|
|
($b_mem_info,$b_rend_info) = ();
|
|
}
|
|
@working = split(/\s*:\s*/,$line,2);
|
|
next if !@working;
|
|
if ($dbg[56] || $b_log){
|
|
$msg = $line;
|
|
print "$msg\n" if $dbg[56];
|
|
push(@$results,$msg) if $b_log;
|
|
}
|
|
if ($source eq 'egl'){
|
|
# eglinfo: eglInitialize failed
|
|
# This is first line after platform fail for devices, but for Device
|
|
# it would be the second or later line. The Device platform can fail, or
|
|
# specific device can fail
|
|
if ($b_platform){
|
|
$value = ($line =~ /Initialize failed/) ? 'inactive': 'active';
|
|
push(@{$gl->{'egl'}{'data'}{'platforms'}{$value}},$platform);
|
|
$gl->{'egl'}{'platforms'}{$platform}{'status'} = $value;
|
|
$b_platform = 0;
|
|
}
|
|
# note: can be sub item: Platform Device platform:; Platform Device:
|
|
elsif ($working[0] =~ /^(\S+) platform/i){
|
|
$platform = lc($1);
|
|
undef $device;
|
|
$b_platform = 1;
|
|
}
|
|
if ($platform && defined $device && $working[0] eq 'eglinfo'){
|
|
push(@{$gl->{'egl'}{'data'}{'platforms'}{'inactive'}},"$platform-$device");
|
|
undef $device;
|
|
}
|
|
if ($platform && $platform eq 'device' && $working[0] =~ /^Device #(\d+)/){
|
|
$device = $1;
|
|
}
|
|
if ($working[0] eq 'EGL API version'){
|
|
if (!defined $platform){
|
|
$gl->{'egl'}{'data'}{'api-version'} = $working[1];
|
|
}
|
|
elsif (defined $device){
|
|
$gl->{'egl'}{'platforms'}{$platform}{$device}{'egl'}{'api-version'} = $working[1];
|
|
}
|
|
else {
|
|
$gl->{'egl'}{'platforms'}{$platform}{'egl'}{'api-version'} = $working[1];
|
|
}
|
|
}
|
|
elsif ($working[0] eq 'EGL version string'){
|
|
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 ($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 ($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 ($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];
|
|
}
|
|
}
|
|
}
|
|
elsif ($working[0] =~ /^OpenGL (compatibility|core) profile vendor$/){
|
|
$value = lc($1);
|
|
if (!$gl->{'glx'}{'opengl'}{$value}{'vendors'} ||
|
|
!(grep {$_ eq $working[1]} @{$gl->{'glx'}{'opengl'}{$value}{'vendors'}})){
|
|
push(@{$gl->{'glx'}{'opengl'}{$value}{'vendors'}}, $working[1]) ;
|
|
}
|
|
if ($source eq 'egl' && $platform){
|
|
if (defined $device){
|
|
$gl->{'egl'}{'platforms'}{$platform}{$device}{'opengl'}{$value}{'vendor'} = $working[1];
|
|
}
|
|
else {
|
|
$gl->{'egl'}{'platforms'}{$platform}{'opengl'}{$value}{'vendor'} = $working[1];
|
|
}
|
|
|
|
}
|
|
}
|
|
elsif (lc($working[0]) eq 'opengl es profile version string'){
|
|
if ($working[1] && !$gl->{'glx'}{'es-version'}){
|
|
# OpenGL ES 3.2 Mesa 23.0.3
|
|
if ($working[1] =~ /^OpenGL ES (\S+) Mesa (\S+)/){
|
|
$gl->{'glx'}{'es'}{'version'} = $1;
|
|
if ($2 && !$gl->{'glx'}{'es'}{'mesa-version'}){
|
|
$gl->{'glx'}{'es'}{'mesa-version'} = $2;
|
|
}
|
|
if ($source eq 'egl' && $platform){
|
|
if (defined $device){
|
|
$gl->{'egl'}{'platforms'}{$platform}{$device}{'opengl'}{'es'}{'vendor'} = 'mesa';
|
|
$gl->{'egl'}{'platforms'}{$platform}{$device}{'opengl'}{'es'}{'version'} = $working[1];
|
|
}
|
|
else {
|
|
$gl->{'egl'}{'platforms'}{$platform}{'opengl'}{'es'}{'vendor'} = 'mesa';
|
|
$gl->{'egl'}{'platforms'}{$platform}{'opengl'}{'es'}{'version'} = $working[1];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
main::log_data('dump',"$source \$results",$results) if $b_log;
|
|
if ($source eq 'egl'){
|
|
print "GL Data: $source: ", Data::Dumper::Dumper $gl if $dbg[57];
|
|
main::log_data('dump',"GL data: $source:",$gl) if $b_log;
|
|
}
|
|
else {
|
|
print "GL Data: $source: ", Data::Dumper::Dumper $gl->{'glx'} if $dbg[57];
|
|
main::log_data('dump',"GLX data: $source:",$gl->{'glx'}) if $b_log;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub process_glx_data {
|
|
eval $start if $b_log;
|
|
my ($glx,$b_glx) = @_;
|
|
my $value;
|
|
# Remember: if you test for a hash ref hash ref, you create the first hash ref!
|
|
if ($glx->{'direct-renders'}){
|
|
$glx->{'direct-render'} = join(', ', @{$glx->{'direct-renders'}});
|
|
}
|
|
if (!$glx->{'opengl'}{'renderers'} && $glx->{'opengl'}{'compatibility'} &&
|
|
$glx->{'opengl'}{'compatibility'}{'renderers'}){
|
|
$glx->{'opengl'}{'renderers'} = $glx->{'opengl'}{'compatibility'}{'renderers'};
|
|
}
|
|
# This is tricky, GLX OpenGL version string can be compatibility version,
|
|
# but usually they are the same. Just in case, try this. Note these are
|
|
# x.y.z type numbering formats generally so use string compare
|
|
if ($glx->{'opengl'}{'core'} && $glx->{'opengl'}{'core'}{'versions'}){
|
|
$glx->{'opengl'}{'version'} = (sort @{$glx->{'opengl'}{'core'}{'versions'}})[-1];
|
|
}
|
|
elsif ($glx->{'opengl'}{'versions'}){
|
|
$glx->{'opengl'}{'version'} = (sort @{$glx->{'opengl'}{'versions'}})[-1];
|
|
}
|
|
if ($glx->{'opengl'}{'version'} &&
|
|
($glx->{'opengl'}{'compatibility'} || $glx->{'opengl'}{'versions'})){
|
|
# print "v: $glx->{'opengl'}{'version'}\n";
|
|
# print Data::Dumper::Dumper $glx->{'opengl'}{'versions'};
|
|
# print 'v1: ', (sort @{$glx->{'opengl'}{'versions'}})[0], "\n";
|
|
# here we look for different versions, and determine most likely compat one
|
|
if ($glx->{'opengl'}{'compatibility'} &&
|
|
$glx->{'opengl'}{'compatibility'}{'versions'} &&
|
|
(sort @{$glx->{'opengl'}{'compatibility'}{'versions'}})[0] ne $glx->{'opengl'}{'version'}){
|
|
$value = (sort @{$glx->{'opengl'}{'compatibility'}{'versions'}})[0];
|
|
$glx->{'opengl'}{'compatibility'}{'version'} = $value;
|
|
}
|
|
elsif ($glx->{'opengl'}{'versions'} &&
|
|
(sort @{$glx->{'opengl'}{'versions'}})[0] ne $glx->{'opengl'}{'version'}){
|
|
$value = (sort @{$glx->{'opengl'}{'versions'}})[0];
|
|
$glx->{'opengl'}{'compatibility'}{'version'} = $value;
|
|
}
|
|
}
|
|
if ($glx->{'opengl'}{'renderers'}){
|
|
$glx->{'opengl'}{'renderer'} = join(', ', @{$glx->{'opengl'}{'renderers'}});
|
|
}
|
|
# likely eglinfo or advanced glxinfo
|
|
if ($glx->{'opengl'}{'vendor'} &&
|
|
$glx->{'opengl'}{'core'} &&
|
|
$glx->{'opengl'}{'core'}{'driver'} &&
|
|
$glx->{'opengl'}{'core'}{'driver'}{'vendor'} &&
|
|
$glx->{'opengl'}{'core'}{'driver'}{'vendor'} eq 'mesa' &&
|
|
$glx->{'opengl'}{'vendor'} ne $glx->{'opengl'}{'core'}{'driver'}{'vendor'}){
|
|
$value = $glx->{'opengl'}{'vendor'} . ' ';
|
|
$value .= $glx->{'opengl'}{'core'}{'driver'}{'vendor'};
|
|
$glx->{'opengl'}{'vendor'} = $value;
|
|
}
|
|
# this can be glxinfo only case, no eglinfo
|
|
elsif ($glx->{'opengl'}{'vendor'} &&
|
|
$glx->{'opengl'}{'driver'} &&
|
|
$glx->{'opengl'}{'driver'}{'vendor'} &&
|
|
$glx->{'opengl'}{'driver'}{'vendor'} eq 'mesa' &&
|
|
$glx->{'opengl'}{'vendor'} ne $glx->{'opengl'}{'driver'}{'vendor'}){
|
|
$value = $glx->{'opengl'}{'vendor'} . ' ';
|
|
$value .= $glx->{'opengl'}{'driver'}{'vendor'};
|
|
$glx->{'opengl'}{'vendor'} = $value;
|
|
}
|
|
elsif (!$glx->{'opengl'}{'vendor'} &&
|
|
$glx->{'opengl'}{'core'} && $glx->{'opengl'}{'core'}{'driver'} &&
|
|
$glx->{'opengl'}{'core'}{'driver'}{'vendor'}){
|
|
$glx->{'opengl'}{'vendor'} = $glx->{'opengl'}{'core'}{'driver'}{'vendor'};
|
|
}
|
|
if ((!$glx->{'opengl'}{'driver'} ||
|
|
!$glx->{'opengl'}{'driver'}{'version'}) &&
|
|
$glx->{'opengl'}{'core'} &&
|
|
$glx->{'opengl'}{'core'}{'driver'} &&
|
|
$glx->{'opengl'}{'core'}{'driver'}{'version'}){
|
|
$value = $glx->{'opengl'}{'core'}{'driver'}{'version'};
|
|
$glx->{'opengl'}{'driver'}{'version'} = $value;
|
|
}
|
|
# only tripped when glx filled by eglinfo
|
|
if (!$glx->{'source'}){
|
|
my $type;
|
|
if (!$b_glx){
|
|
$type = 'glx-egl-missing';
|
|
}
|
|
elsif ($b_display){
|
|
$type = 'glx-egl';
|
|
}
|
|
else {
|
|
$type = 'glx-egl-console';
|
|
}
|
|
$glx->{'note'} = main::message($type);
|
|
}
|
|
print "GLX Data: ", Data::Dumper::Dumper $glx if $dbg[57];
|
|
main::log_data('dump',"GLX data:",$glx) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub vulkan_data {
|
|
eval $start if $b_log;
|
|
my ($program,$vulkan) = @_;
|
|
my ($data,$msg,@working);
|
|
my ($results) = ([]);
|
|
if ($dbg[56] || $b_log){
|
|
$msg = "${line1}Vulkan Data\n${line3}";
|
|
print $msg if $dbg[56];
|
|
push(@$results,$msg) if $b_log;
|
|
}
|
|
if (!$fake{'vulkan'}){
|
|
$data = main::grabber("$program 2>/dev/null",'','','ref');
|
|
}
|
|
else {
|
|
my $file;
|
|
$file = "$fake_data_dir/graphics/vulkan/vulkaninfo-intel-llvm-1.txt";
|
|
$file = "$fake_data_dir/graphics/vulkan/vulkaninfo-nvidia-1.txt";
|
|
$file = "$fake_data_dir/graphics/vulkan/vulkaninfo-intel-1.txt";
|
|
$file = "$fake_data_dir/graphics/vulkan/vulkaninfo-amd-dz.txt";
|
|
$file = "$fake_data_dir/graphics/vulkan/vulkaninfo-mali-3.txt";
|
|
$data = main::reader($file,'','ref');
|
|
}
|
|
if (!$data){
|
|
if ($dbg[56] || $b_log){
|
|
$msg = "No Vulkan data found" if $dbg[56];
|
|
print "$msg\n" if $dbg[56];
|
|
push(@$results,$msg) if $b_log;
|
|
}
|
|
return 0;
|
|
}
|
|
set_mesa_drivers() if !%mesa_drivers;
|
|
my ($id,%active);
|
|
foreach my $line (@$data){
|
|
next if $line =~ /^(\s*|-+|=+)$/;
|
|
@working = split(/\s*:\s*/,$line,2);
|
|
next if !@working;
|
|
if ($line =~ /^\S/){
|
|
if ($active{'start'}){undef $active{'start'}}
|
|
if ($active{'layers'}){undef $active{'layers'}}
|
|
if ($active{'groups'}){undef $active{'groups'}}
|
|
if ($active{'limits'}){undef $active{'limits'}}
|
|
if ($active{'features'}){undef $active{'features'}}
|
|
if ($active{'extensions'}){undef $active{'extensions'}}
|
|
if ($active{'format'}){undef $active{'format'}}
|
|
if ($active{'driver'}){($active{'driver'},$id) = ()}
|
|
}
|
|
next if $active{'start'};
|
|
next if $active{'groups'};
|
|
next if $active{'limits'};
|
|
next if $active{'features'};
|
|
next if $active{'extensions'};
|
|
next if $active{'format'};
|
|
if ($dbg[56] || $b_log){
|
|
$msg = $line;
|
|
print "$msg\n" if $dbg[56];
|
|
push(@$results,$msg) if $b_log;
|
|
}
|
|
if ($working[0] eq 'Vulkan Instance Version'){
|
|
$vulkan->{'data'}{'version'} = $working[1];
|
|
$active{'start'} = 1;
|
|
}
|
|
elsif ($working[0] eq 'Layers'){
|
|
if ($working[1] =~ /count\s*=\s*(\d+)/){
|
|
$vulkan->{'data'}{'layers'} = $1;
|
|
}
|
|
$active{'layers'} = 1;
|
|
}
|
|
# note: can't close this because Intel didn't use proper indentation
|
|
elsif ($working[0] eq 'Presentable Surfaces'){
|
|
$active{'surfaces'} = 1;
|
|
}
|
|
elsif ($working[0] eq 'Device Groups'){
|
|
$active{'groups'} = 1;
|
|
$active{'surfaces'} = 0;
|
|
}
|
|
elsif ($working[0] eq 'Device Properties and Extensions'){
|
|
$active{'devices'} = 1;
|
|
$active{'surfaces'} = 0;
|
|
undef $id;
|
|
}
|
|
elsif ($working[0] eq 'VkPhysicalDeviceProperties'){
|
|
$active{'props'} = 1;
|
|
}
|
|
elsif ($working[0] eq 'VkPhysicalDeviceDriverProperties'){
|
|
$active{'driver'} = 1;
|
|
}
|
|
elsif ($working[0] =~ /^\S+Features/i){
|
|
$active{'features'} = 1;
|
|
}
|
|
# seen as line starter string or inner VkPhysicalDeviceProperties
|
|
elsif ($working[0] =~ /^\s*\S+Limits/i){
|
|
$active{'limits'} = 1;
|
|
}
|
|
elsif ($working[0] =~ /^FORMAT_/){
|
|
$active{'format'} = 1;
|
|
}
|
|
elsif ($working[0] =~ /^(Device|Instance) Extensions/){
|
|
$active{'extensions'} = 1;
|
|
}
|
|
if ($active{'surfaces'}){
|
|
if ($working[0] eq 'GPU id'){
|
|
if ($working[1] =~ /^(\d+)\s+\((.*?)\):?$/){
|
|
$id = $1;
|
|
$vulkan->{'devices'}{$id}{'model'} = main::clean($2);
|
|
}
|
|
}
|
|
if (defined $id){
|
|
# seen leading space, no leading space
|
|
if ($line =~ /^\s*Surface type/){
|
|
$active{'surface-type'} = 1;
|
|
}
|
|
if ($active{'surface-type'} && $line =~ /\S+_(\S+)_surface$/){
|
|
if (!$vulkan->{'devices'}{$id}{'surfaces'} ||
|
|
!(grep {$_ eq $1} @{$vulkan->{'devices'}{$id}{'surfaces'}})){
|
|
push(@{$vulkan->{'devices'}{$id}{'surfaces'}},$1);
|
|
}
|
|
if (!$vulkan->{'data'}{'surfaces'} ||
|
|
!(grep {$_ eq $1} @{$vulkan->{'data'}{'surfaces'}})){
|
|
push(@{$vulkan->{'data'}{'surfaces'}},$1);
|
|
}
|
|
}
|
|
if ($working[0] =~ /^\s*Formats/){
|
|
undef $active{'surface-type'};
|
|
}
|
|
}
|
|
}
|
|
if ($active{'devices'}){
|
|
if ($working[0] =~ /^GPU(\d+)/){
|
|
$id = $1;
|
|
}
|
|
elsif (defined $id){
|
|
# apiVersion=4194528 (1.0.224); 1.3.246 (4206838); 79695971 (0x4c01063)
|
|
if ($line =~ /^\s+apiVersion\s*=\s*(\S+)(\s+\(([^)]+)\))?/i){
|
|
my ($a,$b) = ($1,$3);
|
|
my $api = (!$b || $b =~ /^(0x)?\d+$/) ? $a : $b;
|
|
$vulkan->{'devices'}{$id}{'device-api-version'} = $api;
|
|
}
|
|
elsif ($line =~ /^\s+driverVersion\s*=\s*(\S+)/i){
|
|
$vulkan->{'devices'}{$id}{'device-driver-version'} = $1;
|
|
}
|
|
elsif ($line =~ /^\s+vendorID\s*=\s*0x(\S+)/i){
|
|
$vulkan->{'devices'}{$id}{'vendor-id'} = $1;
|
|
}
|
|
elsif ($line =~ /^\s+deviceID\s*=\s*0x(\S+)/i){
|
|
$vulkan->{'devices'}{$id}{'device-id'} = $1;
|
|
}
|
|
# deviceType=DISCRETE_GPU; PHYSICAL_DEVICE_TYPE_DISCRETE_GPU
|
|
elsif ($line =~ /^\s+deviceType\s*=\s*(\S+?_TYPE_)?(\S+)$/i){
|
|
$vulkan->{'devices'}{$id}{'device-type'} = lc($2);
|
|
$vulkan->{'devices'}{$id}{'device-type'} =~ s/_/-/g;
|
|
}
|
|
# deviceName=AMD Radeon RX 6700 XT (RADV NAVI22); AMD RADV HAWAII
|
|
# lvmpipe (LLVM 15.0.6, 256 bits); NVIDIA GeForce GTX 1650 Ti
|
|
elsif ($line =~ /^\s+deviceName\s*=\s*(\S+)(\s.*|$)/i){
|
|
$vulkan->{'devices'}{$id}{'device-vendor'} = main::clean(lc($1));
|
|
$vulkan->{'devices'}{$id}{'device-name'} = main::clean($1 . $2);
|
|
}
|
|
}
|
|
}
|
|
if ($active{'driver'}){
|
|
if (defined $id){
|
|
# driverName=llvmpipe; radv;
|
|
if ($line =~ /^\s+driverName\s*=\s*(\S+)(\s|$)/i){
|
|
my $driver = lc($1);
|
|
if ($mesa_drivers{$driver}){
|
|
$vulkan->{'devices'}{$id}{'hw'} = $mesa_drivers{$driver};
|
|
}
|
|
$vulkan->{'devices'}{$id}{'driver-name'} = $driver;
|
|
if (!$vulkan->{'data'}{'drivers'} ||
|
|
!(grep {$_ eq $driver} @{$vulkan->{'data'}{'drivers'}})){
|
|
push(@{$vulkan->{'data'}{'drivers'}},$driver);
|
|
}
|
|
}
|
|
# driverInfo=Mesa 23.1.3 (LLVM 15.0.7); 525.89.02; Mesa 23.1.3
|
|
elsif ($line =~ /^\s+driverInfo\s*=\s*((Mesa)\s)?(.*)/i){
|
|
$vulkan->{'devices'}{$id}{'mesa'} = lc($2) if $2;
|
|
$vulkan->{'devices'}{$id}{'driver-info'} = $3;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
main::log_data('dump','$results',$results) if $b_log;
|
|
print 'Vulkan Data: ', Data::Dumper::Dumper $vulkan if $dbg[57];
|
|
main::log_data('dump','$vulkan',$vulkan) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## DISPLAY DATA WAYLAND ##
|
|
sub display_data_wayland {
|
|
eval $start if $b_log;
|
|
my ($b_skip_pos,$program);
|
|
if ($ENV{'WAYLAND_DISPLAY'}){
|
|
$graphics{'display-id'} = $ENV{'WAYLAND_DISPLAY'};
|
|
# return as wayland-0 or 0?
|
|
$graphics{'display-id'} =~ s/wayland-?//i;
|
|
}
|
|
if ($fake{'swaymsg'} || ($program = main::check_program('swaymsg'))){
|
|
swaymsg_data($program);
|
|
}
|
|
# until we get data proving otherwise, assuming these have same output
|
|
elsif ($fake{'wl-info'} || (($program = main::check_program('wayland-info')) ||
|
|
($program = main::check_program('weston-info')))){
|
|
wlinfo_data($program);
|
|
}
|
|
elsif ($fake{'wlr-randr'} || ($program = main::check_program('wlr-randr'))){
|
|
wlrrandr_data($program);
|
|
}
|
|
# make sure we got enough for advanced position data, might be from /sys
|
|
if ($extra > 1 && $monitor_ids){
|
|
$b_skip_pos = check_wayland_data();
|
|
}
|
|
if ($extra > 1 && $monitor_ids && $b_wayland_data){
|
|
# map_monitor_ids([keys %$monitors]); # not required, but leave in case.
|
|
wayland_data_advanced($b_skip_pos);
|
|
}
|
|
print 'Wayland monitors: ', Data::Dumper::Dumper $monitor_ids if $dbg[17];
|
|
main::log_data('dump','$monitor_ids',$monitor_ids) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# If we didn't get explicit tool for wayland data, check to see if we got most
|
|
# of the data from /sys/class/drm edid and then skip xrandr to avoid gunking up
|
|
# the data, in that case, all we get from xrandr would be the position, which is
|
|
# nice but not a must-have. We've already cleared out all disabled ports.
|
|
sub check_wayland_data {
|
|
eval $start if $b_log;
|
|
my ($b_skip_pos,$b_invalid);
|
|
foreach my $key (keys %$monitor_ids){
|
|
# we need these 4 items to construct the grid rectangle
|
|
if (!defined $monitor_ids->{$key}{'pos-x'} ||
|
|
!defined $monitor_ids->{$key}{'pos-y'} ||
|
|
!$monitor_ids->{$key}{'res-x'} || !$monitor_ids->{$key}{'res-y'}){
|
|
$b_skip_pos = 1;
|
|
}
|
|
if (!$monitor_ids->{$key}{'res-x'} || !$monitor_ids->{$key}{'res-y'}){
|
|
$b_invalid = 1;
|
|
}
|
|
}
|
|
# ok, we have enough, we don't need to do fallback xrandr checks
|
|
$b_wayland_data = 1 if !$b_invalid;
|
|
eval $end if $b_log;
|
|
return $b_skip_pos;
|
|
}
|
|
|
|
# Set Display rect size for > 1 monitors, monitor positions, size-i, diag
|
|
sub wayland_data_advanced {
|
|
eval $start if $b_log;
|
|
my ($b_skip_pos) = @_;
|
|
my (%x_pos,%y_pos);
|
|
my ($x_max,$y_max) = (0,0);
|
|
my @keys = keys %$monitor_ids;
|
|
foreach my $key (@keys){
|
|
if (!$b_skip_pos){
|
|
if ($monitor_ids->{$key}{'res-x'} && $monitor_ids->{$key}{'res-x'} > $x_max){
|
|
$x_max = $monitor_ids->{$key}{'res-x'};
|
|
}
|
|
if ($monitor_ids->{$key}{'res-y'} && $monitor_ids->{$key}{'res-y'} > $y_max){
|
|
$y_max = $monitor_ids->{$key}{'res-y'};
|
|
}
|
|
# Now we'll add the detected x, y res to the trackers
|
|
if (!defined $x_pos{$monitor_ids->{$key}{'pos-x'}}){
|
|
$x_pos{$monitor_ids->{$key}{'pos-x'}} = $monitor_ids->{$key}{'res-x'};
|
|
}
|
|
if (!defined $y_pos{$monitor_ids->{$key}{'pos-y'}}){
|
|
$y_pos{$monitor_ids->{$key}{'pos-y'}} += $monitor_ids->{$key}{'res-y'};
|
|
}
|
|
}
|
|
# this means we failed to get EDID real data, and are using just the wayland
|
|
# tool to get this info, eg. with BSD without compositor data.
|
|
if ($monitor_ids->{$key}{'size-x'} && $monitor_ids->{$key}{'size-y'} &&
|
|
(!$monitor_ids->{$key}{'size-x-i'} || !$monitor_ids->{$key}{'size-y-i'} ||
|
|
!$monitor_ids->{$key}{'dpi'} || !$monitor_ids->{$key}{'diagonal'})){
|
|
my $size_x = $monitor_ids->{$key}{'size-x'};
|
|
my $size_y = $monitor_ids->{$key}{'size-y'};
|
|
$monitor_ids->{$key}{'size-x-i'} = sprintf("%.2f", ($size_x/25.4)) + 0;
|
|
$monitor_ids->{$key}{'size-y-i'} = sprintf("%.2f", ($size_y/25.4)) + 0;
|
|
$monitor_ids->{$key}{'diagonal'} = sprintf("%.2f", (sqrt($size_x**2 + $size_y**2)/25.4)) + 0;
|
|
$monitor_ids->{$key}{'diagonal-m'} = sprintf("%.0f", (sqrt($size_x**2 + $size_y**2)));
|
|
if ($monitor_ids->{$key}{'res-x'}){
|
|
my $res_x = $monitor_ids->{$key}{'res-x'};
|
|
$monitor_ids->{$key}{'dpi'} = sprintf("%.0f", $res_x * 25.4 / $size_x);
|
|
}
|
|
}
|
|
}
|
|
if (!$b_skip_pos){
|
|
if (scalar @keys > 1 && %x_pos && %y_pos){
|
|
my ($x,$y) = (0,0);
|
|
foreach (keys %x_pos){$x += $x_pos{$_}}
|
|
foreach (keys %y_pos){$y += $y_pos{$_}}
|
|
# handle cases with one tall portrait mode > 2 short landscapes, etc.
|
|
$x = $x_max if $x_max > $x;
|
|
$y = $y_max if $y_max > $y;
|
|
$graphics{'display-rect'} = $x . 'x' . $y;
|
|
}
|
|
my $layouts = [];
|
|
set_monitor_layouts($layouts);
|
|
# only update position, we already have all the rest of the data
|
|
advanced_monitor_data($monitor_ids,$layouts);
|
|
undef $layouts;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## WAYLAND COMPOSITOR DATA TOOLS ##
|
|
# NOTE: These patterns are VERY fragile, and depend on no changes at all to
|
|
# the data structure, and more important, the order. Something I would put
|
|
# almost no money on being able to count on.
|
|
sub wlinfo_data {
|
|
eval $start if $b_log;
|
|
my ($program) = @_;
|
|
my ($data,%mon,@temp,$ref);
|
|
my ($b_iwlo,$b_izxdg,$file,$hz,$id,$pos_x,$pos_y,$res_x,$res_y,$scale);
|
|
if (!$fake{'wl-info'}){
|
|
undef $monitor_ids;
|
|
$data = main::grabber("$program 2>/dev/null",'','strip','ref');
|
|
}
|
|
else {
|
|
$file = "$fake_data_dir/graphics/wayland/weston-info-2-mon-1.txt";
|
|
$data = main::reader($file,'strip','ref');
|
|
}
|
|
print 'wayland/weston-info raw: ', Data::Dumper::Dumper $data if $dbg[46];
|
|
main::log_data('dump','@$data', $data) if $b_log;
|
|
foreach (@$data){
|
|
# print 'l: ', $_,"\n";
|
|
if (/^interface: 'wl_output', version: \d+, name: (\d+)$/){
|
|
$b_iwlo = 1;
|
|
$id = $1;
|
|
}
|
|
elsif (/^interface: 'zxdg_output/){
|
|
$b_izxdg = 1;
|
|
$b_iwlo = 0;
|
|
}
|
|
if ($b_iwlo){
|
|
if (/^x: (\d+), y: (\d+), scale: ([\d\.]+)/){
|
|
$mon{$id}->{'pos-x'} = $1;
|
|
$mon{$id}->{'pos-y'} = $2;
|
|
$mon{$id}->{'scale'} = $3;
|
|
}
|
|
elsif (/^physical_width: (\d+) mm, physical_height: (\d+) mm/){
|
|
$mon{$id}->{'size-x'} = $1 if $1; # can be 0 if edid data n/a
|
|
$mon{$id}->{'size-y'} = $2 if $2; # can be 0 if edid data n/a
|
|
}
|
|
elsif (/^make: '([^']+)', model: '([^']+)'/){
|
|
my $make = main::clean($1);
|
|
my $model = main::clean($2);
|
|
$mon{$id}->{'model'} = $make;
|
|
if ($make && $model){
|
|
$mon{$id}->{'model'} = $make . ' ' . $model;
|
|
}
|
|
elsif ($model) {
|
|
$mon{$id}->{'model'} = $model;
|
|
}
|
|
elsif ($make) {
|
|
$mon{$id}->{'model'} = $make;
|
|
}
|
|
# includes remove duplicates and remove unset
|
|
if ($mon{$id}->{'model'}){
|
|
$mon{$id}->{'model'} = main::clean_dmi($mon{$id}->{'model'});
|
|
}
|
|
}
|
|
elsif (/^width: (\d+) px, height: (\d+) px, refresh: ([\d\.]+) Hz,/){
|
|
$mon{$id}->{'res-x'} = $1;
|
|
$mon{$id}->{'res-y'} = $2;
|
|
$mon{$id}->{'hz'} = sprintf('%.0f',$3);
|
|
}
|
|
}
|
|
# note: we don't want to use the 'description' field because that doesn't
|
|
# always contain make/model data, sometimes it's: Built-in/Unknown Display
|
|
elsif ($b_izxdg){
|
|
if (/^output: (\d+)/){
|
|
$id = $1;
|
|
}
|
|
elsif (/^name: '([^']+)'$/){
|
|
$mon{$id}->{'monitor'} = $1;
|
|
}
|
|
elsif (/^logical_x: (\d+), logical_y: (\d+)/){
|
|
$mon{$id}->{'log-pos-x'} = $1;
|
|
$mon{$id}->{'log-pos-y'} = $2;
|
|
}
|
|
elsif (/^logical_width: (\d+), logical_height: (\d+)/){
|
|
$mon{$id}->{'log-x'} = $1;
|
|
$mon{$id}->{'log-y'} = $2;
|
|
}
|
|
}
|
|
if ($b_izxdg && /^interface: '(?!zxdg_output)/){
|
|
last;
|
|
}
|
|
}
|
|
# now we need to map %mon back to $monitor_ids
|
|
if (%mon){
|
|
$b_wayland_data = 1;
|
|
foreach my $key (keys %mon){
|
|
next if !$mon{$key}->{'monitor'}; # no way to know what it is, sorry
|
|
$id = $mon{$key}->{'monitor'};
|
|
$monitor_ids->{$id}{'monitor'} = $id;
|
|
$monitor_ids->{$id}{'log-x'} = $mon{$key}->{'log-x'} if defined $mon{$key}->{'log-x'};
|
|
$monitor_ids->{$id}{'log-y'} = $mon{$key}->{'log-y'} if defined $mon{$key}->{'log-y'};
|
|
$monitor_ids->{$id}{'pos-x'} = $mon{$key}->{'pos-x'} if defined $mon{$key}->{'pos-x'};
|
|
$monitor_ids->{$id}{'pos-y'} = $mon{$key}->{'pos-y'} if defined $mon{$key}->{'pos-y'};
|
|
$monitor_ids->{$id}{'res-x'} = $mon{$key}->{'res-x'} if defined $mon{$key}->{'res-x'};
|
|
$monitor_ids->{$id}{'res-y'} = $mon{$key}->{'res-y'} if defined $mon{$key}->{'res-y'};
|
|
$monitor_ids->{$id}{'size-x'} = $mon{$key}->{'size-x'} if defined $mon{$key}->{'size-x'};
|
|
$monitor_ids->{$id}{'size-y'} = $mon{$key}->{'size-y'} if defined $mon{$key}->{'size-y'};
|
|
$monitor_ids->{$id}{'hz'} = $mon{$key}->{'hz'} if defined $mon{$key}->{'hz'};
|
|
if (defined $mon{$key}->{'model'} && !$monitor_ids->{$id}{'model'}){
|
|
$monitor_ids->{$id}{'model'} = $mon{$key}->{'model'};
|
|
}
|
|
$monitor_ids->{$id}{'scale'} = $mon{$key}->{'scale'} if defined $mon{$key}->{'scale'};
|
|
# fallbacks in case wl_output block is not present, which happens
|
|
if (!defined $mon{$key}->{'pos-x'} && defined $mon{$key}->{'log-pos-x'}){
|
|
$monitor_ids->{$id}{'pos-x'} = $mon{$key}->{'log-pos-x'};
|
|
}
|
|
if (!defined $mon{$key}->{'pos-y'} && defined $mon{$key}->{'log-pos-y'}){
|
|
$monitor_ids->{$id}{'pos-y'} = $mon{$key}->{'log-pos-y'};
|
|
}
|
|
if (!defined $mon{$key}->{'res-x'} && defined $mon{$key}->{'log-x'}){
|
|
$monitor_ids->{$id}{'res-x'} = $mon{$key}->{'log-x'};
|
|
}
|
|
if (!defined $mon{$key}->{'res-y'} && defined $mon{$key}->{'log-y'}){
|
|
$monitor_ids->{$id}{'res-y'} = $mon{$key}->{'log-y'};
|
|
}
|
|
}
|
|
}
|
|
print '%mon: ', Data::Dumper::Dumper \%mon if $dbg[46];
|
|
main::log_data('dump','%mon', \%mon) if $b_log;
|
|
print 'wayland/weston-info: monitor_ids: ', Data::Dumper::Dumper $monitor_ids if $dbg[46];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# Note; since not all systems will have /sys data, we'll repack it if it's
|
|
# missing here.
|
|
sub swaymsg_data {
|
|
eval $start if $b_log;
|
|
my ($program) = @_;
|
|
my (@data,%json,@temp,$ref);
|
|
my ($b_json,$file,$hz,$id,$model,$pos_x,$pos_y,$res_x,$res_y,$scale,$serial);
|
|
if (!$fake{'swaymsg'}){
|
|
main::load_json() if !$loaded{'json'};
|
|
if ($use{'json'}){
|
|
my $result = qx($program -t get_outputs -r 2>/dev/null);
|
|
# returns array of monitors found
|
|
@data = &{$use{'json'}->{'decode'}}($result) if $result;
|
|
$b_json = 1;
|
|
print "$use{'json'}->{'type'}: " if $dbg[46];
|
|
# print "using: $use{'json'}->{'type'}\n";
|
|
}
|
|
else {
|
|
@data = main::grabber("$program -t get_outputs -p 2>/dev/null",'','strip');
|
|
}
|
|
}
|
|
else {
|
|
undef $monitor_ids;
|
|
$file = "$fake_data_dir/graphics/wayland/swaymsg-2-monitor-1.txt";
|
|
@data = main::reader($file,'strip');
|
|
}
|
|
print 'swaymsg: ', Data::Dumper::Dumper \@data if $dbg[46];
|
|
main::log_data('dump','@data', \@data) if $b_log;
|
|
# print Data::Dumper::Dumper \@data;
|
|
if ($b_json){
|
|
$b_wayland_data = 1 if scalar @data > 0;
|
|
foreach my $display (@data){
|
|
foreach my $mon (@$display){
|
|
($hz,$pos_x,$pos_y,$res_x,$res_y,$scale) = ();
|
|
$id = $mon->{'name'};
|
|
if (!$monitor_ids->{$id}{'monitor'}){
|
|
$monitor_ids->{$id}{'monitor'} = $mon->{'name'};
|
|
}
|
|
# we don't want to overwrite good edid model data if we already got it
|
|
if (!$monitor_ids->{$id}{'model'} && $mon->{'make'}){
|
|
$monitor_ids->{$id}{'model'} = main::clean($mon->{'make'});
|
|
if ($mon->{'model'}){
|
|
$monitor_ids->{$id}{'model'} .= ' ' . main::clean($mon->{'model'});
|
|
}
|
|
$monitor_ids->{$id}{'model'} = main::remove_duplicates($monitor_ids->{$id}{'model'});
|
|
}
|
|
if ($monitor_ids->{$id}{'primary'}){
|
|
if ($monitor_ids->{$id}{'primary'} ne 'false'){
|
|
$monitor_ids->{$id}{'primary'} = $id;
|
|
$b_primary = 1;
|
|
}
|
|
else {
|
|
$monitor_ids->{$id}{'primary'} = undef;
|
|
}
|
|
}
|
|
if (!$monitor_ids->{$id}{'serial'}){
|
|
$monitor_ids->{$id}{'serial'} = main::clean_dmi($mon->{'serial'});
|
|
}
|
|
# sys data will only have edid type info, not active state res/pos/hz
|
|
if ($mon->{'current_mode'}){
|
|
if ($hz = $mon->{'current_mode'}{'refresh'}){
|
|
$hz = sprintf('%.0f',($mon->{'current_mode'}{'refresh'}/1000));
|
|
$monitor_ids->{$id}{'hz'} = $hz;
|
|
}
|
|
$monitor_ids->{$id}{'res-x'} = $mon->{'current_mode'}{'width'};
|
|
$monitor_ids->{$id}{'res-y'} = $mon->{'current_mode'}{'height'};
|
|
}
|
|
if ($mon->{'rect'}){
|
|
$monitor_ids->{$id}{'pos-x'} = $mon->{'rect'}{'x'};
|
|
$monitor_ids->{$id}{'pos-y'} = $mon->{'rect'}{'y'};
|
|
}
|
|
if ($mon->{'scale'}){
|
|
$monitor_ids->{$id}{'scale'} =$mon->{'scale'};
|
|
}
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
foreach (@data){
|
|
push(@temp,'~~') if /^Output/i;
|
|
push(@temp,$_);
|
|
}
|
|
push(@temp,'~~') if @temp;
|
|
@data = @temp;
|
|
$b_wayland_data = 1 if scalar @data > 8;
|
|
foreach (@data){
|
|
if ($_ eq '~~' && $id){
|
|
$monitor_ids->{$id}{'hz'} = $hz;
|
|
$monitor_ids->{$id}{'model'} = $model if $model;
|
|
$monitor_ids->{$id}{'monitor'} = $id;
|
|
$monitor_ids->{$id}{'pos-x'} = $pos_x;
|
|
$monitor_ids->{$id}{'pos-y'} = $pos_y;
|
|
$monitor_ids->{$id}{'res-x'} = $res_x;
|
|
$monitor_ids->{$id}{'res-y'} = $res_y;
|
|
$monitor_ids->{$id}{'scale'} = $scale;
|
|
$monitor_ids->{$id}{'serial'} = $serial if $serial;
|
|
($hz,$model,$pos_x,$pos_y,$res_x,$res_y,$scale,$serial) = ();
|
|
$b_wayland_data = 1;
|
|
}
|
|
# Output VGA-1 '<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;
|
|
}
|
|
}
|
|
}
|
|
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("$ENV{HOME}/bin/scripts/inxi/data/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 = "$ENV{HOME}/bin/scripts/inxi/data/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_screens,$xrandr);
|
|
if (!$fake{'xrandr'}){
|
|
$xrandr = main::grabber("$program $display_opt 2>/dev/null",'','strip','ref');
|
|
}
|
|
else {
|
|
# my $file;
|
|
# $file = ""$ENV{HOME}/bin/scripts/inxi/data/xrandr/xrandr-4-displays-1.txt";
|
|
# $file = "$ENV{HOME}/bin/scripts/inxi/data/xrandr/xrandr-3-display-primary-issue.txt";
|
|
# $file = "$ENV{HOME}/bin/scripts/inxi/data/xrandr/xrandr-test-1.txt";
|
|
# $file = "$ENV{HOME}/bin/scripts/inxi/data/xrandr/xrandr-test-2.txt";
|
|
# $file = "$ENV{HOME}/bin/scripts/inxi/data/xrandr/xrandr-1-screen-2-in-inxi.txt";
|
|
# $xrandr = main::reader($file,'strip','ref');
|
|
}
|
|
# $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);
|
|
}
|
|
my @working = split(/\s+/,$_);
|
|
# this is the monitor current dimensions
|
|
# 5120x1440 59.98* 29.98
|
|
if ($working[1] =~ /\*/){
|
|
$working[1] =~ s/\*|\+//g;
|
|
$working[1] = sprintf("%.0f",$working[1]);
|
|
if ($monitor_id && %monitors){
|
|
$monitors{$monitor_id}->{'hz'} = $working[1];
|
|
}
|
|
($diagonal,$dpi) = ('','');
|
|
# print Data::Dumper::Dumper \@monitors;
|
|
}
|
|
}
|
|
if (%monitors){
|
|
push(@xrandr_screens,{%monitors});
|
|
}
|
|
my $i = 0;
|
|
my $layouts;
|
|
# corner cases, xrandr screens > xdpyinfo screen, no xdpyinfo counts
|
|
if ($graphics{'screens'} && (!defined $graphics{'display-screens'} ||
|
|
$graphics{'display-screens'} < scalar @{$graphics{'screens'}})){
|
|
$graphics{'display-screens'} = scalar @{$graphics{'screens'}};
|
|
}
|
|
map_monitor_ids(\@ids) if @ids;
|
|
# print "xrandr_screens 1: " . Data::Dumper::Dumper \@xrandr_screens;
|
|
foreach my $main (@{$graphics{'screens'}}){
|
|
# print "h: " . Data::Dumper::Dumper $main;
|
|
# print "h: " . Data::Dumper::Dumper @xrandr_screens;
|
|
# print $main->{'screen'}, "\n";
|
|
foreach my $x_screen (@xrandr_screens){
|
|
# print "d: " . Data::Dumper::Dumper $x_screen;
|
|
my @keys = sort keys %$x_screen;
|
|
if ($x_screen->{$keys[0]}{'screen'} eq $main->{'screen'} &&
|
|
!defined $graphics{'screens'}->[$i]{'monitors'}){
|
|
$graphics{'screens'}->[$i]{'monitors'} = $x_screen;
|
|
}
|
|
if ($extra > 1){
|
|
if (!$layouts){
|
|
$layouts = [];
|
|
set_monitor_layouts($layouts);
|
|
}
|
|
advanced_monitor_data($x_screen,$layouts);
|
|
}
|
|
if (!defined $main->{'size-x'}){
|
|
$graphics{'screens'}->[$i]{'size-missing'} = main::message('tool-missing-basic','xdpyinfo');
|
|
}
|
|
}
|
|
$i++;
|
|
}
|
|
undef $layouts;
|
|
# print "xrandr_screens 2: " . Data::Dumper::Dumper \@xrandr_screens;
|
|
print 'Data: xrandr: ', Data::Dumper::Dumper $graphics{'screens'} if $dbg[17];
|
|
main::log_data('dump','$graphics{screens}',$graphics{'screens'}) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# Handle some strange corner cases with more robust testing
|
|
sub check_screens {
|
|
my ($id) = @_;
|
|
my $b_use;
|
|
# used: scalar @{$graphics{'screens'}} != (scalar @$xrandr_screens + 1)
|
|
# before but that test can fail in some cases.
|
|
# no screens set in xdpyinfo. If xrandr has > 1 xscreen, this would be false
|
|
if (!$graphics{'screens'}){
|
|
$b_use = 1;
|
|
}
|
|
# verify that any xscreen set so far does not exist in $graphics{'screens'}
|
|
else {
|
|
my $b_detected;
|
|
foreach my $screen (@{$graphics{'screens'}}){
|
|
if ($screen->{'screen'} eq $id){
|
|
$b_detected = 1;
|
|
last;
|
|
}
|
|
}
|
|
$b_use = 1 if !$b_detected;
|
|
}
|
|
return $b_use;
|
|
}
|
|
|
|
# Case where no xpdyinfo display server/version data exists, or to set Wayland
|
|
# Xwayland version, or Xvesa data.
|
|
sub display_server_data {
|
|
eval $start if $b_log;
|
|
my ($program);
|
|
# load the extra X paths, it's important that these are first, because
|
|
# later Xorg versions show error if run in console or ssh if the true path
|
|
# is not used.
|
|
@paths = (qw(/usr/lib /usr/lib/xorg /usr/lib/xorg-server /usr/libexec), @paths);
|
|
my (@data,$server,$version);
|
|
if (!$graphics{'x-server'} || !$graphics{'x-server'}->[0][1]){
|
|
# IMPORTANT: both commands send version data to stderr!
|
|
if ($program = main::check_program('Xorg')){
|
|
@data = main::grabber("$program -version 2>&1",'','strip');
|
|
$server = 'X.org';
|
|
}
|
|
elsif ($program = main::check_program('X')){
|
|
@data = main::grabber("$program -version 2>&1",'','strip');
|
|
$server = 'X.org';
|
|
}
|
|
elsif ($program = main::check_program('Xvesa')){
|
|
@data = main::grabber("$program -version 2>&1",'','strip');
|
|
$server = 'Xvesa';
|
|
$graphics{'display-driver'} = ['vesa'];
|
|
$graphics{'xvesa'} = $program;
|
|
if (!$graphics{'screens'}){
|
|
$graphics{'no-screens'} = main::message('screen-xvesa');
|
|
}
|
|
}
|
|
# print join('^ ', @paths), " :: $program\n";
|
|
# print Data::Dumper::Dumper \@data;
|
|
if ($data[0]){
|
|
if ($data[0] =~ /X.org X server (\S+)/i){
|
|
$version = $1;
|
|
}
|
|
elsif ($data[0] =~ /XFree86 Version (\S+)/i){
|
|
$version = $1;
|
|
$server = 'XFree86';
|
|
}
|
|
elsif ($data[0] =~ /X Window System Version (\S+)/i){
|
|
$version = $1;
|
|
}
|
|
elsif ($data[0] =~ /Xvesa from tinyx (\S+)/i){
|
|
$version = $1;
|
|
$server = 'TinyX Xvesa';
|
|
}
|
|
}
|
|
$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;
|
|
}
|
|
|
|
sub display_protocol {
|
|
eval $start if $b_log;
|
|
$graphics{'protocol'} = '';
|
|
if ($ENV{'XDG_SESSION_TYPE'}){
|
|
$graphics{'protocol'} = $ENV{'XDG_SESSION_TYPE'};
|
|
}
|
|
if (!$graphics{'protocol'} && $ENV{'WAYLAND_DISPLAY'}){
|
|
$graphics{'protocol'} = $ENV{'WAYLAND_DISPLAY'};
|
|
}
|
|
# can show as wayland-0
|
|
if ($graphics{'protocol'} && $graphics{'protocol'} =~ /wayland/i){
|
|
$graphics{'protocol'} = 'wayland';
|
|
}
|
|
# yes, I've seen this in 2019 distros, sigh
|
|
elsif ($graphics{'protocol'} eq 'tty'){
|
|
$graphics{'protocol'} = '';
|
|
}
|
|
# If no other source, get user session id, then grab session type.
|
|
# loginctl also results in the session id
|
|
# undef $graphics{'protocol'};
|
|
if (!$graphics{'protocol'}){
|
|
if (my $program = main::check_program('loginctl')){
|
|
my $id = '';
|
|
# $id = $ENV{'XDG_SESSION_ID'}; # returns tty session in console
|
|
my @data = main::grabber("$program --no-pager --no-legend 2>/dev/null",'','strip');
|
|
foreach (@data){
|
|
# some systems show empty or ??? for TTY field, but whoami should do ok
|
|
next if /(ttyv?\d|pts\/)/; # freebsd: ttyv3
|
|
# in display, root doesn't show in the logins
|
|
next if $client{'whoami'} && $client{'whoami'} ne 'root' && !/\b$client{'whoami'}\b/;
|
|
$id = (split(/\s+/, $_))[0];
|
|
# multiuser? too bad, we'll go for the first one that isn't a tty/pts
|
|
last;
|
|
}
|
|
if ($id){
|
|
my $temp = (main::grabber("$program show-session $id -p Type --no-pager --no-legend 2>/dev/null"))[0];
|
|
$temp =~ s/Type=// if $temp;
|
|
# ssh will not show /dev/ttyx so would have passed the first test
|
|
$graphics{'protocol'} = $temp if $temp && $temp ne 'tty';
|
|
}
|
|
}
|
|
}
|
|
$graphics{'protocol'} = lc($graphics{'protocol'}) if $graphics{'protocol'};
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## DRIVER DATA ##
|
|
# for wayland display/monitor drivers, or if no display drivers found for x
|
|
sub gpu_drivers_sys {
|
|
eval $start if $b_log;
|
|
my ($id) = @_;
|
|
my ($driver);
|
|
my $drivers = [];
|
|
# we only want list of drivers for cards with a connected monitor, and inactive
|
|
# ports are already removed by the 'all' stage.
|
|
foreach my $port (keys %{$monitor_ids}){
|
|
if (!$monitor_ids->{$port}{'drivers'} ||
|
|
($id ne 'all' && $id ne $port) ||
|
|
!$monitor_ids->{$port}{'status'} ||
|
|
$monitor_ids->{$port}{'status'} ne 'connected'){
|
|
next;
|
|
}
|
|
else {
|
|
foreach $driver (@{$monitor_ids->{$port}{'drivers'}}){
|
|
push(@$drivers,$driver);
|
|
}
|
|
}
|
|
}
|
|
if (@$drivers){
|
|
@$drivers = sort(@$drivers);
|
|
main::uniq($drivers);
|
|
}
|
|
eval $end if $b_log;
|
|
return $drivers;
|
|
}
|
|
|
|
sub display_drivers_x {
|
|
eval $start if $b_log;
|
|
my $driver_data = [];
|
|
# print 'x-log: ' . $system_files{'xorg-log'} . "\n";
|
|
if (my $log = $system_files{'xorg-log'}){
|
|
if ($fake{'xorg-log'}){
|
|
# $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/Xorg.0-voyager-serena.log";
|
|
# $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/loading-unload-failed-all41-mint.txt";
|
|
# $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/loading-unload-failed-phd21-mint.txt";
|
|
# $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/Xorg.0-gm10.log";
|
|
# $log = "$ENV{HOME}/bin/scripts/inxi/data/xorg-logs/xorg-multi-driver-1.log";
|
|
}
|
|
my $x_log = main::reader($log,'','ref');
|
|
# list is from sgfxi plus non-free drivers, plus ARM drivers.
|
|
# Don't use ati. It's just a wrapper for: r128, mach64, radeon
|
|
my $list = join('|', qw(amdgpu apm ark armsoc atimisc
|
|
chips cirrus cyrix etnaviv fbdev fbturbo fglrx geode glide glint
|
|
i128 i740 i810-dec100 i810e i810 i815 i830 i845 i855 i865 i915 i945 i965
|
|
iftv imstt intel ivtv mach64 mesa mga m68k 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));
|
|
# $list = qr/$list/i; # qr/../i only added perl 5.14, fails on older perls
|
|
my ($b_use_dri,$dri,$driver,%drivers);
|
|
my ($alternate,$failed,$loaded,$unloaded);
|
|
my $pattern = 'Failed|Unload|Loading';
|
|
# preferred source xdriinfo because it's current and accurate, but fallback here
|
|
if (!$graphics{'dri-drivers'}){
|
|
$b_use_dri = 1;
|
|
$pattern .= '|DRI driver:';
|
|
}
|
|
# $pattern = qr/$pattern/i; # qr/../i only added perl 5.14, fails on older perls
|
|
# it's much cheaper to grab the simple pattern match then do the expensive one
|
|
# in the main loop.
|
|
# @$x_log = grep {/Failed|Unload|Loading/} @$x_log;
|
|
foreach my $line (@$x_log){
|
|
next if $line !~ /$pattern/i;
|
|
# print "$line\n";
|
|
# note that in file names, driver is always lower case. Legacy _drv.o
|
|
if ($line =~ /\sLoading.*($list)_drv\.s?o$/i){
|
|
$driver=lc($1);
|
|
# we get all the actually loaded drivers first, we will use this to compare the
|
|
# failed/unloaded, which have not always actually been truly loaded
|
|
$drivers{$driver}='loaded';
|
|
}
|
|
# openbsd uses UnloadModule:
|
|
elsif ($line =~ /(Unloading\s|UnloadModule).*\"?($list)(_drv\.s?o)?\"?$/i){
|
|
$driver=lc($2);
|
|
# we get all the actually loaded drivers first, we will use this to compare the
|
|
# failed/unloaded, which have not always actually been truly loaded
|
|
if (exists $drivers{$driver} && $drivers{$driver} ne 'alternate'){
|
|
$drivers{$driver}='unloaded';
|
|
}
|
|
}
|
|
# verify that the driver actually started the desktop, even with false failed messages
|
|
# which can occur. This is the driver that is actually driving the display.
|
|
# note that xorg will often load several modules, like modesetting,fbdev,nouveau
|
|
# NOTE:
|
|
# (II) UnloadModule: "nouveau"
|
|
# (II) Unloading nouveau
|
|
# (II) Failed to load module "nouveau" (already loaded, 0)
|
|
# (II) LoadModule: "modesetting"
|
|
elsif ($line =~ /Failed.*($list)\"?.*$/i){
|
|
# Set driver to lower case because sometimes it will show as
|
|
# RADEON or NVIDIA in the actual x start
|
|
$driver=lc($1);
|
|
# we need to make sure that the driver has already been truly loaded,
|
|
# not just discussed
|
|
if (exists $drivers{$driver} && $drivers{$driver} ne 'alternate'){
|
|
if ($line !~ /\(already loaded/){
|
|
$drivers{$driver}='failed';
|
|
}
|
|
# reset the previous line's 'unloaded' to 'loaded' as well
|
|
else {
|
|
$drivers{$driver}='loaded';
|
|
}
|
|
}
|
|
elsif ($line =~ /module does not exist/){
|
|
$drivers{$driver}='alternate';
|
|
}
|
|
}
|
|
elsif ($b_use_dri && $line =~ /DRI driver:\s*(\S+)/i){
|
|
$dri = $1;
|
|
if (!$graphics{'dri-drivers'} ||
|
|
!(grep {$dri eq $_} @{$graphics{'dri-drivers'}})){
|
|
push(@{$graphics{'dri-drivers'}},$dri);
|
|
}
|
|
}
|
|
}
|
|
# print 'drivers: ', Data::Dumper::Dumper \%drivers;
|
|
foreach (sort keys %drivers){
|
|
if ($drivers{$_} eq 'loaded'){
|
|
push(@$loaded,$_);
|
|
}
|
|
elsif ($drivers{$_} eq 'unloaded'){
|
|
push(@$unloaded,$_);
|
|
}
|
|
elsif ($drivers{$_} eq 'failed'){
|
|
push(@$failed,$_);
|
|
}
|
|
elsif ($drivers{$_} eq 'alternate'){
|
|
push(@$alternate,$_);
|
|
}
|
|
}
|
|
if ($loaded || $unloaded || $failed || $alternate){
|
|
$driver_data = [$loaded,$unloaded,$failed,$alternate];
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
# print 'source: ', Data::Dumper::Dumper $driver_data;
|
|
return $driver_data;
|
|
}
|
|
sub set_mesa_drivers {
|
|
%mesa_drivers = (
|
|
'anv' => 'intel',
|
|
'crocus' => 'intel',
|
|
'etnaviv' => 'vivante',
|
|
'freedreno' => 'qualcomm',
|
|
'i915' => 'intel',
|
|
'i965' => 'intel',
|
|
'iris' => 'intel',
|
|
'lima' => 'mali',
|
|
'nouveau' => 'nvidia',
|
|
'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' => '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' => '',
|
|
'code' => 'Instinct-MI3xx',
|
|
'pattern' => 'Instinct MI3\d{2}X?',
|
|
'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' => '5690|5691|5692|5693|5694|5695|5696|5697|5698|56a0|56a1|56a3|56a4|' .
|
|
'56a5|56a6|56a7|56a8|56a9|56b0|56b1|56b2|56b3',
|
|
'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+',
|
|
},
|
|
|
|
];
|
|
}
|
|
|
|
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|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',
|
|
'code' => 'GH1xx',
|
|
'kernel' => '',
|
|
'legacy' => 0,
|
|
'process' => 'TSMC n4 (5nm)',
|
|
'release' => '',
|
|
'series' => '545.xx+',
|
|
'status' => $status_current,
|
|
'xorg' => '',
|
|
'years' => '2022+',
|
|
},
|
|
{'arch' => 'Lovelace',
|
|
'ids' => '2684|26b1|26b2|26b5|26b9|2704|2717|2730|2757|2770|2782|2786|27a0|' .
|
|
'27b0|27b1|27b2|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*-*/{edid,enabled,status,modes}';
|
|
my @ports_glob = main::globber($pattern);
|
|
# print Data::Dumper::Dumper \@cards_glob;
|
|
# print Data::Dumper::Dumper \@ports_glob;
|
|
my ($card,%cards,@data,$file,$item,$path,$port);
|
|
foreach $file (@cards_glob){
|
|
next if ! -e $file;
|
|
if ($file =~ m|^/sys/class/drm/(card\d+)/.+?/drivers/(\S+):(\S+)$|){
|
|
push(@{$cards{$1}},[$2,$3]);
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \%cards;
|
|
foreach $file (sort @ports_glob){
|
|
next if ! -r $file;
|
|
$item = $file;
|
|
$item =~ s|(/.*/(card\d+)-([^/]+))/(.+)||;
|
|
$path = $1;
|
|
$card = $2;
|
|
$port = $3;
|
|
$item = $4;
|
|
next if !$1;
|
|
$monitor_ids = {} if !$monitor_ids;
|
|
$monitor_ids->{$port}{'monitor'} = $port;
|
|
if (!$monitor_ids->{$port}{'drivers'} && $cards{$card}){
|
|
foreach my $info (@{$cards{$card}}){
|
|
push(@{$monitor_ids->{$port}{'drivers'}},$info->[1]);
|
|
}
|
|
}
|
|
$monitor_ids->{$port}{'path'} = readlink($path);
|
|
$monitor_ids->{$port}{'path'} =~ s|^\.\./\.\.|/sys|;
|
|
if ($item eq 'status' || $item eq 'enabled'){
|
|
# print "$file\n";
|
|
$monitor_ids->{$port}{$item} = main::reader($file,'strip',0);
|
|
}
|
|
# arm: U:1680x1050p-0
|
|
elsif ($item eq 'modes'){
|
|
@data = main::reader($file,'strip');
|
|
next if !@data;
|
|
# modes has repeat values, probably because kernel doesn't show hz
|
|
main::uniq(\@data);
|
|
$monitor_ids->{$port}{'modes'} = [@data];
|
|
}
|
|
elsif ($item eq 'edid'){
|
|
next if -s $file;
|
|
monitor_edid_data($file,$port);
|
|
}
|
|
}
|
|
main::log_data('dump','$ports ref',$monitor_ids) if $b_log;
|
|
print 'monitor_sys_data(): ', Data::Dumper::Dumper $monitor_ids if $dbg[44];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub monitor_edid_data {
|
|
eval $start if $b_log;
|
|
my ($file,$port) = @_;
|
|
my (@data);
|
|
open my $fh, '<:raw', $file or return; # it failed, give up, we don't care why
|
|
my $edid_raw = do { local $/; <$fh> };
|
|
return if !$edid_raw;
|
|
my $edid = ParseEDID::parse_edid($edid_raw,$dbg[47]);
|
|
main::log_data('dump','Parse::EDID',$edid) if $b_log;
|
|
print 'parse_edid(): ', Data::Dumper::Dumper $edid if $dbg[44];
|
|
return if !$edid || ref $edid ne 'HASH' || !%$edid;
|
|
$monitor_ids->{$port}{'build-date'} = $edid->{'year'};
|
|
if ($edid->{'color_characteristics'}){
|
|
$monitor_ids->{$port}{'colors'} = $edid->{'color_characteristics'};
|
|
}
|
|
if ($edid->{'gamma'}){
|
|
$monitor_ids->{$port}{'gamma'} = ($edid->{'gamma'}/100 + 0);
|
|
}
|
|
if ($edid->{'monitor_name'} || $edid->{'manufacturer_name_nice'}){
|
|
my $model = '';
|
|
if ($edid->{'manufacturer_name_nice'}){
|
|
$model = $edid->{'manufacturer_name_nice'};
|
|
}
|
|
if ($edid->{'monitor_name'}){
|
|
$model .= ' ' if $model;
|
|
$model .= $edid->{'monitor_name'};
|
|
}
|
|
elsif ($model && $edid->{'product_code_h'}){
|
|
$model .= ' ' . $edid->{'product_code_h'};
|
|
}
|
|
$monitor_ids->{$port}{'model'} = main::remove_duplicates(main::clean($model));
|
|
}
|
|
elsif ($edid->{'manufacturer_name'} && $edid->{'product_code_h'}){
|
|
$monitor_ids->{$port}{'model-id'} = $edid->{'manufacturer_name'} . ' ';
|
|
$monitor_ids->{$port}{'model-id'} .= $edid->{'product_code_h'};
|
|
}
|
|
# construct to match xorg values
|
|
if ($edid->{'manufacturer_name'} && $edid->{'product_code'}){
|
|
my $id = $edid->{'manufacturer_name'} . sprintf('%x',$edid->{'product_code'});
|
|
$monitor_ids->{$port}{$id} = ($edid->{'serial_number'}) ? $edid->{'serial_number'}: '';
|
|
}
|
|
if ($edid->{'diagonal_size'}){
|
|
$monitor_ids->{$port}{'diagonal-m'} = sprintf('%.0f',($edid->{'diagonal_size'}*25.4)) + 0;
|
|
$monitor_ids->{$port}{'diagonal'} = sprintf('%.1f',$edid->{'diagonal_size'}) + 0;
|
|
}
|
|
if ($edid->{'ratios'}){
|
|
$monitor_ids->{$port}{'ratio'} = join(', ', @{$edid->{'ratios'}});
|
|
}
|
|
if ($edid->{'detailed_timings'}){
|
|
$monitor_ids->{$port}{'res-x'} = $edid->{'detailed_timings'}[0]{'horizontal_active'};
|
|
$monitor_ids->{$port}{'res-y'} = $edid->{'detailed_timings'}[0]{'vertical_active'};
|
|
if ($edid->{'detailed_timings'}[0]{'horizontal_image_size'}){
|
|
$monitor_ids->{$port}{'size-x'} = $edid->{'detailed_timings'}[0]{'horizontal_image_size'};
|
|
$monitor_ids->{$port}{'size-x-i'} = $edid->{'detailed_timings'}[0]{'horizontal_image_size_i'};
|
|
}
|
|
if ($edid->{'detailed_timings'}[0]{'vertical_image_size'}){
|
|
$monitor_ids->{$port}{'size-y'} = $edid->{'detailed_timings'}[0]{'vertical_image_size'};
|
|
$monitor_ids->{$port}{'size-y-i'} = $edid->{'detailed_timings'}[0]{'vertical_image_size_i'};
|
|
}
|
|
if ($edid->{'detailed_timings'}[0]{'horizontal_dpi'}){
|
|
$monitor_ids->{$port}{'dpi'} = sprintf('%.0f',$edid->{'detailed_timings'}[0]{'horizontal_dpi'}) + 0;
|
|
}
|
|
}
|
|
if ($edid->{'serial_number'} || $edid->{'serial_number2'}){
|
|
# this looks much more like a real serial than the default: serial_number
|
|
if ($edid->{'serial_number2'} && @{$edid->{'serial_number2'}}){
|
|
$monitor_ids->{$port}{'serial'} = main::clean_dmi($edid->{'serial_number2'}[0]);
|
|
}
|
|
elsif ($edid->{'serial_number'}){
|
|
$monitor_ids->{$port}{'serial'} = main::clean_dmi($edid->{'serial_number'});
|
|
}
|
|
}
|
|
# this will be an array reference of one or more edid errors
|
|
if ($edid->{'edid_errors'}){
|
|
$monitor_ids->{$port}{'edid-errors'} = $edid->{'edid_errors'};
|
|
}
|
|
# this will be an array reference of one or more edid warnings
|
|
if ($edid->{'edid_warnings'}){
|
|
$monitor_ids->{$port}{'edid-warnings'} = $edid->{'edid_warnings'};
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub advanced_monitor_data {
|
|
eval $start if $b_log;
|
|
my ($monitors,$layouts) = @_;
|
|
my (@horiz,@vert);
|
|
my $position = '';
|
|
# then see if we can locate a default position primary monitor
|
|
foreach my $key (keys %$monitors){
|
|
next if !defined $monitors->{$key}{'pos-x'} || !defined $monitors->{$key}{'pos-y'};
|
|
# this is the only scenario we can guess at if no primary detected
|
|
if (!$b_primary && !$monitors->{$key}{'primary'} &&
|
|
$monitors->{$key}{'pos-x'} == 0 && $monitors->{$key}{'pos-y'} == 0){
|
|
$monitors->{$key}{'position'} = 'primary';
|
|
$monitors->{$key}{'primary'} = $monitors->{$key}{'monitor'};
|
|
}
|
|
if (!grep {$monitors->{$key}{'pos-x'} == $_} @horiz){
|
|
push(@horiz,$monitors->{$key}{'pos-x'});
|
|
}
|
|
if (!grep {$monitors->{$key}{'pos-y'} == $_} @vert){
|
|
push(@vert,$monitors->{$key}{'pos-y'});
|
|
}
|
|
}
|
|
# we need NUMERIC sort, because positions can be less than 1000!
|
|
@horiz = sort {$a <=> $b} @horiz;
|
|
@vert =sort {$a <=> $b} @vert;
|
|
my ($h,$v) = (scalar(@horiz),scalar(@vert));
|
|
# print Data::Dumper::Dumper \@horiz;
|
|
# print Data::Dumper::Dumper \@vert;
|
|
# print Data::Dumper::Dumper $layouts;
|
|
# print 'mon advanced monitor_map: ', Data::Dumper::Dumper $monitor_map;
|
|
foreach my $key (keys %$monitors){
|
|
# disabled monitor may not have pos-x/pos-y, so skip
|
|
if (@horiz && @vert && (scalar @horiz > 1 || scalar @vert > 1) &&
|
|
defined $monitors->{$key}{'pos-x'} && defined $monitors->{$key}{'pos-y'}){
|
|
$monitors->{$key}{'position'} ||= '';
|
|
$position = '';
|
|
$position = get_monitor_position($monitors->{$key},\@horiz,\@vert);
|
|
$position = $layouts->[$v][$h]{$position} if $layouts->[$v][$h]{$position};
|
|
$monitors->{$key}{'position'} .= ',' if $monitors->{$key}{'position'};
|
|
$monitors->{$key}{'position'} .= $position;
|
|
}
|
|
my $mon_mapped = ($monitor_map) ? $monitor_map->{$monitors->{$key}{'monitor'}} : undef;
|
|
# these are already set for monitor_ids, only need this for Xorg data.
|
|
if ($mon_mapped && $monitor_ids->{$mon_mapped}){
|
|
# note: xorg drivers can be different than gpu drivers
|
|
$monitors->{$key}{'drivers'} = gpu_drivers_sys($mon_mapped);
|
|
$monitors->{$key}{'build-date'} = $monitor_ids->{$mon_mapped}{'build-date'};
|
|
$monitors->{$key}{'colors'} = $monitor_ids->{$mon_mapped}{'colors'};
|
|
$monitors->{$key}{'diagonal'} = $monitor_ids->{$mon_mapped}{'diagonal'};
|
|
$monitors->{$key}{'diagonal-m'} = $monitor_ids->{$mon_mapped}{'diagonal-m'};
|
|
$monitors->{$key}{'gamma'} = $monitor_ids->{$mon_mapped}{'gamma'};
|
|
$monitors->{$key}{'modes'} = $monitor_ids->{$mon_mapped}{'modes'};
|
|
$monitors->{$key}{'model'} = $monitor_ids->{$mon_mapped}{'model'};
|
|
$monitors->{$key}{'color-characteristics'} = $monitor_ids->{$mon_mapped}{'color-characteristics'};
|
|
if (!defined $monitors->{$key}{'size-x'} && $monitor_ids->{$mon_mapped}{'size-x'}){
|
|
$monitors->{$key}{'size-x'} = $monitor_ids->{$mon_mapped}{'size-x'};
|
|
$monitors->{$key}{'size-x-i'} = $monitor_ids->{$mon_mapped}{'size-x-i'};
|
|
}
|
|
if (!defined $monitors->{$key}{'size-y'} && $monitor_ids->{$mon_mapped}{'size-y'}){
|
|
$monitors->{$key}{'size-y'} = $monitor_ids->{$mon_mapped}{'size-y'};
|
|
$monitors->{$key}{'size-y-i'} = $monitor_ids->{$mon_mapped}{'size-y-i'};
|
|
}
|
|
if (!defined $monitors->{$key}{'dpi'} && $monitor_ids->{$mon_mapped}{'dpi'}){
|
|
$monitors->{$key}{'dpi'} = $monitor_ids->{$mon_mapped}{'dpi'};
|
|
}
|
|
if ($monitor_ids->{$mon_mapped}{'model-id'}){
|
|
$monitors->{$key}{'model-id'} = $monitor_ids->{$mon_mapped}{'model-id'};
|
|
}
|
|
if ($monitor_ids->{$mon_mapped}{'edid-errors'}){
|
|
$monitors->{$key}{'edid-errors'} = $monitor_ids->{$mon_mapped}{'edid-errors'};
|
|
}
|
|
if ($monitor_ids->{$mon_mapped}{'edid-warnings'}){
|
|
$monitors->{$key}{'edid-warnings'} = $monitor_ids->{$mon_mapped}{'edid-warnings'};
|
|
}
|
|
if ($monitor_ids->{$mon_mapped}{'enabled'} &&
|
|
$monitor_ids->{$mon_mapped}{'enabled'} eq 'disabled'){
|
|
$monitors->{$key}{'disabled'} = $monitor_ids->{$mon_mapped}{'enabled'};
|
|
}
|
|
$monitors->{$key}{'ratio'} = $monitor_ids->{$mon_mapped}{'ratio'};
|
|
$monitors->{$key}{'serial'} = $monitor_ids->{$mon_mapped}{'serial'};
|
|
}
|
|
# now swap the drm id for the display server id if they don't match
|
|
if ($mon_mapped && $mon_mapped ne $monitors->{$key}{'monitor'}){
|
|
$monitors->{$key}{'monitor-mapped'} = $monitors->{$key}{'monitor'};
|
|
$monitors->{$key}{'monitor'} = $mon_mapped;
|
|
}
|
|
}
|
|
# not printing out primary if Screen has only 1 Monitor
|
|
if (scalar keys %$monitors == 1){
|
|
my @keys = keys %$monitors;
|
|
$monitors->{$keys[0]}{'position'} = undef;
|
|
}
|
|
print Data::Dumper::Dumper $monitors if $dbg[45];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# Clear out all disabled or not connected monitor ports
|
|
sub set_active_monitors {
|
|
eval $start if $b_log;
|
|
foreach my $key (keys %$monitor_ids){
|
|
if (!$monitor_ids->{$key}{'status'} ||
|
|
$monitor_ids->{$key}{'status'} ne 'connected'){
|
|
delete $monitor_ids->{$key};
|
|
}
|
|
}
|
|
# print 'active monitors: ', Data::Dumper::Dumper $monitor_ids;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_monitor_position {
|
|
eval $start if $b_log;
|
|
my ($monitor,$horiz,$vert) = @_;
|
|
my ($i,$position) = (1,'');
|
|
foreach (@$vert){
|
|
if ($_ == $monitor->{'pos-y'}){
|
|
$position = $i . '-';
|
|
last;
|
|
}
|
|
$i++;
|
|
}
|
|
$i = 1;
|
|
foreach (@$horiz){
|
|
if ($_ == $monitor->{'pos-x'}){
|
|
$position .= $i;
|
|
last;
|
|
}
|
|
$i++;
|
|
}
|
|
main::log_data('data','pos-raw: ' . $position) if $b_log;
|
|
eval $end if $b_log;
|
|
return $position;
|
|
}
|
|
|
|
sub set_monitor_layouts {
|
|
my ($layouts) = @_;
|
|
$layouts->[1][2] = {'1-1' => 'left','1-2' => 'right'};
|
|
$layouts->[1][3] = {'1-1' => 'left','1-2' => 'center','1-3' => 'right'};
|
|
$layouts->[1][4] = {'1-1' => 'left','1-2' => 'center-l','1-3' => 'center-r',
|
|
'1-4' => 'right'};
|
|
$layouts->[2][1] = {'1-1' => 'top','2-1' => 'bottom'};
|
|
$layouts->[2][2] = {'1-1' => 'top-left','1-2' => 'top-right',
|
|
'2-1' => 'bottom-l','2-2' => 'bottom-r'};
|
|
$layouts->[2][3] = {'1-1' => 'top-left','1-2' => 'top-center','1-3' => 'top-right',
|
|
'2-1' => 'bottom-l','2-2' => 'bottom-c','2-3' => 'bottom-r'};
|
|
$layouts->[3][1] = {'1-1' => 'top','2-1' => 'middle','3-1' => 'bottom'};
|
|
$layouts->[3][2] = {'1-1' => 'top-left','1-2' => 'top-right',
|
|
'2-1' => 'middle-l','2-2' => 'middle-r',
|
|
'3-1' => 'bottom-l','3-2' => 'bottom-r'};
|
|
$layouts->[3][3] = {'1-1' => 'top-left','1-2' => 'top-center',,'1-3' => 'top-right',
|
|
'2-1' => 'middle-l','2-2' => 'middle-c','2-3' => 'middle-r',
|
|
'3-1' => 'bottom-l','3-2' => 'bottom-c','3-3' => 'bottom-r'};
|
|
}
|
|
|
|
# This is required to resolve the situation where some xorg drivers change
|
|
# the kernel ID for the port to something slightly different, amdgpu in particular.
|
|
sub map_monitor_ids {
|
|
eval $start if $b_log;
|
|
my ($display_ids) = @_;
|
|
return if !$monitor_ids;
|
|
my (@sys_ids,@unmatched_display,@unmatched_sys);
|
|
@unmatched_display = @$display_ids = sort { lc($a) cmp lc($b) } @$display_ids;
|
|
foreach my $key (keys %$monitor_ids){
|
|
if ($monitor_ids->{$key}{'status'} eq 'connected'){
|
|
push(@sys_ids,$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;
|
|
@unmatched_sys = @sys_ids = sort { lc($a) cmp lc($b) } @sys_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] d: $display_ids->[$i]\n" if $dbg[45];
|
|
# try 1: /^([A-Z]+)(-[AB]|-[ADI]|-[ADI]-\d+?|-\d+?)?(-)?(\d+)$/i
|
|
if ($display_ids->[$i] =~ /^$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] =~ /^$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]} = $sys_ids[$i];
|
|
@unmatched_display = grep {$_ ne $display_ids->[$i]} @unmatched_display;
|
|
@unmatched_sys = grep {$_ ne $sys_ids[$i]} @unmatched_sys;
|
|
}
|
|
}
|
|
}
|
|
# in case of one unmatched, we'll dump this, and use the actual unmatched
|
|
if (!$monitor_map->{$display_ids->[$i]}){
|
|
# 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]} = $sys_ids[$i];
|
|
(@unmatched_display,@unmatched_sys) = ();
|
|
}
|
|
else {
|
|
$monitor_map->{$display_ids->[$i]} = main::message('monitor-id');
|
|
}
|
|
}
|
|
}
|
|
# we don't care at all what the pattern is, if there is 1 unmatched display
|
|
# out of 1 sys ids, we'll assume that is the one. This can only be assumed in
|
|
# cases where only 1 monitor was not matched, otherwise it's just a guess.
|
|
# obviously, if one of the matches was wrong, this will also be wrong, but
|
|
# thats' life when dealing with irrational data. DP is a particular problem.
|
|
if (scalar @unmatched_sys == 1){
|
|
$monitor_map->{$unmatched_display[0]} = $unmatched_sys[0];
|
|
}
|
|
main::log_data('dump','$monitor_map ref',$monitor_map) if $b_log;
|
|
print Data::Dumper::Dumper $monitor_map if $dbg[45];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# Handle case of monitor on left or right edge, vertical that is.
|
|
# mm dimensiions are based on the default position of monitor as sold.
|
|
# very old systems may not have non 0 value for size x or y
|
|
# size, res x,y by reference
|
|
sub flip_size_x_y {
|
|
eval $start if $b_log;
|
|
my ($size_x,$size_y,$res_x,$res_y) = @_;
|
|
if ((($$res_x/$$res_y > 1 && $$size_x/$$size_y < 1) ||
|
|
($$res_x/$$res_y < 1 && $$size_x/$$size_y > 1))){
|
|
($$size_x,$$size_y) = ($$size_y,$$size_x);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## COMPOSITOR DATA ##
|
|
sub set_compositor_data {
|
|
eval $start if $b_log;
|
|
my $compositors = get_compositors();
|
|
if (@$compositors){
|
|
my @data;
|
|
foreach my $compositor (@$compositors){
|
|
# gnome-shell is incredibly slow to return version
|
|
if (($extra > 1 || $graphics{'protocol'} eq 'wayland') &&
|
|
(!$show{'system'} || $compositor ne 'gnome-shell')){
|
|
$graphics{'compositors'} = [] if !$graphics{'compositors'};
|
|
push(@{$graphics{'compositors'}},[main::program_data($compositor,$compositor)]);
|
|
}
|
|
else {
|
|
$graphics{'compositors'} = [] if !$graphics{'compositors'};
|
|
push(@{$graphics{'compositors'}},[(main::program_values($compositor))[3]]);
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_compositors {
|
|
eval $start if $b_log;
|
|
my $found = [];
|
|
main::set_ps_gui() if !$loaded{'ps-gui'};
|
|
if (@ps_gui){
|
|
# ORDER MATTES!
|
|
# notes: compiz: debian package compiz-core;
|
|
# enlightenment: as of version 20 wayland compositor
|
|
my @compositors = qw(budgie-wm compiz compton enlightenment gnome-shell
|
|
kwin_wayland kwin_x11 kwinft marco muffin mutter);
|
|
# these are more obscure, so check for them after primary common ones
|
|
push (@compositors,qw(3dwm cosmic-comp dcompmgr gala kmscon
|
|
metisse mir moblin monsterwm picom ukwm unagi unity-system-compositor
|
|
xcompmgr xfwm4 xfwm5 xfwm));
|
|
my $matches = join('|',@compositors) . $wl_compositors;
|
|
foreach my $psg (@ps_gui){
|
|
if ($psg =~ /^($matches)$/){
|
|
push(@$found,$1);
|
|
}
|
|
}
|
|
}
|
|
main::log_data('dump','$found compositors:', $found) if $b_log;
|
|
eval $end if $b_log;
|
|
return $found;
|
|
}
|
|
|
|
## UTILITIES ##
|
|
sub tty_data {
|
|
eval $start if $b_log;
|
|
my ($tty);
|
|
if ($size{'term-cols'}){
|
|
$tty = "$size{'term-cols'}x$size{'term-lines'}";
|
|
}
|
|
# this is broken
|
|
elsif ($b_irc && $client{'console-irc'}){
|
|
ShellData::console_irc_tty() if !$loaded{'con-irc-tty'};
|
|
my $tty_working = $client{'con-irc-tty'};
|
|
if ($tty_working ne '' && (my $program = main::check_program('stty'))){
|
|
my $tty_arg = ($bsd_type) ? '-f' : '-F';
|
|
# handle vtnr integers, and tty ID with letters etc.
|
|
$tty_working = "tty$tty_working" if -e "/dev/tty$tty_working";
|
|
$tty = (main::grabber("$program $tty_arg /dev/$tty_working size 2>/dev/null"))[0];
|
|
if ($tty){
|
|
my @temp = split(/\s+/, $tty);
|
|
$tty = "$temp[1]x$temp[0]";
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $tty;
|
|
}
|
|
}
|
|
|
|
## LogicalItem
|
|
{
|
|
package LogicalItem;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my ($key1,$val1);
|
|
my $rows = [];
|
|
my $num = 0;
|
|
if ($bsd_type){
|
|
$key1 = 'Message';
|
|
$val1 = main::message('logical-data-bsd',$uname[0]);
|
|
push(@$rows,{main::key($num++,0,1,$key1) => $val1});
|
|
}
|
|
else {
|
|
LsblkData::set() if !$loaded{'lsblk'};
|
|
if ($fake{'logical'} || $alerts{'lvs'}->{'action'} eq 'use'){
|
|
lvm_data() if !$loaded{'logical-data'};
|
|
if (!@lvm){
|
|
my $key = 'Message';
|
|
# note: arch linux has a bug where lvs returns 0 if non root start
|
|
my $message = ($use{'logical-lvm'}) ? main::message('tool-permissions','lvs') : main::message('logical-data','');
|
|
push(@$rows, {
|
|
main::key($num++,0,1,$key) => $message,
|
|
});
|
|
}
|
|
else {
|
|
lvm_output($rows,process_lvm_data());
|
|
}
|
|
}
|
|
elsif ($use{'logical-lvm'} && $alerts{'lvs'}->{'action'} eq 'permissions'){
|
|
my $key = 'Message';
|
|
push(@$rows, {
|
|
main::key($num++,0,1,$key) => $alerts{'lvs'}->{'message'},
|
|
});
|
|
}
|
|
elsif (@lsblk && !$use{'logical-lvm'} && ($alerts{'lvs'}->{'action'} eq 'permissions' ||
|
|
$alerts{'lvs'}->{'action'} eq 'missing')){
|
|
my $key = 'Message';
|
|
push(@$rows, {
|
|
main::key($num++,0,1,$key) => main::message('logical-data',''),
|
|
});
|
|
}
|
|
elsif ($alerts{'lvs'}->{'action'} ne 'use'){
|
|
$key1 = $alerts{'lvs'}->{'action'};
|
|
$val1 = $alerts{'lvs'}->{'message'};
|
|
$key1 = ucfirst($key1);
|
|
push(@$rows, {main::key($num++,0,1,$key1) => $val1});
|
|
}
|
|
if ($use{'logical-general'}){
|
|
my $general_data = general_data();
|
|
general_output($rows,$general_data) if @$general_data;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub general_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$general_data) = @_;
|
|
my ($size);
|
|
my ($j,$num) = (0,0);
|
|
# cryptsetup status luks-a00baac5-44ff-4b48-b303-3bedb1f623ce
|
|
foreach my $item (sort {$a->{'type'} cmp $b->{'type'}} @$general_data){
|
|
$j = scalar @$rows;
|
|
$size = ($item->{'size'}) ? main::get_size($item->{'size'}, 'string') : 'N/A';
|
|
push(@$rows,{
|
|
main::key($num++,1,1,'Device') => $item->{'name'},
|
|
});
|
|
if ($b_admin){
|
|
$item->{'name'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'maj-min')} = $item->{'maj-min'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'type')} = $item->{'type'};
|
|
if ($extra > 0 && $item->{'dm'}){
|
|
$rows->[$j]{main::key($num++,0,2,'dm')} = $item->{'dm'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'size')} = $size;
|
|
my $b_fake;
|
|
components_output('general',\$j,\$num,$rows,\@{$item->{'components'}},\$b_fake);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub lvm_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$lvm_data) = @_;
|
|
my ($size);
|
|
my ($j,$num) = (0,0);
|
|
foreach my $vg (sort keys %$lvm_data){
|
|
$j = scalar @$rows;
|
|
# print Data::Dumper::Dumper $lvm_data->{$vg};
|
|
$size = main::get_size($lvm_data->{$vg}{'vg-size'},'string','N/A');
|
|
push(@$rows,{
|
|
main::key($num++,1,1,'Device') => '',
|
|
main::key($num++,0,2,'VG') => $vg,
|
|
main::key($num++,0,2,'type') => uc($lvm_data->{$vg}{'vg-format'}),
|
|
main::key($num++,0,2,'size') => $size,
|
|
},);
|
|
$size = main::get_size($lvm_data->{$vg}{'vg-free'},'string','N/A');
|
|
$rows->[$j]{main::key($num++,0,2,'free')} = $size;
|
|
foreach my $lv (sort keys %{$lvm_data->{$vg}{'lvs'}}){
|
|
next if $extra < 2 && $lv =~ /^\[/; # it's an internal vg lv, raid meta/image
|
|
$j = scalar @$rows;
|
|
my $b_raid;
|
|
$size = main::get_size($lvm_data->{$vg}{'lvs'}{$lv}{'lv-size'},'string','N/A');
|
|
$rows->[$j]{main::key($num++,1,2,'LV')} = $lv;
|
|
if ($b_admin && $lvm_data->{$vg}{'lvs'}{$lv}{'maj-min'}){
|
|
$rows->[$j]{main::key($num++,0,3,'maj-min')} = $lvm_data->{$vg}{'lvs'}{$lv}{'maj-min'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,3,'type')} = $lvm_data->{$vg}{'lvs'}{$lv}{'lv-type'};
|
|
if ($extra > 0 && $lvm_data->{$vg}{'lvs'}{$lv}{'dm'}){
|
|
$rows->[$j]{main::key($num++,0,3,'dm')} = $lvm_data->{$vg}{'lvs'}{$lv}{'dm'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,3,'size')} = $size;
|
|
if ($extra > 1 && !($show{'raid'} || $show{'raid-basic'}) && $lvm_data->{$vg}{'lvs'}{$lv}{'raid'}){
|
|
$j = scalar @$rows;
|
|
$rows->[$j]{main::key($num++,1,3,'RAID')} = '';
|
|
$rows->[$j]{main::key($num++,0,4,'stripes')} = $lvm_data->{$vg}{'lvs'}{$lv}{'raid'}{'stripes'};
|
|
$rows->[$j]{main::key($num++,0,4,'sync')} = $lvm_data->{$vg}{'lvs'}{$lv}{'raid'}{'sync'};
|
|
my $copied = $lvm_data->{$vg}{'lvs'}{$lv}{'raid'}{'copied'};
|
|
$copied = (defined $copied) ? ($copied + 0) . '%': 'N/A';
|
|
$rows->[$j]{main::key($num++,0,4,'copied')} = $copied;
|
|
$rows->[$j]{main::key($num++,0,4,'mismatches')} = $lvm_data->{$vg}{'lvs'}{$lv}{'raid'}{'mismatches'};
|
|
$b_raid = 1;
|
|
}
|
|
components_output('lvm',\$j,\$num,$rows,\@{$lvm_data->{$vg}{'lvs'}{$lv}{'components'}},\$b_raid);
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub components_output {
|
|
my ($type,$j,$num,$rows,$components,$b_raid) = @_;
|
|
my ($l1);
|
|
$$j = scalar @$rows if $$b_raid || $extra > 1;
|
|
$$b_raid = 0;
|
|
if ($type eq 'general'){
|
|
($l1) = (2);
|
|
}
|
|
elsif ($type eq 'lvm'){
|
|
($l1) = (3);
|
|
}
|
|
my $status = (!@$components) ? 'N/A': '';
|
|
$rows->[$$j]{main::key($$num++,1,$l1,'Components')} = $status;
|
|
components_recursive_output($type,$j,$num,$rows,$components,0,'c','p');
|
|
}
|
|
|
|
sub components_recursive_output {
|
|
my ($type,$j,$num,$rows,$components,$indent,$c,$p) = @_;
|
|
my ($l,$m,$size) = (1,1,0);
|
|
my ($l2,$l3);
|
|
if ($type eq 'general'){
|
|
($l2,$l3) = (3+$indent,4+$indent) ;
|
|
}
|
|
elsif ($type eq 'lvm'){
|
|
($l2,$l3) = (4+$indent,5+$indent);
|
|
}
|
|
# print 'outside: ', scalar @$component, "\n", Data::Dumper::Dumper $component;
|
|
foreach my $component (@$components){
|
|
# print "inside: -n", Data::Dumper::Dumper $component->[$i];
|
|
$$j = scalar @$rows if $b_admin;
|
|
my $id;
|
|
if ($component->[0] =~ /^(bcache|dm-|md)[0-9]/){
|
|
$id = $c .'-' . $m;
|
|
$m++;
|
|
}
|
|
else {
|
|
$id = $p . '-' . $l;
|
|
$l++;
|
|
}
|
|
$rows->[$$j]{main::key($$num++,1,$l2,$id)} = $component->[0];
|
|
if ($extra > 1){
|
|
if ($b_admin){
|
|
$component->[1] ||= 'N/A';
|
|
$rows->[$$j]{main::key($$num++,0,$l3,'maj-min')} = $component->[1];
|
|
$rows->[$$j]{main::key($$num++,0,$l3,'mapped')} = $component->[3] if $component->[3];
|
|
$size = main::get_size($component->[2],'string','N/A');
|
|
$rows->[$$j]{main::key($$num++,0,$l3,'size')} = $size;
|
|
}
|
|
#next if !$component->[$i][4];
|
|
for (my $i = 4; $i < scalar @$component; $i++){
|
|
components_recursive_output($type,$j,$num,$rows,$component->[$i],$indent+1,$c.'c',$p.'p');
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Note: type dm is seen in only one dataset, but it's a start
|
|
sub general_data {
|
|
eval $start if $b_log;
|
|
my (@found,$parent,$parent_fs);
|
|
my $general_data = [];
|
|
PartitionData::set('proc') if !$loaded{'partition-data'};
|
|
main::set_mapper() if !$loaded{'mapper'};
|
|
foreach my $row (@lsblk){
|
|
# bcache doesn't have mapped name: !$mapper{$row->{'name'}} ||
|
|
next if !$row->{'parent'};
|
|
$parent = LsblkData::get($row->{'parent'});
|
|
next if !$parent->{'fs'};
|
|
if ($row->{'type'} && (($row->{'type'} eq 'crypt' ||
|
|
$row->{'type'} eq 'mpath' || $row->{'type'} eq 'multipath') ||
|
|
($row->{'type'} eq 'dm' && $row->{'name'} =~ /veracrypt/i) ||
|
|
($parent->{'fs'} eq 'bcache'))){
|
|
my (@full_components,$mapped,$type);
|
|
$mapped = $mapper{$row->{'name'}} if %mapper;
|
|
next if grep(/^$row->{'name'}$/, @found);
|
|
push(@found,$row->{'name'});
|
|
if ($parent->{'fs'} eq 'crypto_LUKS'){
|
|
$type = 'LUKS';
|
|
}
|
|
# note, testing name is random user string, and there is no other
|
|
# ID known, the parent FS is '', empty.
|
|
elsif ($row->{'type'} eq 'dm' && $row->{'name'} =~ /veracrypt/i){
|
|
$type = 'VeraCrypt';
|
|
}
|
|
elsif ($row->{'type'} eq 'crypt'){
|
|
$type = 'Crypto';
|
|
}
|
|
elsif ($parent->{'fs'} eq 'bcache'){
|
|
$type = 'bcache';
|
|
}
|
|
# probably only seen on older Redhat servers, LVM probably replaces
|
|
elsif ($row->{'type'} eq 'mpath' || $row->{'type'} eq 'multipath'){
|
|
$type = 'MultiPath';
|
|
}
|
|
elsif ($row->{'type'} eq 'crypt'){
|
|
$type = 'Crypt';
|
|
}
|
|
# my $name = ($use{'filter-uuid'}) ? "luks-$filter_string" : $row->{'name'};
|
|
component_data($row->{'maj-min'},\@full_components);
|
|
# print "$row->{'name'}\n", Data::Dumper::Dumper \@full_components;
|
|
push(@$general_data, {
|
|
'components' => \@full_components,
|
|
'dm' => $mapped,
|
|
'maj-min' => $row->{'maj-min'},
|
|
'name' => $row->{'name'},
|
|
'size' => $row->{'size'},
|
|
'type' => $type,
|
|
});
|
|
}
|
|
}
|
|
main::log_data('dump','luks @$general_data', $general_data);
|
|
print Data::Dumper::Dumper $general_data if $dbg[23];
|
|
eval $end if $b_log;
|
|
return $general_data;
|
|
}
|
|
|
|
# Note: called for disk totals, raid, and logical
|
|
sub lvm_data {
|
|
eval $start if $b_log;
|
|
$loaded{'logical-data'} = 1;
|
|
my (@args,@data,%totals);
|
|
@args = qw(vg_name vg_fmt vg_size vg_free lv_name lv_layout lv_size
|
|
lv_kernel_major lv_kernel_minor segtype seg_count seg_start_pe seg_size_pe
|
|
stripes devices raid_mismatch_count raid_sync_action raid_write_behind
|
|
copy_percent);
|
|
my $num = 0;
|
|
PartitionData::set() if !$loaded{'partition-data'};
|
|
main::set_mapper() if !$loaded{'mapper'};
|
|
if ($fake{'logical'}){
|
|
# my $file = "$fake_data_dir/raid-logical/lvm/lvs-test-1.txt";
|
|
# @data = main::reader($file,'strip');
|
|
}
|
|
else {
|
|
# lv_full_name: ar0-home; lv_dm_path: /dev/mapper/ar0-home
|
|
# seg_size: unit location on volume where segement starts
|
|
# 2>/dev/null -unit k ---separator ^:
|
|
my $cmd = $alerts{'lvs'}->{'path'};
|
|
$cmd .= ' -aPv --unit k --separator "^:" --segments --noheadings -o ';
|
|
# $cmd .= ' -o +lv_size,pv_major,pv_minor 2>/dev/null';
|
|
$cmd .= join(',', @args);
|
|
$cmd .= ' 2>/dev/null';
|
|
@data = main::grabber("$cmd",'','strip');
|
|
main::log_data('dump','lvm @data', \@data) if $b_log;
|
|
print "command: $cmd\n" if $dbg[22];
|
|
}
|
|
my $j = 0;
|
|
foreach (@data){
|
|
my @line = split(/\^:/, $_);
|
|
next if $_ =~ /^Partial mode/i; # sometimes 2>/dev/null doesn't catch this
|
|
for (my $i = 0; $i < scalar @args; $i++){
|
|
$line[$i] =~ s/k$// if $args[$i] =~ /_(free|size|used)$/;
|
|
$lvm[$j]->{$args[$i]} = $line[$i];
|
|
}
|
|
if (!$totals{'vgs'}->{$lvm[$j]->{'vg_name'}}){
|
|
$totals{'vgs'}->{$lvm[$j]->{'vg_name'}} = $lvm[$j]->{'vg_size'};
|
|
$raw_logical[2] += $lvm[$j]->{'vg_free'} if $lvm[$j]->{'vg_free'};
|
|
}
|
|
$j++;
|
|
}
|
|
# print Data::Dumper::Dumper \%totals, \@raw_logical;
|
|
main::log_data('dump','lvm @lvm', \@lvm) if $b_log;
|
|
print Data::Dumper::Dumper \@lvm if $dbg[22];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub process_lvm_data {
|
|
eval $start if $b_log;
|
|
my $processed = {};
|
|
foreach my $item (@lvm){
|
|
my (@components,@devices,$dm,$dm_tmp,$dm_mm,@full_components,$maj_min,%raid,@temp);
|
|
if (!$processed->{$item->{'vg_name'}}){
|
|
$processed->{$item->{'vg_name'}}->{'vg-size'} = $item->{'vg_size'};
|
|
$processed->{$item->{'vg_name'}}->{'vg-free'} = $item->{'vg_free'};
|
|
$processed->{$item->{'vg_name'}}->{'vg-format'} = $item->{'vg_fmt'};
|
|
}
|
|
if (!$processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}){
|
|
$processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}{'lv-size'} = $item->{'lv_size'};
|
|
$processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}{'lv-type'} = $item->{'segtype'};
|
|
$maj_min = $item->{'lv_kernel_major'} . ':' . $item->{'lv_kernel_minor'};
|
|
$processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}{'maj-min'} = $maj_min;
|
|
$dm_tmp = $item->{'vg_name'} . '-' . $item->{'lv_name'};
|
|
$dm_tmp =~ s/\[|\]$//g;
|
|
$dm = $mapper{$dm_tmp} if %mapper;
|
|
$processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}{'dm'} = $dm;
|
|
if ($item->{'segtype'} && $item->{'segtype'} ne 'linear' && $item->{'segtype'} =~ /^raid/){
|
|
$raid{'copied'} = $item->{'copy_percent'};
|
|
$raid{'mismatches'} = $item->{'raid_mismatch_count'};
|
|
$raid{'stripes'} = $item->{'stripes'};
|
|
$raid{'sync'} = $item->{'raid_sync_action'};
|
|
$raid{'type'} = $item->{'segtype'};
|
|
$processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}{'raid'} = \%raid;
|
|
}
|
|
component_data($maj_min,\@full_components);
|
|
# print "$item->{'lv_name'}\n", Data::Dumper::Dumper \@full_components;
|
|
$processed->{$item->{'vg_name'}}->{'lvs'}{$item->{'lv_name'}}{'components'} = \@full_components;
|
|
}
|
|
}
|
|
main::log_data('dump','lvm %$processed', $processed) if $b_log;
|
|
print Data::Dumper::Dumper $processed if $dbg[23];
|
|
eval $end if $b_log;
|
|
return $processed;
|
|
}
|
|
|
|
sub component_data {
|
|
my ($maj_min,$full_components) = @_;
|
|
push(@$full_components, component_recursive_data($maj_min));
|
|
}
|
|
|
|
sub component_recursive_data {
|
|
eval $start if $b_log;
|
|
my ($maj_min) = @_;
|
|
my (@components,@devices);
|
|
@devices = main::globber("/sys/dev/block/$maj_min/slaves/*") if -e "/sys/dev/block/$maj_min/slaves";
|
|
@devices = map {$_ =~ s|^/.*/||; $_;} @devices if @devices;
|
|
# return @devices if !$b_admin;
|
|
foreach my $device (@devices){
|
|
my ($mapped,$mm2,$part);
|
|
$part = PartitionData::get($device) if @proc_partitions;
|
|
$mm2 = $part->[0] . ':' . $part->[1] if @$part;
|
|
if ($device =~ /^(bcache|dm-|md)[0-9]+$/){
|
|
$mapped = $dmmapper{$device};
|
|
$raw_logical[1] += $part->[2] if $mapped && $mapped =~ /_(cdata|cmeta)$/;
|
|
push(@components, [$device,$mm2,$part->[2],$mapped,[component_recursive_data($mm2)]]);
|
|
}
|
|
else {
|
|
push(@components,[$device,$mm2,$part->[2]]);
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @components;
|
|
}
|
|
}
|
|
|
|
## MachineItem
|
|
# Public: get(), is_vm()
|
|
{
|
|
my $b_vm;
|
|
package MachineItem;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (%soc_machine,$data,@rows,$key1,$val1,$which);
|
|
my $rows = [];
|
|
my $num = 0;
|
|
if ($bsd_type && $sysctl{'machine'} && !$force{'dmidecode'}){
|
|
$data = machine_data_sysctl();
|
|
if (%$data){
|
|
machine_output($rows,$data);
|
|
}
|
|
elsif (!$key1){
|
|
$key1 = 'Message';
|
|
$val1 = main::message('machine-data-force-dmidecode','');
|
|
}
|
|
}
|
|
elsif ($bsd_type || $force{'dmidecode'}){
|
|
if (!$fake{'dmidecode'} && $alerts{'dmidecode'}->{'action'} ne 'use'){
|
|
$key1 = $alerts{'dmidecode'}->{'action'};
|
|
$val1 = $alerts{'dmidecode'}->{'message'};
|
|
$key1 = ucfirst($key1);
|
|
}
|
|
else {
|
|
$data = machine_data_dmi();
|
|
if (%$data){
|
|
machine_output($rows,$data);
|
|
}
|
|
elsif (!$key1){
|
|
$key1 = 'Message';
|
|
$val1 = main::message('machine-data');
|
|
}
|
|
}
|
|
}
|
|
elsif (-d '/sys/class/dmi/id/'){
|
|
$data = machine_data_sys();
|
|
if (%$data){
|
|
machine_output($rows,$data);
|
|
}
|
|
else {
|
|
$key1 = 'Message';
|
|
if ($alerts{'dmidecode'}->{'action'} eq 'missing'){
|
|
$val1 = main::message('machine-data-dmidecode');
|
|
}
|
|
else {
|
|
$val1 = main::message('machine-data');
|
|
}
|
|
}
|
|
}
|
|
elsif ($fake{'elbrus'} || $cpu_arch eq 'elbrus'){
|
|
if ($fake{'elbrus'} || (my $program = main::check_program('fruid_print'))){
|
|
$data = machine_data_fruid($program);
|
|
if (%$data){
|
|
machine_output($rows,$data);
|
|
}
|
|
elsif (!$key1){
|
|
$key1 = 'Message';
|
|
$val1 = main::message('machine-data-fruid');
|
|
}
|
|
}
|
|
}
|
|
elsif (!$bsd_type){
|
|
# this uses /proc/cpuinfo so only GNU/Linux
|
|
if (%risc){
|
|
$data = machine_data_soc();
|
|
machine_soc_output($rows,$data) if %$data;
|
|
}
|
|
if (!$data || !%$data){
|
|
$key1 = 'Message';
|
|
$val1 = main::message('machine-data-force-dmidecode','');
|
|
}
|
|
}
|
|
# if error case, null data, whatever
|
|
if ($key1){
|
|
push(@$rows,{main::key($num++,0,1,$key1) => $val1,});
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub is_vm {
|
|
return $b_vm;
|
|
}
|
|
|
|
## keys for machine data are:
|
|
# 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;
|
|
## 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
|
|
sub machine_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$data) = @_;
|
|
my $firmware = 'BIOS';
|
|
my $num = 0;
|
|
my $j = 0;
|
|
my ($b_chassis,$b_skip_chassis,$b_skip_system);
|
|
my ($bios_date,$bios_rev,$bios_romsize,$bios_vendor,$bios_version,$chassis_serial,
|
|
$chassis_type,$chassis_vendor,$chassis_version,$mobo_model,$mobo_serial,$mobo_vendor,
|
|
$mobo_version,$product_name,$product_serial,$product_version,$system_vendor);
|
|
# foreach my $key (keys %data){
|
|
# print "$key: $data->{$key}\n";
|
|
# }
|
|
if (!$data->{'sys_vendor'} ||
|
|
($data->{'board_vendor'} && $data->{'sys_vendor'} eq $data->{'board_vendor'} &&
|
|
!$data->{'product_name'} && !$data->{'product_version'} &&
|
|
!$data->{'product_serial'})){
|
|
$b_skip_system = 1;
|
|
}
|
|
# The goal here is to not show laptop/mobile devices
|
|
# found a case of battery existing but having nothing in it on desktop mobo
|
|
# not all laptops show the first. /proc/acpi/battery is deprecated.
|
|
elsif (!glob('/proc/acpi/battery/*') && !glob('/sys/class/power_supply/*')){
|
|
# ibm / ibm can be true; dell / quantum is false, so in other words, only do this
|
|
# in case where the vendor is the same and the version is the same and not null,
|
|
# otherwise the version information is going to be different in all cases I think
|
|
if (($data->{'sys_vendor'} && $data->{'board_vendor'} &&
|
|
$data->{'sys_vendor'} eq $data->{'board_vendor'}) &&
|
|
(($data->{'product_version'} && $data->{'board_version'} &&
|
|
$data->{'product_version'} eq $data->{'board_version'}) ||
|
|
(!$data->{'product_version'} && $data->{'product_name'} && $data->{'board_name'} &&
|
|
$data->{'product_name'} eq $data->{'board_name'}))){
|
|
$b_skip_system = 1;
|
|
}
|
|
}
|
|
$data->{'device'} ||= 'N/A';
|
|
$j = scalar @$rows;
|
|
push(@$rows, {
|
|
main::key($num++,0,1,'Type') => ucfirst($data->{'device'}),
|
|
},);
|
|
if (!$b_skip_system){
|
|
# this has already been tested for above so we know it's not null
|
|
$system_vendor = main::clean($data->{'sys_vendor'});
|
|
$product_name = ($data->{'product_name'}) ? $data->{'product_name'}:'N/A';
|
|
$product_version = ($data->{'product_version'}) ? $data->{'product_version'}:'N/A';
|
|
$product_serial = main::filter($data->{'product_serial'});
|
|
$rows->[$j]{main::key($num++,1,1,'System')} = $system_vendor;
|
|
$rows->[$j]{main::key($num++,1,2,'product')} = $product_name;
|
|
$rows->[$j]{main::key($num++,0,3,'v')} = $product_version;
|
|
$rows->[$j]{main::key($num++,0,3,'serial')} = $product_serial;
|
|
# no point in showing chassis if system isn't there, it's very unlikely that
|
|
# would be correct
|
|
if ($extra > 1){
|
|
if ($data->{'board_version'} && $data->{'chassis_version'} &&
|
|
$data->{'chassis_version'} eq $data->{'board_version'}){
|
|
$b_skip_chassis = 1;
|
|
}
|
|
if (!$b_skip_chassis && $data->{'chassis_vendor'}){
|
|
if ($data->{'chassis_vendor'} ne $data->{'sys_vendor'}){
|
|
$chassis_vendor = $data->{'chassis_vendor'};
|
|
}
|
|
# dmidecode can have these be the same
|
|
if ($data->{'chassis_type'} && $data->{'device'} ne $data->{'chassis_type'}){
|
|
$chassis_type = $data->{'chassis_type'};
|
|
}
|
|
if ($data->{'chassis_version'}){
|
|
$chassis_version = $data->{'chassis_version'};
|
|
$chassis_version =~ s/^v([0-9])/$1/i;
|
|
}
|
|
$chassis_serial = main::filter($data->{'chassis_serial'});
|
|
$chassis_vendor ||= '';
|
|
$chassis_type ||= '';
|
|
$rows->[$j]{main::key($num++,1,1,'Chassis')} = $chassis_vendor;
|
|
if ($chassis_type){
|
|
$rows->[$j]{main::key($num++,0,2,'type')} = $chassis_type;
|
|
}
|
|
if ($chassis_version){
|
|
$rows->[$j]{main::key($num++,0,2,'v')} = $chassis_version;
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'serial')} = $chassis_serial;
|
|
}
|
|
}
|
|
$j++; # start new row
|
|
}
|
|
if ($data->{'firmware'}){
|
|
$firmware = $data->{'firmware'};
|
|
}
|
|
$mobo_vendor = ($data->{'board_vendor'}) ? main::clean($data->{'board_vendor'}) : 'N/A';
|
|
$mobo_model = ($data->{'board_name'}) ? $data->{'board_name'}: 'N/A';
|
|
$mobo_version = ($data->{'board_version'})? $data->{'board_version'} : '';
|
|
$mobo_serial = main::filter($data->{'board_serial'});
|
|
$bios_vendor = ($data->{'bios_vendor'}) ? main::clean($data->{'bios_vendor'}) : 'N/A';
|
|
if ($data->{'bios_version'}){
|
|
$bios_version = $data->{'bios_version'};
|
|
$bios_version =~ s/^v([0-9])/$1/i;
|
|
if ($data->{'bios_rev'}){
|
|
$bios_rev = $data->{'bios_rev'};
|
|
}
|
|
}
|
|
$bios_version ||= 'N/A';
|
|
if ($data->{'bios_date'}){
|
|
$bios_date = $data->{'bios_date'};
|
|
}
|
|
$bios_date ||= 'N/A';
|
|
if ($extra > 1 && $data->{'bios_romsize'}){
|
|
$bios_romsize = $data->{'bios_romsize'};
|
|
}
|
|
$rows->[$j]{main::key($num++,1,1,'Mobo')} = $mobo_vendor;
|
|
$rows->[$j]{main::key($num++,1,2,'model')} = $mobo_model;
|
|
if ($mobo_version){
|
|
$rows->[$j]{main::key($num++,0,3,'v')} = $mobo_version;
|
|
}
|
|
$rows->[$j]{main::key($num++,0,3,'serial')} = $mobo_serial;
|
|
if ($extra > 2 && $data->{'board_uuid'}){
|
|
$rows->[$j]{main::key($num++,0,3,'uuid')} = $data->{'board_uuid'};
|
|
}
|
|
if ($extra > 1 && $data->{'board_mfg_date'}){
|
|
$rows->[$j]{main::key($num++,0,3,'mfg-date')} = $data->{'board_mfg_date'};
|
|
}
|
|
$rows->[$j]{main::key($num++,1,1,$firmware)} = $bios_vendor;
|
|
$rows->[$j]{main::key($num++,0,2,'v')} = $bios_version;
|
|
if ($bios_rev){
|
|
$rows->[$j]{main::key($num++,0,2,'rev')} = $bios_rev;
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'date')} = $bios_date;
|
|
if ($bios_romsize){
|
|
$rows->[$j]{main::key($num++,0,2,'rom size')} = $bios_romsize;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub machine_soc_output {
|
|
my ($rows,$soc_machine) = @_;
|
|
my ($key);
|
|
my ($cont_sys,$ind_sys,$j,$num) = (1,1,0,0);
|
|
# print Data::Dumper::Dumper \%soc_machine;
|
|
# this is sketchy, /proc/device-tree/model may be similar to Hardware value from /proc/cpuinfo
|
|
# raspi: Hardware : BCM2835 model: Raspberry Pi Model B Rev 2
|
|
if ($soc_machine->{'device'} || $soc_machine->{'model'}){
|
|
$rows->[$j]{main::key($num++,0,1,'Type')} = uc($risc{'id'});
|
|
my $system = 'System';
|
|
if (defined $soc_machine->{'model'}){
|
|
$rows->[$j]{main::key($num++,1,1,'System')} = $soc_machine->{'model'};
|
|
$system = 'details';
|
|
($cont_sys,$ind_sys) = (0,2);
|
|
}
|
|
$soc_machine->{'device'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,$cont_sys,$ind_sys,$system)} = $soc_machine->{'device'};
|
|
}
|
|
if ($soc_machine->{'mobo'}){
|
|
$rows->[$j]{main::key($num++,1,1,'mobo')} = $soc_machine->{'mobo'};
|
|
}
|
|
# we're going to print N/A for 0000 values sine the item was there.
|
|
if ($soc_machine->{'firmware'}){
|
|
# most samples I've seen are like: 0000
|
|
$soc_machine->{'firmware'} =~ s/^[0]+$//;
|
|
$soc_machine->{'firmware'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'rev')} = $soc_machine->{'firmware'};
|
|
}
|
|
# sometimes has value like: 0000
|
|
if (defined $soc_machine->{'serial'}){
|
|
# most samples I've seen are like: 0000
|
|
$soc_machine->{'serial'} =~ s/^[0]+$//;
|
|
$rows->[$j]{main::key($num++,0,2,'serial')} = main::filter($soc_machine->{'serial'});
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub machine_data_fruid {
|
|
eval $start if $b_log;
|
|
my ($program) = @_;
|
|
my ($b_start,@fruid);
|
|
my $data = {};
|
|
if (!$fake{'elbrus'}){
|
|
@fruid = main::grabber("$program 2>/dev/null",'','strip');
|
|
}
|
|
else {
|
|
# my $file;
|
|
# $file = "$fake_data_dir/machine/fruid/fruid-e904-1_full.txt";
|
|
# $file = "$fake_data_dir/machine/fruid/fruid-e804-1_full.txt";
|
|
# @fruid = main::reader($file,'strip');
|
|
}
|
|
# print Data::Dumper::Dumper \@fruid;
|
|
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->{'board_part_nu'} = $split[1];
|
|
}
|
|
elsif ($split[0] eq 'Board product name'){
|
|
$data->{'board_name'} = $split[1];
|
|
}
|
|
elsif ($split[0] eq 'Board serial number'){
|
|
$data->{'board_serial'} = $split[1];
|
|
}
|
|
elsif ($split[0] eq 'Board product version'){
|
|
$data->{'board_version'} = $split[1];
|
|
}
|
|
}
|
|
print Data::Dumper::Dumper $data if $dbg[28];
|
|
main::log_data('dump','%data',$data) if $b_log;
|
|
return $data;
|
|
}
|
|
|
|
sub machine_data_sys {
|
|
eval $start if $b_log;
|
|
my ($path,$vm);
|
|
my $data = {};
|
|
my $sys_dir = '/sys/class/dmi/id/';
|
|
my $sys_dir_alt = '/sys/devices/virtual/dmi/id/';
|
|
my @sys_files = qw(bios_vendor bios_version bios_date
|
|
board_name board_serial board_vendor board_version chassis_type
|
|
product_name product_serial product_uuid product_version sys_vendor
|
|
);
|
|
if ($extra > 1){
|
|
splice(@sys_files, 0, 0, qw(chassis_serial chassis_vendor chassis_version));
|
|
}
|
|
$data->{'firmware'} = 'BIOS';
|
|
# print Data::Dumper::Dumper \@sys_files;
|
|
if (!-d $sys_dir){
|
|
if (-d $sys_dir_alt){
|
|
$sys_dir = $sys_dir_alt;
|
|
}
|
|
else {
|
|
return 0;
|
|
}
|
|
}
|
|
if (-d '/sys/firmware/efi'){
|
|
$data->{'firmware'} = 'UEFI';
|
|
}
|
|
elsif (glob('/sys/firmware/acpi/tables/UEFI*')){
|
|
$data->{'firmware'} = 'UEFI-[Legacy]';
|
|
}
|
|
foreach (@sys_files){
|
|
$path = "$sys_dir$_";
|
|
if (-r $path){
|
|
$data->{$_} = main::reader($path,'',0);
|
|
$data->{$_} = ($data->{$_}) ? main::clean_dmi($data->{$_}) : '';
|
|
}
|
|
elsif (!$b_root && -e $path && !-r $path){
|
|
$data->{$_} = main::message('root-required');
|
|
}
|
|
else {
|
|
$data->{$_} = '';
|
|
}
|
|
}
|
|
if ($data->{'chassis_type'}){
|
|
if ($data->{'chassis_type'} == 1){
|
|
$data->{'device'} = check_vm($data->{'sys_vendor'},$data->{'product_name'});
|
|
$data->{'device'} ||= 'other-vm?';
|
|
}
|
|
else {
|
|
$data->{'device'} = get_device_sys($data->{'chassis_type'});
|
|
}
|
|
}
|
|
# print "sys:\n";
|
|
# foreach (keys %data){
|
|
# print "$_: $data->{$_}\n";
|
|
# }
|
|
print Data::Dumper::Dumper $data if $dbg[28];
|
|
main::log_data('dump','%data',$data) if $b_log;
|
|
eval $end if $b_log;
|
|
return $data;
|
|
}
|
|
|
|
# This will create an alternate machine data source
|
|
# which will be used for alt ARM machine data in cases
|
|
# where no dmi data present, or by cpu data to guess at
|
|
# certain actions for arm only.
|
|
sub machine_data_soc {
|
|
eval $end if $b_log;
|
|
my $data = {};
|
|
if (my $file = $system_files{'proc-cpuinfo'}){
|
|
CpuItem::cpuinfo_data_grabber($file) if !$loaded{'cpuinfo'};
|
|
# grabber sets keys to lower case to avoid error here
|
|
if ($cpuinfo_machine{'hardware'} || $cpuinfo_machine{'machine'}){
|
|
$data->{'device'} = main::get_defined($cpuinfo_machine{'hardware'},
|
|
$cpuinfo_machine{'machine'});
|
|
$data->{'device'} = main::clean_arm($data->{'device'});
|
|
$data->{'device'} = main::clean_dmi($data->{'device'});
|
|
$data->{'device'} = main::clean($data->{'device'});
|
|
}
|
|
if (defined $cpuinfo_machine{'system type'} || $cpuinfo_machine{'model'}){
|
|
$data->{'model'} = main::get_defined($cpuinfo_machine{'system type'},
|
|
$cpuinfo_machine{'model'});
|
|
$data->{'model'} = main::clean_dmi($data->{'model'});
|
|
$data->{'model'} = main::clean($data->{'model'});
|
|
}
|
|
# seen with PowerMac PPC
|
|
if (defined $cpuinfo_machine{'motherboard'}){
|
|
$data->{'mobo'} = $cpuinfo_machine{'motherboard'};
|
|
}
|
|
if (defined $cpuinfo_machine{'revision'}){
|
|
$data->{'firmware'} = $cpuinfo_machine{'revision'};
|
|
}
|
|
if (defined $cpuinfo_machine{'serial'}){
|
|
$data->{'serial'} = $cpuinfo_machine{'serial'};
|
|
}
|
|
undef %cpuinfo_machine; # we're done with it, don't need it anymore
|
|
}
|
|
if (!$data->{'model'} && $b_android){
|
|
main::set_build_prop() if !$loaded{'build-prop'};
|
|
if ($build_prop{'product-manufacturer'} && $build_prop{'product-model'}){
|
|
my $brand = '';
|
|
if ($build_prop{'product-brand'} &&
|
|
$build_prop{'product-brand'} ne $build_prop{'product-manufacturer'}){
|
|
$brand = $build_prop{'product-brand'} . ' ';
|
|
}
|
|
$data->{'model'} = $brand . $build_prop{'product-manufacturer'} . ' ' . $build_prop{'product-model'};
|
|
}
|
|
elsif ($build_prop{'product-device'}){
|
|
$data->{'model'} = $build_prop{'product-device'};
|
|
}
|
|
elsif ($build_prop{'product-name'}){
|
|
$data->{'model'} = $build_prop{'product-name'};
|
|
}
|
|
}
|
|
if (!$data->{'model'} && -r '/proc/device-tree/model'){
|
|
my $model = main::reader('/proc/device-tree/model','',0);
|
|
main::log_data('data',"device-tree-model: $model") if $b_log;
|
|
if ($model){
|
|
$model = main::clean_dmi($model);
|
|
$model = (split(/\x01|\x02|\x03|\x00/, $model))[0] if $model;
|
|
my $device_temp = main::clean_regex($data->{'device'});
|
|
if (!$data->{'device'} || ($model && $model !~ /\Q$device_temp\E/i)){
|
|
$model = main::clean_arm($model);
|
|
$data->{'model'} = $model;
|
|
}
|
|
}
|
|
}
|
|
if (!$data->{'serial'} && -f '/proc/device-tree/serial-number'){
|
|
my $serial = main::reader('/proc/device-tree/serial-number','',0);
|
|
$serial = (split(/\x01|\x02|\x03|\x00/, $serial))[0] if $serial;
|
|
main::log_data('data',"device-tree-serial: $serial") if $b_log;
|
|
$data->{'serial'} = $serial if $serial;
|
|
}
|
|
print Data::Dumper::Dumper $data if $dbg[28];
|
|
main::log_data('dump','%data',$data) if $b_log;
|
|
eval $end if $b_log;
|
|
return $data;
|
|
}
|
|
|
|
# bios_date: 09/07/2010
|
|
# bios_romsize: dmi only
|
|
# bios_vendor: American Megatrends Inc.
|
|
# bios_version: P1.70
|
|
# bios_rev: 8.14: dmi only
|
|
# board_name: A770DE+
|
|
# board_serial:
|
|
# board_vendor: ASRock
|
|
# board_version:
|
|
# chassis_serial:
|
|
# chassis_type: 3
|
|
# chassis_vendor:
|
|
# chassis_version:
|
|
# firmware:
|
|
# product_name:
|
|
# product_serial:
|
|
# product_uuid:
|
|
# product_version:
|
|
# sys_uuid: dmi/sysctl only
|
|
# sys_vendor:
|
|
sub machine_data_dmi {
|
|
eval $start if $b_log;
|
|
return if !@dmi;
|
|
my ($vm);
|
|
my $data = {};
|
|
$data->{'firmware'} = 'BIOS';
|
|
# dmi types:
|
|
# 0 bios; 1 system info; 2 board|base board info; 3 chassis info;
|
|
# 4 processor info, use to check for hypervisor
|
|
foreach my $row (@dmi){
|
|
# bios/firmware
|
|
if ($row->[0] == 0){
|
|
# skip first three row, we don't need that data
|
|
foreach my $item (@$row[3 .. $#$row]){
|
|
if ($item !~ /^~/){ # skip the indented rows
|
|
my @value = split(/:\s+/, $item);
|
|
if ($value[0] eq 'Release Date'){
|
|
$data->{'bios_date'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'Vendor'){
|
|
$data->{'bios_vendor'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'Version'){
|
|
$data->{'bios_version'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'ROM Size'){
|
|
$data->{'bios_romsize'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'BIOS Revision'){
|
|
$data->{'bios_rev'} = main::clean_dmi($value[1]) }
|
|
}
|
|
else {
|
|
if ($item eq '~UEFI is supported'){
|
|
$data->{'firmware'} = 'UEFI';}
|
|
}
|
|
}
|
|
next;
|
|
}
|
|
# system information
|
|
elsif ($row->[0] == 1){
|
|
# skip first three row, we don't need that data
|
|
foreach my $item (@$row[3 .. $#$row]){
|
|
if ($item !~ /^~/){ # skip the indented rows
|
|
my @value = split(/:\s+/, $item);
|
|
if ($value[0] eq 'Product Name'){
|
|
$data->{'product_name'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'Version'){
|
|
$data->{'product_version'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'Serial Number'){
|
|
$data->{'product_serial'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'Manufacturer'){
|
|
$data->{'sys_vendor'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'UUID'){
|
|
$data->{'sys_uuid'} = main::clean_dmi($value[1]) }
|
|
}
|
|
}
|
|
next;
|
|
}
|
|
# baseboard information
|
|
elsif ($row->[0] == 2){
|
|
# skip first three row, we don't need that data
|
|
foreach my $item (@$row[3 .. $#$row]){
|
|
if ($item !~ /^~/){ # skip the indented rows
|
|
my @value = split(/:\s+/, $item);
|
|
if ($value[0] eq 'Product Name'){
|
|
$data->{'board_name'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'Serial Number'){
|
|
$data->{'board_serial'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'Manufacturer'){
|
|
$data->{'board_vendor'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'Version'){
|
|
$data->{'board_version'} = main::clean_dmi($value[1]) }
|
|
}
|
|
}
|
|
next;
|
|
}
|
|
# chassis information
|
|
elsif ($row->[0] == 3){
|
|
# skip first three row, we don't need that data
|
|
foreach my $item (@$row[3 .. $#$row]){
|
|
if ($item !~ /^~/){ # skip the indented rows
|
|
my @value = split(/:\s+/, $item);
|
|
if ($value[0] eq 'Serial Number'){
|
|
$data->{'chassis_serial'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'Type'){
|
|
$data->{'chassis_type'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'Manufacturer'){
|
|
$data->{'chassis_vendor'} = main::clean_dmi($value[1]) }
|
|
elsif ($value[0] eq 'Version'){
|
|
$data->{'chassis_version'} = main::clean_dmi($value[1]) }
|
|
}
|
|
}
|
|
if ($data->{'chassis_type'} && $data->{'chassis_type'} ne 'Other'){
|
|
$data->{'device'} = $data->{'chassis_type'};
|
|
}
|
|
next;
|
|
}
|
|
# this may catch some BSD and fringe Linux cases
|
|
# processor information: check for hypervisor
|
|
elsif ($row->[0] == 4){
|
|
# skip first three row, we don't need that data
|
|
if (!$data->{'device'}){
|
|
if (grep {/hypervisor/i} @$row){
|
|
$data->{'device'} = 'virtual-machine';
|
|
$b_vm = 1;
|
|
}
|
|
}
|
|
last;
|
|
}
|
|
elsif ($row->[0] > 4){
|
|
last;
|
|
}
|
|
}
|
|
if (!$data->{'device'}){
|
|
$data->{'device'} = check_vm($data->{'sys_vendor'},$data->{'product_name'});
|
|
$data->{'device'} ||= 'other-vm?';
|
|
}
|
|
# print "dmi:\n";
|
|
# foreach (keys %data){
|
|
# print "$_: $data->{$_}\n";
|
|
# }
|
|
print Data::Dumper::Dumper $data if $dbg[28];
|
|
main::log_data('dump','%data',$data) if $b_log;
|
|
eval $end if $b_log;
|
|
return $data;
|
|
}
|
|
|
|
# As far as I know, only OpenBSD supports this method.
|
|
# it uses hw. info from sysctl -a and bios info from dmesg.boot
|
|
sub machine_data_sysctl {
|
|
eval $start if $b_log;
|
|
my ($product,$vendor,$vm);
|
|
my $data = {};
|
|
# ^hw\.(vendor|product|version|serialno|uuid)
|
|
foreach (@{$sysctl{'machine'}}){
|
|
next if !$_;
|
|
my @item = split(':', $_);
|
|
next if !$item[1];
|
|
if ($item[0] eq 'hw.vendor' || $item[0] eq 'machdep.dmi.board-vendor'){
|
|
$data->{'board_vendor'} = main::clean_dmi($item[1]);
|
|
}
|
|
elsif ($item[0] eq 'hw.product' || $item[0] eq 'machdep.dmi.board-product'){
|
|
$data->{'board_name'} = main::clean_dmi($item[1]);
|
|
}
|
|
elsif ($item[0] eq 'hw.version' || $item[0] eq 'machdep.dmi.board-version'){
|
|
$data->{'board_version'} = main::clean_dmi($item[1]);
|
|
}
|
|
elsif ($item[0] eq 'hw.serialno' || $item[0] eq 'machdep.dmi.board-serial'){
|
|
$data->{'board_serial'} = main::clean_dmi($item[1]);
|
|
}
|
|
elsif ($item[0] eq 'hw.serial'){
|
|
$data->{'board_serial'} = main::clean_dmi($item[1]);
|
|
}
|
|
elsif ($item[0] eq 'hw.uuid'){
|
|
$data->{'board_uuid'} = main::clean_dmi($item[1]);
|
|
}
|
|
elsif ($item[0] eq 'machdep.dmi.system-vendor'){
|
|
$data->{'sys_vendor'} = main::clean_dmi($item[1]);
|
|
}
|
|
elsif ($item[0] eq 'machdep.dmi.system-product'){
|
|
$data->{'product_name'} = main::clean_dmi($item[1]);
|
|
}
|
|
elsif ($item[0] eq 'machdep.dmi.system-version'){
|
|
$data->{'product_version'} = main::clean_dmi($item[1]);
|
|
}
|
|
elsif ($item[0] eq 'machdep.dmi.system-serial'){
|
|
$data->{'product_serial'} = main::clean_dmi($item[1]);
|
|
}
|
|
elsif ($item[0] eq 'machdep.dmi.system-uuid'){
|
|
$data->{'sys_uuid'} = main::clean_dmi($item[1]);
|
|
}
|
|
# bios0:at mainbus0: AT/286+ BIOS, date 06/30/06, BIOS32 rev. 0 @ 0xf2030, SMBIOS rev. 2.4 @ 0xf0000 (47 entries)
|
|
# bios0:vendor Phoenix Technologies, LTD version "3.00" date 06/30/2006
|
|
elsif ($item[0] =~ /^bios[0-9]/){
|
|
if ($_ =~ /^^bios[0-9]:at\s.*?\srev\.\s([\S]+)\s@.*/){
|
|
$data->{'bios_rev'} = $1;
|
|
$data->{'firmware'} = 'BIOS' if $_ =~ /BIOS/;
|
|
}
|
|
elsif ($item[1] =~ /^vendor\s(.*?)\sversion\s(.*?)\sdate\s([\S]+)/){
|
|
$data->{'bios_vendor'} = $1;
|
|
$data->{'bios_version'} = $2;
|
|
$data->{'bios_date'} = $3;
|
|
$data->{'bios_version'} =~ s/^v//i if $data->{'bios_version'} && $data->{'bios_version'} !~ /vi/i;
|
|
}
|
|
}
|
|
elsif ($item[0] eq 'machdep.dmi.bios-vendor'){
|
|
$data->{'bios_vendor'} = main::clean_dmi($item[1]);
|
|
}
|
|
elsif ($item[0] eq 'machdep.dmi.bios-version'){
|
|
$data->{'bios_version'} = main::clean_dmi($item[1]);
|
|
}
|
|
elsif ($item[0] eq 'machdep.dmi.bios-date'){
|
|
$data->{'bios_date'} = main::clean_dmi($item[1]);
|
|
}
|
|
}
|
|
if ($data->{'board_vendor'} || $data->{'sys_vendor'} || $data->{'board_name'} || $data->{'product_name'}){
|
|
$vendor = $data->{'sys_vendor'};
|
|
$vendor = $data->{'board_vendor'} if !$vendor;
|
|
$product = $data->{'product_name'};
|
|
$product = $data->{'board_name'} if !$product;
|
|
}
|
|
# detections can be from other sources.
|
|
$data->{'device'} = check_vm($vendor,$product);
|
|
print Data::Dumper::Dumper $data if $dbg[28];
|
|
main::log_data('dump','%data',$data) if $b_log;
|
|
eval $end if $b_log;
|
|
return $data;
|
|
}
|
|
|
|
sub get_device_sys {
|
|
eval $start if $b_log;
|
|
my ($chasis_id) = @_;
|
|
my ($device) = ('');
|
|
my @chassis;
|
|
# See inxi-resources MACHINE DATA for data sources
|
|
$chassis[2] = 'unknown';
|
|
$chassis[3] = 'desktop';
|
|
$chassis[4] = 'desktop';
|
|
# 5 - pizza box was a 1 U desktop enclosure, but some old laptops also id this way
|
|
$chassis[5] = 'pizza-box';
|
|
$chassis[6] = 'desktop';
|
|
$chassis[7] = 'desktop';
|
|
$chassis[8] = 'portable';
|
|
$chassis[9] = 'laptop';
|
|
# note: lenovo T420 shows as 10, notebook, but it's not a notebook
|
|
$chassis[10] = 'laptop';
|
|
$chassis[11] = 'portable';
|
|
$chassis[12] = 'docking-station';
|
|
# note: 13 is all-in-one which we take as a mac type system
|
|
$chassis[13] = 'desktop';
|
|
$chassis[14] = 'notebook';
|
|
$chassis[15] = 'desktop';
|
|
$chassis[16] = 'laptop';
|
|
$chassis[17] = 'server';
|
|
$chassis[18] = 'expansion-chassis';
|
|
$chassis[19] = 'sub-chassis';
|
|
$chassis[20] = 'bus-expansion';
|
|
$chassis[21] = 'peripheral';
|
|
$chassis[22] = 'RAID';
|
|
$chassis[23] = 'server';
|
|
$chassis[24] = 'desktop';
|
|
$chassis[25] = 'multimount-chassis'; # blade?
|
|
$chassis[26] = 'compact-PCI';
|
|
$chassis[27] = 'blade';
|
|
$chassis[28] = 'blade';
|
|
$chassis[29] = 'blade-enclosure';
|
|
$chassis[30] = 'tablet';
|
|
$chassis[31] = 'convertible';
|
|
$chassis[32] = 'detachable';
|
|
$chassis[33] = 'IoT-gateway';
|
|
$chassis[34] = 'embedded-pc';
|
|
$chassis[35] = 'mini-pc';
|
|
$chassis[36] = 'stick-pc';
|
|
$device = $chassis[$chasis_id] if $chassis[$chasis_id];
|
|
eval $end if $b_log;
|
|
return $device;
|
|
}
|
|
|
|
sub check_vm {
|
|
eval $start if $b_log;
|
|
my ($manufacturer,$product_name) = @_;
|
|
$manufacturer ||= '';
|
|
$product_name ||= '';
|
|
my $vm;
|
|
if (my $program = main::check_program('systemd-detect-virt')){
|
|
my $vm_test = (main::grabber("$program 2>/dev/null"))[0];
|
|
if ($vm_test){
|
|
# kvm vbox reports as oracle, usually, unless they change it
|
|
if (lc($vm_test) eq 'oracle'){
|
|
$vm = 'virtualbox';
|
|
}
|
|
elsif ($vm_test ne 'none'){
|
|
$vm = $vm_test;
|
|
}
|
|
}
|
|
}
|
|
if (!$vm || lc($vm) eq 'bochs'){
|
|
if (-e '/proc/vz'){$vm = 'openvz'}
|
|
elsif (-e '/proc/xen'){$vm = 'xen'}
|
|
elsif (-e '/dev/vzfs'){$vm = 'virtuozzo'}
|
|
elsif (my $program = main::check_program('lsmod')){
|
|
my @vm_data = main::grabber("$program 2>/dev/null");
|
|
if (@vm_data){
|
|
if (grep {/kqemu/i} @vm_data){$vm = 'kqemu'}
|
|
elsif (grep {/kvm|qumranet/i} @vm_data){$vm = 'kvm'}
|
|
elsif (grep {/qemu/i} @vm_data){$vm = 'qemu'}
|
|
}
|
|
}
|
|
}
|
|
# this will catch many Linux systems and some BSDs
|
|
if (!$vm || lc($vm) eq 'bochs'){
|
|
# $device_vm is '' if nothing detected
|
|
my @vm_data = ($device_vm);
|
|
push(@vm_data,@{$dboot{'machine-vm'}}) if $dboot{'machine-vm'};
|
|
if (-e '/dev/disk/by-id'){
|
|
my @dev = glob('/dev/disk/by-id/*');
|
|
push(@vm_data,@dev);
|
|
}
|
|
if (grep {/innotek|vbox|virtualbox/i} @vm_data){
|
|
$vm = 'virtualbox';
|
|
}
|
|
elsif (grep {/vmware/i} @vm_data){
|
|
$vm = 'vmware';
|
|
}
|
|
# needs to be first, because contains virtio;qumranet, grabber only gets
|
|
# first instance then stops, so make sure patterns are right.
|
|
elsif (grep {/(openbsd[\s-]vmm)/i} @vm_data){
|
|
$vm = 'vmm';
|
|
}
|
|
elsif (grep {/(\bhvm\b)/i} @vm_data){
|
|
$vm = 'hvm';
|
|
}
|
|
elsif (grep {/(qemu)/i} @vm_data){
|
|
$vm = 'qemu';
|
|
}
|
|
elsif (grep {/(\bkvm\b|qumranet|virtio)/i} @vm_data){
|
|
$vm = 'kvm';
|
|
}
|
|
elsif (grep {/Virtual HD|Microsoft.*Virtual Machine/i} @vm_data){
|
|
$vm = 'hyper-v';
|
|
}
|
|
if (!$vm && (my $file = $system_files{'proc-cpuinfo'})){
|
|
my @info = main::reader($file);
|
|
$vm = 'virtual-machine' if grep {/^flags.*hypervisor/} @info;
|
|
}
|
|
# this may be wrong, confirm it
|
|
if (!$vm && -e '/dev/vda' || -e '/dev/vdb' || -e '/dev/xvda' || -e '/dev/xvdb'){
|
|
$vm = 'virtual-machine';
|
|
}
|
|
}
|
|
if (!$vm && $product_name){
|
|
if ($product_name eq 'VMware'){
|
|
$vm = 'vmware';
|
|
}
|
|
elsif ($product_name eq 'VirtualBox'){
|
|
$vm = 'virtualbox';
|
|
}
|
|
elsif ($product_name eq 'KVM'){
|
|
$vm = 'kvm';
|
|
}
|
|
elsif ($product_name eq 'Bochs'){
|
|
$vm = 'qemu';
|
|
}
|
|
}
|
|
if (!$vm && $manufacturer && $manufacturer eq 'Xen'){
|
|
$vm = 'xen';
|
|
}
|
|
$b_vm = 1 if $vm;
|
|
eval $end if $b_log;
|
|
return $vm;
|
|
}
|
|
}
|
|
|
|
## NetworkItem
|
|
{
|
|
package NetworkItem;
|
|
my ($b_ip_run,@ifs_found);
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my $rows = [];
|
|
my $num = 0;
|
|
if (%risc && !$use{'soc-network'} && !$use{'pci-tool'}){
|
|
# do nothing, but keep the test conditions to force
|
|
# the non arm case to always run
|
|
}
|
|
else {
|
|
device_output($rows);
|
|
}
|
|
# note: raspberry pi uses usb networking only
|
|
if (!@$rows){
|
|
if (%risc){
|
|
my $key = 'Message';
|
|
@$rows = ({
|
|
main::key($num++,0,1,$key) => main::message('risc-pci',$risc{'id'})
|
|
});
|
|
}
|
|
else {
|
|
my $key = 'Message';
|
|
my $message = '';
|
|
my $type = 'pci-card-data';
|
|
# for some reason, this was in device_output too redundantly
|
|
if ($pci_tool && $alerts{$pci_tool}->{'action'} eq 'permissions'){
|
|
$type = 'pci-card-data-root';
|
|
}
|
|
elsif (!$bsd_type && !%risc && !$pci_tool &&
|
|
$alerts{'lspci'}->{'action'} &&
|
|
$alerts{'lspci'}->{'action'} eq 'missing'){
|
|
$message = $alerts{'lspci'}->{'message'};
|
|
}
|
|
$message = main::message($type,'') if !$message;
|
|
@$rows = ({
|
|
main::key($num++,0,1,$key) => $message
|
|
});
|
|
}
|
|
}
|
|
usb_output($rows);
|
|
if ($show{'network-advanced'}){
|
|
# @ifs_found = ();
|
|
# shift @ifs_found;
|
|
# pop @ifs_found;
|
|
if (!$bsd_type){
|
|
advanced_data_sys($rows,'check','',0,'','','');
|
|
}
|
|
else {
|
|
advanced_data_bsd($rows,'check');
|
|
}
|
|
}
|
|
if ($show{'ip'}){
|
|
wan_ip($rows);
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub device_output {
|
|
eval $start if $b_log;
|
|
return if !$devices{'network'};
|
|
my $rows = $_[0];
|
|
my ($b_wifi,%holder);
|
|
my ($j,$num) = (0,1);
|
|
foreach my $row (@{$devices{'network'}}){
|
|
$num = 1;
|
|
# print "$row->[0] $row->[3]\n";
|
|
# print "$row->[0] $row->[3]\n";
|
|
$j = scalar @$rows;
|
|
my $driver = $row->[9];
|
|
my $chip_id = main::get_chip_id($row->[5],$row->[6]);
|
|
# working around a virtuo bug same chip id is used on two nics
|
|
if (!defined $holder{$chip_id}){
|
|
$holder{$chip_id} = 0;
|
|
}
|
|
else {
|
|
$holder{$chip_id}++;
|
|
}
|
|
# first check if it's a known wifi id'ed card, if so, no print of duplex/speed
|
|
$b_wifi = check_wifi($row->[4]);
|
|
my $device = $row->[4];
|
|
$device = ($device) ? main::clean_pci($device,'output') : 'N/A';
|
|
#$device ||= 'N/A';
|
|
$driver ||= 'N/A';
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $device,
|
|
},);
|
|
if ($extra > 0 && $use{'pci-tool'} && $row->[12]){
|
|
my $item = main::get_pci_vendor($row->[4],$row->[12]);
|
|
$rows->[$j]{main::key($num++,0,2,'vendor')} = $item if $item;
|
|
}
|
|
if ($row->[1] eq '0680'){
|
|
$rows->[$j]{main::key($num++,0,2,'type')} = 'network bridge';
|
|
}
|
|
$rows->[$j]{main::key($num++,1,2,'driver')} = $driver;
|
|
my $bus_id = 'N/A';
|
|
# note: for arm/mips we want to see the single item bus id, why not?
|
|
# note: we can have bus id: 0002 / 0 which is valid, but 0 / 0 is invalid
|
|
if (defined $row->[2] && $row->[2] ne '0' && defined $row->[3]){
|
|
$bus_id = "$row->[2].$row->[3]"}
|
|
elsif (defined $row->[2] && $row->[2] ne '0'){
|
|
$bus_id = $row->[2]}
|
|
elsif (defined $row->[3] && $row->[3] ne '0'){
|
|
$bus_id = $row->[3]}
|
|
if ($extra > 0){
|
|
if ($row->[9] && !$bsd_type){
|
|
my $version = main::get_module_version($row->[9]);
|
|
$version ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'v')} = $version;
|
|
}
|
|
if ($b_admin && $row->[10]){
|
|
$row->[10] = main::get_driver_modules($row->[9],$row->[10]);
|
|
$rows->[$j]{main::key($num++,0,3,'modules')} = $row->[10] if $row->[10];
|
|
}
|
|
$row->[8] ||= 'N/A';
|
|
if ($extra > 1 && $bus_id ne 'N/A'){
|
|
main::get_pcie_data($bus_id,$j,$rows,\$num);
|
|
}
|
|
# as far as I know, wifi has no port, but in case it does in future, use it
|
|
if (!$b_wifi || ($b_wifi && $row->[8] ne 'N/A')){
|
|
$rows->[$j]{main::key($num++,0,2,'port')} = $row->[8];
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'bus-ID')} = $bus_id;
|
|
}
|
|
if ($extra > 1){
|
|
$rows->[$j]{main::key($num++,0,2,'chip-ID')} = $chip_id;
|
|
}
|
|
if ($extra > 2 && $row->[1]){
|
|
$rows->[$j]{main::key($num++,0,2,'class-ID')} = $row->[1];
|
|
}
|
|
if (!$bsd_type && $extra > 0 && $bus_id ne 'N/A' && $bus_id =~ /\.0$/){
|
|
my $temp = main::get_device_temp($bus_id);
|
|
if ($temp){
|
|
$rows->[$j]{main::key($num++,0,2,'temp')} = $temp . ' C';
|
|
}
|
|
}
|
|
if ($show{'network-advanced'}){
|
|
my @data;
|
|
if (!$bsd_type){
|
|
advanced_data_sys($rows,$row->[5],$row->[6],$holder{$chip_id},$b_wifi,'',$bus_id);
|
|
}
|
|
else {
|
|
if (defined $row->[9] && defined $row->[11]){
|
|
advanced_data_bsd($rows,"$row->[9]$row->[11]",$b_wifi);
|
|
}
|
|
}
|
|
}
|
|
# print "$row->[0]\n";
|
|
}
|
|
# @rows = ();
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub usb_output {
|
|
eval $start if $b_log;
|
|
return if !$usb{'network'};
|
|
my $rows = $_[0];
|
|
my (@temp2,$b_wifi,$driver,$path,$path_id,$product,$type);
|
|
my ($j,$num) = (0,1);
|
|
foreach my $row (@{$usb{'network'}}){
|
|
$num = 1;
|
|
($driver,$path,$path_id,$product,$type) = ('','','','','');
|
|
$product = main::clean($row->[13]) if $row->[13];
|
|
$driver = $row->[15] if $row->[15];
|
|
$path = $row->[3] if $row->[3];
|
|
$path_id = $row->[2] if $row->[2];
|
|
$type = $row->[14] if $row->[14];
|
|
$driver ||= 'N/A';
|
|
$j = scalar @$rows;
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $product,
|
|
main::key($num++,0,2,'driver') => $driver,
|
|
main::key($num++,1,2,'type') => 'USB',
|
|
},);
|
|
$b_wifi = check_wifi($product);
|
|
if ($extra > 0){
|
|
if ($extra > 1){
|
|
$row->[8] ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'rev')} = $row->[8];
|
|
if ($row->[17]){
|
|
$rows->[$j]{main::key($num++,0,3,'speed')} = $row->[17];
|
|
}
|
|
if ($row->[24]){
|
|
$rows->[$j]{main::key($num++,0,3,'lanes')} = $row->[24];
|
|
}
|
|
if ($b_admin && $row->[22]){
|
|
$rows->[$j]{main::key($num++,0,3,'mode')} = $row->[22];
|
|
}
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'bus-ID')} = "$path_id:$row->[1]";
|
|
if ($extra > 1){
|
|
$row->[7] ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'chip-ID')} = $row->[7];
|
|
}
|
|
if ($extra > 2){
|
|
if (defined $row->[5] && $row->[5] ne ''){
|
|
$rows->[$j]{main::key($num++,0,2,'class-ID')} = "$row->[4]$row->[5]";
|
|
}
|
|
if ($row->[16]){
|
|
$rows->[$j]{main::key($num++,0,2,'serial')} = main::filter($row->[16]);
|
|
}
|
|
}
|
|
}
|
|
if ($show{'network-advanced'}){
|
|
if (!$bsd_type){
|
|
my (@temp,$vendor,$chip);
|
|
@temp = split(':', $row->[7]) if $row->[7];
|
|
($vendor,$chip) = ($temp[0],$temp[1]) if @temp;
|
|
advanced_data_sys($rows,$vendor,$chip,0,$b_wifi,$path,'');
|
|
}
|
|
# NOTE: we need the driver + driver nu, like wlp0 to get a match,
|
|
else {
|
|
$driver .= $row->[21] if defined $row->[21];
|
|
advanced_data_bsd($rows,$driver,$b_wifi);
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub advanced_data_sys {
|
|
eval $start if $b_log;
|
|
return if ! -d '/sys/class/net';
|
|
my ($rows,$vendor,$chip,$count,$b_wifi,$path_usb,$bus_id) = @_;
|
|
my ($cont_if,$ind_if,$j,$num) = (2,3,0,0);
|
|
my $key = 'IF';
|
|
my ($b_check,$b_usb,$if,$path,@paths);
|
|
# ntoe: we've already gotten the base path, now we
|
|
# we just need to get the IF path, which is one level in:
|
|
# usb1/1-1/1-1:1.0/net/enp0s20f0u1/
|
|
if ($path_usb){
|
|
$b_usb = 1;
|
|
@paths = main::globber("${path_usb}*/net/*");
|
|
}
|
|
else {
|
|
@paths = main::globber('/sys/class/net/*');
|
|
}
|
|
@paths = grep {!/\/lo$/} @paths;
|
|
# push(@paths,'/sys/class/net/ppp0'); # fake IF if needed to match test data
|
|
if ($count > 0 && $count < scalar @paths){
|
|
@paths = splice(@paths, $count, scalar @paths);
|
|
}
|
|
if ($vendor eq 'check'){
|
|
$b_check = 1;
|
|
$key = 'IF-ID';
|
|
($cont_if,$ind_if) = (1,2);
|
|
}
|
|
# print join('; ', @paths), $count, "\n";
|
|
foreach (@paths){
|
|
my ($data1,$data2,$duplex,$mac,$speed,$state);
|
|
$j = scalar @$rows;
|
|
# for usb, we already know where we are
|
|
if (!$b_usb){
|
|
# pi mmcnr has pcitool and also these vendor/device paths.
|
|
if (!%risc || $use{'pci-tool'}){
|
|
$path = "$_/device/vendor";
|
|
$data1 = main::reader($path,'',0) if -r $path;
|
|
$data1 =~ s/^0x// if $data1;
|
|
$path = "$_/device/device";
|
|
$data2 = main::reader($path,'',0) if -r $path;
|
|
$data2 =~ s/^0x// if $data2;
|
|
# this is a fix for a redhat bug in virtio
|
|
$data2 = (defined $data2 && $data2 eq '0001' && defined $chip && $chip eq '1000') ? '1000' : $data2;
|
|
}
|
|
# there are cases where arm devices have a small pci bus
|
|
# or, with mmcnr devices, will show device/vendor info in data1/2
|
|
# which won't match with the path IDs
|
|
if (%risc && $chip && Cwd::abs_path($_) =~ /\b$chip\b/){
|
|
$data1 = $vendor;
|
|
$data2 = $chip;
|
|
}
|
|
}
|
|
# print "d1:$data1 v:$vendor d2:$data2 c:$chip bus_id: $bus_id\n";
|
|
# print Cwd::abs_path($_), "\n" if $bus_id;
|
|
if ($b_usb || $b_check || ($data1 && $data2 && $data1 eq $vendor && $data2 eq $chip &&
|
|
(%risc || check_bus_id($_,$bus_id)))){
|
|
$if = $_;
|
|
$if =~ s/^\/.+\///;
|
|
# print "top: if: $if ifs: @ifs_found\n";
|
|
next if ($b_check && grep {/$if/} @ifs_found);
|
|
$path = "$_/duplex";
|
|
$duplex = main::reader($path,'',0) if -r $path;
|
|
$duplex ||= 'N/A';
|
|
$path = "$_/address";
|
|
$mac = main::reader($path,'',0) if -r $path;
|
|
$mac = main::filter($mac);
|
|
$path = "$_/speed";
|
|
$speed = main::reader($path,'',0) if -r $path;
|
|
$speed ||= 'N/A';
|
|
$path = "$_/operstate";
|
|
$state = main::reader($path,'',0) if -r $path;
|
|
$state ||= 'N/A';
|
|
# print "$speed \n";
|
|
push(@$rows,{
|
|
main::key($num++,1,$cont_if,$key) => $if,
|
|
main::key($num++,0,$ind_if,'state') => $state
|
|
});
|
|
# my $j = scalar @row - 1;
|
|
push(@ifs_found, $if) if (!$b_check && (! grep {/$if/} @ifs_found));
|
|
# print "push: if: $if ifs: @ifs_found\n";
|
|
# no print out for wifi since it doesn't have duplex/speed data available
|
|
# note that some cards show 'unknown' for state, so only testing explicitly
|
|
# for 'down' string in that to skip showing speed/duplex
|
|
# /sys/class/net/$if/wireless : not always there, but worth a try: wlan/wl/ww/wlp
|
|
$b_wifi = 1 if !$b_wifi && (-e "$_$if/wireless" || $if =~ /^(wl|ww)/);
|
|
if (!$b_wifi && $state ne 'down' && $state ne 'no'){
|
|
# make sure the value is strictly numeric before appending Mbps
|
|
$speed = (main::is_int($speed)) ? "$speed Mbps" : $speed;
|
|
$rows->[$j]{main::key($num++,0,$ind_if,'speed')} = $speed;
|
|
$rows->[$j]{main::key($num++,0,$ind_if,'duplex')} = $duplex;
|
|
}
|
|
$rows->[$j]{main::key($num++,0,$ind_if,'mac')} = $mac;
|
|
# if ($b_check){
|
|
# push(@rows,@row);
|
|
# }
|
|
# else {
|
|
# @rows = @row;
|
|
# }
|
|
if ($show{'ip'}){
|
|
if_ip($rows,$key,$if);
|
|
}
|
|
last if !$b_check;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub advanced_data_bsd {
|
|
eval $start if $b_log;
|
|
return if ! @ifs_bsd;
|
|
my ($rows,$if,$b_wifi) = @_;
|
|
my ($data,$working_if);
|
|
my ($b_check,$state,$speed,$duplex,$mac);
|
|
my ($cont_if,$ind_if,$j,$num) = (2,3,0,0);
|
|
my $key = 'IF';
|
|
if ($if eq 'check'){
|
|
$b_check = 1;
|
|
$key = 'IF-ID';
|
|
($cont_if,$ind_if) = (1,2);
|
|
}
|
|
foreach my $item (@ifs_bsd){
|
|
if (ref $item ne 'ARRAY'){
|
|
$working_if = $item;
|
|
# print "$working_if\n";
|
|
next;
|
|
}
|
|
else {
|
|
$data = $item;
|
|
}
|
|
if ($b_check || $working_if eq $if){
|
|
$if = $working_if if $b_check;
|
|
# print "top1: if: $if ifs: wif: $working_if @ifs_found\n";
|
|
next if ($b_check && grep {/$if/} @ifs_found);
|
|
# print "top2: if: $if wif: $working_if ifs: @ifs_found\n";
|
|
# print Data::Dumper::Dumper $data;
|
|
# ($state,$speed,$duplex,$mac)
|
|
$duplex = $data->[2];
|
|
$duplex ||= 'N/A';
|
|
$mac = main::filter($data->[3]);
|
|
$speed = $data->[1];
|
|
$speed ||= 'N/A';
|
|
$state = $data->[0];
|
|
$state ||= 'N/A';
|
|
$j = scalar @$rows;
|
|
# print "$speed \n";
|
|
push(@$rows, {
|
|
main::key($num++,1,$cont_if,$key) => $if,
|
|
main::key($num++,0,$ind_if,'state') => $state,
|
|
});
|
|
push(@ifs_found, $if) if (!$b_check && (!grep {/$if/} @ifs_found));
|
|
# print "push: if: $if ifs: @ifs_found\n";
|
|
# no print out for wifi since it doesn't have duplex/speed data available
|
|
# note that some cards show 'unknown' for state, so only testing explicitly
|
|
# for 'down' string in that to skip showing speed/duplex
|
|
if (!$b_wifi && $state ne 'down' && $state ne 'no network'){
|
|
# make sure the value is strictly numeric before appending Mbps
|
|
$speed = (main::is_int($speed)) ? "$speed Mbps" : $speed;
|
|
$rows->[$j]{main::key($num++,0,$ind_if,'speed')} = $speed;
|
|
$rows->[$j]{main::key($num++,0,$ind_if,'duplex')} = $duplex;
|
|
}
|
|
$rows->[$j]{main::key($num++,0,$ind_if,'mac')} = $mac;
|
|
if ($show{'ip'} && $if){
|
|
if_ip($rows,$key,$if);
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## Result values:
|
|
# 0: ipv
|
|
# 1: ip
|
|
# 2: broadcast, if found
|
|
# 3: scope, if found
|
|
# 4: scope IF, if different from IF
|
|
sub if_ip {
|
|
eval $start if $b_log;
|
|
my ($rows,$type,$if) = @_;
|
|
my ($working_if);
|
|
my ($cont_ip,$ind_ip,$if_cnt) = (3,4,0);
|
|
my ($j,$num) = (0,0);
|
|
$b_ip_run = 1;
|
|
if ($type eq 'IF-ID'){
|
|
($cont_ip,$ind_ip) = (2,3);
|
|
}
|
|
OUTER:
|
|
foreach my $item (@ifs){
|
|
if (ref $item ne 'ARRAY'){
|
|
$working_if = $item;
|
|
# print "if:$if wif:$working_if\n";
|
|
next;
|
|
}
|
|
if ($working_if eq $if){
|
|
$if_cnt = 0;
|
|
# print "if $if item:\n", Data::Dumper::Dumper $item;
|
|
foreach my $data2 (@$item){
|
|
$j = scalar @$rows;
|
|
$num = 1;
|
|
$if_cnt++;
|
|
if ($limit > 0 && $if_cnt > $limit){
|
|
push(@$rows, {
|
|
main::key($num++,0,$cont_ip,'Message') => main::message('output-limit',scalar @$item),
|
|
});
|
|
last OUTER;
|
|
}
|
|
# print "$data2->[0] $data2->[1]\n";
|
|
my ($ipv,$ip,$broadcast,$scope,$scope_id);
|
|
$ipv = ($data2->[0])? $data2->[0]: 'N/A';
|
|
$ip = main::filter($data2->[1]);
|
|
$scope = ($data2->[3])? $data2->[3]: 'N/A';
|
|
# note: where is this ever set to 'all'? Old test condition?
|
|
if ($if ne 'all'){
|
|
if (defined $data2->[4] && $working_if ne $data2->[4]){
|
|
# scope global temporary deprecated dynamic
|
|
# scope global dynamic
|
|
# scope global temporary deprecated dynamic
|
|
# scope site temporary deprecated dynamic
|
|
# scope global dynamic noprefixroute enx403cfc00ac68
|
|
# scope global eth0
|
|
# scope link
|
|
# scope site dynamic
|
|
# scope link
|
|
# trim off if at end of multi word string if found
|
|
$data2->[4] =~ s/\s$if$// if $data2->[4] =~ /[^\s]+\s$if$/;
|
|
my $key = ($data2->[4] =~ /deprecated|dynamic|temporary|noprefixroute/) ? 'type' : 'virtual';
|
|
push(@$rows, {
|
|
main::key($num++,1,$cont_ip,"IP v$ipv") => $ip,
|
|
main::key($num++,0,$ind_ip,$key) => $data2->[4],
|
|
main::key($num++,0,$ind_ip,'scope') => $scope,
|
|
});
|
|
}
|
|
else {
|
|
push(@$rows, {
|
|
main::key($num++,1,$cont_ip,"IP v$ipv") => $ip,
|
|
main::key($num++,0,$ind_ip,'scope') => $scope,
|
|
});
|
|
}
|
|
}
|
|
else {
|
|
push(@$rows, {
|
|
main::key($num++,1,($cont_ip - 1),'IF') => $if,
|
|
main::key($num++,1,$cont_ip,"IP v$ipv") => $ip,
|
|
main::key($num++,0,$ind_ip,'scope') => $scope,
|
|
});
|
|
}
|
|
if ($extra > 1 && $data2->[2]){
|
|
$broadcast = main::filter($data2->[2]);
|
|
$rows->[$j]{main::key($num++,0,$ind_ip,'broadcast')} = $broadcast;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# Get ip using downloader to stdout. This is a clean, text only IP output url,
|
|
# single line only, ending in the ip address. May have to modify this in the future
|
|
# to handle ipv4 and ipv6 addresses but should not be necessary.
|
|
# ip=$(echo 2001:0db8:85a3:0000:0000:8a2e:0370:7334 | gawk --re-interval '
|
|
# ip=$(wget -q -O - $WAN_IP_URL | gawk --re-interval '
|
|
# this generates a direct dns based ipv4 ip address, but if opendns.com goes down,
|
|
# the fall backs will still work.
|
|
# note: consistently slower than domain based:
|
|
# dig +short +time=1 +tries=1 myip.opendns.com. A @208.67.222.222
|
|
sub wan_ip {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my ($b_dig,$b_html,$ip,$ua);
|
|
my $num = 0;
|
|
# time: 0.06 - 0.07 seconds
|
|
# Cisco opendns.com may be terminating supporting this one, sometimes works, sometimes not:
|
|
# use -4/6 to force ipv 4 or 6, but generally we want the 'natural' native ip returned.
|
|
# dig +short +time=1 +tries=1 myip.opendns.com @resolver1.opendns.com :: 0.021s
|
|
# Works but is slow:
|
|
# dig +short @ns1-1.akamaitech.net ANY whoami.akamai.net :: 0.156s
|
|
# This one can take forever, and sometimes requires explicit -4 or -6
|
|
# dig -4 TXT +short o-o.myaddr.l.google.com @ns1.google.com :: 0.026s; 1.087ss
|
|
if (!$force{'no-dig'} && (my $program = main::check_program('dig'))){
|
|
$ip = (main::grabber("$program +short +time=1 +tries=1 \@ns1-1.akamaitech.net ANY whoami.akamai.net 2>/dev/null"))[0];
|
|
$ip =~ s/"//g if $ip; # some return IP in quotes, when using TXT
|
|
$b_dig = 1;
|
|
}
|
|
if (!$ip && !$force{'no-html-wan'}){
|
|
# if dig failed or is not installed, set downloader data if unset
|
|
if (!defined $dl{'no-ssl'}){
|
|
main::set_downloader();
|
|
}
|
|
# note: tests: akamai: 0.015 - 0.025 icanhazip.com: 0.020 0.030
|
|
# smxi: 0.230, so ~10x slower. Dig is not as fast as you'd expect
|
|
# dig: 0.167s 0.156s
|
|
# leaving smxi as last test because I know it will always be up.
|
|
# --wan-ip-url replaces values with user supplied arg
|
|
# 0.020s: http://whatismyip.akamai.com/
|
|
# 0.136s: https://get.geojs.io/v1/ip
|
|
# 0.024s: http://icanhazip.com/
|
|
# 0.027s: ifconfig.io
|
|
# 0.230s: https://smxi.org/opt/ip.php
|
|
# 0.023s: https://api.ipify.org :: NOTE: hangs, widely variable times, don't use
|
|
my @urls = (!$wan_url) ? qw(http://whatismyip.akamai.com/
|
|
http://icanhazip.com/ https://smxi.org/opt/ip.php) : ($wan_url);
|
|
foreach (@urls){
|
|
$ua = 'ip' if $_ =~ /smxi/;
|
|
$ip = main::download_file('stdout',$_,'',$ua);
|
|
if ($ip){
|
|
# print "$_\n";
|
|
chomp($ip);
|
|
$ip = (split(/\s+/, $ip))[-1];
|
|
last;
|
|
}
|
|
}
|
|
$b_html = 1;
|
|
}
|
|
if ($ip && $use{'filter'}){
|
|
$ip = $filter_string;
|
|
}
|
|
if (!$ip){
|
|
# true case trips
|
|
if (!$b_dig){
|
|
$ip = main::message('IP-no-dig', 'WAN IP');
|
|
}
|
|
elsif ($b_dig && !$b_html){
|
|
$ip = main::message('IP-dig', 'WAN IP');
|
|
}
|
|
else {
|
|
$ip = main::message('IP', 'WAN IP');
|
|
}
|
|
}
|
|
push(@$rows, {
|
|
main::key($num++,0,1,'WAN IP') => $ip,
|
|
});
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub check_bus_id {
|
|
eval $start if $b_log;
|
|
my ($path,$bus_id) = @_;
|
|
my ($b_valid);
|
|
if ($bus_id){
|
|
# legacy, not link, but uevent has path:
|
|
# PHYSDEVPATH=/devices/pci0000:00/0000:00:0a.1/0000:05:00.0
|
|
if (Cwd::abs_path($path) =~ /$bus_id\// ||
|
|
(-r "$path/uevent" && -s "$path/uevent" &&
|
|
(grep {/$bus_id/} main::reader("$path/uevent")))){
|
|
$b_valid = 1;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $b_valid;
|
|
}
|
|
|
|
sub check_wifi {
|
|
my ($item) = @_;
|
|
my $b_wifi = ($item =~ /wireless|wi-?fi|wlan|802\.11|centrino/i) ? 1 : 0;
|
|
return $b_wifi;
|
|
}
|
|
}
|
|
|
|
## OpticalItem
|
|
{
|
|
package OpticalItem;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my $start = scalar @$rows;
|
|
my ($data,$val1);
|
|
my $num = 0;
|
|
if ($bsd_type){
|
|
$val1 = main::message('optical-data-bsd');
|
|
if ($dboot{'optical'}){
|
|
$data = drive_data_bsd();
|
|
drive_output($rows,$data) if %$data;
|
|
}
|
|
else{
|
|
my $file = $system_files{'dmesg-boot'};
|
|
if ($file && ! -r $file){
|
|
$val1 = main::message('dmesg-boot-permissions');
|
|
}
|
|
elsif (!$file){
|
|
$val1 = main::message('dmesg-boot-missing');
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$val1 = main::message('optical-data');
|
|
$data = drive_data_linux();
|
|
drive_output($rows,$data) if %$data;
|
|
}
|
|
# if none of the above increased the row count, show the error message
|
|
if ($start == scalar @$rows){
|
|
push(@$rows,{main::key($num++,0,1,'Message') => $val1});
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub drive_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$drives) = @_;
|
|
my $num = 0;
|
|
my $j = 0;
|
|
# build floppy if any
|
|
foreach my $key (sort keys %$drives){
|
|
if ($drives->{$key}{'type'} eq 'floppy'){
|
|
push(@$rows, {
|
|
main::key($num++,0,1,ucfirst($drives->{$key}{'type'})) => "/dev/$key",
|
|
});
|
|
delete $drives->{$key};
|
|
}
|
|
}
|
|
foreach my $key (sort keys %$drives){
|
|
$j = scalar @$rows;
|
|
$num = 1;
|
|
my $vendor = $drives->{$key}{'vendor'};
|
|
$vendor ||= 'N/A';
|
|
my $model = $drives->{$key}{'model'};
|
|
$model ||= 'N/A';
|
|
push(@$rows, {
|
|
main::key($num++,1,1,ucfirst($drives->{$key}{'type'})) => "/dev/$key",
|
|
main::key($num++,0,2,'vendor') => $vendor,
|
|
main::key($num++,0,2,'model') => $model,
|
|
});
|
|
if ($extra > 0){
|
|
my $rev = $drives->{$key}{'rev'};
|
|
$rev ||= 'N/A';
|
|
$rows->[$j]{ main::key($num++,0,2,'rev')} = $rev;
|
|
}
|
|
if ($extra > 1 && $drives->{$key}{'serial'}){
|
|
$rows->[$j]{ main::key($num++,0,2,'serial')} = main::filter($drives->{$key}{'serial'});
|
|
}
|
|
my $links = (@{$drives->{$key}{'links'}}) ? join(',', sort @{$drives->{$key}{'links'}}) : 'N/A' ;
|
|
$rows->[$j]{ main::key($num++,0,2,'dev-links')} = $links;
|
|
if ($show{'optical'}){
|
|
$j = scalar @$rows;
|
|
my $speed = $drives->{$key}{'speed'};
|
|
$speed ||= 'N/A';
|
|
my ($audio,$multisession) = ('','');
|
|
if (defined $drives->{$key}{'multisession'}){
|
|
$multisession = ($drives->{$key}{'multisession'} == 1) ? 'yes' : 'no' ;
|
|
}
|
|
$multisession ||= 'N/A';
|
|
if (defined $drives->{$key}{'audio'}){
|
|
$audio = ($drives->{$key}{'audio'} == 1) ? 'yes' : 'no' ;
|
|
}
|
|
$audio ||= 'N/A';
|
|
my $dvd = 'N/A';
|
|
my (@rw,$rws);
|
|
if (defined $drives->{$key}{'dvd'}){
|
|
$dvd = ($drives->{$key}{'dvd'} == 1) ? 'yes' : 'no' ;
|
|
}
|
|
if ($drives->{$key}{'cdr'}){
|
|
push(@rw, 'cd-r');
|
|
}
|
|
if ($drives->{$key}{'cdrw'}){
|
|
push(@rw, 'cd-rw');
|
|
}
|
|
if ($drives->{$key}{'dvdr'}){
|
|
push(@rw, 'dvd-r');
|
|
}
|
|
if ($drives->{$key}{'dvdram'}){
|
|
push(@rw, 'dvd-ram');
|
|
}
|
|
$rws = (@rw) ? join(',', @rw) : 'none' ;
|
|
push(@$rows, {
|
|
main::key($num++,1,2,'Features') => '',
|
|
main::key($num++,0,3,'speed') => $speed,
|
|
main::key($num++,0,3,'multisession') => $multisession,
|
|
main::key($num++,0,3,'audio') => $audio,
|
|
main::key($num++,0,3,'dvd') => $dvd,
|
|
main::key($num++,0,3,'rw') => $rws,
|
|
});
|
|
if ($extra > 0){
|
|
my $state = $drives->{$key}{'state'};
|
|
$state ||= 'N/A';
|
|
$rows->[$j]{ main::key($num++,0,3,'state')} = $state;
|
|
}
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper $drives;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub drive_data_bsd {
|
|
eval $start if $b_log;
|
|
my (@rows,@temp);
|
|
my $drives = {};
|
|
my ($count,$i,$working) = (0,0,'');
|
|
foreach (@{$dboot{'optical'}}){
|
|
$_ =~ s/(cd[0-9]+)\(([^:]+):([0-9]+):([0-9]+)\):/$1:$2-$3.$4,/;
|
|
my @row = split(/:\s*/, $_);
|
|
next if ! defined $row[1];
|
|
if ($working ne $row[0]){
|
|
# print "$id_holder $row[0]\n";
|
|
$working = $row[0];
|
|
}
|
|
# no dots, note: ada2: 2861588MB BUT: ada2: 600.000MB/s
|
|
if (!exists $drives->{$working}){
|
|
$drives->{$working}{'links'} = [];
|
|
$drives->{$working}{'model'} = '';
|
|
$drives->{$working}{'rev'} = '';
|
|
$drives->{$working}{'state'} = '';
|
|
$drives->{$working}{'vendor'} = '';
|
|
$drives->{$working}{'temp'} = '';
|
|
$drives->{$working}{'type'} = ($working =~ /^cd/) ? 'optical' : 'unknown';
|
|
}
|
|
# print "$_\n";
|
|
if ($bsd_type !~ /^(net|open)bsd$/){
|
|
if ($row[1] && $row[1] =~ /^<([^>]+)>/){
|
|
$drives->{$working}{'model'} = $1;
|
|
$count = ($drives->{$working}{'model'} =~ tr/ //);
|
|
if ($count && $count > 1){
|
|
@temp = split(/\s+/, $drives->{$working}{'model'});
|
|
$drives->{$working}{'vendor'} = $temp[0];
|
|
my $index = ($#temp > 2) ? ($#temp - 1): $#temp;
|
|
$drives->{$working}{'model'} = join(' ', @temp[1..$index]);
|
|
$drives->{$working}{'rev'} = $temp[-1] if $count > 2;
|
|
}
|
|
if ($show{'optical'}){
|
|
if (/\bDVD\b/){
|
|
$drives->{$working}{'dvd'} = 1;
|
|
}
|
|
if (/\bRW\b/){
|
|
$drives->{$working}{'cdrw'} = 1;
|
|
$drives->{$working}{'dvdr'} = 1 if $drives->{$working}{'dvd'};
|
|
}
|
|
}
|
|
}
|
|
if ($row[1] && $row[1] =~ /^Serial/){
|
|
@temp = split(/\s+/,$row[1]);
|
|
$drives->{$working}{'serial'} = $temp[-1];
|
|
}
|
|
if ($show{'optical'}){
|
|
if ($row[1] =~ /^([0-9\.]+[MGTP][B]?\/s)/){
|
|
$drives->{$working}{'speed'} = $1;
|
|
$drives->{$working}{'speed'} =~ s/\.[0-9]+//;
|
|
}
|
|
if (/\bDVD[-]?RAM\b/){
|
|
$drives->{$working}{'cdr'} = 1;
|
|
$drives->{$working}{'dvdram'} = 1;
|
|
}
|
|
if ($row[2] && $row[2] =~ /,\s(.*)$/){
|
|
$drives->{$working}{'state'} = $1;
|
|
$drives->{$working}{'state'} =~ s/\s+-\s+/, /;
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
if ($row[2] && $row[2] =~ /<([^>]+)>/){
|
|
$drives->{$working}{'model'} = $1;
|
|
$count = ($drives->{$working}{'model'} =~ tr/,//);
|
|
# print "c: $count $row[2]\n";
|
|
if ($count && $count > 1){
|
|
@temp = split(/,\s*/, $drives->{$working}{'model'});
|
|
$drives->{$working}{'vendor'} = $temp[0];
|
|
$drives->{$working}{'model'} = $temp[1];
|
|
$drives->{$working}{'rev'} = $temp[2];
|
|
}
|
|
if ($show{'optical'}){
|
|
if (/\bDVD\b/){
|
|
$drives->{$working}{'dvd'} = 1;
|
|
}
|
|
if (/\bRW\b/){
|
|
$drives->{$working}{'cdrw'} = 1;
|
|
$drives->{$working}{'dvdr'} = 1 if $drives->{$working}{'dvd'};
|
|
}
|
|
if (/\bDVD[-]?RAM\b/){
|
|
$drives->{$working}{'cdr'} = 1;
|
|
$drives->{$working}{'dvdram'} = 1;
|
|
}
|
|
}
|
|
}
|
|
if ($show{'optical'}){
|
|
# print "$row[1]\n";
|
|
if (($row[1] =~ tr/,//) > 1){
|
|
@temp = split(/,\s*/, $row[1]);
|
|
$drives->{$working}{'speed'} = $temp[2];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
main::log_data('dump','%$drives',$drives) if $b_log;
|
|
# print Data::Dumper::Dumper $drives;
|
|
eval $end if $b_log;
|
|
return $drives;
|
|
}
|
|
|
|
sub drive_data_linux {
|
|
eval $start if $b_log;
|
|
my (@data,@info,@rows);
|
|
my $drives = {};
|
|
@data = main::globber('/dev/dvd* /dev/cdr* /dev/scd* /dev/sr* /dev/fd[0-9]');
|
|
# Newer kernel is NOT linking all optical drives. Some, but not all.
|
|
# Get the actual disk dev location, first try default which is easier to run,
|
|
# need to preserve line breaks
|
|
foreach (@data){
|
|
my $working = readlink($_);
|
|
$working = ($working) ? $working: $_;
|
|
next if $working =~ /random/;
|
|
# possible fix: puppy has these in /mnt not /dev they say
|
|
$working =~ s/\/(dev|media|mnt)\///;
|
|
$_ =~ s/\/(dev|media|mnt)\///;
|
|
if (!defined $drives->{$working}){
|
|
my @temp = ($_ ne $working) ? ($_) : ();
|
|
$drives->{$working}{'links'} = \@temp;
|
|
$drives->{$working}{'type'} = ($working =~ /^fd/) ? 'floppy' : 'optical' ;
|
|
}
|
|
else {
|
|
push(@{$drives->{$working}{'links'}}, $_) if $_ ne $working;
|
|
}
|
|
# print "$working\n";
|
|
}
|
|
if ($show{'optical'} && -e '/proc/sys/dev/cdrom/info'){
|
|
@info = main::reader('/proc/sys/dev/cdrom/info','strip');
|
|
}
|
|
# print join('; ', @data), "\n";
|
|
foreach my $key (keys %$drives){
|
|
next if $drives->{$key}{'type'} eq 'floppy';
|
|
my $device = "/sys/block/$key/device";
|
|
if (-d $device){
|
|
if (-r "$device/vendor"){
|
|
$drives->{$key}{'vendor'} = main::reader("$device/vendor",'',0);
|
|
$drives->{$key}{'vendor'} = main::clean($drives->{$key}{'vendor'});
|
|
$drives->{$key}{'state'} = main::reader("$device/state",'',0);
|
|
$drives->{$key}{'model'} = main::reader("$device/model",'',0);
|
|
$drives->{$key}{'model'} = main::clean($drives->{$key}{'model'});
|
|
$drives->{$key}{'rev'} = main::reader("$device/rev",'',0);
|
|
}
|
|
}
|
|
elsif (-r "/proc/ide/$key/model"){
|
|
$drives->{$key}{'vendor'} = main::reader("/proc/ide/$key/model",'',0);
|
|
$drives->{$key}{'vendor'} = main::clean($drives->{$key}{'vendor'});
|
|
}
|
|
if ($show{'optical'} && @info){
|
|
my $index = 0;
|
|
foreach my $item (@info){
|
|
next if $item =~ /^\s*$/;
|
|
my @split = split(/\s+/, $item);
|
|
if ($item =~ /^drive name:/){
|
|
foreach my $id (@split){
|
|
last if ($id eq $key);
|
|
$index++;
|
|
}
|
|
last if !$index; # index will be > 0 if it was found
|
|
}
|
|
elsif ($item =~/^drive speed:/){
|
|
$drives->{$key}{'speed'} = $split[$index];
|
|
}
|
|
elsif ($item =~/^Can read multisession:/){
|
|
$drives->{$key}{'multisession'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can read MCN:/){
|
|
$drives->{$key}{'mcn'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can play audio:/){
|
|
$drives->{$key}{'audio'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can write CD-R:/){
|
|
$drives->{$key}{'cdr'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can write CD-RW:/){
|
|
$drives->{$key}{'cdrw'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can read DVD:/){
|
|
$drives->{$key}{'dvd'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can write DVD-R:/){
|
|
$drives->{$key}{'dvdr'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can write DVD-RAM:/){
|
|
$drives->{$key}{'dvdram'}=$split[$index+1];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
main::log_data('dump','%$drives',$drives) if $b_log;
|
|
# print Data::Dumper::Dumper $drives;
|
|
eval $end if $b_log;
|
|
return $drives;
|
|
}
|
|
}
|
|
|
|
## PartitionItem
|
|
{
|
|
# these will be globally accessible via PartitionItem::filters()
|
|
my ($fs_exclude,$fs_skip,$part_filter);
|
|
package PartitionItem;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my ($key1,$val1);
|
|
my $rows = [];
|
|
my $num = 0;
|
|
set_partitions() if !$loaded{'set-partitions'};
|
|
# Fails in corner case with zram but no other mounted filesystems
|
|
if (!@partitions){
|
|
$key1 = 'Message';
|
|
#$val1 = ($bsd_type && $bsd_type eq 'darwin') ?
|
|
# main::message('darwin-feature') : main::message('partition-data');
|
|
$val1 = main::message('partition-data');
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1,});
|
|
}
|
|
else {
|
|
create_output($rows);
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub create_output {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my $num = 0;
|
|
my $j = 0;
|
|
my ($dev,$dev_type,$fs,$percent,$raw_size,$size,$used);
|
|
# alpha sort for non numerics
|
|
if ($show{'partition-sort'} !~ /^(percent-used|size|used)$/){
|
|
@partitions = sort { $a->{$show{'partition-sort'}} cmp $b->{$show{'partition-sort'}} } @partitions;
|
|
}
|
|
else {
|
|
@partitions = sort { $a->{$show{'partition-sort'}} <=> $b->{$show{'partition-sort'}} } @partitions;
|
|
}
|
|
my $fs_skip = get_filters('fs-skip');
|
|
foreach my $row (@partitions){
|
|
$num = 1;
|
|
next if $row->{'type'} eq 'secondary' && $show{'partition'};
|
|
next if $show{'swap'} && $row->{'fs'} && $row->{'fs'} eq 'swap';
|
|
next if $row->{'swap-type'} && $row->{'swap-type'} ne 'partition';
|
|
if (!$row->{'hidden'}){
|
|
$size = ($row->{'size'}) ? main::get_size($row->{'size'},'string') : 'N/A';
|
|
$used = main::get_size($row->{'used'},'string','N/A'); # used can be 0
|
|
$percent = (defined $row->{'percent-used'}) ? ' (' . $row->{'percent-used'} . '%)' : '';
|
|
}
|
|
else {
|
|
$percent = '';
|
|
$used = $size = (!$b_root) ? main::message('root-required') : main::message('partition-hidden');
|
|
}
|
|
$fs = ($row->{'fs'}) ? lc($row->{'fs'}): 'N/A';
|
|
$dev_type = ($row->{'dev-type'}) ? $row->{'dev-type'} : 'dev';
|
|
$row->{'dev-base'} = '/dev/' . $row->{'dev-base'} if $dev_type eq 'dev' && $row->{'dev-base'};
|
|
$dev = ($row->{'dev-base'}) ? $row->{'dev-base'} : 'N/A';
|
|
$row->{'id'} =~ s|/home/[^/]+/(.*)|/home/$filter_string/$1| if $use{'filter'};
|
|
$j = scalar @$rows;
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'ID') => $row->{'id'},
|
|
});
|
|
if (($b_admin || $row->{'hidden'}) && $row->{'raw-size'}){
|
|
# It's an error! permissions or missing tool
|
|
$raw_size = ($row->{'raw-size'}) ? main::get_size($row->{'raw-size'},'string') : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'raw-size')} = $raw_size;
|
|
}
|
|
if ($b_admin && $row->{'raw-available'} && $size ne 'N/A'){
|
|
$size .= ' (' . $row->{'raw-available'} . '%)';
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'size')} = $size;
|
|
$rows->[$j]{main::key($num++,0,2,'used')} = $used . $percent;
|
|
$rows->[$j]{main::key($num++,0,2,'fs')} = $fs;
|
|
if ($b_admin && $fs eq 'swap' && defined $row->{'swappiness'}){
|
|
$rows->[$j]{main::key($num++,0,2,'swappiness')} = $row->{'swappiness'};
|
|
}
|
|
if ($b_admin && $fs eq 'swap' && defined $row->{'cache-pressure'}){
|
|
$rows->[$j]{main::key($num++,0,2,'cache-pressure')} = $row->{'cache-pressure'};
|
|
}
|
|
if ($extra > 1 && $fs eq 'swap' && defined $row->{'priority'}){
|
|
$rows->[$j]{main::key($num++,0,2,'priority')} = $row->{'priority'};
|
|
}
|
|
if ($b_admin && $row->{'block-size'}){
|
|
$rows->[$j]{main::key($num++,0,2,'block-size')} = $row->{'block-size'} . ' B';;
|
|
# $rows->[$j]{main::key($num++,0,2,'physical')} = $row->{'block-size'} . ' B';
|
|
# $rows->[$j]{main::key($num++,0,2,'logical')} = $row->{'block-logical'} . ' B';
|
|
}
|
|
$rows->[$j]{main::key($num++,1,2,$dev_type)} = $dev;
|
|
if ($b_admin && $row->{'maj-min'}){
|
|
$rows->[$j]{main::key($num++,0,3,'maj-min')} = $row->{'maj-min'};
|
|
}
|
|
if ($extra > 0 && $row->{'dev-mapped'}){
|
|
$rows->[$j]{main::key($num++,0,3,'mapped')} = $row->{'dev-mapped'};
|
|
}
|
|
# add fs known to not use label/uuid here
|
|
if (($show{'label'} || $show{'uuid'}) && $dev_type eq 'dev' &&
|
|
$fs !~ /^$fs_skip$/){
|
|
if ($show{'label'}){
|
|
if ($use{'filter-label'}){
|
|
$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;
|
|
}
|
|
|
|
sub set_partitions {
|
|
eval $start if $b_log;
|
|
# return if $bsd_type && $bsd_type eq 'darwin'; # darwin has mutated output
|
|
my (@data,@rows,@mount,@partitions_working,$part,@working);
|
|
my ($back_size,$back_used,$b_fs,$cols) = (4,3,1,6);
|
|
my ($b_dfp,$b_fake_map,$b_load,$b_logical,$b_space,);
|
|
my ($block_size,$blockdev,$dev_base,$dev_mapped,$dev_type,$fs,$id,$label,
|
|
$maj_min,$percent_used,$raw_size,$replace,$size_available,$size,$test,
|
|
$type,$uuid,$used);
|
|
$loaded{'set-partitions'} = 1;
|
|
if ($b_admin){
|
|
# For partition block size
|
|
$blockdev = $alerts{'blockdev'}->{'path'} if $alerts{'blockdev'}->{'path'};
|
|
}
|
|
# For raw partition sizes, maj_min
|
|
if ($bsd_type){
|
|
DiskDataBSD::set() if !$loaded{'disk-data-bsd'};
|
|
}
|
|
else {
|
|
PartitionData::set() if !$loaded{'partition-data'};
|
|
LsblkData::set() if !$loaded{'lsblk'};
|
|
}
|
|
# set @labels, @uuid
|
|
if (!$bsd_type){
|
|
set_label_uuid() if !$loaded{'label-uuid'};
|
|
}
|
|
# Most current OS support -T and -k, but -P means different things
|
|
# in freebsd. However since most use is from linux, we make that default
|
|
# android 7 no -T support
|
|
if (!$fake{'partitions'}){
|
|
if (@partitions_working = main::grabber("df -P -T -k 2>/dev/null")){
|
|
main::set_mapper() if !$loaded{'mapper'} && !$bsd_type;
|
|
$b_dfp = 1;
|
|
}
|
|
elsif (@partitions_working = main::grabber("df -T -k 2>/dev/null")){
|
|
# Fine, it worked, could be bsd or linux
|
|
}
|
|
# Busybox supports -k and -P, older openbsd, darwin, solaris don't have -P
|
|
else {
|
|
if (@partitions_working = main::grabber("df -k -P 2>/dev/null")){
|
|
$b_dfp = 1;
|
|
}
|
|
else {
|
|
@partitions_working = main::grabber("df -k 2>/dev/null");
|
|
}
|
|
$b_fs = 0;
|
|
if (my $path = main::check_program('mount')){
|
|
@mount = main::grabber("$path 2>/dev/null");
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
my $file;
|
|
# $file = "$fake_data_dir/block-devices/df/df-kTP-cygwin-1.txt";
|
|
# $file = "$fake_data_dir/block-devices/df/df-kT-wrapped-1.txt";
|
|
# @partitions_working = main::reader($file);
|
|
}
|
|
# print Data::Dumper::Dumper \@partitions_working;
|
|
# Determine positions
|
|
if (@partitions_working){
|
|
my $row1 = shift @partitions_working;
|
|
$row1 =~ s/Mounted on/Mounted-on/i;
|
|
my @temp = split(/\s+/,$row1);
|
|
$cols = $#temp;
|
|
}
|
|
# NOTE: using -P fixes line wraps, otherwise look for hangs and reconnect
|
|
if (!$b_dfp){
|
|
my $holder = '';
|
|
my @part_temp;
|
|
foreach (@partitions_working){
|
|
my @columns= split(/\s+/,$_);
|
|
if ($#columns < $cols){
|
|
$holder = join('^^',@columns[0..$#columns]);
|
|
next;
|
|
}
|
|
if ($holder){ # reconnect hanging lines
|
|
$_ = $holder . ' ' . $_;
|
|
$holder = '';
|
|
}
|
|
push(@part_temp,$_);
|
|
}
|
|
@partitions_working = @part_temp;
|
|
}
|
|
if (!$bsd_type){
|
|
# New kernels/df have rootfs and / repeated, creating two entries for the
|
|
# same partition so check for two string endings of / then slice out the
|
|
# rootfs one, I could check for it before slicing it out, but doing that
|
|
# would require the same action twice re code execution.
|
|
my $roots = 0;
|
|
foreach (@partitions_working){
|
|
$roots++ if /\s\/$/;
|
|
}
|
|
@partitions_working = grep {!/^rootfs/} @partitions_working if $roots > 1;
|
|
}
|
|
else {
|
|
# turns out freebsd uses this junk too
|
|
$b_fake_map = 1;
|
|
# darwin k: Filesystem 1024-blocks Used Available Capacity iused ifree %iused Mounted on
|
|
# linux kT: Filesystem Type 1K-blocks Used Available Use% Mounted on
|
|
# freebsd kT: Filesystem Type 1024-blocks Used Avail Capacity Mounted on
|
|
if ($bsd_type eq 'darwin'){
|
|
($back_size,$back_used) = (7,6);
|
|
}
|
|
}
|
|
my $filters = get_filters('partition');
|
|
# These are local, not remote, iso, or overlay types:
|
|
my $fuse_fs = 'adb|apfs(-?fuse)?|archive(mount)?|gphoto|gv|gzip|ifuse|';
|
|
$fuse_fs .= '[^\.]*mtp|ntfs-?3g|[^\.]*ptp|vdfuse|vram|wim(mount)?|xb|xml';
|
|
# Just the common ones desktops might have
|
|
my $remote_fs = 'curlftp|gmail|g(oogle-?)?drive|pnfs|\bnfs|rclone|s3fs|smb|ssh';
|
|
# push @partitions_working, '//mafreebox.freebox.fr/Disque dur cifs 239216096 206434016 20607496 91% /freebox/Disque dur';
|
|
# push @partitions_working, '//mafreebox.freebox.fr/AllPG cifs 436616192 316339304 120276888 73% /freebox/AllPG';
|
|
# push(@partitions_working,'/dev/loop0p1 iso9660 3424256 3424256 0 100% /media/jason/d-live nf 11.3.0 gn 6555 9555 amd64');
|
|
# push(@partitions_working,'drvfs 9p 511881212 115074772 396806440 23% /mnt/c');
|
|
# push(@partitions_working,'drivers 9p 511881212 115074772 396806440 23% /usr/lib/wsl/drivers');
|
|
foreach (@partitions_working){
|
|
($dev_base,$dev_mapped,$dev_type,$fs,$id,$label,
|
|
$maj_min,$type,$uuid) = ('','','','','','','','','');
|
|
($b_load,$b_space,$block_size,$percent_used,$raw_size,$size_available,
|
|
$size,$used) = (0,0,0,0,0,0,0,0);
|
|
undef $part;
|
|
# apple crap, maybe also freebsd?
|
|
$_ =~ s/^map\s+([\S]+)/map:\/$1/ if $b_fake_map;
|
|
# handle spaces in remote filesystem names
|
|
# busybox df shows KM, sigh; note: GoogleDrive Hogne: fuse.rclone 15728640 316339304 120276888 73%
|
|
if (/^(.*?)(\s[\S]+)\s+[a-z][a-z0-9\.]+(\s+[0-9]+){3}\s+[0-9]+%\s/){
|
|
$replace = $test = "$1$2";
|
|
if ($test =~ /\s/){ # paranoid test, but better safe than sorry
|
|
$b_space = 1;
|
|
$replace =~ s/\s/^^/g;
|
|
# print ":$replace:\n";
|
|
$_ =~ s/^$test/$replace/;
|
|
# print "$_\n";
|
|
}
|
|
}
|
|
my @row = split(/\s+/, $_);
|
|
# print Data::Dumper::Dumper \@row;
|
|
$row[0] =~ s/\^\^/ /g if $b_space; # reset spaces in > 1 word fs name
|
|
# autofs is a bsd thing, has size 0
|
|
if ($row[0] =~ /^$filters$/ || $row[0] =~ /^ROOT/i ||
|
|
($b_fs && ($row[2] == 0 || $row[1] =~ /^(autofs|devtmpfs|iso9660|tmpfs)$/))){
|
|
next;
|
|
}
|
|
# cygwin C:\cygwin passes this test so has to be handled later
|
|
if ($row[0] =~ /^\/dev\/|:\/|\/\//){
|
|
# this could point to by-label or by-uuid so get that first. In theory, abs_path should
|
|
# drill down to get the real path, but it isn't always working.
|
|
if ($row[0] eq '/dev/root'){
|
|
$row[0] = get_root();
|
|
}
|
|
# sometimes paths are set using /dev/disk/by-[label|uuid] so we need to get the /dev/xxx path
|
|
if ($row[0] =~ /by-label|by-uuid/){
|
|
$row[0] = Cwd::abs_path($row[0]);
|
|
}
|
|
elsif ($row[0] =~ /mapper\// && %mapper){
|
|
$dev_mapped = $row[0];
|
|
$dev_mapped =~ s|^/.*/||;
|
|
$row[0] = $mapper{$dev_mapped} if $mapper{$dev_mapped};
|
|
}
|
|
elsif ($row[0] =~ /\/dm-[0-9]+$/ && %dmmapper){
|
|
my $temp = $row[0];
|
|
$temp =~ s|^/.*/||;
|
|
$dev_mapped = $dmmapper{$temp};
|
|
}
|
|
$dev_base = $row[0];
|
|
$dev_base =~ s|^/.*/||;
|
|
$part = LsblkData::get($dev_base) if @lsblk;
|
|
$maj_min = get_maj_min($dev_base) if @proc_partitions;
|
|
}
|
|
# this handles zfs type devices/partitions, which do not start with / but contain /
|
|
# note: Main/jails/transmission_1 path can be > 1 deep
|
|
# Main zfs 3678031340 8156 3678023184 0% /mnt/Main
|
|
if (!$dev_base && ($row[0] =~ /^([^\/]+\/)(.+)/ ||
|
|
($row[0] =~ /^[^\/]+$/ && $row[1] =~ /^(btrfs|hammer[2-9]?|zfs)$/)) ||
|
|
($windows{'wsl'} && $row[0] eq 'drivers')){
|
|
$dev_base = $row[0];
|
|
$dev_type = 'logical';
|
|
}
|
|
# this handles yet another fredforfaen special case where a mounted drive
|
|
# has the search string in its name, includes / (|
|
|
if ($row[-1] =~ m%^/(|boot|boot/efi|home|opt|tmp|usr|usr/home|var|var/log|var/tmp)$% ||
|
|
($b_android && $row[-1] =~ /^\/(cache|data|firmware|system)$/)){
|
|
$b_load = 1;
|
|
# note, older df in bsd do not have file system column
|
|
$type = 'main';
|
|
}
|
|
# $cols in case where mount point has space in name, we only care about the first part
|
|
elsif ($row[$cols] !~ m%^\/(|boot|boot/efi|home|opt|tmp|usr|usr/home|var|var/log|var/tmp)$% &&
|
|
$row[$cols] !~ /^filesystem/ &&
|
|
!($b_android && $row[$cols] =~ /^\/(cache|data|firmware|system)$/)){
|
|
$b_load = 1;
|
|
$type = 'secondary';
|
|
}
|
|
if ($b_load){
|
|
if (!$bsd_type){
|
|
if ($b_fs){
|
|
$fs = ($part->{'fs'}) ? $part->{'fs'} : $row[1];
|
|
}
|
|
else {
|
|
$fs = get_mounts_fs($row[0],\@mount);
|
|
}
|
|
if ($show{'label'}){
|
|
if ($part->{'label'}){
|
|
$label = $part->{'label'};
|
|
}
|
|
elsif (@labels){
|
|
$label = get_label($row[0]);
|
|
}
|
|
}
|
|
if ($show{'uuid'}){
|
|
if ($part->{'uuid'}){
|
|
$uuid = $part->{'uuid'};
|
|
}
|
|
elsif (@uuids){
|
|
$uuid = get_uuid($row[0]);
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$fs = ($b_fs) ? $row[1]: get_mounts_fs($row[0],\@mount);
|
|
}
|
|
# assuming that all null/nullfs are parts of a logical fs
|
|
$b_logical = 1 if $fs && $fs =~ /^(btrfs|hammer|null|zfs)/;
|
|
$id = join(' ', @row[$cols .. $#row]);
|
|
$size = $row[$cols - $back_size];
|
|
if ($b_admin && -e "/sys/block/"){
|
|
@working = admin_data($blockdev,$dev_base,$size);
|
|
$raw_size = $working[0];
|
|
$size_available = $working[1];
|
|
$block_size = $working[2];
|
|
}
|
|
if (!$dev_type){
|
|
# C:/cygwin64, D:
|
|
if ($windows{'cygwin'} && $row[0] =~ /^[A-Z]+:/){
|
|
$dev_type = 'windows';
|
|
$dev_base = $row[0] if !$dev_base;
|
|
# looks weird if D:, yes, I know, windows uses \, but cygwin doesn't
|
|
$dev_base .= '/' if $dev_base =~ /:$/;
|
|
}
|
|
elsif ($windows{'wsl'} && $row[0] =~ /^(drvfs)/){
|
|
$dev_type = 'windows';
|
|
if ($id =~ m|^/mnt/([a-z])$|){
|
|
$dev_base = uc($1) . ':';
|
|
}
|
|
$dev_base = $row[0] if !$dev_base;
|
|
}
|
|
# need data set, this could maybe be converted to use
|
|
# dev-mapped and abspath but not without testing
|
|
elsif ($dev_base =~ /^map:\/(.*)/){
|
|
$dev_type = 'mapped';
|
|
$dev_base = $1;
|
|
}
|
|
# note: possible: sshfs path: beta:data/; remote: fuse.rclone
|
|
elsif ($dev_base =~ /^\/\/|:\// || ($fs && $fs =~ /($remote_fs)/i)){
|
|
$dev_type = 'remote';
|
|
$dev_base = $row[0] if !$dev_base; # only trips in fs test case
|
|
}
|
|
# a slice bsd system, zfs can't be detected this easily
|
|
elsif ($b_logical && $fs && $fs =~ /^null(fs)?$/){
|
|
$dev_type = 'logical';
|
|
$dev_base = $row[0] if !$dev_base;
|
|
}
|
|
elsif (!$dev_base){
|
|
if ($fs && $fs =~ /^(fuse[\._-]?)?($fuse_fs)(fs)?/i){
|
|
$dev_base = $2;
|
|
$dev_type = 'fuse';
|
|
}
|
|
# Check dm-crypt, that may be real partition type, but no data.
|
|
# We've hit something inxi doesn't know about, or error has occured
|
|
else {
|
|
$dev_type = 'source';
|
|
$dev_base = main::message('unknown-dev');
|
|
}
|
|
}
|
|
else {
|
|
$dev_type = 'dev';
|
|
}
|
|
}
|
|
if ($bsd_type && $dev_type eq 'dev' && $row[0] &&
|
|
($b_admin || $show{'label'} || $show{'uuid'})){
|
|
my $temp = DiskDataBSD::get($row[0]);
|
|
$block_size = $temp->{'logical-block-size'};
|
|
$label = $temp->{'label'};
|
|
$uuid = $temp->{'uuid'};
|
|
}
|
|
$used = $row[$cols - $back_used];
|
|
$percent_used = sprintf("%.1f", ($used/$size)*100) if ($size && main::is_numeric($size));
|
|
push(@partitions,{
|
|
'block-size' => $block_size,
|
|
'dev-base' => $dev_base,
|
|
'dev-mapped' => $dev_mapped,
|
|
'dev-type' => $dev_type,
|
|
'fs' => $fs,
|
|
'id' => $id,
|
|
'label' => $label,
|
|
'maj-min' => $maj_min,
|
|
'percent-used' => $percent_used,
|
|
'raw-available' => $size_available,
|
|
'raw-size' => $raw_size,
|
|
'size' => $size,
|
|
'type' => $type,
|
|
'used' => $used,
|
|
'uuid' => $uuid,
|
|
});
|
|
}
|
|
}
|
|
swap_data() if !$loaded{'set-swap'};
|
|
push(@partitions,@swaps);
|
|
print Data::Dumper::Dumper \@partitions if $dbg[16];
|
|
if (!$bsd_type && @lsblk){
|
|
check_partition_data();# updates @partitions
|
|
}
|
|
main::log_data('dump','@partitions',\@partitions) if $b_log;
|
|
print Data::Dumper::Dumper \@partitions if $dbg[16];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub swap_data {
|
|
eval $start if $b_log;
|
|
$loaded{'set-swap'} = 1;
|
|
my (@data,@working);
|
|
my ($block_size,$cache_pressure,$dev_base,$dev_mapped,$dev_type,$label,
|
|
$maj_min,$mount,$path,$pattern1,$pattern2,$percent_used,$priority,
|
|
$size,$swap_type,$swappiness,$used,$uuid,$zram_comp,$zram_mcs,
|
|
$zswap_enabled,$zram_comp_avail,$zswap_comp,$zswap_mpp);
|
|
my ($s,$j,$size_id,$used_id) = (1,0,2,3);
|
|
if (!$bsd_type){
|
|
# faster, avoid subshell, same as swapon -s
|
|
if (-r '/proc/swaps'){
|
|
@working = main::reader("/proc/swaps");
|
|
}
|
|
elsif ($path = main::check_program('swapon')){
|
|
# note: while -s is deprecated, --show --bytes is not supported
|
|
# on older systems
|
|
@working = main::grabber("$path -s 2>/dev/null");
|
|
}
|
|
if ($b_admin){
|
|
swap_advanced_data(\$swappiness,\$cache_pressure,\$zswap_enabled,
|
|
\$zswap_comp,\$zswap_mpp);
|
|
}
|
|
if (($show{'label'} || $show{'uuid'}) && !$loaded{'label-uuid'}){
|
|
set_label_uuid();
|
|
}
|
|
$pattern1 = 'partition|file|ram';
|
|
$pattern2 = '[^\s].*[^\s]';
|
|
}
|
|
else {
|
|
if ($path = main::check_program('swapctl')){
|
|
# output in in KB blocks
|
|
@working = main::grabber("$path -l -k 2>/dev/null");
|
|
}
|
|
($size_id,$used_id) = (1,2);
|
|
$pattern1 = '[0-9]+';
|
|
$pattern2 = '[^\s]+';
|
|
}
|
|
# now add the swap partition data, don't want to show swap files, just partitions,
|
|
# though this can include /dev/ramzswap0. Note: you can also use /proc/swaps for this
|
|
# data, it's the same exact output as swapon -s
|
|
foreach (@working){
|
|
#next if ! /^\/dev/ || /^\/dev\/(ramzwap|zram)/;
|
|
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+/, $_);
|
|
# /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';
|
|
}
|
|
elsif (m|^/dev|){
|
|
$swap_type = 'partition';
|
|
$dev_base = $data[0];
|
|
$dev_base =~ s|^/dev/||;
|
|
if (!$bsd_type){
|
|
if ($dev_base =~ /^dm-/ && %dmmapper){
|
|
$dev_mapped = $dmmapper{$dev_base};
|
|
}
|
|
if ($show{'label'} && @labels){
|
|
$label = get_label($data[0]);
|
|
}
|
|
if ($show{'uuid'} && @uuids){
|
|
$uuid = get_uuid($data[0]);
|
|
}
|
|
}
|
|
else {
|
|
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';
|
|
$maj_min = get_maj_min($dev_base) if @proc_partitions;
|
|
}
|
|
elsif ($data[1] && $data[1] eq 'file' || m|^/|){
|
|
$swap_type = 'file';
|
|
}
|
|
$priority = $data[-1] if !$bsd_type;
|
|
# swpaon -s: /dev/sdb1 partition 16383996 109608 -2
|
|
# swapctl -l -k: /dev/label/swap0.eli 524284 154092
|
|
# users could have space in swapfile name
|
|
if (/^($pattern2)\s+($pattern1)\s+/){
|
|
$mount = main::trimmer($1);
|
|
}
|
|
$size = $data[$size_id];
|
|
$used = $data[$used_id];
|
|
$percent_used = sprintf("%.1f", ($used/$size)*100);
|
|
push(@swaps, {
|
|
'block-size' => $block_size,
|
|
'cache-pressure' => $cache_pressure,
|
|
'dev-base' => $dev_base,
|
|
'dev-mapped' => $dev_mapped,
|
|
'dev-type' => $dev_type,
|
|
'fs' => 'swap',
|
|
'id' => "swap-$s",
|
|
'label' => $label,
|
|
'maj-min' => $maj_min,
|
|
'mount' => $mount,
|
|
'percent-used' => $percent_used,
|
|
'priority' => $priority,
|
|
'size' => $size,
|
|
'swappiness' => $swappiness,
|
|
'type' => 'main',
|
|
'swap-type' => $swap_type,
|
|
'used' => $used,
|
|
'uuid' => $uuid,
|
|
'zram-comp' => $zram_comp,
|
|
'zram-comp-avail' => $zram_comp_avail,
|
|
'zram-max-comp-streams' => $zram_mcs,
|
|
'zswap-enabled' => $zswap_enabled,
|
|
'zswap-compressor' => $zswap_comp,
|
|
'zswap-max-pool-percent' => $zswap_mpp,
|
|
});
|
|
$s++;
|
|
}
|
|
main::log_data('dump','@swaps',\@swaps) if $b_log;
|
|
print Data::Dumper::Dumper \@swaps if $dbg[15];;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# Alll by ref: 0: $swappiness; 1: $cache_pressure; 2: $zswap_enabled;
|
|
# 3: $zswap_comp; 4: $zswap_mpp
|
|
sub swap_advanced_data {
|
|
eval $start if $b_log;
|
|
if (-r '/proc/sys/vm/swappiness'){
|
|
${$_[0]} = main::reader('/proc/sys/vm/swappiness','',0);
|
|
if (defined ${$_[0]}){
|
|
${$_[0]} .= (${$_[0]} == 60) ? ' (default)' : ' (default 60)' ;
|
|
}
|
|
}
|
|
if (-r '/proc/sys/vm/vfs_cache_pressure'){
|
|
${$_[1]} = main::reader('/proc/sys/vm/vfs_cache_pressure','',0);
|
|
if (defined ${$_[1]}){
|
|
${$_[1]} .= (${$_[1]}== 100) ? ' (default)' : ' (default 100)' ;
|
|
}
|
|
}
|
|
if (-r '/sys/module/zswap/parameters/enabled'){
|
|
${$_[2]} = main::reader('/sys/module/zswap/parameters/enabled','',0);
|
|
if (${$_[2]} =~ /^(Y|yes|true|1)$/){
|
|
${$_[2]} = 'yes';
|
|
}
|
|
elsif (${$_[2]} =~ /^(N|no|false|0)$/){
|
|
${$_[2]} = 'no';
|
|
}
|
|
else {
|
|
${$_[2]} = 'unset';
|
|
}
|
|
}
|
|
if (-r '/sys/module/zswap/parameters/compressor'){
|
|
${$_[3]} = main::reader('/sys/module/zswap/parameters/compressor','',0);
|
|
}
|
|
if (-r '/sys/module/zswap/parameters/max_pool_percent'){
|
|
${$_[4]} = main::reader('/sys/module/zswap/parameters/max_pool_percent','',0);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# 0: device id [zram0]; by ref: 1: $zram_comp; 2: $zram_comp_avail; 3: $zram_mcs;
|
|
sub zram_data {
|
|
if (-r "/sys/block/$_[0]/comp_algorithm"){
|
|
${$_[2]} = main::reader("/sys/block/$_[0]/comp_algorithm",'',0);
|
|
# current is in [..] in list
|
|
if (${$_[2]} =~ /\[(\S+)\]/){
|
|
${$_[1]} = $1;
|
|
# dump the active one, and leave the available
|
|
${$_[2]} =~ s/\[${$_[1]}\]//;
|
|
${$_[2]} =~ s/^\s+|\s+$//g;
|
|
${$_[2]} =~ s/\s+/,/g;
|
|
}
|
|
}
|
|
if (-r "/sys/block/$_[0]/max_comp_streams"){
|
|
${$_[3]} = main::reader("/sys/block/$_[0]/max_comp_streams",'',0);
|
|
}
|
|
}
|
|
|
|
# Handle cases of hidden file systems
|
|
sub check_partition_data {
|
|
eval $start if $b_log;
|
|
my ($b_found,$dev_mapped,$temp);
|
|
my $filters = get_filters('partition');
|
|
foreach my $row (@lsblk){
|
|
$b_found = 0;
|
|
$dev_mapped = '';
|
|
if (!$row->{'name'} || !$row->{'mount'} || !$row->{'type'} ||
|
|
($row->{'fs'} && $row->{'fs'} =~ /^$filters$/) ||
|
|
($row->{'type'} =~ /^(disk|loop|rom)$/)){
|
|
next;
|
|
}
|
|
# unmap so we can match name to dev-base
|
|
if (%mapper && $mapper{$row->{'name'}}){
|
|
$dev_mapped = $row->{'name'};
|
|
$row->{'name'} = $mapper{$row->{'name'}};
|
|
}
|
|
# print "$row->{'name'} $row->{'mount'}\n";
|
|
foreach my $row2 (@partitions){
|
|
# print "1: n:$row->{'name'} m:$row->{'mount'} db:$row2->{'dev-base'} id:$row2->{'id'}\n";
|
|
next if !$row2->{'id'};
|
|
# note: for swap mount point is [SWAP] in @lsblk, but swap-x in @partitions
|
|
if ($row->{'mount'} eq $row2->{'id'} || $row->{'name'} eq $row2->{'dev-base'}){
|
|
$b_found = 1;
|
|
last;
|
|
}
|
|
# print "m:$row->{'mount'} id:$row2->{'id'}\n";
|
|
}
|
|
if (!$b_found){
|
|
# print "found: n:$row->{'name'} m:$row->{'mount'}\n";
|
|
$temp = {
|
|
'block-logical' => $row->{'block-logical'},
|
|
'dev-base' => $row->{'name'},
|
|
'dev-mapped' => $dev_mapped,
|
|
'fs' => $row->{'fs'},
|
|
'id' => $row->{'mount'},
|
|
'hidden' => 1,
|
|
'label' => $row->{'label'},
|
|
'maj-min' => $row->{'maj-min'},
|
|
'percent-used' => 0,
|
|
'raw-size' => $row->{'size'},
|
|
'size' => 0,
|
|
'type' => 'secondary',
|
|
'used' => 0,
|
|
'uuid' => $row->{'uuid'},
|
|
};
|
|
push(@partitions,$temp);
|
|
main::log_data('dump','lsblk check: @temp',$temp) if $b_log;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# fs-exclude: Excludes fs size from disk used total;
|
|
# fs-skip: do not display label/uuid fields from partition/unmounted/swap.
|
|
# partition: do not use this partition in -p output.
|
|
# args: 0: [fs-exclude|fs-skip|partition]
|
|
sub get_filters {
|
|
set_filters() if !$fs_exclude;
|
|
if ($_[0] eq 'fs-exclude'){
|
|
return $fs_exclude;
|
|
}
|
|
elsif ($_[0] eq 'fs-skip'){
|
|
return $fs_skip;
|
|
}
|
|
elsif ($_[0] eq 'partition'){
|
|
return $part_filter;
|
|
}
|
|
}
|
|
|
|
# See docs/inxi-partitions.txt FILE SYSTEMS for specific fs info.
|
|
# The filter string must match /^[regex]$/ exactly.
|
|
sub set_filters {
|
|
# Notes: appimage/flatpak mount?; astreamfs reads remote http urls;
|
|
# avfs == fuse; cgmfs,vramfs in ram, like devfs, sysfs; gfs = googlefs;
|
|
# hdfs == hadoop; ifs == integrated fs; pvfs == orangefs; smb == cifs;
|
|
# null == hammer fs slice; kfs/kosmosfs == CloudStore;
|
|
# snap mounts with squashfs; swap is set in swap_data(); vdfs != vdfuse;
|
|
# vramfs == like zram except gpu ram;
|
|
# Some can be fuse mounts: fuse.sshfs.
|
|
# Distributed/Remote: 9p, (open-)?afs, alluxio, astreamfs, beegfs,
|
|
# cephfs, cfs, chironfs, cifs, cloudstore, dfs, davfs, dce,
|
|
# gdrivefs, gfarm, gfs\d{0,2}, gitfs, glusterfs, gmailfs, gpfs,
|
|
# hdfs, httpdirfs, hubicfuse, ipfs, juice, k(osmos)?fs, .*lafs, lizardfs,
|
|
# lustre, magma, mapr, moosefs, nfs[34], objective, ocfs\d{0,2}, onefs,
|
|
# orangefs, panfs, pnfs, pvfs\d{0,2}, rclone, restic, rozofs, s3fs, scality,
|
|
# sfs, sheepdogfs, spfs, sshfs, smbfs, v9fs, 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/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 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 $start = '(fuse(blk)?[\._-]?)?(';
|
|
my $end = ')([\._-]?fuse)?(fs)?\d{0,2}';
|
|
$fs_exclude = $start . join('|',@exclude) . $end;
|
|
$fs_skip = $start . join('|',@exclude,'f') . $end; # apfs?; BSD ffs has no u/l
|
|
$part_filter = '((' . join('|',@partition) . ')(fs)?|';
|
|
$part_filter .= '\/dev|\/dev\/loop[0-9]+|\/run(\/.*)?|\/sys\/.*)';
|
|
# print "$part_filter\n";
|
|
}
|
|
|
|
sub get_mounts_fs {
|
|
eval $start if $b_log;
|
|
my ($item,$mount) = @_;
|
|
$item =~ s/map:\/(\S+)/map $1/ if $bsd_type && $bsd_type eq 'darwin';
|
|
return 'N/A' if ! @$mount;
|
|
my ($fs) = ('');
|
|
# linux: /dev/sdb6 on /var/www/m type ext4 (rw,relatime,data=ordered)
|
|
# /dev/sda3 on /root.dev/ugw type ext3 (rw,relatime,errors=continue,user_xattr,acl,barrier=1,data=journal)
|
|
# bsd: /dev/ada0s1a on / (ufs, local, soft-updates)
|
|
# bsd 2: /dev/wd0g on /home type ffs (local, nodev, nosuid)
|
|
foreach (@$mount){
|
|
if ($_ =~ /^$item\s+on.*?\s+type\s+([\S]+)\s+\([^\)]+\)/){
|
|
$fs = $1;
|
|
last;
|
|
}
|
|
elsif ($_ =~ /^$item\s+on.*?\s+\(([^,\s\)]+?)[,\s]*.*\)/){
|
|
$fs = $1;
|
|
last;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
main::log_data('data',"fs: $fs") if $b_log;
|
|
return $fs;
|
|
}
|
|
|
|
sub set_label_uuid {
|
|
eval $start if $b_log;
|
|
$loaded{'label-uuid'} = 1;
|
|
if ($show{'unmounted'} || $show{'label'} || $show{'swap'} || $show{'uuid'}){
|
|
if (-d '/dev/disk/by-label'){
|
|
@labels = main::globber('/dev/disk/by-label/*');
|
|
}
|
|
if (-d '/dev/disk/by-uuid'){
|
|
@uuids = main::globber('/dev/disk/by-uuid/*');
|
|
}
|
|
main::log_data('dump', '@labels', \@labels) if $b_log;
|
|
main::log_data('dump', '@uuids', \@uuids) if $b_log;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# args: 0: blockdev full path (part only); 1: block id; 2: size (part only)
|
|
sub admin_data {
|
|
eval $start if $b_log;
|
|
my ($blockdev,$id,$size) = @_;
|
|
# 0: calc block 1: available percent 2: disk physical block size/partition block size;
|
|
my @sizes = (0,0,0);
|
|
my ($block_size,$percent,$size_raw) = (0,0,0);
|
|
foreach my $row (@proc_partitions){
|
|
if ($row->[-1] eq $id){
|
|
$size_raw = $row->[2];
|
|
last;
|
|
}
|
|
}
|
|
# get the fs block size
|
|
$block_size = (main::grabber("$blockdev --getbsz /dev/$id 2>/dev/null"))[0] if $blockdev;
|
|
if (!$size_raw){
|
|
$size_raw = 'N/A';
|
|
}
|
|
else {
|
|
$percent = sprintf("%.2f", ($size/$size_raw) * 100) if $size && $size_raw;
|
|
}
|
|
# print "$id size: $size %: $percent p-b: $block_size raw: $size_raw\n";
|
|
@sizes = ($size_raw,$percent,$block_size);
|
|
main::log_data('dump','@sizes',\@sizes) if $b_log;
|
|
eval $end if $b_log;
|
|
return @sizes;
|
|
}
|
|
|
|
sub get_maj_min {
|
|
eval $start if $b_log;
|
|
my ($id) = @_;
|
|
my ($maj_min,@working);
|
|
foreach my $row (@proc_partitions){
|
|
if ($id eq $row->[-1]){
|
|
$maj_min = $row->[0] . ':' . $row->[1];
|
|
last;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $maj_min;
|
|
}
|
|
|
|
sub get_label {
|
|
eval $start if $b_log;
|
|
my ($item) = @_;
|
|
my $label = '';
|
|
foreach (@labels){
|
|
if ($item eq Cwd::abs_path($_)){
|
|
$label = $_;
|
|
$label =~ s/\/dev\/disk\/by-label\///;
|
|
$label =~ s/\\x20/ /g;
|
|
$label =~ s%\\x2f%/%g;
|
|
last;
|
|
}
|
|
}
|
|
$label ||= 'N/A';
|
|
eval $end if $b_log;
|
|
return $label;
|
|
}
|
|
|
|
sub get_root {
|
|
eval $start if $b_log;
|
|
my ($path) = ('/dev/root');
|
|
# note: the path may be a symbolic link to by-label/by-uuid but not
|
|
# sure how far in abs_path resolves the path.
|
|
my $temp = Cwd::abs_path($path);
|
|
$path = $temp if $temp;
|
|
# note: it's a kernel config option to have /dev/root be a sym link
|
|
# or not, if it isn't, path will remain /dev/root, if so, then try mount
|
|
if ($path eq '/dev/root' && (my $program = main::check_program('mount'))){
|
|
my @data = main::grabber("$program 2>/dev/null");
|
|
# /dev/sda2 on / type ext4 (rw,noatime,data=ordered)
|
|
foreach (@data){
|
|
if (/^([\S]+)\son\s\/\s/){
|
|
$path = $1;
|
|
# note: we'll be handing off any uuid/label paths to the next
|
|
# check tools after get_root() above, so don't trim those.
|
|
$path =~ s/.*\/// if $path !~ /by-uuid|by-label/;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $path;
|
|
}
|
|
|
|
sub get_uuid {
|
|
eval $start if $b_log;
|
|
my ($item) = @_;
|
|
my $uuid = '';
|
|
foreach (@uuids){
|
|
if ($item eq Cwd::abs_path($_)){
|
|
$uuid = $_;
|
|
$uuid =~ s/\/dev\/disk\/by-uuid\///;
|
|
last;
|
|
}
|
|
}
|
|
$uuid ||= 'N/A';
|
|
eval $end if $b_log;
|
|
return $uuid;
|
|
}
|
|
}
|
|
|
|
## ProcessItem
|
|
{
|
|
package ProcessItem;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my $num = 0;
|
|
my $rows = [];
|
|
if (@ps_aux){
|
|
if ($show{'ps-cpu'}){
|
|
cpu_processes($rows);
|
|
}
|
|
if ($show{'ps-mem'}){
|
|
mem_processes($rows);
|
|
}
|
|
}
|
|
else {
|
|
my $key = 'Message';
|
|
push(@$rows, {
|
|
main::key($num++,0,1,$key) => main::message('ps-data-null','')
|
|
});
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub cpu_processes {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my ($j,$num,$cpu,$cpu_mem,$mem,$pid) = (0,0,'','','','');
|
|
my ($pid_col,@ps_rows);
|
|
my $count = ($b_irc)? 5: $ps_count;
|
|
if ($ps_cols >= 10){
|
|
@ps_rows = sort {
|
|
my @a = split(/\s+/, $a);
|
|
my @b = split(/\s+/, $b);
|
|
$b[2] <=> $a[2] } @ps_aux;
|
|
$pid_col = 1;
|
|
}
|
|
else {
|
|
@ps_rows = @ps_aux;
|
|
$pid_col = 0 if $ps_cols == 2;
|
|
}
|
|
# if there's a count limit, for irc, etc, only use that much of the data
|
|
@ps_rows = splice(@ps_rows,0,$count);
|
|
$j = scalar @ps_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";
|
|
push(@$rows,{
|
|
main::key($num++,1,1,'CPU top') => "$count$throttled" . ' of ' . scalar @ps_aux
|
|
});
|
|
my $i = 1;
|
|
foreach (@ps_rows){
|
|
$num = 1;
|
|
$j = scalar @$rows;
|
|
my @row = split(/\s+/, $_);
|
|
my $command = process_starter(scalar @row, $row[$ps_cols],$row[$ps_cols + 1]);
|
|
$cpu = ($ps_cols >= 10) ? $row[2] . '%': 'N/A';
|
|
push(@$rows,{
|
|
main::key($num++,1,2,$i++) => '',
|
|
main::key($num++,0,3,'cpu') => $cpu,
|
|
main::key($num++,1,3,'command') => $command->[0],
|
|
});
|
|
if ($command->[1]){
|
|
$rows->[$j]{main::key($num++,0,4,'started-by')} = $command->[1];
|
|
}
|
|
$pid = (defined $pid_col)? $row[$pid_col] : 'N/A';
|
|
$rows->[$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] . '%)';
|
|
$rows->[$j]{main::key($num++,0,3,'mem')} = $mem;
|
|
}
|
|
# print Data::Dumper::Dumper \@processes, "i: $i; j: $j ";
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub mem_processes {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my ($j,$num,$cpu,$cpu_mem,$mem,$pid) = (0,0,'','','','');
|
|
my (@data,$pid_col,$memory,@ps_rows);
|
|
my $count = ($b_irc)? 5: $ps_count;
|
|
if ($ps_cols >= 10){
|
|
@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;
|
|
}
|
|
else {
|
|
@ps_rows = @ps_aux;
|
|
$pid_col = 0 if $ps_cols == 2;
|
|
}
|
|
@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,$j);
|
|
#$cpu_mem = ' - CPU: % used' if $extra > 0;
|
|
# my $header = "Memory MiB/% used - Command - pid$cpu_mem - top";
|
|
# my $header = "Top $count by Memory";
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Memory top') => "$count$throttled" . ' of ' . scalar @ps_aux
|
|
});
|
|
my $i = 1;
|
|
foreach (@ps_rows){
|
|
$num = 1;
|
|
$j = scalar @$rows;
|
|
my @row = split(/\s+/, $_);
|
|
if ($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] . "%)";
|
|
}
|
|
else {
|
|
$mem = 'N/A';
|
|
}
|
|
my $command = process_starter(scalar @row, $row[$ps_cols],$row[$ps_cols + 1]);
|
|
push(@$rows,{
|
|
main::key($num++,1,2,$i++) => '',
|
|
main::key($num++,0,3,'mem') => $mem,
|
|
main::key($num++,1,3,'command') => $command->[0],
|
|
});
|
|
if ($command->[1]){
|
|
$rows->[$j]{main::key($num++,0,4,'started-by')} = $command->[1];
|
|
}
|
|
$pid = (defined $pid_col)? $row[$pid_col] : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'pid')} = $pid;
|
|
if ($extra > 0 && $ps_cols >= 10){
|
|
$cpu = $row[2] . '%';
|
|
$rows->[$j]{main::key($num++,0,3,'cpu')} = $cpu;
|
|
}
|
|
# print Data::Dumper::Dumper \@processes, "i: $i; j: $j ";
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub process_starter {
|
|
my ($count, $row10, $row11) = @_;
|
|
my $return = [];
|
|
# note: [migration/0] would clear with a simple basename
|
|
if ($count > ($ps_cols + 1) && $row11 =~ /^\// && $row11 !~ /^\/(tmp|temp)/){
|
|
$row11 =~ s/^\/.*\///;
|
|
$return->[0] = $row11;
|
|
$row10 =~ s/^\/.*\///;
|
|
$return->[1] = $row10;
|
|
}
|
|
else {
|
|
$row10 =~ s/^\/.*\///;
|
|
$return->[0] = $row10;
|
|
$return->[1] = '';
|
|
}
|
|
return $return;
|
|
}
|
|
|
|
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;
|
|
}
|
|
}
|
|
|
|
## RaidItem
|
|
{
|
|
package RaidItem;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my ($hardware_raid,$key1,$val1);
|
|
my $num = 0;
|
|
my $rows = [];
|
|
$hardware_raid = hw_data() if $use{'hardware-raid'} || $fake{'raid-hw'};
|
|
raid_data() if !$loaded{'raid'};
|
|
# print 'get btrfs: ', Data::Dumper::Dumper \@btrfs_raid;
|
|
# print 'get lvm: ', Data::Dumper::Dumper \@lvm_raid;
|
|
# print 'get md: ', Data::Dumper::Dumper \@md_raid;
|
|
# print 'get zfs: ', Data::Dumper::Dumper \@zfs_raid;
|
|
if (!@btrfs_raid && !@lvm_raid && !@md_raid && !@zfs_raid && !@soft_raid &&
|
|
!$hardware_raid){
|
|
if ($show{'raid-forced'}){
|
|
$key1 = 'Message';
|
|
$val1 = main::message('raid-data');
|
|
}
|
|
}
|
|
else {
|
|
if ($hardware_raid){
|
|
hw_output($rows,$hardware_raid);
|
|
}
|
|
if (@btrfs_raid){
|
|
btrfs_output($rows);
|
|
}
|
|
if (@lvm_raid){
|
|
lvm_output($rows);
|
|
}
|
|
if (@md_raid){
|
|
md_output($rows);
|
|
}
|
|
if (@soft_raid){
|
|
soft_output($rows);
|
|
}
|
|
if (@zfs_raid){
|
|
zfs_output($rows);
|
|
}
|
|
}
|
|
if (!@$rows && $key1){
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1,});
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub hw_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$hardware_raid) = @_;
|
|
my ($j,$num) = (0,0);
|
|
foreach my $row (@$hardware_raid){
|
|
$num = 1;
|
|
my $device = ($row->{'device'}) ? $row->{'device'}: 'N/A';
|
|
my $driver = ($row->{'driver'}) ? $row->{'driver'}: 'N/A';
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Hardware') => $device,
|
|
});
|
|
$j = scalar @$rows - 1;
|
|
$rows->[$j]{main::key($num++,0,2,'vendor')} = $row->{'vendor'} if $row->{'vendor'};
|
|
$rows->[$j]{main::key($num++,1,2,'driver')} = $driver;
|
|
if ($extra > 0){
|
|
$row->{'driver-version'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'v')} = $row->{'driver-version'};
|
|
if ($extra > 2){
|
|
my $port= ($row->{'port'}) ? $row->{'port'}: 'N/A' ;
|
|
$rows->[$j]{main::key($num++,0,2,'port')} = $port;
|
|
}
|
|
my $bus_id = (defined $row->{'bus-id'} && defined $row->{'sub-id'}) ? "$row->{'bus-id'}.$row->{'sub-id'}": 'N/A' ;
|
|
$rows->[$j]{main::key($num++,0,2,'bus-ID')} = $bus_id;
|
|
}
|
|
if ($extra > 1){
|
|
my $chip_id = main::get_chip_id($row->{'vendor-id'},$row->{'chip-id'});
|
|
$rows->[$j]{main::key($num++,0,2,'chip-ID')} = $chip_id;
|
|
}
|
|
if ($extra > 2){
|
|
$row->{'rev'} = 'N/A' if !defined $row->{'rev'}; # could be 0
|
|
$rows->[$j]{main::key($num++,0,2,'rev')} = $row->{'rev'};
|
|
$rows->[$j]{main::key($num++,0,2,'class-ID')} = $row->{'class-id'} if $row->{'class-id'};
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
# print Data::Dumper::Dumper $rows;
|
|
}
|
|
|
|
sub btrfs_output {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my (@components,@good);
|
|
my ($size);
|
|
my ($j,$num) = (0,0);
|
|
foreach my $row (sort {$a->{'id'} cmp $b->{'id'}} @btrfs_raid){
|
|
$j = scalar @$rows;
|
|
$rows->[$j]{main::key($num++,1,2,'Components')} = '';
|
|
my $b_bump;
|
|
components_output('lvm','Online',$rows,\@good,\$j,\$num,\$b_bump);
|
|
components_output('lvm','Meta',$rows,\@components,\$j,\$num,\$b_bump);
|
|
}
|
|
eval $end if $b_log;
|
|
# print Data::Dumper::Dumper $rows;
|
|
}
|
|
|
|
sub lvm_output {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my (@components,@good,@components_meta);
|
|
my ($size);
|
|
my ($j,$num) = (0,0);
|
|
foreach my $row (sort {$a->{'id'} cmp $b->{'id'}} @lvm_raid){
|
|
$j = scalar @$rows;
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $row->{'id'},
|
|
});
|
|
if ($b_admin && $row->{'maj-min'}){
|
|
$rows->[$j]{main::key($num++,0,2,'maj-min')} = $row->{'maj-min'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'type')} = $row->{'type'};
|
|
$rows->[$j]{main::key($num++,0,2,'level')} = $row->{'level'};
|
|
$size = ($row->{'size'}) ? main::get_size($row->{'size'},'string'): 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'size')} = $size;
|
|
if ($row->{'raid-sync'}){
|
|
$rows->[$j]{main::key($num++,0,2,'sync')} = $row->{'raid-sync'};
|
|
}
|
|
if ($extra > 0){
|
|
$j = scalar @$rows;
|
|
$num = 1;
|
|
$rows->[$j]{main::key($num++,1,2,'Info')} = '';
|
|
if (defined $row->{'stripes'}){
|
|
$rows->[$j]{main::key($num++,0,3,'stripes')} = $row->{'stripes'};
|
|
}
|
|
if (defined $row->{'raid-mismatches'} && ($extra > 1 || $row->{'raid-mismatches'} > 0)){
|
|
$rows->[$j]{main::key($num++,0,3,'mismatches')} = $row->{'raid-mismatches'};
|
|
}
|
|
if (defined $row->{'copy-percent'} && ($extra > 1 || $row->{'copy-percent'} < 100)){
|
|
$rows->[$j]{main::key($num++,0,3,'copied')} = ($row->{'copy-percent'} + 0) . '%';
|
|
}
|
|
if ($row->{'vg'}){
|
|
$rows->[$j]{main::key($num++,1,3,'v-group')} = $row->{'vg'};
|
|
}
|
|
$size = ($row->{'vg-size'}) ? main::get_size($row->{'vg-size'},'string') : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,4,'vg-size')} = $size;
|
|
$size = ($row->{'vg-free'}) ? main::get_size($row->{'vg-free'},'string') : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,4,'vg-free')} = $size;
|
|
}
|
|
@components = (ref $row->{'components'} eq 'ARRAY') ? @{$row->{'components'}} : ();
|
|
@good = ();
|
|
@components_meta = ();
|
|
foreach my $item (sort { $a->[0] cmp $b->[0]} @components){
|
|
if ($item->[4] =~ /_rmeta/){
|
|
push(@components_meta, $item);
|
|
}
|
|
else {
|
|
push(@good, $item);
|
|
}
|
|
}
|
|
$j = scalar @$rows;
|
|
$rows->[$j]{main::key($num++,1,2,'Components')} = '';
|
|
my $b_bump;
|
|
components_output('lvm','Online',$rows,\@good,\$j,\$num,\$b_bump);
|
|
components_output('lvm','Meta',$rows,\@components_meta,\$j,\$num,\$b_bump);
|
|
}
|
|
eval $end if $b_log;
|
|
# print Data::Dumper::Dumper $rows;
|
|
}
|
|
|
|
sub md_output {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my (@components,@good,@failed,@inactive,@spare,@temp);
|
|
my ($blocks,$chunk,$level,$report,$size,$status);
|
|
my ($j,$num) = (0,0);
|
|
# print Data::Dumper::Dumper \@md_raid;
|
|
if ($extra > 2 && $md_raid[0]->{'supported-levels'}){
|
|
push(@$rows, {
|
|
main::key($num++,0,1,'Supported mdraid levels') => $md_raid[0]->{'supported-levels'},
|
|
});
|
|
}
|
|
foreach my $row (sort {$a->{'id'} cmp $b->{'id'}} @md_raid){
|
|
$j = scalar @$rows;
|
|
next if !%$row;
|
|
$num = 1;
|
|
$level = (defined $row->{'level'}) ? $row->{'level'} : 'linear';
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $row->{'id'},
|
|
});
|
|
if ($b_admin && $row->{'maj-min'}){
|
|
$rows->[$j]{main::key($num++,0,2,'maj-min')} = $row->{'maj-min'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'type')} = $row->{'type'};
|
|
$rows->[$j]{main::key($num++,0,2,'level')} = $level;
|
|
$rows->[$j]{main::key($num++,0,2,'status')} = $row->{'status'};
|
|
if ($row->{'details'}{'state'}){
|
|
$rows->[$j]{main::key($num++,0,2,'state')} = $row->{'details'}{'state'};
|
|
}
|
|
if ($row->{'size'}){
|
|
$size = main::get_size($row->{'size'},'string');
|
|
}
|
|
else {
|
|
$size = (!$b_root && !@lsblk) ? main::message('root-required'): 'N/A';
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'size')} = $size;
|
|
$report = ($row->{'report'}) ? $row->{'report'}: '';
|
|
$report .= " $row->{'u-data'}" if $report;
|
|
$report ||= 'N/A';
|
|
if ($extra == 0){
|
|
# print "here 0\n";
|
|
$rows->[$j]{main::key($num++,0,2,'report')} = $report;
|
|
}
|
|
if ($extra > 0){
|
|
$j = scalar @$rows;
|
|
$num = 1;
|
|
$rows->[$j]{main::key($num++,1,2,'Info')} = '';
|
|
#$rows->[$j]{main::key($num++,0,3,'raid')} = $raid;
|
|
$rows->[$j]{main::key($num++,0,3,'report')} = $report;
|
|
$blocks = ($row->{'blocks'}) ? $row->{'blocks'} : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'blocks')} = $blocks;
|
|
$chunk = ($row->{'chunk-size'}) ? $row->{'chunk-size'} : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'chunk-size')} = $chunk;
|
|
if ($extra > 1){
|
|
if ($row->{'bitmap'}){
|
|
$rows->[$j]{main::key($num++,0,3,'bitmap')} = $row->{'bitmap'};
|
|
}
|
|
if ($row->{'super-block'}){
|
|
$rows->[$j]{main::key($num++,0,3,'super-blocks')} = $row->{'super-block'};
|
|
}
|
|
if ($row->{'algorithm'}){
|
|
$rows->[$j]{main::key($num++,0,3,'algorithm')} = $row->{'algorithm'};
|
|
}
|
|
}
|
|
}
|
|
@components = (ref $row->{'components'} eq 'ARRAY') ? @{$row->{'components'}} : ();
|
|
@good = ();
|
|
@failed = ();
|
|
@inactive = ();
|
|
@spare = ();
|
|
# @spare = split(/\s+/, $row->{'unused'}) if $row->{'unused'};
|
|
# print Data::Dumper::Dumper \@components;
|
|
foreach my $item (sort { $a->[1] <=> $b->[1]} @components){
|
|
if (defined $item->[2] && $item->[2] =~ /^(F)$/){
|
|
push(@failed,$item);
|
|
}
|
|
elsif (defined $item->[2] && $item->[2] =~ /(S)$/){
|
|
push(@spare,$item);
|
|
}
|
|
elsif ($row->{'status'} && $row->{'status'} eq 'inactive'){
|
|
push(@inactive,$item);
|
|
}
|
|
else {
|
|
push(@good,$item);
|
|
}
|
|
}
|
|
$j = scalar @$rows;
|
|
$rows->[$j]{main::key($num++,1,2,'Components')} = '';
|
|
my $b_bump;
|
|
components_output('mdraid','Online',$rows,\@good,\$j,\$num,\$b_bump);
|
|
components_output('mdraid','Failed',$rows,\@failed,\$j,\$num,\$b_bump);
|
|
components_output('mdraid','Inactive',$rows,\@inactive,\$j,\$num,\$b_bump);
|
|
components_output('mdraid','Spare',$rows,\@spare,\$j,\$num,\$b_bump);
|
|
if ($row->{'recovery-percent'}){
|
|
$j = scalar @$rows;
|
|
$num = 1;
|
|
my $percent = $row->{'recovery-percent'};
|
|
if ($extra > 1 && $row->{'progress-bar'}){
|
|
$percent .= " $row->{'progress-bar'}"
|
|
}
|
|
$rows->[$j]{main::key($num++,1,2,'Recovering')} = $percent;
|
|
my $finish = ($row->{'recovery-finish'})?$row->{'recovery-finish'} : 'N/A';
|
|
$rows->[$j]{main::key($num++,0,3,'time-remaining')} = $finish;
|
|
if ($extra > 0){
|
|
if ($row->{'sectors-recovered'}){
|
|
$rows->[$j]{main::key($num++,0,3,'sectors')} = $row->{'sectors-recovered'};
|
|
}
|
|
}
|
|
if ($extra > 1 && $row->{'recovery-speed'}){
|
|
$rows->[$j]{main::key($num++,0,3,'speed')} = $row->{'recovery-speed'};
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
# print Data::Dumper::Dumper $rows;
|
|
}
|
|
|
|
sub soft_output {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my (@components,@good,@failed,@offline,@rebuild,@temp);
|
|
my ($size);
|
|
my ($j,$num) = (0,0);
|
|
if (@soft_raid && $alerts{'bioctl'}->{'action'} eq 'permissions'){
|
|
push(@$rows,{
|
|
main::key($num++,1,1,'Message') => main::message('root-item-incomplete','softraid'),
|
|
});
|
|
}
|
|
# print Data::Dumper::Dumper \@soft_raid;
|
|
foreach my $row (sort {$a->{'id'} cmp $b->{'id'}} @soft_raid){
|
|
$j = scalar @$rows;
|
|
next if !%$row;
|
|
$num = 1;
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $row->{'id'},
|
|
});
|
|
$row->{'level'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'type')} = $row->{'type'};
|
|
$rows->[$j]{main::key($num++,0,2,'level')} = $row->{'level'};
|
|
$rows->[$j]{main::key($num++,0,2,'status')} = $row->{'status'};
|
|
if ($row->{'state'}){
|
|
$rows->[$j]{main::key($num++,0,2,'state')} = $row->{'state'};
|
|
}
|
|
if ($row->{'size'}){
|
|
$size = main::get_size($row->{'size'},'string');
|
|
}
|
|
$size ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'size')} = $size;
|
|
@components = (ref $row->{'components'} eq 'ARRAY') ? @{$row->{'components'}} : ();
|
|
@good = ();
|
|
@failed = ();
|
|
@offline = ();
|
|
@rebuild = ();
|
|
foreach my $item (sort { $a->[1] <=> $b->[1]} @components){
|
|
if (defined $item->[2] && $item->[2] eq 'failed'){
|
|
push(@failed,$item);
|
|
}
|
|
elsif (defined $item->[2] && $item->[2] eq 'offline'){
|
|
push(@offline,$item);
|
|
}
|
|
elsif (defined $item->[2] && $item->[2] eq 'rebuild'){
|
|
push(@rebuild,$item);
|
|
}
|
|
else {
|
|
push(@good,$item);
|
|
}
|
|
}
|
|
$j = scalar @$rows;
|
|
$rows->[$j]{main::key($num++,1,2,'Components')} = '';
|
|
my $b_bump;
|
|
components_output('softraid','Online',$rows,\@good,\$j,\$num,\$b_bump);
|
|
components_output('softraid','Failed',$rows,\@failed,\$j,\$num,\$b_bump);
|
|
components_output('softraid','Rebuild',$rows,\@rebuild,\$j,\$num,\$b_bump);
|
|
components_output('softraid','Offline',$rows,\@offline,\$j,\$num,\$b_bump);
|
|
}
|
|
eval $end if $b_log;
|
|
# print Data::Dumper::Dumper $rows;
|
|
}
|
|
|
|
sub zfs_output {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my (@arrays,@arrays_holder,@components,@good,@failed,@spare);
|
|
my ($allocated,$available,$level,$size,$status);
|
|
my ($b_row_1_sizes);
|
|
my ($j,$num) = (0,0);
|
|
# print Data::Dumper::Dumper \@zfs_raid;
|
|
foreach my $row (sort {$a->{'id'} cmp $b->{'id'}} @zfs_raid){
|
|
$j = scalar @$rows;
|
|
$b_row_1_sizes = 0;
|
|
next if !%$row;
|
|
$num = 1;
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Device') => $row->{'id'},
|
|
main::key($num++,0,2,'type') => $row->{'type'},
|
|
main::key($num++,0,2,'status') => $row->{'status'},
|
|
});
|
|
$size = ($row->{'raw-size'}) ? main::get_size($row->{'raw-size'},'string') : '';
|
|
$available = main::get_size($row->{'raw-free'},'string',''); # could be zero free
|
|
if ($extra > 2){
|
|
$allocated = ($row->{'raw-allocated'}) ? main::get_size($row->{'raw-allocated'},'string') : '';
|
|
}
|
|
@arrays = @{$row->{'arrays'}};
|
|
@arrays = grep {defined $_} @arrays;
|
|
@arrays_holder = @arrays;
|
|
my $count = scalar @arrays;
|
|
if (!defined $arrays[0]->{'level'}){
|
|
$level = 'linear';
|
|
$rows->[$j]{main::key($num++,0,2,'level')} = $level;
|
|
}
|
|
elsif ($count < 2 && $arrays[0]->{'level'}){
|
|
$rows->[$j]{main::key($num++,0,2,'level')} = $arrays[0]->{'level'};
|
|
}
|
|
if ($size || $available || $allocated){
|
|
$rows->[$j]{main::key($num++,1,2,'raw')} = '';
|
|
if ($size){
|
|
# print "here 0\n";
|
|
$rows->[$j]{main::key($num++,0,3,'size')} = $size;
|
|
$size = '';
|
|
$b_row_1_sizes = 1;
|
|
}
|
|
if ($available){
|
|
$rows->[$j]{main::key($num++,0,3,'free')} = $available;
|
|
$available = '';
|
|
$b_row_1_sizes = 1;
|
|
}
|
|
if ($allocated){
|
|
$rows->[$j]{main::key($num++,0,3,'allocated')} = $allocated;
|
|
$allocated = '';
|
|
}
|
|
}
|
|
if ($row->{'zfs-size'}){
|
|
$rows->[$j]{main::key($num++,1,2,'zfs-fs')} = '';
|
|
$rows->[$j]{main::key($num++,0,3,'size')} = main::get_size($row->{'zfs-size'},'string');
|
|
$rows->[$j]{main::key($num++,0,3,'free')} = main::get_size($row->{'zfs-free'},'string');
|
|
}
|
|
foreach my $row2 (@arrays){
|
|
if ($count > 1){
|
|
$j = scalar @$rows;
|
|
$num = 1;
|
|
$size = ($row2->{'raw-size'}) ? main::get_size($row2->{'raw-size'},'string') : 'N/A';
|
|
$available = ($row2->{'raw-free'}) ? main::get_size($row2->{'raw-free'},'string') : 'N/A';
|
|
$level = (defined $row2->{'level'}) ? $row2->{'level'}: 'linear';
|
|
$status = ($row2->{'status'}) ? $row2->{'status'}: 'N/A';
|
|
push(@$rows, {
|
|
main::key($num++,1,2,'Array') => $level,
|
|
main::key($num++,0,3,'status') => $status,
|
|
main::key($num++,1,3,'raw') => '',
|
|
main::key($num++,0,4,'size') => $size,
|
|
main::key($num++,0,4,'free') => $available,
|
|
});
|
|
}
|
|
# items like cache may have one component, with a size on that component
|
|
elsif (!$b_row_1_sizes){
|
|
# print "here $count\n";
|
|
$size = ($row2->{'raw-size'}) ? main::get_size($row2->{'raw-size'},'string') : 'N/A';
|
|
$available = ($row2->{'raw-free'}) ? main::get_size($row2->{'raw-free'},'string') : 'N/A';
|
|
$rows->[$j]{main::key($num++,1,2,'raw')} = '';
|
|
$rows->[$j]{main::key($num++,0,3,'size')} = $size;
|
|
$rows->[$j]{main::key($num++,0,3,'free')} = $available;
|
|
if ($extra > 2){
|
|
$allocated = ($row2->{'raw-allocated'}) ? main::get_size($row2->{'raw-allocated'},'string') : '';
|
|
if ($allocated){
|
|
$rows->[$j]{main::key($num++,0,3,'allocated')} = $allocated;
|
|
}
|
|
}
|
|
}
|
|
@components = (ref $row2->{'components'} eq 'ARRAY') ? @{$row2->{'components'}} : ();
|
|
@failed = ();
|
|
@spare = ();
|
|
@good = ();
|
|
# @spare = split(/\s+/, $row->{'unused'}) if $row->{'unused'};
|
|
foreach my $item (sort { $a->[0] cmp $b->[0]} @components){
|
|
if (defined $item->[3] && $item->[3] =~ /^(DEGRADED|FAULTED|UNAVAIL)$/){
|
|
push(@failed, $item);
|
|
}
|
|
elsif (defined $item->[3] && $item->[3] =~ /(AVAIL|OFFLINE|REMOVED)$/){
|
|
push(@spare, $item);
|
|
}
|
|
# note: spares in use show: INUSE but technically it's still a spare,
|
|
# but since it's in use, consider it online.
|
|
else {
|
|
push(@good, $item);
|
|
}
|
|
}
|
|
$j = scalar @$rows;
|
|
$rows->[$j]{main::key($num++,1,3,'Components')} = '';
|
|
my $b_bump;
|
|
components_output('zfs','Online',$rows,\@good,\$j,\$num,\$b_bump);
|
|
components_output('zfs','Failed',$rows,\@failed,\$j,\$num,\$b_bump);
|
|
components_output('zfs','Available',$rows,\@spare,\$j,\$num,\$b_bump);
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
# print Data::Dumper::Dumper $rows;
|
|
}
|
|
|
|
# Most key stuff passed by ref, and is changed on the fly
|
|
sub components_output {
|
|
eval $start if $b_log;
|
|
my ($type,$item,$rows,$array,$j,$num,$b_bump) = @_;
|
|
return if !@$array && $item ne 'Online';
|
|
my ($extra1,$extra2,$f1,$f2,$f3,$f4,$f5,$k,$k1,$key1,$l1,$l2,$l3);
|
|
if ($type eq 'btrfs'){
|
|
|
|
}
|
|
elsif ($type eq 'lvm'){
|
|
($f1,$f2,$f3,$f4,$f5,$l1,$l2,$l3) = (1,2,3,4,5,3,4,5);
|
|
$k = 1;
|
|
$extra1 = 'mapped';
|
|
$extra2 = 'dev';
|
|
}
|
|
elsif ($type eq 'mdraid'){
|
|
($f1,$f2,$f3,$f4,$k1,$l1,$l2,$l3) = (3,4,5,6,1,3,4,5);
|
|
$extra1 = 'mapped';
|
|
$k = 1 if $item eq 'Inactive';
|
|
}
|
|
elsif ($type eq 'softraid'){
|
|
($f1,$f2,$f3,$f4,$k1,$l1,$l2,$l3) = (1,10,10,3,5,3,4,5);
|
|
$extra1 = 'device';
|
|
$k = 1;
|
|
}
|
|
elsif ($type eq 'zfs'){
|
|
($f1,$f2,$f3,$l1,$l2,$l3) = (1,2,3,4,5,6);
|
|
$k = 1;
|
|
}
|
|
# print "item: $item\n";
|
|
$$j++ if $$b_bump;
|
|
$$b_bump = 0;
|
|
my $good = ($item eq 'Online' && !@$array) ? 'N/A' : '';
|
|
$rows->[$$j]{main::key($$num++,1,$l1,$item)} = $good;
|
|
#$$j++ if $b_admin;
|
|
# print Data::Dumper::Dumper $array;
|
|
foreach my $device (@$array){
|
|
next if ref $device ne 'ARRAY';
|
|
# if ($b_admin && $device->[$f1] && $device->[$f2]){
|
|
if ($b_admin){
|
|
$$j++;
|
|
$$b_bump = 1;
|
|
$$num = 1;
|
|
}
|
|
$key1 = (defined $k1 && defined $device->[$k1]) ? $device->[$k1] : $k++;
|
|
$rows->[$$j]{main::key($$num++,1,$l2,$key1)} = $device->[0];
|
|
if ($b_admin && $device->[$f2]){
|
|
$rows->[$$j]{main::key($$num++,0,$l3,'maj-min')} = $device->[$f2];
|
|
}
|
|
if ($b_admin && $device->[$f1]){
|
|
my $size = main::get_size($device->[$f1],'string');
|
|
$rows->[$$j]{main::key($$num++,0,$l3,'size')} = $size;
|
|
}
|
|
if ($b_admin && $device->[$f3]){
|
|
$rows->[$$j]{main::key($$num++,0,$l3,'state')} = $device->[$f3];
|
|
}
|
|
if ($b_admin && $extra1 && $device->[$f4]){
|
|
$rows->[$$j]{main::key($$num++,0,$l3,$extra1)} = $device->[$f4];
|
|
}
|
|
if ($b_admin && $extra2 && $device->[$f5]){
|
|
$rows->[$$j]{main::key($$num++,0,$l3,$extra2)} = $device->[$f5];
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub raid_data {
|
|
eval $start if $b_log;
|
|
LsblkData::set() if !$bsd_type && !$loaded{'lsblk'};
|
|
main::set_mapper() if !$bsd_type && !$loaded{'mapper'};
|
|
PartitionData::set() if !$bsd_type && !$loaded{'partition-data'};
|
|
my (@data);
|
|
$loaded{'raid'} = 1;
|
|
if ($fake{'raid-btrfs'} ||
|
|
($alerts{'btrfs'}->{'action'} && $alerts{'btrfs'}->{'action'} eq 'use')){
|
|
@btrfs_raid = btrfs_data();
|
|
}
|
|
if ($fake{'raid-lvm'} ||
|
|
($alerts{'lvs'}->{'action'} && $alerts{'lvs'}->{'action'} eq 'use')){
|
|
@lvm_raid = lvm_data();
|
|
}
|
|
if ($fake{'raid-md'} || (my $file = $system_files{'proc-mdstat'})){
|
|
@md_raid = md_data($file);
|
|
}
|
|
if ($fake{'raid-soft'} || $sysctl{'softraid'}){
|
|
DiskDataBSD::set() if !$loaded{'disk-data-bsd'};
|
|
@soft_raid = soft_data();
|
|
}
|
|
if ($fake{'raid-zfs'} || (my $path = main::check_program('zpool'))){
|
|
DiskDataBSD::set() if $bsd_type && !$loaded{'disk-data-bsd'};
|
|
@zfs_raid = zfs_data($path);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# 0: type
|
|
# 1: type_id
|
|
# 2: bus_id
|
|
# 3: sub_id
|
|
# 4: device
|
|
# 5: vendor_id
|
|
# 6: chip_id
|
|
# 7: rev
|
|
# 8: port
|
|
# 9: driver
|
|
# 10: modules
|
|
sub hw_data {
|
|
eval $start if $b_log;
|
|
return if !$devices{'hwraid'};
|
|
my ($driver,$vendor,$hardware_raid);
|
|
foreach my $working (@{$devices{'hwraid'}}){
|
|
$driver = ($working->[9]) ? lc($working->[9]): '';
|
|
$driver =~ s/-/_/g if $driver;
|
|
my $driver_version = ($driver) ? main::get_module_version($driver): '';
|
|
if ($extra > 2 && $use{'pci-tool'} && $working->[11]){
|
|
$vendor = main::get_pci_vendor($working->[4],$working->[11]);
|
|
}
|
|
push(@$hardware_raid, {
|
|
'class-id' => $working->[1],
|
|
'bus-id' => $working->[2],
|
|
'chip-id' => $working->[6],
|
|
'device' => $working->[4],
|
|
'driver' => $driver,
|
|
'driver-version' => $driver_version,
|
|
'port' => $working->[8],
|
|
'rev' => $working->[7],
|
|
'sub-id' => $working->[3],
|
|
'vendor-id' => $working->[5],
|
|
'vendor' => $vendor,
|
|
});
|
|
}
|
|
# print Data::Dumper::Dumper $hardware_raid;
|
|
main::log_data('dump','@$hardware_raid',$hardware_raid) if $b_log;
|
|
eval $end if $b_log;
|
|
return $hardware_raid;
|
|
}
|
|
|
|
# Placeholder, if they ever get useful tools
|
|
sub btrfs_data {
|
|
eval $start if $b_log;
|
|
my (@btraid,@working);
|
|
if ($fake{'raid-btrfs'}){
|
|
|
|
}
|
|
else {
|
|
|
|
}
|
|
print Data::Dumper::Dumper \@working if $dbg[37];
|
|
print Data::Dumper::Dumper \@btraid if $dbg[37];
|
|
main::log_data('dump','@lvraid',\@btraid) if $b_log;
|
|
eval $end if $b_log;
|
|
return @btraid;
|
|
}
|
|
|
|
sub lvm_data {
|
|
eval $start if $b_log;
|
|
LogicalItem::lvm_data() if !$loaded{'logical-data'};
|
|
return if !@lvm;
|
|
my (@lvraid,$maj_min,$vg_used,@working);
|
|
foreach my $item (@lvm){
|
|
next if $item->{'segtype'} && $item->{'segtype'} !~ /^raid/;
|
|
my (@components,$dev,$maj_min,$vg_used);
|
|
# print Data::Dumper::Dumper $item;
|
|
if ($item->{'lv_kernel_major'} . ':' . $item->{'lv_kernel_minor'}){
|
|
$maj_min = $item->{'lv_kernel_major'} . ':' . $item->{'lv_kernel_minor'};
|
|
}
|
|
if (defined $item->{'vg_free'} && defined $item->{'vg_size'}){
|
|
$vg_used = ($item->{'vg_size'} - $item->{'vg_free'});
|
|
}
|
|
$raw_logical[0] += $item->{'lv_size'} if $item->{'lv_size'};
|
|
@working = main::globber("/sys/dev/block/$maj_min/slaves/*") if $maj_min;
|
|
@working = map {$_ =~ s|^/.*/||; $_;} @working if @working;
|
|
foreach my $part (@working){
|
|
my ($dev,$maj_min,$mapped,$size);
|
|
if (@proc_partitions){
|
|
my $info = PartitionData::get($part);
|
|
$maj_min = $info->[0] . ':' . $info->[1] if defined $info->[1];
|
|
$size = $info->[2];
|
|
$raw_logical[1] += $size if $part =~ /^dm-/ && $size;
|
|
my @data = main::globber("/sys/dev/block/$maj_min/slaves/*") if $maj_min;
|
|
@data = map {$_ =~ s|^/.*/||; $_;} @data if @data;
|
|
$dev = join(',', @data) if @data;
|
|
}
|
|
$mapped = $dmmapper{$part} if %dmmapper;
|
|
push(@components, [$part,$size,$maj_min,undef,$mapped,$dev],);
|
|
}
|
|
if ($item->{'segtype'}){
|
|
if ($item->{'segtype'} eq 'raid1'){$item->{'segtype'} = 'mirror';}
|
|
else {$item->{'segtype'} =~ s/^raid([0-9]+)/raid-$1/;}
|
|
}
|
|
push(@lvraid, {
|
|
'components' => \@components,
|
|
'copy-percent' => $item->{'copy_percent'},
|
|
'id' => $item->{'lv_name'},
|
|
'level' => $item->{'segtype'},
|
|
'maj-min' => $maj_min,
|
|
'raid-mismatches' => $item->{'raid_mismatch_count'},
|
|
'raid-sync' => $item->{'raid_sync_action'},
|
|
'size' => $item->{'lv_size'},
|
|
'stripes' => $item->{'stripes'},
|
|
'type' => $item->{'vg_fmt'},
|
|
'vg' => $item->{'vg_name'},
|
|
'vg-free' => $item->{'vg_free'},
|
|
'vg-size' => $item->{'vg_size'},
|
|
'vg-used' => $vg_used,
|
|
});
|
|
}
|
|
print Data::Dumper::Dumper \@lvraid if $dbg[37];
|
|
main::log_data('dump','@lvraid',\@lvraid) if $b_log;
|
|
eval $end if $b_log;
|
|
return @lvraid;
|
|
}
|
|
|
|
sub md_data {
|
|
eval $start if $b_log;
|
|
my ($mdstat) = @_;
|
|
my $j = 0;
|
|
if ($fake{'raid-md'}){
|
|
#$mdstat = "$fake_data_dir/raid-logical/md/md-4-device-1.txt";
|
|
#$mdstat = "$fake_data_dir/raid-logical/md/md-rebuild-1.txt";
|
|
#$mdstat = "$fake_data_dir/raid-logical/md/md-2-mirror-fserver2-1.txt";
|
|
#$mdstat = "$fake_data_dir/raid-logical/md/md-2-raid10-abucodonosor.txt";
|
|
#$mdstat = "$fake_data_dir/raid-logical/md/md-2-raid10-ant.txt";
|
|
#$mdstat = "$fake_data_dir/raid-logical/md/md-inactive-weird-syntax.txt";
|
|
#$mdstat = "$fake_data_dir/raid-logical/md/md-inactive-active-syntax.txt";
|
|
#$mdstat = "$fake_data_dir/raid-logical/md/md-inactive-active-spare-syntax.txt";
|
|
}
|
|
my @working = main::reader($mdstat,'strip');
|
|
# print Data::Dumper::Dumper \@working;
|
|
my (@mdraid,@temp,$b_found,$system,$unused);
|
|
# NOTE: a system with empty mdstat will not show these values
|
|
if ($working[0] && $working[0] =~ /^Personalities/){
|
|
$system = (split(/:\s*/, $working[0]))[1];
|
|
$system =~ s/\[|\]//g if $system;
|
|
shift @working;
|
|
}
|
|
if ($working[-1] && $working[-1] =~ /^unused\sdevices/){
|
|
$unused = (split(/:\s*/, $working[-1]))[1];
|
|
$unused =~ s/<|>|none//g if $unused;
|
|
pop @working;
|
|
}
|
|
foreach (@working){
|
|
$_ =~ s/\s*:\s*/:/;
|
|
# print "$_\n";
|
|
# md0 : active raid1 sdb1[2] sda1[0]
|
|
# md126 : active (auto-read-only) raid1 sdq1[0]
|
|
# md127 : inactive sda0
|
|
# md1 : inactive sda1[0] sdd1[3] sdc1[2] sdb1[1]
|
|
# if (/^(md[0-9]+)\s*:\s*([^\s]+)(\s\([^)]+\))?\s([^\s]+)\s(.*)/){
|
|
if (/^(md[0-9]+)\s*:\s*([\S]+)(\s\([^)]+\))?/){
|
|
my ($component_string,$details,$device,$id,$level,$maj_min,$part,$size,$status);
|
|
my (@components);
|
|
$id = $1;
|
|
$status = $2;
|
|
if (/^(md[0-9]+)\s*:\s*([\S]+)(\s\([^)]+\))?\s((faulty|linear|multipath|raid)[\S]*)\s(.*)/){
|
|
$level = $4;
|
|
$component_string = $6;
|
|
$level =~ s/^raid1$/mirror/;
|
|
$level =~ s/^raid/raid-/;
|
|
$level = 'mirror' if $level eq '1';
|
|
}
|
|
elsif (/^(md[0-9]+)\s*:\s*([\S]+)(\s\([^)]+\))?\s(.*)/){
|
|
$component_string = $4;
|
|
$level = 'N/A';
|
|
}
|
|
@temp = ();
|
|
# cascade of tests, light to cpu intense
|
|
if ((!$maj_min || !$size) && @proc_partitions){
|
|
$part = PartitionData::get($id);
|
|
if (@$part){
|
|
$maj_min = $part->[0] . ':' . $part->[1];
|
|
$size = $part->[2];
|
|
}
|
|
}
|
|
if ((!$maj_min || !$size) && @lsblk){
|
|
$device = LsblkData::get($id) if @lsblk;
|
|
$maj_min = $device->{'maj-min'} if $device->{'maj-min'};
|
|
$size = $device->{'size'} if $device->{'size'};
|
|
}
|
|
if ((!$size || $b_admin) && $alerts{'mdadm'}->{'action'} eq 'use'){
|
|
$details = md_details($id);
|
|
$size = $details->{'size'} if $details->{'size'};
|
|
}
|
|
$raw_logical[0] += $size if $size;
|
|
# remember, these include the [x] id, so remove that for disk/unmounted
|
|
foreach my $component (split(/\s+/, $component_string)){
|
|
my (%data,$maj_min,$name,$number,$info,$mapped,$part_size,$state);
|
|
if ($component =~ /([\S]+)\[([0-9]+)\]\(?([SF])?\)?/){
|
|
($name,$number,$info) = ($1,$2,$3);
|
|
}
|
|
elsif ($component =~ /([\S]+)/){
|
|
$name = $1;
|
|
}
|
|
next if !$name;
|
|
if ($details->{'devices'} && ref $details->{'devices'} eq 'HASH'){
|
|
$maj_min = $details->{'devices'}{$name}{'maj-min'};
|
|
$state = $details->{'devices'}{$name}{'state'};
|
|
}
|
|
if ((!$maj_min || !$part_size) && @proc_partitions){
|
|
$part = PartitionData::get($name);
|
|
if (@$part){
|
|
$maj_min = $part->[0] . ':' . $part->[1] if !$maj_min;
|
|
$part_size = $part->[2] if !$part_size;
|
|
}
|
|
}
|
|
if ((!$maj_min || !$part_size) && @lsblk){
|
|
%data= LsblkData::get($name);
|
|
$maj_min = $data{'maj-min'} if !$maj_min;
|
|
$part_size = $data{'size'}if !$part_size;
|
|
}
|
|
$mapped = $dmmapper{$name} if %dmmapper;
|
|
$raw_logical[1] += $part_size if $part_size;
|
|
$state = $info if !$state && $info;
|
|
push(@components,[$name,$number,$info,$part_size,$maj_min,$state,$mapped]);
|
|
}
|
|
# print "$component_string\n";
|
|
$j = scalar @mdraid;
|
|
push(@mdraid, {
|
|
'chunk-size' => $details->{'chunk-size'}, # if we got it, great, if not, further down
|
|
'components' => \@components,
|
|
'details' => $details,
|
|
'id' => $id,
|
|
'level' => $level,
|
|
'maj-min' => $maj_min,
|
|
'size' => $size,
|
|
'status' => $status,
|
|
'type' => 'mdraid',
|
|
});
|
|
}
|
|
# print "$_\n";
|
|
if ($_ =~ /^([0-9]+)\sblocks/){
|
|
$mdraid[$j]->{'blocks'} = $1;
|
|
}
|
|
if ($_ =~ /super\s([0-9\.]+)\s/){
|
|
$mdraid[$j]->{'super-block'} = $1;
|
|
}
|
|
if ($_ =~ /algorithm\s([0-9\.]+)\s/){
|
|
$mdraid[$j]->{'algorithm'} = $1;
|
|
}
|
|
if ($_ =~ /\[([0-9]+\/[0-9]+)\]\s\[([U_]+)\]/){
|
|
$mdraid[$j]->{'report'} = $1;
|
|
$mdraid[$j]->{'u-data'} = $2;
|
|
}
|
|
if ($_ =~ /resync=([\S]+)/){
|
|
$mdraid[$j]->{'resync'} = $1;
|
|
}
|
|
if ($_ =~ /([0-9]+[km])\schunk/i){
|
|
$mdraid[$j]->{'chunk-size'} = $1;
|
|
}
|
|
if ($_ =~ /(\[[=]*>[\.]*\]).*(resync|recovery)\s*=\s*([0-9\.]+%)?(\s\(([0-9\/]+)\))?/){
|
|
$mdraid[$j]->{'progress-bar'} = $1;
|
|
$mdraid[$j]->{'recovery-percent'} = $3 if $3;
|
|
$mdraid[$j]->{'sectors-recovered'} = $5 if $5;
|
|
}
|
|
if ($_ =~ /finish\s*=\s*([\S]+)\s+speed\s*=\s*([\S]+)/){
|
|
$mdraid[$j]->{'recovery-finish'} = $1;
|
|
$mdraid[$j]->{'recovery-speed'} = $2;
|
|
}
|
|
# print 'mdraid loop: ', Data::Dumper::Dumper \@mdraid;
|
|
}
|
|
if (@mdraid){
|
|
$mdraid[0]->{'supported-levels'} = $system if $system;
|
|
$mdraid[0]->{'unused'} = $unused if $unused;
|
|
}
|
|
print Data::Dumper::Dumper \@mdraid if $dbg[37];
|
|
eval $end if $b_log;
|
|
return @mdraid;
|
|
}
|
|
|
|
sub md_details {
|
|
eval $start if $b_log;
|
|
my ($id) = @_;
|
|
my (@working);
|
|
my $details = {};
|
|
my $cmd = $alerts{'mdadm'}->{'path'} . " --detail /dev/$id 2>/dev/null";
|
|
my @data = main::grabber($cmd,'','strip');
|
|
main::log_data('dump',"$id raw: \@data",\@data) if $b_log;
|
|
foreach (@data){
|
|
@working = split(/\s*:\s*/, $_, 2);
|
|
if (scalar @working == 2){
|
|
if ($working[0] eq 'Array Size' && $working[1] =~ /^([0-9]+)\s\(/){
|
|
$details->{'size'} = $1;
|
|
}
|
|
elsif ($working[0] eq 'Active Devices'){
|
|
$details->{'c-active'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'Chunk Size'){
|
|
$details->{'chunk-size'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'Failed Devices'){
|
|
$details->{'c-failed'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'Raid Devices'){
|
|
$details->{'c-raid'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'Spare Devices'){
|
|
$details->{'c-spare'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'State'){
|
|
$details->{'state'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'Total Devices'){
|
|
$details->{'c-total'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'Used Dev Size' && $working[1] =~ /^([0-9]+)\s\(/){
|
|
$details->{'dev-size'} = $1;
|
|
}
|
|
elsif ($working[0] eq 'UUID'){
|
|
$details->{'uuid'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'Working Devices'){
|
|
$details->{'c-working'} = $working[1];
|
|
}
|
|
}
|
|
# end component data lines
|
|
else {
|
|
@working = split(/\s+/,$_);
|
|
# 0 8 80 0 active sync /dev/sdf
|
|
# 2 8 128 - spare /dev/sdi
|
|
next if !@working || $working[0] eq 'Number' || scalar @working < 6;
|
|
$working[-1] =~ s|^/dev/(mapper/)?||;
|
|
$details->{'devices'}{$working[-1]} = {
|
|
'maj-min' => $working[1] . ':' . $working[2],
|
|
'number' => $working[0],
|
|
'raid-device' => $working[3],
|
|
'state' => join(' ', @working[4..($#working - 1)]),
|
|
};
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper $details;
|
|
main::log_data('dump',$id . ': %$details',$details) if $b_log;
|
|
eval $end if $b_log;
|
|
return $details;
|
|
}
|
|
|
|
sub soft_data {
|
|
eval $start if $b_log;
|
|
my ($cmd,$id,$state,$status,@data,@softraid,@working);
|
|
# already been set in DiskDataBSD but we know the device exists
|
|
foreach my $device (@{$sysctl{'softraid'}}){
|
|
if ($device =~ /\.drive[\d]+:([\S]+)\s\(([a-z0-9]+)\)[,\s]+(\S+)/){
|
|
my ($level,$size,@components);
|
|
$id = $2;
|
|
$status = $1;
|
|
$state = $3;
|
|
if ($alerts{'bioctl'}->{'action'} eq 'use'){
|
|
$cmd = $alerts{'bioctl'}->{'path'} . " $id 2>/dev/null";
|
|
@data = main::grabber($cmd,'','strip');
|
|
main::log_data('dump','softraid @data',\@data) if $b_log;
|
|
shift @data if @data; # get rid of headers
|
|
foreach my $row (@data){
|
|
@working = split(/\s+/,$row);
|
|
next if !defined $working[0];
|
|
if ($working[0] =~ /^softraid/){
|
|
if ($working[3] && main::is_numeric($working[3])){
|
|
$size = $working[3]/1024;# it's in bytes
|
|
$raw_logical[0] += $size;
|
|
}
|
|
$status = lc($working[2]) if $working[2];
|
|
$state = lc(join(' ', @working[6..$#working])) if $working[6];
|
|
$level = lc($working[5]) if $working[5];
|
|
}
|
|
elsif ($working[0] =~ /^[\d]{1,2}$/){
|
|
my ($c_id,$c_device,$c_size,$c_status);
|
|
if ($working[2] && main::is_numeric($working[2])){
|
|
$c_size = $working[2]/1024;# it's in bytes
|
|
$raw_logical[1] += $c_size;
|
|
}
|
|
$c_status = lc($working[1]) if $working[1];
|
|
if ($working[3] && $working[3] =~ /^([\d:\.]+)$/){
|
|
$c_device = $1;
|
|
}
|
|
if ($working[5] && $working[5] =~ /<([^>]+)>/){
|
|
$c_id = $1;
|
|
}
|
|
# when offline, there will be no $c_id, but we want to show device
|
|
if (!$c_id && $c_device){
|
|
$c_id = $c_device;
|
|
}
|
|
push(@components,[$c_id,$c_size,$c_status,$c_device]) if $c_id;
|
|
}
|
|
}
|
|
}
|
|
push(@softraid, {
|
|
'components' => \@components,
|
|
'id' => $id,
|
|
'level' => $level,
|
|
'size' => $size,
|
|
'state' => $state,
|
|
'status' => $status,
|
|
'type' => 'softraid',
|
|
});
|
|
}
|
|
}
|
|
print Data::Dumper::Dumper \@softraid if $dbg[37];
|
|
main::log_data('dump','@softraid',\@softraid) if $b_log;
|
|
eval $end if $b_log;
|
|
return @softraid;
|
|
}
|
|
|
|
sub zfs_data {
|
|
eval $start if $b_log;
|
|
my ($zpool) = @_;
|
|
my (@components,@zfs);
|
|
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 ($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");
|
|
}
|
|
# 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;
|
|
}
|
|
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;
|
|
eval $end if $b_log;
|
|
return ();
|
|
}
|
|
my ($status_i) = (0);
|
|
# NAME SIZE ALLOC FREE EXPANDSZ FRAG CAP DEDUP HEALTH ALTROOT
|
|
my $test = shift @working; # get rid of first header line
|
|
if ($test){
|
|
foreach (split(/\s+/, $test)){
|
|
last if $_ eq 'HEALTH';
|
|
$status_i++;
|
|
}
|
|
}
|
|
foreach (@working){
|
|
my @row = split(/\s+/, $_);
|
|
if (/^[\S]+/){
|
|
@components = ();
|
|
$i = 0;
|
|
$size = ($row[1] && $row[1] ne '-') ? main::translate_size($row[1]): '';
|
|
$allocated = ($row[2] && $row[2] ne '-')? main::translate_size($row[2]): '';
|
|
$free = ($row[3] && $row[3] ne '-')? main::translate_size($row[3]): '';
|
|
($zfs_used,$zfs_avail) = zfs_fs_sizes($zfs_path,$row[0]) if $zfs_path;
|
|
if (defined $zfs_used && defined $zfs_avail){
|
|
$zfs_size = $zfs_used + $zfs_avail;
|
|
$raw_logical[0] += $zfs_size;
|
|
}
|
|
else {
|
|
# must be BEFORE '$size_holder =' because only used if hits a new device
|
|
# AND unassigned via raid/mirror arrays. Corner case for > 1 device systems.
|
|
$raw_logical[0] += $size_holder if $size_holder;
|
|
$size_holder = $size;
|
|
}
|
|
$status = (defined $row[$status_i] && $row[$status_i] ne '') ? $row[$status_i]: 'no-status';
|
|
$j = scalar @zfs;
|
|
push(@zfs, {
|
|
'id' => $row[0],
|
|
'arrays' => ([],),
|
|
'raw-allocated' => $allocated,
|
|
'raw-free' => $free,
|
|
'raw-size' => $size,
|
|
'zfs-free' => $zfs_avail,
|
|
'zfs-size' => $zfs_size,
|
|
'status' => $status,
|
|
'type' => 'zfs',
|
|
});
|
|
}
|
|
# print Data::Dumper::Dumper \@zfs;
|
|
# raid level is the second item in the output, unless it is not, sometimes it is absent
|
|
elsif ($row[1] =~ /raid|mirror/){
|
|
$row[1] =~ s/^raid1/mirror/;
|
|
#$row[1] =~ s/^raid/raid-/; # need to match in zpool status <device>
|
|
$k = scalar @{$zfs[$j]->{'arrays'}};
|
|
$zfs[$j]->{'arrays'}[$k]{'level'} = $row[1];
|
|
$i = 0;
|
|
$size = ($row[2] && $row[2] ne '-') ? main::translate_size($row[2]) : '';
|
|
if (!defined $zfs_used || !defined $zfs_avail){
|
|
$size_holder = 0;
|
|
$raw_logical[0] += $size if $size;
|
|
}
|
|
$zfs[$j]->{'arrays'}[$k]{'raw-allocated'} = ($row[3] && $row[3] ne '-') ? main::translate_size($row[3]) : '';
|
|
$zfs[$j]->{'arrays'}[$k]{'raw-free'} = ($row[4] && $row[4] ne '-') ? main::translate_size($row[4]) : '';
|
|
$zfs[$j]->{'arrays'}[$k]{'raw-size'} = $size;
|
|
}
|
|
# https://blogs.oracle.com/eschrock/entry/zfs_hot_spares
|
|
elsif ($row[1] =~ /spares?/){
|
|
next;
|
|
}
|
|
# A member of a raid array:
|
|
# ada2 - - - - - -
|
|
# A single device not in an array:
|
|
# ada0s2 25.9G 14.6G 11.3G - 0% 56%
|
|
# gptid/3838f796-5c46-11e6-a931-d05099ac4dc2 - - - - - -
|
|
# 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 = ($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%
|
|
# 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]{'raw-size'} = $size;
|
|
$raw_logical[0] += $size if $size;
|
|
}
|
|
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]->{'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) && $working && @proc_partitions){
|
|
my $part = PartitionData::get($working);
|
|
if (@$part){
|
|
$maj_min = $part->[0] . ':' . $part->[1];
|
|
$part_size = $part->[2];
|
|
}
|
|
}
|
|
if ((!$maj_min || !$part_size) && $working && @lsblk){
|
|
my $data= LsblkData::get($working);
|
|
$maj_min = $data->{'maj-min'};
|
|
$part_size = $data->{'size'};
|
|
}
|
|
if (!$part_size && $bsd_type && $working){
|
|
my $temp = DiskDataBSD::get($working);
|
|
$part_size = $temp->{'size'} if $temp->{'size'};
|
|
}
|
|
$raw_logical[1] += $part_size if $part_size;
|
|
$zfs[$j]->{'arrays'}[$k]{'components'}[$i] = [$working,$part_size,$maj_min,$state];
|
|
$i++;
|
|
}
|
|
}
|
|
$raw_logical[0] += $size_holder if $size_holder;
|
|
# print Data::Dumper::Dumper \@zfs;
|
|
# clear out undefined arrrays values
|
|
$j = 0;
|
|
foreach my $row (@zfs){
|
|
my @arrays = (ref $row->{'arrays'} eq 'ARRAY') ? @{$row->{'arrays'}} : ();
|
|
@arrays = grep {defined $_} @arrays;
|
|
$zfs[$j]->{'arrays'} = \@arrays;
|
|
$j++;
|
|
}
|
|
@zfs = zfs_status($zpool,\@zfs);
|
|
print Data::Dumper::Dumper \@zfs if $dbg[37];
|
|
eval $end if $b_log;
|
|
return @zfs;
|
|
}
|
|
|
|
sub zfs_fs_sizes {
|
|
my ($path,$id) = @_;
|
|
eval $start if $b_log;
|
|
my @data;
|
|
my @result = main::grabber("$path list -pH $id 2>/dev/null",'','strip');
|
|
main::log_data('dump','zfs list @result',\@result) if $b_log;
|
|
print Data::Dumper::Dumper \@result if $dbg[37];
|
|
# some zfs devices do not have zfs data, lake spare storage devices
|
|
if (@result){
|
|
my @working = split(/\s+/,$result[0]);
|
|
$data[0] = $working[1]/1024 if $working[1];
|
|
$data[1] = $working[2]/1024 if $working[2];
|
|
}
|
|
elsif ($b_log || $dbg[37]) {
|
|
@result = main::grabber("$path list -pH $id 2>&1",'','strip');
|
|
main::log_data('dump','zfs list w/error @result',\@result) if $b_log;
|
|
print '@result w/error: ', Data::Dumper::Dumper \@result if $dbg[37];
|
|
}
|
|
eval $end if $b_log;
|
|
return @data;
|
|
}
|
|
|
|
sub zfs_status {
|
|
eval $start if $b_log;
|
|
my ($zpool,$zfs) = @_;
|
|
my ($cmd,$level,$status,@pool_status,@temp);
|
|
my ($i,$j,$k,$l) = (0,0,0,0);
|
|
foreach my $row (@$zfs){
|
|
$i = 0;
|
|
$k = 0;
|
|
if ($fake{'raid-zfs'}){
|
|
my $file;
|
|
# $file = "$fake_data_dir/raid-logical/zfs/zpool-status-1-mirror-main-solestar.txt";
|
|
# $file = "$fake_data_dir/raid-logical/zfs/zpool-status-2-mirror-main-solestar.txt";
|
|
# $file = "$fake_data_dir/raid-logical/zfs/zpool-status-tank-1.txt";
|
|
#@pool_status = main::reader($file,'strip');
|
|
}
|
|
else {
|
|
$cmd = "$zpool status $row->{'id'} 2>/dev/null";
|
|
@pool_status = main::grabber($cmd,"\n",'strip');
|
|
}
|
|
main::log_data('cmd',$cmd) if $b_log;
|
|
# @arrays = (ref $row->{'arrays'} eq 'ARRAY') ? @{$row->{'arrays'}} : ();
|
|
# print "$row->{'id'} rs:$row->{'status'}\n";
|
|
$status = ($row->{'status'} && $row->{'status'} eq 'no-status') ? check_zfs_status($row->{'id'},\@pool_status): $row->{'status'};
|
|
$zfs->[$j]{'status'} = $status if $status;
|
|
#@arrays = grep {defined $_} @arrays;
|
|
# print "$row->{id} $#arrays\n";
|
|
# print Data::Dumper::Dumper \@arrays;
|
|
foreach my $array (@{$row->{'arrays'}}){
|
|
# print 'ref: ', ref $array, "\n";
|
|
#next if ref $array ne 'HASH';
|
|
my @components = (ref $array->{'components'} eq 'ARRAY') ? @{$array->{'components'}} : ();
|
|
$l = 0;
|
|
# zpool status: mirror-0 ONLINE 2 0 0
|
|
$level = ($array->{'level'}) ? "$array->{'level'}-$i": $array->{'level'};
|
|
$status = ($level) ? check_zfs_status($level,\@pool_status): '';
|
|
$zfs->[$j]{'arrays'}[$k]{'status'} = $status;
|
|
# print "$level i:$i j:$j k:$k $status\n";
|
|
foreach my $component (@components){
|
|
my @temp = split('~', $component);
|
|
$status = ($temp[0]) ? check_zfs_status($temp[0],\@pool_status): '';
|
|
$zfs->[$j]{'arrays'}[$k]{'components'}[$l] .= $status if $status;
|
|
$l++;
|
|
}
|
|
$k++;
|
|
# haven't seen a raid5/6 type array yet, zfs uses z1,z2,and z3
|
|
$i++ if $array->{'level'}; # && $array->{'level'} eq 'mirror';
|
|
}
|
|
$j++;
|
|
}
|
|
eval $end if $b_log;
|
|
return @$zfs;
|
|
}
|
|
|
|
sub check_zfs_status {
|
|
eval $start if $b_log;
|
|
my ($item,$pool_status) = @_;
|
|
my ($status) = ('');
|
|
foreach (@$pool_status){
|
|
my @temp = split(/\s+/, $_);
|
|
if ($temp[0] eq $item){
|
|
last if !$temp[1];
|
|
$status = $temp[1];
|
|
last;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $status;
|
|
}
|
|
}
|
|
|
|
## RamItem
|
|
{
|
|
package RamItem;
|
|
my ($vendors,$vendor_ids);
|
|
my $ram_total = 0;
|
|
sub get {
|
|
my ($key1,$ram,$val1);
|
|
my $rows = [];
|
|
my $num = 0;
|
|
if ($bsd_type && !$force{'dmidecode'} && ($dboot{'ram'} || $fake{'dboot'})){
|
|
$ram = dboot_data();
|
|
if (@$ram){
|
|
ram_output($rows,$ram,'dboot');
|
|
}
|
|
else {
|
|
$key1 = 'message';
|
|
$val1 = main::message('ram-data-dmidecode');
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'RAM Report') => '',
|
|
main::key($num++,0,2,$key1) => $val1,
|
|
});
|
|
}
|
|
}
|
|
elsif ($fake{'dmidecode'} || $alerts{'dmidecode'}->{'action'} eq 'use'){
|
|
$ram = dmidecode_data();
|
|
if (@$ram){
|
|
ram_output($rows,$ram,'dmidecode');
|
|
}
|
|
else {
|
|
$key1 = 'message';
|
|
$val1 = main::message('ram-data');
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'RAM Report') => '',
|
|
main::key($num++,0,2,$key1) => $val1,
|
|
});
|
|
}
|
|
}
|
|
else {
|
|
$key1 = $alerts{'dmidecode'}->{'action'};
|
|
$val1 = $alerts{'dmidecode'}->{'message'};
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'RAM Report') => '',
|
|
main::key($num++,0,2,$key1) => $val1,
|
|
});
|
|
}
|
|
# we want the real installed RAM total if detected so add this after.
|
|
if (!$loaded{'memory'}){
|
|
$num = 0;
|
|
my $system_ram = {};
|
|
MemoryData::row('ram',$system_ram,\$num,1);
|
|
unshift(@$rows,$system_ram);
|
|
}
|
|
($vendors,$vendor_ids) = ();
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub ram_total {
|
|
return $ram_total;
|
|
}
|
|
|
|
sub ram_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$ram,$source) = @_;
|
|
return if !@$ram;
|
|
my $num = 0;
|
|
my $j = 0;
|
|
my ($b_non_system);
|
|
my ($arrays,$modules,$slots,$type_holder) = (0,0,0,'');
|
|
if ($source eq 'dboot'){
|
|
push(@$rows, {
|
|
main::key($num++,0,1,'Message') => main::message('ram-data-complete'),
|
|
});
|
|
}
|
|
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'}),
|
|
});
|
|
if ($item->{'cap-qualifier'}){
|
|
$rows->[$j]{main::key($num++,0,3,'note')} = $item->{'cap-qualifier'};
|
|
}
|
|
# show if > 1 array otherwise shows in System RAM line.
|
|
if (scalar @$ram > 1){
|
|
$rows->[$j]{main::key($num++,0,2,'installed')} = process_size($item->{'used-capacity'});
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'use')} = $item->{'use'} if $b_non_system;
|
|
$rows->[$j]{main::key($num++,1,2,'slots')} = $item->{'slots'};
|
|
if ($item->{'slots-qualifier'}){
|
|
$rows->[$j]{main::key($num++,0,3,'note')} = $item->{'slots-qualifier'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'modules')} = $item->{'slots-active'};
|
|
$item->{'eec'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'EC')} = $item->{'eec'};
|
|
if ($extra > 0 && (!$b_non_system ||
|
|
(main::is_numeric($item->{'max-module-size'}) &&
|
|
$item->{'max-module-size'} > 10))){
|
|
$rows->[$j]{main::key($num++,1,2,'max-module-size')} = process_size($item->{'max-module-size'});
|
|
if ($item->{'mod-qualifier'}){
|
|
$rows->[$j]{main::key($num++,0,3,'note')} = $item->{'mod-qualifier'};
|
|
}
|
|
}
|
|
if ($extra > 1 && $item->{'voltage'}){
|
|
$rows->[$j]{main::key($num++,0,2,'voltage')} = $item->{'voltage'};
|
|
}
|
|
}
|
|
else {
|
|
$slots += $item->{'slots'} if $item->{'slots'};
|
|
$arrays++;
|
|
}
|
|
foreach my $entry ($item->{'modules'}){
|
|
next if ref $entry ne 'ARRAY';
|
|
# print Data::Dumper::Dumper $entry;
|
|
foreach my $mod (@$entry){
|
|
$num = 1;
|
|
$j = scalar @$rows;
|
|
# Multi array setups will start index at next from previous array
|
|
next if ref $mod ne 'HASH';
|
|
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, {
|
|
main::key($num++,1,2,'Device') => $mod->{'locator'},
|
|
});
|
|
# This will contain the no module string
|
|
if ($mod->{'size'} =~ /\D/){
|
|
$rows->[$j]{main::key($num++,0,3,'type')} = lc($mod->{'size'});
|
|
next;
|
|
}
|
|
if ($extra > 1 && $mod->{'type'}){
|
|
$rows->[$j]{main::key($num++,0,3,'info')} = $mod->{'type'};
|
|
}
|
|
$mod->{'device-type'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,1,3,'type')} = $mod->{'device-type'};
|
|
if ($extra > 2 && $mod->{'device-type'} ne 'N/A'){
|
|
$mod->{'device-type-detail'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,4,'detail')} = $mod->{'device-type-detail'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,3,'size')} = process_size($mod->{'size'});
|
|
if ($mod->{'speed'} && $mod->{'configured-clock-speed'} &&
|
|
$mod->{'speed'} ne $mod->{'configured-clock-speed'}){
|
|
$rows->[$j]{main::key($num++,1,3,'speed')} = '';
|
|
$rows->[$j]{main::key($num++,0,4,'spec')} = $mod->{'speed'};
|
|
if ($mod->{'speed-note'}){
|
|
$rows->[$j]{main::key($num++,0,4,'note')} = $mod->{'speed-note'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,4,'actual')} = $mod->{'configured-clock-speed'};
|
|
if ($mod->{'configured-note'}){
|
|
$rows->[$j]{main::key($num++,0,5,'note')} = $mod->{'configured-note'};
|
|
}
|
|
}
|
|
else {
|
|
if (!$mod->{'speed'} && $mod->{'configured-clock-speed'}){
|
|
if ($mod->{'configured-clock-speed'}){
|
|
$mod->{'speed'} = $mod->{'configured-clock-speed'};
|
|
if ($mod->{'configured-note'}){
|
|
$mod->{'speed-note'} = $mod->{'configured-note'};
|
|
}
|
|
}
|
|
}
|
|
# Rare instances, dmi type 6, no speed, dboot also no speed
|
|
$mod->{'speed'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,1,3,'speed')} = $mod->{'speed'};
|
|
if ($mod->{'speed-note'}){
|
|
$rows->[$j]{main::key($num++,0,4,'note')} = $mod->{'speed-note'};
|
|
}
|
|
}
|
|
# Handle cases where -xx or -xxx and no voltage data (common) or voltages
|
|
# are all the same.
|
|
if ($extra > 1){
|
|
if (($mod->{'voltage-config'} || $mod->{'voltage-max'} ||
|
|
$mod->{'voltage-min'}) && ($b_admin || (
|
|
($mod->{'voltage-config'} && $mod->{'voltage-max'} &&
|
|
$mod->{'voltage-config'} ne $mod->{'voltage-max'}) ||
|
|
($mod->{'voltage-config'} && $mod->{'voltage-min'} &&
|
|
$mod->{'voltage-config'} ne $mod->{'voltage-min'}) ||
|
|
($mod->{'voltage-min'} && $mod->{'voltage-max'} &&
|
|
$mod->{'voltage-max'} ne $mod->{'voltage-min'})
|
|
))){
|
|
$rows->[$j]{main::key($num++,1,3,'volts')} = '';
|
|
if ($mod->{'voltage-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++,0,3,'volts')} = $mod->{'voltage-config'};
|
|
}
|
|
}
|
|
if ($source ne 'dboot' && $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 ($source ne 'dboot' && $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 ($source ne 'dboot' && $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;
|
|
}
|
|
|
|
sub dmidecode_data {
|
|
eval $start if $b_log;
|
|
my ($b_5,$handle,@temp);
|
|
my ($derived_module_size,$max_cap_5,$max_cap_16,$max_module_size,
|
|
$slots_active) = (0,0,0,0,0);
|
|
my ($i,$j,$k) = (0,0,0);
|
|
my $ram = [];
|
|
my $check = main::message('note-check');
|
|
# print Data::Dumper::Dumper \@dmi;
|
|
foreach my $entry (@dmi){
|
|
## Note: do NOT reset these values, that causes failures
|
|
# ($derived_module_size,$max_cap_5,$max_cap_16,$max_module_size) = (0,0,0,0);
|
|
if ($entry->[0] == 5){
|
|
$slots_active = 0;
|
|
foreach my $item (@$entry){
|
|
@temp = split(/:\s*/, $item, 2);
|
|
next if !$temp[1];
|
|
if ($temp[0] eq 'Maximum Memory Module Size'){
|
|
$max_module_size = calculate_size($temp[1],$max_module_size);
|
|
$ram->[$k]{'max-module-size'} = $max_module_size;
|
|
}
|
|
elsif ($temp[0] eq 'Maximum Total Memory Size'){
|
|
$max_cap_5 = calculate_size($temp[1],$max_cap_5);
|
|
$ram->[$k]{'max-capacity-5'} = $max_cap_5;
|
|
}
|
|
elsif ($temp[0] eq 'Memory Module Voltage'){
|
|
$temp[1] =~ s/\s*V.*$//; # seen: 5.0 V 3.3 V
|
|
$ram->[$k]{'voltage'} = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Associated Memory Slots'){
|
|
$ram->[$k]{'slots-5'} = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Error Detecting Method'){
|
|
$temp[1] ||= 'None';
|
|
$ram->[$k]{'eec'} = $temp[1];
|
|
}
|
|
}
|
|
$ram->[$k]{'modules'} = [];
|
|
# print Data::Dumper::Dumper \@ram;
|
|
$b_5 = 1;
|
|
}
|
|
elsif ($entry->[0] == 6){
|
|
my ($size,$speed,$type) = (0,0,0);
|
|
my ($bank_locator,$device_type,$locator,$main_locator) = ('','','','');
|
|
foreach my $item (@$entry){
|
|
@temp = split(/:\s*/, $item, 2);
|
|
next if !$temp[1];
|
|
if ($temp[0] eq 'Installed Size'){
|
|
# Get module size
|
|
$size = calculate_size($temp[1],0);
|
|
# Using this causes issues, really only works for 16
|
|
# if ($size =~ /^[0-9][0-9]+$/){
|
|
# $ram->[$k]{'device-count-found'}++;
|
|
# $ram->[$k]{'used-capacity'} += $size;
|
|
# }
|
|
# Get data after module size
|
|
$temp[1] =~ s/ Connection\)?//;
|
|
$temp[1] =~ s/^[0-9]+\s*[KkMGTP]B\s*\(?//;
|
|
$type = lc($temp[1]);
|
|
$slots_active++;
|
|
}
|
|
elsif ($temp[0] eq 'Current Speed'){
|
|
$speed = main::clean_dmi($temp[1]);
|
|
}
|
|
elsif ($temp[0] eq 'Locator' || $temp[0] eq 'Socket Designation'){
|
|
$temp[1] =~ s/D?RAM slot #?/Slot/i; # can be with or without #
|
|
$locator = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Bank Locator'){
|
|
$bank_locator = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Type'){
|
|
$device_type = main::clean_dmi($temp[1]);
|
|
}
|
|
}
|
|
# Because of the wide range of bank/slot type data, we will just use
|
|
# the one that seems most likely to be right. Some have:
|
|
# 'Bank: SO DIMM 0 slot: J6A' so we dump the useless data and use the
|
|
# one most likely to be visibly correct
|
|
if ($bank_locator =~ /DIMM/){
|
|
$main_locator = $bank_locator;
|
|
}
|
|
else {
|
|
$main_locator = $locator;
|
|
}
|
|
$ram->[$k]{'modules'}[$j] = {
|
|
'device-type' => $device_type,
|
|
'locator' => $main_locator,
|
|
'size' => $size,
|
|
'speed' => $speed,
|
|
'type' => $type,
|
|
};
|
|
# print Data::Dumper::Dumper \@ram;
|
|
$j++;
|
|
}
|
|
elsif ($entry->[0] == 16){
|
|
$handle = $entry->[1];
|
|
$ram->[$handle] = $ram->[$k] if $ram->[$k];
|
|
$ram->[$k] = undef;
|
|
$slots_active = 0;
|
|
# ($derived_module_size,$max_cap_16) = (0,0);
|
|
foreach my $item (@$entry){
|
|
@temp = split(/:\s*/, $item, 2);
|
|
next if !$temp[1];
|
|
if ($temp[0] eq 'Maximum Capacity'){
|
|
$max_cap_16 = calculate_size($temp[1],$max_cap_16);
|
|
$ram->[$handle]{'max-capacity-16'} = $max_cap_16;
|
|
}
|
|
# Note: these 3 have cleaned data in DmiData, so replace stuff manually
|
|
elsif ($temp[0] eq 'Location'){
|
|
$temp[1] =~ s/\sOr\sMotherboard//;
|
|
$temp[1] ||= 'System Board';
|
|
$ram->[$handle]{'location'} = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Use'){
|
|
$temp[1] ||= 'System Memory';
|
|
$ram->[$handle]{'use'} = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Error Correction Type'){
|
|
$temp[1] ||= 'None';
|
|
$ram->[$handle]{'eec'} = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Number Of Devices'){
|
|
$ram->[$handle]{'slots-16'} = $temp[1];
|
|
}
|
|
# print "0: $temp[0]\n";
|
|
}
|
|
$ram->[$handle]{'derived-module-size'} = 0;
|
|
$ram->[$handle]{'device-count-found'} = 0;
|
|
$ram->[$handle]{'used-capacity'} = 0;
|
|
# print "s16: $ram->[$handle]{'slots-16'}\n";
|
|
}
|
|
elsif ($entry->[0] == 17){
|
|
my ($bank_locator,$configured_speed,$configured_note,
|
|
$data_width) = ('','','','');
|
|
my ($device_type,$device_type_detail,$form_factor,$locator,
|
|
$main_locator) = ('','','','','');
|
|
my ($manufacturer,$vendor_id,$part_number,$serial,$speed,$speed_note,
|
|
$total_width) = ('','','','','','','');
|
|
my ($voltage_config,$voltage_max,$voltage_min);
|
|
my ($device_size,$i_data,$i_total,$working_size) = (0,0,0,0);
|
|
foreach my $item (@$entry){
|
|
@temp = split(/:\s*/, $item, 2);
|
|
next if !$temp[1];
|
|
if ($temp[0] eq 'Array Handle'){
|
|
$handle = hex($temp[1]);
|
|
}
|
|
# These two can have 'none' or 'unknown' value
|
|
elsif ($temp[0] eq 'Data Width'){
|
|
$data_width = main::clean_dmi($temp[1]);
|
|
$data_width =~ s/[\s_-]?bits// if $data_width;
|
|
}
|
|
elsif ($temp[0] eq 'Total Width'){
|
|
$total_width = main::clean_dmi($temp[1]);
|
|
$total_width =~ s/[\s_-]?bits// if $total_width;
|
|
}
|
|
# Do not try to guess from installed modules, only use this to correct
|
|
# type 5 data
|
|
elsif ($temp[0] eq 'Size'){
|
|
# we want any non real size data to be preserved
|
|
if ($temp[1] =~ /^[0-9]+\s*[KkMTPG]i?B/){
|
|
$derived_module_size = calculate_size($temp[1],$derived_module_size);
|
|
$working_size = calculate_size($temp[1],0);
|
|
$device_size = $working_size;
|
|
$slots_active++;
|
|
}
|
|
else {
|
|
$device_size = $temp[1];
|
|
}
|
|
}
|
|
elsif ($temp[0] eq 'Locator'){
|
|
$temp[1] =~ s/D?RAM slot #?/Slot/i;
|
|
$locator = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Bank Locator'){
|
|
$bank_locator = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Form Factor'){
|
|
$form_factor = $temp[1];
|
|
}
|
|
# these two can have 'none' or 'unknown' value
|
|
elsif ($temp[0] eq 'Type'){
|
|
$device_type = main::clean_dmi($temp[1]);
|
|
}
|
|
elsif ($temp[0] eq 'Type Detail'){
|
|
$device_type_detail = main::clean_dmi($temp[1]);
|
|
}
|
|
elsif ($temp[0] eq 'Speed'){
|
|
my $result = process_speed($temp[1],$device_type,$check);
|
|
($speed,$speed_note) = @$result;
|
|
}
|
|
# This is the actual speed the system booted at, speed is hardcoded
|
|
# clock speed means MHz, memory speed MT/S
|
|
elsif ($temp[0] eq 'Configured Clock Speed' ||
|
|
$temp[0] eq 'Configured Memory Speed'){
|
|
my $result = process_speed($temp[1],$device_type,$check);
|
|
($configured_speed,$configured_note) = @$result;
|
|
}
|
|
elsif ($temp[0] eq 'Manufacturer'){
|
|
$temp[1] = main::clean_dmi($temp[1]);
|
|
$manufacturer = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Part Number'){
|
|
$part_number = main::clean_unset($temp[1],'^[0]+$|.*Module.*|PartNum.*');
|
|
}
|
|
elsif ($temp[0] eq 'Serial Number'){
|
|
$serial = main::clean_unset($temp[1],'^[0]+$|SerNum.*');
|
|
}
|
|
elsif ($temp[0] eq 'Configured Voltage'){
|
|
if ($temp[1] =~ /^([\d\.]+)/){
|
|
$voltage_config = $1;
|
|
}
|
|
}
|
|
elsif ($temp[0] eq 'Maximum Voltage'){
|
|
if ($temp[1] =~ /^([\d\.]+)/){
|
|
$voltage_max = $1;
|
|
}
|
|
}
|
|
elsif ($temp[0] eq 'Minimum Voltage'){
|
|
if ($temp[1] =~ /^([\d\.]+)/){
|
|
$voltage_min = $1;
|
|
}
|
|
}
|
|
}
|
|
# 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'}++;
|
|
# build up actual capacity found for override tests
|
|
$ram->[$handle]{'used-capacity'} += $working_size;
|
|
}
|
|
# Sometimes the data is just wrong, they reverse total/data. data I
|
|
# believe is used for the actual memory bus width, total is some synthetic
|
|
# thing, sometimes missing. Note that we do not want a regular string
|
|
# comparison, because 128 bit memory buses are in our future, and
|
|
# 128 bits < 64 bits with string compare.
|
|
$data_width =~ /(^[0-9]+).*/;
|
|
$i_data = $1;
|
|
$total_width =~ /(^[0-9]+).*/;
|
|
$i_total = $1;
|
|
if ($i_data && $i_total && $i_data > $i_total){
|
|
my $temp_width = $data_width;
|
|
$data_width = $total_width;
|
|
$total_width = $temp_width;
|
|
}
|
|
if ($manufacturer && $manufacturer =~ /^([a-f0-9]{4})$/i){
|
|
$vendor_id = lc($1) if $1;
|
|
}
|
|
if ((!$manufacturer || $vendor_id) && $part_number){
|
|
my $result = ram_vendor($part_number);
|
|
$manufacturer = $result->[0] if $result->[0];
|
|
$part_number = $result->[1] if $result->[1];
|
|
}
|
|
if ($vendor_id && !$manufacturer){
|
|
set_ram_vendor_ids() if !$vendor_ids;
|
|
if ($vendor_ids->{$vendor_id}){
|
|
$manufacturer = $vendor_ids->{$vendor_id};
|
|
}
|
|
}
|
|
$ram->[$handle]{'derived-module-size'} = $derived_module_size;
|
|
$ram->[$handle]{'slots-active'} = $slots_active;
|
|
$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]{'vendor-id'} = $vendor_id;
|
|
$ram->[$handle]{'modules'}[$i]{'part-number'} = $part_number;
|
|
$ram->[$handle]{'modules'}[$i]{'serial'} = $serial;
|
|
$ram->[$handle]{'modules'}[$i]{'speed'} = $speed;
|
|
$ram->[$handle]{'modules'}[$i]{'speed-note'} = $speed_note if $speed_note;
|
|
$ram->[$handle]{'modules'}[$i]{'total-width'} = $total_width;
|
|
$ram->[$handle]{'modules'}[$i]{'voltage-config'} = $voltage_config;
|
|
$ram->[$handle]{'modules'}[$i]{'voltage-max'} = $voltage_max;
|
|
$ram->[$handle]{'modules'}[$i]{'voltage-min'} = $voltage_min;
|
|
$i++
|
|
}
|
|
elsif ($entry->[0] < 17){
|
|
next;
|
|
}
|
|
elsif ($entry->[0] > 17){
|
|
last;
|
|
}
|
|
}
|
|
print 'dmidecode pre process_data: ', Data::Dumper::Dumper $ram if $dbg[36];
|
|
main::log_data('dump','@$ram',$ram) if $b_log;
|
|
process_data($ram) if @$ram;
|
|
main::log_data('dump','@$ram',$ram) if $b_log;
|
|
print 'dmidecode post process_data: ', Data::Dumper::Dumper $ram if $dbg[36];
|
|
eval $end if $b_log;
|
|
return $ram;
|
|
}
|
|
|
|
sub dboot_data {
|
|
eval $start if $b_log;
|
|
my $ram = [];
|
|
my $est = main::message('note-est');
|
|
my ($arr,$derived_module_size,$slots_active,$subtract) = (0,0,0,0);
|
|
my ($holder);
|
|
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 = 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;
|
|
$slots_active++;
|
|
if ($addr){
|
|
$ram->[$arr]{'slots-16'} = $addr - 80 + 1 - $subtract;
|
|
$locator = 'Slot-' . $ram->[$arr]{'slots-16'};
|
|
}
|
|
$derived_module_size = $size if $size > $derived_module_size;
|
|
$ram->[$arr]{'device-count-found'}++;
|
|
# 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;
|
|
$ram->[$arr]{'slots-qualifier'} = $est;
|
|
$ram->[$arr]{'eec'} = $ecc;
|
|
$ram->[$arr]{'derived-module-size'} = $derived_module_size;
|
|
$ram->[$arr]{'used-capacity'} += $size;
|
|
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 $ram;
|
|
}
|
|
|
|
sub process_data {
|
|
eval $start if $b_log;
|
|
my $ram = $_[0];
|
|
my @result;
|
|
my $b_debug = 0;
|
|
my $check = main::message('note-check');
|
|
my $est = main::message('note-est');
|
|
foreach my $item (@$ram){
|
|
# Because we use the actual array handle as the index, there will be many
|
|
# undefined keys.
|
|
next if ! defined $item;
|
|
my ($max_cap,$max_mod_size) = (0,0);
|
|
my ($alt_cap,$est_cap,$est_mod,$est_slots,$unit) = (0,'','','','');
|
|
$max_cap = $item->{'max-capacity-16'};
|
|
$max_cap ||= 0;
|
|
# Make sure they are integers not string if empty.
|
|
$item->{'slots-5'} ||= 0;
|
|
$item->{'slots-16'} ||= 0;
|
|
$item->{'slots-active'} ||= 0;
|
|
$item->{'device-count-found'} ||= 0;
|
|
$item->{'max-capacity-5'} ||= 0;
|
|
$item->{'max-module-size'} ||= 0;
|
|
$item->{'used-capacity'} ||= 0;
|
|
# $item->{'max-module-size'} = 0;# debugger
|
|
# 1: If max cap 1 is null, and max cap 2 not null, use 2
|
|
if ($b_debug){
|
|
print "1: mms: $item->{'max-module-size'} :dms: $item->{'derived-module-size'} ";
|
|
print ":mc: $max_cap :uc: $item->{'used-capacity'}\n";
|
|
print "1a: s5: $item->{'slots-5'} s16: $item->{'slots-16'}\n";
|
|
}
|
|
if (!$max_cap && $item->{'max-capacity-5'}){
|
|
$max_cap = $item->{'max-capacity-5'};
|
|
}
|
|
if ($b_debug){
|
|
print "2: mms: $item->{'max-module-size'} :dms: $item->{'derived-module-size'} ";
|
|
print ":mc: $max_cap :uc: $item->{'used-capacity'}\n";
|
|
}
|
|
# 2: Now check to see if actually found module sizes are > than listed
|
|
# max module, replace if >
|
|
if ($item->{'max-module-size'} && $item->{'derived-module-size'} &&
|
|
$item->{'derived-module-size'} > $item->{'max-module-size'}){
|
|
$item->{'max-module-size'} = $item->{'derived-module-size'};
|
|
$est_mod = $est;
|
|
}
|
|
if ($b_debug){
|
|
print "3: dcf: $item->{'device-count-found'} :dms: $item->{'derived-module-size'} ";
|
|
print ":mc: $max_cap :uc: $item->{'used-capacity'}\n";
|
|
}
|
|
# Note: some cases memory capacity == max module size, so one stick will
|
|
# fill it but I think only with cases of 2 slots does this happen, so
|
|
# if > 2, use the count of slots.
|
|
if ($max_cap && ($item->{'device-count-found'} || $item->{'slots-16'})){
|
|
# First check that actual memory found is not greater than listed max cap,
|
|
# or checking to see module count * max mod size is not > used capacity
|
|
if ($item->{'used-capacity'} && $item->{'max-capacity-16'}){
|
|
if ($item->{'used-capacity'} > $max_cap){
|
|
if ($item->{'max-module-size'} &&
|
|
$item->{'used-capacity'} < ($item->{'slots-16'} * $item->{'max-module-size'})){
|
|
$max_cap = $item->{'slots-16'} * $item->{'max-module-size'};
|
|
$est_cap = $est;
|
|
print "A\n" if $b_debug;
|
|
}
|
|
elsif ($item->{'derived-module-size'} &&
|
|
$item->{'used-capacity'} < ($item->{'slots-16'} * $item->{'derived-module-size'})){
|
|
$max_cap = $item->{'slots-16'} * $item->{'derived-module-size'};
|
|
$est_cap = $est;
|
|
print "B\n" if $b_debug;
|
|
}
|
|
else {
|
|
$max_cap = $item->{'used-capacity'};
|
|
$est_cap = $est;
|
|
print "C\n" if $b_debug;
|
|
}
|
|
}
|
|
}
|
|
# Note that second case will never really activate except on virtual
|
|
# machines and maybe mobile devices.
|
|
if (!$est_cap){
|
|
# Do not do this for only single modules found, max mod size can be
|
|
# equal to the array size.
|
|
if ($item->{'slots-16'} > 1 && $item->{'device-count-found'} > 1 &&
|
|
$max_cap < ($item->{'derived-module-size'} * $item->{'slots-16'})){
|
|
$max_cap = $item->{'derived-module-size'} * $item->{'slots-16'};
|
|
$est_cap = $est;
|
|
print "D\n" if $b_debug;
|
|
}
|
|
elsif ($item->{'device-count-found'} > 0 &&
|
|
$max_cap < ($item->{'derived-module-size'} * $item->{'device-count-found'})){
|
|
$max_cap = $item->{'derived-module-size'} * $item->{'device-count-found'};
|
|
$est_cap = $est;
|
|
print "E\n" if $b_debug;
|
|
}
|
|
# Handle cases where we have type 5 data: mms x device count equals
|
|
# type 5 max caphowever do not use it if cap / devices equals the
|
|
# derived module size.
|
|
elsif ($item->{'max-module-size'} > 0 &&
|
|
($item->{'max-module-size'} * $item->{'slots-16'}) == $item->{'max-capacity-5'} &&
|
|
$item->{'max-capacity-5'} != $item->{'max-capacity-16'} &&
|
|
$item->{'derived-module-size'} != ($item->{'max-capacity-16'}/$item->{'slots-16'})){
|
|
$max_cap = $item->{'max-capacity-5'};
|
|
$est_cap = $est;
|
|
print "F\n" if $b_debug;
|
|
}
|
|
|
|
}
|
|
if ($b_debug){
|
|
print "4: mms: $item->{'max-module-size'} :dms: $item->{'derived-module-size'} ";
|
|
print ":mc: $max_cap :uc: $item->{'used-capacity'}\n";
|
|
}
|
|
# Some cases of type 5 have too big module max size, just dump the data
|
|
# then since we cannot know if it is valid or not, and a guess can be
|
|
# wrong easily.
|
|
if ($item->{'max-module-size'} && $max_cap && $item->{'max-module-size'} > $max_cap){
|
|
$item->{'max-module-size'} = 0;
|
|
}
|
|
if ($b_debug){
|
|
print "5: dms: $item->{'derived-module-size'} :s16: $item->{'slots-16'} :mc: $max_cap\n";
|
|
}
|
|
# Now prep for rebuilding the ram array data.
|
|
if (!$item->{'max-module-size'}){
|
|
# ie: 2x4gB
|
|
if (!$est_cap && $item->{'derived-module-size'} > 0 &&
|
|
$max_cap > ($item->{'derived-module-size'} * $item->{'slots-16'} * 4)){
|
|
$est_cap = $check;
|
|
print "G\n" if $b_debug;
|
|
}
|
|
if ($max_cap && ($item->{'slots-16'} || $item->{'slots-5'})){
|
|
my $slots = 0;
|
|
if ($item->{'slots-16'} && $item->{'slots-16'} >= $item->{'slots-5'}){
|
|
$slots = $item->{'slots-16'};
|
|
}
|
|
elsif ($item->{'slots-5'} && $item->{'slots-5'} > $item->{'slots-16'}){
|
|
$slots = $item->{'slots-5'};
|
|
}
|
|
# print "slots: $slots\n" if $b_debug;
|
|
if ($item->{'derived-module-size'} * $slots > $max_cap){
|
|
$item->{'max-module-size'} = $item->{'derived-module-size'};
|
|
print "H\n" if $b_debug;
|
|
}
|
|
else {
|
|
$item->{'max-module-size'} = sprintf("%.f",$max_cap/$slots);
|
|
print "J\n" if $b_debug;
|
|
}
|
|
$est_mod = $est;
|
|
}
|
|
}
|
|
# Case where listed max cap is too big for actual slots x max cap, eg:
|
|
# listed max cap, 8gb, max mod 2gb, slots 2
|
|
else {
|
|
if (!$est_cap && $item->{'max-module-size'} > 0){
|
|
if ($max_cap > ($item->{'max-module-size'} * $item->{'slots-16'})){
|
|
$est_cap = $check;
|
|
print "K\n" if $b_debug;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# No slots found due to legacy dmi probably. Note, too many logic errors
|
|
# happen if we just set a general slots above, so safest to do it here
|
|
$item->{'slots-16'} = $item->{'slots-5'} if $item->{'slots-5'} && !$item->{'slots-16'};
|
|
if (!$item->{'slots-16'} && $item->{'modules'} && ref $item->{'modules'} eq 'ARRAY'){
|
|
$est_slots = $check;
|
|
$item->{'slots-16'} = scalar @{$item->{'modules'}};
|
|
print "L\n" if $b_debug;
|
|
}
|
|
# Only bsds using dmesg data
|
|
elsif ($item->{'slots-qualifier'}){
|
|
$est_slots = $item->{'slots-qualifier'};
|
|
$est_cap = $est;
|
|
}
|
|
$ram_total += $item->{'used-capacity'};
|
|
push(@result, {
|
|
'capacity' => $max_cap,
|
|
'cap-qualifier' => $est_cap,
|
|
'eec' => $item->{'eec'},
|
|
'location' => $item->{'location'},
|
|
'max-module-size' => $item->{'max-module-size'},
|
|
'mod-qualifier' => $est_mod,
|
|
'modules' => $item->{'modules'},
|
|
'slots' => $item->{'slots-16'},
|
|
'slots-active' => $item->{'slots-active'},
|
|
'slots-qualifier' => $est_slots,
|
|
'use' => $item->{'use'},
|
|
'used-capacity' => $item->{'used-capacity'},
|
|
'voltage-config' => $item->{'voltage-config'},
|
|
'voltage-max' => $item->{'voltage-max'},
|
|
'voltage-min' => $item->{'voltage-min'},
|
|
});
|
|
}
|
|
@$ram = @result;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub process_speed {
|
|
my ($speed,$device_type,$check) = @_;
|
|
my $speed_note;
|
|
$speed = main::clean_dmi($speed) if $speed;
|
|
if ($device_type && $device_type =~ /ddr/i && $speed &&
|
|
$speed =~ /^([0-9]+)\s*MHz/){
|
|
$speed = ($1 * 2) . " MT/s ($speed)";
|
|
}
|
|
# 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]+)\s*M/){
|
|
$speed_note = $check if $1 < 50 || $1 > 20000 ;
|
|
}
|
|
return [$speed,$speed_note];
|
|
}
|
|
|
|
# args: 0: size in KiB
|
|
sub process_size {
|
|
my ($size) = @_;
|
|
my ($b_trim,$unit) = (0,'');
|
|
# print "size0: $size\n";
|
|
return 'N/A' if !$size;
|
|
# we're going to preserve the bad data for output
|
|
return $size if !main::is_numeric($size);
|
|
# print "size: $size\n";
|
|
# We only want max 2 decimal places, and only when it's a unit > 1 GiB.
|
|
$b_trim = 1 if $size > 1024**2;
|
|
($size,$unit) = main::get_size($size);
|
|
$size = sprintf("%.2f",$size) if $b_trim;
|
|
$size =~ s/\.[0]+$//;
|
|
$size = "$size $unit";
|
|
return $size;
|
|
}
|
|
|
|
# arg: 0: size string; 1: working size. If calculated result > $size, uses new
|
|
# value. If $data not valid, returns 0.
|
|
sub calculate_size {
|
|
my ($data, $size) = @_;
|
|
# Technically k is KiB, K is KB but can't trust that.
|
|
if ($data =~ /^([0-9]+\s*[kKGMTP])i?B/){
|
|
my $working = $1;
|
|
# This converts it to KiB
|
|
my $working_size = main::translate_size($working);
|
|
# print "ws-a: $working_size s-1: $size\n";
|
|
if (main::is_numeric($working_size) && $working_size > $size){
|
|
$size = $working_size;
|
|
}
|
|
# print "ws-b: $working_size s-2: $size\n";
|
|
}
|
|
else {
|
|
$size = 0;
|
|
}
|
|
# print "d-2: $data s-3: $size\n";
|
|
return $size;
|
|
}
|
|
|
|
# BSD: Map string to speed, in MT/s
|
|
sub speed_mapper {
|
|
my ($type) = @_;
|
|
my %speeds = (
|
|
# 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-21333' => 2666,
|
|
'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...
|
|
);
|
|
return ($speeds{$type}) ? $speeds{$type} . ' MT/s' : $type;
|
|
}
|
|
|
|
|
|
## 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',
|
|
'ad00' => 'SK-Hynix',# confirmed
|
|
'c0a9' => 'Crucial',
|
|
'ce00' => 'Samsung',# confirmed
|
|
# '' => '',
|
|
}
|
|
}
|
|
## END RAM VENDOR ##
|
|
|
|
sub ram_vendor {
|
|
eval $end if $b_log;
|
|
my ($id) = $_[0];
|
|
set_ram_vendors() if !$vendors;
|
|
my ($vendor);
|
|
foreach my $row (@$vendors){
|
|
if ($id =~ /$row->[0]/i){
|
|
$vendor = $row->[2];
|
|
# Usually we want to assign N/A at output phase, maybe do this logic there?
|
|
if ($row->[1]){
|
|
if ($id !~ m/$row->[1]$/i){
|
|
$id =~ s/$row->[1]//i;
|
|
}
|
|
else {
|
|
$id = 'N/A';
|
|
}
|
|
}
|
|
$id =~ s/^[\/\[\s_-]+|[\/\s_-]+$//g;
|
|
$id =~ s/\s\s/ /g;
|
|
last;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return [$vendor,$id];
|
|
}
|
|
}
|
|
|
|
## RepoItem
|
|
{
|
|
package RepoItem;
|
|
# easier to keep these package global, but undef after done
|
|
my (@dbg_files,$debugger_dir,%repo_keys);
|
|
my $num = 0;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
($debugger_dir) = @_;
|
|
my $rows = [];
|
|
if ($extra > 0 && !$loaded{'package-data'}){
|
|
my $packages = PackageData::get('main',\$num);
|
|
for (keys %$packages){
|
|
$rows->[0]{$_} = $packages->{$_};
|
|
}
|
|
}
|
|
my $start = scalar @$rows; # to test if we found more rows after
|
|
$num = 0;
|
|
if ($bsd_type){
|
|
get_repos_bsd($rows);
|
|
}
|
|
else {
|
|
get_repos_linux($rows);
|
|
}
|
|
if ($debugger_dir){
|
|
@$rows = @dbg_files;
|
|
undef @dbg_files;
|
|
undef $debugger_dir;
|
|
undef %repo_keys;
|
|
}
|
|
else {
|
|
if ($start == scalar @$rows){
|
|
my $pm_missing;
|
|
if ($bsd_type){
|
|
$pm_missing = main::message('repo-data-bsd',$uname[0]);
|
|
}
|
|
else {
|
|
$pm_missing = main::message('repo-data');
|
|
}
|
|
push(@$rows,{main::key($num++,0,1,'Alert') => $pm_missing});
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub get_repos_linux {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my (@content,$data,@data2,@data3,@files,$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 $tce_app = '/usr/bin/tce';
|
|
my $tce_file = '/opt/tcemirror';
|
|
my $tce_file2 = '/opt/localmirrors';
|
|
my $yum_conf = '/etc/yum.conf';
|
|
my $yum_repo_dir = '/etc/yum.repos.d/';
|
|
my $xbps_dir_1 = '/etc/xbps.d/';
|
|
my $xbps_dir_2 = '/usr/share/xbps.d/';
|
|
my $zypp_repo_dir = '/etc/zypp/repos.d/';
|
|
my $b_test = 0;
|
|
## apt: Debian, *buntus + derived (deb files);AltLinux, PCLinuxOS (rpm files)
|
|
# Sometimes some yum/rpm repos may create apt repos here as well
|
|
if (-f $apt || -d "$apt.d"){
|
|
my ($apt_arch,$apt_comp,$apt_suites,$apt_types,@apt_urls,@apt_working,
|
|
$b_apt_enabled,$file,$string);
|
|
my $counter = 0;
|
|
@files = main::globber("$apt.d/*.list");
|
|
push(@files, $apt);
|
|
# prefilter list for logging
|
|
@files = grep {-f $_} @files; # may not have $apt file.
|
|
main::log_data('data',"apt repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log;
|
|
foreach (sort @files){
|
|
# altlinux/pclinuxos use rpms in apt files, -r to be on safe side
|
|
if (-r $_){
|
|
$data = repo_builder($_,'apt','^\s*(deb|rpm)');
|
|
push(@$rows,@$data);
|
|
}
|
|
}
|
|
# @files = main::globber("$fake_data_dir/repo/apt/*.sources");
|
|
@files = main::globber("$apt.d/*.sources");
|
|
# prefilter list for logging, sometimes globber returns non-prsent files.
|
|
@files = grep {-f $_} @files;
|
|
# @files = ("$fake_data_dir/repo/apt/deb822-u193-3.sources",
|
|
# "$fake_data_dir/repo/apt/deb822-u193-3.sourcesdeb822-u193-4-signed-by.sources");
|
|
main::log_data('data',"apt deb822 repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log;
|
|
foreach $file (@files){
|
|
# critical: whitespace is the separator, no logical ordering of
|
|
# field names exists within each entry.
|
|
@data2 = main::reader($file);
|
|
# print Data::Dumper::Dumper \@data2;
|
|
if (@data2){
|
|
@data2 = map {s/^\s*$/~/;$_} @data2;
|
|
push(@data2, '~');
|
|
}
|
|
push(@dbg_files, $file) if $debugger_dir;
|
|
# print "$file\n";
|
|
@apt_urls = ();
|
|
@apt_working = ();
|
|
$b_apt_enabled = 1;
|
|
foreach my $row (@data2){
|
|
# NOTE: the syntax of deb822 must be considered a bug, it's sloppy beyond belief.
|
|
# deb822 supports line folding which starts with space
|
|
# BUT: you can start a URIs: block of urls with a space, sigh.
|
|
next if $row =~ /^\s+/ && $row !~ /^\s+[^#]+:\//;
|
|
# strip out line space starters now that it's safe
|
|
$row =~ s/^\s+//;
|
|
# print "$row\n";
|
|
if ($row eq '~'){
|
|
if (@apt_working && $b_apt_enabled){
|
|
# print "1: url builder\n";
|
|
foreach $repo (@apt_working){
|
|
$string = $apt_types;
|
|
$string .= ' [arch=' . $apt_arch . ']' if $apt_arch;
|
|
$string .= ' ' . $repo;
|
|
$string .= ' ' . $apt_suites if $apt_suites ;
|
|
$string .= ' ' . $apt_comp if $apt_comp;
|
|
# print "s1:$string\n";
|
|
push(@data3, $string);
|
|
}
|
|
# print join("\n",@data3),"\n";
|
|
push(@apt_urls,@data3);
|
|
}
|
|
@data3 = ();
|
|
@apt_working = ();
|
|
$apt_arch = '';
|
|
$apt_comp = '';
|
|
$apt_suites = '';
|
|
$apt_types = '';
|
|
$b_apt_enabled = 1;
|
|
}
|
|
elsif ($row =~ /^Types:\s*(.*)/i){
|
|
# print "1:$1\n";
|
|
$apt_types = $1;
|
|
}
|
|
elsif ($row =~ /^Enabled:\s*(.*)/i){
|
|
$b_apt_enabled = ($1 =~ /\b(disable|false|off|no|without)\b/i) ? 0: 1;
|
|
}
|
|
elsif ($row =~ /^[^#]+:\//){
|
|
my $url = $row;
|
|
$url =~ s/^URIs:\s*//i;
|
|
push(@apt_working, $url) if $url;
|
|
}
|
|
elsif ($row =~ /^Suites:\s*(.*)/i){
|
|
$apt_suites = $1;
|
|
}
|
|
elsif ($row =~ /^Components:\s*(.*)/i){
|
|
$apt_comp = $1;
|
|
}
|
|
elsif ($row =~ /^Architectures:\s*(.*)/i){
|
|
$apt_arch = $1;
|
|
}
|
|
}
|
|
if (@apt_urls){
|
|
$key = repo_data('active','apt');
|
|
clean_url(\@apt_urls);
|
|
}
|
|
else {
|
|
$key = repo_data('missing','apt');
|
|
}
|
|
push(@$rows,
|
|
{main::key($num++,1,1,$key) => $file},
|
|
[@apt_urls],
|
|
);
|
|
}
|
|
@files = ();
|
|
}
|
|
## pacman, pacman-g2: Arch + derived, Frugalware
|
|
if (-f $pacman || -f $pacman_g2){
|
|
$repo = 'pacman';
|
|
if (-f $pacman_g2){
|
|
$pacman = $pacman_g2;
|
|
$repo = 'pacman-g2';
|
|
}
|
|
@files = main::reader($pacman,'strip');
|
|
if (@files){
|
|
@repos = grep {/^\s*Server/i} @files;
|
|
@files = grep {/^\s*Include/i} @files;
|
|
}
|
|
if (@files){
|
|
@files = map {
|
|
my @working = split(/\s+=\s+/, $_);
|
|
$working[1];
|
|
} @files;
|
|
}
|
|
@files = sort @files;
|
|
main::uniq(\@files);
|
|
unshift(@files, $pacman) if @repos;
|
|
foreach (@files){
|
|
if (-f $_){
|
|
$data = repo_builder($_,$repo,'^\s*Server','\s*=\s*',1);
|
|
push(@$rows,@$data);
|
|
}
|
|
else {
|
|
# set it so the debugger knows the file wasn't there
|
|
push(@dbg_files, $_) if $debugger_dir;
|
|
push(@$rows,
|
|
{main::key($num++,1,1,'File listed in') => $pacman},
|
|
[("$_ does not seem to exist.")],
|
|
);
|
|
}
|
|
}
|
|
if (!@$rows){
|
|
push(@$rows,
|
|
{main::key($num++,0,1,repo_data('missing','files')) => $pacman },
|
|
);
|
|
}
|
|
}
|
|
## netpkg: Zenwalk, Slackware
|
|
if (-f $netpkg){
|
|
my @data2 = ($netpkg);
|
|
if (-d $netpkg_dir){
|
|
@data3 = main::globber("$netpkg_dir/*");
|
|
@data3 = grep {!/\/local$/} @data3 if @data3; # package directory
|
|
push(@data2,@data3) if @data3;
|
|
}
|
|
foreach my $file (@data2){
|
|
$data = repo_builder($file,'netpkg','^URL\s*=','\s*=\s*',1);
|
|
push(@$rows,@$data);
|
|
}
|
|
}
|
|
## sbopkg, sboui, slackpkg, slackpkg+, slapt_get, slpkg: Slackware + derived
|
|
# $slpkg = "$ENV{'HOME'}/bin/scripts/inxi/data/repo/slackware/slpkg-2.toml";
|
|
# $sbopkg = "$ENV{HOME}/bin/scripts/inxi/data/repo/slackware/sbopkg-2.conf";
|
|
# $sboui_backend = "$ENV{HOME}/bin/scripts/inxi/data/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 = "$ENV{HOME}/bin/scripts/inxi/data/repo/slackware/sbopkg-root-1.conf";
|
|
@files = ($sbopkg);
|
|
# /root not readable as user, unless it is, so just check if readable
|
|
push(@files,$sbo_root) if -r $sbo_root;
|
|
my ($branch,$name);
|
|
# SRC_REPO repo URL not used, not what we think
|
|
foreach my $file (@files){
|
|
foreach my $row (main::reader($file,'strip')){
|
|
if ($row =~ /^REPO_NAME=(\S\{REPO_NAME:-)?(.*?)\}?$/){
|
|
$name = $2;
|
|
}
|
|
elsif ($row =~ /^REPO_BRANCH=(\S\{REPO_BRANCH:-)?(.*?)\}?$/){
|
|
$branch = $2;
|
|
}
|
|
}
|
|
}
|
|
# First found overridden by next, so we don't care where the value came
|
|
# from. We do care if 1 file and not root however, since might be wrong.
|
|
if ($branch && $name){
|
|
if ($b_root || scalar @files == 2){
|
|
$key = repo_data('active','sbopkg');
|
|
}
|
|
else {
|
|
$key = repo_data('active-permissions','sbopkg');
|
|
}
|
|
@content = ("$name ~ $branch");
|
|
}
|
|
else {
|
|
$key = repo_data('missing','sbopkg');
|
|
}
|
|
my @data = (
|
|
{main::key($num++,1,1,$key) => join(', ',@files)},
|
|
[@content],
|
|
);
|
|
push(@$rows,@data);
|
|
(@content,@files) = ();
|
|
}
|
|
if (-f $sboui_backend){
|
|
my ($branch,$repo);
|
|
# Note: sboui also has a sboui.conf file, with the package_manager string
|
|
# but that is too hard to handle clearly in output so leaving aside.
|
|
foreach my $row (main::reader($sboui_backend,'strip')){
|
|
if ($row =~ /^REPO\s*=\s*["']?(\S+?)["']?\s*$/){
|
|
$repo = $1;
|
|
}
|
|
elsif ($row =~ /^BRANCH\s*=\s*["']?(\S+?)["']?\s*$/){
|
|
$branch = $1;
|
|
}
|
|
}
|
|
if ($repo){
|
|
$key = repo_data('active','sboui');
|
|
$branch = 'current' if !$branch || $repo =~ /ponce/i;
|
|
@content = ("SBo $branch ~ $repo"); # we want SBo name to show
|
|
}
|
|
else {
|
|
$key = repo_data('missing','sboui');
|
|
}
|
|
my @data = (
|
|
{main::key($num++,1,1,$key) => $sboui_backend},
|
|
[@content],
|
|
);
|
|
push(@$rows,@data);
|
|
@content = ();
|
|
}
|
|
if (-f $slackpkg){
|
|
$data = repo_builder($slackpkg,'slackpkg','^[[:space:]]*[^#]+');
|
|
push(@$rows,@$data);
|
|
}
|
|
if (-d $slapt_get){
|
|
@data2 = main::globber("${slapt_get}*");
|
|
@data2 = grep {!/pubring/} @data2 if @data2;
|
|
foreach my $file (@data2){
|
|
$data = repo_builder($file,'slaptget','^\s*SOURCE','\s*=\s*',1);
|
|
push(@$rows,@$data);
|
|
}
|
|
}
|
|
if (-f $slackpkg_plus){
|
|
push(@dbg_files, $slackpkg_plus) if $debugger_dir;
|
|
my (@repoplus_list,$active_repos);
|
|
foreach my $row (main::reader($slackpkg_plus,'strip')){
|
|
@data2 = split(/\s*=\s*/, $row);
|
|
@data2 = map { $_ =~ s/^\s+|\s+$//g ; $_ } @data2;
|
|
last if $data2[0] =~ /^SLACKPKGPLUS/i && $data2[1] eq 'off';
|
|
# REPOPLUS=(slackpkgplus restricted alienbob ktown multilib slacky)
|
|
if ($data2[0] =~ /^REPOPLUS/i){
|
|
@repoplus_list = split(/\s+/, $data2[1]);
|
|
@repoplus_list = map {s/\(|\)//g; $_} @repoplus_list;
|
|
$active_repos = join('|',@repoplus_list);
|
|
|
|
}
|
|
# MIRRORPLUS['multilib']=http://taper.alienbase.nl/mirrors/people/alien/multilib/14.1/
|
|
if ($active_repos && $data2[0] =~ /^MIRRORPLUS/i){
|
|
$data2[0] =~ s/MIRRORPLUS\[\'|\'\]//ig;
|
|
if ($data2[0] =~ /$active_repos/){
|
|
push(@content,"$data2[0] ~ $data2[1]");
|
|
}
|
|
}
|
|
}
|
|
if (!@content){
|
|
$key = repo_data('missing','slackpkg+');
|
|
}
|
|
else {
|
|
clean_url(\@content);
|
|
$key = repo_data('active','slackpkg+');
|
|
}
|
|
my @data = (
|
|
{main::key($num++,1,1,$key) => $slackpkg_plus},
|
|
[@content],
|
|
);
|
|
push(@$rows,@data);
|
|
@content = ();
|
|
}
|
|
if (-f $slpkg){
|
|
my ($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) = ();
|
|
}
|
|
}
|
|
## dnf, yum, zypp: Redhat, Suse + derived (rpm based)
|
|
if (-f $dnf_conf ||-d $dnf_repo_dir|| -d $yum_repo_dir || -f $yum_conf ||
|
|
-d $zypp_repo_dir){
|
|
@files = ();
|
|
push(@files, $dnf_conf) if -f $dnf_conf;
|
|
push(@files, main::globber("$dnf_repo_dir*.repo")) if -d $dnf_repo_dir;
|
|
push(@files, $yum_conf) if -f $yum_conf;
|
|
push(@files, main::globber("$yum_repo_dir*.repo")) if -d $yum_repo_dir;
|
|
if (-d $zypp_repo_dir){
|
|
push(@files, main::globber("$zypp_repo_dir*.repo"));
|
|
main::log_data('data',"zypp repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log;
|
|
}
|
|
# push(@files, "$fake_data_dir/repo/yum/rpmfusion-nonfree-1.repo");
|
|
if (@files){
|
|
foreach (sort @files){
|
|
@data2 = main::reader($_);
|
|
push(@dbg_files, $_) if $debugger_dir;
|
|
if (/yum/){
|
|
$repo = 'yum';
|
|
}
|
|
elsif (/dnf/){
|
|
$repo = 'dnf';
|
|
}
|
|
elsif(/zypp/){
|
|
$repo = 'zypp';
|
|
}
|
|
my ($enabled,$url,$title) = (undef,'','');
|
|
foreach my $line (@data2){
|
|
# this is a hack, assuming that each item has these fields listed, we collect the 3
|
|
# items one by one, then when the url/enabled fields are set, we print it out and
|
|
# reset the data. Not elegant but it works. Note that if enabled was not present
|
|
# we assume it is enabled then, and print the line, reset the variables. This will
|
|
# miss the last item, so it is printed if found in END
|
|
if ($line =~ /^\[(.+)\]/){
|
|
my $temp = $1;
|
|
if ($url && $title && defined $enabled){
|
|
if ($enabled > 0){
|
|
push(@content, "$title ~ $url");
|
|
}
|
|
($enabled,$url,$title) = (undef,'','');
|
|
}
|
|
$title = $temp;
|
|
}
|
|
# Note: it looks like enabled comes before url
|
|
elsif ($line =~ /^(metalink|mirrorlist|baseurl)\s*=\s*(.*)/i){
|
|
$url = $2;
|
|
}
|
|
# note: enabled = 1. enabled = 0 means disabled
|
|
elsif ($line =~ /^enabled\s*=\s*(0|1|No|Yes|True|False)/i){
|
|
$enabled = $1;
|
|
$enabled =~ s/(No|False)/0/i;
|
|
$enabled =~ s/(Yes|True)/1/i;
|
|
}
|
|
# print out the line if all 3 values are found, otherwise if a new
|
|
# repoTitle is hit above, it will print out the line there instead
|
|
if ($url && $title && defined $enabled){
|
|
if ($enabled > 0){
|
|
push(@content, "$title ~ $url");
|
|
}
|
|
($enabled,$url,$title) = (0,'','');
|
|
}
|
|
}
|
|
# print the last one if there is data for it
|
|
if ($url && $title && $enabled){
|
|
push(@content, "$title ~ $url");
|
|
}
|
|
if (!@content){
|
|
$key = repo_data('missing',$repo);
|
|
}
|
|
else {
|
|
clean_url(\@content);
|
|
$key = repo_data('active',$repo);
|
|
}
|
|
push(@$rows,
|
|
{main::key($num++,1,1,$key) => $_},
|
|
[@content],
|
|
);
|
|
@content = ();
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \@$rows;
|
|
}
|
|
# emerge, portage: Gentoo + derived
|
|
if ((-d $portage_dir || -d $portage_gentoo_dir) && main::check_program('emerge')){
|
|
@files = (main::globber("$portage_dir*.conf"),main::globber("$portage_gentoo_dir*.conf"));
|
|
$repo = 'portage';
|
|
if (@files){
|
|
foreach (sort @files){
|
|
@data2 = main::reader($_);
|
|
push(@dbg_files, $_) if $debugger_dir;
|
|
my ($enabled,$url,$title) = (undef,'','');
|
|
foreach my $line (@data2){
|
|
# this is a hack, assuming that each item has these fields listed, we collect the 3
|
|
# items one by one, then when the url/enabled fields are set, we print it out and
|
|
# reset the data. Not elegant but it works. Note that if enabled was not present
|
|
# we assume it is enabled then, and print the line, reset the variables. This will
|
|
# miss the last item, so it is printed if found in END
|
|
if ($line =~ /^\[(.+)\]/){
|
|
my $temp = $1;
|
|
if ($url && $title && defined $enabled){
|
|
if ($enabled > 0){
|
|
push(@content, "$title ~ $url");
|
|
}
|
|
($enabled,$url,$title) = (undef,'','');
|
|
}
|
|
$title = $temp;
|
|
}
|
|
elsif ($line =~ /^(sync-uri)\s*=\s*(.*)/i){
|
|
$url = $2;
|
|
}
|
|
# note: enabled = 1. enabled = 0 means disabled
|
|
elsif ($line =~ /^auto-sync\s*=\s*(0|1|No|Yes|True|False)/i){
|
|
$enabled = $1;
|
|
$enabled =~ s/(No|False)/0/i;
|
|
$enabled =~ s/(Yes|True)/1/i;
|
|
}
|
|
# print out the line if all 3 values are found, otherwise if a new
|
|
# repoTitle is hit above, it will print out the line there instead
|
|
if ($url && $title && defined $enabled){
|
|
if ($enabled > 0){
|
|
push(@content, "$title ~ $url");
|
|
}
|
|
($enabled,$url,$title) = (undef,'','');
|
|
}
|
|
}
|
|
# print the last one if there is data for it
|
|
if ($url && $title && $enabled){
|
|
push(@content, "$title ~ $url");
|
|
}
|
|
if (! @content){
|
|
$key = repo_data('missing','portage');
|
|
}
|
|
else {
|
|
clean_url(\@content);
|
|
$key = repo_data('active','portage');
|
|
}
|
|
push(@$rows,
|
|
{main::key($num++,1,1,$key) => $_},
|
|
[@content],
|
|
);
|
|
@content = ();
|
|
}
|
|
}
|
|
}
|
|
## apk: Alpine, Chimera
|
|
if (-f $apk || -d "$apk.d"){
|
|
@files = main::globber("$apk.d/*.list");
|
|
push(@files, $apk);
|
|
# prefilter list for logging
|
|
@files = grep {-f $_} @files; # may not have $apk file.
|
|
main::log_data('data',"apk repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log;
|
|
foreach (sort @files){
|
|
# -r to be on safe side
|
|
if (-r $_){
|
|
$data = repo_builder($_,'apk','^\s*[^#]+');
|
|
push(@$rows,@$data);
|
|
}
|
|
}
|
|
}
|
|
## scratchpkg: Venom
|
|
if (-f $scratchpkg){
|
|
$data = repo_builder($scratchpkg,'scratchpkg','^[[:space:]]*[^#]+');
|
|
push(@$rows,@$data);
|
|
}
|
|
# cards: Nutyx
|
|
if (-f $cards){
|
|
@data3 = main::reader($cards,'clean');
|
|
push(@dbg_files, $cards) if $debugger_dir;
|
|
foreach (@data3){
|
|
if ($_ =~ /^dir\s+\/[^\|]+\/([^\/\|]+)\s*(\|\s*((http|ftp).*))?/){
|
|
my $type = ($3) ? $3: 'local';
|
|
push(@content, "$1 ~ $type");
|
|
}
|
|
}
|
|
if (! @content){
|
|
$key = repo_data('missing','cards');
|
|
}
|
|
else {
|
|
clean_url(\@content);
|
|
$key = repo_data('active','cards');
|
|
}
|
|
push(@$rows,
|
|
{main::key($num++,1,1,$key) => $cards},
|
|
[@content],
|
|
);
|
|
@content = ();
|
|
}
|
|
## tce: TinyCore
|
|
if (-e $tce_app || -f $tce_file || -f $tce_file2){
|
|
if (-f $tce_file){
|
|
$data = repo_builder($tce_file,'tce','^\s*[^#]+');
|
|
push(@$rows,@$data);
|
|
}
|
|
if (-f $tce_file2){
|
|
$data = repo_builder($tce_file2,'tce','^\s*[^#]+');
|
|
push(@$rows,@$data);
|
|
}
|
|
}
|
|
## xbps: Void
|
|
if (-d $xbps_dir_1 || -d $xbps_dir_2){
|
|
@files = main::globber("$xbps_dir_1*.conf");
|
|
push(@files,main::globber("$xbps_dir_2*.conf")) if -d $xbps_dir_2;
|
|
main::log_data('data',"xbps repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log;
|
|
foreach (sort @files){
|
|
if (-r $_){
|
|
$data = repo_builder($_,'xbps','^\s*repository\s*=','\s*=\s*',1);
|
|
push(@$rows,@$data);
|
|
}
|
|
}
|
|
}
|
|
## urpmq: Mandriva, Mageia
|
|
if ($path = main::check_program('urpmq')){
|
|
@data2 = main::grabber("$path --list-media active --list-url","\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.
|
|
# Contrib ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/contrib/release
|
|
# Contrib Updates ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/contrib/updates
|
|
# Non-free ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/non-free/release
|
|
# Non-free Updates ftp://ftp.uwsg.indiana.edu/linux/mandrake/official/2011/x86_64/media/non-free/updates
|
|
# Nonfree Updates (Local19) /mnt/data/mirrors/mageia/distrib/cauldron/x86_64/media/nonfree/updates
|
|
foreach (@data2){
|
|
# Need to dump leading/trailing spaces and clear out color codes for irc output
|
|
$_ =~ s/\x1B\[([0-9]{1,2}(;[0-9]{1,2})?)?[m|K]//g;
|
|
$_ =~ s/\e\[([0-9];)?[0-9]+m//g;
|
|
# urpmq output is the same each line, repo name space repo url, can be:
|
|
# rsync://, ftp://, file://, http:// OR repo is locally mounted on FS in some cases
|
|
if (/(.+)\s([\S]+:\/\/.+)/){
|
|
# pack the repo url
|
|
push(@content, $1);
|
|
clean_url(\@content);
|
|
# get the repo
|
|
$repo = $2;
|
|
push(@$rows,
|
|
{main::key($num++,1,1,'urpm repo') => $repo},
|
|
[@content],
|
|
);
|
|
@content = ();
|
|
}
|
|
}
|
|
}
|
|
# pisi: Pardus, Solus
|
|
if ((-d $pisi_dir && ($path = main::check_program('pisi'))) ||
|
|
(-d $eopkg_dir && ($path = main::check_program('eopkg')))){
|
|
#$path = 'eopkg';
|
|
my $which = ($path =~ /pisi$/) ? 'pisi': 'eopkg';
|
|
my $cmd = ($which eq 'pisi') ? "$path list-repo": "$path lr";
|
|
# my $file = "$ENV{HOME}/bin/scripts/inxi/data/repo/solus/eopkg-2.txt";
|
|
# @data2 = main::reader($file,'strip');
|
|
@data2 = main::grabber("$cmd 2>/dev/null","\n",'strip');
|
|
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.
|
|
# Pardus-2009.1 [Aktiv]
|
|
# http://packages.pardus.org.tr/pardus-2009.1/pisi-index.xml.bz2
|
|
# Contrib [Aktiv]
|
|
# http://packages.pardus.org.tr/contrib-2009/pisi-index.xml.bz2
|
|
# Solus [inactive]
|
|
# https://packages.solus-project.com/shannon/eopkg-index.xml.xz
|
|
foreach (@data2){
|
|
next if /^\s*$/;
|
|
# need to dump leading/trailing spaces and clear out color codes for irc output
|
|
$_ =~ s/\x1B\[([0-9]{1,2}(;[0-9]{1,2})?)?[m|K]//g;
|
|
$_ =~ s/\e\[([0-9];)?[0-9]+m//g;
|
|
if (/^\/|:\/\//){
|
|
push(@content, $_) if $repo;
|
|
}
|
|
# Local [inactive] Unstable [active]
|
|
elsif (/^(.*)\s\[([\S]+)\]/){
|
|
$repo = $1;
|
|
$repo = ($2 =~ /^activ/i) ? $repo : '';
|
|
}
|
|
if ($repo && @content){
|
|
clean_url(\@content);
|
|
$key = repo_data('active',$which);
|
|
push(@$rows,
|
|
{main::key($num++,1,1,$key) => $repo},
|
|
[@content],
|
|
);
|
|
$repo = '';
|
|
@content = ();
|
|
}
|
|
}
|
|
# last one if present
|
|
if ($repo && @content){
|
|
clean_url(\@content);
|
|
$key = repo_data('active',$which);
|
|
push(@$rows,
|
|
{main::key($num++,1,1,$key) => $repo},
|
|
[@content],
|
|
);
|
|
}
|
|
}
|
|
## nix: General pm for Linux/Unix
|
|
if (-f $nix && ($path = main::check_program('nix-channel'))){
|
|
@content = main::grabber("$path --list 2>/dev/null","\n",'strip');
|
|
main::writer("$debugger_dir/system-repo-data-nix.txt",\@content) if $debugger_dir;
|
|
if (!@content){
|
|
$key = repo_data('missing','nix');
|
|
}
|
|
else {
|
|
clean_url(\@content);
|
|
$key = repo_data('active','nix');
|
|
}
|
|
my $user = ($ENV{'USER'}) ? $ENV{'USER'}: 'N/A';
|
|
push(@$rows,
|
|
{main::key($num++,1,1,$key) => $user},
|
|
[@content],
|
|
);
|
|
@content = ();
|
|
|
|
}
|
|
# print Dumper $rows;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_repos_bsd {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my (@content,$data,@data2,@data3,@files);
|
|
my ($key);
|
|
my $bsd_pkg = '/usr/local/etc/pkg/repos/';
|
|
my $freebsd = '/etc/freebsd-update.conf';
|
|
my $freebsd_pkg = '/etc/pkg/FreeBSD.conf';
|
|
my $ghostbsd_pkg = '/etc/pkg/GhostBSD.conf';
|
|
my $hardenedbsd_pkg = '/etc/pkg/HardenedBSD.conf';
|
|
my $mports = '/usr/mports/Makefile';
|
|
my $netbsd = '/usr/pkg/etc/pkgin/repositories.conf';
|
|
my $openbsd = '/etc/pkg.conf';
|
|
my $openbsd2 = '/etc/installurl';
|
|
my $portsnap = '/etc/portsnap.conf';
|
|
if (-f $portsnap || -f $freebsd || -d $bsd_pkg ||
|
|
-f $ghostbsd_pkg || -f $hardenedbsd_pkg){
|
|
if (-f $portsnap){
|
|
$data = repo_builder($portsnap,'portsnap','^\s*SERVERNAME','\s*=\s*',1);
|
|
push(@$rows,@$data);
|
|
}
|
|
if (-f $freebsd){
|
|
$data = repo_builder($freebsd,'freebsd','^\s*ServerName','\s+',1);
|
|
push(@$rows,@$data);
|
|
}
|
|
if (-d $bsd_pkg || -f $freebsd_pkg || -f $ghostbsd_pkg || -f $hardenedbsd_pkg){
|
|
@files = main::globber('/usr/local/etc/pkg/repos/*.conf');
|
|
push(@files, $freebsd_pkg) if -f $freebsd_pkg;
|
|
push(@files, $ghostbsd_pkg) if -f $ghostbsd_pkg;
|
|
push(@files, $hardenedbsd_pkg) if -f $hardenedbsd_pkg;
|
|
if (@files){
|
|
my ($url);
|
|
foreach (@files){
|
|
push(@dbg_files, $_) if $debugger_dir;
|
|
# these will be result sets separated by an empty line
|
|
# first dump all lines that start with #
|
|
@content = main::reader($_,'strip');
|
|
# then do some clean up on the lines
|
|
@content = map { $_ =~ s/{|}|,|\*//g; $_;} @content if @content;
|
|
# get all rows not starting with a # and starting with a non space character
|
|
my $url = '';
|
|
foreach my $line (@content){
|
|
if ($line !~ /^\s*$/){
|
|
my @data2 = split(/\s*:\s*/, $line);
|
|
@data2 = map { $_ =~ s/^\s+|\s+$//g; $_;} @data2;
|
|
if ($data2[0] eq 'url'){
|
|
$url = "$data2[1]:$data2[2]";
|
|
$url =~ s/"|,//g;
|
|
}
|
|
# print "url:$url\n" if $url;
|
|
if ($data2[0] eq 'enabled'){
|
|
if ($url && $data2[1] =~ /^(1|true|yes)$/i){
|
|
push(@data3, "$url");
|
|
}
|
|
$url = '';
|
|
}
|
|
}
|
|
}
|
|
if (!@data3){
|
|
$key = repo_data('missing','bsd-package');
|
|
}
|
|
else {
|
|
clean_url(\@data3);
|
|
$key = repo_data('active','bsd-package');
|
|
}
|
|
push(@$rows,
|
|
{main::key($num++,1,1,$key) => $_},
|
|
[@data3],
|
|
);
|
|
@data3 = ();
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if (-f $openbsd || -f $openbsd2){
|
|
if (-f $openbsd){
|
|
$data = repo_builder($openbsd,'openbsd','^installpath','\s*=\s*',1);
|
|
push(@$rows,@$data);
|
|
}
|
|
if (-f $openbsd2){
|
|
$data = repo_builder($openbsd2,'openbsd','^(http|ftp)','',1);
|
|
push(@$rows,@$data);
|
|
}
|
|
}
|
|
if (-f $netbsd){
|
|
# not an empty row, and not a row starting with #
|
|
$data = repo_builder($netbsd,'netbsd','^\s*[^#]+$');
|
|
push(@$rows,@$data);
|
|
}
|
|
# I don't think this is right, have to find out, for midnightbsd
|
|
# if (-f $mports){
|
|
# @data = main::reader($mports,'strip');
|
|
# main::writer("$debugger_dir/system-repo-data-mports.txt",\@data) if $debugger_dir;
|
|
# for (@data){
|
|
# if (!/^MASTER_SITE_INDEX/){
|
|
# next;
|
|
# }
|
|
# else {
|
|
# push(@data3,(split(/=\s*/,$_))[1]);
|
|
# }
|
|
# last if /^INDEX/;
|
|
# }
|
|
# if (!@data3){
|
|
# $key = repo_data('missing','mports');
|
|
# }
|
|
# else {
|
|
# clean_url(\@data3);
|
|
# $key = repo_data('active','mports');
|
|
# }
|
|
# push(@$rows,
|
|
# {main::key($num++,1,1,$key) => $mports},
|
|
# [@data3],
|
|
# );
|
|
# @data3 = ();
|
|
# }
|
|
# BSDs do not default always to having repo files, so show correct error
|
|
# mesage in that case
|
|
if (!@$rows){
|
|
if ($bsd_type eq 'freebsd'){
|
|
$key = repo_data('missing','freebsd-files');
|
|
}
|
|
elsif ($bsd_type eq 'openbsd'){
|
|
$key = repo_data('missing','openbsd-files');
|
|
}
|
|
elsif ($bsd_type eq 'netbsd'){
|
|
$key = repo_data('missing','netbsd-files');
|
|
}
|
|
else {
|
|
$key = repo_data('missing','bsd-files');
|
|
}
|
|
push(@$rows,
|
|
{main::key($num++,0,1,'Message') => $key},
|
|
[()],
|
|
);
|
|
}
|
|
eval $start if $b_log;
|
|
}
|
|
|
|
sub set_repo_keys {
|
|
eval $start if $b_log;
|
|
%repo_keys = (
|
|
'apk-active' => 'APK repo',
|
|
'apk-missing' => 'No active APK repos in',
|
|
'apt-active' => 'Active apt repos in',
|
|
'apt-missing' => 'No active apt repos in',
|
|
'bsd-files-missing' => 'No pkg server files found',
|
|
'bsd-package-active' => 'Enabled pkg servers in',
|
|
'bsd-package-missing' => 'No enabled BSD pkg servers in',
|
|
'cards-active' => 'Active CARDS collections in',
|
|
'cards-missing' => 'No active CARDS collections in',
|
|
'dnf-active' => 'Active dnf repos in',
|
|
'dnf-missing' => 'No active dnf repos in',
|
|
'eopkg-active' => 'Active eopkg repo',
|
|
'eopkg-missing' => 'No active eopkg repos found',
|
|
'files-missing' => 'No repo files found in',
|
|
'freebsd-active' => 'FreeBSD update server',
|
|
'freebsd-files-missing' => 'No FreeBSD update server files found',
|
|
'freebsd-missing' => 'No FreeBSD update servers in',
|
|
'freebsd-pkg-active' => 'FreeBSD default pkg server',
|
|
'freebsd-pkg-missing' => 'No FreeBSD default pkg server in',
|
|
'mports-active' => 'mports servers',
|
|
'mports-missing' => 'No mports servers found',
|
|
'netbsd-active' => 'NetBSD pkg servers',
|
|
'netbsd-files-missing' => 'No NetBSD pkg server files found',
|
|
'netbsd-missing' => 'No NetBSD pkg servers in',
|
|
'netpkg-active' => 'Active netpkg repos in',
|
|
'netpkg-missing' => 'No active netpkg repos in',
|
|
'nix-active' => 'Active nix channels for user',
|
|
'nix-missing' => 'No nix channels found for user',
|
|
'openbsd-active' => 'OpenBSD pkg mirror',
|
|
'openbsd-files-missing' => 'No OpenBSD pkg mirror files found',
|
|
'openbsd-missing' => 'No OpenBSD pkg mirrors in',
|
|
'pacman-active' => 'Active pacman repo servers in',
|
|
'pacman-missing' => 'No active pacman repos in',
|
|
'pacman-g2-active' => 'Active pacman-g2 repo servers in',
|
|
'pacman-g2-missing' => 'No active pacman-g2 repos in',
|
|
'pisi-active' => 'Active pisi repo',
|
|
'pisi-missing' => 'No active pisi repos found',
|
|
'portage-active' => 'Enabled portage sources in',
|
|
'portage-missing' => 'No enabled portage sources in',
|
|
'portsnap-active' => 'Ports server',
|
|
'portsnap-missing' => 'No ports servers in',
|
|
'sbopkg-active' => 'Active sbopkg repo',
|
|
'sbopkg-active-permissions' => 'Active sbopkg repo (confirm with root)',
|
|
'sbopkg-missing' => 'No sbopkg repo',
|
|
'sboui-active' => 'Active sboui repo',
|
|
'sboui-missing' => 'No sboui repo',
|
|
'scratchpkg-active' => 'scratchpkg repos in',
|
|
'scratchpkg-missing' => 'No active scratchpkg repos in',
|
|
'slackpkg-active' => 'slackpkg mirror in',
|
|
'slackpkg-missing' => 'No slackpkg mirror set in',
|
|
'slackpkg+-active' => 'slackpkg+ repos in',
|
|
'slackpkg+-missing' => 'No active slackpkg+ repos in',
|
|
'slaptget-active' => 'slapt-get repos in',
|
|
'slaptget-missing' => 'No active slapt-get repos in',
|
|
'slpkg-active' => 'Active slpkg repos in',
|
|
'slpkg-missing' => 'No active slpkg repos in',
|
|
'tce-active' => 'tce mirrors in',
|
|
'tce-missing' => 'No tce mirrors in',
|
|
'xbps-active' => 'Active xbps repos in',
|
|
'xbps-missing' => 'No active xbps repos in',
|
|
'yum-active' => 'Active yum repos in',
|
|
'yum-missing' => 'No active yum repos in',
|
|
'zypp-active' => 'Active zypp repos in',
|
|
'zypp-missing' => 'No active zypp repos in',
|
|
);
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub repo_data {
|
|
eval $start if $b_log;
|
|
my ($status,$type) = @_;
|
|
set_repo_keys() if !%repo_keys;
|
|
eval $end if $b_log;
|
|
return $repo_keys{$type . '-' . $status};
|
|
}
|
|
|
|
sub repo_builder {
|
|
eval $start if $b_log;
|
|
my ($file,$type,$search,$split,$count) = @_;
|
|
my (@content,$key);
|
|
push(@dbg_files, $file) if $debugger_dir;
|
|
if (-r $file){
|
|
@content = main::reader($file);
|
|
@content = grep {/$search/i && !/^\s*$/} @content if @content;
|
|
clean_data(\@content) if @content;
|
|
}
|
|
if ($split && @content){
|
|
@content = map {
|
|
my @inner = split(/$split/, $_);
|
|
$inner[$count];
|
|
} @content;
|
|
}
|
|
if (!@content){
|
|
$key = repo_data('missing',$type);
|
|
}
|
|
else {
|
|
$key = repo_data('active',$type);
|
|
clean_url(\@content);
|
|
}
|
|
eval $end if $b_log;
|
|
return [
|
|
{main::key($num++,1,1,$key) => $file},
|
|
[@content],
|
|
];
|
|
}
|
|
|
|
sub clean_data {
|
|
# basics: trim white space, get rid of double spaces; trim comments at
|
|
# ends of repo values
|
|
@{$_[0]} = map {
|
|
$_ =~ s/\s\s+/ /g;
|
|
$_ =~ s/^\s+|\s+$//g;
|
|
$_ =~ s/\[\s+/[/g; # [ signed-by
|
|
$_ =~ s/\s+\]/]/g;
|
|
$_ =~ s/^(.*\/.*) #.*/$1/;
|
|
$_;} @{$_[0]};
|
|
}
|
|
|
|
# Clean if irc
|
|
sub clean_url {
|
|
@{$_[0]} = map {$_ =~ s/:\//: \//; $_} @{$_[0]} if $b_irc;
|
|
# trim comments at ends of repo values
|
|
@{$_[0]} = map {$_ =~ s/^(.*\/.*) #.*/$1/; $_} @{$_[0]};
|
|
}
|
|
|
|
sub file_path {
|
|
my ($filename,$dir) = @_;
|
|
my ($working);
|
|
$working = $filename;
|
|
$working =~ s/^\///;
|
|
$working =~ s/\//-/g;
|
|
$working = "$dir/file-repo-$working.txt";
|
|
return $working;
|
|
}
|
|
}
|
|
|
|
## SensorItem
|
|
{
|
|
package SensorItem;
|
|
my $gpu_data = [];
|
|
my $sensors_raw = {};
|
|
my $max_fan = 15000;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my ($b_data,$b_ipmi,$b_no_lm,$b_no_sys);
|
|
my ($message_type,$program,$val1,$sensors);
|
|
my ($key1,$num,$rows) = ('Message',0,[]);
|
|
my $source = 'sensors'; # will trip some type output if ipmi + another type
|
|
# we're allowing 1 or 2 ipmi tools, first the gnu one, then the
|
|
# almost certain to be present in BSDs
|
|
if ($fake{'ipmi'} || (main::globber('/dev/ipmi**') &&
|
|
(($program = main::check_program('ipmi-sensors')) ||
|
|
($program = main::check_program('ipmitool'))))){
|
|
if ($fake{'ipmi'} || $b_root){
|
|
$sensors = ipmi_data($program);
|
|
$b_data = sensors_output($rows,'ipmi',$sensors);
|
|
if (!$b_data){
|
|
$val1 = main::message('sensor-data-ipmi');
|
|
push(@$rows,{
|
|
main::key($num++,1,1,'Src') => 'ipmi',
|
|
main::key($num++,0,1,$key1) => $val1,
|
|
});
|
|
}
|
|
}
|
|
else {
|
|
$key1 = 'Permissions';
|
|
$val1 = main::message('sensor-data-ipmi-root');
|
|
push(@$rows,{
|
|
main::key($num++,1,1,'Src') => 'ipmi',
|
|
main::key($num++,0,2,$key1) => $val1,
|
|
});
|
|
}
|
|
$b_ipmi = 1;
|
|
}
|
|
$b_data = 0;
|
|
if ($bsd_type){
|
|
if ($sysctl{'sensor'}){
|
|
$sensors = sysctl_data();
|
|
$source = 'sysctl' if $b_ipmi;
|
|
$b_data = sensors_output($rows,$source,$sensors);
|
|
if (!$b_data){
|
|
$source = 'sysctl';
|
|
$val1 = main::message('sensor-data-bsd',$uname[0]);
|
|
}
|
|
}
|
|
else {
|
|
if ($bsd_type =~ /^(free|open)bsd/){
|
|
$source = 'sysctl';
|
|
$val1 = main::message('sensor-data-bsd-ok');
|
|
}
|
|
else {
|
|
$source = 'N/A';
|
|
$val1 = main::message('sensor-data-bsd-unsupported');
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
if (!$force{'sensors-sys'} &&
|
|
($fake{'sensors'} || $alerts{'sensors'}->{'action'} eq 'use')){
|
|
load_lm_sensors();
|
|
$sensors = linux_sensors_data();
|
|
$source = 'lm-sensors' if $b_ipmi; # trips per sensor type output
|
|
$b_data = sensors_output($rows,$source,$sensors);
|
|
# print "here 1\n";
|
|
$b_no_lm = 1 if !$b_data;
|
|
}
|
|
# given recency of full /sys data, we want to prefer lm-sensors for a long time
|
|
# and use /sys as a fallback. This will handle servers, which often do not
|
|
# have lm-sensors installed, but do have /sys hwmon data.
|
|
if (!$b_data && -d '/sys/class/hwmon'){
|
|
load_sys_data();
|
|
$sensors = linux_sensors_data();
|
|
$source = '/sys'; # trips per sensor type output
|
|
$b_data = sensors_output($rows,$source,$sensors);
|
|
# print "here 2\n";
|
|
$b_no_sys = 1 if !$b_data;
|
|
}
|
|
if (!$b_data){
|
|
if ($b_no_lm || $b_no_sys){
|
|
if ($b_no_lm && $b_no_sys){
|
|
$source = 'lm-sensors+/sys';
|
|
$val1 = main::message('sensor-data-sys-lm');
|
|
}
|
|
elsif ($b_no_lm){
|
|
$source = 'lm-sensors';
|
|
$val1 = main::message('sensor-data-lm-sensors');
|
|
}
|
|
else {
|
|
$val1 = main::message('sensor-data-sys');
|
|
}
|
|
}
|
|
elsif (!$fake{'sensors'} && $alerts{'sensors'}->{'action'} ne 'use'){
|
|
# print "here 3\n";
|
|
$source = 'lm-sensors';
|
|
$key1 = $alerts{'sensors'}->{'action'};
|
|
$key1 = ucfirst($key1);
|
|
$val1 = $alerts{'sensors'}->{'message'};
|
|
}
|
|
else {
|
|
$source = 'N/A';
|
|
$val1 = main::message('sensors-data-linux');
|
|
}
|
|
}
|
|
}
|
|
if (!$b_data){
|
|
push(@$rows,{
|
|
main::key($num++,1,1,'Src') => $source,
|
|
main::key($num++,0,2,$key1) => $val1,
|
|
});
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub sensors_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$source,$sensors) = @_;
|
|
my ($b_result,@fan_default,@fan_main);
|
|
my $fan_number = 0;
|
|
my $num = 0;
|
|
my $j = scalar @$rows;
|
|
if (!$loaded{'gpu-data'} &&
|
|
($source eq 'sensors' || $source eq 'lm-sensors' || $source eq '/sys')){
|
|
gpu_sensor_data();
|
|
}
|
|
# gpu sensors data might be present even if standard sensors data wasn't
|
|
return if !%$sensors && !@$gpu_data;
|
|
$b_result = 1; ## need to trip data found conditions
|
|
my $temp_unit = (defined $sensors->{'temp-unit'}) ? " $sensors->{'temp-unit'}": '';
|
|
my $cpu_temp = (defined $sensors->{'cpu-temp'}) ? $sensors->{'cpu-temp'} . $temp_unit: 'N/A';
|
|
my $mobo_temp = (defined $sensors->{'mobo-temp'}) ? $sensors->{'mobo-temp'} . $temp_unit: 'N/A';
|
|
my $cpu1_key = ($sensors->{'cpu2-temp'}) ? 'cpu-1': 'cpu';
|
|
my ($l1,$l2,$l3) = (1,2,3);
|
|
if ($source ne 'sensors'){
|
|
$rows->[$j]{main::key($num++,1,1,'Src')} = $source;
|
|
($l1,$l2,$l3) = (2,3,4);
|
|
}
|
|
$rows->[$j]{main::key($num++,1,$l1,'System Temperatures')} = '';
|
|
$rows->[$j]{main::key($num++,0,$l2,$cpu1_key)} = $cpu_temp;
|
|
if ($sensors->{'cpu2-temp'}){
|
|
$rows->[$j]{main::key($num++,0,$l2,'cpu-2')} = $sensors->{'cpu2-temp'} . $temp_unit;
|
|
}
|
|
if ($sensors->{'cpu3-temp'}){
|
|
$rows->[$j]{main::key($num++,0,$l2,'cpu-3')} = $sensors->{'cpu3-temp'} . $temp_unit;
|
|
}
|
|
if ($sensors->{'cpu4-temp'}){
|
|
$rows->[$j]{main::key($num++,0,$l2,'cpu-4')} = $sensors->{'cpu4-temp'} . $temp_unit;
|
|
}
|
|
if (defined $sensors->{'pch-temp'}){
|
|
my $pch_temp = $sensors->{'pch-temp'} . $temp_unit;
|
|
$rows->[$j]{main::key($num++,0,$l2,'pch')} = $pch_temp;
|
|
}
|
|
$rows->[$j]{main::key($num++,0,$l2,'mobo')} = $mobo_temp;
|
|
if (defined $sensors->{'sodimm-temp'}){
|
|
my $sodimm_temp = $sensors->{'sodimm-temp'} . $temp_unit;
|
|
$rows->[$j]{main::key($num++,0,$l2,'sodimm')} = $sodimm_temp;
|
|
}
|
|
if (defined $sensors->{'psu-temp'}){
|
|
my $psu_temp = $sensors->{'psu-temp'} . $temp_unit;
|
|
$rows->[$j]{main::key($num++,0,$l2,'psu')} = $psu_temp;
|
|
}
|
|
if (defined $sensors->{'ambient-temp'}){
|
|
my $ambient_temp = $sensors->{'ambient-temp'} . $temp_unit;
|
|
$rows->[$j]{main::key($num++,0,$l2,'ambient')} = $ambient_temp;
|
|
}
|
|
if (scalar @$gpu_data == 1 && defined $gpu_data->[0]{'temp'}){
|
|
my $gpu_temp = $gpu_data->[0]{'temp'};
|
|
my $gpu_type = $gpu_data->[0]{'type'};
|
|
my $gpu_unit = (defined $gpu_data->[0]{'temp-unit'} && $gpu_temp) ? " $gpu_data->[0]{'temp-unit'}" : ' C';
|
|
$rows->[$j]{main::key($num++,1,$l2,'gpu')} = $gpu_type;
|
|
$rows->[$j]{main::key($num++,0,$l3,'temp')} = $gpu_temp . $gpu_unit;
|
|
if ($extra > 1 && $gpu_data->[0]{'temp-mem'}){
|
|
$rows->[$j]{main::key($num++,0,$l3,'mem')} = $gpu_data->[0]{'temp-mem'} . $gpu_unit;
|
|
}
|
|
}
|
|
$j = scalar @$rows;
|
|
@fan_main = @{$sensors->{'fan-main'}} if $sensors->{'fan-main'};
|
|
@fan_default = @{$sensors->{'fan-default'}} if $sensors->{'fan-default'};
|
|
my $fan_def = (!@fan_main && !@fan_default) ? 'N/A' : '';
|
|
$rows->[$j]{main::key($num++,1,$l1,'Fan Speeds (rpm)')} = $fan_def;
|
|
my $b_cpu = 0;
|
|
for (my $i = 0; $i < scalar @fan_main; $i++){
|
|
next if $i == 0;# starts at 1, not 0
|
|
if (defined $fan_main[$i]){
|
|
if ($i == 1 || ($i == 2 && !$b_cpu)){
|
|
$rows->[$j]{main::key($num++,0,$l2,'cpu')} = $fan_main[$i];
|
|
$b_cpu = 1;
|
|
}
|
|
elsif ($i == 2 && $b_cpu){
|
|
$rows->[$j]{main::key($num++,0,$l2,'mobo')} = $fan_main[$i];
|
|
}
|
|
elsif ($i == 3){
|
|
$rows->[$j]{main::key($num++,0,$l2,'psu')} = $fan_main[$i];
|
|
}
|
|
elsif ($i == 4){
|
|
$rows->[$j]{main::key($num++,0,$l2,'sodimm')} = $fan_main[$i];
|
|
}
|
|
elsif ($i > 4){
|
|
$fan_number = $i - 4;
|
|
$rows->[$j]{main::key($num++,0,$l2,"case-$fan_number")} = $fan_main[$i];
|
|
}
|
|
}
|
|
}
|
|
for (my $i = 0; $i < scalar @fan_default; $i++){
|
|
next if $i == 0;# starts at 1, not 0
|
|
if (defined $fan_default[$i]){
|
|
$rows->[$j]{main::key($num++,0,$l2,"fan-$i")} = $fan_default[$i];
|
|
}
|
|
}
|
|
$rows->[$j]{main::key($num++,0,$l2,'psu')} = $sensors->{'fan-psu'} if defined $sensors->{'fan-psu'};
|
|
$rows->[$j]{main::key($num++,0,$l2,'psu-1')} = $sensors->{'fan-psu1'} if defined $sensors->{'fan-psu1'};
|
|
$rows->[$j]{main::key($num++,0,$l2,'psu-2')} = $sensors->{'fan-psu2'} if defined $sensors->{'fan-psu2'};
|
|
# note: so far, only nvidia-settings returns speed, and that's in percent
|
|
if (scalar @$gpu_data == 1 && defined $gpu_data->[0]{'fan-speed'}){
|
|
my $gpu_fan = $gpu_data->[0]{'fan-speed'} . $gpu_data->[0]{'speed-unit'};
|
|
my $gpu_type = $gpu_data->[0]{'type'};
|
|
$rows->[$j]{main::key($num++,1,$l2,'gpu')} = $gpu_type;
|
|
$rows->[$j]{main::key($num++,0,$l3,'fan')} = $gpu_fan;
|
|
}
|
|
if (scalar @$gpu_data > 1){
|
|
$j = scalar @$rows;
|
|
$rows->[$j]{main::key($num++,1,$l1,'GPU')} = '';
|
|
my $gpu_unit = (defined $gpu_data->[0]{'temp-unit'}) ? " $gpu_data->[0]{'temp-unit'}" : ' C';
|
|
foreach my $info (@$gpu_data){
|
|
# speed unit is either '' or %
|
|
my $gpu_fan = (defined $info->{'fan-speed'}) ? $info->{'fan-speed'} . $info->{'speed-unit'}: undef;
|
|
my $gpu_type = $info->{'type'};
|
|
my $gpu_temp = (defined $info->{'temp'}) ? $info->{'temp'} . $gpu_unit: 'N/A';
|
|
$rows->[$j]{main::key($num++,1,$l2,'device')} = $gpu_type;
|
|
if (defined $info->{'screen'}){
|
|
$rows->[$j]{main::key($num++,0,$l3,'screen')} = $info->{'screen'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,$l3,'temp')} = $gpu_temp;
|
|
if ($extra > 1 && $info->{'temp-mem'}){
|
|
$rows->[$j]{main::key($num++,0,$l3,'mem')} = $info->{'temp-mem'} . $gpu_unit;
|
|
}
|
|
if (defined $gpu_fan){
|
|
$rows->[$j]{main::key($num++,0,$l3,'fan')} = $gpu_fan;
|
|
}
|
|
if ($extra > 2 && $info->{'watts'}){
|
|
$rows->[$j]{main::key($num++,0,$l3,'watts')} = $info->{'watts'};
|
|
}
|
|
if ($extra > 2 && $info->{'volts-gpu'}){
|
|
$rows->[$j]{main::key($num++,0,$l3,$info->{'volts-gpu'}[1])} = $info->{'volts-gpu'}[0];
|
|
}
|
|
}
|
|
}
|
|
if ($extra > 0 && ($source eq 'ipmi' ||
|
|
($sensors->{'volts-12'} || $sensors->{'volts-5'} || $sensors->{'volts-3.3'} ||
|
|
$sensors->{'volts-vbat'}))){
|
|
$j = scalar @$rows;
|
|
$sensors->{'volts-12'} ||= 'N/A';
|
|
$sensors->{'volts-5'} ||= 'N/A';
|
|
$sensors->{'volts-3.3'} ||= 'N/A';
|
|
$sensors->{'volts-vbat'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,1,$l1,'Power')} = '';
|
|
$rows->[$j]{main::key($num++,0,$l2,'12v')} = $sensors->{'volts-12'};
|
|
$rows->[$j]{main::key($num++,0,$l2,'5v')} = $sensors->{'volts-5'};
|
|
$rows->[$j]{main::key($num++,0,$l2,'3.3v')} = $sensors->{'volts-3.3'};
|
|
$rows->[$j]{main::key($num++,0,$l2,'vbat')} = $sensors->{'volts-vbat'};
|
|
if ($extra > 1 && $source eq 'ipmi'){
|
|
$sensors->{'volts-dimm-p1'} ||= 'N/A';
|
|
$sensors->{'volts-dimm-p2'} ||= 'N/A';
|
|
if ($sensors->{'volts-dimm-p1'}){
|
|
$rows->[$j]{main::key($num++,0,$l2,'dimm-p1')} = $sensors->{'volts-dimm-p1'};
|
|
}
|
|
if ($sensors->{'volts-dimm-p2'}){
|
|
$rows->[$j]{main::key($num++,0,$l2,'dimm-p2')} = $sensors->{'volts-dimm-p2'};
|
|
}
|
|
if ($sensors->{'volts-soc-p1'}){
|
|
$rows->[$j]{main::key($num++,0,$l2,'soc-p1')} = $sensors->{'volts-soc-p1'};
|
|
}
|
|
if ($sensors->{'volts-soc-p2'}){
|
|
$rows->[$j]{main::key($num++,0,$l2,'soc-p2')} = $sensors->{'volts-soc-p2'};
|
|
}
|
|
}
|
|
if (scalar @$gpu_data == 1 && $extra > 2 &&
|
|
($gpu_data->[0]{'watts'} || $gpu_data->[0]{'volts-gpu'})){
|
|
$rows->[$j]{main::key($num++,1,$l2,'gpu')} = $gpu_data->[0]{'type'};
|
|
if ($gpu_data->[0]{'watts'}){
|
|
$rows->[$j]{main::key($num++,0,$l3,'watts')} = $gpu_data->[0]{'watts'};
|
|
}
|
|
if ($gpu_data->[0]{'volts-gpu'}){
|
|
$rows->[$j]{main::key($num++,0,$l3,$gpu_data->[0]{'volts-gpu'}[1])} = $gpu_data->[0]{'volts-gpu'}[0];
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $b_result;
|
|
}
|
|
|
|
sub ipmi_data {
|
|
eval $start if $b_log;
|
|
my ($program) = @_;
|
|
my ($b_cpu_0,$cmd,$file,@data,$fan_working,@row,$speed,$sys_fan_nu,$temp_working,
|
|
$working_unit);
|
|
my ($b_ipmitool,$i_key,$i_value,$i_unit);
|
|
my $sensors = {};
|
|
if ($fake{'ipmi'}){
|
|
## ipmitool ##
|
|
# $file = "$fake_data_dir/sensors/ipmitool/ipmitool-sensors-archerseven-1.txt";$program='ipmitool';
|
|
# $file = "$fake_data_dir/sensorsipmitool/ipmitool-sensors-epyc-1.txt";$program='ipmitool';
|
|
# $file = "$fake_data_dir/sensorsipmitool/ipmitool-sensors-RK016013.txt";$program='ipmitool';
|
|
# $file = "$fake_data_dir/sensorsipmitool/ipmitool-sensors-freebsd-offsite-backup.txt";
|
|
# $file = "$fake_data_dir/sensorsipmitool/ipmitool-sensor-shom-1.txt";$program='ipmitool';
|
|
# $file = "$fake_data_dir/sensorsipmitool/ipmitool-sensor-shom-2.txt";$program='ipmitool';
|
|
# $file = "$fake_data_dir/sensorsipmitool/ipmitool-sensor-tyan-1.txt";$program='ipmitool';
|
|
# ($b_ipmitool,$i_key,$i_value,$i_unit) = (1,0,1,2); # ipmitool sensors
|
|
## ipmi-sensors ##
|
|
# $file = "$fake_data_dir/sensorsipmitool/ipmi-sensors-epyc-1.txt";$program='ipmi-sensors';
|
|
# $file = "$fake_data_dir/sensorsipmitool/ipmi-sensors-lathander.txt";$program='ipmi-sensors';
|
|
# $file = "$fake_data_dir/sensorsipmitool/ipmi-sensors-zwerg.txt";$program='ipmi-sensors';
|
|
# $file = "$fake_data_dir/sensorsipmitool/ipmi-sensors-arm-server-1.txt";$program='ipmi-sensors';
|
|
# ($b_ipmitool,$i_key,$i_value,$i_unit) = (0,1,3,4); # ipmi-sensors
|
|
# @data = main::reader($file);
|
|
}
|
|
else {
|
|
if ($program =~ /ipmi-sensors$/){
|
|
$cmd = $program;
|
|
($b_ipmitool,$i_key,$i_value,$i_unit) = (0,1,3,4);
|
|
}
|
|
else { # ipmitool
|
|
$cmd = "$program sensor"; # note: 'sensor' NOT 'sensors' !!
|
|
($b_ipmitool,$i_key,$i_value,$i_unit) = (1,0,1,2);
|
|
}
|
|
@data = main::grabber("$cmd 2>/dev/null");
|
|
}
|
|
# print join("\n", @data), "\n";
|
|
# shouldn't need to log, but saw a case with debugger ipmi data, but none here apparently
|
|
main::log_data('dump','ipmi @data',\@data) if $b_log;
|
|
return $sensors if !@data;
|
|
foreach (@data){
|
|
next if /^\s*$/;
|
|
# print "$_\n";
|
|
@row = split(/\s*\|\s*/, $_);
|
|
# print "$row[$i_value]\n";
|
|
next if !main::is_numeric($row[$i_value]);
|
|
# print "$row[$i_key] - $row[$i_value]\n";
|
|
if (!$sensors->{'mobo-temp'} && $row[$i_key] =~ /^(MB[\s_-]?TEMP[0-9]|System[\s_-]?Temp|System[\s_-]?Board([\s_-]?Temp)?)$/i){
|
|
$sensors->{'mobo-temp'} = int($row[$i_value]);
|
|
$working_unit = $row[$i_unit];
|
|
$working_unit =~ s/degrees\s// if $b_ipmitool;
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
elsif ($row[$i_key] =~ /^(System[\s_-]?)?(Ambient)([\s_-]?Temp)?$/i){
|
|
$sensors->{'ambient-temp'} = int($row[$i_value]);
|
|
$working_unit = $row[$i_unit];
|
|
$working_unit =~ s/degrees\s// if $b_ipmitool;
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
# Platform Control Hub (PCH), it is the X370 chip on the Crosshair VI Hero.
|
|
# VRM: voltage regulator module
|
|
# NOTE: CPU0_TEMP CPU1_TEMP is possible, unfortunately; CPU Temp Interf
|
|
elsif (!$sensors->{'cpu-temp'} && $row[$i_key] =~ /^CPU[\s_-]?([01])?([\s_](below[\s_]Tmax|Temp))?$/i){
|
|
$b_cpu_0 = 1 if defined $1 && $1 == 0;
|
|
$sensors->{'cpu-temp'} = int($row[$i_value]);
|
|
$working_unit = $row[$i_unit];
|
|
$working_unit =~ s/degrees\s// if $b_ipmitool;
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
elsif ($row[$i_key] =~ /^CPU[\s_-]?([1-4])([\s_](below[\s_]Tmax|Temp))?$/i){
|
|
$temp_working = $1;
|
|
$temp_working++ if $b_cpu_0;
|
|
$sensors->{"cpu${temp_working}-temp"} = int($row[$i_value]);
|
|
$working_unit = $row[$i_unit];
|
|
$working_unit =~ s/degrees\s// if $b_ipmitool;
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
# for temp1/2 only use temp1/2 if they are null or greater than the last ones
|
|
elsif ($row[$i_key] =~ /^(MB[\s_-]?TEMP1|Temp[\s_]1)$/i){
|
|
$temp_working = int($row[$i_value]);
|
|
$working_unit = $row[$i_unit];
|
|
$working_unit =~ s/degrees\s// if $b_ipmitool;
|
|
if (!$sensors->{'temp1'} || (defined $temp_working && $temp_working > 0)){
|
|
$sensors->{'temp1'} = $temp_working;
|
|
}
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
elsif ($row[$i_key] =~ /^(MB[_]?TEMP2|Temp[\s_]2)$/i){
|
|
$temp_working = int($row[$i_value]);
|
|
$working_unit = $row[$i_unit];
|
|
$working_unit =~ s/degrees\s// if $b_ipmitool;
|
|
if (!$sensors->{'temp2'} || (defined $temp_working && $temp_working > 0)){
|
|
$sensors->{'temp2'} = $temp_working;
|
|
}
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
# temp3 is only used as an absolute override for systems with all 3 present
|
|
elsif ($row[$i_key] =~ /^(MB[_]?TEMP3|Temp[\s_]3)$/i){
|
|
$temp_working = int($row[$i_value]);
|
|
$working_unit = $row[$i_unit];
|
|
$working_unit =~ s/degrees\s// if $b_ipmitool;
|
|
if (!$sensors->{'temp3'} || (defined $temp_working && $temp_working > 0)){
|
|
$sensors->{'temp3'} = $temp_working;
|
|
}
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
elsif (!$sensors->{'sodimm-temp'} && ($row[$i_key] =~ /^(DIMM[-_]([A-Z][0-9]+[-_])?[A-Z]?[0-9]+[A-Z]?)$/i ||
|
|
$row[$i_key] =~ /^DIMM\s?[0-9]+ (Area|Temp).*/)){
|
|
$sensors->{'sodimm-temp'} = int($row[$i_value]);
|
|
$working_unit = $row[$i_unit];
|
|
$working_unit =~ s/degrees\s// if $b_ipmitool;
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
# note: can be cpu fan:, cpu fan speed:, etc.
|
|
elsif ($row[$i_key] =~ /^(CPU|Processor)[\s_]Fan/i ||
|
|
$row[$i_key] =~ /^SYS\.[0-9][\s_]?\(CPU\s?0\)$/i){
|
|
$speed = int($row[$i_value]);
|
|
$sensors->{'fan-main'}->[1] = $speed if $speed < $max_fan;
|
|
}
|
|
# note that the counters are dynamically set for fan numbers here
|
|
# otherwise you could overwrite eg aux fan2 with case fan2 in theory
|
|
# note: cpu/mobo/ps are 1/2/3
|
|
# SYS.3(Front 2)
|
|
# $row[$i_key] =~ /^(SYS[\.])([0-9])\s?\((Front|Rear).+\)$/i
|
|
elsif ($row[$i_key] =~ /^(SYS[\s_])?FAN[\s_]?([0-9A-F]+)/i){
|
|
$sys_fan_nu = hex($2);
|
|
$fan_working = int($row[$i_value]);
|
|
next if $fan_working > $max_fan;
|
|
$sensors->{'fan-default'} = () if !$sensors->{'fan-default'};
|
|
if ($sys_fan_nu =~ /^([0-9]+)$/){
|
|
# add to array if array index does not exist OR if number is > existing number
|
|
if (defined $sensors->{'fan-default'}->[$sys_fan_nu]){
|
|
if ($fan_working >= $sensors->{'fan-default'}->[$sys_fan_nu]){
|
|
$sensors->{'fan-default'}->[$sys_fan_nu] = $fan_working;
|
|
}
|
|
}
|
|
else {
|
|
$sensors->{'fan-default'}->[$sys_fan_nu] = $fan_working;
|
|
}
|
|
}
|
|
}
|
|
elsif ($row[$i_key] =~ /^(FAN PSU|PSU FAN)$/i){
|
|
$speed = int($row[$i_value]);
|
|
$sensors->{'fan-psu'} = $speed if $speed < $max_fan;
|
|
}
|
|
elsif ($row[$i_key] =~ /^(FAN PSU1|PSU1 FAN)$/i){
|
|
$speed = int($row[$i_value]);
|
|
$sensors->{'fan-psu-1'} = $speed if $speed < $max_fan;
|
|
}
|
|
elsif ($row[$i_key] =~ /^(FAN PSU2|PSU2 FAN)$/i){
|
|
$speed = int($row[$i_value]);
|
|
$sensors->{'fan-psu-2'} = $speed if $speed < $max_fan;
|
|
}
|
|
if ($extra > 0){
|
|
if ($row[$i_key] =~ /^((.+\s|P[_]?)?\+?12V|PSU[12]_VOUT)$/i){
|
|
$sensors->{'volts-12'} = $row[$i_value];
|
|
}
|
|
elsif ($row[$i_key] =~ /^(.+\s5V|P5V|5VCC|5V( PG)?|5V_SB)$/i){
|
|
$sensors->{'volts-5'} = $row[$i_value];
|
|
}
|
|
elsif ($row[$i_key] =~ /^(.+\s3\.3V|P3V3|3\.3VCC|3\.3V( PG)?|3V3_SB)$/i){
|
|
$sensors->{'volts-3.3'} = $row[$i_value];
|
|
}
|
|
elsif ($row[$i_key] =~ /^((P_)?VBAT|CMOS Battery|BATT 3.0V)$/i){
|
|
$sensors->{'volts-vbat'} = $row[$i_value];
|
|
}
|
|
# NOTE: VDimmP1ABC VDimmP1DEF
|
|
elsif (!$sensors->{'volts-dimm-p1'} && $row[$i_key] =~ /^(P1_VMEM|VDimmP1|MEM RSR A PG|DIMM_VR1_VOLT)/i){
|
|
$sensors->{'volts-dimm-p1'} = $row[$i_value];
|
|
}
|
|
elsif (!$sensors->{'volts-dimm-p2'} && $row[$i_key] =~ /^(P2_VMEM|VDimmP2|MEM RSR B PG|DIMM_VR2_VOLT)/i){
|
|
$sensors->{'volts-dimm-p2'} = $row[$i_value];
|
|
}
|
|
elsif (!$sensors->{'volts-soc-p1'} && $row[$i_key] =~ /^(P1_SOC_RUN$)/i){
|
|
$sensors->{'volts-soc-p1'} = $row[$i_value];
|
|
}
|
|
elsif (!$sensors->{'volts-soc-p2'} && $row[$i_key] =~ /^(P2_SOC_RUN$)/i){
|
|
$sensors->{'volts-soc-p2'} = $row[$i_value];
|
|
}
|
|
}
|
|
}
|
|
print Data::Dumper::Dumper $sensors if $dbg[31];
|
|
process_data($sensors) if %$sensors;
|
|
main::log_data('dump','ipmi: %$sensors',$sensors) if $b_log;
|
|
eval $end if $b_log;
|
|
print Data::Dumper::Dumper $sensors if $dbg[31];
|
|
return $sensors;
|
|
}
|
|
|
|
sub linux_sensors_data {
|
|
eval $start if $b_log;
|
|
my $sensors = {};
|
|
my ($sys_fan_nu) = (0);
|
|
my ($adapter,$fan_working,$temp_working,$working_unit) = ('','','','','');
|
|
foreach $adapter (keys %{$sensors_raw->{'main'}}){
|
|
next if !$adapter || ref $sensors_raw->{'main'}{$adapter} ne 'ARRAY';
|
|
# not sure why hwmon is excluded, forgot to add info in comments
|
|
if ((@sensors_use && !(grep {/$adapter/} @sensors_use)) ||
|
|
(@sensors_exclude && (grep {/$adapter/} @sensors_exclude))){
|
|
next;
|
|
}
|
|
foreach (@{$sensors_raw->{'main'}{$adapter}}){
|
|
my @working = split(':', $_);
|
|
next if !$working[0];
|
|
# print "$working[0]:$working[1]\n";
|
|
# There are some guesses here, but with more sensors samples it will get closer.
|
|
# note: using arrays starting at 1 for all fan arrays to make it easier overall
|
|
# we have to be sure we are working with the actual real string before assigning
|
|
# data to real variables and arrays. Extracting C/F degree unit as well to use
|
|
# when constructing temp items for array.
|
|
# note that because of charset issues, no "°" degree sign used, but it is required
|
|
# in testing regex to avoid error. It might be because I got that data from a forum post,
|
|
# note directly via debugger.
|
|
if ($_ =~ /^T?(AMBIENT|M\/B|MB|Motherboard|SIO|SYS).*:([0-9\.]+)[\s°]*(C|F)/i){
|
|
# avoid SYSTIN: 118 C
|
|
if (main::is_numeric($2) && $2 < 90){
|
|
$sensors->{'mobo-temp'} = $2;
|
|
$working_unit = $3;
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
}
|
|
# issue 58 msi/asus show wrong for CPUTIN so overwrite it if PECI 0 is present
|
|
# http://www.spinics.net/lists/lm-sensors/msg37308.html
|
|
# NOTE: had: ^CPU.*\+([0-9]+): but that misses: CPUTIN and anything not with + in starter
|
|
# However, "CPUTIN is not a reliable measurement because it measures difference to Tjmax,
|
|
# which is the maximum CPU temperature reported as critical temperature by coretemp"
|
|
# NOTE: I've seen an inexplicable case where: CPU:52.0°C fails to match with [\s°] but
|
|
# does match with: [\s°]*. I can't account for this, but that's why the * is there
|
|
# Tdie is a new k10temp-pci syntax for real cpu die temp. Tctl is cpu control value,
|
|
# NOT the real cpu die temp: UNLESS tctl and tdie are equal, sigh..
|
|
elsif ($_ =~ /^(Chip 0.*?|T?CPU.*|Tdie.*):([0-9\.]+)[\s°]*(C|F)/i){
|
|
$temp_working = $2;
|
|
$working_unit = $3;
|
|
if (!$sensors->{'cpu-temp'} ||
|
|
(defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'cpu-temp'})){
|
|
$sensors->{'cpu-temp'} = $temp_working;
|
|
}
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
elsif ($_ =~ /^(Tctl.*):([0-9\.]+)[\s°]*(C|F)/i){
|
|
$temp_working = $2;
|
|
$working_unit = $3;
|
|
if (!$sensors->{'tctl-temp'} ||
|
|
(defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'tctl-temp'})){
|
|
$sensors->{'tctl-temp'} = $temp_working;
|
|
}
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
elsif ($_ =~ /^PECI\sAgent\s0.*:([0-9\.]+)[\s°]*(C|F)/i){
|
|
$sensors->{'cpu-peci-temp'} = $1;
|
|
$working_unit = $2;
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
elsif ($_ =~ /^T?(P\/S|Power).*:([0-9\.]+)[\s°]*(C|F)/i){
|
|
$sensors->{'psu-temp'} = $2;
|
|
$working_unit = $3;
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
elsif ($_ =~ /^T?(dimm|mem|sodimm).*?:([0-9\.]+)[\s°]*(C|F)/i){
|
|
$sensors->{'sodimm-temp'} = $1;
|
|
$working_unit = $2;
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
# for temp1/2 only use temp1/2 if they are null or greater than the last ones
|
|
elsif ($_ =~ /^temp1:([0-9\.]+)[\s°]*(C|F)/i){
|
|
$temp_working = $1;
|
|
$working_unit = $2;
|
|
if (!$sensors->{'temp1'} ||
|
|
(defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'temp1'})){
|
|
$sensors->{'temp1'} = $temp_working;
|
|
}
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
elsif ($_ =~ /^temp2:([0-9\.]+)[\s°]*(C|F)/i){
|
|
$temp_working = $1;
|
|
$working_unit = $2;
|
|
if (!$sensors->{'temp2'} ||
|
|
(defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'temp2'})){
|
|
$sensors->{'temp2'} = $temp_working;
|
|
}
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
# temp3 is only used as an absolute override for systems with all 3 present
|
|
elsif ($_ =~ /^temp3:([0-9\.]+)[\s°]*(C|F)/i){
|
|
$temp_working = $1;
|
|
$working_unit = $2;
|
|
if (!$sensors->{'temp3'} ||
|
|
(defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'temp3'})){
|
|
$sensors->{'temp3'} = $temp_working;
|
|
}
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
# final fallback if all else fails, funtoo user showed sensors putting
|
|
# temp on wrapped second line, not handled
|
|
elsif ($_ =~ /^T?(core0|core 0|Physical id 0)(.*):([0-9\.]+)[\s°]*(C|F)/i){
|
|
$temp_working = $3;
|
|
$working_unit = $4;
|
|
if (!$sensors->{'core-0-temp'} ||
|
|
(defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'core-0-temp'})){
|
|
$sensors->{'core-0-temp'} = $temp_working;
|
|
}
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit) if $working_unit;
|
|
}
|
|
# note: can be cpu fan:, cpu fan speed:, etc.
|
|
elsif (!defined $sensors->{'fan-main'}->[1] && $_ =~ /^F?(CPU|Processor).*:([0-9]+)[\s]RPM/i){
|
|
$sensors->{'fan-main'}->[1] = $2 if $2 < $max_fan;
|
|
}
|
|
elsif (!defined $sensors->{'fan-main'}->[2] && $_ =~ /^F?(M\/B|MB|SYS|Motherboard).*:([0-9]+)[\s]RPM/i){
|
|
$sensors->{'fan-main'}->[2] = $2 if $2 < $max_fan;
|
|
}
|
|
elsif (!defined $sensors->{'fan-main'}->[3] && $_ =~ /F?(Power|P\/S|POWER).*:([0-9]+)[\s]RPM/i){
|
|
$sensors->{'fan-main'}->[3] = $2 if $2 < $max_fan;
|
|
}
|
|
elsif (!defined $sensors->{'fan-main'}->[4] && $_ =~ /F?(dimm|mem|sodimm).*:([0-9]+)[\s]RPM/i){
|
|
$sensors->{'fan-main'}->[4] = $2 if $2 < $max_fan;
|
|
}
|
|
# note that the counters are dynamically set for fan numbers here
|
|
# otherwise you could overwrite eg aux fan2 with case fan2 in theory
|
|
# note: cpu/mobo/ps/sodimm are 1/2/3/4
|
|
elsif ($_ =~ /^F?(AUX|CASE|CHASSIS|FRONT|REAR).*:([0-9]+)[\s]RPM/i){
|
|
next if $2 > $max_fan;
|
|
$temp_working = $2;
|
|
for (my $i = 5; $i < 30; $i++){
|
|
next if defined $sensors->{'fan-main'}->[$i];
|
|
if (!defined $sensors->{'fan-main'}->[$i]){
|
|
$sensors->{'fan-main'}->[$i] = $temp_working;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
# in rare cases syntax is like: fan1: xxx RPM
|
|
elsif ($_ =~ /^FAN(1)?:([0-9]+)[\s]RPM/i){
|
|
$sensors->{'fan-default'}->[1] = $2 if $2 < $max_fan;
|
|
}
|
|
elsif ($_ =~ /^FAN([2-9]|1[0-9]).*:([0-9]+)[\s]RPM/i){
|
|
next if $2 > $max_fan;
|
|
$fan_working = $2;
|
|
$sys_fan_nu = $1;
|
|
if ($sys_fan_nu =~ /^([0-9]+)$/){
|
|
# add to array if array index does not exist OR if number is > existing number
|
|
if (defined $sensors->{'fan-default'}->[$sys_fan_nu]){
|
|
if ($fan_working >= $sensors->{'fan-default'}->[$sys_fan_nu]){
|
|
$sensors->{'fan-default'}->[$sys_fan_nu] = $fan_working;
|
|
}
|
|
}
|
|
else {
|
|
$sensors->{'fan-default'}->[$sys_fan_nu] = $fan_working;
|
|
}
|
|
}
|
|
}
|
|
if ($extra > 0){
|
|
if ($_ =~ /^[+]?(12 Volt|12V|V\+?12).*:([0-9\.]+)\sV/i){
|
|
$sensors->{'volts-12'} = $2;
|
|
}
|
|
# note: 5VSB is a field name
|
|
elsif ($_ =~ /^[+]?(5 Volt|5V|V\+?5):([0-9\.]+)\sV/i){
|
|
$sensors->{'volts-5'} = $2;
|
|
}
|
|
elsif ($_ =~ /^[+]?(3\.3 Volt|3\.3V|V\+?3\.3).*:([0-9\.]+)\sV/i){
|
|
$sensors->{'volts-3.3'} = $2;
|
|
}
|
|
elsif ($_ =~ /^(Vbat).*:([0-9\.]+)\sV/i){
|
|
$sensors->{'volts-vbat'} = $2;
|
|
}
|
|
elsif ($_ =~ /^v(dimm|mem|sodimm).*:([0-9\.]+)\sV/i){
|
|
$sensors->{'volts-mem'} = $2;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
foreach $adapter (keys %{$sensors_raw->{'pch'}}){
|
|
next if !$adapter || ref $sensors_raw->{'pch'}{$adapter} ne 'ARRAY';
|
|
if ((@sensors_use && !(grep {/$adapter/} @sensors_use)) ||
|
|
(@sensors_exclude && (grep {/$adapter/} @sensors_exclude))){
|
|
next;
|
|
}
|
|
$temp_working = '';
|
|
foreach (@{$sensors_raw->{'pch'}{$adapter}}){
|
|
if ($_ =~ /^[^:]+:([0-9\.]+)[\s°]*(C|F)/i){
|
|
$temp_working = $1;
|
|
$working_unit = $2;
|
|
if (!$sensors->{'pch-temp'} ||
|
|
(defined $temp_working && $temp_working > 0 && $temp_working > $sensors->{'pch-temp'})){
|
|
$sensors->{'pch-temp'} = $temp_working;
|
|
}
|
|
if (!$sensors->{'temp-unit'} && $working_unit){
|
|
$sensors->{'temp-unit'} = set_temp_unit($sensors->{'temp-unit'},$working_unit);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
print Data::Dumper::Dumper $sensors if $dbg[31];
|
|
process_data($sensors) if %$sensors;
|
|
main::log_data('dump','lm-sensors: %sensors',$sensors) if $b_log;
|
|
print Data::Dumper::Dumper $sensors if $dbg[31];
|
|
eval $end if $b_log;
|
|
return $sensors;
|
|
}
|
|
|
|
sub load_lm_sensors {
|
|
eval $start if $b_log;
|
|
my (@sensors_data,@values);
|
|
my ($adapter,$holder,$type) = ('','','');
|
|
if ($fake{'sensors'}){
|
|
# my $file;
|
|
# $file = "$fake_data_dir/sensors/lm-sensors/amdgpu-w-fan-speed-stretch-k10.txt";
|
|
# $file = "$fake_data_dir/sensors/lm-sensors/peci-tin-geggo.txt";
|
|
# $file = "$fake_data_dir/sensors/lm-sensors/sensors-w-other-biker.txt";
|
|
# $file = "$fake_data_dir/sensors/lm-sensors/sensors-asus-chassis-1.txt";
|
|
# $file = "$fake_data_dir/sensors/lm-sensors/sensors-devnull-1.txt";
|
|
# $file = "$fake_data_dir/sensors/lm-sensors/sensors-jammin1.txt";
|
|
# $file = "$fake_data_dir/sensors/lm-sensors/sensors-mx-incorrect-1.txt";
|
|
# $file = "$fake_data_dir/sensors/lm-sensors/sensors-maximus-arch-1.txt";
|
|
# $file = "$fake_data_dir/sensors/lm-sensors/kernel-58-sensors-ant-1.txt";
|
|
# $file = "$fake_data_dir/sensors/lm-sensors/sensors-zenpower-nvme-2.txt";
|
|
# $file = "$fake_data_dir/sensors/lm-sensors/sensors-pch-intel-1.txt";
|
|
# $file = "$fake_data_dir/sensors/slm-sensors/ensors-ppc-sr71.txt";
|
|
# $file = "$fake_data_dir/sensors/lm-sensors/sensors-coretemp-acpitz-1.txt";
|
|
# $file = "$fake_data_dir/sensors/lm-sensors/sensors-applesmc-1.txt";
|
|
# @sensors_data = main::reader($file);
|
|
}
|
|
else {
|
|
# only way to get sensor array data? Unless using sensors -j, but can't assume json
|
|
@sensors_data = main::grabber($alerts{'sensors'}->{'path'} . ' 2>/dev/null');
|
|
}
|
|
# print join("\n", @sensors_data), "\n";
|
|
if (@sensors_data){
|
|
@sensors_data = map {$_ =~ s/\s*:\s*\+?/:/;$_} @sensors_data;
|
|
push(@sensors_data, 'END');
|
|
}
|
|
# print Data::Dumper::Dumper \@sensors_data;
|
|
foreach (@sensors_data){
|
|
# print 'st:', $_, "\n";
|
|
next if /^\s*$/;
|
|
$_ = main::trimmer($_);
|
|
if (@values && $adapter && (/^Adapter/ || $_ eq 'END')){
|
|
# note: drivetemp: known, but many others could exist
|
|
if ($adapter =~ /^(drive|nvme)/){
|
|
$type = 'disk';
|
|
}
|
|
elsif ($adapter =~ /^(BAT)/){
|
|
$type = 'bat';
|
|
}
|
|
# intel on die io controller, like southbridge/northbridge used to be
|
|
elsif ($adapter =~ /^(pch[_-])/){
|
|
$type = 'pch';
|
|
}
|
|
elsif ($adapter =~ /^(.*hwmon)-/){
|
|
$type = 'hwmon';
|
|
}
|
|
# ath/iwl: wifi; enp/eno/eth/i350bb: lan nic
|
|
elsif ($adapter =~ /^(ath|i350bb|iwl|en[op][0-9]|eth)[\S]+-/){
|
|
$type = 'network';
|
|
}
|
|
# put last just in case some other sensor type above had intel in name
|
|
elsif ($adapter =~ /^(amdgpu|intel|nouveau|radeon)-/){
|
|
$type = 'gpu';
|
|
}
|
|
elsif ($adapter =~ /^(acpitz)-/ && $adapter !~ /^(acpitz-virtual)-/ ){
|
|
$type = 'acpitz';
|
|
}
|
|
else {
|
|
$type = 'main';
|
|
}
|
|
$sensors_raw->{$type}{$adapter} = [@values];
|
|
@values = ();
|
|
$adapter = '';
|
|
}
|
|
if (/^Adapter/){
|
|
$adapter = $holder;
|
|
}
|
|
elsif (/\S:\S/){
|
|
push(@values, $_);
|
|
}
|
|
else {
|
|
$holder = $_;
|
|
}
|
|
}
|
|
print 'lm sensors: ' , Data::Dumper::Dumper $sensors_raw if $dbg[18];
|
|
main::log_data('dump','lm-sensors data: %$sensors_raw',$sensors_raw) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub load_sys_data {
|
|
eval $start if $b_log;
|
|
my ($device,$mon,$name,$label,$unit,$value,@values,%hwmons);
|
|
my ($j,$holder,$sensor,$type) = (0,'','','');
|
|
my $glob = '/sys/class/hwmon/hwmon*/';
|
|
$glob .= '{name,device,{curr,fan,in,power,temp}*_{input,label}}';
|
|
my @hwmon = main::globber($glob);
|
|
# print Data::Dumper::Dumper \@sensors_data;
|
|
@hwmon = sort @hwmon;
|
|
push(@hwmon,'END');
|
|
foreach my $item (@hwmon){
|
|
next if ! -e $item;
|
|
$item =~ m|/sys/class/hwmon/(hwmon\d+)/|;
|
|
$mon = $1;
|
|
$mon =~ s/hwmon(\d)$/hwmon0$1/ if $mon =~ /hwmon\d$/;
|
|
# if it's a new hwmon, dump all previous data to avoid carry-over
|
|
if (!defined $hwmons{$mon}){
|
|
$sensor = '';
|
|
$holder = '';
|
|
$j = 0;
|
|
}
|
|
if ($item =~ m/([^\/]+)_input$/){
|
|
$sensor = $1;
|
|
$value = main::reader($item,'strip',0);;
|
|
}
|
|
# add the label to the just created _input item, if valid
|
|
elsif ($item =~ m/([^\/]+)_label$/){
|
|
print "3: mon: $mon id: $sensor holder: $holder file: $item\n" if $dbg[51];
|
|
# if this doesn't match, something unexpected happened, like no _input for
|
|
# _label item. Seen that, real.
|
|
next if !$holder || $1 ne $holder;
|
|
if (defined $hwmons{$mon}->{'sensors'}[$j]{'id'}){
|
|
$sensor = $1;
|
|
$hwmons{$mon}->{'sensors'}[$j]{'label'} = main::reader($item,'strip',0);
|
|
}
|
|
}
|
|
if ($sensor && ($sensor ne $holder || $item eq 'END')){
|
|
print "2: mon: $mon id: $sensor holder: $holder file: $item\n" if $dbg[51];
|
|
# add the item, we'll add label after if it's located since it will be next
|
|
# in loop due to sort order.
|
|
if ($value){
|
|
push(@{$hwmons{$mon}->{'sensors'}},{
|
|
'id' => $sensor,
|
|
'value' => $value,
|
|
});
|
|
$j = $#{$hwmons{$mon}->{'sensors'}};
|
|
}
|
|
$holder = $sensor;
|
|
($sensor,$value) = ('',undef,undef);
|
|
}
|
|
print "1: mon: $mon id: $sensor holder: $holder file: $item\n" if $dbg[51];
|
|
# print "$item\n";
|
|
if ($item =~ /name$/){
|
|
$name = main::reader($item,'strip',0);
|
|
if ($name =~ /^(drive|nvme)/){
|
|
$type = 'disk';
|
|
}
|
|
elsif ($name =~ /^(BAT)/i){
|
|
$type = 'bat';
|
|
}
|
|
# intel on die io controller, like southbridge/northbridge used to be
|
|
elsif ($name =~ /^(pch)/){
|
|
$type = 'pch';
|
|
}
|
|
elsif ($name =~ /^(.*hwmon)/){
|
|
$type = 'hwmon';
|
|
}
|
|
# ath/iwl: wifi; enp/eno/eth/i350bb: lan nic
|
|
elsif ($name =~ /^(ath|i350|iwl|en[op][0-9]|eth)[\S]/){
|
|
$type = 'network';
|
|
}
|
|
# put last just in case some other sensor type above had intel in name
|
|
elsif ($name =~ /^(amdgpu|intel|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'}}){
|
|
my $name = ($item->{'label'}) ? $item->{'label'}: $item->{'id'};
|
|
if ($item->{'id'} =~ /^temp/){
|
|
$unit = 'C';
|
|
$value = sprintf('%0.1f',$item->{'value'}/1000);
|
|
}
|
|
elsif ($item->{'id'} =~ /^fan/){
|
|
$unit = 'rpm';
|
|
$value = $item->{'value'};
|
|
}
|
|
# note: many sensors require further math on value, so these will be wrong
|
|
# in many cases since this is not running the math on the results like
|
|
# lm-sensors will do if sensors are detected and loaded and configured.
|
|
elsif ($item->{'id'} =~ /^in\d/){
|
|
if ($item->{'value'} >= 1000){
|
|
$unit = 'V';
|
|
$value = sprintf('%0.2f',$item->{'value'}/1000) + 0;
|
|
if ($hwmons{$hwmon}->{'type'} eq 'main' && $name =~ /^in\d/){
|
|
if ($value >= 10 && $value <= 14){
|
|
$name = '12V';
|
|
}
|
|
elsif ($value >= 4 && $value <= 6){
|
|
$name = '5V';
|
|
}
|
|
# vbat can be 3, 3.3, but so can 3.3V board
|
|
}
|
|
}
|
|
else {
|
|
$unit = 'mV';
|
|
$value = $item->{'value'};
|
|
}
|
|
}
|
|
elsif ($item->{'id'} =~ /^power/){
|
|
$unit = 'W';
|
|
$value = sprintf('%0.1f',$item->{'value'}/1000);
|
|
}
|
|
if (defined $value && defined $unit){
|
|
my $string = $name . ':' . $value . " $unit";
|
|
push(@values,$string);
|
|
}
|
|
}
|
|
# if ($hwmons{$hwmon}->{'type'} eq 'acpitz' && $hwmons{$hwmon}->{'device'}){
|
|
# my $tz ='/sys/class/thermal/' . $hwmons{$hwmon}->{'device'} . '/type';
|
|
# if (-e $tz){
|
|
# my $tz_type = main::reader($tz,'strip',0),"\n";
|
|
# }
|
|
# }
|
|
if (@values){
|
|
$sensors_raw->{$hwmons{$hwmon}->{'type'}}{$adapter} = [@values];
|
|
}
|
|
}
|
|
print '/sys/class/hwmon processed: ' , Data::Dumper::Dumper $sensors_raw if $dbg[18];
|
|
main::log_data('dump','/sys data: %$sensors_raw',$sensors_raw) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# bsds sysctl may have hw.sensors data
|
|
sub sysctl_data {
|
|
eval $start if $b_log;
|
|
my (@data);
|
|
my $sensors = {};
|
|
# assume always starts at 0, can't do dynamic because freebsd shows tz1 first
|
|
my $add = 1;
|
|
print Data::Dumper::Dumper $sysctl{'sensor'} if $dbg[18];;
|
|
foreach (@{$sysctl{'sensor'}}){
|
|
my ($sensor,$type,$number,$value);
|
|
if (/^hw\.sensors\.([a-z]+)([0-9]+)\.(cpu|temp|fan|volt)([0-9])/){
|
|
$sensor = $1;
|
|
$type = $3;
|
|
$number = $4;
|
|
# hw.sensors.cpu0.temp0:47.00 degC
|
|
# hw.sensors.acpitz0.temp0:43.00 degC
|
|
$type = 'cpu' if $sensor eq 'cpu';
|
|
}
|
|
elsif (/^hw\.sensors\.(acpi)\.(thermal)\.(tz)([0-9]+)\.(temperature)/){
|
|
$sensor = $1 . $3; # eg acpitz
|
|
$type = ($5 eq 'temperature') ? 'temp': $5;
|
|
$number = $4;
|
|
}
|
|
elsif (/^dev\.(cpu)\.([0-9]+)\.(temperature)/){
|
|
$sensor = $1;
|
|
$type = $3;
|
|
$number = $2;
|
|
$type = 'cpu' if $sensor eq 'cpu';
|
|
}
|
|
if ($sensor && $type){
|
|
if ($sensor && ((@sensors_use && !(grep {/$sensor/} @sensors_use)) ||
|
|
(@sensors_exclude && (grep {/$sensor/} @sensors_exclude)))){
|
|
next;
|
|
}
|
|
my $working = (split(':\s*', $_))[1];
|
|
if (defined $working && $working =~ /^([0-9\.]+)\s?((deg)?([CF]))?\b/){
|
|
$value = $1 ;
|
|
$sensors->{'temp-unit'} = $4 if $4 && !$sensors->{'temp-unit'};
|
|
}
|
|
else {
|
|
next;
|
|
}
|
|
$number += $add;
|
|
if ($type eq 'cpu' && !defined $sensors->{'cpu-temp'}){
|
|
$sensors->{'cpu-temp'} = $value;
|
|
}
|
|
elsif ($type eq 'temp' && !defined $sensors->{'temp' . $number}){
|
|
$sensors->{'temp' . $number} = $value;
|
|
}
|
|
elsif ($type eq 'fan' && !defined $sensors->{'fan-main'}->[$number]){
|
|
$sensors->{'fan-main'}->[$number] = $value if $value < $max_fan;
|
|
}
|
|
elsif ($type eq 'volt'){
|
|
if ($working =~ /\+3\.3V/i){
|
|
$sensors->{'volts-3.3'} = $value;
|
|
}
|
|
elsif ($working =~ /\+5V/i){
|
|
$sensors->{'volts-5'} = $value;
|
|
}
|
|
elsif ($working =~ /\+12V/i){
|
|
$sensors->{'volts-12'} = $value;
|
|
}
|
|
elsif ($working =~ /VBAT/i){
|
|
$sensors->{'volts-vbat'} = $value;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
process_data($sensors) if %$sensors;
|
|
main::log_data('dump','%$sensors',$sensors) if $b_log;
|
|
print Data::Dumper::Dumper $sensors if $dbg[31];;
|
|
eval $end if $b_log;
|
|
return $sensors;
|
|
}
|
|
|
|
sub set_temp_unit {
|
|
my ($sensors,$working) = @_;
|
|
my $return_unit = '';
|
|
if (!$sensors && $working){
|
|
$return_unit = $working;
|
|
}
|
|
elsif ($sensors){
|
|
$return_unit = $sensors;
|
|
}
|
|
return $return_unit;
|
|
}
|
|
|
|
sub process_data {
|
|
eval $start if $b_log;
|
|
my ($sensors) = @_;
|
|
my ($cpu_temp,$cpu2_temp,$cpu3_temp,$cpu4_temp,$mobo_temp,$pch_temp,$psu_temp);
|
|
my ($fan_type,$i,$j,$index_count_fan_default,$index_count_fan_main) = (0,0,0,0,0);
|
|
my $temp_diff = 20; # for C, handled for F after that is determined
|
|
my (@fan_main,@fan_default);
|
|
# kernel/sensors only show Tctl if Tctl == Tdie temp, sigh...
|
|
if (!$sensors->{'cpu-temp'} && $sensors->{'tctl-temp'}){
|
|
$sensors->{'cpu-temp'} = $sensors->{'tctl-temp'};
|
|
undef $sensors->{'tctl-temp'};
|
|
}
|
|
# first we need to handle the case where we have to determine which temp/fan to use for cpu and mobo:
|
|
# note, for rare cases of weird cool cpus, user can override in their prefs and force the assignment
|
|
# this is wrong for systems with > 2 tempX readings, but the logic is too complex with 3 variables
|
|
# so have to accept that it will be wrong in some cases, particularly for motherboard temp readings.
|
|
if ($sensors->{'temp1'} && $sensors->{'temp2'}){
|
|
if ($sensors_cpu_nu){
|
|
$fan_type = $sensors_cpu_nu;
|
|
}
|
|
else {
|
|
# first some fringe cases with cooler cpu than mobo: assume which is cpu temp based on fan speed
|
|
# but only if other fan speed is 0.
|
|
if ($sensors->{'temp1'} >= $sensors->{'temp2'} &&
|
|
defined $fan_default[1] && defined $fan_default[2] && $fan_default[1] == 0 && $fan_default[2] > 0){
|
|
$fan_type = 2;
|
|
}
|
|
elsif ($sensors->{'temp2'} >= $sensors->{'temp1'} &&
|
|
defined $fan_default[1] && defined $fan_default[2] && $fan_default[2] == 0 && $fan_default[1] > 0){
|
|
$fan_type = 1;
|
|
}
|
|
# then handle the standard case if these fringe cases are false
|
|
elsif ($sensors->{'temp1'} >= $sensors->{'temp2'}){
|
|
$fan_type = 1;
|
|
}
|
|
else {
|
|
$fan_type = 2;
|
|
}
|
|
}
|
|
}
|
|
# need a case for no temps at all reported, like with old intels
|
|
elsif (!$sensors->{'temp2'} && !$sensors->{'cpu-temp'}){
|
|
if (!$sensors->{'temp1'} && !$sensors->{'mobo-temp'}){
|
|
$fan_type = 1;
|
|
}
|
|
elsif ($sensors->{'temp1'} && !$sensors->{'mobo-temp'}){
|
|
$fan_type = 1;
|
|
}
|
|
elsif ($sensors->{'temp1'} && $sensors->{'mobo-temp'}){
|
|
$fan_type = 1;
|
|
}
|
|
}
|
|
# convert the diff number for F, it needs to be bigger that is
|
|
if ($sensors->{'temp-unit'} && $sensors->{'temp-unit'} eq "F"){
|
|
$temp_diff = $temp_diff * 1.8
|
|
}
|
|
if ($sensors->{'cpu-temp'}){
|
|
# specific hack to handle broken CPUTIN temps with PECI
|
|
if ($sensors->{'cpu-peci-temp'} && ($sensors->{'cpu-temp'} - $sensors->{'cpu-peci-temp'}) > $temp_diff){
|
|
$cpu_temp = $sensors->{'cpu-peci-temp'};
|
|
}
|
|
# then get the real cpu temp, best guess is hottest is real, though only within narrowed diff range
|
|
else {
|
|
$cpu_temp = $sensors->{'cpu-temp'};
|
|
}
|
|
}
|
|
else {
|
|
if ($fan_type){
|
|
# there are some weird scenarios
|
|
if ($fan_type == 1){
|
|
if ($sensors->{'temp1'} && $sensors->{'temp2'} && $sensors->{'temp2'} > $sensors->{'temp1'}){
|
|
$cpu_temp = $sensors->{'temp2'};
|
|
}
|
|
else {
|
|
$cpu_temp = $sensors->{'temp1'};
|
|
}
|
|
}
|
|
else {
|
|
if ($sensors->{'temp1'} && $sensors->{'temp2'} && $sensors->{'temp1'} > $sensors->{'temp2'}){
|
|
$cpu_temp = $sensors->{'temp1'};
|
|
}
|
|
else {
|
|
$cpu_temp = $sensors->{'temp2'};
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$cpu_temp = $sensors->{'temp1'}; # can be null, that is ok
|
|
}
|
|
if ($cpu_temp){
|
|
# using $sensors->{'temp3'} is just not reliable enough, more errors caused than fixed imo
|
|
# if ($sensors->{'temp3'} && $sensors->{'temp3'} > $cpu_temp){
|
|
# $cpu_temp = $sensors->{'temp3'};
|
|
# }
|
|
# there are some absurdly wrong $sensors->{'temp1'}: acpitz-virtual-0 $sensors->{'temp1'}: +13.8°C
|
|
if ($sensors->{'core-0-temp'} && ($sensors->{'core-0-temp'} - $cpu_temp) > $temp_diff){
|
|
$cpu_temp = $sensors->{'core-0-temp'};
|
|
}
|
|
}
|
|
}
|
|
# if all else fails, use core0/peci temp if present and cpu is null
|
|
if (!$cpu_temp){
|
|
if ($sensors->{'core-0-temp'}){
|
|
$cpu_temp = $sensors->{'core-0-temp'};
|
|
}
|
|
# note that peci temp is known to be colder than the actual system
|
|
# sometimes so it is the last fallback we want to use even though in theory
|
|
# it is more accurate, but fact suggests theory wrong.
|
|
elsif ($sensors->{'cpu-peci-temp'}){
|
|
$cpu_temp = $sensors->{'cpu-peci-temp'};
|
|
}
|
|
}
|
|
# then the real mobo temp
|
|
if ($sensors->{'mobo-temp'}){
|
|
$mobo_temp = $sensors->{'mobo-temp'};
|
|
}
|
|
elsif ($fan_type){
|
|
if ($fan_type == 1){
|
|
if ($sensors->{'temp1'} && $sensors->{'temp2'} && $sensors->{'temp2'} > $sensors->{'temp1'}){
|
|
$mobo_temp = $sensors->{'temp1'};
|
|
}
|
|
else {
|
|
$mobo_temp = $sensors->{'temp2'};
|
|
}
|
|
}
|
|
else {
|
|
if ($sensors->{'temp1'} && $sensors->{'temp2'} && $sensors->{'temp1'} > $sensors->{'temp2'}){
|
|
$mobo_temp = $sensors->{'temp2'};
|
|
}
|
|
else {
|
|
$mobo_temp = $sensors->{'temp1'};
|
|
}
|
|
}
|
|
## NOTE: not safe to assume $sensors->{'temp3'} is the mobo temp, sad to say
|
|
# if ($sensors->{'temp1'} && $sensors->{'temp2'} && $sensors->{'temp3'} && $sensors->{'temp3'} < $mobo_temp){
|
|
# $mobo_temp = $sensors->{'temp3'};
|
|
# }
|
|
}
|
|
# in case with cpu-temp AND temp1 and not temp 2, or temp 2 only, fan type: 0
|
|
else {
|
|
if ($sensors->{'cpu-temp'} && $sensors->{'temp1'} &&
|
|
$sensors->{'cpu-temp'} > $sensors->{'temp1'}){
|
|
$mobo_temp = $sensors->{'temp1'};
|
|
}
|
|
elsif ($sensors->{'temp2'}){
|
|
$mobo_temp = $sensors->{'temp2'};
|
|
}
|
|
}
|
|
@fan_main = @{$sensors->{'fan-main'}} if $sensors->{'fan-main'};
|
|
$index_count_fan_main = (@fan_main) ? scalar @fan_main : 0;
|
|
@fan_default = @{$sensors->{'fan-default'}} if $sensors->{'fan-default'};
|
|
$index_count_fan_default = (@fan_default) ? scalar @fan_default : 0;
|
|
# then set the cpu fan speed
|
|
if (!$fan_main[1]){
|
|
# note, you cannot test for $fan_default[1] or [2] != ""
|
|
# because that creates an array item in gawk just by the test itself
|
|
if ($fan_type == 1 && defined $fan_default[1]){
|
|
$fan_main[1] = $fan_default[1];
|
|
$fan_default[1] = undef;
|
|
}
|
|
elsif ($fan_type == 2 && defined $fan_default[2]){
|
|
$fan_main[1] = $fan_default[2];
|
|
$fan_default[2] = undef;
|
|
}
|
|
}
|
|
# clear out any duplicates. Primary fan real trumps fan working always if same speed
|
|
for ($i = 1; $i <= $index_count_fan_main; $i++){
|
|
if (defined $fan_main[$i] && $fan_main[$i]){
|
|
for ($j = 1; $j <= $index_count_fan_default; $j++){
|
|
if (defined $fan_default[$j] && $fan_main[$i] == $fan_default[$j]){
|
|
$fan_default[$j] = undef;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# now see if you can find the fast little mobo fan, > 5000 rpm and put it as mobo
|
|
# note that gawk is returning true for some test cases when $fan_default[j] < 5000
|
|
# which has to be a gawk bug, unless there is something really weird with arrays
|
|
# note: 500 > $fan_default[j] < 1000 is the exact trigger, and if you manually
|
|
# assign that value below, the > 5000 test works again, and a print of the value
|
|
# shows the proper value, so the corruption might be internal in awk.
|
|
# Note: gensub is the culprit I think, assigning type string for range 501-1000 but
|
|
# type integer for all others, this triggers true for >
|
|
for ($j = 1; $j <= $index_count_fan_default; $j++){
|
|
if (defined $fan_default[$j] && $fan_default[$j] > 5000 && !$fan_main[2]){
|
|
$fan_main[2] = $fan_default[$j];
|
|
$fan_default[$j] = undef;
|
|
# then add one if required for output
|
|
if ($index_count_fan_main < 2){
|
|
$index_count_fan_main = 2;
|
|
}
|
|
}
|
|
}
|
|
# if they are ALL null, print error message. psFan is not used in output currently
|
|
if (!$cpu_temp && !$mobo_temp && !$fan_main[1] && !$fan_main[2] && !$fan_main[1] && !@fan_default){
|
|
%$sensors = ();
|
|
}
|
|
else {
|
|
my ($ambient_temp,$psu_fan,$psu1_fan,$psu2_fan,$psu_temp,$sodimm_temp,
|
|
$v_12,$v_5,$v_3_3,$v_dimm_p1,$v_dimm_p2,$v_soc_p1,$v_soc_p2,$v_vbat);
|
|
$psu_temp = $sensors->{'psu-temp'} if $sensors->{'psu-temp'};
|
|
# sodimm fan is fan_main[4]
|
|
$sodimm_temp = $sensors->{'sodimm-temp'} if $sensors->{'sodimm-temp'};
|
|
$cpu2_temp = $sensors->{'cpu2-temp'} if $sensors->{'cpu2-temp'};
|
|
$cpu3_temp = $sensors->{'cpu3-temp'} if $sensors->{'cpu3-temp'};
|
|
$cpu4_temp = $sensors->{'cpu4-temp'} if $sensors->{'cpu4-temp'};
|
|
$ambient_temp = $sensors->{'ambient-temp'} if $sensors->{'ambient-temp'};
|
|
$pch_temp = $sensors->{'pch-temp'} if $sensors->{'pch-temp'};
|
|
$psu_fan = $sensors->{'fan-psu'} if $sensors->{'fan-psu'};
|
|
$psu1_fan = $sensors->{'fan-psu-1'} if $sensors->{'fan-psu-1'};
|
|
$psu2_fan = $sensors->{'fan-psu-2'} if $sensors->{'fan-psu-2'};
|
|
# so far only for ipmi, sensors data is junk for volts
|
|
if ($extra > 0 && ($sensors->{'volts-12'} || $sensors->{'volts-5'} ||
|
|
$sensors->{'volts-3.3'} || $sensors->{'volts-vbat'})){
|
|
$v_12 = $sensors->{'volts-12'} if $sensors->{'volts-12'};
|
|
$v_5 = $sensors->{'volts-5'} if $sensors->{'volts-5'};
|
|
$v_3_3 = $sensors->{'volts-3.3'} if $sensors->{'volts-3.3'};
|
|
$v_vbat = $sensors->{'volts-vbat'} if $sensors->{'volts-vbat'};
|
|
$v_dimm_p1 = $sensors->{'volts-dimm-p1'} if $sensors->{'volts-dimm-p1'};
|
|
$v_dimm_p2 = $sensors->{'volts-dimm-p2'} if $sensors->{'volts-dimm-p2'};
|
|
$v_soc_p1 = $sensors->{'volts-soc-p1'} if $sensors->{'volts-soc-p1'};
|
|
$v_soc_p2 = $sensors->{'volts-soc-p2'} if $sensors->{'volts-soc-p2'};
|
|
}
|
|
%$sensors = (
|
|
'ambient-temp' => $ambient_temp,
|
|
'cpu-temp' => $cpu_temp,
|
|
'cpu2-temp' => $cpu2_temp,
|
|
'cpu3-temp' => $cpu3_temp,
|
|
'cpu4-temp' => $cpu4_temp,
|
|
'mobo-temp' => $mobo_temp,
|
|
'pch-temp' => $pch_temp,
|
|
'psu-temp' => $psu_temp,
|
|
'temp-unit' => $sensors->{'temp-unit'},
|
|
'fan-main' => \@fan_main,
|
|
'fan-default' => \@fan_default,
|
|
'fan-psu' => $psu_fan,
|
|
'fan-psu1' => $psu1_fan,
|
|
'fan-psu2' => $psu2_fan,
|
|
);
|
|
if ($psu_temp){
|
|
$sensors->{'psu-temp'} = $psu_temp;
|
|
}
|
|
if ($sodimm_temp){
|
|
$sensors->{'sodimm-temp'} = $sodimm_temp;
|
|
}
|
|
if ($extra > 0 && ($v_12 || $v_5 || $v_3_3 || $v_vbat)){
|
|
$sensors->{'volts-12'} = $v_12;
|
|
$sensors->{'volts-5'} = $v_5;
|
|
$sensors->{'volts-3.3'} = $v_3_3;
|
|
$sensors->{'volts-vbat'} = $v_vbat;
|
|
$sensors->{'volts-dimm-p1'} = $v_dimm_p1;
|
|
$sensors->{'volts-dimm-p2'} = $v_dimm_p2;
|
|
$sensors->{'volts-soc-p1'} = $v_soc_p1;
|
|
$sensors->{'volts-soc-p2'} = $v_soc_p2;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub gpu_sensor_data {
|
|
eval $start if $b_log;
|
|
my ($cmd,@data,@data2,$path,@screens,$temp);
|
|
my $j = 0;
|
|
$loaded{'gpu-data'} = 1;
|
|
if ($path = main::check_program('nvidia-settings')){
|
|
# first get the number of screens. This only work if you are in X
|
|
if ($b_display){
|
|
@data = main::grabber("$path -q screens 2>/dev/null");
|
|
foreach (@data){
|
|
if (/(:[0-9]\.[0-9])/){
|
|
push(@screens, $1);
|
|
}
|
|
}
|
|
}
|
|
# do a guess, this will work for most users, it's better than nothing for out of X
|
|
else {
|
|
$screens[0] = ':0.0';
|
|
}
|
|
# now we'll get the gpu temp for each screen discovered. The print out function
|
|
# will handle removing screen data for single gpu systems. -t shows only data we want
|
|
# GPUCurrentClockFreqs: 520,600
|
|
# GPUCurrentFanSpeed: 50 0-100, not rpm, percent I think
|
|
# VideoRam: 1048576
|
|
# CUDACores: 16
|
|
# PCIECurrentLinkWidth: 16
|
|
# PCIECurrentLinkSpeed: 5000
|
|
# RefreshRate: 60.02 Hz [oer screen]
|
|
# ViewPortOut=1280x1024+0+0}, DPY-1: nvidia-auto-select @1280x1024 +1280+0 {ViewPortIn=1280x1024,
|
|
# ViewPortOut=1280x1024+0+0}
|
|
# ThermalSensorReading: 50
|
|
# PCIID: 4318,2661 - the pci stuff doesn't appear to work
|
|
# PCIBus: 2
|
|
# PCIDevice: 0
|
|
# Irq: 30
|
|
foreach my $screen (@screens){
|
|
my $screen2 = $screen;
|
|
$screen2 =~ s/\.[0-9]$//;
|
|
$cmd = '-q GPUCoreTemp -q VideoRam -q GPUCurrentClockFreqs -q PCIECurrentLinkWidth ';
|
|
$cmd .= '-q Irq -q PCIBus -q PCIDevice -q GPUCurrentFanSpeed';
|
|
$cmd = "$path -c $screen2 $cmd 2>/dev/null";
|
|
@data = main::grabber($cmd);
|
|
main::log_data('cmd',$cmd) if $b_log;
|
|
push(@data,@data2);
|
|
$j = scalar @$gpu_data;
|
|
foreach my $item (@data){
|
|
if ($item =~ /^\s*Attribute\s\'([^']+)\'\s.*:\s*([\S]+)\.$/){
|
|
my $attribute = $1;
|
|
my $value = $2;
|
|
$gpu_data->[$j]{'type'} = 'nvidia';
|
|
$gpu_data->[$j]{'speed-unit'} = '%';
|
|
$gpu_data->[$j]{'screen'} = $screen;
|
|
if (!$gpu_data->[$j]{'temp'} && $attribute eq 'GPUCoreTemp'){
|
|
$gpu_data->[$j]{'temp'} = $value;
|
|
}
|
|
elsif (!$gpu_data->[$j]{'ram'} && $attribute eq 'VideoRam'){
|
|
$gpu_data->[$j]{'ram'} = $value;
|
|
}
|
|
elsif (!$gpu_data->[$j]{'clock'} && $attribute eq 'GPUCurrentClockFreqs'){
|
|
$gpu_data->[$j]{'clock'} = $value;
|
|
}
|
|
elsif (!$gpu_data->[$j]{'bus'} && $attribute eq 'PCIBus'){
|
|
$gpu_data->[$j]{'bus'} = $value;
|
|
}
|
|
elsif (!$gpu_data->[$j]{'bus-id'} && $attribute eq 'PCIDevice'){
|
|
$gpu_data->[$j]{'bus-id'} = $value;
|
|
}
|
|
elsif (!$gpu_data->[$j]{'fan-speed'} && $attribute eq 'GPUCurrentFanSpeed'){
|
|
$gpu_data->[$j]{'fan-speed'} = $value;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if ($path = main::check_program('aticonfig')){
|
|
# aticonfig --adapter=0 --od-gettemperature
|
|
@data = main::grabber("$path --adapter=all --od-gettemperature 2>/dev/null");
|
|
foreach (@data){
|
|
if (/Sensor [^0-9]*([0-9\.]+) /){
|
|
$j = scalar @$gpu_data;
|
|
my $value = $1;
|
|
$gpu_data->[$j]{'type'} = 'amd';
|
|
$gpu_data->[$j]{'temp'} = $value;
|
|
}
|
|
}
|
|
}
|
|
if ($sensors_raw->{'gpu'}){
|
|
# my ($b_found,$holder) = (0,'');
|
|
foreach my $adapter (keys %{$sensors_raw->{'gpu'}}){
|
|
$j = scalar @$gpu_data;
|
|
$gpu_data->[$j]{'type'} = $adapter;
|
|
$gpu_data->[$j]{'type'} =~ s/^(amdgpu|intel|nouveau|radeon)-.*/$1/;
|
|
# print "ad: $adapter\n";
|
|
foreach (@{$sensors_raw->{'gpu'}{$adapter}}){
|
|
# print "val: $_\n";
|
|
if (/^[^:]*mem[^:]*:([0-9\.]+).*\b(C|F)\b/i){
|
|
$gpu_data->[$j]{'temp-mem'} = $1;
|
|
$gpu_data->[$j]{'unit'} = $2;
|
|
# print "temp: $_\n";
|
|
}
|
|
elsif (/^[^:]+:([0-9\.]+).*\b(C|F)\b/i){
|
|
$gpu_data->[$j]{'temp'} = $1;
|
|
$gpu_data->[$j]{'unit'} = $2;
|
|
# print "temp: $_\n";
|
|
}
|
|
# speeds can be in percents or rpms, so need the 'fan' in regex
|
|
elsif (/^.*?fan.*?:([0-9\.]+).*(RPM)?/i){
|
|
$gpu_data->[$j]{'fan-speed'} = $1;
|
|
# NOTE: we test for nvidia %, everything else stays with nothing
|
|
$gpu_data->[$j]{'speed-unit'} = '';
|
|
}
|
|
elsif (/^[^:]+:([0-9\.]+)\s+W\s/i){
|
|
$gpu_data->[$j]{'watts'} = $1;
|
|
}
|
|
elsif (/^[^:]+:([0-9\.]+)\s+(m?V)\s/i){
|
|
$gpu_data->[$j]{'volts-gpu'} = [$1,$2];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
main::log_data('dump','sensors output: video: @$gpu_data',$gpu_data) if $b_log;
|
|
print 'gpu_data: ', Data::Dumper::Dumper $gpu_data if $dbg[18];
|
|
eval $end if $b_log;
|
|
}
|
|
}
|
|
|
|
## SlotItem
|
|
{
|
|
package SlotItem;
|
|
my ($sys_slots);
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my ($data,$key1,$val1);
|
|
my $rows = [];
|
|
my $num = 0;
|
|
if ($fake{'dmidecode'} || ($alerts{'dmidecode'}->{'action'} eq 'use' &&
|
|
(!%risc || $use{'slot-tool'}))){
|
|
if ($b_admin && -e '/sys/devices/pci0000:00'){
|
|
slot_data_sys();
|
|
}
|
|
$data = slot_data_dmi();
|
|
slot_output($rows,$data) if @$data;
|
|
if (!@$rows){
|
|
my $key = 'Message';
|
|
push(@$rows, {
|
|
main::key($num++,0,1,$key) => main::message('pci-slot-data','')
|
|
});
|
|
}
|
|
}
|
|
elsif (%risc && !$use{'slot-tool'}){
|
|
$key1 = 'Message';
|
|
$val1 = main::message('risc-pci',$risc{'id'});
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1});
|
|
}
|
|
elsif ($alerts{'dmidecode'}->{'action'} ne 'use'){
|
|
$key1 = $alerts{'dmidecode'}->{'action'};
|
|
$val1 = $alerts{'dmidecode'}->{'message'};
|
|
$key1 = ucfirst($key1);
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1});
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub slot_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$data) = @_;
|
|
my $num = 1;
|
|
foreach my $slot_data (@$data){
|
|
next if !$slot_data || ref $slot_data ne 'HASH';
|
|
$num = 1;
|
|
my $j = scalar @$rows;
|
|
$slot_data->{'id'} = 'N/A' if !defined $slot_data->{'id'}; # can be 0
|
|
$slot_data->{'pci'} ||= 'N/A';
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Slot') => $slot_data->{'id'},
|
|
main::key($num++,0,2,'type') => $slot_data->{'pci'},
|
|
},);
|
|
# PCIe only
|
|
if ($extra > 1 && $slot_data->{'gen'}){
|
|
$rows->[$j]{main::key($num++,0,2,'gen')} = $slot_data->{'gen'};
|
|
}
|
|
if ($slot_data->{'lanes-phys'} && $slot_data->{'lanes-active'} &&
|
|
$slot_data->{'lanes-phys'} ne $slot_data->{'lanes-active'}){
|
|
$rows->[$j]{main::key($num++,1,2,'lanes')} = '';
|
|
$rows->[$j]{main::key($num++,0,3,'phys')} = $slot_data->{'lanes-phys'};
|
|
$rows->[$j]{main::key($num++,0,3,'active')} = $slot_data->{'lanes-active'};
|
|
}
|
|
elsif ($slot_data->{'lanes-phys'}){
|
|
$rows->[$j]{main::key($num++,0,2,'lanes')} = $slot_data->{'lanes-phys'};
|
|
}
|
|
# Non PCIe only
|
|
if ($extra > 1 && $slot_data->{'bits'}){
|
|
$rows->[$j]{main::key($num++,0,2,'bits')} = $slot_data->{'bits'};
|
|
}
|
|
# PCI-X and PCI only
|
|
if ($extra > 1 && $slot_data->{'mhz'}){
|
|
$rows->[$j]{main::key($num++,0,2,'MHz')} = $slot_data->{'mhz'};
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'status')} = $slot_data->{'usage'};
|
|
if ($slot_data->{'extra'}){
|
|
$rows->[$j]{main::key($num++,0,2,'info')} = join(', ', @{$slot_data->{'extra'}});
|
|
}
|
|
if ($extra > 1){
|
|
$slot_data->{'length'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'length')} = $slot_data->{'length'};
|
|
if ($slot_data->{'cpu'}){
|
|
$rows->[$j]{main::key($num++,0,2,'cpu')} = $slot_data->{'cpu'};
|
|
}
|
|
if ($slot_data->{'volts'}){
|
|
$rows->[$j]{main::key($num++,0,2,'volts')} = $slot_data->{'volts'};
|
|
}
|
|
}
|
|
if ($extra > 0){
|
|
$slot_data->{'bus_address'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,1,2,'bus-ID')} = $slot_data->{'bus_address'};
|
|
if ($b_admin && $slot_data->{'children'}){
|
|
children_output($rows,$j,\$num,$slot_data->{'children'},3);
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
sub children_output {
|
|
my ($rows,$j,$num,$children,$ind) = @_;
|
|
my $cnt = 0;
|
|
$rows->[$j]{main::key($$num++,1,$ind,'children')} = '';
|
|
$ind++;
|
|
foreach my $id (sort keys %{$children}){
|
|
$cnt++;
|
|
$rows->[$j]{main::key($$num++,1,$ind,$cnt)} = $id;
|
|
if ($children->{$id}{'class-id'} && $children->{$id}{'class-id-sub'}){
|
|
my $class = $children->{$id}{'class-id'} . $children->{$id}{'class-id-sub'};
|
|
$rows->[$j]{main::key($$num++,0,($ind + 1),'class-ID')} = $class;
|
|
if ($children->{$id}{'class'}){
|
|
$rows->[$j]{main::key($$num++,0,($ind + 1),'type')} = $children->{$id}{'class'};
|
|
}
|
|
}
|
|
if ($children->{$id}{'children'}){
|
|
children_output($rows,$j,$num,$children->{$id}{'children'},$ind + 1);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub slot_data_dmi {
|
|
eval $start if $b_log;
|
|
my $i = 0;
|
|
my $slots = [];
|
|
foreach my $slot_data (@dmi){
|
|
next if $slot_data->[0] != 9;
|
|
my (%data,@extra);
|
|
# skip first two row, we don't need that data
|
|
foreach my $item (@$slot_data[2 .. $#$slot_data]){
|
|
if ($item !~ /^~/){ # skip the indented rows
|
|
my @value = split(/:\s+/, $item, 2);
|
|
if ($value[0] eq 'Type'){
|
|
$data{'type'} = $value[1];
|
|
}
|
|
if ($value[0] eq 'Designation'){
|
|
$data{'designation'} = $value[1];
|
|
}
|
|
if ($value[0] eq 'Current Usage'){
|
|
$data{'usage'} = lc($value[1]);
|
|
}
|
|
if ($value[0] eq 'ID'){
|
|
$data{'id'} = $value[1];
|
|
}
|
|
if ($value[0] eq 'Length'){
|
|
$data{'length'} = lc($value[1]);
|
|
}
|
|
if ($value[0] eq 'Bus Address'){
|
|
$value[1] =~ s/^0000://;
|
|
$data{'bus_address'} = $value[1];
|
|
if ($b_admin && $sys_slots){
|
|
$data{'children'} = slot_children($data{'bus_address'},$sys_slots);
|
|
}
|
|
}
|
|
}
|
|
elsif ($item =~ /^~([\d.]+)[\s-]?V is provided/){
|
|
$data{'volts'} = $1;
|
|
}
|
|
}
|
|
if ($data{'type'} eq 'Other' && $data{'designation'}){
|
|
$data{'type'} = $data{'designation'};
|
|
undef $data{'designation'};
|
|
}
|
|
foreach my $string (($data{'type'},$data{'designation'})){
|
|
next if !$string;
|
|
print "st: $string\n" if $dbg[48];
|
|
$string =~ s/(PCI[\s_-]?Express|Pci[_-]?e)/PCIe /ig;
|
|
$string =~ s/PCI[\s_-]?X/PCIX /ig;
|
|
$string =~ s/Mini[\s_-]?PCI/MiniPCI /ig;
|
|
$string =~ s/Media[\s_-]?Card/MediaCard/ig;
|
|
$string =~ s/Express[\s_-]?Card/ExpressCard/ig;
|
|
$string =~ s/Card[\s_-]?Bus/CardBus/ig;
|
|
$string =~ s/PCMCIA/PCMCIA /ig;
|
|
if (!$data{'pci'} && $string =~ /(AGP|ISA|MiniPCI|PCIe|PCIX|PCMCIA|PCI)/){
|
|
$data{'pci'} = $1;
|
|
# print "pci: $data{'pci'}\n";
|
|
}
|
|
if ($string =~ /(MiniPCI|PCMCIA)/){
|
|
$data{'pci'} = $1;
|
|
# print "pci: $data{'pci'}\n";
|
|
}
|
|
# legacy format: PCIE#3-x8
|
|
if (!$data{'lanes-phys'} && $string =~ /(^x|#\d+-x)(\d+)/){
|
|
$data{'lanes-phys'} = $2;
|
|
}
|
|
if (!$data{'lanes-active'} && $string =~ /^x\d+ .*? x(\d+)/){
|
|
$data{'lanes-active'} = $1;
|
|
}
|
|
# legacy format, seens with PCI-X/PCIe mobos: PCIX#2-100MHz, PCIE#3-x8
|
|
if (!defined $data{'id'} && $string =~ /(#|PCI)(\d+)\b/){
|
|
$data{'id'} = $2;
|
|
}
|
|
if (!defined $data{'id'} && $string =~ /SLOT[\s-]?(\d+)\b/i){
|
|
$data{'id'} = $1;
|
|
}
|
|
if ($string =~ s/\bJ-?(\S+)\b//){
|
|
push(@extra,'J' . $1) if ! grep {$_ eq 'J' . $1} @extra;
|
|
}
|
|
if ($string =~ s/\bM\.?2\b//){
|
|
push(@extra,'M.2') if ! grep {$_ eq 'M.2'} @extra;
|
|
}
|
|
if ($string =~ /(ExpressCard|MediaCard|CardBus)/){
|
|
push(@extra,$1) if ! grep {$_ eq $1} @extra;
|
|
}
|
|
if (!$data{'cpu'} && $string =~ s/CPU-?(\d+)\b//){
|
|
$data{'cpu'} = $1;
|
|
}
|
|
if (!$data{'gen'} && $data{'pci'} && $data{'pci'} eq 'PCIe' &&
|
|
$string =~ /PCIe[\s_-]*([\d.]+)/){
|
|
$data{'gen'} = $1 + 0;
|
|
}
|
|
if (!$data{'mhz'} && $data{'pci'} && $string =~ /(\d+)[\s_-]?MHz/){
|
|
$data{'mhz'} = $1;
|
|
}
|
|
if (!$data{'bits'} && $data{'pci'} && $string =~ /\b(\d+)[\s_-]?bit/){
|
|
$data{'bits'} = $1;
|
|
}
|
|
$i++;
|
|
}
|
|
if (!$data{'pci'} && $data{'type'} &&
|
|
$data{'type'} =~ /(ExpressCard|MediaCard|CardBus)/){
|
|
$data{'pci'} = $1;
|
|
@extra = grep {$_ ne $data{'pci'}} @extra;
|
|
}
|
|
$data{'extra'} = [@extra] if @extra;
|
|
push(@$slots,{%data}) if %data;
|
|
}
|
|
print '@$slots: ', Data::Dumper::Dumper $slots if $dbg[48];
|
|
main::log_data('dump','@$slots final',$slots) if $b_log;
|
|
eval $end if $b_log;
|
|
return $slots;
|
|
}
|
|
|
|
sub slot_data_sys {
|
|
eval $start if $b_log;
|
|
my $path = '/sys/devices/pci0000:*/00*';
|
|
my @data = main::globber($path);
|
|
my ($full,$id);
|
|
foreach $full (@data){
|
|
$id = $full;
|
|
$id =~ s/^.*\/\S+:([0-9a-f]{2}:[0-9a-f]{2}\.[0-9a-f]+)$/$1/;
|
|
$sys_slots->{$id} = slot_data_recursive($full);
|
|
}
|
|
print 'sys_slots: ', Data::Dumper::Dumper $sys_slots if $dbg[49];
|
|
main::log_data('dump','$sys_slots',$sys_slots) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub slot_data_recursive {
|
|
eval $start if $b_log;
|
|
my $path = shift @_;
|
|
my $info = {};
|
|
my $id = $path;
|
|
$id =~ s/^.*\/\S+:(\S{2}:\S{2}\.\S+)$/$1/;
|
|
my ($content,$id2,@files);
|
|
# @files = main::globber("$full/{class,current_link_speed,current_link_width,max_link_speed,max_link_width,00*}");
|
|
if (-e "$path/class" && ($content = main::reader("$path/class",'strip',0))){
|
|
if ($content =~ /^0x(\S{2})(\S{2})/){
|
|
$info->{'class-id'} = $1;
|
|
$info->{'class-id-sub'} = $2;
|
|
$info->{'class'} = DeviceData::pci_class($1);
|
|
if ($info->{'class-id'} eq '06'){
|
|
my @files = main::globber("$path/00*:[0-9a-f][0-9a-f]:[0-9a-f][0-9a-f].[0-9a-f]");
|
|
foreach my $item (@files){
|
|
$id = $item;
|
|
$id =~ s/^.*\/[0-9a-f]+:([0-9a-f]{2}:[0-9a-f]{2}\.[0-9a-f]+)$/$1/;
|
|
$info->{'children'}{$id} = slot_data_recursive($item);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if (-e "$path/current_link_speed" &&
|
|
($content = main::reader("$path/current_link_speed",'strip',0))){
|
|
$content =~ s/\sPCIe//i;
|
|
$info->{'current-link-speed'} = main::clean_dmi($content);
|
|
}
|
|
if (-e "$path/current_link_width" &&
|
|
($content = main::reader("$path/current_link_width",'strip',0))){
|
|
$info->{'current-link-width'} = $content;
|
|
}
|
|
eval $end if $b_log;
|
|
return $info;
|
|
}
|
|
|
|
sub slot_children {
|
|
eval $start if $b_log;
|
|
my ($bus_id,$slots) = @_;
|
|
my $children = slot_children_recursive($bus_id,$slots);
|
|
# $children->{'0a:00.0'}{'children'} = {'3423' => {
|
|
# 'class' => 'test','class-id' => '05','class-id-sub' => '10'}};
|
|
print $bus_id, ' children: ', Data::Dumper::Dumper $children if $dbg[49];
|
|
main::log_data('dump','$children',$children) if $b_log;
|
|
eval $end if $b_log;
|
|
return $children;
|
|
}
|
|
|
|
sub slot_children_recursive {
|
|
my ($bus_id,$slots) = @_;
|
|
my $children;
|
|
foreach my $key (keys %{$slots}){
|
|
if ($slots->{$bus_id}){
|
|
$children = $slots->{$bus_id}{'children'} if $slots->{$bus_id}{'children'};
|
|
last;
|
|
}
|
|
elsif ($slots->{$key}{'children'}){
|
|
slot_children_recursive($bus_id,$slots->{$key}{'children'});
|
|
}
|
|
}
|
|
return $children;
|
|
}
|
|
}
|
|
|
|
## SwapItem
|
|
{
|
|
package SwapItem;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my $rows = [];
|
|
my $num = 0;
|
|
create_output($rows);
|
|
if (!@$rows){
|
|
@$rows = ({main::key($num++,0,1,'Alert') => main::message('swap-data')});
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub create_output {
|
|
eval $start if $b_log;
|
|
my $rows = $_[0];
|
|
my $num = 0;
|
|
my $j = 0;
|
|
my (@rows,$dev,$percent,$raw_size,$size,$used);
|
|
PartitionData::set() if !$bsd_type && !$loaded{'partition-data'};
|
|
DiskDataBSD::set() if $bsd_type && !$loaded{'disk-data-bsd'};
|
|
main::set_mapper() if !$loaded{'mapper'};
|
|
PartitionItem::swap_data() if !$loaded{'set-swap'};
|
|
foreach my $row (@swaps){
|
|
$num = 1;
|
|
$size = ($row->{'size'}) ? main::get_size($row->{'size'},'string') : 'N/A';
|
|
$used = main::get_size($row->{'used'},'string','N/A'); # used can be 0
|
|
$percent = (defined $row->{'percent-used'}) ? ' (' . $row->{'percent-used'} . '%)' : '';
|
|
$dev = ($row->{'swap-type'} eq 'file') ? 'file' : 'dev';
|
|
$row->{'swap-type'} = ($row->{'swap-type'}) ? $row->{'swap-type'} : 'N/A';
|
|
if ($b_admin && !$bsd_type && $j == 0){
|
|
$j = scalar @rows;
|
|
if (defined $row->{'swappiness'} || defined $row->{'cache-pressure'}){
|
|
$rows->[$j]{main::key($num++,1,1,'Kernel')} = '';
|
|
if (defined $row->{'swappiness'}){
|
|
$rows->[$j]{main::key($num++,0,2,'swappiness')} = $row->{'swappiness'};
|
|
}
|
|
if (defined $row->{'cache-pressure'}){
|
|
$rows->[$j]{main::key($num++,0,2,'cache-pressure')} = $row->{'cache-pressure'};
|
|
}
|
|
$row->{'zswap-enabled'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,1,2,'zswap')} = $row->{'zswap-enabled'};
|
|
if ($row->{'zswap-enabled'} eq 'yes'){
|
|
if (defined $row->{'zswap-compressor'}){
|
|
$rows->[$j]{main::key($num++,0,1,'compressor')} = $row->{'zswap-compressor'};
|
|
}
|
|
if (defined $row->{'zswap-max-pool-percent'}){
|
|
$rows->[$j]{main::key($num++,0,1,'max-pool')} = $row->{'zswap-max-pool-percent'} . '%';
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$rows->[$j]{main::key($num++,0,1,'Message')} = main::message('swap-admin');
|
|
}
|
|
}
|
|
$j = scalar @$rows;
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'ID') => $row->{'id'},
|
|
main::key($num++,0,2,'type') => $row->{'swap-type'},
|
|
});
|
|
# not used for swap as far as I know
|
|
if ($b_admin && $row->{'raw-size'}){
|
|
# It's an error! permissions or missing tool
|
|
$raw_size = main::get_size($row->{'raw-size'},'string');
|
|
$rows->[$j]{main::key($num++,0,2,'raw-size')} = $raw_size;
|
|
}
|
|
# not used for swap as far as I know
|
|
if ($b_admin && $row->{'raw-available'} && $size ne 'N/A'){
|
|
$size .= ' (' . $row->{'raw-available'} . '%)';
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'size')} = $size;
|
|
$rows->[$j]{main::key($num++,0,2,'used')} = $used . $percent;
|
|
# not used for swap as far as I know
|
|
if ($b_admin && $row->{'block-size'}){
|
|
$rows->[$j]{main::key($num++,0,2,'block-size')} = $row->{'block-size'} . ' B';;
|
|
#$rows->[$j]{main::key($num++,0,2,'physical')} = $row->{'block-size'} . ' B';
|
|
#$rows->[$j]{main::key($num++,0,2,'logical')} = $row->{'block-logical'} . ' B';
|
|
}
|
|
if ($extra > 1 && defined $row->{'priority'}){
|
|
$rows->[$j]{main::key($num++,0,2,'priority')} = $row->{'priority'};
|
|
}
|
|
if ($b_admin && $row->{'swap-type'} eq 'zram'){
|
|
if ($row->{'zram-comp'}){
|
|
$rows->[$j]{main::key($num++,1,2,'comp')} = $row->{'zram-comp'};
|
|
if ($row->{'zram-comp-avail'}){
|
|
$rows->[$j]{main::key($num++,0,3,'avail')} = $row->{'zram-comp-avail'};
|
|
}
|
|
}
|
|
if ($row->{'zram-max-comp-streams'}){
|
|
$rows->[$j]{main::key($num++,0,3,'max-streams')} = $row->{'zram-max-comp-streams'};
|
|
}
|
|
}
|
|
$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';
|
|
if ($b_admin && $row->{'maj-min'}){
|
|
$rows->[$j]{main::key($num++,0,3,'maj-min')} = $row->{'maj-min'};
|
|
}
|
|
if ($extra > 0 && $row->{'dev-mapped'}){
|
|
$rows->[$j]{main::key($num++,0,3,'mapped')} = $row->{'dev-mapped'};
|
|
}
|
|
if ($show{'label'} && ($row->{'label'} || $row->{'swap-type'} eq 'partition')){
|
|
if ($use{'filter-label'}){
|
|
$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')){
|
|
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;
|
|
}
|
|
}
|
|
|
|
## UnmountedItem
|
|
{
|
|
package UnmountedItem;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my ($data,$key1,$val1);
|
|
my $rows = [];
|
|
my $num = 0;
|
|
if ($bsd_type){
|
|
DiskDataBSD::set() if !$loaded{'disk-data-bsd'};
|
|
if (%disks_bsd && ($alerts{'disklabel'}->{'action'} eq 'use' ||
|
|
$alerts{'gpart'}->{'action'} eq 'use')){
|
|
$data = bsd_data();
|
|
if (!@$data){
|
|
$key1 = 'Message';
|
|
$val1 = main::message('unmounted-data');
|
|
}
|
|
else {
|
|
create_output($rows,$data);
|
|
}
|
|
}
|
|
else {
|
|
if ($alerts{'disklabel'}->{'action'} eq 'permissions'){
|
|
$key1 = 'Message';
|
|
$val1 = $alerts{'disklabel'}->{'message'};
|
|
}
|
|
else {
|
|
$key1 = 'Message';
|
|
$val1 = main::message('unmounted-data-bsd',$uname[0]);
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
if ($system_files{'proc-partitions'}){
|
|
$data = proc_data();
|
|
if (!@$data){
|
|
$key1 = 'Message';
|
|
$val1 = main::message('unmounted-data');
|
|
}
|
|
else {
|
|
create_output($rows,$data);
|
|
}
|
|
}
|
|
else {
|
|
$key1 = 'Message';
|
|
$val1 = main::message('unmounted-file');
|
|
}
|
|
}
|
|
if (!@$rows && $key1){
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1});
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub create_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$unmounted) = @_;
|
|
my ($fs);
|
|
my ($j,$num) = (0,0);
|
|
@$unmounted = sort { $a->{'dev-base'} cmp $b->{'dev-base'} } @$unmounted;
|
|
my $fs_skip = PartitionItem::get_filters('fs-skip');
|
|
foreach my $row (@$unmounted){
|
|
$num = 1;
|
|
my $size = ($row->{'size'}) ? main::get_size($row->{'size'},'string') : 'N/A';
|
|
if ($row->{'fs'}){
|
|
$fs = lc($row->{'fs'});
|
|
}
|
|
else {
|
|
if ($bsd_type){
|
|
$fs = 'N/A';
|
|
}
|
|
elsif (main::check_program('file')){
|
|
$fs = ($b_root) ? 'N/A' : main::message('root-required');
|
|
}
|
|
else {
|
|
$fs = main::message('tool-missing-basic','file');
|
|
}
|
|
}
|
|
$j = scalar @$rows;
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'ID') => "/dev/$row->{'dev-base'}",
|
|
});
|
|
if ($b_admin && $row->{'maj-min'}){
|
|
$rows->[$j]{main::key($num++,0,2,'maj-min')} = $row->{'maj-min'};
|
|
}
|
|
if ($extra > 0 && $row->{'dev-mapped'}){
|
|
$rows->[$j]{main::key($num++,0,2,'mapped')} = $row->{'dev-mapped'};
|
|
}
|
|
$row->{'label'} ||= 'N/A';
|
|
$row->{'uuid'} ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,2,'size')} = $size;
|
|
$rows->[$j]{main::key($num++,0,2,'fs')} = $fs;
|
|
# don't show for fs known to not have label/uuid
|
|
if (($show{'label'} || $show{'uuid'}) && $fs !~ /^$fs_skip$/){
|
|
if ($show{'label'}){
|
|
if ($use{'filter-label'}){
|
|
$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'};
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub proc_data {
|
|
eval $start if $b_log;
|
|
my ($dev_mapped,$fs,$label,$maj_min,$size,$uuid,$part);
|
|
my $unmounted = [];
|
|
# last filters to make sure these are dumped
|
|
my @filters = ('scd[0-9]+','sr[0-9]+','cdrom[0-9]*','cdrw[0-9]*',
|
|
'dvd[0-9]*','dvdrw[0-9]*','fd[0-9]','ram[0-9]*');
|
|
my $num = 0;
|
|
# set labels, uuid, gpart
|
|
PartitionItem::set_partitions() if !$loaded{'set-partitions'};
|
|
RaidItem::raid_data() if !$loaded{'raid'};
|
|
my $mounted = get_mounted();
|
|
# print join("\n",(@filters,@$mounted)),"\n";
|
|
foreach my $row (@proc_partitions){
|
|
($dev_mapped,$fs,$label,$maj_min,$uuid,$size) = ('','','','','','');
|
|
# note that size 1 means it is a logical extended partition container
|
|
# lvm might have dm-1 type syntax
|
|
# need to exclude loop type file systems, squashfs for example
|
|
# NOTE: nvme needs special treatment because the main device is: nvme0n1
|
|
# note: $working[2] != 1 is wrong, it's not related
|
|
# note: for zfs using /dev/sda no partitions, previous rule would have removed
|
|
# the unmounted report because sdb was found in sdb1, but match of eg sdb1 and sdb12
|
|
# makes this a problem, so using zfs_member test instead to filter out zfs members.
|
|
# For zfs using entire disk, ie, sda, in that case, all partitions sda1 sda9 (8BiB)
|
|
# belong to zfs, and aren't unmmounted, so if sda and partition sda9,
|
|
# remove from list. this only works for sdxx drives, but is better than no fix
|
|
# This logic may also end up working for btrfs partitions, and maybe hammer?
|
|
# In arm/android seen /dev/block/mmcblk0p12
|
|
# 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 = LsblkData::get($id);
|
|
if (%$part){
|
|
$fs = $part->{'fs'};
|
|
$label = $part->{'label'};
|
|
$maj_min = $part->{'maj-min'};
|
|
$uuid = $part->{'uuid'};
|
|
$size = $part->{'size'} if $part->{'size'} && !$row->[2];
|
|
}
|
|
}
|
|
$size ||= $row->[2];
|
|
$fs = unmounted_filesystem($row->[-1]) if !$fs;
|
|
# seen: (zfs|lvm2|linux_raid)_member; crypto_luks
|
|
# note: lvm, raid members are never mounted. luks member is never mounted.
|
|
next if $fs && $fs =~ /(bcache|crypto|luks|_member)$/i;
|
|
# these components of lvm raid will show as partitions byt are reserved private lvm member
|
|
# See man lvm for all current reserved private volume names
|
|
next if $dev_mapped && $dev_mapped =~ /_([ctv]data|corig|[mr]image|mlog|[crt]meta|pmspare|pvmove|vorigin)(_[0-9]+)?$/;
|
|
if (!$bsd_type){
|
|
$label = PartitionItem::get_label("/dev/$row->[-1]") if !$label;
|
|
$uuid = PartitionItem::get_uuid("/dev/$row->[-1]") if !$uuid;
|
|
}
|
|
else {
|
|
my @temp = GpartData::get($row->[-1]);
|
|
$label = $temp[1] if $temp[1];
|
|
$uuid = $temp[2] if $temp[2];
|
|
}
|
|
$maj_min = "$row->[0]:$row->[1]" if !$maj_min;
|
|
push(@$unmounted, {
|
|
'dev-base' => $row->[-1],
|
|
'dev-mapped' => $dev_mapped,
|
|
'fs' => $fs,
|
|
'label' => $label,
|
|
'maj-min' => $maj_min,
|
|
'size' => $size,
|
|
'uuid' => $uuid,
|
|
});
|
|
}
|
|
}
|
|
print Data::Dumper::Dumper $unmounted if $dbg[35];
|
|
main::log_data('dump','@$unmounted',$unmounted) if $b_log;
|
|
eval $end if $b_log;
|
|
return $unmounted;
|
|
}
|
|
|
|
sub bsd_data {
|
|
eval $start if $b_log;
|
|
my ($fs,$label,$size,$uuid,%part);
|
|
my $unmounted = [];
|
|
PartitionItem::set_partitions() if !$loaded{'set-partitions'};
|
|
RaidItem::raid_data() if !$loaded{'raid'};
|
|
my $mounted = get_mounted();
|
|
foreach my $id (sort keys %disks_bsd){
|
|
next if !$disks_bsd{$id}->{'partitions'};
|
|
foreach my $part (sort keys %{$disks_bsd{$id}->{'partitions'}}){
|
|
if (!(grep {$_ =~ /$part$/} @$mounted)){
|
|
$fs = $disks_bsd{$id}->{'partitions'}{$part}{'fs'};
|
|
next if $fs && $fs =~ /(raid|_member)$/i;
|
|
$label = $disks_bsd{$id}->{'partitions'}{$part}{'label'};
|
|
$size = $disks_bsd{$id}->{'partitions'}{$part}{'size'};
|
|
$uuid = $disks_bsd{$id}->{'partitions'}{$part}{'uuid'};
|
|
# $fs = unmounted_filesystem($part) if !$fs;
|
|
push(@$unmounted, {
|
|
'dev-base' => $part,
|
|
'dev-mapped' => '',
|
|
'fs' => $fs,
|
|
'label' => $label,
|
|
'maj-min' => '',
|
|
'size' => $size,
|
|
'uuid' => $uuid,
|
|
});
|
|
}
|
|
}
|
|
}
|
|
print Data::Dumper::Dumper $unmounted if $dbg[35];
|
|
main::log_data('dump','@$unmounted',$unmounted) if $b_log;
|
|
eval $end if $b_log;
|
|
return $unmounted;
|
|
}
|
|
|
|
sub get_mounted {
|
|
eval $start if $b_log;
|
|
my (@arrays);
|
|
my $mounted = [];
|
|
foreach my $row (@partitions){
|
|
push(@$mounted, $row->{'dev-base'}) if $row->{'dev-base'};
|
|
}
|
|
# print Data::Dumper::Dumper \@zfs_raid;
|
|
foreach my $row ((@btrfs_raid,@lvm_raid,@md_raid,@soft_raid,@zfs_raid)){
|
|
# we want to not show md0 etc in unmounted report
|
|
push(@$mounted, $row->{'id'}) if $row->{'id'};
|
|
# print Data::Dumper::Dumper $row;
|
|
# row->arrays->components: zfs; row->components: lvm,mdraid,softraid
|
|
if ($row->{'arrays'} && ref $row->{'arrays'} eq 'ARRAY'){
|
|
push(@arrays,@{$row->{'arrays'}});
|
|
}
|
|
elsif ($row->{'components'} && ref $row->{'components'} eq 'ARRAY'){
|
|
push(@arrays,$row);
|
|
}
|
|
@arrays = grep {defined $_} @arrays;
|
|
# print Data::Dumper::Dumper \@arrays;
|
|
foreach my $item (@arrays){
|
|
# print Data::Dumper::Dumper $item;
|
|
my @components = (ref $item->{'components'} eq 'ARRAY') ? @{$item->{'components'}} : ();
|
|
foreach my $component (@components){
|
|
# md has ~, not zfs,lvm,softraid
|
|
my $temp = (split('~', $component->[0]))[0];
|
|
push(@$mounted, $temp);
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $mounted;
|
|
}
|
|
|
|
# bsds do not seem to return any useful data so only for linux
|
|
sub unmounted_filesystem {
|
|
eval $start if $b_log;
|
|
my ($item) = @_;
|
|
my ($data,%part);
|
|
my ($file,$fs,$path) = ('','','');
|
|
if ($path = main::check_program('file')){
|
|
$file = $path;
|
|
}
|
|
# order matters in this test!
|
|
my @filesystems = ('ext2','ext3','ext4','ext5','ext','ntfs',
|
|
'fat32','fat16','FAT\s\(.*\)','vfat','fatx','tfat','exfat','swap','btrfs',
|
|
'ffs','hammer','hfs\+','hfs\splus','hfs\sextended\sversion\s[1-9]','hfsj',
|
|
'hfs','apfs','jfs','nss','reiserfs','reiser4','ufs2','ufs','xfs','zfs');
|
|
if ($file){
|
|
# this will fail if regular user and no sudo present, but that's fine, it will just return null
|
|
# note the hack that simply slices out the first line if > 1 items found in string
|
|
# also, if grub/lilo is on partition boot sector, no file system data is available
|
|
$data = (main::grabber("$sudoas$file -s /dev/$item 2>/dev/null"))[0];
|
|
if ($data){
|
|
foreach (@filesystems){
|
|
if ($data =~ /($_)[\s,]/i){
|
|
$fs = $1;
|
|
$fs = main::trimmer($fs);
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
main::log_data('data',"fs: $fs") if $b_log;
|
|
eval $end if $b_log;
|
|
return $fs;
|
|
}
|
|
}
|
|
|
|
## UsbItem
|
|
{
|
|
package UsbItem;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my ($key1,$val1);
|
|
my $rows = [];
|
|
my $num = 0;
|
|
if (!$usb{'main'} && $alerts{'lsusb'}->{'action'} ne 'use' &&
|
|
$alerts{'usbdevs'}->{'action'} ne 'use' &&
|
|
$alerts{'usbconfig'}->{'action'} ne 'use'){
|
|
if ($os eq 'linux'){
|
|
$key1 = $alerts{'lsusb'}->{'action'};
|
|
$val1 = $alerts{'lsusb'}->{'message'};
|
|
}
|
|
else {
|
|
# note: usbdevs only has 'missing', usbconfig has missing/permissions
|
|
# both have platform, but irrelevant since testing for linux here
|
|
if ($alerts{'usbdevs'}->{'action'} eq 'missing' &&
|
|
$alerts{'usbconfig'}->{'action'} eq 'missing'){
|
|
$key1 = $alerts{'usbdevs'}->{'action'};
|
|
$val1 = main::message('tools-missing-bsd','usbdevs/usbconfig');
|
|
}
|
|
elsif ($alerts{'usbconfig'}->{'action'} eq 'permissions'){
|
|
$key1 = $alerts{'usbconfig'}->{'action'};
|
|
$val1 = $alerts{'usbconfig'}->{'message'};
|
|
}
|
|
# elsif ($alerts{'lsusb'}->{'action'} eq 'missing'){
|
|
# $key1 = $alerts{'lsusb'}->{'action'};
|
|
# $val1 = $alerts{'lsusb'}->{'message'};
|
|
# }
|
|
}
|
|
$key1 = ucfirst($key1);
|
|
@$rows = ({main::key($num++,0,1,$key1) => $val1});
|
|
}
|
|
else {
|
|
usb_output($rows);
|
|
if (!@$rows){
|
|
my $key = 'Message';
|
|
@$rows = ({
|
|
main::key($num++,0,1,$key) => main::message('usb-data','')
|
|
});
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub usb_output {
|
|
eval $start if $b_log;
|
|
return if !$usb{'main'};
|
|
my $rows = $_[0];
|
|
my ($b_hub,$bus_id,$chip_id,$driver,$ind_rc,$ind_sc,$path_id,$ports,$product,
|
|
$rev,$serial,$speed_si,$type);
|
|
my $num = 0;
|
|
my $j = 0;
|
|
# note: the data has been presorted in UsbData:
|
|
# bus alpah id, so we don't need to worry about the order
|
|
foreach my $id (@{$usb{'main'}}){
|
|
$j = scalar @$rows;
|
|
($b_hub,$ind_rc,$ind_sc,$num) = (0,4,3,1);
|
|
($driver,$path_id,$ports,$product,$rev,$serial,$speed_si,
|
|
$type) = ('','','','','','','','','');
|
|
$rev = $id->[8] if $id->[8];
|
|
$product = main::clean($id->[13]) if $id->[13];
|
|
$serial = main::filter($id->[16]) if $id->[16];
|
|
$product ||= 'N/A';
|
|
$rev ||= 'N/A';
|
|
$path_id = $id->[2] if $id->[2];
|
|
$bus_id = "$path_id:$id->[1]";
|
|
# it's a hub
|
|
if ($id->[4] eq '09'){
|
|
$ports = $id->[10] if $id->[10];
|
|
$ports ||= 'N/A';
|
|
# print "pt0:$protocol\n";
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Hub') => $bus_id,
|
|
main::key($num++,0,2,'info') => $product,
|
|
main::key($num++,0,2,'ports') => $ports,
|
|
},);
|
|
$b_hub = 1;
|
|
$ind_rc =3;
|
|
$ind_sc =2;
|
|
}
|
|
# it's a device
|
|
else {
|
|
$type = $id->[14] if $id->[14];
|
|
$driver = $id->[15] if $id->[15];
|
|
$type ||= 'N/A';
|
|
$driver ||= 'N/A';
|
|
# print "pt3:$class:$product\n";
|
|
$rows->[$j]{main::key($num++,1,2,'Device')} = $bus_id;
|
|
$rows->[$j]{main::key($num++,0,3,'info')} = $product;
|
|
$rows->[$j]{main::key($num++,0,3,'type')} = $type;
|
|
if ($extra > 0){
|
|
$rows->[$j]{main::key($num++,0,3,'driver')} = $driver;
|
|
}
|
|
if ($extra > 2 && $id->[9]){
|
|
$rows->[$j]{main::key($num++,0,3,'interfaces')} = $id->[9];
|
|
}
|
|
}
|
|
# for either hub or device
|
|
$rows->[$j]{main::key($num++,1,$ind_sc,'rev')} = $rev;
|
|
if ($extra > 0){
|
|
$speed_si = ($id->[17]) ? $id->[17] : 'N/A';
|
|
$speed_si .= " ($id->[25])" if ($b_admin && $id->[25]);
|
|
$rows->[$j]{main::key($num++,0,$ind_rc,'speed')} = $speed_si;
|
|
if ($extra > 1){
|
|
if ($id->[24]){
|
|
if ($id->[23] == $id->[24]){
|
|
$rows->[$j]{main::key($num++,0,$ind_rc,'lanes')} = $id->[24];
|
|
}
|
|
else {
|
|
$rows->[$j]{main::key($num++,1,$ind_rc,'lanes')} = '';
|
|
$rows->[$j]{main::key($num++,0,($ind_rc+1),'rx')} = $id->[23];
|
|
$rows->[$j]{main::key($num++,0,($ind_rc+1),'tx')} = $id->[24];
|
|
}
|
|
}
|
|
}
|
|
# 22 is only available if 23 and 24 are present as well
|
|
if ($b_admin && $id->[22]){
|
|
$rows->[$j]{main::key($num++,0,$ind_rc,'mode')} = $id->[22];
|
|
}
|
|
if ($extra > 2 && $id->[19] && $id->[19] ne '0mA'){
|
|
$rows->[$j]{main::key($num++,0,$ind_sc,'power')} = $id->[19];
|
|
}
|
|
$chip_id = $id->[7];
|
|
$chip_id ||= 'N/A';
|
|
$rows->[$j]{main::key($num++,0,$ind_sc,'chip-ID')} = $chip_id;
|
|
if ($extra > 2 && defined $id->[5] && $id->[5] ne ''){
|
|
my $id = sprintf("%02s",$id->[4]) . sprintf("%02s", $id->[5]);
|
|
$rows->[$j]{main::key($num++,0,$ind_sc,'class-ID')} = $id;
|
|
}
|
|
if (!$b_hub && $extra > 2){
|
|
if ($serial){
|
|
$rows->[$j]{main::key($num++,0,$ind_sc,'serial')} = main::filter($serial);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \@rows;
|
|
eval $end if $b_log;
|
|
}
|
|
}
|
|
|
|
## WeatherItem
|
|
# add metric / imperial (us) switch
|
|
{
|
|
package WeatherItem;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my $rows = [];
|
|
my $num = 0;
|
|
my $location = [];
|
|
location_data($location);
|
|
# print Data::Dumper::Dumper $location;exit;
|
|
if (!$location->[0]){
|
|
@$rows = ({
|
|
main::key($num++,0,1,'Message') => main::message('weather-null','current location')
|
|
});
|
|
}
|
|
else {
|
|
my $weather = get_weather($location);
|
|
if ($weather->{'error'}){
|
|
@$rows = ({
|
|
main::key($num++,0,1,'Message') => main::message('weather-error',$weather->{'error'})
|
|
});
|
|
}
|
|
elsif (!$weather->{'weather'}){
|
|
@$rows = ({
|
|
main::key($num++,0,1,'Message') => main::message('weather-null','weather data')
|
|
});
|
|
}
|
|
else {
|
|
weather_output($rows,$location,$weather);
|
|
}
|
|
}
|
|
if (!@$rows){
|
|
@$rows = ({
|
|
main::key($num++,0,1,'Message') => main::message('weather-null','weather data')
|
|
});
|
|
}
|
|
eval $end if $b_log;
|
|
return $rows;
|
|
}
|
|
|
|
sub weather_output {
|
|
eval $start if $b_log;
|
|
my ($rows,$location,$weather) = @_;
|
|
my ($j,$num) = (0,0);
|
|
my ($value);
|
|
my ($conditions) = ('NA');
|
|
$conditions = "$weather->{'weather'}";
|
|
my $temp = process_unit(
|
|
$weather->{'temp'},
|
|
$weather->{'temp-c'},'C',
|
|
$weather->{'temp-f'},'F');
|
|
$j = scalar @$rows;
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Report') => '',
|
|
main::key($num++,0,2,'temperature') => $temp,
|
|
main::key($num++,0,2,'conditions') => $conditions,
|
|
},);
|
|
if ($extra > 0){
|
|
my $pressure = process_unit(
|
|
$weather->{'pressure'},
|
|
$weather->{'pressure-mb'},'mb',
|
|
$weather->{'pressure-in'},'in');
|
|
my $wind = process_wind(
|
|
$weather->{'wind'},
|
|
$weather->{'wind-direction'},
|
|
$weather->{'wind-mph'},
|
|
$weather->{'wind-ms'},
|
|
$weather->{'wind-gust-mph'},
|
|
$weather->{'wind-gust-ms'});
|
|
$rows->[$j]{main::key($num++,0,2,'wind')} = $wind;
|
|
if ($extra > 1){
|
|
if (defined $weather->{'cloud-cover'}){
|
|
$rows->[$j]{main::key($num++,0,2,'cloud cover')} = $weather->{'cloud-cover'} . '%';
|
|
}
|
|
if ($weather->{'precip-1h-mm'} && defined $weather->{'precip-1h-in'}){
|
|
$value = process_unit('',$weather->{'precip-1h-mm'},'mm',
|
|
$weather->{'precip-1h-in'},'in');
|
|
$rows->[$j]{main::key($num++,0,2,'precipitation')} = $value;
|
|
}
|
|
if ($weather->{'rain-1h-mm'} && defined $weather->{'rain-1h-in'}){
|
|
$value = process_unit('',$weather->{'rain-1h-mm'},'mm',
|
|
$weather->{'rain-1h-in'},'in');
|
|
$rows->[$j]{main::key($num++,0,2,'rain')} = $value;
|
|
}
|
|
if ($weather->{'snow-1h-mm'} && defined $weather->{'snow-1h-in'}){
|
|
$value = process_unit('',$weather->{'snow-1h-mm'},'mm',
|
|
$weather->{'snow-1h-in'},'in');
|
|
$rows->[$j]{main::key($num++,0,2,'snow')} = $value;
|
|
}
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'humidity')} = $weather->{'humidity'} . '%';
|
|
if ($extra > 1){
|
|
if ($weather->{'dewpoint'} || (defined $weather->{'dewpoint-c'} &&
|
|
defined $weather->{'dewpoint-f'})){
|
|
$value = process_unit(
|
|
$weather->{'dewpoint'},
|
|
$weather->{'dewpoint-c'},
|
|
'C',
|
|
$weather->{'dewpoint-f'},
|
|
'F');
|
|
$rows->[$j]{main::key($num++,0,2,'dew point')} = $value;
|
|
}
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'pressure')} = $pressure;
|
|
}
|
|
if ($extra > 1){
|
|
if ($weather->{'heat-index'} || (defined $weather->{'heat-index-c'} &&
|
|
defined $weather->{'heat-index-f'})){
|
|
$value = process_unit(
|
|
$weather->{'heat-index'},
|
|
$weather->{'heat-index-c'},'C',
|
|
$weather->{'heat-index-f'},'F');
|
|
$rows->[$j]{main::key($num++,0,2,'heat index')} = $value;
|
|
}
|
|
if ($weather->{'windchill'} || (defined $weather->{'windchill-c'} &&
|
|
defined $weather->{'windchill-f'})){
|
|
$value = process_unit(
|
|
$weather->{'windchill'},
|
|
$weather->{'windchill-c'},'C',
|
|
$weather->{'windchill-f'},'F');
|
|
$rows->[$j]{main::key($num++,0,2,'wind chill')} = $value;
|
|
}
|
|
if ($extra > 2){
|
|
if ($weather->{'forecast'}){
|
|
$j = scalar @$rows;
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Forecast') => $weather->{'forecast'},
|
|
},);
|
|
}
|
|
}
|
|
}
|
|
$j = scalar @$rows;
|
|
if ($extra > 2 && !$use{'filter'}){
|
|
complete_location(
|
|
$location,
|
|
$weather->{'city'},
|
|
$weather->{'state'},
|
|
$weather->{'country'});
|
|
}
|
|
push(@$rows, {
|
|
main::key($num++,1,1,'Locale') => $location->[1],
|
|
},);
|
|
if ($extra > 2 && !$use{'filter'} && ($weather->{'elevation-m'} ||
|
|
$weather->{'elevation-ft'})){
|
|
$rows->[$j]{main::key($num++,0,2,'altitude')} = process_elevation(
|
|
$weather->{'elevation-m'},
|
|
$weather->{'elevation-ft'});
|
|
}
|
|
$rows->[$j]{main::key($num++,0,2,'current time')} = $weather->{'date-time'},;
|
|
if ($extra > 2){
|
|
$weather->{'observation-time-local'} = 'N/A' if !$weather->{'observation-time-local'};
|
|
$rows->[$j]{main::key($num++,0,2,'observation time')} = $weather->{'observation-time-local'};
|
|
if ($weather->{'sunrise'}){
|
|
$rows->[$j]{main::key($num++,0,2,'sunrise')} = $weather->{'sunrise'};
|
|
}
|
|
if ($weather->{'sunset'}){
|
|
$rows->[$j]{main::key($num++,0,2,'sunset')} = $weather->{'sunset'};
|
|
}
|
|
if ($weather->{'moonphase'}){
|
|
$value = $weather->{'moonphase'} . '%';
|
|
$value .= ($weather->{'moonphase-graphic'}) ? ' ' . $weather->{'moonphase-graphic'} :'';
|
|
$rows->[$j]{main::key($num++,0,2,'moonphase')} = $value;
|
|
}
|
|
}
|
|
if ($weather->{'api-source'}){
|
|
$rows->[$j]{main::key($num++,0,1,'Source')} = $weather->{'api-source'};
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub process_elevation {
|
|
eval $start if $b_log;
|
|
my ($meters,$feet) = @_;
|
|
my ($result,$i_unit,$m_unit) = ('','ft','m');
|
|
$feet = sprintf("%.0f", 3.28 * $meters) if defined $meters && !$feet;
|
|
$meters = sprintf("%.1f", $feet/3.28) if defined $feet && !$meters;
|
|
$meters = sprintf("%.0f", $meters) if $meters;
|
|
if (defined $meters && $weather_unit eq 'mi'){
|
|
$result = "$meters $m_unit ($feet $i_unit)";
|
|
}
|
|
elsif (defined $meters && $weather_unit eq 'im'){
|
|
$result = "$feet $i_unit ($meters $m_unit)";
|
|
}
|
|
elsif (defined $meters && $weather_unit eq 'm'){
|
|
$result = "$meters $m_unit";
|
|
}
|
|
elsif (defined $feet && $weather_unit eq 'i'){
|
|
$result = "$feet $i_unit";
|
|
}
|
|
else {
|
|
$result = 'N/A';
|
|
}
|
|
eval $end if $b_log;
|
|
return $result;
|
|
}
|
|
|
|
sub process_unit {
|
|
eval $start if $b_log;
|
|
my ($primary,$metric,$m_unit,$imperial,$i_unit) = @_;
|
|
my $result = '';
|
|
if (defined $metric && defined $imperial && $weather_unit eq 'mi'){
|
|
$result = "$metric $m_unit ($imperial $i_unit)";
|
|
}
|
|
elsif (defined $metric && defined $imperial && $weather_unit eq 'im'){
|
|
$result = "$imperial $i_unit ($metric $m_unit)";
|
|
}
|
|
elsif (defined $metric && $weather_unit eq 'm'){
|
|
$result = "$metric $m_unit";
|
|
}
|
|
elsif (defined $imperial && $weather_unit eq 'i'){
|
|
$result = "$imperial $i_unit";
|
|
}
|
|
elsif ($primary){
|
|
$result = $primary;
|
|
}
|
|
else {
|
|
$result = 'N/A';
|
|
}
|
|
eval $end if $b_log;
|
|
return $result;
|
|
}
|
|
|
|
sub process_wind {
|
|
eval $start if $b_log;
|
|
my ($primary,$direction,$mph,$ms,$gust_mph,$gust_ms) = @_;
|
|
my ($result,$gust_kmh,$kmh,$i_unit,$m_unit,$km_unit) = ('','','','mph','m/s','km/h');
|
|
# get rid of possible gust values if they are the same as wind values
|
|
$gust_mph = undef if $gust_mph && $mph && $mph eq $gust_mph;
|
|
$gust_ms = undef if $gust_ms && $ms && $ms eq $gust_ms;
|
|
# calculate and round, order matters so that rounding only happens after math done
|
|
$ms = 0.44704 * $mph if defined $mph && !defined $ms;
|
|
$mph = $ms * 2.23694 if defined $ms && !defined $mph;
|
|
$kmh = sprintf("%.0f", 18*$ms/5) if defined $ms;
|
|
$ms = sprintf("%.1f", $ms) if defined $ms; # very low mph speeds yield 0, which is wrong
|
|
$mph = sprintf("%.0f", $mph) if defined $mph;
|
|
$gust_ms = 0.44704 * $gust_mph if $gust_mph && !$gust_ms;
|
|
$gust_kmh = 18 * $gust_ms / 5 if $gust_ms;
|
|
$gust_mph = $gust_ms * 2.23694 if $gust_ms && !$gust_mph;
|
|
$gust_mph = sprintf("%.0f", $gust_mph) if $gust_mph;
|
|
$gust_kmh = sprintf("%.0f", $gust_kmh) if $gust_kmh;
|
|
$gust_ms = sprintf("%.0f", $gust_ms) if $gust_ms;
|
|
if (!defined $mph && $primary){
|
|
$result = $primary;
|
|
}
|
|
elsif (defined $mph && defined $direction){
|
|
if ($weather_unit eq 'mi'){
|
|
$result = "from $direction at $ms $m_unit ($kmh $km_unit, $mph $i_unit)";
|
|
}
|
|
elsif ($weather_unit eq 'im'){
|
|
$result = "from $direction at $mph $i_unit ($ms $m_unit, $kmh $km_unit)";
|
|
}
|
|
elsif ($weather_unit eq 'm'){
|
|
$result = "from $direction at $ms $m_unit ($kmh $km_unit)";
|
|
}
|
|
elsif ($weather_unit eq 'i'){
|
|
$result = "from $direction at $mph $i_unit";
|
|
}
|
|
if ($gust_mph){
|
|
if ($weather_unit eq 'mi'){
|
|
$result .= ". Gusting to $ms $m_unit ($kmh $km_unit, $mph $i_unit)";
|
|
}
|
|
elsif ($weather_unit eq 'im'){
|
|
$result .= ". Gusting to $mph $i_unit ($ms $m_unit, $kmh $km_unit)";
|
|
}
|
|
elsif ($weather_unit eq 'm'){
|
|
$result .= ". Gusting to $ms $m_unit ($kmh $km_unit)";
|
|
}
|
|
elsif ($weather_unit eq 'i'){
|
|
$result .= ". Gusting to $mph $i_unit";
|
|
}
|
|
}
|
|
}
|
|
elsif ($primary){
|
|
$result = $primary;
|
|
}
|
|
else {
|
|
$result = 'N/A';
|
|
}
|
|
eval $end if $b_log;
|
|
return $result;
|
|
}
|
|
|
|
sub get_weather {
|
|
eval $start if $b_log;
|
|
my ($location) = @_;
|
|
my $now = POSIX::strftime "%Y%m%d%H%M", localtime;
|
|
my ($date_time,$freshness,$tz,$weather_data);
|
|
my $weather = {};
|
|
my $loc_name = lc($location->[0]);
|
|
$loc_name =~ s/-\/|\s|,/-/g;
|
|
$loc_name =~ s/--/-/g;
|
|
my $file_cached = "$user_data_dir/weather-$loc_name-$weather_source.txt";
|
|
if (-r $file_cached){
|
|
@$weather_data = main::reader($file_cached);
|
|
$freshness = (split(/\^\^/, $weather_data->[0]))[1];
|
|
# print "$now:$freshness\n";
|
|
}
|
|
if (!$freshness || $freshness < ($now - 60)){
|
|
$weather_data = download_weather($now,$file_cached,$location);
|
|
}
|
|
# print join("\n", @weather_data), "\n";
|
|
# NOTE: because temps can be 0, we can't do if value tests
|
|
foreach (@$weather_data){
|
|
my @working = split(/\s*\^\^\s*/, $_);
|
|
next if ! defined $working[1] || $working[1] eq '';
|
|
if ($working[0] eq 'api_source'){
|
|
$weather->{'api-source'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'city'){
|
|
$weather->{'city'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'cloud_cover'){
|
|
$weather->{'cloud-cover'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'country'){
|
|
$weather->{'country'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'dewpoint_string'){
|
|
$weather->{'dewpoint'} = $working[1];
|
|
$working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/;
|
|
$weather->{'dewpoint-c'} = $2;;
|
|
$weather->{'dewpoint-f'} = $1;;
|
|
}
|
|
elsif ($working[0] eq 'dewpoint_c'){
|
|
$weather->{'dewpoint-c'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'dewpoint_f'){
|
|
$weather->{'dewpoint-f'} = $working[1];
|
|
}
|
|
# WU: there are two elevations, we want the first one
|
|
elsif (!$weather->{'elevation-m'} && $working[0] eq 'elevation'){
|
|
# note: bug in source data uses ft for meters, not 100% of time, but usually
|
|
$weather->{'elevation-m'} = $working[1];
|
|
$weather->{'elevation-m'} =~ s/\s*(ft|m).*$//;
|
|
}
|
|
elsif ($working[0] eq 'error'){
|
|
$weather->{'error'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'forecast'){
|
|
$weather->{'forecast'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'heat_index_string'){
|
|
$weather->{'heat-index'} = $working[1];
|
|
$working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/;
|
|
$weather->{'heat-index-c'} = $2;;
|
|
$weather->{'heat-index-f'} = $1;
|
|
}
|
|
elsif ($working[0] eq 'heat_index_c'){
|
|
$weather->{'heat-index-c'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'heat_index_f'){
|
|
$weather->{'heat-index-f'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'relative_humidity'){
|
|
$working[1] =~ s/%$//;
|
|
$weather->{'humidity'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'local_time'){
|
|
$weather->{'local-time'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'local_epoch'){
|
|
$weather->{'local-epoch'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'moonphase'){
|
|
$weather->{'moonphase'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'moonphase_graphic'){
|
|
$weather->{'moonphase-graphic'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'observation_time_rfc822'){
|
|
$weather->{'observation-time-rfc822'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'observation_epoch'){
|
|
$weather->{'observation-epoch'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'observation_time'){
|
|
$weather->{'observation-time-local'} = $working[1];
|
|
$weather->{'observation-time-local'} =~ s/Last Updated on //;
|
|
}
|
|
elsif ($working[0] eq 'precip_mm'){
|
|
$weather->{'precip-1h-mm'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'precip_in'){
|
|
$weather->{'precip-1h-in'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'pressure_string'){
|
|
$weather->{'pressure'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'pressure_mb'){
|
|
$weather->{'pressure-mb'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'pressure_in'){
|
|
$weather->{'pressure-in'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'rain_1h_mm'){
|
|
$weather->{'rain-1h-mm'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'rain_1h_in'){
|
|
$weather->{'rain-1h-in'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'snow_1h_mm'){
|
|
$weather->{'snow-1h-mm'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'snow_1h_in'){
|
|
$weather->{'snow-1h-in'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'state_name'){
|
|
$weather->{'state'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'sunrise'){
|
|
if ($working[1]){
|
|
if ($working[1] !~ /^[0-9]+$/){
|
|
$weather->{'sunrise'} = $working[1];
|
|
}
|
|
# trying to figure out remote time from UTC is too hard
|
|
elsif (!$show{'weather-location'}){
|
|
$weather->{'sunrise'} = POSIX::strftime "%T", localtime($working[1]);
|
|
}
|
|
}
|
|
}
|
|
elsif ($working[0] eq 'sunset'){
|
|
if ($working[1]){
|
|
if ($working[1] !~ /^[0-9]+$/){
|
|
$weather->{'sunset'} = $working[1];
|
|
}
|
|
# trying to figure out remote time from UTC is too hard
|
|
elsif (!$show{'weather-location'}){
|
|
$weather->{'sunset'} = POSIX::strftime "%T", localtime($working[1]);
|
|
}
|
|
}
|
|
}
|
|
elsif ($working[0] eq 'temperature_string'){
|
|
$weather->{'temp'} = $working[1];
|
|
$working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/;
|
|
$weather->{'temp-c'} = $2;;
|
|
$weather->{'temp-f'} = $1;
|
|
# $weather->{'temp'} =~ s/\sF/\xB0 F/; # B0
|
|
# $weather->{'temp'} =~ s/\sF/\x{2109}/;
|
|
# $weather->{'temp'} =~ s/\sC/\x{2103}/;
|
|
}
|
|
elsif ($working[0] eq 'temp_f'){
|
|
$weather->{'temp-f'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'temp_c'){
|
|
$weather->{'temp-c'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'timezone'){
|
|
$weather->{'timezone'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'visibility'){
|
|
$weather->{'visibility'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'visibility_km'){
|
|
$weather->{'visibility-km'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'visibility_mi'){
|
|
$weather->{'visibility-mi'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'weather'){
|
|
$weather->{'weather'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'wind_degrees'){
|
|
$weather->{'wind-degrees'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'wind_dir'){
|
|
$weather->{'wind-direction'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'wind_mph'){
|
|
$weather->{'wind-mph'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'wind_gust_mph'){
|
|
$weather->{'wind-gust-mph'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'wind_gust_ms'){
|
|
$weather->{'wind-gust-ms'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'wind_ms'){
|
|
$weather->{'wind-ms'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'wind_string'){
|
|
$weather->{'wind'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'windchill_string'){
|
|
$weather->{'windchill'} = $working[1];
|
|
$working[1] =~ /^([0-9\.]+)\sF\s\(([0-9\.]+)\sC\)/;
|
|
$weather->{'windchill-c'} = $2;
|
|
$weather->{'windchill-f'} = $1;
|
|
}
|
|
elsif ($working[0] eq 'windchill_c'){
|
|
$weather->{'windchill-c'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'windchill_f'){
|
|
$weather->{'windchill_f'} = $working[1];
|
|
}
|
|
}
|
|
if ($show{'weather-location'}){
|
|
if ($weather->{'observation-time-local'} &&
|
|
$weather->{'observation-time-local'} =~ /^(.*)\s([a-z_]+\/[a-z_]+)$/i){
|
|
$tz = $2;
|
|
}
|
|
if (!$tz && $weather->{'timezone'}){
|
|
$tz = $weather->{'timezone'};
|
|
$weather->{'observation-time-local'} .= ' (' . $weather->{'timezone'} . ')' if $weather->{'observation-time-local'};
|
|
}
|
|
# very clever trick, just make the system think it's in the
|
|
# remote timezone for this local block only
|
|
local $ENV{'TZ'} = $tz if $tz;
|
|
$date_time = POSIX::strftime "%c", localtime();
|
|
$date_time = test_locale_date($date_time,'','');
|
|
$weather->{'date-time'} = $date_time;
|
|
# only wu has rfc822 value, and we want the original observation time then
|
|
if ($weather->{'observation-epoch'} && $tz){
|
|
$date_time = POSIX::strftime "%Y-%m-%d %T ($tz %z)", localtime($weather->{'observation-epoch'});
|
|
$date_time = test_locale_date($date_time,$show{'weather-location'},$weather->{'observation-epoch'});
|
|
$weather->{'observation-time-local'} = $date_time;
|
|
}
|
|
}
|
|
else {
|
|
$date_time = POSIX::strftime "%c", localtime();
|
|
$date_time = test_locale_date($date_time,'','');
|
|
$tz = ($location->[2]) ? " ($location->[2])" : '';
|
|
$weather->{'date-time'} = $date_time . $tz;
|
|
}
|
|
# we get the wrong time using epoch for remote -W location
|
|
if (!$show{'weather-location'} && $weather->{'observation-epoch'}){
|
|
$date_time = POSIX::strftime "%c", localtime($weather->{'observation-epoch'});
|
|
$date_time = test_locale_date($date_time,$show{'weather-location'},$weather->{'observation-epoch'});
|
|
$weather->{'observation-time-local'} = $date_time;
|
|
}
|
|
eval $end if $b_log;
|
|
return $weather;
|
|
}
|
|
|
|
sub download_weather {
|
|
eval $start if $b_log;
|
|
my ($now,$file_cached,$location) = @_;
|
|
my ($temp,$ua,$url);
|
|
my $weather = [];
|
|
$url = "https://smxi.org/opt/xr2.php?loc=$location->[0]&src=$weather_source";
|
|
$ua = 'weather';
|
|
if ($fake{'weather'}){
|
|
# my $file2 = "$fake_data_dir/weather/weather-1.xml";
|
|
# my $file2 = "$fake_data_dir/weather/feed-oslo-1.xml";
|
|
# local $/;
|
|
# my $file = "$fake_data_dir/weather/weather-1.xml";
|
|
# open(my $fh, '<', $file) or die "can't open $file: $!";
|
|
# $temp = <$fh>;
|
|
}
|
|
else {
|
|
$temp = main::download_file('stdout',$url,'',$ua);
|
|
}
|
|
@$weather = split('\n', $temp) if $temp;
|
|
unshift(@$weather, "timestamp^^$now");
|
|
main::writer($file_cached,$weather);
|
|
# print "$file_cached: download/cleaned\n";
|
|
eval $end if $b_log;
|
|
return $weather;
|
|
}
|
|
|
|
# Rsolve wide character issue, if detected, switch to iso
|
|
# date format, we won't try to be too clever here.
|
|
sub test_locale_date {
|
|
my ($date_time,$location,$epoch) = @_;
|
|
# $date_time .= 'дек';
|
|
# print "1: $date_time\n";
|
|
if ($date_time =~ m/[^\x00-\x7f]/){
|
|
if (!$location && $epoch){
|
|
$date_time = POSIX::strftime "%Y-%m-%d %H:%M:%S", localtime($epoch);
|
|
}
|
|
else {
|
|
$date_time = POSIX::strftime "%Y-%m-%d %H:%M:%S", localtime();
|
|
}
|
|
}
|
|
$date_time =~ s/\s+$//;
|
|
# print "2: $date_time\n";
|
|
return $date_time;
|
|
}
|
|
|
|
## Location Data ##
|
|
sub location_data {
|
|
eval $start if $b_log;
|
|
my $location = $_[0];
|
|
if ($show{'weather-location'}){
|
|
my $location_string;
|
|
$location_string = $show{'weather-location'};
|
|
$location_string =~ s/\+/ /g;
|
|
if ($location_string =~ /,/){
|
|
my @temp = split(',', $location_string);
|
|
my $sep = '';
|
|
my $string = '';
|
|
foreach (@temp){
|
|
$_ = ucfirst($_);
|
|
$string .= $sep . $_;
|
|
$sep = ', ';
|
|
}
|
|
$location_string = $string;
|
|
}
|
|
$location_string = main::filter($location_string);
|
|
@$location = ($show{'weather-location'},$location_string,'');
|
|
}
|
|
else {
|
|
get_location($location);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_location {
|
|
eval $start if $b_log;
|
|
my $location = $_[0];
|
|
my ($city,$country,$freshness,%loc,$loc_arg,$loc_string,@loc_data,$state);
|
|
my $now = POSIX::strftime "%Y%m%d%H%M", localtime;
|
|
my $file_cached = "$user_data_dir/location-main.txt";
|
|
if (-r $file_cached){
|
|
@loc_data = main::reader($file_cached);
|
|
$freshness = (split(/\^\^/, $loc_data[0]))[1];
|
|
}
|
|
if (!$freshness || $freshness < $now - 90){
|
|
my $temp;
|
|
my $url = "http://geoip.ubuntu.com/lookup";
|
|
# {
|
|
# local $/;
|
|
# my $file = "$fake_data_dir/weather/location-1.xml";
|
|
# open(my $fh, '<', $file) or die "can't open $file: $!";
|
|
# $temp = <$fh>;
|
|
# }
|
|
$temp = main::download_file('stdout',$url);
|
|
@loc_data = split('\n', $temp);
|
|
@loc_data = map {
|
|
s/<\?.*<Response>//;
|
|
s/<\/[^>]+>/\n/g;
|
|
s/>/^^/g;
|
|
s/<//g;
|
|
$_;
|
|
} @loc_data;
|
|
@loc_data = split('\n', $loc_data[0]);
|
|
unshift(@loc_data, "timestamp^^$now");
|
|
main::writer($file_cached,\@loc_data);
|
|
# 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'){
|
|
$loc{'country3'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'CountryCode'){
|
|
$loc{'country'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'CountryName'){
|
|
$loc{'country2'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'RegionCode'){
|
|
$loc{'region-id'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'RegionName'){
|
|
$loc{'region'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'City'){
|
|
$loc{'city'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'ZipPostalCode'){
|
|
$loc{'zip'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'Latitude'){
|
|
$loc{'lat'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'Longitude'){
|
|
$loc{'long'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'TimeZone'){
|
|
$loc{'tz'} = $working[1];
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \%loc;
|
|
# assign location, cascade from most accurate
|
|
# latitude,longitude first
|
|
if ($loc{'lat'} && $loc{'long'}){
|
|
$loc_arg = "$loc{'lat'},$loc{'long'}";
|
|
}
|
|
# city,state next
|
|
elsif ($loc{'city'} && $loc{'region-id'}){
|
|
$loc_arg = "$loc{'city'},$loc{'region-id'}";
|
|
}
|
|
# postal code last, that can be a very large region
|
|
elsif ($loc{'zip'}){
|
|
$loc_arg = $loc{'zip'};
|
|
}
|
|
$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::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;
|
|
}
|
|
|
|
sub complete_location {
|
|
eval $start if $b_log;
|
|
my ($location,$city,$state,$country) = @_;
|
|
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;
|
|
}
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### ITEM UTILITIES
|
|
#### -------------------------------------------------------------------
|
|
|
|
# android only, for distro / OS id and machine data
|
|
sub set_build_prop {
|
|
eval $start if $b_log;
|
|
my $path = '/system/build.prop';
|
|
$loaded{'build-prop'} = 1;
|
|
return if ! -r $path;
|
|
my @data = reader($path,'strip');
|
|
foreach (@data){
|
|
my @working = split('=', $_);
|
|
next if $working[0] !~ /^ro\.(build|product)/;
|
|
if ($working[0] eq 'ro.build.date.utc'){
|
|
$build_prop{'build-date'} = strftime "%F", gmtime($working[1]);
|
|
}
|
|
# ldgacy, replaced by ro.product.device
|
|
elsif ($working[0] eq 'ro.build.product'){
|
|
$build_prop{'build-product'} = $working[1];
|
|
}
|
|
# this can be brand, company, android, it varies, but we don't want android value
|
|
elsif ($working[0] eq 'ro.build.user'){
|
|
$build_prop{'build-user'} = $working[1] if $working[1] !~ /android/i;
|
|
}
|
|
elsif ($working[0] eq 'ro.build.version.release'){
|
|
$build_prop{'build-version'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'ro.product.board'){
|
|
$build_prop{'product-board'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'ro.product.brand'){
|
|
$build_prop{'product-brand'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'ro.product.device'){
|
|
$build_prop{'product-device'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'ro.product.manufacturer'){
|
|
$build_prop{'product-manufacturer'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'ro.product.model'){
|
|
$build_prop{'product-model'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'ro.product.name'){
|
|
$build_prop{'product-name'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'ro.product.screensize'){
|
|
$build_prop{'product-screensize'} = $working[1];
|
|
}
|
|
}
|
|
log_data('dump','%build_prop',\%build_prop) if $b_log;
|
|
print Dumper \%build_prop if $dbg[20];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## CompilerVersion
|
|
{
|
|
package CompilerVersion;
|
|
|
|
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] =~ /.*(gcc|clang)\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] = 'clang';
|
|
$compiler->[1] =main::program_version($path,'clang',3,'--version');
|
|
}
|
|
}
|
|
}
|
|
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';
|
|
}
|
|
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);
|
|
}
|
|
}
|
|
main::log_data('dump','@$compiler',$compiler) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
}
|
|
|
|
sub set_dboot_data {
|
|
eval $start if $b_log;
|
|
$loaded{'dboot'} = 1;
|
|
my ($file,@db_data,@dm_data,@temp);
|
|
my ($counter) = (0);
|
|
if (!$fake{'dboot'}){
|
|
$file = $system_files{'dmesg-boot'};
|
|
}
|
|
else {
|
|
# $file = "$fake_data_dir/bsd/dmesg-boot/bsd-disks-diabolus.txt";
|
|
# $file = "$fake_data_dir/bsd/dmesg-boot/freebsd-disks-solestar.txt";
|
|
# $file = "$fake_data_dir/bsd/dmesg-boot/freebsd-enceladus-1.txt";
|
|
## matches: toshiba: openbsd-5.6-sysctl-2.txt
|
|
# $file = "$fake_data_dir/bsd/dmesg-boot/openbsd-5.6-dmesg.boot-1.txt";
|
|
## matches: compaq: openbsd-5.6-sysctl-1.txt"
|
|
# $file = "$fake_data_dir/bsd/dmesg-boot/openbsd-dmesg.boot-1.txt";
|
|
# $file = "$fake_data_dir/bsd/dmesg-boot/openbsd-6.8-battery-sensors-1.txt";
|
|
}
|
|
if ($file){
|
|
return if ! -r $file;
|
|
@db_data = reader($file);
|
|
# sometimes > 1 sessions stored, dump old ones
|
|
for (@db_data){
|
|
if (/^(Dragonfly|OpenBSD|NetBSD|FreeBSD is a registered trademark|Copyright.*Midnight)/){
|
|
$counter++;
|
|
undef @temp if $counter > 1;
|
|
}
|
|
push(@temp,$_);
|
|
}
|
|
@db_data = @temp;
|
|
undef @temp;
|
|
my @dm_data = grabber('dmesg 2>/dev/null');
|
|
# clear out for netbsd, only 1 space following or lines won't match
|
|
@dm_data = map {$_ =~ s/^\[[^\]]+\]\s//;$_} @dm_data;
|
|
$counter = 0;
|
|
# dump previous sessions, and also everything roughly before dmesg.boot
|
|
# ends, it does't need to be perfect, we just only want the actual post
|
|
# boot data
|
|
for (@dm_data){
|
|
if (/^(Dragonfly|OpenBSD|NetBSD|FreeBSD is a registered trademark|Copyright.*Midnight)/ ||
|
|
/^(smbus[0-9]:|Security policy loaded|root on)/){
|
|
$counter++;
|
|
undef @temp if $counter > 1;
|
|
}
|
|
push(@temp,$_);
|
|
}
|
|
@dm_data = @temp;
|
|
undef @temp;
|
|
push(@db_data,'~~~~~',@dm_data);
|
|
# uniq(\@db_data); # get rid of duplicate lines
|
|
# some dmesg repeats, so we need to dump the second and > iterations
|
|
# replace all indented items with ~ so we can id them easily while
|
|
# processing note that if user, may get error of read permissions
|
|
# for some weird reason, real mem and avail mem are use a '=' separator,
|
|
# who knows why, the others are ':'
|
|
foreach (@db_data){
|
|
$_ =~ s/\s*=\s*|:\s*/:/;
|
|
$_ =~ s/\"//g;
|
|
$_ =~ s/^\s+/~/;
|
|
$_ =~ s/\s\s/ /g;
|
|
$_ =~ s/^(\S+)\sat\s/$1:at /; # ada0 at ahcich0
|
|
push(@{$dboot{'main'}}, $_);
|
|
if ($use{'bsd-battery'} && /^acpi(bat|cmb)/){
|
|
push(@{$sysctl{'battery'}}, $_);
|
|
}
|
|
# ~Debug Features 0:<2 CTX BKPTs,4 Watchpoints,6 Breakpoints,PMUv3,Debugv8>
|
|
elsif ($use{'bsd-cpu'} &&
|
|
(!/^~(Debug|Memory)/ && /(^cpu[0-9]+:|Features|^~*Origin:\s*)/)){
|
|
push(@{$dboot{'cpu'}}, $_);
|
|
}
|
|
# FreeBSD: 'da*' is a USB device 'ada*' is a SATA device 'mmcsd*' is an SD card
|
|
# OpenBSD: 'sd' is usb device, 'wd' normal drive. OpenBSD uses sd for nvme drives
|
|
# but also has the nvme data:
|
|
# nvme1 at pci6 dev 0 function 0 vendor "Phison", unknown product 0x5012 rev 0x01: msix, NVMe 1.3
|
|
# nvme1: OWC Aura P12 1.0TB, firmware ECFM22.6, serial 2003100010208
|
|
# scsibus2 at nvme1: 2 targets, initiator 0
|
|
# sd1 at scsibus2 targ 1 lun 0: <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];
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## 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,@data,@xprop);
|
|
my $desktop = [];
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
set_desktop_values();
|
|
main::set_ps_gui() if !$loaded{'ps-gui'};
|
|
get_kde_trinity_data();
|
|
if (!@$desktop){
|
|
get_env_de_data();
|
|
}
|
|
if (!@$desktop){
|
|
get_env_xprop_gnome_based_data();
|
|
}
|
|
if (!@$desktop){
|
|
get_env_xfce_data();
|
|
}
|
|
if (!@$desktop){
|
|
get_env_xprop_misc_data();
|
|
}
|
|
if (!@$desktop){
|
|
get_ps_de_data();
|
|
}
|
|
if ($extra > 2 && @$desktop){
|
|
set_info_data();
|
|
}
|
|
if ($b_display && !$force{'display'} && $extra > 1){
|
|
get_wm();
|
|
}
|
|
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) = ();
|
|
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*//i;
|
|
return $_[0];
|
|
}
|
|
|
|
sub get_kde_trinity_data {
|
|
eval $start if $b_log;
|
|
my ($kded,$kded_name,$program,@version_data,@version_data2);
|
|
my $kde_full_session = ($ENV{'KDE_FULL_SESSION'}) ? $ENV{'KDE_FULL_SESSION'} : '';
|
|
# we can't rely on 3 using kded3, it could be kded
|
|
if ($kde_full_session && ($program = main::check_program('kded' . $kde_full_session))){
|
|
$kded = $program;
|
|
$kded_name = 'kded' . $kde_full_session;
|
|
}
|
|
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 && (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 ($desktop_session eq 'kde-plasma' || $xdg_desktop eq 'kde' ||
|
|
$kde_session_version){
|
|
if ($kde_session_version && $kde_session_version <= 4){
|
|
@data = ($kded_name) ? main::program_values($kded_name) : ();
|
|
if (@data){
|
|
$desktop->[0] = $data[3];
|
|
$desktop->[1] = main::program_version($kded,$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] && $kded){
|
|
@version_data = main::grabber("$kded --version 2>/dev/null");
|
|
}
|
|
}
|
|
$desktop->[0] = 'KDE' if !$desktop->[0];
|
|
}
|
|
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("kf-config"))){
|
|
@version_data = main::grabber("$program --version 2>/dev/null");
|
|
}
|
|
# hope we don't use this fallback, not the same version as kde always
|
|
if (!@version_data && $kded){
|
|
@version_data = main::grabber("$kded --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::message('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';
|
|
}
|
|
}
|
|
# KDE_FULL_SESSION property is only available since KDE 3.5.5.
|
|
elsif ($kde_full_session eq 'true'){
|
|
@version_data = ($kded) ? 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;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_env_de_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,'leftwm','leftwm',0,0],
|
|
[1,'pantheon','pantheon',0,0],
|
|
[1,'penrose','penrose',0,0],# unknown, just guessing
|
|
[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;
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_env_xprop_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';
|
|
# 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' || ($b_xprop &&
|
|
(main::check_program('muffin') || main::check_program('cinnamon-session')) &&
|
|
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'))){
|
|
# 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];
|
|
}
|
|
}
|
|
# 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';
|
|
}
|
|
# 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 (main::check_program('gnome-shell')){
|
|
($desktop->[0],$desktop->[1]) = main::program_data('gnome','gnome-shell');
|
|
}
|
|
$b_gtk = 1;
|
|
$desktop->[0] ||= 'GNOME';
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# Note, GNOME_DESKTOP_SESSION_ID is deprecated so we'll see how that works out
|
|
# https://bugzilla.gnome.org/show_bug.cgi?id=542880.
|
|
# NOTE: manjaro is leaving XDG data null, which forces the manual check for gnome, sigh...
|
|
# some gnome programs can trigger a false xprop gnome ID
|
|
# _GNOME_BACKGROUND_REPRESENTATIVE_COLORS(STRING) = "rgb(23,31,35)"
|
|
sub check_gnome {
|
|
eval $start if $b_log;
|
|
my ($b_gnome,$detection) = (0,'');
|
|
if ($xdg_desktop && $xdg_desktop =~ /gnome/){
|
|
$detection = 'xdg_current_desktop';
|
|
$b_gnome = 1;
|
|
}
|
|
# should work as long as string contains gnome, eg: peppermint:gnome
|
|
# filtered explicitly in set_desktop_values
|
|
elsif ($xdg_desktop && $xdg_desktop !~ /gnome/){
|
|
$detection = 'xdg_current_desktop';
|
|
}
|
|
# possible values: lightdm-xsession, only positive match tests will work
|
|
elsif ($gdmsession && $gdmsession eq 'gnome'){
|
|
$detection = 'gdmsession';
|
|
$b_gnome = 1;
|
|
}
|
|
# risky: Debian: $DESKTOP_SESSION = lightdm-xsession; Manjaro/Arch = xfce
|
|
# note that mate/cinnamon would already have been caught so no need to add
|
|
# explicit tests for them
|
|
elsif ($desktop_session && $desktop_session eq 'gnome'){
|
|
$detection = 'desktop_session';
|
|
$b_gnome = 1;
|
|
}
|
|
# possible value: this-is-deprecated, but I believe only gnome based desktops
|
|
# set this variable, so it doesn't matter what it contains
|
|
elsif ($ENV{'GNOME_DESKTOP_SESSION_ID'}){
|
|
$detection = 'gnome_destkop_session_id';
|
|
$b_gnome = 1;
|
|
}
|
|
# maybe use ^_gnome_session instead? try it for a while
|
|
elsif ($b_xprop && main::check_program('gnome-shell') &&
|
|
main::awk(\@xprop,'^_gnome_session')){
|
|
$detection = 'xprop-root';
|
|
$b_gnome = 1;
|
|
}
|
|
main::log_data('data','$detection:$b_gnome>>' . $detection . ":$b_gnome") if $b_log;
|
|
eval $end if $b_log;
|
|
return $b_gnome;
|
|
}
|
|
|
|
# Not strictly dependent on xprop data, which is not necessarily always present
|
|
sub get_env_xfce_data {
|
|
eval $start if $b_log;
|
|
my (@version_data);
|
|
# print join("\n", @xprop), "\n";
|
|
# String: "This is xfdesktop version 4.2.12"
|
|
# alternate: xfce4-about --version > xfce4-about 4.10.0 (Xfce 4.10)
|
|
# note: some distros/wm (e.g. bunsen) set $xdg_desktop to xfce to solve some
|
|
# other issues so but are OpenBox. Not inxi issue.
|
|
# $xdg_desktop can be /usr/bin/startxfce4
|
|
# print "xdg_d: $xdg_desktop gdms: $gdmsession\n";
|
|
if ($xdg_desktop eq 'xfce' || $gdmsession eq 'xfce' ||
|
|
($b_xprop && main::check_program('xfdesktop')) &&
|
|
main::awk(\@xprop,'^(xfdesktop|xfce)')){
|
|
@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]){
|
|
my $version = '4'; # just assume it's 4, we tried
|
|
if (main::check_program('xfce4-panel')){
|
|
$version = '4';
|
|
}
|
|
# talk to xfce to see what id they will be using for xfce 5
|
|
elsif (main::check_program('xfce5-panel')){
|
|
$version = '5';
|
|
}
|
|
# they might get rid of number, we'll see
|
|
elsif (main::check_program('xfce-panel')){
|
|
$version = '';
|
|
}
|
|
@data = main::program_values("xfce${version}-panel");
|
|
# print Data::Dumper::Dumper \@data;
|
|
# 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] ||= '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];
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# These require data from xprop, at least partially
|
|
sub get_env_xprop_misc_data {
|
|
eval $start if $b_log;
|
|
# print join("\n", @xprop), "\n";
|
|
if ($xdg_desktop eq 'moksha' || $gdmsession eq 'moksha' || ($b_xprop &&
|
|
(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';
|
|
if ($b_xprop){
|
|
$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' ||
|
|
($b_xprop && 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';
|
|
if ($b_xprop){
|
|
$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.
|
|
# I believe all these will be X only wm, so xprop tests fine here.
|
|
if ($b_xprop && !$desktop->[0]){
|
|
# 0 check program; 1 xprop search; 2: data; 3 - optional: ps_gui search
|
|
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'],
|
|
);
|
|
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]);
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
# need to check starts line because it's so short
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_ps_de_data {
|
|
eval $start if $b_log;
|
|
my ($program,@version_data);
|
|
main::set_ps_gui() if !$loaded{'ps-gui'};
|
|
if (@ps_gui){
|
|
# 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
|
|
# in this list.
|
|
# unverfied: 2bwm catwm mcwm penrose snapwm uwm wmfs wmfs2 wingo wmii2
|
|
# xfdesktoo is fallback in case not in xprop
|
|
my @wms = qw(icewm 2bwm 9wm aewm aewm\+\+ afterstep amiwm antiwm awesome
|
|
blackbox bspwm calmwm catwm cde ctwm dwm echinus evilwm fluxbox fvwm
|
|
hackedbox herbstluftwm instantwm i3 ion3 jbwm jwm larswm leftwm lwm
|
|
matchbox-window-manager mcwm mini musca mvwm mwm nawm notion nscde
|
|
openbox pekwm penrose qvwm ratpoison
|
|
sawfish scrotwm snapwm spectrwm tinywm tvtwm twm uwm
|
|
windowlab wmfs wmfs2 wingo wmii2 wmii wmx xmonad yeahwm);
|
|
my $matches = join('|',@wms) . $wl_compositors;
|
|
# note: use my $psg to avoid bizarre return from program_data to ps_gui write
|
|
foreach my $psg (@ps_gui){
|
|
# no need to use check program with short list of ps_gui
|
|
if ($psg =~ /^($matches)$/){
|
|
my $item = $1;
|
|
($desktop->[0],$desktop->[1]) = main::program_data($item);
|
|
if ($extra > 1 && $item eq 'xfdesktop'){
|
|
($desktop->[2],$desktop->[3]) = main::program_data('xfdesktop-toolkit',$item,1);
|
|
}
|
|
last;
|
|
}
|
|
}
|
|
if (!$desktop->[0]){
|
|
# order matters, these have alternate search patterns from default name
|
|
# 1 check program; 2 ps_gui search; 3 data; 4: trigger alternate values/version
|
|
@wms =(
|
|
['WindowMaker','WindowMaker','wmaker',''],
|
|
['clfswm','.*(sh|c?lisp)?.*clfswm','clfswm',''],
|
|
['cwm','(openbsd-)?cwm','cwm',''],
|
|
['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',''],
|
|
['qtile','.*(python.*)?qtile','qtile',''],
|
|
['stumpwm','(sh|c?lisp)?.*stumpwm','stumpwm',''],
|
|
);
|
|
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);
|
|
}
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# NOTE: used to use a super slow method here, but gtk-launch returns
|
|
# the gtk version I believe
|
|
sub set_gtk_data {
|
|
eval $start if $b_log;
|
|
if (main::check_program('gtk-launch')){
|
|
($desktop->[2],$desktop->[3]) = main::program_data('gtk-launch');
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_qt_data {
|
|
eval $start if $b_log;
|
|
my ($program,@data,@version_data);
|
|
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 = '';}
|
|
}
|
|
# 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] && main::check_program('qtdiag')){
|
|
($desktop->[2],$desktop->[3]) = main::program_data('qtdiag');
|
|
}
|
|
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;
|
|
}
|
|
# 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;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_wm {
|
|
eval $start if $b_log;
|
|
if (!$force{'wmctrl'}){
|
|
get_wm_main();
|
|
}
|
|
# note, some wm, like cinnamon muffin, do not appear in ps aux, but do in wmctrl
|
|
if ((!$desktop->[5] || $force{'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|kwinft|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 (!$desktop->[5]){
|
|
main::set_ps_gui() if !$loaded{'ps-gui'};
|
|
# order matters, see above logic
|
|
# due to lisp/python starters, clfswm/stumpwm/qtile will not detect here
|
|
my @wms = qw(2bwm 9wm aewm aewm\+\+ afterstep amiwm antiwm awesome blackbox
|
|
calmwm catwm clfswm compiz ctwm (openbsd-)?cwm fluxbox bspwm budgie-wm
|
|
deepin-wm dwm echinus evilwm flwm fvwm-crystal fvwm1 fvwm2 fvwm3 fvwm95
|
|
fvwm gala gnome-shell hackedbox i3 instantwm ion3 jbwm jwm twin kwin_wayland
|
|
kwin_x11 kwinft kwin larswm leftwm lwm matchbox-window-manager marco mcwm mini
|
|
muffin musca deepin-mutter mutter deepin-metacity metacity mvwm mwm
|
|
nawm notion openbox qtile qvwm penrose ratpoison sawfish scrotwm snapwm
|
|
spectrwm stumpwm tinywm tvtwm twm ukwm windowlab WindowMaker wingo wmfs2?
|
|
wmii2? wmx xfwm[45]? xmonad yeahwm);
|
|
my $wms = join('|',@wms) . $wl_compositors;
|
|
foreach my $psg (@ps_gui){
|
|
if ($psg =~ /^($wms)$/){
|
|
$working = $1;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
get_wm_version('manual',$working) if $working;
|
|
$desktop->[5] = $working if !$desktop->[5] && $working;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_wm_wmctrl {
|
|
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]){
|
|
# variants: gnome shell;
|
|
# IceWM 1.3.8 (Linux 3.2.0-4-amd64/i686) ; Metacity (Marco) ; Xfwm4
|
|
$desktop->[5] =~ s/\d+\.\d\S+|[\[\(].*\d+\.\d.*[\)\]]//g;
|
|
$desktop->[5] = main::trimmer($desktop->[5]);
|
|
# change Metacity (Marco) to marco
|
|
if ($desktop->[5] =~ /marco/i){$desktop->[5] = 'marco'}
|
|
elsif ($desktop->[5] =~ /muffin/i){$desktop->[5] = 'muffin'}
|
|
elsif (lc($desktop->[5]) eq 'gnome shell'){$desktop->[5] = 'gnome-shell'}
|
|
elsif ($desktop_session eq 'trinity' && lc($desktop->[5]) eq 'kwin'){$desktop->[5] = 'Twin'}
|
|
get_wm_version('wmctrl',$desktop->[5]);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_wm_version {
|
|
eval $start if $b_log;
|
|
my ($type,$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));
|
|
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);
|
|
return if !$data[0];
|
|
# print Data::Dumper::Dumper \@data;
|
|
$desktop->[5] = $data[0] if $type eq 'manual';
|
|
$desktop->[6] = $data[1] if $data[1];
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_info_data {
|
|
eval $start if $b_log;
|
|
main::set_ps_gui() if !$loaded{'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|';
|
|
$pattern .= 'i3bar|i3status|i3-status-rs|icewmtray|';
|
|
$pattern .= 'kdocker|kicker|';
|
|
$pattern .= 'latte|latte-dock|lemonbar|ltpanel|luastatus|lxpanel|lxqt-panel|';
|
|
$pattern .= 'matchbox-panel|mate-panel|nwg-bar|nwg-dock|nwg-panel|ourico|';
|
|
$pattern .= 'perlpanel|plank|plasma-desktop|plasma-netbook|polybar|pypanel|';
|
|
$pattern .= 'razor-panel|razorqt-panel|rootbar|sfwbar|stalonetray|swaybar|';
|
|
$pattern .= 'taskbar|tint2|trayer|';
|
|
$pattern .= 'ukui-panel|vala-panel|wapanel|waybar|wbar|wharf|wingpanel|witray|';
|
|
$pattern .= 'xfce4-panel|xfce5-panel|xmobar|yabar|yambar';
|
|
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 (@info){
|
|
main::uniq(\@info);
|
|
$desktop->[4] = join(', ', @info);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_xprop {
|
|
eval $start if $b_log;
|
|
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
|
|
# 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;
|
|
}
|
|
}
|
|
# print "@xprop\n";
|
|
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;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $temp;
|
|
}
|
|
|
|
## DiskDataBSD
|
|
# handles disks and partition extra data for disks bsd, raid-zfs,
|
|
# partitions, swap, unmounted
|
|
# glabel: partID, logical/physical-block-size, uuid, label, size
|
|
# disklabel: partID, block-size, fs, size
|
|
{
|
|
package DiskDataBSD;
|
|
|
|
# Sets initial pure dboot data, and fills it in with
|
|
# disklabel/gpart partition and advanced data
|
|
sub set {
|
|
eval $start if $b_log;
|
|
$loaded{'disk-data-bsd'} = 1;
|
|
set_dboot_disks();
|
|
if ($use{'bsd-partition'}){
|
|
if ($alerts{'gpart'}->{'action'} eq 'use'){
|
|
set_gpart_data();
|
|
}
|
|
elsif ($alerts{'disklabel'}->{'action'} eq 'use'){
|
|
set_disklabel_data();
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my $id = $_[0];
|
|
return if !$id || !%disks_bsd;
|
|
$id =~ s|^/dev/||;
|
|
my $data = {};
|
|
# this handles mainly zfs, which can be either disk or part
|
|
if ($disks_bsd{$id}){
|
|
$data = $disks_bsd{$id};
|
|
delete $data->{'partitions'} if $data->{'partitions'};
|
|
}
|
|
else {
|
|
OUTER: foreach my $key (keys %disks_bsd){
|
|
if ($disks_bsd{$key}->{'partitions'}){
|
|
foreach my $part (keys %{$disks_bsd{$key}->{'partitions'}}){
|
|
if ($part eq $id){
|
|
$data = $disks_bsd{$key}->{'partitions'}{$part};
|
|
last OUTER;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $data;
|
|
}
|
|
|
|
sub set_dboot_disks {
|
|
eval $start if $b_log;
|
|
my ($working,@temp);
|
|
foreach my $id (sort keys %{$dboot{'disk'}}){
|
|
next if !@{$dboot{'disk'}->{$id}};
|
|
foreach (@{$dboot{'disk'}->{$id}}){
|
|
my @row = split(/:\s*/, $_);
|
|
next if !$row[0];
|
|
# no dots, note: ada2: 2861588MB BUT: ada2: 600.000MB/s
|
|
# print "$_ i: $i\n";
|
|
# openbsd/netbsd matches will often work
|
|
if ($row[0] =~ /(^|,\s*)([0-9\.]+\s*[MGTPE])i?B?[,.\s]+([0-9]+)\ssectors$|^</){
|
|
$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;
|
|
}
|
|
}
|
|
|
|
sub get_display_manager {
|
|
eval $start if $b_log;
|
|
my (@data,@glob,$link,$path,@temp);
|
|
my $found = [];
|
|
# ldm - LTSP display manager. Note that sddm does not appear to have a .pid
|
|
# extension in Arch. Guessing on cdm, qingy. pcdm uses vt, PCDM-vt9.pid
|
|
# Not verified: qingy emptty; greetd.run verified, but alternate:
|
|
# greetd-684.sock if no .run seen. Add Ly in case they add run file/directory.
|
|
# greetd frontends: agreety dlm gtkgreet qtgreet tuigreet wlgreet
|
|
# mlogin may be mlogind, not verified
|
|
my @dms = qw(brzdm cdm clogin emptty entranced gdm gdm3 greetd kdm kdm3 kdmctl
|
|
ldm lightdm lxdm ly mdm mlogin nodm pcdm qingy sddm slim slimski tbsm tdm
|
|
udm wdm xdm xdmctl xenodm xlogin);
|
|
# these are the only one I know of so far that have version info. xlogin /
|
|
# clogin do, -V, brzdm -v, but syntax not verified.
|
|
my @dms_version = qw(gdm gdm3 lightdm ly slim);
|
|
my $pattern = '';
|
|
if (-d '/run'){
|
|
$pattern .= '/run';
|
|
}
|
|
# in most linux, /var/run is a sym link to /run, so no need to check it twice
|
|
if (-d '/var/run' && ! -l '/var/run'){
|
|
$pattern .= ',' if $pattern;
|
|
$pattern .= '/var/run';
|
|
}
|
|
if (-d '/var/run/rc.d'){
|
|
$pattern .= ',' if $pattern;
|
|
$pattern .= '/var/run/rc.d';
|
|
}
|
|
if ($pattern){
|
|
$pattern = '{' . $pattern . '/*}' if $pattern;
|
|
# for dm.pid type file or dm directory names, like greetd-684.sock
|
|
@glob = globber($pattern) if $pattern;
|
|
}
|
|
# 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 = grep {/\/($search)\b/} @glob;
|
|
# $search = join('|',@glob);
|
|
if (@glob){
|
|
uniq(\@glob);
|
|
foreach my $item (@glob){
|
|
my @id = grep {$item =~ /\/$_\b/} @dms;
|
|
push(@temp,@id) if @id;
|
|
}
|
|
# note: there were issues with duplicated dm's, using uniq will handle those
|
|
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){
|
|
# do nothing, we just wanted the path
|
|
if ($extra > 2 && (grep {$dm eq $_} @dms_version) &&
|
|
($path = check_program($dm))){}
|
|
else {$path = $dm}
|
|
# print "$path $extra\n";
|
|
@dm_info = ();
|
|
@data = program_data($dm,$path,3);
|
|
$dm_info[0] = $data[0];
|
|
$dm_info[1] = $data[1];
|
|
if (scalar @dms > 1 && (my $temp = ServiceData::get('status',$dm))){
|
|
$dm_info[2] = message('stopped') if $temp && $temp =~ /stopped|disabled/;
|
|
}
|
|
push(@$found,[@dm_info]);
|
|
}
|
|
if (!@$found){
|
|
# ly does not have a run/pid file
|
|
if (grep {$_ eq 'ly'} @ps_gui){
|
|
@data = program_data('ly','ly',3);
|
|
$dm_info[0] = $data[0];
|
|
$dm_info[1] = $data[1];
|
|
$found->[0] = [@dm_info];
|
|
}
|
|
elsif (grep {/startx$/} @ps_gui){
|
|
$found->[0] = ['startx'];
|
|
}
|
|
elsif (grep {$_ eq 'xinit'} @ps_gui){
|
|
$found->[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
|
|
# print Data::Dumper::Dumper \@found;
|
|
log_data('dump','display manager: @$found',$found) if $b_log;
|
|
eval $end if $b_log;
|
|
return $found;
|
|
}
|
|
|
|
## DistroData
|
|
{
|
|
package DistroData;
|
|
my (@distro_files,@osr,@working);
|
|
my ($distro,$distro_file,$distro_id,$system_base) = ('','','','');
|
|
my ($etc_issue,$lc_issue,$os_release) = ('','','/etc/os-release');
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
if ($bsd_type){
|
|
get_bsd_os();
|
|
}
|
|
else {
|
|
get_linux_distro();
|
|
}
|
|
eval $end if $b_log;
|
|
return ($distro,$system_base);
|
|
}
|
|
|
|
sub get_bsd_os {
|
|
eval $start if $b_log;
|
|
# used to parse /System/Library/CoreServices/SystemVersion.plist for Darwin
|
|
# but dumping that since it broke, just using standard BSD uname 0 2 name.
|
|
if (!$distro){
|
|
my $bsd_type_osr = 'dragonfly';
|
|
@osr = main::reader($os_release) if -r $os_release;
|
|
if (@osr && $bsd_type =~ /($bsd_type_osr)/ && (grep {/($bsd_type_osr)/i} @osr)){
|
|
$distro = get_os_release();
|
|
$distro_id = lc($1);
|
|
}
|
|
}
|
|
if (!$distro){
|
|
my $bsd_type_version = 'truenas';
|
|
my ($version_file,$version_info) = ('/etc/version','');
|
|
$version_info = main::reader($version_file,'strip') if -r $version_file;
|
|
if ($version_info && $version_info =~ /($bsd_type_version)/i){
|
|
$distro = $version_info;
|
|
$distro_id = lc($1);
|
|
}
|
|
}
|
|
if (!$distro){
|
|
# seen a case without osx file, or was it permissions?
|
|
# this covers all the other bsds anyway, no problem.
|
|
$distro = "$uname[0] $uname[2]";
|
|
$distro_id = lc($uname[0]);
|
|
}
|
|
if ($distro &&
|
|
(-e '/etc/pkg/GhostBSD.conf' || -e '/usr/local/etc/pkg/repos/GhostBSD.conf') &&
|
|
$distro =~ /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){
|
|
$system_base = $distro;
|
|
$distro = "GhostBSD $version";
|
|
}
|
|
}
|
|
system_base_bsd() if $extra > 0;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_linux_distro {
|
|
# NOTE: increasingly no distro release files are present, so this logic is
|
|
# deprecated, but still works often.
|
|
# order matters!
|
|
my @derived = qw(antix-version aptosid-version bodhibuilder.conf kanotix-version
|
|
knoppix-version pclinuxos-release mandrake-release manjaro-release mx-version
|
|
pardus-release porteus-version q4os_version sabayon-release
|
|
siduction-version sidux-version slax-version slint-version slitaz-release
|
|
solusos-release turbolinux-release zenwalk-version);
|
|
my $derived_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';
|
|
# note, pclinuxos has all these mandrake/mandriva files, careful!
|
|
my $lsb_good_s = 'mandrake-release|mandriva-release|mandrakelinux-release|';
|
|
$lsb_good_s .= 'manjaro-release';
|
|
my $os_release_good_s = 'altlinux-release|arch-release|mageia-release|';
|
|
$os_release_good_s .= '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|guix|mageia|manjaro|oracle|pclinuxos|porteux|';
|
|
$osr_good .= 'raspberry pi os|slint|zorin';
|
|
# Force use of pretty name because that's only location of derived distro name
|
|
my $osr_pretty = 'zinc';
|
|
my ($b_issue,$b_lsb,$b_osr_pretty,$b_skip_issue,$b_skip_osr);
|
|
my ($issue,$lsb_release) = ('/etc/issue','/etc/lsb-release');
|
|
# Note: OpenSuse Tumbleweed 2018-05 has made /etc/issue created by sym link to /run/issue
|
|
# and then made that resulting file 700 permissions, which is obviously a mistake
|
|
$etc_issue = main::reader($issue,'strip',0) if -r $issue;
|
|
# debian issue can end with weird escapes like \n \l
|
|
# antergos: Antergos Linux \r (\l)
|
|
$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;
|
|
$b_skip_issue = 1;
|
|
push(@distro_files, $lsb_release);
|
|
}
|
|
$b_issue = 1 if -f $issue;
|
|
$b_lsb = 1 if -f $lsb_release;
|
|
if (!$b_skip_issue && $etc_issue){
|
|
$lc_issue = lc($etc_issue);
|
|
if ($lc_issue =~ /(antergos|grml|linux lite|openmediavault)/){
|
|
$distro_id = $1;
|
|
$b_skip_issue = 1;
|
|
}
|
|
# This raspbian detection fails for raspberry pi os
|
|
elsif ($lc_issue =~ /(raspbian|peppermint)/){
|
|
$distro_id = $1;
|
|
$distro_file = $os_release if @osr;
|
|
}
|
|
# Note: wrong fix, applies to both raspbian and raspberry pi os
|
|
# assumption here is that r pi os fixes this before stable release
|
|
elsif ($lc_issue =~ /^debian/ && -e '/etc/apt/sources.list.d/raspi.list' &&
|
|
(grep {/[^#]+raspberrypi\.org/} main::reader('/etc/apt/sources.list.d/raspi.list'))){
|
|
$distro_id = 'raspios' ;
|
|
}
|
|
}
|
|
# Note that antergos changed this around # 2018-05, and now lists
|
|
# antergos in os-release, sigh... We want these distros to use os-release
|
|
# if it contains their names. Last check below
|
|
if (@osr){
|
|
if (grep {/($osr_good)/i} @osr){
|
|
$distro_file = $os_release;
|
|
}
|
|
elsif (grep {/($osr_pretty)/i} @osr){
|
|
$b_osr_pretty = 1;
|
|
}
|
|
}
|
|
if (grep {/armbian/} @distro_files){
|
|
$distro_id = 'armbian' ;
|
|
}
|
|
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
|
|
# manjaro should use lsb, which has the full info, arch uses os release
|
|
# antergos should use /etc/issue. We've already checked os-release above
|
|
if ($distro_id eq 'antergos' || (grep {/antergos|chakra|manjaro/} @distro_files)){
|
|
@distro_files = grep {!/arch-release/} @distro_files;
|
|
}
|
|
my $distro_files_s = join('|', @distro_files);
|
|
@working = (@derived,@primary);
|
|
foreach my $file (@working){
|
|
if ("/etc/$file" =~ /($distro_files_s)$/){
|
|
# These is for only those distro's with self named release/version files
|
|
# because Mint does not use such, it must be done as below
|
|
# Force use of os-release file in cases where there might be conflict
|
|
# between lsb-release rules and os-release priorities.
|
|
if (@osr && $file =~ /($os_release_good_s)$/){
|
|
$distro_file = $os_release;
|
|
}
|
|
# Now lets see if the distro file is in the known-good working-lsb-list
|
|
# if so, use lsb-release, if not, then just use the found file
|
|
elsif ($b_lsb && $file =~ /$lsb_good_s/){
|
|
$distro_file = $lsb_release;
|
|
}
|
|
else {
|
|
$distro_file = "/etc/$file";
|
|
}
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
main::log_data('data',"distro_file-2: $distro_file") if $b_log;
|
|
# first test for the legacy antiX distro id file
|
|
if (-r '/etc/antiX'){
|
|
@working = main::reader('/etc/antiX');
|
|
$distro = main::awk(\@working,'antix.*\.iso') if @working;
|
|
$distro = main::clean_characters($distro) if $distro;
|
|
}
|
|
# 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)){
|
|
print "df: $distro_file lf: $lsb_release\n";
|
|
$distro = get_lsb_release($lsb_release);
|
|
}
|
|
elsif ($distro_file && $distro_file eq $os_release){
|
|
$distro = get_os_release($b_osr_pretty);
|
|
$b_skip_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
|
|
# the first line
|
|
if ($distro_file eq '/etc/SuSE-release'){
|
|
# Leaving off extra data since all new suse have it, in os-release, this file has
|
|
# line breaks, like os-release but in case we want it, it's:
|
|
# CODENAME = Mantis | VERSION = 12.2
|
|
# For now, just take first occurrence, which should be the first line, which does
|
|
# not use a variable type format
|
|
@working = main::reader($distro_file);
|
|
$distro = main::awk(\@working,'suse');
|
|
}
|
|
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;
|
|
}
|
|
else {
|
|
$distro = 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" ;
|
|
}
|
|
}
|
|
$distro = main::clean_characters($distro) if $distro;
|
|
}
|
|
# Otherwise try the default debian/ubuntu/distro /etc/issue file
|
|
elsif ($b_issue){
|
|
if (!$distro_id && $lc_issue && $lc_issue =~ /(mint|lmde)/){
|
|
$distro_id = $1;
|
|
$b_skip_issue = 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_skip_issue && @osr){
|
|
$distro = get_os_release($b_osr_pretty);
|
|
$b_skip_osr = 1;
|
|
}
|
|
elsif (!$b_skip_issue && $b_lsb){
|
|
$distro = get_lsb_release();
|
|
}
|
|
elsif ($etc_issue){
|
|
if (-d '/etc/guix' && $lc_issue =~ /^this is the gnu system\./){
|
|
$distro = 'Guix';
|
|
# They didn't use any standard paths or files for os data, sigh, use pm version
|
|
my $version = main::program_version('guix', '^guix', '4','--version',1);
|
|
$distro .= " $version" if $version;
|
|
$b_skip_issue = 1;
|
|
}
|
|
else {
|
|
$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';
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# 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_skip_osr && @osr){
|
|
$distro = get_os_release($b_osr_pretty);
|
|
$b_skip_osr = 1;
|
|
}
|
|
}
|
|
# 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 && $windows{'cygwin'}){
|
|
$distro = $uname[0]; # like so: CYGWIN_NT-10.0-19043
|
|
$b_skip_osr = 1;
|
|
}
|
|
if (!$distro){
|
|
if (!$b_skip_osr && @osr){
|
|
$distro = get_os_release($b_osr_pretty);
|
|
$b_skip_osr = 1;
|
|
}
|
|
elsif ($b_lsb){
|
|
$distro = get_lsb_release();
|
|
}
|
|
}
|
|
# Now some final null tries
|
|
if (!$distro){
|
|
# 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;
|
|
}
|
|
}
|
|
system_base() if $extra > 0;
|
|
# Some last customized changes, double check if possible to verify still valid
|
|
if ($distro){
|
|
if ($distro_id eq 'armbian'){
|
|
$distro =~ s/Debian/Armbian/;
|
|
}
|
|
elsif ($distro_id eq 'raspios'){
|
|
$system_base = $distro;
|
|
# No need to repeat the debian version info if base:
|
|
if ($extra == 0){$distro =~ s/Debian\s*GNU\/Linux/Raspberry Pi OS/;}
|
|
else {$distro = 'Raspberry Pi OS';}
|
|
}
|
|
elsif (-d '/etc/salixtools/' && $distro =~ /Slackware/i){
|
|
$distro =~ s/Slackware/Salix/;
|
|
}
|
|
}
|
|
else {
|
|
# android fallback, sometimes requires root, sometimes doesn't
|
|
android_info() if $b_android;
|
|
}
|
|
## Finally, if all else has failed, give up
|
|
$distro ||= 'unknown';
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub android_info {
|
|
eval $start if $b_log;
|
|
main::set_build_prop() if !$loaded{'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'} . ')';
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub system_base_bsd {
|
|
eval $start if $b_log;
|
|
# ghostbsd is handled in main bsd section
|
|
if (lc($uname[1]) eq 'nomadbsd' && $distro_id eq 'freebsd'){
|
|
$system_base = $distro;
|
|
$distro = $uname[1];
|
|
}
|
|
elsif (-f '/etc/pkg/HardenedBSD.conf' && $distro_id eq 'freebsd'){
|
|
$system_base = $distro;
|
|
$distro = 'HardenedBSD';
|
|
}
|
|
elsif ($distro_id =~ /^(truenas)$/){
|
|
$system_base = "$uname[0] $uname[2]";
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub system_base {
|
|
eval $start if $b_log;
|
|
# 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';
|
|
# 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';
|
|
# osr has distro name but has fedora centos redhat ID_LIKE and VERSION_ID same
|
|
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|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);
|
|
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) = ();
|
|
}
|
|
}
|
|
elsif (-r $base_upstream_lsb){
|
|
$system_base = get_lsb_release($base_upstream_lsb);
|
|
}
|
|
# probably no need for these @osr greps, just grep $distro instead?
|
|
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_arch,ubuntu tests. For steamos, use fallback arch
|
|
elsif (grep {/($base_osr_debian_version)/i} @osr){
|
|
$system_base = debian_id();
|
|
}
|
|
elsif (grep {/($base_osr_redhat)/i} @osr){
|
|
$base_type = 'rhel';
|
|
}
|
|
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_file_debian_version)/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_distro_arch)/i){
|
|
$system_base = 'Arch Linux';
|
|
}
|
|
if (!$system_base && $distro){
|
|
foreach my $key (keys %base_version){
|
|
if (-r $base_version{$key} && $distro =~ /($key)/i){
|
|
$system_base = main::reader($base_version{$key},'strip',0);
|
|
$system_base = main::clean_characters($system_base) if $system_base;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
if (!$system_base && $distro && -d '/etc/salixtools/' && $distro =~ /Slackware/i){
|
|
$system_base = $distro;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# Note: corner case when parsing the bodhi distro file
|
|
# args: 0: file name
|
|
sub get_lsb_release {
|
|
eval $start if $b_log;
|
|
my ($lsb_file) = @_;
|
|
$lsb_file ||= '/etc/lsb-release';
|
|
my ($distro_lsb,$id,$release,$codename,$description) = ('','','','','');
|
|
my ($dist_id,$dist_release,$dist_code,$dist_desc) = ('DISTRIB_ID',
|
|
'DISTRIB_RELEASE','DISTRIB_CODENAME','DISTRIB_DESCRIPTION');
|
|
if ($lsb_file eq '/etc/bodhi/info'){
|
|
$id = 'Bodhi Linux';
|
|
# note: No ID field, hard code
|
|
($dist_id,$dist_release,$dist_code,$dist_desc) = ('ID','RELEASE',
|
|
'CODENAME','DESCRIPTION');
|
|
}
|
|
my @content = main::reader($lsb_file);
|
|
main::log_data('dump','@content',\@content) if $b_log;
|
|
@content = map {s/,|\*|\\||\"|[:\47]|^\s+|\s+$|n\/a//ig; $_} @content if @content;
|
|
foreach (@content){
|
|
next if /^\s*$/;
|
|
my @working = split(/\s*=\s*/, $_);
|
|
next if !$working[0];
|
|
if ($working[0] eq $dist_id && $working[1]){
|
|
if ($working[1] =~ /^Manjaro/i){
|
|
$id = 'Manjaro Linux';
|
|
}
|
|
# in the old days, arch used lsb_release
|
|
# elsif ($working[1] =~ /^Arch$/i){
|
|
# $id = 'Arch Linux';
|
|
# }
|
|
else {
|
|
$id = $working[1];
|
|
}
|
|
}
|
|
elsif ($working[0] eq $dist_release && $working[1]){
|
|
$release = $working[1];
|
|
}
|
|
elsif ($working[0] eq $dist_code && $working[1]){
|
|
$codename = $working[1];
|
|
}
|
|
# sometimes some distros cannot do their lsb-release files correctly,
|
|
# so here is one last chance to get it right.
|
|
elsif ($working[0] eq $dist_desc && $working[1]){
|
|
$description = $working[1];
|
|
}
|
|
}
|
|
if (!$id && !$release && !$codename && $description){
|
|
$distro_lsb = $description;
|
|
}
|
|
else {
|
|
# avoid duplicates
|
|
$distro_lsb = $id;
|
|
$distro_lsb .= " $release" if $release && $distro_lsb !~ /$release/;
|
|
# eg: release: 9 codename: mga9
|
|
if ($codename && $distro_lsb !~ /$codename/i &&
|
|
(!$release || $codename !~ /$release/)){
|
|
$distro_lsb .= " $codename";
|
|
}
|
|
$distro_lsb =~ s/^\s+|\s\s+|\s+$//g; # get rid of double and trailing spaces
|
|
}
|
|
eval $end if $b_log;
|
|
return $distro_lsb;
|
|
}
|
|
|
|
sub get_os_release {
|
|
eval $start if $b_log;
|
|
my ($b_osr_pretty,$base_type) = @_;
|
|
my ($base_id,$base_name,$base_version,$distro_osr,$name,$name_lc,$name_pretty,
|
|
$version_codename,$version_name,$version_id) = ('','','','','','','','','','');
|
|
my @content = @osr;
|
|
main::log_data('dump','@content',\@content) if $b_log;
|
|
@content = map {s/\\||\"|[:\47]|^\s+|\s+$|n\/a//ig; $_} @content if @content;
|
|
foreach (@content){
|
|
next if /^\s*$/;
|
|
my @working = split(/\s*=\s*/, $_);
|
|
next if !$working[0];
|
|
if ($working[0] eq 'PRETTY_NAME' && $working[1]){
|
|
$name_pretty = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'NAME' && $working[1]){
|
|
$name = $working[1];
|
|
$name_lc = lc($name);
|
|
}
|
|
elsif ($working[0] eq 'VERSION_CODENAME' && $working[1]){
|
|
$version_codename = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'VERSION' && $working[1]){
|
|
$version_name = $working[1];
|
|
$version_name =~ s/,//g;
|
|
}
|
|
elsif ($working[0] eq 'VERSION_ID' && $working[1]){
|
|
$version_id = $working[1];
|
|
}
|
|
# for mint/zorin, other ubuntu base system base
|
|
if ($base_type){
|
|
if ($working[0] eq 'ID_LIKE' && $working[1]){
|
|
if ($base_type eq 'ubuntu'){
|
|
# feren,popos shows debian, feren ID ubuntu
|
|
$working[1] =~ s/^(debian|ubuntu\sdebian|debian\subuntu)/ubuntu/;
|
|
$base_name = $working[1];
|
|
}
|
|
# oracle ID_LIKE="fedora". Why? who knows.
|
|
if ($base_type eq 'rhel' && $working[1] =~ /rhel|fedora/i){
|
|
$base_name = 'RHEL';
|
|
$base_version = $version_id if $version_id;
|
|
}
|
|
elsif ($base_type eq 'arch' && $working[1] =~ /$base_type/i){
|
|
$base_name = 'Arch Linux';
|
|
}
|
|
else {
|
|
$base_name = ucfirst($working[1]);
|
|
}
|
|
}
|
|
elsif ($base_type eq 'ubuntu' && $working[0] eq 'UBUNTU_CODENAME' && $working[1]){
|
|
$base_version = ucfirst($working[1]);
|
|
}
|
|
elsif ($base_type eq 'debian' && $working[0] eq 'DEBIAN_CODENAME' && $working[1]){
|
|
$base_version = $working[1];
|
|
}
|
|
}
|
|
}
|
|
# NOTE: tumbleweed has pretty name but pretty name does not have version id
|
|
# arco shows only the release name, like kirk, in pretty name. Too many distros
|
|
# are doing pretty name wrong, and just putting in the NAME value there
|
|
if (!$base_type){
|
|
if ((!$b_osr_pretty || !$name_pretty) && $name && $version_name){
|
|
$distro_osr = $name;
|
|
$distro_osr = 'Arco Linux' if $name_lc =~ /^arco/;
|
|
if ($version_id && $version_name !~ /$version_id/){
|
|
$distro_osr .= ' ' . $version_id;
|
|
}
|
|
$distro_osr .= " $version_name";
|
|
}
|
|
elsif ($name_pretty && ($name_pretty !~ /tumbleweed/i && $name_lc ne 'arcolinux')){
|
|
$distro_osr = $name_pretty;
|
|
}
|
|
elsif ($name){
|
|
$distro_osr = $name;
|
|
if ($version_id){
|
|
$distro_osr .= ' ' . $version_id;
|
|
}
|
|
}
|
|
if ($version_codename && $distro_osr !~ /$version_codename/i){
|
|
$distro_osr .= " $version_codename";
|
|
}
|
|
}
|
|
# note: mint has varying formats here, some have ubuntu as name, 17 and earlier
|
|
else {
|
|
# incoherent feren use of version, id, etc
|
|
if ($base_type eq 'ubuntu' && !$base_version && $version_codename &&
|
|
$name =~ /feren/i){
|
|
$base_version = ucfirst($version_codename);
|
|
$distro =~ s/ $version_codename//;
|
|
}
|
|
# mint 17 used ubuntu os-release, so won't have $base_version, steamos holo
|
|
if ($base_name && $base_type eq 'rhel'){
|
|
$distro_osr = $base_name;
|
|
$distro_osr .= ' ' . $version_id if $version_id;
|
|
}
|
|
elsif ($base_name && $base_type eq 'arch'){
|
|
$distro_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_osr = "$base_name $base_id$base_version";
|
|
}
|
|
elsif ($base_type eq 'default' && ($name_pretty || ($name && $version_name))){
|
|
$distro_osr = ($name && $version_name) ? "$name $version_name" : $name_pretty;
|
|
}
|
|
# LMDE 2 has only limited data in os-release, no _LIKE values. 3 has like and debian_codename
|
|
elsif ($base_type eq 'ubuntu' && $name_lc =~ /^(debian|ubuntu)/ &&
|
|
($name_pretty || ($name && $version_name))){
|
|
$distro_osr = ($name && $version_name) ? "$name $version_name": $name_pretty;
|
|
}
|
|
elsif ($base_type eq 'debian' && $base_version){
|
|
$distro_osr = debian_id($base_version);
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $distro_osr;
|
|
}
|
|
|
|
# args: 0: optional: debian codename
|
|
sub debian_id {
|
|
eval $start if $b_log;
|
|
my ($codename) = @_;
|
|
my ($debian_version,$id);
|
|
if (-r '/etc/debian_version'){
|
|
$debian_version = main::reader('/etc/debian_version','strip',0);
|
|
}
|
|
$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',
|
|
'14' => 'forky',
|
|
);
|
|
if (main::is_numeric($debian_version)){
|
|
$id .= " $debian_version " . $debians{int($debian_version)};
|
|
}
|
|
elsif ($codename){
|
|
my %by_value = reverse %debians;
|
|
my $version = (main::is_numeric($debian_version)) ? "$debian_version $codename": $debian_version;
|
|
$id .= " $version";
|
|
}
|
|
# like buster/sid
|
|
elsif ($debian_version){
|
|
$id .= " $debian_version";
|
|
}
|
|
eval $end if $b_log;
|
|
return $id;
|
|
}
|
|
|
|
# Note, these are only for matching distro/mint derived names.
|
|
# Update list as new names become available. While first Mint was 2006-08,
|
|
# this method depends on /etc/os-release which was introduced 2012-02.
|
|
# Mint is using UBUNTU_CODENAME without ID data.
|
|
sub ubuntu_id {
|
|
eval $start if $b_log;
|
|
my ($codename) = @_;
|
|
$codename = lc($codename);
|
|
my ($id) = ('');
|
|
# xx.04, xx.10
|
|
my %codenames = (
|
|
# '??' => '25.04',
|
|
# '??' => '24.10',
|
|
'noble' => '24.04 LTS',
|
|
'mantic' => '23.10',
|
|
'lunar' => '23.04',
|
|
'kinetic' => '22.10',
|
|
'jammy' => '22.04 LTS',
|
|
'impish' => '21.10',
|
|
'hirsute' => '21.04',
|
|
'groovy' => '20.10',
|
|
'focal' => '20.04 LTS',
|
|
'eoan' => '19.10',
|
|
'disco' => '19.04',
|
|
'cosmic' => '18.10',
|
|
'bionic' => '18.04 LTS',
|
|
'artful' => '17.10',
|
|
'zesty' => '17.04',
|
|
'yakkety' => '16.10',
|
|
'xenial' => '16.04 LTS',
|
|
'wily' => '15.10',
|
|
'vivid' => '15.04',
|
|
'utopic' => '14.10',
|
|
'trusty' => '14.04 LTS ',
|
|
'saucy' => '13.10',
|
|
'raring' => '13.04',
|
|
'quantal' => '12.10',
|
|
'precise' => '12.04 LTS ',
|
|
# 'natty' => '11.04','oneiric' => '11.10',
|
|
# 'lucid' => '10.04','maverick' => '10.10',
|
|
# 'jaunty' => '9.04','karmic' => '9.10',
|
|
# 'hardy' => '8.04','intrepid' => '8.10',
|
|
# 'feisty' => '7.04','gutsy' => '7.10',
|
|
# 'dapper' => '6.06','edgy' => '6.10',
|
|
# 'hoary' => '5.04','breezy' => '5.10',
|
|
# 'warty' => '4.10', # warty was the first ubuntu release
|
|
);
|
|
$id = $codenames{$codename} if defined $codenames{$codename};
|
|
eval $end if $b_log;
|
|
return $id;
|
|
}
|
|
}
|
|
|
|
## DmidecodeData
|
|
{
|
|
package DmidecodeData;
|
|
|
|
# Note, all actual tests have already been run in check_tools so if we
|
|
# got here, we're good.
|
|
sub set {
|
|
eval $start if $b_log;
|
|
${$_[0]} = 1; # set check boolean by reference
|
|
if ($fake{'dmidecode'} || $alerts{'dmidecode'}->{'action'} eq 'use'){
|
|
generate_data();
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub generate_data {
|
|
eval $start if $b_log;
|
|
my ($content,@data,@working,$type,$handle);
|
|
if ($fake{'dmidecode'}){
|
|
my $file;
|
|
# $file = "$fake_data_dir/dmidecode/pci-freebsd-8.2-2";
|
|
# $file = "$fake_data_dir/dmidecode/dmidecode-loki-1.txt";
|
|
# $file = "$fake_data_dir/dmidecode/dmidecode-t41-1.txt";
|
|
# $file = "$fake_data_dir/dmidecode/dmidecode-mint-20180106.txt";
|
|
# $file = "$fake_data_dir/dmidecode/dmidecode-vmware-ram-1.txt";
|
|
# $file = "$fake_data_dir/dmidecode/dmidecode-tyan-4408.txt";
|
|
# $file = "$fake_data_dir/ram/dmidecode-speed-configured-1.txt";
|
|
# $file = "$fake_data_dir/ram/dmidecode-speed-configured-2.txt";
|
|
# $file = "$fake_data_dir/ram/00srv-dmidecode-mushkin-1.txt";
|
|
# $file = "$fake_data_dir/dmidecode/dmidecode-slots-pcix-pcie-1.txt";
|
|
# $file = "$fake_data_dir/dmidecode/dmidecode-Microknopix-pci-vga-types-5-6-16-17.txt";
|
|
# open(my $fh, '<', $file) or die "can't open $file: $!";
|
|
# chomp(@data = <$fh>);
|
|
}
|
|
else {
|
|
$content = qx($alerts{'dmidecode'}->{'path'} 2>/dev/null);
|
|
@data = split('\n', $content);
|
|
}
|
|
# we don't need the opener lines of dmidecode output
|
|
# but we do want to preserve the indentation. Empty lines
|
|
# won't matter, they will be skipped, so no need to handle them.
|
|
# some dmidecodes do not use empty line separators
|
|
splice(@data, 0, 5) if @data;
|
|
my $j = 0;
|
|
my $b_skip = 1;
|
|
foreach (@data){
|
|
if (!/^Hand/){
|
|
next if $b_skip;
|
|
if (/^[^\s]/){
|
|
$_ = lc($_);
|
|
$_ =~ s/\s(information)//;
|
|
push(@working, $_);
|
|
}
|
|
elsif (/^\t/){
|
|
$_ =~ s/^\t\t/~/;
|
|
$_ =~ s/^\t|\s+$//g;
|
|
push(@working, $_);
|
|
}
|
|
}
|
|
elsif (/^Handle\s(0x[0-9A-Fa-f]+).*DMI\stype\s([0-9]+),.*/){
|
|
$j = scalar @dmi;
|
|
$handle = hex($1);
|
|
$type = $2;
|
|
$use{'slot-tool'} = 1 if $type && $type == 9;
|
|
$b_skip = ($type > 126) ? 1 : 0;
|
|
next if $b_skip;
|
|
# we don't need 32, system boot, or 127, end of table
|
|
if (@working){
|
|
if ($working[0] != 32 && $working[0] < 127){
|
|
$dmi[$j] = (
|
|
[@working],
|
|
);
|
|
}
|
|
}
|
|
@working = ($type,$handle);
|
|
}
|
|
}
|
|
if (@working && $working[0] != 32 && $working[0] != 127){
|
|
$j = scalar @dmi;
|
|
$dmi[$j] = \@working;
|
|
}
|
|
# last by not least, sort it by dmi type, now we don't have to worry
|
|
# about random dmi type ordering in the data, which happens. Also sort
|
|
# by handle, as secondary sort.
|
|
@dmi = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @dmi;
|
|
main::log_data('dump','@dmi',\@dmi) if $b_log;
|
|
print Data::Dumper::Dumper \@dmi if $dbg[2];
|
|
eval $end if $b_log;
|
|
}
|
|
}
|
|
|
|
# args: 0: driver; 1: modules, comma separated, return only modules
|
|
# which do not equal the driver string itself. Sometimes the module
|
|
# name is different from the driver name, even though it's the same thing.
|
|
sub get_driver_modules {
|
|
eval $start if $b_log;
|
|
my ($driver,$modules) = @_;
|
|
return if !$modules;
|
|
my @mods = split(/,\s+/, $modules);
|
|
if ($driver){
|
|
@mods = grep {!/^$driver$/} @mods;
|
|
my $join = (length(join(',', @mods)) > 40) ? ', ' : ',';
|
|
$modules = join($join, @mods);
|
|
}
|
|
log_data('data','$modules',$modules) if $b_log;
|
|
eval $end if $b_log;
|
|
return $modules;
|
|
}
|
|
|
|
# Return all detected gcc versions
|
|
sub get_gcc_data {
|
|
eval $start if $b_log;
|
|
my ($gcc,@data,@temp);
|
|
my $gccs = [];
|
|
# 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-*');
|
|
# usually like gcc-11 but sometimes gcc-11.2.0
|
|
foreach (@temp){
|
|
if (/\/gcc-([0-9.]+)$/){
|
|
push(@$gccs, $1) if !$gcc || $1 ne $gcc;
|
|
}
|
|
}
|
|
}
|
|
unshift(@$gccs, $gcc) if $gcc;
|
|
log_data('dump','@gccs',$gccs) if $b_log;
|
|
eval $end if $b_log;
|
|
return $gccs;
|
|
}
|
|
|
|
## GlabelData - 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 ($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;
|
|
}
|
|
}
|
|
$dev_id ||= $gptid; # no match? return full string
|
|
eval $end if $b_log;
|
|
return $dev_id;
|
|
}
|
|
|
|
sub set {
|
|
eval $start if $b_log;
|
|
$loaded{'glabel'} = 1;
|
|
if (my $path = main::check_program('glabel')){
|
|
@glabel = main::grabber("$path status 2>/dev/null");
|
|
}
|
|
main::log_data('dump','@glabel:with Headers',\@glabel) if $b_log;
|
|
# get rid of first header line
|
|
shift @glabel;
|
|
eval $end if $b_log;
|
|
}
|
|
}
|
|
|
|
sub get_hostname {
|
|
eval $start if $b_log;
|
|
my $hostname = '';
|
|
if ($ENV{'HOSTNAME'}){
|
|
$hostname = $ENV{'HOSTNAME'};
|
|
}
|
|
elsif (!$bsd_type && -r "/proc/sys/kernel/hostname"){
|
|
$hostname = reader('/proc/sys/kernel/hostname','',0);
|
|
}
|
|
# puppy removed this from core modules, sigh
|
|
# this is faster than subshell of hostname
|
|
elsif (check_perl_module('Sys::Hostname')){
|
|
Sys::Hostname->import;
|
|
$hostname = Sys::Hostname::hostname();
|
|
}
|
|
elsif (my $program = check_program('hostname')){
|
|
$hostname = (grabber("$program 2>/dev/null"))[0];
|
|
}
|
|
$hostname ||= 'N/A';
|
|
eval $end if $b_log;
|
|
return $hostname;
|
|
}
|
|
|
|
## InitData
|
|
{
|
|
package InitData;
|
|
my ($init,$init_version,$program) = ('','','');
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my $runlevel = get_runlevel();
|
|
my $default = ($extra > 1) ? get_runlevel_default() : '';
|
|
my ($rc,$rc_version) = ('','');
|
|
my $comm = (-r '/proc/1/comm') ? main::reader('/proc/1/comm','',0) : '';
|
|
# this test is pretty solid, if pid 1 is owned by systemd, it is systemd
|
|
# otherwise that is 'init', which covers the rest of the init systems.
|
|
# more data may be needed for other init systems.
|
|
# Some systemd cases no /proc/1/comm exists however :(
|
|
if (($comm && $comm =~ /systemd/) || -e '/run/systemd/units'){
|
|
$init = 'systemd';
|
|
if ($program = main::check_program('systemd')){
|
|
$init_version = main::program_version($program,'^systemd','2','--version',1);
|
|
}
|
|
if (!$init_version && ($program = main::check_program('systemctl'))){
|
|
$init_version = main::program_version($program,'^systemd','2','--version',1);
|
|
}
|
|
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 = main::program_version('epoch', '^Epoch', '4','version');
|
|
}
|
|
# if they fix dinit to show /proc/1/comm == dinit
|
|
elsif ($comm =~ /^dinit/){
|
|
dinit_data();
|
|
}
|
|
elsif ($comm =~ /finit/){
|
|
$init = 'finit';
|
|
if ($program = main::check_program('finit')){
|
|
$init_version = main::program_version($program,'^Finit','2','-v',1);
|
|
}
|
|
}
|
|
# not verified
|
|
elsif ($comm =~ /^hummingbird/){
|
|
$init = 'Hummingbird';
|
|
# no version data known. Complete if more info found.
|
|
}
|
|
# nosh can map service manager to systemctl, service, rcctl, at least.
|
|
elsif ($comm =~ /^nosh/){
|
|
$init = 'nosh';
|
|
}
|
|
# missing data: note, runit can install as a dependency without being the
|
|
# init system: http://smarden.org/runit/sv.8.html
|
|
# NOTE: the proc test won't work on bsds, so if runit is used on bsds we
|
|
# will need more data
|
|
elsif ($comm =~ /runit/){
|
|
$init = 'runit';
|
|
# no version data as of 2022-10-26
|
|
}
|
|
elsif ($comm =~ /^s6/){
|
|
$init = 's6';
|
|
# no version data as of 2022-10-26
|
|
}
|
|
elsif ($comm =~ /shepherd/){
|
|
$init = 'Shepherd';
|
|
$init_version = main::program_version('shepherd', '^shepherd', '4','--version',1);
|
|
}
|
|
# fallback for some inits that link to /sbin/init
|
|
elsif ($comm eq 'init'){
|
|
# shows /sbin/dinit-init but may change
|
|
if (-e '/sbin/dinit' && readlink('/sbin/init') =~ /dinit/){
|
|
dinit_data();
|
|
}
|
|
elsif (-e '/sbin/openrc-init' && readlink('/sbin/init') =~ /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 (!%risc &&
|
|
($init_version = main::program_version('init', 'upstart', '3','--version'))){
|
|
$init = 'Upstart';
|
|
}
|
|
elsif (main::check_program('launchctl')){
|
|
$init = 'launchd';
|
|
}
|
|
# could be nosh or runit as well for BSDs, not handled yet
|
|
elsif (-f '/etc/inittab'){
|
|
$init = 'SysVinit';
|
|
if (main::check_program('strings')){
|
|
my @data = main::grabber('strings /sbin/init');
|
|
$init_version = main::awk(\@data,'^version\s+[0-9]',2);
|
|
}
|
|
}
|
|
elsif (-f '/etc/ttys'){
|
|
$init = 'init (BSD)';
|
|
}
|
|
}
|
|
if ((grep { /openrc/ } main::globber('/run/*openrc*')) || (grep {/openrc/} @ps_cmd)){
|
|
if (!$init || $init ne 'OpenRC'){
|
|
($rc,$rc_version) = openrc_data();
|
|
}
|
|
if (-r '/run/openrc/softlevel'){
|
|
$runlevel = main::reader('/run/openrc/softlevel','',0);
|
|
}
|
|
elsif (-r '/var/run/openrc/softlevel'){
|
|
$runlevel = main::reader('/var/run/openrc/softlevel','',0);
|
|
}
|
|
elsif ($program = main::check_program('rc-status')){
|
|
$runlevel = (main::grabber("$program -r 2>/dev/null"))[0];
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return {
|
|
'init-type' => $init,
|
|
'init-version' => $init_version,
|
|
'rc-type' => $rc,
|
|
'rc-version' => $rc_version,
|
|
'runlevel' => $runlevel,
|
|
'default' => $default,
|
|
};
|
|
}
|
|
|
|
sub dinit_data {
|
|
eval $start if $b_log;
|
|
$init = 'dinit';
|
|
# Dinit version 0.15.1.
|
|
if ($program = main::check_program('dinit')){
|
|
$init_version = main::program_version($program,'^Dinit','3','--version',1);
|
|
$init_version =~ s/\.$//;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub openrc_data {
|
|
eval $start if $b_log;
|
|
my $version;
|
|
# /sbin/openrc --version == openrc (OpenRC) 0.13
|
|
if ($program = main::check_program('openrc')){
|
|
$version = main::program_version($program, '^openrc', '3','--version');
|
|
}
|
|
# /sbin/rc --version == rc (OpenRC) 0.11.8 (Gentoo Linux)
|
|
elsif ($program = main::check_program('rc')){
|
|
$version = main::program_version($program, '^rc', '3','--version');
|
|
}
|
|
eval $end if $b_log;
|
|
return ('OpenRC',$version);
|
|
}
|
|
|
|
# Check? /var/run/nologin for bsds?
|
|
sub get_runlevel {
|
|
eval $start if $b_log;
|
|
my $runlevel = '';
|
|
if ($program = main::check_program('runlevel')){
|
|
# variants: N 5; 3 5; unknown
|
|
$runlevel = (main::grabber("$program 2>/dev/null"))[0];
|
|
$runlevel = undef if $runlevel && lc($runlevel) eq 'unknown';
|
|
$runlevel =~ s/^(\S\s)?(\d)$/$2/ if $runlevel;
|
|
# print_line($runlevel . ";;");
|
|
}
|
|
eval $end if $b_log;
|
|
return $runlevel;
|
|
}
|
|
|
|
# Note: it appears that at least as of 2014-01-13, /etc/inittab is going
|
|
# to be used for default runlevel in upstart/sysvinit. systemd default is
|
|
# not always set so check to see if it's linked.
|
|
sub get_runlevel_default {
|
|
eval $start if $b_log;
|
|
my @data;
|
|
my $default = '';
|
|
if ($program = main::check_program('systemctl')){
|
|
# note: systemd systems do not necessarily have this link created
|
|
my $systemd = '/etc/systemd/system/default.target';
|
|
# faster to read than run
|
|
if (-e $systemd){
|
|
$default = readlink($systemd);
|
|
$default =~ s/(.*\/|\.target$)//g if $default;
|
|
}
|
|
if (!$default){
|
|
$default = (main::grabber("$program get-default 2>/dev/null"))[0];
|
|
$default =~ s/\.target$// if $default;
|
|
}
|
|
}
|
|
if (!$default){
|
|
# http://askubuntu.com/questions/86483/how-can-i-see-or-change-default-run-level
|
|
# note that technically default can be changed at boot but for inxi purposes
|
|
# that does not matter, we just want to know the system default
|
|
my $upstart = '/etc/init/rc-sysinit.conf';
|
|
my $inittab = '/etc/inittab';
|
|
if (-r $upstart){
|
|
# env DEFAULT_RUNLEVEL=2
|
|
@data = main::reader($upstart);
|
|
$default = main::awk(\@data,'^env\s+DEFAULT_RUNLEVEL',2,'=');
|
|
}
|
|
# handle weird cases where null but inittab exists
|
|
if (!$default && -r $inittab){
|
|
@data = main::reader($inittab);
|
|
$default = main::awk(\@data,'^id.*initdefault',2,':');
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $default;
|
|
}
|
|
}
|
|
|
|
## IpData
|
|
{
|
|
package IpData;
|
|
|
|
sub set {
|
|
eval $start if $b_log;
|
|
if ($force{'ip'} ||
|
|
(!$force{'ifconfig'} && $alerts{'ip'}->{'action'} eq 'use')){
|
|
set_ip_addr();
|
|
}
|
|
elsif ($force{'ifconfig'} || $alerts{'ifconfig'}->{'action'} eq 'use'){
|
|
set_ifconfig();
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_ip_addr {
|
|
eval $start if $b_log;
|
|
my @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')){
|
|
# what happens with future > 64 bit kernels? we'll see in the future!
|
|
if ($bits = (grabber("$program _POSIX_V6_LP64_OFF64 2>/dev/null"))[0]){
|
|
if ($bits =~ /^(-1|undefined)$/i){
|
|
$bits = 32;
|
|
}
|
|
# no docs for true state, 1 is usually true, but probably can be others
|
|
else {
|
|
$bits = 64;
|
|
}
|
|
}
|
|
# returns long bits if we got nothing on first test
|
|
$bits = (grabber("$program LONG_BIT 2>/dev/null"))[0] if !$bits;
|
|
}
|
|
# fallback test
|
|
if (!$bits && $bits_sys){
|
|
$bits = $bits_sys;
|
|
}
|
|
$bits ||= 'N/A';
|
|
eval $end if $b_log;
|
|
return $bits;
|
|
}
|
|
|
|
# arg: 0: $cs_curr, by ref; 1: $cs_avail, by ref.
|
|
sub get_kernel_clocksource {
|
|
eval $start if $b_log;
|
|
if (-r '/sys/devices/system/clocksource/clocksource0/current_clocksource'){
|
|
${$_[0]} = reader('/sys/devices/system/clocksource/clocksource0/current_clocksource','',0);
|
|
if ($b_admin &&
|
|
-r '/sys/devices/system/clocksource/clocksource0/available_clocksource'){
|
|
${$_[1]} = reader('/sys/devices/system/clocksource/clocksource0/available_clocksource','',0);
|
|
if (${$_[0]} && ${$_[1]}){
|
|
my @temp = split(/\s+/,${$_[1]});
|
|
@temp = grep {$_ ne ${$_[0]}} @temp;
|
|
${$_[1]} = join(',', @temp);
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_kernel_data {
|
|
eval $start if $b_log;
|
|
my ($ksplice) = ('');
|
|
my $kernel = [];
|
|
# Linux; yawn; 4.9.0-3.1-liquorix-686-pae; #1 ZEN SMP PREEMPT liquorix 4.9-4 (2017-01-14); i686
|
|
# FreeBSD; siwi.pair.com; 8.2-STABLE; FreeBSD 8.2-STABLE #0: Tue May 31 14:36:14 EDT 2016 erik5@iddhi.pair.com:/usr/obj/usr/src/sys/82PAIRx-AMD64; amd64
|
|
if (@uname){
|
|
$kernel->[0] = $uname[2];
|
|
if ((my $program = check_program('uptrack-uname')) && $kernel->[0]){
|
|
$ksplice = qx($program -rm);
|
|
$ksplice = trimmer($ksplice);
|
|
$kernel->[0] = $ksplice . ' (ksplice)' if $ksplice;
|
|
}
|
|
$kernel->[1] = $uname[-1];
|
|
}
|
|
# we want these to have values to save validation checks for output
|
|
$kernel->[0] ||= 'N/A';
|
|
$kernel->[1] ||= 'N/A';
|
|
log_data('data',"kernel: " . join('; ', $kernel) . " ksplice: $ksplice") if $b_log;
|
|
log_data('dump','perl @uname', \@uname) if $b_log;
|
|
eval $end if $b_log;
|
|
return $kernel;
|
|
}
|
|
|
|
## KernelParameters
|
|
{
|
|
package KernelParameters;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my ($parameters);
|
|
if (my $file = $system_files{'proc-cmdline'}){
|
|
$parameters = parameters_linux($file);
|
|
}
|
|
elsif ($bsd_type){
|
|
$parameters = parameters_bsd();
|
|
}
|
|
eval $end if $b_log;
|
|
return $parameters;
|
|
}
|
|
|
|
sub parameters_linux {
|
|
eval $start if $b_log;
|
|
my ($file) = @_;
|
|
# unrooted android may have file only root readable
|
|
my $line = main::reader($file,'',0) if -r $file;
|
|
$line =~ s/\s\s+/ /g;
|
|
eval $end if $b_log;
|
|
return $line;
|
|
}
|
|
|
|
sub parameters_bsd {
|
|
eval $start if $b_log;
|
|
my ($parameters);
|
|
eval $end if $b_log;
|
|
return $parameters;
|
|
}
|
|
}
|
|
|
|
## LsblkData - set/get
|
|
{
|
|
package LsblkData;
|
|
|
|
# args: 0: partition name
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my $item = $_[0];
|
|
return if !@lsblk;
|
|
my $result;
|
|
foreach my $device (@lsblk){
|
|
if ($device->{'name'} eq $item){
|
|
$result = $device;
|
|
last;
|
|
}
|
|
}
|
|
eval $start if $b_log;
|
|
return ($result) ? $result : {};
|
|
}
|
|
|
|
sub set {
|
|
eval $start if $b_log;
|
|
$loaded{'lsblk'} = 1;
|
|
if ($alerts{'lsblk'} && $alerts{'lsblk'}->{'path'}){
|
|
# check to see if lsblk removes : - separators from accepted input syntax
|
|
my $cmd = $alerts{'lsblk'}->{'path'} . ' -bP --output NAME,TYPE,RM,FSTYPE,';
|
|
$cmd .= 'SIZE,LABEL,UUID,SERIAL,MOUNTPOINT,PHY-SEC,LOG-SEC,PARTFLAGS,';
|
|
$cmd .= 'MAJ:MIN,PKNAME 2>/dev/null';
|
|
print "cmd: $cmd\n" if $dbg[32];
|
|
my @working = main::grabber($cmd);
|
|
print Data::Dumper::Dumper \@working if $dbg[32];
|
|
# note: lsblk 2.37 changeed - and : to _ in the output.
|
|
my $pattern = 'NAME="([^"]*)"\s+TYPE="([^"]*)"\s+RM="([^"]*)"\s+';
|
|
$pattern .= 'FSTYPE="([^"]*)"\s+SIZE="([^"]*)"\s+LABEL="([^"]*)"\s+';
|
|
$pattern .= 'UUID="([^"]*)"\s+SERIAL="([^"]*)"\s+MOUNTPOINT="([^"]*)"\s+';
|
|
$pattern .= 'PHY[_-]SEC="([^"]*)"\s+LOG[_-]SEC="([^"]*)"\s+';
|
|
$pattern .= 'PARTFLAGS="([^"]*)"\s+MAJ[:_-]MIN="([^"]*)"\s+PKNAME="([^"]*)"';
|
|
foreach (@working){
|
|
if (/$pattern/){
|
|
my $size = ($5) ? $5/1024: 0;
|
|
# some versions of lsblk do not return serial, fs, uuid, or label
|
|
push(@lsblk, {
|
|
'name' => $1,
|
|
'type' => $2,
|
|
'rm' => $3,
|
|
'fs' => $4,
|
|
'size' => $size,
|
|
'label' => $6,
|
|
'uuid' => $7,
|
|
'serial' => $8,
|
|
'mount' => $9,
|
|
'block-physical' => $10,
|
|
'block-logical' => $11,
|
|
'partition-flags' => $12,
|
|
'maj-min' => $13,
|
|
'parent' => $14,
|
|
});
|
|
# must be below assignments!! otherwise the result of the match replaces values
|
|
# note: for bcache and luks, the device that has that fs is the parent!!
|
|
if ($show{'logical'}){
|
|
$use{'logical-lvm'} = 1 if !$use{'logical-lvm'} && $2 && $2 eq 'lvm';
|
|
if (!$use{'logical-general'} && (($4 &&
|
|
($4 eq 'crypto_LUKS' || $4 eq 'bcache')) ||
|
|
($2 && ($2 eq 'dm' && $1 =~ /veracrypt/i) || $2 eq 'crypto' ||
|
|
$2 eq 'mpath' || $2 eq 'multipath'))){
|
|
$use{'logical-general'} = 1;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
print Data::Dumper::Dumper \@lsblk if $dbg[32];
|
|
main::log_data('dump','@lsblk',\@lsblk) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
}
|
|
|
|
sub set_mapper {
|
|
eval $start if $b_log;
|
|
$loaded{'mapper'} = 1;
|
|
return if ! -d '/dev/mapper';
|
|
foreach ((globber('/dev/mapper/*'))){
|
|
my ($key,$value) = ($_,Cwd::abs_path("$_"));
|
|
next if !$value;
|
|
$key =~ s|^/.*/||;
|
|
$value =~ s|^/.*/||;
|
|
$mapper{$key} = $value;
|
|
}
|
|
%dmmapper = reverse %mapper if %mapper;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## MemoryData
|
|
{
|
|
package MemoryData;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my ($type) = @_;
|
|
$loaded{'memory'} = 1;
|
|
my ($memory);
|
|
# netbsd 8.0 uses meminfo, but it uses it in a weird way
|
|
if (!$force{'vmstat'} && (!$bsd_type || ($force{'meminfo'} && $bsd_type)) &&
|
|
(my $file = $system_files{'proc-meminfo'})){
|
|
$memory = linux_data($type,$file);
|
|
}
|
|
else {
|
|
$memory = bsd_data($type);
|
|
}
|
|
eval $end if $b_log;
|
|
return $memory;
|
|
}
|
|
|
|
# $memory:
|
|
# 0: available (not reserved or iGPU)
|
|
# 1: used (of available)
|
|
# 2: used %
|
|
# 3: gpu (raspberry pi only)
|
|
# Linux only, but could be extended if anyone wants to do the work for BSDs
|
|
# 4: array ref: sys_memory [total, blocks, block-size, count factor]
|
|
# 5: array ref: proc/iomem [total, reserved, gpu]
|
|
#
|
|
# args: 0: source, the caller; 1: $row hash ref; 2: $num ref; 3: indent
|
|
sub row {
|
|
eval $start if $b_log;
|
|
my ($source,$row,$num,$indent) = @_;
|
|
$loaded{'memory'} = 1;
|
|
my ($available,$gpu_ram,$note,$total,$used);
|
|
my $memory = get('full');
|
|
if ($memory){
|
|
# print Data::Dumper::Dumper $memory;
|
|
if ($memory->[3]){
|
|
$gpu_ram = $memory->[3];
|
|
}
|
|
elsif ($memory->[5] && $memory->[5][2]){
|
|
$gpu_ram = $memory->[5][2];
|
|
}
|
|
# Great, we have the real RAM data.
|
|
if ($show{'ram'} && ($total = RamItem::ram_total())){
|
|
$total = main::get_size($total,'string');
|
|
}
|
|
elsif ($memory->[4] || $memory->[5]){
|
|
process_total($memory,\$total,\$note);
|
|
}
|
|
if ($gpu_ram){
|
|
$gpu_ram = main::get_size($gpu_ram,'string');
|
|
}
|
|
$available = main::get_size($memory->[0],'string') if $memory->[0];
|
|
$used = main::get_size($memory->[1],'string') if $memory->[1];
|
|
$used .= " ($memory->[2]%)" if $memory->[2];
|
|
}
|
|
my $field = ($source eq 'info') ? 'Memory' : 'System RAM';
|
|
$available ||= 'N/A';
|
|
$total ||= 'N/A';
|
|
$used ||= 'N/A';
|
|
$row->{main::key($$num++,1,$indent,$field)} = '';
|
|
$row->{main::key($$num++,1,$indent+1,'total')} = $total;
|
|
$row->{main::key($$num++,0,$indent+2,'note')} = $note if $note;
|
|
$row->{main::key($$num++,0,$indent+1,'available')} = $available;
|
|
$row->{main::key($$num++,0,$indent+1,'used')} = $used;
|
|
$row->{main::key($$num++,0,$indent+1,'igpu')} = $gpu_ram if $gpu_ram;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## LINUX DATA ##
|
|
sub linux_data {
|
|
eval $start if $b_log;
|
|
my ($type,$file) = @_;
|
|
my ($available,$buffers,$cached,$free,$gpu,$not_used,$total_avail) = (0,0,0,0,0,0,0);
|
|
my ($iomem,$memory,$sys_memory,$total);
|
|
my @data = main::reader($file);
|
|
# Note: units kB should mean 1000x8 bits, but actually means KiB! Confusing
|
|
foreach (@data){
|
|
# Not actual total, it's total physical minus reserved/kernel/system.
|
|
if ($_ =~ /^MemTotal:/){
|
|
$total_avail = main::get_piece($_,2);
|
|
}
|
|
elsif ($_ =~ /^MemFree:/){
|
|
$free = main::get_piece($_,2);
|
|
}
|
|
elsif ($_ =~ /^Buffers:/){
|
|
$buffers = main::get_piece($_,2);
|
|
}
|
|
elsif ($_ =~ /^Cached:/){
|
|
$cached = main::get_piece($_,2);
|
|
}
|
|
elsif ($_ =~ /^MemAvailable:/){
|
|
$available = main::get_piece($_,2);
|
|
}
|
|
}
|
|
$gpu = gpu_ram_arm() if $risc{'arm'};
|
|
if ($type ne 'short' && ($fake{'sys-mem'} || -d '/sys/devices/system/memory')){
|
|
sys_memory(\$sys_memory);
|
|
}
|
|
if ($type ne 'short' && ($fake{'iomem'} || ($b_root && -r '/proc/iomem'))){
|
|
proc_iomem(\$iomem);
|
|
}
|
|
# $gpu = main::translate_size('128M');
|
|
# $total_avail += $gpu; # not using because this ram is not available to system
|
|
if ($available){
|
|
$not_used = $available;
|
|
}
|
|
# Seen fringe cases, where total - free+buff+cach < 0
|
|
# The idea is that the OS must be using 10MiB of ram or more
|
|
elsif (($total_avail - ($free + $buffers + $cached)) > 10000){
|
|
$not_used = ($free + $buffers + $cached);
|
|
}
|
|
# Netbsd goes < 0, but it's wrong, so dump the cache
|
|
elsif (($total_avail - ($free + $buffers)) > 10000){
|
|
$not_used = ($free + $buffers);
|
|
}
|
|
else {
|
|
$not_used = $free;
|
|
}
|
|
my $used = ($total_avail - $not_used);
|
|
my $percent = ($used && $total_avail) ? sprintf("%.1f", ($used/$total_avail)*100) : '';
|
|
if ($type eq 'short'){
|
|
$memory = short_data($total_avail,$used,$percent);
|
|
}
|
|
else {
|
|
# raw return in KiB
|
|
$memory = [$total_avail,$used,$percent,$gpu,$sys_memory,$iomem];
|
|
}
|
|
# print "$total_avail, $used, $percent, $gpu\n";
|
|
# print Data::Dumper::Dumper $memory;
|
|
main::log_data('data',"memory ref: $memory") if $b_log;
|
|
eval $end if $b_log;
|
|
return $memory;
|
|
}
|
|
|
|
# All values 0 if not root, but it is readable.
|
|
# See inxi-perl/dev/code-snippets.pl for original attempt, with pci/reserved
|
|
# args: 0: $iomem by ref
|
|
sub proc_iomem {
|
|
eval $start if $b_log;
|
|
my $file = '/proc/iomem';
|
|
my ($buffer,$gpu,$pci,$reserved,$rom,$system) = (0,0,0,0,0,0);
|
|
my $b_reserved;
|
|
no warnings 'portable';
|
|
if ($fake{'iomem'}){
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/memory/proc-iomem-128gb-1.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/memory/proc-iomem-544mb-igpu.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/memory/proc-iomem-64mb-vram-stolen.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/memory/proc-iomem-rh-1-matrox.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/memory/proc-iomem-2-vram.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/memory/proc-iomem-512mb-1.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/memory/proc-iomem-518mb-reserved-1.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/memory/proc-iomem-512mb-2-onboardgpu-active.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/memory/proc-iomem-512mb-system-1.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/memory/proc-iomem-257.18gb-system-1.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/memory/proc-iomem-192gb-system-1.txt";
|
|
$file = "$ENV{'HOME'}/bin/scripts/inxi/data/memory/proc-iomem-1012mb-igpu.txt";
|
|
}
|
|
foreach ((main::reader($file),'EOF')){
|
|
if ($dbg[54]){
|
|
if (/^\s*([0-9a-f]+)-([^\s]+) : /){
|
|
print $_,"\n",' size: ';
|
|
print main::get_size(((hex($2) - hex($1) + 1)/1024),'string'), "\n";
|
|
}
|
|
}
|
|
# Get everythign solidly System RAM
|
|
if (/^([0-9a-f]+)-([^\s]+) : (System RAM)$/i){
|
|
$system += hex($2) - hex($1) + 1;
|
|
}
|
|
elsif (/^([0-9a-f]+)-([^\s]+) : (Ram buffer)$/i){
|
|
$buffer += hex($2) - hex($1) + 1;
|
|
}
|
|
# Sometimes primary Reserved block contains PCI and other non RAM devices,
|
|
# but also can contain non RAM addresses, maybe NVMe?
|
|
elsif (/^([0-9a-f]+)-([^\s]+) : (Reserved)$/i){
|
|
$reserved += hex($2) - hex($1) + 1;
|
|
}
|
|
# Legacy System ROM not in a Reserved block, primary item.
|
|
elsif (/^\s*([0-9a-f]+)-([^\s]+) : (System ROM)$/i){
|
|
$rom += hex($2) - hex($1) + 1;
|
|
}
|
|
elsif (/^([0-9a-f]+)-([^\s]+) : (ACPI Tables)$/i){
|
|
$rom += hex($2) - hex($1) + 1;
|
|
}
|
|
# Incomplete because sometimes Reserved blocks contain PCI etc devices
|
|
elsif (/^([0-9a-f]+)-([^\s]+) : (PCI .*)$/){
|
|
$pci += hex($2) - hex($1) + 1;
|
|
}
|
|
# Graphics stolen memory/Video RAM area, but legacy had inside PCI blocks,
|
|
# not reserved, or as primary. That behavior seems to have changed.
|
|
if (/^\s*([0-9a-f]+)-([^\s]+) : (?:(Video RAM|Graphics).*)$/i){
|
|
$gpu += hex($2) - hex($1) + 1;
|
|
}
|
|
}
|
|
if ($dbg[54] || $b_log){
|
|
my $d = ['iomem:','System: ' . main::get_size(($system/1024),'string'),
|
|
'Reserved: ' . main::get_size(($reserved/1024),'string'),
|
|
'Buffer: ' . main::get_size(($buffer/1024),'string'),
|
|
'iGPU: ' . main::get_size(($gpu/1024),'string'),
|
|
'ROM: ' . main::get_size(($rom/1024),'string'),
|
|
'System+iGPU+buffer+rom: ' . main::get_size((($system+$gpu+$buffer+$rom)/1024),'string'),
|
|
' Raw GiB: ' . ($system+$gpu+$buffer+$rom)/1024**3,
|
|
'System+reserved: ' . main::get_size((($system+$reserved)/1024),'string'),
|
|
' Raw GiB: ' . ($system+$reserved)/1024**3,
|
|
'System+reserved+buffer: ' . main::get_size((($system+$reserved+$buffer)/1024),'string'),
|
|
' Raw GiB: ' . ($system+$reserved+$buffer)/1024**3,
|
|
'Reserved-iGPU: ' . main::get_size((($reserved-$gpu)/1024),'string'),
|
|
'PCI Bus: ' . main::get_size(($pci/1024),'string')];
|
|
main::log_data('dump','$d iomem',$d) if $b_log;
|
|
print "\n",join("\n",@$d),"\n\n" if $dbg[54];
|
|
}
|
|
if ($gpu || $system || $reserved){
|
|
# This combination seems to provide the bwest overall result
|
|
$system += $gpu + $rom + $buffer;
|
|
${$_[0]} = [$system/1024,$reserved/1024,$gpu/1024];
|
|
}
|
|
main::log_data('dump','$iomem',$_[0]) if $b_log;
|
|
print 'proc/iomem: ', Data::Dumper::Dumper $_[0] if $dbg[53];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# Note: seen case where actual 128 GiB, result here 130, 65x2GiB. Also cases
|
|
# where blocks under expected total, this may be related to active onboard gpu.
|
|
sub sys_memory {
|
|
eval $start if $b_log;
|
|
return if !$fake{'sys-mem'} && ! -r '/sys/devices/system/memory/block_size_bytes';
|
|
my ($count,$factor,$size,$total) = (0,1,0,0);
|
|
# state = off,online; online = 1/0
|
|
foreach my $online (main::globber('/sys/devices/system/memory/memory*/online')){
|
|
$count++ if main::reader($online,'',0); # content 1/0, so will read as t/f
|
|
}
|
|
if ($count){
|
|
$size = main::reader('/sys/devices/system/memory/block_size_bytes','',0);
|
|
if ($size){
|
|
$size = hex($size)/1024; # back to integer KiB
|
|
$total = $count * $size;
|
|
}
|
|
}
|
|
if ($fake{'sys-mem'}){
|
|
# ($total,$count,$size) = (,,); #
|
|
# ($total,$count,$size) = (4194304,32,131072); # 4gb
|
|
# ($total,$count,$size) = (7864320,60,131072); # 7.5 gb, -4 blocks
|
|
# ($total,$count,$size) = (136314880,65,2097152); # 130 gb, +1 block
|
|
# ($total,$count,$size) = (8126464,62,131072); # 7.75 gb, -2 blocks, vram?
|
|
# ($total,$count,$size) = (33554432,256,131072); # 32 gb
|
|
# ($total,$count,$size) = (8388608,64,131072); # 8gb
|
|
# ($total,$count,$size) = (270532608,129,2097152); # 258 gb, +1 block
|
|
# ($total,$count,$size) = (17563648,134,131072); # 16.75 gb, +6 block
|
|
# ($total,$count,$size) = (3801088,29,131072); # 3.62 gb, -3 blocks
|
|
# ($total,$count,$size) = (67108864,32,2097152); # 64 gb
|
|
# ($total,$count,$size) = (524288,4,131072); # 512 mb, maybe -4 blocks, vm
|
|
}
|
|
# Max stick size assumed: 64 blocks: 8 GiB/128 GiB min module: 2 GiB/32 GiB
|
|
# 128 blocks: 16 GiB/256 GiB min module: 4 GiB/64 GiB but no way to know
|
|
# Note: 128 MiB blocks; > 32 GiB, 2 GiB blocks, I think.
|
|
# 64: 8 GiB/256 GiB, min module: 2 GiB/32 GiB
|
|
if ($count > 32){
|
|
$factor = 16;}
|
|
# 32: 4 GiB/64 GiB, min module: 1 GiB/16 GiB
|
|
elsif ($count > 16){
|
|
$factor = 8;}
|
|
# 16: 2 GiB, min module: 512 MiB
|
|
elsif ($count > 8){
|
|
$factor = 4;}
|
|
# 8: 1 GiB, min module: 256 MiB
|
|
elsif ($count > 4){
|
|
$factor = 2;}
|
|
# 4: 512 MiB, min module: 128 MiB
|
|
else {
|
|
$factor = 1;}
|
|
if ($total || $count || $size){
|
|
${$_[0]} = [$total,$count,$size,$factor];
|
|
}
|
|
if ($dbg[54] || $b_log){
|
|
my $d = ['/sys:','Total: ' . main::get_size($total,'string'),
|
|
'Blocks: ' . $count,
|
|
'Block-size: ' . main::get_size($size,'string'),
|
|
"Count-factor: $count % $factor: " . $count % $factor];
|
|
main::log_data('dump','$d sys-mem',$d) if $b_log;
|
|
print "\n",join("\n",@$d),"\n\n" if $dbg[54];
|
|
}
|
|
main::log_data('dump','$sys_memory',$_[0]) if $b_log;
|
|
print 'sys memory: ', Data::Dumper::Dumper $_[0] if $dbg[53];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# These are hacks since the phy ram real data is not available in clear form
|
|
# args: 0: memory array ref; 1: $total ref; 2: $note ref.
|
|
sub process_total {
|
|
eval $start if $b_log;
|
|
my ($memory,$total,$note) = @_;
|
|
my ($d,$b_vm,@info);
|
|
my $src = '';
|
|
$b_vm = MachineItem::is_vm() if $show{'machine'};
|
|
# Seen case where actual 128 GiB, result here 130, 65x2GiB. Maybe nvme?
|
|
# This can be over or under phys ram
|
|
if ($memory->[4] && $memory->[4][0]){
|
|
@info = main::get_size($memory->[4][0]);
|
|
# We want to show note for probably wrong results
|
|
if ((!$fake{'sys-mem'} && $memory->[0] && $memory->[4][0] < $memory->[0]) ||
|
|
(!$b_vm && $memory->[4][1] % $memory->[4][3] != 0)){
|
|
$$note = main::message('note-check');
|
|
}
|
|
$src = 'sys';
|
|
}
|
|
# Note: this is a touch under the real ram amount, varies, igpu/vram can eat it.
|
|
# This working total will only be under phys ram.
|
|
if ($memory->[5] && $memory->[5][0] &&
|
|
(!$memory->[4] || !$memory->[4][0] || ($memory->[4][0] != $memory->[5][0]))){
|
|
@info = main::get_size($memory->[5][0]);
|
|
$src = 'iomem';
|
|
}
|
|
if (@info){
|
|
$$note = '';
|
|
if (!$b_vm){
|
|
# $info[0] = 384;
|
|
# $info[1] = 'MiB';
|
|
my ($factor,$factor2) = (1,0.5);
|
|
# For M, assume smallest is 128, anything older won't even work probably.
|
|
# For T RAM, the system ram is going to be 99.9% of physical because the
|
|
# reserved stuff is going to be tiny, I believe. We will see.
|
|
# T array stick sizes: 128/256/512/1024 G
|
|
# Note: samsung ships 1T modules (2024?), 512G (2023).
|
|
if ($info[0] > 512){
|
|
$factor = ($info[1] eq 'MiB') ? 256 : 64;
|
|
}
|
|
elsif ($info[0] > 256){
|
|
$factor = ($info[1] eq 'MiB') ? 128 : 32;
|
|
}
|
|
elsif ($info[0] > 128){
|
|
$factor = ($info[1] eq 'MiB') ? 64 : 16;
|
|
}
|
|
elsif ($info[0] > 64){
|
|
$factor = 8;
|
|
}
|
|
elsif ($info[0] > 16){
|
|
$factor = 4;
|
|
}
|
|
elsif ($info[0] > 8){
|
|
$factor = 4;
|
|
}
|
|
elsif ($info[0] > 4){
|
|
$factor = 2;
|
|
}
|
|
elsif ($info[0] > 3){
|
|
$factor = 1;
|
|
}
|
|
elsif ($info[0] > 2){
|
|
$factor = ($info[1] eq 'TiB') ? 0.25 : 0.5;
|
|
}
|
|
# Note: get_size returns 1 as 1024, so we never actually see 1
|
|
elsif ($info[0] > 1){
|
|
$factor = ($info[1] eq 'TiB') ? 0.125 : 0.25;
|
|
}
|
|
my $result = $info[0] / $factor;
|
|
my $mod = ((100 * $result) % 100);
|
|
if ($b_log || $dbg[54]){
|
|
push(@$d,"src: $src result: $info[0] / $factor: $result math-modulus: $mod");
|
|
}
|
|
if ($mod > 0){
|
|
my ($check,$working) = (0,0);
|
|
# Sometimes Perl generates a tiny value over 0.1: 0.100000000000023
|
|
# but also we want to be a little loose here. Note that when high
|
|
# numbers, like 1012 M, we want the math much looser.
|
|
# Within ~ 5%
|
|
if ($info[1] eq 'MiB'){
|
|
if ($info[0] > 768){
|
|
$check = 64;
|
|
}
|
|
elsif ($info[0] > 512){
|
|
$check = 32;
|
|
}
|
|
elsif ($info[0] > 256){
|
|
$check = 16;
|
|
}
|
|
else {
|
|
$check = 4;
|
|
}
|
|
}
|
|
# Within ~ 1%
|
|
elsif ($info[1] eq 'GiB'){
|
|
if ($info[0] > 512){
|
|
$check = 4;
|
|
}
|
|
elsif ($info[0] > 256){
|
|
$check = 2;
|
|
}
|
|
elsif ($info[0] > 3){
|
|
$check = 0.25;
|
|
}
|
|
else {
|
|
$check = 0.1;
|
|
}
|
|
}
|
|
# Will need to verify this T assumption on real data one day, but keep
|
|
# in mind how much reserved ram this would be!
|
|
elsif ($info[1] eq 'TiB'){
|
|
if ($info[0] > 16){
|
|
$check = 0.25;
|
|
}
|
|
elsif ($info[0] > 8){
|
|
$check = 0.15;
|
|
}
|
|
elsif ($info[0] > 2){
|
|
$check = 0.1;
|
|
}
|
|
else {
|
|
$check = 0.05;
|
|
}
|
|
}
|
|
# iomem is always under, sys can be over or under. we want fractional
|
|
# corresponding value over or under result.
|
|
# sys has block sizes: 128M, 2G, 32G, so sizes will always be divisible
|
|
if ($src eq 'sys'){
|
|
if ($info[0] > 64){
|
|
$factor2 = 0.25;
|
|
}
|
|
}
|
|
if ($src eq 'sys' && int($result + $factor2) == int($result)){
|
|
$working = int($result) * $factor;
|
|
}
|
|
else {
|
|
$working = POSIX::ceil($result) * $factor;
|
|
}
|
|
if ($b_log || $dbg[54]){
|
|
push(@$d, "factor2: $factor2 floor_res+fact2: " . int($result + $factor2),
|
|
"ceil_result * factor: " . (POSIX::ceil($result) * $factor),
|
|
"floor_result * factor: " . (int($result) * $factor));
|
|
}
|
|
if (abs(($working - $info[0])) < $check){
|
|
if ($src eq 'sys' && $info[0] != $working){
|
|
$$note = main::message('note-est');
|
|
}
|
|
if ($b_log || $dbg[54]){
|
|
push(@$d,"check less: ($working - $info[0]) < $check: ",
|
|
"result: inside ceil < $check, clean");
|
|
}
|
|
}
|
|
else {
|
|
if ($b_log || $dbg[54]){
|
|
push(@$d,"check not less: ($working - $info[0]) < $check: ",
|
|
"set: $info[0] = $working");
|
|
}
|
|
$$note = main::message('note-est');
|
|
}
|
|
$info[0] = $working;
|
|
}
|
|
else {
|
|
if ($b_log || $dbg[54]){
|
|
push(@$d,"result: clean match, no change: $info[0] $info[1]");
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
my $dec = ($info[1] eq 'MiB') ? 1: 2;
|
|
$info[0] = sprintf("%0.${dec}f",$info[0]) + 0;
|
|
if ($b_log || $dbg[54]){
|
|
push(@$d,"result: vm, using size: $info[0] $info[1]");
|
|
}
|
|
}
|
|
$$total = $info[0] . ' ' . $info[1];
|
|
}
|
|
if ($b_log || $dbg[54]){
|
|
main::log_data('dump','debugger',$d) if $b_log;
|
|
print Data::Dumper::Dumper $d if $dbg[54];
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## BSD DATA ##
|
|
## openbsd/linux
|
|
# procs memory page disks traps cpu
|
|
# r b w avm fre flt re pi po fr sr wd0 wd1 int sys cs us sy id
|
|
# 0 0 0 55256 1484092 171 0 0 0 0 0 2 0 12 460 39 3 1 96
|
|
## openbsd 6.3? added in M/G/T etc, sigh...
|
|
# 2 57 55M 590M 789 0 0 0...
|
|
## freebsd:
|
|
# procs memory page disks faults cpu
|
|
# r b w avm fre flt re pi po fr sr ad0 ad1 in sy cs us sy id
|
|
# 0 0 0 21880M 6444M 924 32 11 0 822 827 0 0 853 832 463 8 3 88
|
|
# with -H
|
|
# 2 0 0 14925812 936448 36 13 10 0 84 35 0 0 84 30 42 11 3 86
|
|
## dragonfly: V1, supported -H
|
|
# procs memory page disks faults cpu
|
|
# r b w avm fre flt re pi po fr sr ad0 ad1 in sy cs us sy id
|
|
# 0 0 0 0 84060 30273993 2845 12742 1164 407498171 320960902 0 0 ....
|
|
## dragonfly: V2, no avm, no -H support
|
|
sub bsd_data {
|
|
eval $start if $b_log;
|
|
my ($type) = @_;
|
|
my ($avm,$av_pages,$cnt,$fre,$free_mem,$mult,$real_mem,$total) = (0,0,0,0,0,0,0,0);
|
|
my (@data,$memory,$message);
|
|
# my $arg = ($bsd_type ne 'openbsd' && $bsd_type ne 'dragonfly') ? '-H' : '';
|
|
if (my $program = main::check_program('vmstat')){
|
|
# See above, it's the last line. -H makes it hopefully all in kB so no need
|
|
# for K/M/G tests, note that -H not consistently supported, so don't use.
|
|
my @vmstat = main::grabber("vmstat 2>/dev/null",'\n','strip');
|
|
main::log_data('dump','@vmstat',\@vmstat) if $b_log;
|
|
my @header = split(/\s+/, $vmstat[1]);
|
|
foreach (@header){
|
|
if ($_ eq 'avm'){$avm = $cnt}
|
|
elsif ($_ eq 'fre'){$fre = $cnt}
|
|
elsif ($_ eq 'flt'){last;}
|
|
$cnt++;
|
|
}
|
|
my $row = $vmstat[-1];
|
|
if ($row){
|
|
@data = split(/\s+/, $row);
|
|
# Openbsd 6.3, dragonfly 5.x introduced an M / G character, sigh.
|
|
if ($avm > 0 && $data[$avm] && $data[$avm] =~ /^([0-9\.]+[KGMT])(iB|B)?$/){
|
|
$data[$avm] = main::translate_size($1);
|
|
}
|
|
if ($fre > 0 && $data[$fre] && $data[$fre] =~ /^([0-9\.]+[KGMT])(iB|B)?$/){
|
|
$data[$fre] = main::translate_size($1);
|
|
}
|
|
# Dragonfly can have 0 avg, or no avm, sigh, but they may fix that so make test dynamic
|
|
if ($avm > 0 && $data[$avm] != 0){
|
|
$av_pages = ($bsd_type !~ /^(net|open)bsd$/) ? sprintf('%.1f',$data[$avm]/1024) : $data[$avm];
|
|
}
|
|
if ($fre > 0 && $data[$fre] != 0){
|
|
$free_mem = sprintf('%.1f',$data[$fre]);
|
|
}
|
|
}
|
|
}
|
|
# Code to get total goes here:
|
|
if ($alerts{'sysctl'}->{'action'} eq 'use'){
|
|
# For dragonfly, we will use free mem, not used because free is 0
|
|
my @working;
|
|
if ($sysctl{'memory'}){
|
|
foreach (@{$sysctl{'memory'}}){
|
|
# Freebsd seems to use bytes here
|
|
if (!$real_mem && /^hw.physmem:/){
|
|
@working = split(/:\s*/, $_);
|
|
# if ($working[1]){
|
|
$working[1] =~ s/^[^0-9]+|[^0-9]+$//g;
|
|
$real_mem = sprintf("%.1f", $working[1]/1024);
|
|
# }
|
|
last if $free_mem;
|
|
}
|
|
# But, it uses K here. Openbsd/Dragonfly do not seem to have this item
|
|
# This can be either: Free Memory OR Free Memory Pages
|
|
elsif (/^Free Memory:/){
|
|
@working = split(/:\s*/, $_);
|
|
$working[1] =~ s/[^0-9]+//g;
|
|
$free_mem = sprintf("%.1f", $working[1]);
|
|
last if $real_mem;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$message = "sysctl $alerts{'sysctl'}->{'action'}"
|
|
}
|
|
# Not using, but leave in place for a bit in case we want it
|
|
# my $type = ($free_mem) ? ' free':'' ;
|
|
# Hack: temp fix for openbsd/darwin: in case no free mem was detected but we have physmem
|
|
if (($av_pages || $free_mem) && !$real_mem){
|
|
my $error = ($message) ? $message: 'total N/A';
|
|
my $used = (!$free_mem) ? $av_pages : $real_mem - $free_mem;
|
|
if ($type eq 'short'){
|
|
$memory = short_data($error,$used);
|
|
}
|
|
else {
|
|
$memory = [$error,$used,undef];
|
|
}
|
|
}
|
|
# Use openbsd/dragonfly avail mem data if available
|
|
elsif (($av_pages || $free_mem) && $real_mem){
|
|
my $used = (!$free_mem) ? $av_pages : $real_mem - $free_mem;
|
|
my $percent = ($used && $real_mem) ? sprintf("%.1f", ($used/$real_mem)*100) : '';
|
|
if ($type eq 'short'){
|
|
$memory = short_data($real_mem,$used,$percent);
|
|
}
|
|
else {
|
|
$memory = [$real_mem,$used,$percent,0];
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $memory;
|
|
}
|
|
|
|
## TOOLS ##
|
|
# args: 0: avail memory; 1: used memory; 2: percent used
|
|
sub short_data {
|
|
# some BSDs, no available
|
|
my @avail = (main::is_numeric($_[0])) ? main::get_size($_[0]) : ($_[0]);
|
|
my @used = main::get_size($_[1]);
|
|
my $string = '';
|
|
if ($avail[1] && $used[1]){
|
|
if ( $avail[1] eq $used[1]){
|
|
$string = "$used[0]/$avail[0] $used[1]";
|
|
}
|
|
else {
|
|
$string = "$used[0] $used[1]/$avail[0] $avail[1]";
|
|
}
|
|
}
|
|
elsif ($used[1]){
|
|
$string = "$used[0]/[$avail[0]] $used[1]";
|
|
}
|
|
$string .= " ($_[2]%)" if $_[2];
|
|
return $string;
|
|
}
|
|
|
|
# Raspberry pi only
|
|
sub gpu_ram_arm {
|
|
eval $start if $b_log;
|
|
my ($gpu_ram) = (0);
|
|
if (my $program = main::check_program('vcgencmd')){
|
|
# gpu=128M
|
|
# "VCHI initialization failed" - you need to add video group to your user
|
|
my $working = (main::grabber("$program get_mem gpu 2>/dev/null"))[0];
|
|
$working = (split(/\s*=\s*/, $working))[1] if $working;
|
|
$gpu_ram = main::translate_size($working) if $working;
|
|
}
|
|
main::log_data('data',"gpu ram: $gpu_ram") if $b_log;
|
|
eval $end if $b_log;
|
|
return $gpu_ram;
|
|
}
|
|
}
|
|
|
|
# args: 0: module to get version of
|
|
sub get_module_version {
|
|
eval $start if $b_log;
|
|
my ($module) = @_;
|
|
return if !$module;
|
|
my ($version);
|
|
my $path = "/sys/module/$module/version";
|
|
if (-r $path){
|
|
$version = reader($path,'',0);
|
|
}
|
|
elsif (-f "/sys/module/$module/uevent"){
|
|
$version = 'kernel';
|
|
}
|
|
# print "version:$version\n";
|
|
if (!$version){
|
|
if (my $path = check_program('modinfo')){
|
|
my @data = grabber("$path $module 2>/dev/null");
|
|
$version = awk(\@data,'^version',2,':\s+') if @data;
|
|
}
|
|
}
|
|
$version ||= '';
|
|
eval $end if $b_log;
|
|
return $version;
|
|
}
|
|
|
|
## PackageData
|
|
# Note: this outputs the key/value pairs ready to go and is
|
|
# called from either -r or -Ix, -r precedes.
|
|
{
|
|
package PackageData;
|
|
my ($count,$num,%pms,$type);
|
|
$pms{'total'} = 0;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
# $num passed by reference to maintain incrementing where requested
|
|
($type,$num) = @_;
|
|
$loaded{'package-data'} = 1;
|
|
my $output = {};
|
|
package_counts();
|
|
appimage_counts();
|
|
create_output($output);
|
|
eval $end if $b_log;
|
|
return $output;
|
|
}
|
|
|
|
sub create_output {
|
|
eval $start if $b_log;
|
|
my $output = $_[0];
|
|
my $total = '';
|
|
if ($pms{'total'}){
|
|
$total = $pms{'total'};
|
|
}
|
|
else {
|
|
if ($type eq 'inner' || $pms{'note'}){
|
|
$total = 'N/A' if $extra < 2;
|
|
}
|
|
else {
|
|
$total = main::message('package-data');
|
|
}
|
|
}
|
|
if ($pms{'total'} && $extra > 1){
|
|
delete $pms{'total'};
|
|
my $b_mismatch;
|
|
foreach (keys %pms){
|
|
next if $_ eq 'note';
|
|
if ($pms{$_}->{'pkgs'} && $pms{$_}->{'pkgs'} != $total){
|
|
$b_mismatch = 1;
|
|
last;
|
|
}
|
|
}
|
|
$total = '' if !$b_mismatch;
|
|
}
|
|
$output->{main::key($$num++,1,1,'Packages')} = $total;
|
|
# if blocked pm secondary, only show if no total or improbable total
|
|
if ($pms{'note'} && $extra < 2 && (!$pms{'total'} || $total < 100)){
|
|
$output->{main::key($$num++,0,2,'note')} = $pms{'note'};
|
|
}
|
|
if ($extra > 1 && %pms){
|
|
foreach my $pm (sort keys %pms){
|
|
my ($cont,$ind) = (1,2);
|
|
# if package mgr command returns error, this will not be a hash
|
|
next if ref $pms{$pm} ne 'HASH';
|
|
if ($pms{$pm}->{'pkgs'} || $b_admin || ($extra > 1 && $pms{$pm}->{'note'})){
|
|
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}->{'note'};
|
|
$output->{main::key($$num++,($cont+1),$ind,'pkgs')} = $pms{$pm}->{'pkgs'};
|
|
if ($pms{$pm}->{'note'}){
|
|
$output->{main::key($$num++,$cont,$ind,'note')} = $pms{$pm}->{'note'};
|
|
}
|
|
if ($b_admin ){
|
|
if ($pms{$pm}->{'libs'}){
|
|
$output->{main::key($$num++,$cont,($ind+1),'libs')} = $pms{$pm}->{'libs'};
|
|
}
|
|
if ($pms{$pm}->{'tools'}){
|
|
$output->{main::key($$num++,$cont,$ind,'tools')} = $pms{$pm}->{'tools'};
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \%output;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub package_counts {
|
|
eval $start if $b_log;
|
|
my ($type) = @_;
|
|
# note: there is a program called discover which has nothing to do with kde
|
|
# apt systems: plasma-discover, non apt, discover, but can't use due to conflict
|
|
# my $disc = 'plasma-discover';
|
|
my $gs = 'gnome-software';
|
|
# 0: key; 1: program; 2: p/d; 3: arg/path; 4: 0/1 use lib;
|
|
# 5: lib slice; 6: lib splitter; 7 - optional eval test;
|
|
# 8: optional installed tool tests for -ra
|
|
# needed: cards [nutyx], urpmq [mageia]
|
|
my @pkg_managers = (
|
|
['alps','alps','p','showinstalled',1,0,''],
|
|
['apk','apk','p','info',1,0,''],
|
|
# ['aptd','dpkg-query','d','/usr/lib/*',1,3,'\\/'],
|
|
# mutyx. do cards test because there is a very slow pkginfo python pkg mgr
|
|
['cards','pkginfo','p','-i',1,1,'','main::check_program(\'cards\')'],
|
|
# older dpkg-query do not support -f values consistently: eg ${binary:Package}
|
|
['dpkg','dpkg-query','p','-W --showformat=\'${Package}\n\'',1,0,'','',
|
|
['apt','apt-get','aptitude','deb-get','nala','synaptic']],
|
|
['emerge','emerge','d','/var/db/pkg/*/*/',1,5,'\\/'],
|
|
['eopkg','eopkg','d','/var/lib/eopkg/package/*',1,5,'\\/'],
|
|
['guix-sys','guix','p','package -p "/run/current-system/profile" -I',1,0,''],
|
|
['guix-usr','guix','p','package -I',1,0,''],
|
|
['kiss','kiss','p','list',1,0,''],
|
|
['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','cylon','octopi','pacaur','pakku','pamac','paru',
|
|
'pikaur','trizen','yaourt','yay','yup']],
|
|
['pacman-g2','pacman-g2','p','-Q',1,0,'','',],
|
|
['pkg','pkg','d','/var/db/pkg/*',1,0,''], # 'pkg list' returns non programs
|
|
['pkg_add','pkg_info','p','',1,0,''], # OpenBSD has set of tools, not 1 pm
|
|
# like cards, avoid pkginfo directly due to python pm being so slow
|
|
# but pkgadd is also found in scratch
|
|
['pkgutils','pkginfo','p','-i',1,0,'','main::check_program(\'pkgadd\')'],
|
|
# slack 15 moves packages to /var/lib/pkgtools/packages but links to /var/log/packages
|
|
['pkgtool','installpkg','d','/var/lib/pkgtools/packages/*',1,5,'\\/',
|
|
'!-d \'/var/netpkg\' && -d \'/var/lib/pkgtools/packages\'',
|
|
['sbopkg','sboui','slackpkg','slapt-get','slpkg','swaret']],
|
|
['pkgtool','installpkg','d','/var/log/packages/*',1,4,'\\/',
|
|
'! -d \'/var/lib/pkgtools/packages\' && -d \'/var/log/packages/\'',
|
|
['sbopkg','sboui','slackpkg','slapt-get','slpkg','swaret']],
|
|
# rpm way too slow without nodigest/sig!! confirms packages exist
|
|
# but even with, MASSIVELY slow in some cases, > 20, 30 seconds!!!!
|
|
# find another way to get rpm package counts or don't show this feature for rpm!!
|
|
['rpm','rpm','force','-qa --nodigest --nosignature',1,0,'','',
|
|
['dnf','packagekit','up2date','urpmi','yast','yum','zypper']],
|
|
# 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,''],
|
|
['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 ($program);
|
|
foreach my $pm (@pkg_managers){
|
|
if ($program = main::check_program($pm->[1])){
|
|
next if $pm->[7] && !eval $pm->[7];
|
|
my ($error,$libs,@list,$pmts);
|
|
if ($pm->[2] eq 'p' || ($pm->[2] eq 'force' && check_run($pm))){
|
|
chomp(@list = qx($program $pm->[3] 2>/dev/null));
|
|
}
|
|
elsif ($pm->[2] eq 'd'){
|
|
@list = main::globber($pm->[3]);
|
|
}
|
|
else {
|
|
# update message() if pm other than rpm disabled by default
|
|
$error = main::message('pm-' . $pm->[1] . '-disabled');
|
|
}
|
|
$count = scalar @list if !$error;
|
|
# print Data::Dumper::Dumper \@list;
|
|
if (!$error){
|
|
if ($b_admin && $count && $pm->[4]){
|
|
$libs = count_libs(\@list,$pm->[5],$pm->[6]);
|
|
}
|
|
}
|
|
else {
|
|
$pms{'note'} = $error;
|
|
}
|
|
# 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 = '';
|
|
}
|
|
}
|
|
$pmts = join(',',sort @tools) if @tools;
|
|
}
|
|
$pms{$pm->[0]} = {
|
|
'pkgs' => $count,
|
|
'libs' => $libs,
|
|
'note' => $error,
|
|
'tools' => $pmts,
|
|
};
|
|
$pms{'total'} += $count if defined $count;
|
|
# print Data::Dumper::Dumper \%pms;
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \%pms;
|
|
main::log_data('dump','Package managers: %pms',\%pms) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub appimage_counts {
|
|
if (@ps_cmd && (grep {/\bappimage(d|launcher)\b/} @ps_cmd)){
|
|
my @list = main::globber($ENV{'HOME'} . '/.{appimage/,local/bin/}*.[aA]pp[iI]mage');
|
|
$count = scalar @list;
|
|
$pms{'zzz-appimage'} = {
|
|
'pkgs' => $count,
|
|
'libs' => undef,
|
|
};
|
|
$pms{'total'} += $count;
|
|
}
|
|
}
|
|
|
|
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";
|
|
foreach (@$items){
|
|
@data = split(/$split/, $_);
|
|
# print scalar @data, '::', $data[$pos], "\n";
|
|
$i++ if $data[$pos] && $data[$pos] =~ m%^lib%;
|
|
}
|
|
return $i;
|
|
}
|
|
}
|
|
|
|
## ParseEDID
|
|
{
|
|
package ParseEDID;
|
|
# CVT_ratios:
|
|
my @known_ratios = qw(5/4 4/3 3/2 16/10 15/9 16/9);
|
|
|
|
# Set values
|
|
my @edid_info = (
|
|
['a8', '_header'],
|
|
['a2', 'manufacturer_name'],
|
|
['v', 'product_code'],
|
|
['V', 'serial_number'],
|
|
['C', 'week'],
|
|
['C', 'year'],
|
|
['C', 'edid_version'],
|
|
['C', 'edid_revision'],
|
|
['a', 'video_input_definition'],
|
|
['C', 'max_size_horizontal'], # in cm, 0 on projectors
|
|
['C', 'max_size_vertical'], # in cm, 0 on projectors
|
|
['C', 'gamma'],
|
|
['a', 'feature_support'],
|
|
['a10', 'color_characteristics'],
|
|
['a3' , 'established_timings'],
|
|
['a16', 'standard_timings'],
|
|
['a72', 'monitor_details'],
|
|
['C', 'extension_flag'],
|
|
['C', 'checksum'],
|
|
);
|
|
my %subfields = (
|
|
manufacturer_name => [
|
|
[1, ''],
|
|
[5, '1'],
|
|
[5, '2'],
|
|
[5, '3'],
|
|
],
|
|
video_input_definition => [
|
|
[1, 'digital'],
|
|
[1, 'separate_sync'],
|
|
[1, 'composite_sync'],
|
|
[1, 'sync_on_green'],
|
|
[2, ''],
|
|
[2, 'voltage_level'],
|
|
],
|
|
feature_support => [
|
|
[1, 'DPMS_standby'],
|
|
[1, 'DPMS_suspend'],
|
|
[1, 'DPMS_active_off'],
|
|
[1, 'rgb'],
|
|
[1, ''],
|
|
[1, 'sRGB_compliance'],
|
|
[1, 'has_preferred_timing'],
|
|
[1, 'GTF_compliance'],
|
|
],
|
|
# these are VESA timings, basically: VESA-EEDID-A2.pdf
|
|
established_timings => [
|
|
# byte 1, 23h
|
|
[1, '720x400_70'],
|
|
[1, '720x400_88'],
|
|
[1, '640x480_60'],
|
|
[1, '640x480_67'],
|
|
[1, '640x480_72'],
|
|
[1, '640x480_75'],
|
|
[1, '800x600_56'],
|
|
[1, '800x600_60'],
|
|
# byte 2, 24h
|
|
[1, '800x600_72'],
|
|
[1, '800x600_75'],
|
|
[1, '832x624_75'],
|
|
[1, '1024x768_87i'],
|
|
[1, '1024x768_60'],
|
|
[1, '1024x768_70'],
|
|
[1, '1024x768_75'],
|
|
[1, '1280x1024_75'],
|
|
# byte 3, 25h
|
|
# 7: [1, '1152x870_75'], # apple macII
|
|
# 6-0: manufacturer's timings
|
|
],
|
|
detailed_timing => [
|
|
[8, 'horizontal_active'],
|
|
[8, 'horizontal_blanking'],
|
|
[4, 'horizontal_active_hi'],
|
|
[4, 'horizontal_blanking_hi'],
|
|
[8, 'vertical_active'],
|
|
[8, 'vertical_blanking'],
|
|
[4, 'vertical_active_hi'],
|
|
[4, 'vertical_blanking_hi'],
|
|
[8, 'horizontal_sync_offset'],
|
|
[8, 'horizontal_sync_pulse_width'],
|
|
[4, 'vertical_sync_offset'],
|
|
[4, 'vertical_sync_pulse_width'],
|
|
[2, 'horizontal_sync_offset_hi'],
|
|
[2, 'horizontal_sync_pulse_width_hi'],
|
|
[2, 'vertical_sync_offset_hi'],
|
|
[2, 'vertical_sync_pulse_width_hi'],
|
|
[8, 'horizontal_image_size'], # in mm
|
|
[8, 'vertical_image_size'], # in mm
|
|
[4, 'horizontal_image_size_hi'],
|
|
[4, 'vertical_image_size_hi'],
|
|
[8, 'horizontal_border'],
|
|
[8, 'vertical_border'],
|
|
[1, 'interlaced'],
|
|
[2, 'stereo'],
|
|
[2, 'digital_composite'],
|
|
[1, 'horizontal_sync_positive'],
|
|
[1, 'vertical_sync_positive'],
|
|
[1, ''],
|
|
],
|
|
# 16 bytes, up to 8 additional timings, each identified by a unique 2 byte
|
|
# code derived from the horizontal active pixel count, the image aspect ratio
|
|
# and field refresh rate as described in Table 3.19
|
|
standard_timing => [
|
|
[8, 'X'],
|
|
[2, 'aspect'],
|
|
[6, 'vfreq'],
|
|
],
|
|
monitor_range => [
|
|
[8, 'vertical_min'],
|
|
[8, 'vertical_max'],
|
|
[8, 'horizontal_min'],
|
|
[8, 'horizontal_max'],
|
|
[8, 'pixel_clock_max'],
|
|
],
|
|
manufacturer_specified_range_timing => [
|
|
# http://www.spwg.org/salisbury_march_19_2002.pdf
|
|
# for the glossary: http://www.vesa.org/Public/PSWG/PSWG15v1.pdf
|
|
[8, 'horizontal_sync_pulse_width_min'], # HSPW (Horizontal Sync Pulse Width)
|
|
[8, 'horizontal_sync_pulse_width_max'],
|
|
[8, 'horizontal_back_porch_min'], # t_hbp
|
|
[8, 'horizontal_back_porch_max'],
|
|
[8, 'vertical_sync_pulse_width_min'], # VSPW (Vertical Sync Pulse Width)
|
|
[8, 'vertical_sync_pulse_width_max'],
|
|
[8, 'vertical_back_porch_min'], # t_vbp (Vertical Back Porch)
|
|
[8, 'vertical_back_porch_max'],
|
|
[8, 'horizontal_blanking_min'], # t_hp (Horizontal Period)
|
|
[8, 'horizontal_blanking_max'],
|
|
[8, 'vertical_blanking_min'], # t_vp
|
|
[8, 'vertical_blanking_max'],
|
|
[8, 'module_revision'],
|
|
],
|
|
cea_data_block_collection => [
|
|
[3, 'type'],
|
|
[5, 'size'],
|
|
],
|
|
cea_video_data_block => [
|
|
[1, 'native'],
|
|
[7, 'mode'],
|
|
],
|
|
# Section 3.7 in VESA-EEDID-A2.pdf specs
|
|
color_characteristics => [
|
|
# Rx1 Rx0 Ry1 Ry0 Gx1 Gx0 Gy1 Gy0
|
|
[8, 'white_point_red_green'],
|
|
# Bx1 Bx0 By1 By0 Wx1 Wx0 Wy1 Wy0
|
|
[8, 'white_point_blue_white'],
|
|
[8, 'red_x'],
|
|
[8, 'red_y'],
|
|
[8, 'green_x'],
|
|
[8, 'green_y'],
|
|
[8, 'blue_x'],
|
|
[8, 'blue_y'],
|
|
[8, 'white_x'],
|
|
[8, 'white_y'],
|
|
],
|
|
);
|
|
my @cea_video_mode_to_detailed_timing = (
|
|
'pixel_clock',
|
|
'horizontal_active',
|
|
'vertical_active',
|
|
'aspect',
|
|
'horizontal_blanking',
|
|
'horizontal_sync_offset',
|
|
'horizontal_sync_pulse_width',
|
|
'vertical_blanking',
|
|
'vertical_sync_offset',
|
|
'vertical_sync_pulse_width',
|
|
'horizontal_sync_positive',
|
|
'vertical_sync_positive',
|
|
'interlaced'
|
|
);
|
|
my @cea_video_modes = (
|
|
# [0] pixel clock, [1] X, [2] Y, [3] aspect, [4] Hblank, [5] Hsync_offset, [6] Hsync_pulse_width,
|
|
# [7] Vblank, [8] Vsync_offset, [9] Vsync_pulse_width, [10] Hsync+, [11] Vsync+, [12] interlaced
|
|
# 59.94/29.97 and similar modes also have a 60.00/30.00 counterpart by raising the pixel clock
|
|
[ 25.175, 640, 480, "4/3", 160, 16, 96, 45, 10, 2, 0, 0, 0 ], # 1: 640x 480@59.94
|
|
[ 27.000, 720, 480, "4/3", 138, 16, 62, 45, 9, 6, 0, 0, 0 ], # 2: 720x 480@59.94
|
|
[ 27.000, 720, 480, "16/9", 138, 16, 62, 45, 9, 6, 0, 0, 0 ], # 3: 720x 480@59.94
|
|
[ 74.250, 1280, 720, "16/9", 370, 110, 40, 30, 5, 5, 1, 1, 0 ], # 4: 1280x 720@60.00
|
|
[ 74.250, 1920, 1080, "16/9", 280, 88, 44, 45, 4, 10, 1, 1, 1 ], # 5: 1920x1080@30.00
|
|
[ 27.000, 1440, 480, "4/3", 276, 38, 124, 45, 8, 6, 0, 0, 1 ], # 6: 1440x 480@29.97
|
|
[ 27.000, 1440, 480, "16/9", 276, 38, 124, 45, 8, 6, 0, 0, 1 ], # 7: 1440x 480@29.97
|
|
[ 27.000, 1440, 240, "4/3", 276, 38, 124, 22, 4, 3, 0, 0, 0 ], # 8: 1440x 240@60.05
|
|
[ 27.000, 1440, 240, "16/9", 276, 38, 124, 22, 4, 3, 0, 0, 0 ], # 9: 1440x 240@60.05
|
|
[ 54.000, 2880, 480, "4/3", 552, 76, 248, 45, 8, 6, 0, 0, 1 ], # 10: 2880x 480@29.97
|
|
[ 54.000, 2880, 480, "16/9", 552, 76, 248, 45, 8, 6, 0, 0, 1 ], # 11: 2880x 480@29.97
|
|
[ 54.000, 2880, 240, "4/3", 552, 76, 248, 22, 4, 3, 0, 0, 0 ], # 12: 2880x 240@60.05
|
|
[ 54.000, 2880, 240, "16/9", 552, 76, 248, 22, 4, 3, 0, 0, 0 ], # 13: 2880x 240@60.05
|
|
[ 54.000, 1440, 480, "4/3", 276, 32, 124, 45, 9, 6, 0, 0, 0 ], # 14: 1440x 480@59.94
|
|
[ 54.000, 1440, 480, "16/9", 276, 32, 124, 45, 9, 6, 0, 0, 0 ], # 15: 1440x 480@59.94
|
|
[ 148.500, 1920, 1080, "16/9", 280, 88, 44, 45, 4, 5, 1, 1, 0 ], # 16: 1920x1080@60.00
|
|
[ 27.000, 720, 576, "4/3", 144, 12, 64, 49, 5, 5, 0, 0, 0 ], # 17: 720x 576@50.00
|
|
[ 27.000, 720, 576, "16/9", 144, 12, 64, 49, 5, 5, 0, 0, 0 ], # 18: 720x 576@50.00
|
|
[ 74.250, 1280, 720, "16/9", 700, 440, 40, 30, 5, 5, 1, 1, 0 ], # 19: 1280x 720@50.00
|
|
[ 74.250, 1920, 1080, "16/9", 720, 528, 44, 45, 4, 10, 1, 1, 1 ], # 20: 1920x1080@25.00
|
|
[ 27.000, 1440, 576, "4/3", 288, 24, 126, 49, 4, 6, 0, 0, 1 ], # 21: 1440x 576@25.00
|
|
[ 27.000, 1440, 576, "16/9", 288, 24, 126, 49, 4, 6, 0, 0, 1 ], # 22: 1440x 576@25.00
|
|
[ 27.000, 1440, 288, "4/3", 288, 24, 126, 24, 2, 3, 0, 0, 0 ], # 23: 1440x 288@50.08
|
|
[ 27.000, 1440, 288, "16/9", 288, 24, 126, 24, 2, 3, 0, 0, 0 ], # 24: 1440x 288@50.08
|
|
[ 54.000, 2880, 576, "4/3", 576, 48, 252, 49, 4, 6, 0, 0, 1 ], # 25: 2880x 576@25.00
|
|
[ 54.000, 2880, 576, "16/9", 576, 48, 252, 49, 4, 6, 0, 0, 1 ], # 26: 2880x 576@25.00
|
|
[ 54.000, 2880, 288, "4/3", 576, 48, 252, 24, 2, 3, 0, 0, 0 ], # 27: 2880x 288@50.08
|
|
[ 54.000, 2880, 288, "16/9", 576, 48, 252, 24, 2, 3, 0, 0, 0 ], # 28: 2880x 288@50.08
|
|
[ 54.000, 1440, 576, "4/3", 288, 24, 128, 49, 5, 5, 0, 0, 0 ], # 29: 1440x 576@50.00
|
|
[ 54.000, 1440, 576, "16/9", 288, 24, 128, 49, 5, 5, 0, 0, 0 ], # 30: 1440x 576@50.00
|
|
[ 148.500, 1920, 1080, "16/9", 720, 528, 44, 45, 4, 5, 1, 1, 0 ], # 31: 1920x1080@50.00
|
|
[ 74.250, 1920, 1080, "16/9", 830, 638, 44, 45, 4, 5, 1, 1, 0 ], # 32: 1920x1080@24.00
|
|
[ 74.250, 1920, 1080, "16/9", 720, 528, 44, 45, 4, 5, 1, 1, 0 ], # 33: 1920x1080@25.00
|
|
[ 74.250, 1920, 1080, "16/9", 280, 88, 44, 45, 4, 5, 1, 1, 0 ], # 34: 1920x1080@30.00
|
|
[ 108.000, 2880, 480, "4/3", 552, 64, 248, 45, 9, 6, 0, 0, 0 ], # 35: 2880x 480@59.94
|
|
[ 108.000, 2880, 480, "16/9", 552, 64, 248, 45, 9, 6, 0, 0, 0 ], # 36: 2880x 480@59.94
|
|
[ 108.000, 2880, 576, "4/3", 576, 48, 256, 49, 5, 5, 0, 0, 0 ], # 37: 2880x 576@50.00
|
|
[ 108.000, 2880, 576, "16/9", 576, 48, 256, 49, 5, 5, 0, 0, 0 ], # 38: 2880x 576@50.00
|
|
[ 72.000, 1920, 1080, "16/9", 384, 32, 168, 170, 46, 10, 1, 0, 1 ], # 39: 1920x1080@25.00
|
|
[ 148.500, 1920, 1080, "16/9", 720, 528, 44, 45, 4, 10, 1, 1, 1 ], # 40: 1920x1080@50.00
|
|
[ 148.500, 1280, 720, "16/9", 700, 440, 40, 30, 5, 5, 1, 1, 0 ], # 41: 1280x 720@100.00
|
|
[ 54.000, 720, 576, "4/3", 144, 12, 64, 49, 5, 5, 0, 0, 0 ], # 42: 720x 576@100.00
|
|
[ 54.000, 720, 576, "16/9", 144, 12, 64, 49, 5, 5, 0, 0, 0 ], # 43: 720x 576@100.00
|
|
[ 54.000, 1440, 576, "4/3", 288, 24, 126, 49, 4, 6, 0, 0, 0 ], # 44: 1440x 576@50.00
|
|
[ 54.000, 1440, 576, "16/9", 288, 24, 126, 49, 4, 6, 0, 0, 0 ], # 45: 1440x 576@50.00
|
|
[ 148.500, 1920, 1080, "16/9", 280, 88, 44, 45, 4, 10, 1, 1, 1 ], # 46: 1920x1080@60.00
|
|
[ 148.500, 1280, 720, "16/9", 370, 110, 40, 30, 5, 5, 1, 1, 0 ], # 47: 1280x 720@120.00
|
|
[ 54.000, 720, 480, "4/3", 138, 16, 62, 45, 9, 6, 0, 0, 0 ], # 48: 720x 480@119.88
|
|
[ 54.000, 720, 480, "16/9", 138, 16, 62, 45, 9, 6, 0, 0, 0 ], # 49: 720x 480@119.88
|
|
[ 54.000, 1440, 480, "4/3", 276, 38, 124, 45, 8, 6, 0, 0, 1 ], # 50: 1440x 480@59.94
|
|
[ 54.000, 1440, 480, "16/9", 276, 38, 124, 45, 8, 6, 0, 0, 1 ], # 51: 1440x 480@59.94
|
|
[ 108.000, 720, 576, "4/3", 144, 12, 64, 49, 5, 5, 0, 0, 0 ], # 52: 720x 576@200.00
|
|
[ 108.000, 720, 576, "16/9", 144, 12, 64, 49, 5, 5, 0, 0, 0 ], # 53: 720x 576@200.00
|
|
[ 108.000, 1440, 576, "4/3", 288, 24, 126, 49, 4, 6, 0, 0, 1 ], # 54: 1440x 576@100.00
|
|
[ 108.000, 1440, 576, "16/9", 288, 24, 126, 49, 4, 6, 0, 0, 1 ], # 55: 1440x 576@100.00
|
|
[ 108.000, 720, 480, "4/3", 138, 16, 62, 45, 9, 6, 0, 0, 0 ], # 56: 720x 480@239.76
|
|
[ 108.000, 720, 480, "16/9", 138, 16, 62, 45, 9, 6, 0, 0, 0 ], # 57: 720x 480@239.76
|
|
[ 108.000, 1440, 480, "4/3", 276, 38, 124, 45, 8, 6, 0, 0, 1 ], # 58: 1440x 480@119.88
|
|
[ 108.000, 1440, 480, "16/9", 276, 38, 124, 45, 8, 6, 0, 0, 1 ], # 59: 1440x 480@119.88
|
|
[ 59.400, 1280, 720, "16/9", 2020, 1760, 40, 30, 5, 5, 1, 1, 0 ], # 60: 1280x 720@24.00
|
|
[ 74.250, 1280, 720, "16/9", 2680, 2420, 40, 30, 5, 5, 1, 1, 0 ], # 61: 1280x 720@25.00
|
|
[ 74.250, 1280, 720, "16/9", 2020, 1760, 40, 30, 5, 5, 1, 1, 0 ], # 62: 1280x 720@30.00
|
|
[ 297.000, 1920, 1080, "16/9", 280, 88, 44, 45, 4, 5, 1, 1, 0 ], # 63: 1920x1080@120.00
|
|
[ 297.000, 1920, 1080, "16/9", 720, 528, 44, 45, 4, 10, 1, 1, 0 ], # 64: 1920x1080@100.00
|
|
);
|
|
# Exist but IDs Unknown: Pixio, AOpen (AON?), AORUS [probably GBT], Deco Gear,
|
|
# Eyoyo, GAEMS, GeChic, KOORUI, Lilliput, Mobile Pixels, Nexanic, SunFounder,
|
|
# TECNII, TPEKKA, V7/VSEVEN,
|
|
# Guesses: KYY=KYY, MSI=MSI, KOE=Kaohsiung Opto Electronics
|
|
# PGS: Princeton Graphic Systems; SDC: Samsung Display Co;
|
|
# SIS: Silicon Integrated Systems; STN: Samsung Electronics America;
|
|
# BDS: Barco Display Systems
|
|
# TAI: Toshiba America
|
|
# HIQ: Hitachi ImageQuest or Kaohsiung Opto Electronics? or does Imagequest make hitachi:
|
|
# NVD: Nvidia or NewVisionDisplay?
|
|
my %vendors = (
|
|
'AAC' => 'AcerView', 'ACI' => 'Asus', 'ACR' => 'Acer', 'ACT' => 'Targa', 'ADI' => 'ADI',
|
|
'AIC' => 'AG Neovo', 'AMW' => 'AMW', 'ANX' => 'Acer Netxix', 'AOC' => 'AOC', 'API' => 'A Plus Info',
|
|
'APP' => 'Apple', 'ART' => 'ArtMedia', 'AST' => 'AST Research', 'AUO' => 'AU Optronics',
|
|
'BEL' => 'Beltronic', 'BMM' => 'BMM', 'BNQ' => 'BenQ', 'BOE' => 'BOE Display', 'BDS' => 'Barco',
|
|
'CHO' => 'Sichuang Changhong', 'CMN' => 'ChiMei InnoLux', 'CMO' => 'Chi Mei Optoelectronics',
|
|
'CPL' => 'Compal/ALFA', 'CPQ' => 'Compaq', 'CPT' => 'Chungwa Picture Tubes', 'CTX' => 'CTX (Chuntex)', 'CVT' => 'DGM',
|
|
'DEC' => 'DEC', 'DEL' => 'Dell', 'DON' => 'Denon', 'DPC' => 'Delta', 'DPL' => 'Digital Projection', 'DWE' => 'Daewoo',
|
|
'ECS' => 'Elitegroup', 'EIZ' => 'EIZO', 'ELS' => 'ELSA', 'ENC' => 'EIZO NANAO', 'EPI' => 'Envision', 'ETR' => 'Rotel',
|
|
'FCM' => 'Funai', 'FUJ' => 'Fujitsu', 'FUS' => 'Fujitsu Siemens',
|
|
'GBT' => 'Gigabyte', 'GFN' => 'Gefen', 'GSM' => 'LG (GoldStar)', 'GWY' => 'Gateway 2000',
|
|
'HEI' => 'Hyundai.', 'HIQ' => 'Hyundai ImageQuest', 'HIT' => 'Hitachi', 'HPN' => 'HP',
|
|
'HSD' => 'HannSpree/HannStar', 'HSL' => 'Hansol', 'HTC' => 'Hitachi/Nissei', 'HVR' => 'Hitachi',
|
|
'HWP' => 'HP', 'HWV' => 'Huawei',
|
|
'IBM' => 'IBM', 'ICL' => 'Fujitsu ICL', 'IFS' => 'InFocus', 'INO' => 'Innolab Pte', 'IQT' => 'Hyundai',
|
|
'IVM' => 'Idek Iiyama', 'IVO' => 'InfoVision Optronics/Kunshan',
|
|
'KDS' => 'Korea Data Systems (KDS)', 'KFC' => 'KFC Computek', 'KOE' => 'Kaohsiung OptoElectronics',
|
|
'KTC' => 'Kingston', 'KYY' => 'KYY',
|
|
'LCD' => 'Toshiba Matsushita', 'LEN' => 'Lenovo', 'LGD' => 'LG Display', 'LKM' => 'Adlas/Azalea',
|
|
'LNK' => 'LINK', 'LPL' => 'LG Philips', 'LTN' => 'Lite-On',
|
|
'MAG' => 'MAG InnoVision', 'MAX' => 'Belinea/Maxdata', 'MED' => 'Medion',
|
|
'MEI' => 'Panasonic', 'MEL' => 'Mitsubishi', 'MIR' => 'Miro', 'MSI' => 'MSI', 'MTC' => 'MITAC',
|
|
'NAN' => 'NANAO/EIZO', 'NEX' => 'Nexgen Mediatech', 'NCP' => 'Najing CEC Panda', 'NEC' => 'NEC',
|
|
'NOK' => 'Nokia', 'NVD' => 'Nvidia',
|
|
'ONK' => 'Onkyo', 'OPT' => 'Optoma','OQI' => 'ViewSonic Optiquest', 'ORN' => 'Orion',
|
|
'PBN' => 'Packard Bell', 'PCK' => 'Daewoo', 'PDC' => 'Polaroid', 'PGS' => 'Princeton',
|
|
'PHL' => 'Philips', 'PIO' => 'Pioneer', 'PNR' => 'Planar', 'PRT' => 'Princeton',
|
|
'QDI' => 'Quantum Data', 'QDS' => 'Quanta Display', 'REL' => 'Relisys', 'REN' => 'Renesas',
|
|
'SAM' => 'Samsung', 'SAN' => 'Sanyo', 'SBI' => 'Smarttech', 'SDC' => 'Samsung', 'SEC' => 'Seiko Epson',
|
|
'SEN' => 'Sensics', 'SHP' => 'Sharp', 'SGD' => 'Sigma Designs', 'SGI' => 'SGI', 'SHI' => 'Jiangsu Shinco',
|
|
'SII' => 'Silicon Image', 'SIS' => 'SIS', 'SKM' => 'Guangzhou Teclast', 'SMC' => 'Samtron',
|
|
'SMI' => 'Smile', 'SNI' => 'Siemens Nixdorf', 'SNY' => 'Sony', 'SPT' => 'Sceptre',
|
|
'SRC' => 'Shamrock', 'STN' => 'Samsung', 'STP' => 'Sceptre', 'SUN' => 'Sun Microsystems', 'SYN' => 'Synaptics',
|
|
'TAI' => 'Toshiba', 'TAT' => 'Tatung', 'TOS' => 'Toshiba', 'TRL' => 'Royal Information',
|
|
'TSB' => 'Toshiba', 'UEG' => 'EliteGroup', 'UNM' => 'Unisys',
|
|
'VIT' => 'Visitech', 'VLV' => 'Valve', 'VSC' => 'ViewSonic', 'VTK' => 'Viewteck', 'VTS' => 'VTech',
|
|
'WTC' => 'Wen Technology', 'XLX' => 'Xilinx', 'YMH' => 'Yamaha', 'ZCM' => 'Zenith',
|
|
);
|
|
|
|
sub _within_limit {
|
|
my ($value, $type, $limit) = @_;
|
|
$type eq 'min' ? $value >= $limit : $value <= $limit;
|
|
}
|
|
|
|
sub _get_many_bits {
|
|
my ($s, $field_name) = @_;
|
|
my @bits = split('', unpack('B*', $s));
|
|
my %h;
|
|
foreach (@{$subfields{$field_name}}) {
|
|
my ($size, $field) = @$_;
|
|
my @l = ('0' x (8 - $size), splice(@bits, 0, $size));
|
|
if ($field && $field !~ /^_/){
|
|
$h{$field} = unpack("C", pack('B*', join('', @l)));
|
|
# spec: chromacity: 0.xyz: white_point see color_characteristics
|
|
if ($h{$field} && $field_name eq 'color_characteristics'){
|
|
$h{$field} = ($field =~ /_[xy]$/) ? sprintf('%0.3f',$h{$field}/255) : [@l[1..8]];
|
|
}
|
|
}
|
|
}
|
|
\%h;
|
|
}
|
|
|
|
sub _build_detailed_timing {
|
|
my ($pixel_clock, $vv) = @_;
|
|
my $h = _get_many_bits($vv, 'detailed_timing');
|
|
$h->{pixel_clock} = $pixel_clock / 100; # to have it in MHz
|
|
my %detailed_timing_field_size = map { $_->[1], $_->[0] } @{$subfields{detailed_timing}};
|
|
foreach my $field (keys %detailed_timing_field_size) {
|
|
$field =~ s/_hi$// or next;
|
|
my $hi = delete($h->{$field . '_hi'});
|
|
$h->{$field} += $hi << $detailed_timing_field_size{$field};
|
|
}
|
|
$h;
|
|
}
|
|
|
|
sub _add_standard_timing_modes {
|
|
my ($edid, $v) = @_;
|
|
my @aspect2ratio = (
|
|
$edid->{edid_version} > 1 || $edid->{edid_revision} > 2 ? '16/10' : '1/1',
|
|
'4/3', '5/4', '16/9',
|
|
);
|
|
$v = [ map {
|
|
my $h = _get_many_bits($_, 'standard_timing');
|
|
$h->{X} = ($h->{X} + 31) * 8;
|
|
if ($_ ne "\x20\x20" && $h->{X} > 256){ # cf VALID_TIMING in Xorg edid.h
|
|
$h->{vfreq} += 60;
|
|
if ($h->{ratio} = $aspect2ratio[$h->{aspect}]){
|
|
delete $h->{aspect};
|
|
$h->{Y} = $h->{X} / eval($h->{ratio});
|
|
}
|
|
$h;
|
|
}
|
|
else { () }
|
|
} unpack('a2' x (length($v) / 2), $v) ];
|
|
$v;
|
|
}
|
|
|
|
sub parse_edid {
|
|
eval $start if $b_log;
|
|
my ($raw_edid, $verbose) = @_;
|
|
my (%edid, @warnings);
|
|
my ($main_edid, @eedid_blocks) = unpack("a128" x (length($raw_edid) / 128), $raw_edid);
|
|
my @vals = unpack(join('', map { $_->[0] } @edid_info), $main_edid);
|
|
my $i = 0;
|
|
foreach (@edid_info) {
|
|
my ($field, $v) = ($_->[1], $vals[$i++]);
|
|
if ($field eq 'year'){
|
|
$v += 1990;
|
|
}
|
|
elsif ($field eq 'manufacturer_name'){
|
|
my $h = _get_many_bits($v, 'manufacturer_name');
|
|
$v = join('', map { chr(ord('A') + $h->{$_} - 1) } 1 .. 3);
|
|
$v = "" if $v eq "@@@";
|
|
$edid{'manufacturer_name_nice'} = ($v && $vendors{$v}) ? $vendors{$v} : '';
|
|
}
|
|
elsif ($field eq 'video_input_definition'){
|
|
$v = _get_many_bits($v, 'video_input_definition');
|
|
}
|
|
elsif ($field eq 'feature_support'){
|
|
$v = _get_many_bits($v, 'feature_support');
|
|
}
|
|
elsif ($field eq 'color_characteristics'){
|
|
$v = _get_many_bits($v, 'color_characteristics');
|
|
}
|
|
elsif ($field eq 'established_timings'){
|
|
my $h = _get_many_bits($v, 'established_timings');
|
|
$v = [
|
|
sort { $a->{X} <=> $b->{X} || $a->{vfreq} <=> $b->{vfreq} }
|
|
map { /(\d+)x(\d+)_(\d+)(i?)/ ? { X => $1, Y => $2, vfreq => $3, $4 ? (interlace => 1) : () } : () }
|
|
grep { $h->{$_} } keys %$h ];
|
|
}
|
|
elsif ($field eq 'standard_timings'){
|
|
$v = _add_standard_timing_modes(\%edid, $v);
|
|
}
|
|
elsif ($field eq 'monitor_details'){
|
|
while ($v){
|
|
(my $pixel_clock, my $vv, $v) = unpack("v a16 a*", $v);
|
|
if ($pixel_clock){
|
|
# detailed timing
|
|
my $h = _build_detailed_timing($pixel_clock, $vv);
|
|
push @{$edid{detailed_timings}}, $h
|
|
if $h->{horizontal_active} > 1 && $h->{vertical_active} > 1;
|
|
}
|
|
else {
|
|
(my $flag, $vv) = unpack("n x a*", $vv);
|
|
if ($flag == 0xfd){
|
|
# range
|
|
$edid{monitor_range} = _get_many_bits($vv, 'monitor_range');
|
|
if ($edid{monitor_range}{pixel_clock_max} == 0xff){
|
|
delete $edid{monitor_range}{pixel_clock_max};
|
|
}
|
|
else {
|
|
$edid{monitor_range}{pixel_clock_max} *= 10; #- to have it in MHz
|
|
}
|
|
}
|
|
elsif ($flag == 0xf){
|
|
my $range = _get_many_bits($vv, 'manufacturer_specified_range_timing');
|
|
my $e = $edid{detailed_timings}[0];
|
|
my $valid = 1;
|
|
foreach my $m ('min', 'max') {
|
|
my %total;
|
|
foreach my $dir ('horizontal', 'vertical'){
|
|
$range->{$dir . '_sync_pulse_width_' . $m} *= 2;
|
|
$range->{$dir . '_back_porch_' . $m} *= 2;
|
|
$range->{$dir . '_blanking_' . $m} *= 2;
|
|
if ($e && $e->{$dir . '_active'}
|
|
&& _within_limit($e->{$dir . '_blanking'}, $m, $range->{$dir . '_blanking_' . $m})
|
|
&& _within_limit($e->{$dir . '_sync_pulse_width'}, $m, $range->{$dir . '_sync_pulse_width_' . $m})
|
|
&& _within_limit($e->{$dir . '_blanking'} - $e->{$dir . '_sync_offset'} - $e->{$dir . '_sync_pulse_width'},
|
|
$m, $range->{$dir . '_back_porch_' . $m})){
|
|
$total{$dir} = $e->{$dir . '_active'} + $range->{$dir . '_blanking_' . $m};
|
|
}
|
|
}
|
|
if ($total{horizontal} && $total{vertical}){
|
|
my $hfreq = $e->{pixel_clock} * 1000 / $total{horizontal};
|
|
my $vfreq = $hfreq * 1000 / $total{vertical};
|
|
$range->{'horizontal_' . ($m eq 'min' ? 'max' : 'min')} = _round($hfreq);
|
|
$range->{'vertical_' . ($m eq 'min' ? 'max' : 'min')} = _round($vfreq);
|
|
}
|
|
else {
|
|
$valid = 0;
|
|
}
|
|
}
|
|
$edid{$valid ? 'monitor_range' : 'manufacturer_specified_range_timing'} = $range;
|
|
}
|
|
elsif ($flag == 0xfa){
|
|
push @{$edid{standard_timings}}, _add_standard_timing_modes(\%edid, unpack('a12', $vv));
|
|
}
|
|
elsif ($flag == 0xfc){
|
|
my $prev = $edid{monitor_name};
|
|
$edid{monitor_name} = ($prev ? "$prev " : '') . unpack('A13', $vv);
|
|
}
|
|
elsif ($flag == 0xfe){
|
|
push @{$edid{monitor_text}}, unpack('A13', $vv);
|
|
}
|
|
elsif ($flag == 0xff){
|
|
push @{$edid{serial_number2}}, unpack('A13', $vv);
|
|
}
|
|
elsif ($vv ne "\0" x 13 && $vv ne " " x 13){
|
|
push(@warnings, "parse_edid: unknown flag $flag");
|
|
warn "$warnings[-1]\n" if $verbose;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
$edid{$field} = $v if $field && $field !~ /^_/;
|
|
}
|
|
foreach (@eedid_blocks){
|
|
my ($tag, $v) = unpack("C a*", $_);
|
|
if ($tag == 0x02){ # CEA EDID
|
|
my $dtd_offset;
|
|
($dtd_offset, $v) = unpack("x C x a*", $v);
|
|
next if $dtd_offset < 4;
|
|
$dtd_offset -= 4;
|
|
while ($dtd_offset > 0){
|
|
if (!$v){
|
|
push(@warnings, "parse_edid: DTD offset outside of available data");
|
|
warn "$warnings[-1]\n" if $verbose;
|
|
last;
|
|
}
|
|
my $h = _get_many_bits($v, 'cea_data_block_collection');
|
|
$dtd_offset -= $h->{size} + 1;
|
|
my $vv;
|
|
($vv, $v) = unpack("x a$h->{size} a*", $v);
|
|
if ($h->{type} == 0x02){ # Video Data Block
|
|
my @vmodes = unpack("a" x $h->{size}, $vv);
|
|
foreach my $vmode (@vmodes){
|
|
$h = _get_many_bits($vmode, 'cea_video_data_block');
|
|
my $cea_mode = $cea_video_modes[$h->{mode} - 1];
|
|
if (!$cea_mode){
|
|
push(@warnings, "parse_edid: unhandled CEA mode $h->{mode}");
|
|
warn "$warnings[-1]\n" if $verbose;
|
|
next;
|
|
}
|
|
my %det_mode = (source => 'cea_vdb');
|
|
@det_mode{@cea_video_mode_to_detailed_timing} = @$cea_mode;
|
|
push @{$edid{detailed_timings}}, \%det_mode;
|
|
}
|
|
}
|
|
}
|
|
while (length($v) >= 18){
|
|
(my $pixel_clock, my $vv, $v) = unpack("v a16 a*", $v);
|
|
last if !$pixel_clock;
|
|
my $h = _build_detailed_timing($pixel_clock, $vv);
|
|
push @{$edid{detailed_timings}}, $h
|
|
if $h->{horizontal_active} > 1 && $h->{vertical_active} > 1;
|
|
}
|
|
}
|
|
else {
|
|
push(@warnings, "parse_edid: unknown tag $tag");
|
|
warn "$warnings[-1]\n" if $verbose;
|
|
}
|
|
}
|
|
$edid{max_size_precision} = 'cm';
|
|
if ($edid{product_code}){
|
|
$edid{product_code_h} = sprintf('%04x', $edid{product_code});
|
|
if ($edid{manufacturer_name}){
|
|
$edid{EISA_ID} = $edid{manufacturer_name} . $edid{product_code_h};
|
|
}
|
|
$edid{product_code_h} = '0x'. $edid{product_code_h};
|
|
}
|
|
if ($edid{monitor_range}){
|
|
$edid{HorizSync} = $edid{monitor_range}{horizontal_min} . '-' . $edid{monitor_range}{horizontal_max};
|
|
$edid{VertRefresh} = $edid{monitor_range}{vertical_min} . '-' . $edid{monitor_range}{vertical_max};
|
|
}
|
|
if ($edid{max_size_vertical}){
|
|
$edid{ratio} = $edid{max_size_horizontal} / $edid{max_size_vertical};
|
|
$edid{ratio_name} = _ratio_name($edid{max_size_horizontal}, $edid{max_size_vertical}, 'cm');
|
|
$edid{ratio_precision} = 'cm';
|
|
}
|
|
if ($edid{feature_support}{has_preferred_timing} && $edid{detailed_timings}[0]){
|
|
$edid{detailed_timings}[0]{preferred} = 1;
|
|
}
|
|
foreach my $h (@{$edid{detailed_timings}}){
|
|
# EDID standard is ambiguous on how interlaced modes should be
|
|
# specified; workaround clearly broken modes:
|
|
if ($h->{interlaced}){
|
|
foreach ("720x480", "1440x480", "2880x480", "720x576", "1440x576", "2880x576", "1920x1080"){
|
|
if ($_ eq $h->{horizontal_active} . 'x' . $h->{vertical_active} * 2){
|
|
$h->{vertical_active} *= 2;
|
|
$h->{vertical_blanking} *= 2;
|
|
$h->{vertical_sync_offset} *= 2;
|
|
$h->{vertical_sync_pulse_width} *= 2;
|
|
$h->{vertical_blanking} |= 1;
|
|
}
|
|
}
|
|
}
|
|
# if the mm size given in the detailed_timing is not far from the cm size
|
|
# put it as a more precise cm size
|
|
my %in_cm = (
|
|
horizontal => _define($h->{horizontal_image_size}) / 10,
|
|
vertical => _define($h->{vertical_image_size}) / 10,
|
|
);
|
|
my ($error) = sort { $b <=> $a } map { abs($edid{'max_size_' . $_} - $in_cm{$_}) } keys %in_cm;
|
|
if ($error <= 0.5){
|
|
$edid{'max_size_' . $_} = $in_cm{$_} foreach keys %in_cm;
|
|
$edid{max_size_precision} = 'mm';
|
|
}
|
|
if ($error < 1 && $in_cm{vertical}){
|
|
# using it for the ratio
|
|
$edid{ratio} = $in_cm{horizontal} / $in_cm{vertical};
|
|
$edid{ratio_name} = _ratio_name($in_cm{horizontal}, $in_cm{vertical}, 'mm');
|
|
$edid{ratio_precision} = 'mm';
|
|
}
|
|
if ($edid{ratio_precision} &&
|
|
abs($edid{ratio} - $h->{horizontal_active} / $h->{vertical_active}) > ($edid{ratio_precision} eq 'mm' ? 0.02 : 0.2)){
|
|
$h->{bad_ratio} = 1;
|
|
}
|
|
if ($edid{ratio_name}){
|
|
$edid{ratios} = $edid{ratio_name};
|
|
$edid{ratios} =~ s|/|:|g;
|
|
$edid{ratios} = [split(/ or /, $edid{ratios})]; # "3/2 or 16/10"
|
|
}
|
|
if ($edid{max_size_vertical}){
|
|
$h->{vertical_dpi} = $h->{vertical_active} / $edid{max_size_vertical} * 2.54;
|
|
}
|
|
if ($edid{max_size_horizontal}){
|
|
$h->{horizontal_dpi} = $h->{horizontal_active} / $edid{max_size_horizontal} * 2.54;
|
|
}
|
|
if ($h->{horizontal_image_size}){
|
|
$h->{horizontal_image_size_i} = sprintf('%.2f',($h->{horizontal_image_size}/25.4)) + 0;
|
|
}
|
|
if ($h->{vertical_image_size}){
|
|
$h->{vertical_image_size_i} = sprintf('%.2f',($h->{vertical_image_size}/25.4)) + 0;
|
|
}
|
|
my $dpi_string = '';
|
|
if ($h->{vertical_dpi} && $h->{horizontal_dpi}){
|
|
$dpi_string =
|
|
abs($h->{vertical_dpi} / $h->{horizontal_dpi} - 1) < 0.05 ?
|
|
sprintf("%d dpi", $h->{horizontal_dpi}) :
|
|
sprintf("%dx%d dpi", $h->{horizontal_dpi}, $h->{vertical_dpi});
|
|
}
|
|
my $horizontal_total = $h->{horizontal_active} + $h->{horizontal_blanking};
|
|
my $vertical_total = $h->{vertical_active} + $h->{vertical_blanking};
|
|
no warnings 'uninitialized';
|
|
$h->{ModeLine_comment} = sprintf(qq(# Monitor %s%s modeline (%.1f Hz vsync, %.1f kHz hsync, %sratio %s%s)),
|
|
$h->{preferred} ? "preferred" : "supported",
|
|
$h->{source} eq 'cea_vdb' ? " CEA" : '',
|
|
$h->{pixel_clock} / $horizontal_total / $vertical_total * 1000 * 1000 * ($h->{interlaced} ? 2 : 1),
|
|
$h->{pixel_clock} / $horizontal_total * 1000,
|
|
$h->{interlaced} ? "interlaced, " : '',
|
|
_nearest_ratio($h->{horizontal_active} / $h->{vertical_active}, 0.01) || sprintf("%.2f", $h->{horizontal_active} / $h->{vertical_active}),
|
|
$dpi_string ? ", $dpi_string" : '');
|
|
|
|
$h->{ModeLine} = sprintf(qq("%dx%d" $h->{pixel_clock} %d %d %d %d %d %d %d %d %shsync %svsync%s),
|
|
$h->{horizontal_active}, $h->{vertical_active},
|
|
$h->{horizontal_active},
|
|
$h->{horizontal_active} + $h->{horizontal_sync_offset},
|
|
$h->{horizontal_active} + $h->{horizontal_sync_offset} + $h->{horizontal_sync_pulse_width},
|
|
$horizontal_total,
|
|
$h->{vertical_active},
|
|
$h->{vertical_active} + $h->{vertical_sync_offset},
|
|
$h->{vertical_active} + $h->{vertical_sync_offset} + $h->{vertical_sync_pulse_width},
|
|
$vertical_total,
|
|
$h->{horizontal_sync_positive} ? '+' : '-',
|
|
$h->{vertical_sync_positive} ? '+' : '-',
|
|
$h->{interlaced} ? ' Interlace' : '');
|
|
}
|
|
$edid{diagonal_size} = sqrt(_sqr($edid{max_size_horizontal}) + _sqr($edid{max_size_vertical})) / 2.54;
|
|
# we want to use null data found tests so only return errors/warnings if
|
|
# %edid or if verbose, since then we want to know no matter what.
|
|
if (%edid || $verbose){
|
|
_edid_errors(\%edid);
|
|
$edid{edid_warnings} = \@warnings if @warnings;
|
|
}
|
|
eval $end if $b_log;
|
|
\%edid;
|
|
}
|
|
|
|
sub _edid_errors {
|
|
my $edid = shift @_;
|
|
if (!defined $edid->{edid_version}){
|
|
_edid_error($edid,'edid-version','undefined');
|
|
}
|
|
elsif ($edid->{edid_version} < 1 || $edid->{edid_version} > 2){
|
|
_edid_error($edid,'edid-version',$edid->{edid_version});
|
|
}
|
|
if (!defined $edid->{edid_revision}){
|
|
_edid_error($edid,'edid-revision','undefined');
|
|
}
|
|
elsif ($edid->{edid_revision} == 0xff){
|
|
_edid_error($edid,'edid-revision',$edid->{edid_revision});
|
|
}
|
|
if ($edid->{monitor_range}){
|
|
if (!$edid->{monitor_range}{horizontal_min}){
|
|
_edid_error($edid,'edid-sync','no horizontal');
|
|
}
|
|
elsif ($edid->{monitor_range}{horizontal_min} > $edid->{monitor_range}{horizontal_max}){
|
|
_edid_error($edid,'edid-sync',
|
|
"bad horizontal values: min: $edid->{monitor_range}{horizontal_min} max: $edid->{monitor_range}{horizontal_max}");
|
|
}
|
|
if (!$edid->{monitor_range}{vertical_min}){
|
|
_edid_error($edid,'edid-sync','no vertical');
|
|
}
|
|
elsif ($edid->{monitor_range}{vertical_min} > $edid->{monitor_range}{vertical_max}){
|
|
_edid_error($edid,'edid-sync',
|
|
"bad vertical values: min: $edid->{monitor_range}{vertical_min} max: $edid->{monitor_range}{vertical_max}");
|
|
}
|
|
}
|
|
}
|
|
|
|
sub _edid_error {
|
|
my ($edid,$error,$data) = @_;
|
|
$edid->{edid_errors} = [] if !$edid->{edid_errors};
|
|
push(@{$edid->{edid_errors}},main::message($error,$data));
|
|
}
|
|
|
|
sub _nearest_ratio {
|
|
my ($ratio, $max_error) = @_;
|
|
my @sorted =
|
|
sort { $a->[1] <=> $b->[1] }
|
|
map {
|
|
my $error = abs($ratio - eval($_));
|
|
$error > $max_error ? () : [ $_, $error ];
|
|
} @known_ratios;
|
|
$sorted[0][0];
|
|
}
|
|
|
|
sub _ratio_name {
|
|
my ($horizontal, $vertical, $precision) = @_;
|
|
if ($precision eq 'mm'){
|
|
_nearest_ratio($horizontal / $vertical, 0.1);
|
|
}
|
|
else {
|
|
my $error = 0.5;
|
|
my $ratio1 = _nearest_ratio(($horizontal + $error) / ($vertical - $error), 0.2);
|
|
my $ratio2 = _nearest_ratio(($horizontal - $error) / ($vertical + $error), 0.2);
|
|
$ratio1 && $ratio2 or return;
|
|
if ($ratio1 eq $ratio2){
|
|
$ratio1;
|
|
}
|
|
else {
|
|
my $ratio = _nearest_ratio($horizontal / $vertical, 0.2);
|
|
join(' or ', $ratio, $ratio eq $ratio1 ? $ratio2 : $ratio1);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub _define {
|
|
defined $_[0] ? $_[0] : 0;
|
|
}
|
|
|
|
sub _sqr {
|
|
$_[0] * $_[0];
|
|
}
|
|
|
|
sub _round {
|
|
int($_[0] + 0.5);
|
|
}
|
|
}
|
|
|
|
## PartitionData - set/get
|
|
# for /proc/partitions only, see DiskDataBSD for BSD partition data.
|
|
{
|
|
package PartitionData;
|
|
|
|
sub set {
|
|
my ($type) = @_;
|
|
$loaded{'partition-data'} = 1;
|
|
if (my $file = $system_files{'proc-partitions'}){
|
|
proc_data($file);
|
|
}
|
|
}
|
|
|
|
# args: 0: partition name, without /dev, like sda1, sde
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my $item = $_[0];
|
|
return if !@proc_partitions;
|
|
my $result;
|
|
foreach my $device (@proc_partitions){
|
|
if ($device->[3] eq $item){
|
|
$result = $device;
|
|
last;
|
|
}
|
|
}
|
|
eval $start if $b_log;
|
|
return ($result) ? $result : [];
|
|
}
|
|
|
|
sub proc_data {
|
|
eval $start if $b_log;
|
|
my $file = $_[0];
|
|
if ($fake{'partitions'}){
|
|
# $file = "$fake_data_dir/block-devices/proc-partitions/proc-partitions-1.txt";
|
|
}
|
|
my @parts = main::reader($file,'strip');
|
|
# print Data::Dumper::Dumper \@parts;
|
|
shift @parts if @parts; # get rid of headers
|
|
for (@parts){
|
|
my @temp = split(/\s+/, $_);
|
|
next if !defined $temp[2];
|
|
push (@proc_partitions,[$temp[0],$temp[1],$temp[2],$temp[3]]);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
}
|
|
|
|
# args: 0: pci device string; 1: pci cleaned subsystem string
|
|
sub get_pci_vendor {
|
|
eval $start if $b_log;
|
|
my ($device, $subsystem) = @_;
|
|
return if !$subsystem;
|
|
my ($vendor,$sep) = ('','');
|
|
# get rid of any [({ type characters that will make regex fail
|
|
# and similar matches show as non-match
|
|
my @data = split(/\s+/, clean_regex($subsystem));
|
|
foreach my $word (@data){
|
|
# AMD Tahiti PRO [Radeon HD 7950/8950 OEM / R9 280]
|
|
# PC Partner Limited / Sapphire Technology Tahiti PRO [Radeon HD 7950/8950 OEM / R9 280]
|
|
# $word =~ s/(\+|\$|\?|\^|\*)/\\$1/g;
|
|
if (length($word) == 1 || $device !~ m|\b\Q$word\E\b|i){
|
|
$vendor .= $sep . $word;
|
|
$sep = ' ';
|
|
}
|
|
else {
|
|
last;
|
|
}
|
|
}
|
|
# just in case we had a standalone last character after done
|
|
$vendor =~ s| [/\(\[\{a\.,-]$|| if $vendor;
|
|
eval $end if $b_log;
|
|
return $vendor;
|
|
}
|
|
|
|
# $rows, $num by ref.
|
|
sub get_pcie_data {
|
|
eval $start if $b_log;
|
|
my ($bus_id,$j,$rows,$num,$type) = @_;
|
|
$type ||= '';
|
|
# see also /sys/class/drm/
|
|
my $path_start = '/sys/bus/pci/devices/0000:';
|
|
return if !$bus_id || ! -d $path_start . $bus_id;
|
|
$path_start .= $bus_id;
|
|
my $path = $path_start . '/{max_link_width,current_link_width,max_link_speed';
|
|
$path .= ',current_link_speed}';
|
|
my @files = globber($path);
|
|
if ($type eq 'gpu'){
|
|
$path = $path_start . '/0000*/0000*/{mem_info_vram_used,mem_info_vram_total}';
|
|
push(@files,globber($path));
|
|
}
|
|
# print @files,"\n";
|
|
return if !@files;
|
|
my (%data,$name);
|
|
my %gen = (
|
|
'2.5 GT/s' => 1,
|
|
'5 GT/s' => 2,
|
|
'8 GT/s' => 3,
|
|
'16 GT/s' => 4,
|
|
'32 GT/s' => 5,
|
|
'64 GT/s' => 6,
|
|
);
|
|
foreach (@files){
|
|
if (-r $_){
|
|
$name = $_;
|
|
$name =~ s|^/.*/||;
|
|
$data{$name} = reader($_,'strip',0);
|
|
if ($name eq 'max_link_speed' || $name eq 'current_link_speed'){
|
|
$data{$name} =~ s/\.0\b| PCIe$//g; # trim .0 off in 5.0, 8.0
|
|
}
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \%data;
|
|
# Maximum PCIe Bandwidth = SPEED * WIDTH * (1 - ENCODING) - 1Gb/s.
|
|
if ($data{'current_link_speed'} && $data{'current_link_width'}){
|
|
$$rows[$j]->{key($$num++,1,2,'pcie')} = '';
|
|
if ($b_admin && $gen{$data{'current_link_speed'}}){
|
|
$$rows[$j]{key($$num++,0,3,'gen')} = $gen{$data{'current_link_speed'}};
|
|
}
|
|
$$rows[$j]{key($$num++,0,3,'speed')} = $data{'current_link_speed'};
|
|
$$rows[$j]->{key($$num++,0,3,'lanes')} = $data{'current_link_width'};
|
|
if ($b_admin && (($data{'max_link_speed'} &&
|
|
$data{'max_link_speed'} ne $data{'current_link_speed'}) ||
|
|
($data{'max_link_width'} &&
|
|
$data{'max_link_width'} ne $data{'current_link_width'}))){
|
|
$$rows[$j]->{key($$num++,1,3,'link-max')} = '';
|
|
if ($data{'max_link_speed'} &&
|
|
$data{'max_link_speed'} ne $data{'current_link_speed'}){
|
|
$$rows[$j]{key($$num++,0,4,'gen')} = $gen{$data{'max_link_speed'}};
|
|
$$rows[$j]->{key($$num++,0,4,'speed')} = $data{'max_link_speed'};
|
|
}
|
|
if ($data{'max_link_width'} &&
|
|
$data{'max_link_width'} ne $data{'current_link_width'}){
|
|
$$rows[$j]->{key($$num++,0,4,'lanes')} = $data{'max_link_width'};
|
|
}
|
|
}
|
|
}
|
|
if ($type eq 'gpu' && $data{'mem_info_vram_used'} && $data{'mem_info_vram_total'}){
|
|
$$rows[$j]->{key($$num++,1,2,'vram')} = '';
|
|
$$rows[$j]->{key($$num++,0,3,'total')} = get_size($data{'mem_info_vram_total'}/1024,'string');
|
|
my $used = get_size($data{'mem_info_vram_used'}/1024,'string');
|
|
$used .= ' (' . sprintf('%0.1f',($data{'mem_info_vram_used'}/$data{'mem_info_vram_total'}*100)) . '%)';
|
|
$$rows[$j]->{key($$num++,0,3,'used')} = $used;
|
|
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_ps_aux {
|
|
eval $start if $b_log;
|
|
my ($header,$ps,@temp);
|
|
# note: some ps cut off output based on terminal width
|
|
# ww sets width unlimited
|
|
$loaded{'ps-aux'} = 1;
|
|
$ps = grabber("ps wwaux 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);
|
|
}
|
|
$ps_cols = $#temp; # the indexes, not the scalar count
|
|
if ($ps_cols < 10){
|
|
my $version = qx(ps --version 2>&1);
|
|
$b_busybox_ps = 1 if $version =~ /busybox/i;
|
|
}
|
|
return if !@$ps; # note: mips/openwrt ps has no 'a'
|
|
for (@$ps){
|
|
next if !$_;
|
|
next if $self_name eq 'inxi' && /\/$self_name\b/;
|
|
$_ = lc;
|
|
push (@ps_aux,$_);
|
|
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;
|
|
# handle case of ps wrapping lines despite ww unlimited width, which
|
|
# should NOT be happening, but is.
|
|
next if !defined $split[$ps_cols];
|
|
if ($split[$ps_cols] !~ /^\[/){
|
|
push(@ps_cmd,join(' ', @split[$ps_cols .. $final]));
|
|
}
|
|
}
|
|
# never, because ps loaded before option handler
|
|
# print Dumper \@ps_cmd; # if $dbg[5];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_ps_gui {
|
|
eval $start if $b_log;
|
|
$loaded{'ps-gui'} = 1;
|
|
my ($b_wl,$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(2bwm 3dwm 9wm afterstep aewm aewm\+\+ amiwm antiwm awesome
|
|
blackbox bspwm calmwm catwm cde (sh|c?lisp).*clfswm ctwm (openbsd-)?cwm
|
|
dwm evilwm
|
|
fluxbox flwm flwm_topside fvwm.*-crystal fvwm1 fvwm2 fvwm3 fvwm95 fvwm
|
|
herbstluftwm i3 icewm instantwm ion3 jbwm jwm larswm leftwm lwm
|
|
matchbox-window-manager mcwm mini monsterwm musca mwm nawm notion
|
|
openbox nscde pekwm penrose python.*qtile qvwm ratpoison
|
|
sawfish scrotwm snapwm spectrwm (sh|c?lisp).*stumpwm
|
|
tinywm tvtwm twm uwm windowlab WindowMaker wingo wm2 wmfs wmfs2 wmii2 wmii
|
|
wmx xfdesktop xmonad yeahwm);
|
|
push(@match,@temp);
|
|
$b_wl = 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.
|
|
if ($show{'system'} && $extra > 1){
|
|
@temp=qw(budgie-wm compiz deepin-wm gala gnome-shell
|
|
twin kwin_wayland kwin_x11 kwinft kwin marco
|
|
deepin-metacity metacity metisse mir muffin deepin-mutter mutter
|
|
ukwm xfwm[45]?);
|
|
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 i3-status(-rs)? icewmtray
|
|
kdocker kicker latte latte-dock lemonbar ltpanel luastatus lxpanel lxqt-panel
|
|
matchbox-panel mate-panel nwg-bar nwg-dock nwg-panel ourico
|
|
perlpanel plank plasma-desktop plasma-netbook polybar pypanel
|
|
razor-panel razorqt-panel rootbar
|
|
sfwbar stalonetray swaybar taskbar tint2 trayer
|
|
ukui-panel vala-panel wapanel waybar wbar wharf wingpanel witray
|
|
xfce[45]?-panel xmobar yambar yabar);
|
|
push(@match,@temp);
|
|
}
|
|
# compositors (for wayland these are also the server, note.
|
|
# for wayland always show, so always load these
|
|
if ($show{'graphic'}){
|
|
@temp=qw(3dwm budgie-wm cairo compiz compton cosmic-comp deepin-wm dcompmgr
|
|
enlightenment gala gnome-shell kmscon kwin_wayland kwin_x11 kwinft kwin
|
|
marco metisse mir moblin muffin mutter picom steamcompmgr
|
|
ukwm unagi unity-system-compositor wayland xcompmgr xfwm[45]?);
|
|
push(@match,@temp);
|
|
$b_wl = 1;
|
|
}
|
|
uniq(\@match);
|
|
my $matches = join('|', @match);
|
|
if ($b_wl){
|
|
# wayland compositors generally are compositors and wm.
|
|
# These will be used globally to avoid having to redo it over and over.
|
|
$wl_compositors = '|' . join('|',qw(asc awc
|
|
cage cagebreak cardboard chameleonwm clayland comfc
|
|
dwc dwl epd-wm fireplace feathers fenestra glass gamescope greenfield grefson
|
|
hikari hopalong hyprland inaban japokwm kiwmi labwc laikawm lipstick liri
|
|
mahogany marina maze motorcar newm nucleus orbital perceptia phoc pywm qtile
|
|
river rootston rustland simulavr skylight smithay sommelier sway swc swvkc
|
|
tabby taiwins tinybox tinywl trinkster velox vimway vivarium
|
|
wavy waybox way-?cooler wayfire wayhouse waymonad westeros westford
|
|
weston wio\+? wxr[cd] xuake));
|
|
$matches .= $wl_compositors;
|
|
}
|
|
$matches = qr/$matches/; # remember qr/../i only added perl 5.014
|
|
foreach (@ps_cmd){
|
|
if (/^(|[\S]*\/)($matches)(\/|\s|$)/){
|
|
$working = $2;
|
|
push(@ps_gui, $working); # deal with duplicates with uniq
|
|
}
|
|
}
|
|
uniq(\@ps_gui) if @ps_gui;
|
|
print Dumper \@ps_gui if $dbg[5];
|
|
log_data('dump','@ps_gui',\@ps_gui) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_self_version {
|
|
eval $start if $b_log;
|
|
my $patch = $self_patch;
|
|
if ($patch ne ''){
|
|
# for cases where it was for example: 00-b1 clean to -b1
|
|
$patch =~ s/^[0]+-?//;
|
|
$patch = "-$patch" if $patch;
|
|
}
|
|
eval $end if $b_log;
|
|
return $self_version . $patch;
|
|
}
|
|
|
|
## ServiceData
|
|
{
|
|
package ServiceData;
|
|
my ($key,$service,$type);
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
($type,$service) = @_;
|
|
my $value;
|
|
set() if !$loaded{'service-tool'};
|
|
$key = (keys %service_tool)[0] if %service_tool;
|
|
if ($key){
|
|
if ($type eq 'status'){
|
|
$value = process_status();
|
|
}
|
|
elsif ($type eq 'tool'){
|
|
$value = $service_tool{$key}->[1];
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $value;
|
|
}
|
|
|
|
sub process_status {
|
|
eval $start if $b_log;
|
|
my ($cmd,$status,@data);
|
|
my ($result,$value) = ('','');
|
|
my %translate = (
|
|
'active' => 'running',
|
|
'down' => 'stopped',
|
|
'fail' => 'not found',
|
|
'failed' => 'not found',
|
|
'inactive' => 'stopped',
|
|
'ok' => 'running',
|
|
'not running' => 'stopped',
|
|
'run' => 'running',
|
|
'started' => 'running',
|
|
);
|
|
if ($key eq 'systemctl'){
|
|
$cmd = "$service_tool{$key}->[0] status $service";
|
|
}
|
|
# can be /etc/init.d or /etc/rc.d; ghostbsd/gentoo have this
|
|
elsif ($key eq 'rc-service'){
|
|
$cmd = "$service_tool{$key}->[0] $service status";
|
|
}
|
|
elsif ($key eq 'rcctl'){
|
|
$cmd = "$service_tool{$key}->[0] check $service";
|
|
}
|
|
# dragonfly/netbsd/freebsd have this. We prefer service over following since
|
|
# if it is present, the assumption is that it is being used, though multi id
|
|
# is probably better.
|
|
elsif ($key eq 'service'){
|
|
$cmd = "$service_tool{$key}->[0] $service status";
|
|
}
|
|
# upstart, legacy, and finit, needs more data
|
|
elsif ($key eq 'initctl' || $key eq 'dinitctl'){
|
|
$cmd = "$service_tool{$key}->[0] status $service";
|
|
}
|
|
# runit
|
|
elsif ($key eq 'sv'){
|
|
$cmd = "$service_tool{$key}->[0] status $service";
|
|
}
|
|
# s6: note, shows s6-rc but uses s6-svstat; -n makes human-readable. Needs
|
|
# real data samples before adding.
|
|
# elsif ($key eq 's6-rc'){
|
|
# $cmd = "$service_tool{$key}->[0] $service";
|
|
# }
|
|
# check or status or onestatus (netbsd)
|
|
elsif ($key eq 'rc.d'){
|
|
if (-e "$service_tool{$key}->[0]$service"){
|
|
$status = ($bsd_type && $bsd_type =~ /(dragonfly)/) ? 'status' : 'check';
|
|
$cmd = "$service_tool{$key}->[0]$service check";
|
|
}
|
|
else {
|
|
$result = 'not found';
|
|
}
|
|
}
|
|
elsif ($key eq 'init.d'){
|
|
if (-e "$service_tool{$key}->[0]$service"){
|
|
$cmd = "$service_tool{$key}->[0]$service status";
|
|
}
|
|
else {
|
|
$result = 'not found';
|
|
}
|
|
}
|
|
@data = main::grabber("$cmd 2>&1",'','strip') if $cmd;
|
|
# @data = ('bluetooth is running.');
|
|
print "key: $key\n", Data::Dumper::Dumper \@data if $dbg[29];
|
|
main::log_data('dump','service @data',\@data) if $b_log;
|
|
for my $row (@data){
|
|
my @working = split(/\s*:\s*/,$row);
|
|
($value) = ('');
|
|
# print "$working[0]::$working[1]\n";
|
|
# Loaded: masked (Reason: Unit sddm.service is masked.)
|
|
if ($working[0] eq 'Loaded'){
|
|
# note: sshd shows ssh for ssh.service
|
|
$working[1] =~ /^(.+?)\s*\(.*?\.service;\s+(\S+?);.*/;
|
|
$result = lc($1) if $1;
|
|
$result = lc($2) if $2; # this will be enabled/disabled
|
|
}
|
|
# Active: inactive (dead)
|
|
elsif ($working[0] eq 'Active'){
|
|
$working[1] =~ /^(.+?)\s*\((\S+?)\).*/;
|
|
$value = lc($1) if $1 && (!$result || $result ne 'disabled');
|
|
$value = $translate{$value} if $value && $translate{$value};
|
|
$result .= ",$value" if ($result && $value);
|
|
last;
|
|
}
|
|
# Status : running
|
|
elsif ($working[0] eq 'Status' || $working[0] eq 'State'){
|
|
$result = lc($working[1]);
|
|
$result = $translate{$result} if $translate{$result};
|
|
last;
|
|
}
|
|
# valid syntax, but service does not exist
|
|
# * rc-service: service 'ntp' does not exist ::
|
|
# dinitctl: service not loaded [whether exists or not]
|
|
elsif ($row =~ /$service.*?(not (exist|(be )?found|loaded)|no such (directory|file)|unrecognized)/i){
|
|
$result = 'not found';
|
|
last;
|
|
}
|
|
# means command directive doesn't exist, we don't know if service exists or not
|
|
# * ntpd: unknown function 'disable' ::
|
|
elsif ($row =~ /unknown (directive|function)|Usage/i){
|
|
last;
|
|
}
|
|
# rc-service: * status: started :: * status: stopped, fail handled in not exist test
|
|
elsif ($working[0] eq '* status' && $working[1]){
|
|
$result = lc($working[1]);
|
|
$result = $translate{$result} if $translate{$result};
|
|
last;
|
|
}
|
|
## start exists status detections
|
|
elsif ($working[0] =~ /\b$service is ([a-z\s]+?)(\s+as\s.*|\s+\.\.\..*)?\.?$/){
|
|
$result = lc($1);
|
|
$result = $translate{$result} if $translate{$result};
|
|
last;
|
|
}
|
|
# runit sv: run/down/fail - fail means not found
|
|
# run: udevd: (pid 631) 641s :: down: sshd: 9s, normally up
|
|
elsif ($working[1] && $working[1] eq $service && $working[0] =~ /^([a-z]+)$/){
|
|
$result = lc($1);
|
|
$result = $translate{$result} if $translate{$result};
|
|
$result = "enabled,$result" if $working[2] && $working[2] =~ /normally up/i;
|
|
}
|
|
# OpenBSD: sshd(ok)
|
|
elsif ($working[0] =~ /\b$service\s*\(([^\)]+)\)/){
|
|
$result = lc($1);
|
|
$result = $translate{$result} if $translate{$result};
|
|
last;
|
|
}
|
|
}
|
|
print "service result: $result\n" if $dbg[29];
|
|
main::log_data('data',"result: $result") if $b_log;
|
|
eval $end if $b_log;
|
|
return $result;
|
|
}
|
|
|
|
sub set {
|
|
eval $start if $b_log;
|
|
$loaded{'service-tool'} = 1;
|
|
my ($path);
|
|
if ($path = main::check_program('systemctl')){
|
|
# systemctl status ssh :: Loaded: / Active:
|
|
%service_tool = ('systemctl' => [$path,'systemctl']);
|
|
}
|
|
elsif ($path = main::check_program('rc-service')){
|
|
# rc-service ssh status :: * status: stopped
|
|
%service_tool = ('rc-service' => [$path,'rc-service']);
|
|
}
|
|
elsif ($path = main::check_program('rcctl')){
|
|
# rc-service ssh status :: * status: stopped
|
|
%service_tool = ('rcctl' => [$path,'rcctl']);
|
|
}
|
|
elsif ($path = main::check_program('service')){
|
|
# service sshd status
|
|
%service_tool = ('service' => [$path,'service']);
|
|
}
|
|
elsif ($path = main::check_program('sv')){
|
|
%service_tool = ('sv' => [$path,'sv']);
|
|
}
|
|
# needs data, never seen output, but report if present
|
|
elsif ($path = main::check_program('s6-svstat')){
|
|
%service_tool = ('s6-rc' => [$path,'s6-rc']);
|
|
}
|
|
elsif ($path = main::check_program('dinitctl')){
|
|
%service_tool = ('dinitctl' => [$path,'dinitctl']);
|
|
}
|
|
# make it last in tools, need more data
|
|
elsif ($path = main::check_program('initctl')){
|
|
%service_tool = ('initctl' => [$path,'initctl']);
|
|
}
|
|
# freebsd does not have 'check', netbsd does not have status
|
|
elsif (-d '/etc/rc.d/'){
|
|
# /etc/rc.d/ssh check :: ssh(ok|failed)
|
|
%service_tool = ('rc.d' => ['/etc/rc.d/','/etc/rc.d']);
|
|
}
|
|
elsif (-d '/etc/init.d/'){
|
|
# /etc/init.d/ssh status :: Loaded: loaded (...)/ Active: active (...)
|
|
%service_tool = ('init.d' => ['/etc/init.d/','/etc/init.d']);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
}
|
|
# $dbg[29] = 1; set_path(); print ServiceData::get('status','bluetooth'),"\n";
|
|
|
|
## ShellData
|
|
{
|
|
package ShellData;
|
|
my $b_debug = 0; # disable all debugger output in case forget to comment out!
|
|
|
|
# Public. This does not depend on using ps -jfp, open/netbsd do not at this
|
|
# point support it, so we only want to use -jp to get parent $ppid set in
|
|
# initialize(). shell_launcher will use -f so it only runs in case we got
|
|
# $pppid. $client{'pppid'} will be used to trigger launcher tests. If started
|
|
# with sshd via ssh user@address 'pinxi -Ia' will show sshd as shell, which is
|
|
# fine, that's what it is.
|
|
sub set {
|
|
eval $start if $b_log;
|
|
my ($cmd,$parent,$pppid,$shell);
|
|
$loaded{'shell-data'} = 1;
|
|
$cmd = "ps -wwp $ppid -o comm= 2>/dev/null";
|
|
$shell = qx($cmd);
|
|
# we'll be using these $client pppid/parent values in shell_launcher()
|
|
$pppid = $client{'pppid'} = get_pppid($ppid);
|
|
$pppid ||= '';
|
|
$client{'pppid'} ||= '';
|
|
# print "sh: $shell\n";
|
|
main::log_data('cmd',$cmd) if $b_log;
|
|
chomp($shell);
|
|
if ($shell){
|
|
# print "shell pre: $shell\n";
|
|
# when run in debugger subshell, would return sh as shell,
|
|
# and parent as perl, that is, pinxi itself, which is actually right.
|
|
# trim leading /.../ off just in case. ps -p should return the name, not path
|
|
# but at least one user dataset suggests otherwise so just do it for all.
|
|
$shell =~ s/^.*\///;
|
|
# NOTE: su -c "inxi -F" results in shell being su
|
|
# but: su - results in $parent being su
|
|
my $i=0;
|
|
$parent = $client{'parent'} = parent_name($pppid) if $pppid;
|
|
$parent ||= '';
|
|
print "1: shell: $shell $ppid parent: $parent $pppid\n" if $b_debug;
|
|
# this will fail in this case: sudo su -c 'inxi -Ia'
|
|
if ($shell =~ /^(doas|login|sudo|su)$/){
|
|
$client{'su-start'} = $shell if $shell ne 'login';
|
|
$shell = $parent if $parent;
|
|
}
|
|
# eg: su to root, then sudo
|
|
elsif ($parent && $client{'parent'} =~ /^(doas|sudo|su)$/){
|
|
$client{'su-start'} = $parent;
|
|
$parent = '';
|
|
}
|
|
print "2: shell: $shell parent: $parent\n" if $b_debug;
|
|
my $working = $ENV{'SHELL'};
|
|
if ($working){
|
|
$working =~ s/^.*\///;
|
|
# a few manual changes for known
|
|
# Note: parent when fizsh shows as zsh but SHELL is fizsh, but other times
|
|
# SHELL is default shell, but in zsh, SHELL is default shell, not zfs
|
|
if ($shell eq 'zsh' && $working eq 'fizsh'){
|
|
$shell = $working;
|
|
}
|
|
}
|
|
# print "3: shell post: $shell working: $working\n";
|
|
# since there are endless shells, we'll keep a list of non program value
|
|
# set shells since there is little point in adding those to program values
|
|
if (shell_test($shell)){
|
|
# do nothing, just leave $shell as is
|
|
}
|
|
# note: not all programs return version data. This may miss unhandled shells!
|
|
elsif ((@app = main::program_data(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 = main::program_data(lc($parent),lc($parent),0)) && $app[0]){
|
|
$shell = $app[0];
|
|
$client{'version'} = $app[1] if $app[1];
|
|
}
|
|
print "shell 5: $shell version: $client{'version'}\n" if $b_debug;
|
|
}
|
|
}
|
|
else {
|
|
$client{'version'} = main::message('unknown-shell');
|
|
}
|
|
print "6: shell not app version: $client{'version'}\n" if $b_debug;
|
|
}
|
|
$client{'version'} ||= '';
|
|
$client{'version'} =~ s/(\(.*|-release|-version)// if $client{'version'};
|
|
$shell =~ s/^[\s-]+|[\s-]+$//g if $shell; # sometimes will be like -sh
|
|
$client{'name'} = lc($shell);
|
|
$client{'name-print'} = $shell;
|
|
print "7: shell: $client{'name-print'} version: $client{'version'}\n" if $b_debug;
|
|
if ($extra > 2 && $working && lc($shell) ne lc($working)){
|
|
if (@app = main::program_data(lc($working))){
|
|
$client{'default-shell'} = $app[0];
|
|
$client{'default-shell-v'} = $app[1];
|
|
$client{'default-shell-v'} =~ s/(\s*\(.*|-release|-version)// if $client{'default-shell-v'};
|
|
}
|
|
else {
|
|
$client{'default-shell'} = $working;
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
# last fallback to catch things like busybox shells
|
|
if (my $busybox = readlink(main::check_program('sh'))){
|
|
if ($busybox =~ m|busybox$|){
|
|
$client{'name'} = 'ash';
|
|
$client{'name-print'} = 'ash (busybox)';
|
|
}
|
|
}
|
|
print "8: shell: $client{'name-print'} version: $client{'version'}\n" if $b_debug;
|
|
if (!$client{'name'}) {
|
|
$client{'name'} = 'shell';
|
|
# handling na here, not on output, so we can test for !$client{'name-print'}
|
|
$client{'name-print'} = 'N/A';
|
|
}
|
|
}
|
|
if (!$client{'su-start'}){
|
|
$client{'su-start'} = 'sudo' if $ENV{'SUDO_USER'};
|
|
$client{'su-start'} = 'doas' if $ENV{'DOAS_USER'};
|
|
}
|
|
if ($parent && $parent eq 'login'){
|
|
$client{'su-start'} = ($client{'su-start'}) ? $client{'su-start'} . ',' . $parent: $parent;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# Public: returns shell launcher, terminal, program, whatever
|
|
# depends on $pppid so only runs if that is set.
|
|
sub shell_launcher {
|
|
eval $start if $b_log;
|
|
my (@data);
|
|
my ($msg,$pppid,$shell_parent) = ('','','');
|
|
$pppid = $client{'pppid'};
|
|
if ($b_log){
|
|
$msg = ($ppid) ? "pppid: $pppid ppid: $ppid": "ppid: undefined";
|
|
main::log_data('data',$msg);
|
|
}
|
|
# print "self parent: $pppid ppid: $ppid\n";
|
|
if ($pppid){
|
|
$shell_parent = $client{'parent'};
|
|
# print "shell parent 1: $shell_parent\n";
|
|
if ($b_log){
|
|
$msg = ($shell_parent) ? "shell parent 1: $shell_parent": "shell parent 1: undefined";
|
|
main::log_data('data',$msg);
|
|
}
|
|
# in case sudo starts inxi, parent is shell (or perl inxi if run by debugger)
|
|
# so: perl (2) started pinxi with sudo (3) in sh (4) in terminal
|
|
my $shells = 'ash|bash|busybox|cicada|csh|dash|doas|elvish|fish|fizsh|ksh|';
|
|
$shells .= 'ksh93|lksh|login|loksh|mksh|nash|oh|oil|osh|pdksh|perl|posh|';
|
|
$shells .= 'su|sudo|tcsh|xonsh|yash|zsh';
|
|
$shells .= shell_test('return');
|
|
my $i = 0;
|
|
print "self::pppid-0: $pppid :: $shell_parent\n" if $b_debug;
|
|
# note that new shells not matched will keep this loop spinning until it ends.
|
|
# All we really can do about that is update with new shell name when we find them.
|
|
while ($i < 8 && $shell_parent && $shell_parent =~ /^($shells)$/){
|
|
# bash > su > parent
|
|
$i++;
|
|
$pppid = get_pppid($pppid);
|
|
$shell_parent = parent_name($pppid);
|
|
print "self::pppid-${i}: $pppid :: $shell_parent\n" if $b_debug;
|
|
if ($b_log){
|
|
$msg = ($shell_parent) ? "parent-$i: $shell_parent": "shell parent $i: undefined";
|
|
main::log_data('data',$msg);
|
|
}
|
|
}
|
|
}
|
|
if ($b_log){
|
|
$pppid ||= '';
|
|
$shell_parent ||= '';
|
|
main::log_data('data',"parents: pppid: $pppid parent-name: $shell_parent");
|
|
}
|
|
eval $end if $b_log;
|
|
return $shell_parent;
|
|
}
|
|
|
|
# args: 0: parent id
|
|
# returns SID/start ID
|
|
sub get_pppid {
|
|
eval $start if $b_log;
|
|
my ($ppid) = @_;
|
|
return 0 if !$ppid;
|
|
# ps -j -fp : some bsds ps do not have -f for PPID, so we can't get the ppid
|
|
my $cmd = "ps -wwjfp $ppid 2>/dev/null";
|
|
main::log_data('cmd',$cmd) if $b_log;
|
|
my @data = main::grabber($cmd);
|
|
# shift @data if @data;
|
|
my $pppid = main::awk(\@data,"$ppid",3,'\s+');
|
|
eval $end if $b_log;
|
|
return $pppid;
|
|
}
|
|
|
|
# args: 0: parent id
|
|
# returns parent command name
|
|
sub parent_name {
|
|
eval $start if $b_log;
|
|
my ($ppid) = @_;
|
|
return '' if !$ppid;
|
|
my ($parent_name);
|
|
my $cmd = "ps -wwjp $ppid 2>/dev/null";
|
|
main::log_data('cmd',$cmd) if $b_log;
|
|
my @data = main::grabber($cmd,'','strip');
|
|
# dump the headers if they exist
|
|
$parent_name = (grep {/$ppid/} @data)[0] if @data;
|
|
if ($parent_name){
|
|
# we don't want to worry about column position, just slice off all
|
|
# the first part before the command
|
|
$parent_name =~ s/^.*[0-9]+:[0-9\.]+\s+//;
|
|
# then get the command
|
|
$parent_name = (split(/\s+/,$parent_name))[0];
|
|
# get rid of /../ path info if present
|
|
$parent_name =~ s|^.*/|| if $parent_name;
|
|
# to work around a ps -p or gnome-terminal bug, which returns
|
|
# gnome-terminal- trim -/_ off start/end; _su, etc, which breaks detections
|
|
$parent_name =~ s/^[_-]|[_-]$//g;
|
|
}
|
|
eval $end if $b_log;
|
|
return $parent_name;
|
|
}
|
|
|
|
# List of program_values non-handled shells, or known to have no version
|
|
# Move shell to set_program_values for print name, or version if available
|
|
# args: 0: return|[shell name to test
|
|
# returns test list OR shell name/''
|
|
sub shell_test {
|
|
my ($test) = @_;
|
|
# these shells are not verified or tested
|
|
my $shells = 'apush|ccsh|ch|esh?|eshell|heirloom|hush|';
|
|
$shells .= 'ion|imrsh|larryshell|mrsh|msh(ell)?|murex|nsh|nu(shell)?|';
|
|
$shells .= 'oksh|psh|pwsh|pysh(ell)?|rush|sash|xsh?|';
|
|
# these shells are tested and have no version info
|
|
$shells .= 'es|rc|scsh|sh';
|
|
return '|' . $shells if $test eq 'return';
|
|
return ($test =~ /^($shells)$/) ? $test : '';
|
|
}
|
|
|
|
# This will test against default IP like: (:0) vs full IP to determine
|
|
# ssh status. Surprisingly easy test? Cross platform
|
|
sub ssh_status {
|
|
eval $start if $b_log;
|
|
my ($b_ssh,$ssh);
|
|
# fred pts/10 2018-03-24 16:20 (:0.0)
|
|
# fred-remote pts/1 2018-03-27 17:13 (43.43.43.43)
|
|
if (my $program = main::check_program('who')){
|
|
$ssh = (main::grabber("$program am i 2>/dev/null"))[0];
|
|
# crude IP validation, v6 ::::::::, v4 x.x.x.x
|
|
if ($ssh && $ssh =~ /\(([:0-9a-f]{8,}|[1-9][\.0-9]{6,})\)$/){
|
|
$b_ssh = 1;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $b_ssh;
|
|
}
|
|
|
|
# If IRC: called if root for -S, -G, or if not in display for user.
|
|
sub console_irc_tty {
|
|
eval $start if $b_log;
|
|
$loaded{'con-irc-tty'} = 1;
|
|
# not set for root in or out of display
|
|
if (defined $ENV{'XDG_VTNR'}){
|
|
$client{'con-irc-tty'} = $ENV{'XDG_VTNR'};
|
|
}
|
|
else {
|
|
# ppid won't work with name, so this is assuming there's only one client running
|
|
# if in display, -G returns vt size, not screen dimensions in rowsxcols.
|
|
$client{'con-irc-tty'} = main::awk(\@ps_aux,'.*\b' . $client{'name'} . '\b.*',7,'\s+');
|
|
$client{'con-irc-tty'} =~ s/^(tty|\?)// if defined $client{'con-irc-tty'};
|
|
}
|
|
$client{'con-irc-tty'} = '' if !defined $client{'con-irc-tty'};
|
|
main::log_data('data',"console-irc-tty:$client{'con-irc-tty'}") if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub tty_number {
|
|
eval $start if $b_log;
|
|
$loaded{'tty-number'} = 1;
|
|
# note: ttyname returns undefined if pinxi is > redirected output
|
|
# variants: /dev/pts/1 /dev/tty1 /dev/ttyp2 /dev/ttyra [hex number a]
|
|
$client{'tty-number'} = POSIX::ttyname(1);
|
|
# but tty direct works fine in that case
|
|
if (!defined $client{'tty-number'} && (my $program = main::check_program('tty'))){
|
|
chomp($client{'tty-number'} = qx($program 2>/dev/null));
|
|
if (defined $client{'tty-number'} && $client{'tty-number'} =~ /^not/){
|
|
undef $client{'tty-number'};
|
|
}
|
|
}
|
|
if (defined $client{'tty-number'}){
|
|
$client{'tty-number'} =~ s/^\/dev\/(tty)?//;
|
|
}
|
|
else {
|
|
$client{'tty-number'} = '';
|
|
}
|
|
# systemd only item, usually same as tty in console, not defined
|
|
# for root or non systemd systems.
|
|
if (defined $ENV{'XDG_VTNR'} && $client{'tty-number'} ne '' &&
|
|
$ENV{'XDG_VTNR'} ne $client{'tty-number'}){
|
|
$client{'tty-number'} = "$client{'tty-number'} (vt $ENV{'XDG_VTNR'})";
|
|
}
|
|
elsif ($client{'tty-number'} eq '' && defined $ENV{'XDG_VTNR'}){
|
|
$client{'tty-number'} = $ENV{'XDG_VTNR'};
|
|
}
|
|
main::log_data('data',"tty:$client{'tty-number'}") if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
}
|
|
|
|
sub set_sysctl_data {
|
|
eval $start if $b_log;
|
|
return if !$alerts{'sysctl'} || $alerts{'sysctl'}->{'action'} ne 'use';
|
|
my (@temp);
|
|
# darwin sysctl has BOTH = and : separators, and repeats data. Why?
|
|
if (!$fake{'sysctl'}){
|
|
# just on odd chance we hit a bsd with /proc/cpuinfo, don't want to
|
|
# sleep 2x
|
|
if ($use{'bsd-sleep'} && !$system_files{'proc-cpuinfo'}){
|
|
if ($b_hires){
|
|
eval 'Time::HiRes::usleep($sleep)';
|
|
}
|
|
else {
|
|
select(undef, undef, undef, $cpu_sleep);
|
|
}
|
|
}
|
|
@temp = grabber($alerts{'sysctl'}->{'path'} . " -a 2>/dev/null");
|
|
}
|
|
else {
|
|
my $file;
|
|
# $file = "$fake_data_dir/bsd/sysctl/obsd_6.1_sysctl_soekris6501_root.txt";
|
|
# $file = "$fake_data_dir/bsd/sysctl/obsd_6.1sysctl_lenovot500_user.txt";
|
|
## matches: compaq: openbsd-dmesg.boot-1.txt
|
|
# $file = "$fake_data_dir/bsd/sysctl/openbsd-5.6-sysctl-1.txt";
|
|
## matches: toshiba: openbsd-5.6-dmesg.boot-1.txt
|
|
# $file = "$fake_data_dir/bsd/sysctl/openbsd-5.6-sysctl-2.txt";
|
|
# $file = "$fake_data_dir/bsd/sysctl/obsd-6.8-sysctl-a-battery-sensor-1.txt";
|
|
# @temp = reader($file);
|
|
}
|
|
foreach (@temp){
|
|
$_ =~ s/\s*=\s*|:\s+/:/;
|
|
$_ =~ s/\"//g;
|
|
push(@{$sysctl{'main'}}, $_);
|
|
# we're building these here so we can use these arrays per feature
|
|
if ($use{'bsd-audio'} && /^hw\.snd\./){
|
|
push(@{$sysctl{'audio'}}, $_); # not used currently, just test data
|
|
}
|
|
# note: we could use ac0 to indicate plugged in but messes with battery output
|
|
elsif ($use{'bsd-battery'} && /^hw\.sensors\.acpi(bat|cmb)/){
|
|
push(@{$sysctl{'battery'}}, $_);
|
|
}
|
|
# hw.cpufreq.temperature: 40780 :: dev.cpu0.temperature
|
|
# hw.acpi.thermal.tz2.temperature: 27.9C :: hw.acpi.thermal.tz1.temperature: 42.1C
|
|
# hw.acpi.thermal.tz0.temperature: 42.1C
|
|
elsif ($use{'bsd-sensor'} &&((/^hw\.sensors/ && !/^hw\.sensors\.acpi(ac|bat|cmb)/ &&
|
|
!/^hw\.sensors\.softraid/) || /^hw\.acpi\.thermal/ || /^dev\.cpu\.[0-9]+\.temp/)){
|
|
push(@{$sysctl{'sensor'}}, $_);
|
|
}
|
|
# Must go AFTER sensor because sometimes freebsd puts sensors in dev.cpu
|
|
# hw.l1dcachesize hw.l2cachesize
|
|
elsif ($use{'bsd-cpu'} && (/^hw\.(busfreq|clock|n?cpu|l[123].?cach|model|smt)/ ||
|
|
/^dev\.cpu/ || /^machdep\.(cpu|hlt_logical_cpus)/)){
|
|
push(@{$sysctl{'cpu'}}, $_);
|
|
}
|
|
# only activate if using the diskname feature in dboot!! note assign to $dboot.
|
|
elsif ($use{'bsd-disk'} && /^hw\.disknames/){
|
|
push(@{$dboot{'disk'}}, $_);
|
|
}
|
|
elsif ($use{'bsd-kernel'} && /^kern.compiler_version/){
|
|
push(@{$sysctl{'kernel'}}, $_);
|
|
}
|
|
elsif ($use{'bsd-machine'} &&
|
|
/^(hw\.|machdep\.dmi\.(bios|board|system)-)(date|product|serial(no)?|uuid|vendor|version)/){
|
|
push(@{$sysctl{'machine'}}, $_);
|
|
}
|
|
# let's rely on dboot, we really just want the hardware specs for solid ID
|
|
# elsif ($use{'bsd-machine'} && !$dboot{'machine-vm'} &&
|
|
# /(\bhvm\b|innotek|\bkvm\b|microsoft.*virtual machine|openbsd[\s-]vmm|qemu|qumranet|vbox|virtio|virtualbox|vmware)/i){
|
|
# push(@{$dboot{'machine-vm'}}, $_);
|
|
# }
|
|
elsif ($use{'bsd-memory'} && /^(hw\.(physmem|usermem)|Free Memory)/){
|
|
push(@{$sysctl{'memory'}}, $_);
|
|
}
|
|
|
|
elsif ($use{'bsd-raid'} && /^hw\.sensors\.softraid[0-9]\.drive[0-9]/){
|
|
push(@{$sysctl{'softraid'}}, $_);
|
|
}
|
|
}
|
|
if ($dbg[7]){
|
|
print("main\n", Dumper $sysctl{'main'});
|
|
print("dboot-machine-vm\n", Dumper $dboot{'machine-vm'});
|
|
print("audio\n", Dumper $sysctl{'audio'});
|
|
print("battery\n", Dumper $sysctl{'battery'});
|
|
print("cpu\n", Dumper $sysctl{'cpu'});
|
|
print("kernel\n", Dumper $sysctl{'kernel'});
|
|
print("machine\n", Dumper $sysctl{'machine'});
|
|
print("memory\n", Dumper $sysctl{'memory'});
|
|
print("sensors\n", Dumper $sysctl{'sensor'});
|
|
print("softraid\n", Dumper $sysctl{'softraid'});
|
|
}
|
|
# this thing can get really long.
|
|
if ($b_log){
|
|
main::log_data('dump','$sysctl{main}',$sysctl{'main'});
|
|
main::log_data('dump','$dboot{machine-vm}',$sysctl{'machine-vm'});
|
|
main::log_data('dump','$sysctl{audio}',$sysctl{'audio'});
|
|
main::log_data('dump','$sysctl{battery}',$sysctl{'battery'});
|
|
main::log_data('dump','$sysctl{cpu}',$sysctl{'cpu'});
|
|
main::log_data('dump','$sysctl{kernel}',$sysctl{'kernel'});
|
|
main::log_data('dump','$sysctl{machine}',$sysctl{'machine'});
|
|
main::log_data('dump','$sysctl{memory}',$sysctl{'memory'});
|
|
main::log_data('dump','$sysctl{sensors}',$sysctl{'sensor'});
|
|
main::log_data('dump','$sysctl{softraid}',$sysctl{'softraid'});
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_uptime {
|
|
eval $start if $b_log;
|
|
my ($days,$hours,$minutes,$seconds,$sys_time,$uptime) = ('','','','','','');
|
|
if (check_program('uptime')){
|
|
$uptime = qx(uptime);
|
|
$uptime = trimmer($uptime);
|
|
if ($fake{'uptime'}){
|
|
# $uptime = '2:58PM up 437 days, 8:18, 3 users, load averages: 2.03, 1.72, 1.77';
|
|
# $uptime = '04:29:08 up 3:18, 3 users, load average: 0,00, 0,00, 0,00';
|
|
# $uptime = '10:23PM up 5 days, 16:17, 1 user, load averages: 0.85, 0.90, 1.00';
|
|
# $uptime = '05:36:47 up 1 day, 3:28, 4 users, load average: 1,88, 0,98, 0,62';
|
|
# $uptime = '05:36:47 up 1 day, 3 min, 4 users, load average: 1,88, 0,98, 0,62';
|
|
# $uptime = '04:41:23 up 2:16, load average: 7.13, 6.06, 3.41 # root openwrt';
|
|
# $uptime = '9:51 PM up 2 mins, 1 user, load average: 0:58, 0.27, 0.11';
|
|
# $uptime = '05:36:47 up 3 min, 4 users, load average: 1,88, 0,98, 0,62';
|
|
# $uptime = '9:51 PM up 49 secs, 1 user, load average: 0:58, 0.27, 0.11';
|
|
# $uptime = '04:11am up 0:00, 1 user, load average: 0.08, 0.03, 0.01'; # openSUSE 13.1 (Bottle)
|
|
# $uptime = '11:21:43 up 1 day 5:53, 4 users, load average: 0.48, 0.62, 0.48'; # openSUSE Tumbleweed 20210515
|
|
}
|
|
if ($uptime){
|
|
# trim off and store system time and up, and cut off user/load data
|
|
$uptime =~ s/^([0-9:])\s*([AP]M)?.+up\s+|,?\s*([0-9]+\suser|load).*$//gi;
|
|
# print "ut: $uptime\n";
|
|
if ($1){
|
|
$sys_time = $1;
|
|
$sys_time .= lc($2) if $2;
|
|
}
|
|
if ($uptime =~ /\b([0-9]+)\s+day[s]?\b/){
|
|
$days = ($1 + 0) . 'd';
|
|
}
|
|
if ($uptime =~ /\b([0-9]{1,2}):([0-9]{1,2})\b/){
|
|
$hours = ($1 + 0) . 'h';
|
|
$minutes = ($2 + 0) . 'm';
|
|
}
|
|
else {
|
|
if ($uptime =~ /\b([0-9]+)\smin[s]?\b/){
|
|
$minutes = ($1 + 0) . 'm';
|
|
}
|
|
if ($uptime =~ /\b([0-9]+)\ssec[s]?\b/){
|
|
$seconds = ($1 + 0) . 's';
|
|
}
|
|
}
|
|
$days .= ' ' if $days && ($hours || $minutes || $seconds);
|
|
$hours .= ' ' if $hours && $minutes;
|
|
$minutes .= ' ' if $minutes && $seconds;
|
|
$uptime = $days . $hours . $minutes . $seconds;
|
|
}
|
|
}
|
|
$uptime ||= 'N/A';
|
|
eval $end if $b_log;
|
|
return $uptime;
|
|
}
|
|
|
|
## UsbData
|
|
# %usb array indexes
|
|
# 0: bus id / sort id
|
|
# 1: device id
|
|
# 2: path_id
|
|
# 3: path
|
|
# 4: class id
|
|
# 5: subclass id
|
|
# 6: protocol id
|
|
# 7: vendor:chip id
|
|
# 8: usb version
|
|
# 9: interfaces
|
|
# 10: ports
|
|
# 11: vendor
|
|
# 12: product
|
|
# 13: device-name
|
|
# 14: type string
|
|
# 15: driver
|
|
# 16: serial
|
|
# 17: speed (bits, Si base 10, [MG]bps)
|
|
# 18: configuration - not used
|
|
# 19: power mW bsd only, not used yet
|
|
# 20: product rev number
|
|
# 21: driver_nu [bsd only]
|
|
# 22: admin usb rev info
|
|
# 23: rx lanes
|
|
# 24: tx lanes
|
|
# 25: speed (Bytes, IEC base 2, [MG]iBs
|
|
# 26: absolute path
|
|
{
|
|
package UsbData;
|
|
my (@working);
|
|
my (@asound_ids,$b_asound,$b_hub,$addr_id,$bus_id,$bus_id_alpha,
|
|
$chip_id,$class_id,$device_id,$driver,$driver_nu,$ids,$interfaces,
|
|
$name,$network_regex,$path,$path_id,$power,$product,$product_id,$protocol_id,
|
|
$mode,$rev,$serial,$speed_si,$speed_iec,$subclass_id,$type,$version,
|
|
$vendor,$vendor_id);
|
|
my $b_live = 1; # debugger file data
|
|
|
|
sub set {
|
|
eval $start if $b_log;
|
|
${$_[0]} = 1; # set checked boolean
|
|
# note: bsd package usbutils has lsusb in it, but we dont' want it for default
|
|
# usbdevs is best, has most data, and runs as user
|
|
if ($alerts{'usbdevs'}->{'action'} eq 'use'){
|
|
usbdevs_data();
|
|
}
|
|
# usbconfig has weak/poor output, and requires root, only fallback
|
|
elsif ($alerts{'usbconfig'}->{'action'} eq 'use'){
|
|
usbconfig_data();
|
|
}
|
|
# if user config sets USB_SYS you can override with --usb-tool
|
|
elsif ((!$force{'usb-sys'} || $force{'lsusb'}) && $alerts{'lsusb'}->{'action'} eq 'use'){
|
|
lsusb_data();
|
|
}
|
|
elsif (-d '/sys/bus/usb/devices'){
|
|
sys_data('main');
|
|
}
|
|
@{$usb{'main'}} = sort {$a->[0] cmp $b->[0]} @{$usb{'main'}} if $usb{'main'};
|
|
if ($b_log){
|
|
main::log_data('dump','$usb{audio}: ',$usb{'audio'});
|
|
main::log_data('dump','$usb{bluetooth}: ',$usb{'bluetooth'});
|
|
main::log_data('dump','$usb{disk}: ',$usb{'disk'});
|
|
main::log_data('dump','$usb{graphics}: ',$usb{'graphics'});
|
|
main::log_data('dump','$usb{network}: ',$usb{'network'});
|
|
}
|
|
if ($dbg[55]){
|
|
print '$usb{audio}: ', Data::Dumper::Dumper $usb{'audio'};
|
|
print '$usb{bluetooth}: ', Data::Dumper::Dumper $usb{'bluetooth'};
|
|
print '$usb{disk}: ', Data::Dumper::Dumper $usb{'disk'};
|
|
print '$usb{graphics}: ', Data::Dumper::Dumper $usb{'graphics'};
|
|
print '$usb{network}: ', Data::Dumper::Dumper $usb{'network'};
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub lsusb_data {
|
|
eval $start if $b_log;
|
|
my (@temp);
|
|
my @data = usb_grabber('lsusb');
|
|
foreach (@data){
|
|
next if /^~$|^Couldn't/; # expensive second call: || /UNAVAIL/
|
|
@working = split(/\s+/, $_);
|
|
next unless defined $working[1] && defined $working[3];
|
|
$working[3] =~ s/:$//;
|
|
# Don't use this fix, the data is garbage in general! Seen FreeBSD lsusb with:
|
|
# Bus /dev/usb Device /dev/ugen0.3: ID 24ae:1003 Shenzhen Rapoo Technology Co., Ltd.
|
|
# hub, note incomplete data: Bus /dev/usb Device /dev/ugen0.1: ID 0000:0000
|
|
# linux:
|
|
# Bus 005 Device 007: ID 0d8c:000c C-Media Electronics, Inc. Audio Adapter
|
|
# if ($working[3] =~ m|^/dev/ugen([0-9]+)\.([0-9]+)|){
|
|
# $working[1] = $1;
|
|
# $working[3] = $2;
|
|
# }
|
|
next unless main::is_numeric($working[1]) && main::is_numeric($working[3]);
|
|
$addr_id = int($working[3]);
|
|
$bus_id = int($working[1]);
|
|
$path_id = "$bus_id-$addr_id";
|
|
$chip_id = $working[5];
|
|
@temp = @working[6..$#working];
|
|
$name = main::remove_duplicates(join(' ', @temp));
|
|
# $type = check_type($name,'','');
|
|
$type ||= '';
|
|
# do NOT set bus_id_alpha here!!
|
|
# print "$name\n";
|
|
$working[0] = $bus_id;
|
|
$working[1] = $addr_id;
|
|
$working[2] = $path_id;
|
|
$working[3] = '';
|
|
$working[4] = '00';
|
|
$working[5] = '';
|
|
$working[6] = '';
|
|
$working[7] = $chip_id;
|
|
$working[8] = '';
|
|
$working[9] = '';
|
|
$working[10] = 0;
|
|
$working[11] = '';
|
|
$working[12] = '';
|
|
$working[13] = $name;
|
|
$working[14] = '';# $type;
|
|
$working[15] = '';
|
|
$working[16] = '';
|
|
$working[17] = '';
|
|
$working[18] = '';
|
|
$working[19] = '';
|
|
$working[20] = '';
|
|
push(@{$usb{'main'}},[@working]);
|
|
# print join("\n",@working),"\n\n=====\n";
|
|
}
|
|
print 'lsusb-pre-sys: ', Data::Dumper::Dumper $usb{'main'} if $dbg[6];
|
|
sys_data('lsusb') if $usb{'main'};
|
|
print 'lsusb-w-sys: ', Data::Dumper::Dumper $usb{'main'} if $dbg[6];
|
|
main::log_data('dump','$usb{main}: plain',$usb{'main'}) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# ugen0.1: <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);
|
|
}
|
|
}
|
|
main::log_data('dump','$usb{main}: usbconfig',$usb{'main'}) if $b_log;
|
|
print 'usbconfig: ', Data::Dumper::Dumper $usb{'main'} if $dbg[6];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# Controller /dev/usb2:
|
|
# addr 1: full speed, self powered, config 1, UHCI root hub(0x0000), Intel(0x8086), rev 1.00
|
|
# port 1 addr 2: full speed, power 98 mA, config 1, USB Receiver(0xc52b), Logitech(0x046d), rev 12.01
|
|
# port 2 powered
|
|
sub usbdevs_data {
|
|
eval $start if $b_log;
|
|
my ($b_multi,$class,$config,$hub_id,$port,$port_value,$product_rev);
|
|
my ($ports) = (0);
|
|
my @data = usb_grabber('usbdevs');
|
|
foreach (@data){
|
|
if ($_ eq '~' && @working){
|
|
$working[10] = $ports;
|
|
push(@{$usb{'main'}},[@working]);
|
|
assign_usb_type([@working]);
|
|
undef @working;
|
|
($config,$driver,$power,$rev) = ('','','','');
|
|
}
|
|
elsif (/^Controller\s\/dev\/usb([0-9]+)/){
|
|
$bus_id = $1;
|
|
}
|
|
elsif (/^addr\s([0-9]+):\s([^,]+),[^,0-9]+([0-9]+ mA)?,\s+config\s+([0-9]+),\s?([^,]+)\(0x([0-9a-f]{4})\),\s?([^,]+)\s?\(0x([0-9a-f]{4})\)/){
|
|
($mode,$rev,$speed_si,$speed_iec) = ();
|
|
$hub_id = $1;
|
|
$addr_id = $1;
|
|
$speed_si = $2; # requires prep
|
|
$power = $3;
|
|
$chip_id = "$6:$8";
|
|
$config = $4;
|
|
$name = main::remove_duplicates("$7 $5");
|
|
# print "p1:$protocol\n";
|
|
$path_id = "$bus_id-$hub_id";
|
|
$bus_id_alpha = bus_id_alpha($path_id);
|
|
$ports = 0;
|
|
process_power(\$power) if $power;
|
|
$port_value = '';
|
|
version_data('bsd',\$speed_si,\$speed_iec,\$rev,\$mode);
|
|
$working[0] = $bus_id_alpha;
|
|
$working[1] = $addr_id;
|
|
$working[2] = $path_id;
|
|
$working[3] = '';
|
|
$working[4] = '09';
|
|
$working[5] = '';
|
|
$working[6] = '';
|
|
$working[7] = $chip_id;
|
|
$working[8] = $rev;
|
|
$working[9] = '';
|
|
$working[10] = $ports;
|
|
$working[13] = $name;
|
|
$working[14] = 'Hub';
|
|
$working[15] = '';
|
|
$working[16] = '';
|
|
$working[17] = $speed_si;
|
|
$working[18] = $config;
|
|
$working[19] = $power;
|
|
$working[20] = '';
|
|
$working[22] = $mode;
|
|
$working[25] = $speed_iec;
|
|
}
|
|
elsif (/^port\s([0-9]+)\saddr\s([0-9]+):\s([^,]+),[^,0-9]*([0-9]+\s?mA)?,\s+config\s+([0-9]+),\s?([^,]+)\(0x([0-9a-f]{4})\),\s?([^,]+)\s?\(0x([0-9a-f]{4})\)/){
|
|
($rev,$mode,$speed_iec,$speed_si) = ();
|
|
$port = $1;
|
|
$addr_id = $2;
|
|
$speed_si = $3;
|
|
$power = $4;
|
|
$config = $5;
|
|
$chip_id = "$7:$9";
|
|
$name = main::remove_duplicates("$8 $6");
|
|
$type = check_type($name,'','');
|
|
$type ||= '';
|
|
# print "p2:$protocol\n";
|
|
$ports++;
|
|
$path_id = "$bus_id-$hub_id.$port";
|
|
$bus_id_alpha = bus_id_alpha($path_id);
|
|
process_power(\$power) if $power;
|
|
version_data('bsd',\$speed_si,\$speed_iec,\$rev,\$mode);
|
|
$working[0] = $bus_id_alpha;
|
|
$working[1] = $addr_id;
|
|
$working[2] = $path_id;
|
|
$working[3] = '';
|
|
$working[4] = '01';
|
|
$working[5] = '';
|
|
$working[6] = '';
|
|
$working[7] = $chip_id;
|
|
$working[8] = $rev;
|
|
$working[9] = '';
|
|
$working[10] = $ports;
|
|
$working[11] = '';
|
|
$working[12] = '';
|
|
$working[13] = $name;
|
|
$working[14] = $type;
|
|
$working[15] = '';
|
|
$working[16] = '';
|
|
$working[17] = $speed_si;
|
|
$working[18] = $config;
|
|
$working[19] = $power;
|
|
$working[20] = '';
|
|
$working[22] = $mode;
|
|
$working[25] = $speed_iec;
|
|
}
|
|
elsif (/^port\s([0-9]+)\spowered/){
|
|
$ports++;
|
|
}
|
|
# newer openbsd usbdevs totally changed their syntax and layout, but it is better...
|
|
elsif (/^addr\s*([0-9a-f]+):\s+([a-f0-9]{4}:[a-f0-9]{4})\s*([^,]+)?(,\s[^,]+?)?,\s+([^,]+)$/){
|
|
$addr_id = $1;
|
|
$chip_id = $2;
|
|
$vendor = main::clean($3) if $3;
|
|
$vendor ||= '';
|
|
$name = main::remove_duplicates("$vendor $5");
|
|
$type = check_type($name,'','');
|
|
$class_id = ($name =~ /hub/i) ? '09': '01';
|
|
$path_id = "$bus_id-$addr_id";
|
|
$bus_id_alpha = bus_id_alpha($path_id);
|
|
$ports = 0;
|
|
$b_multi = 1;
|
|
$working[0] = $bus_id_alpha;
|
|
$working[1] = $addr_id;
|
|
$working[2] = $path_id;
|
|
$working[3] = '';
|
|
$working[4] = $class_id;
|
|
$working[5] = '';
|
|
$working[6] = '';
|
|
$working[7] = $chip_id;
|
|
$working[8] = '';
|
|
$working[9] = '';
|
|
$working[10] = $ports;
|
|
$working[11] = '';
|
|
$working[12] = '';
|
|
$working[13] = $name;
|
|
$working[14] = $type;
|
|
$working[15] = '';
|
|
$working[16] = '';
|
|
$working[17] = '';
|
|
$working[18] = '';
|
|
$working[19] = '';
|
|
$working[20] = '';
|
|
}
|
|
elsif ($b_multi &&
|
|
/^([^,]+),\s+(self powered|power\s+([0-9]+\s+mA)),\s+config\s([0-9]+),\s+rev\s+([0-9\.]+)(,\s+i?Serial\s(\S*))?/i){
|
|
($mode,$rev,$speed_iec,$speed_si) = ();
|
|
$speed_si = $1;
|
|
$power = $3;
|
|
process_power(\$power) if $power;
|
|
version_data('bsd',\$speed_si,\$speed_iec,\$rev,\$mode);
|
|
$working[8] = $rev;
|
|
$working[16] = $7 if $7;
|
|
$working[17] = $speed_si;
|
|
$working[18] = $4; # config number
|
|
$working[19] = $power;
|
|
$working[20] = $5; # product rev
|
|
$working[22] = $mode;
|
|
$working[25] = $speed_iec;
|
|
}
|
|
# 1 or more drivers supported
|
|
elsif ($b_multi && /^driver:\s*([^,]+)$/){
|
|
my $temp = $1;
|
|
$working[4] = '09' if $temp =~ /hub[0-9]/;
|
|
$temp =~ s/([0-9]+)$//;
|
|
$working[21] = $1; # driver nu
|
|
# drivers, note that when numbers trimmed off, drivers can have same name
|
|
$working[15] = ($working[15] && $working[15] !~ /\b$temp\b/) ? "$working[15],$temp" : $temp;
|
|
# now that we have the driver, let's recheck the type
|
|
if (!$type && $name && $working[15]){
|
|
$type = check_type($name,$working[15],'');
|
|
$working[14] = $type if $type;
|
|
}
|
|
}
|
|
elsif ($b_multi && /^port\s[0-9]/){
|
|
$ports++;
|
|
}
|
|
}
|
|
main::log_data('dump','$usb{main}: usbdevs',$usb{'main'}) if $b_log;
|
|
print 'usbdevs: ', Data::Dumper::Dumper $usb{'main'} if $dbg[6];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub usb_grabber {
|
|
eval $start if $b_log;
|
|
my ($program) = @_;
|
|
my ($args,$path,$pattern,@data,@working);
|
|
if ($program eq 'lsusb'){
|
|
$args = '';
|
|
$path = $alerts{'lsusb'}->{'path'};
|
|
$pattern = '^Bus [0-9]';
|
|
}
|
|
elsif ($program eq 'usbconfig'){
|
|
$args = 'dump_device_desc';
|
|
$path = $alerts{'usbconfig'}->{'path'};
|
|
$pattern = '^[a-z_-]+[0-9]+\.[0-9]+:';
|
|
}
|
|
elsif ($program eq 'usbdevs'){
|
|
$args = '-vv';
|
|
$path = $alerts{'usbdevs'}->{'path'};
|
|
$pattern = '^(addr\s[0-9a-f]+:|port\s[0-9]+\saddr\s[0-9]+:)';
|
|
}
|
|
if ($b_live && !$fake{'usbdevs'} && !$fake{'usbconfig'}){
|
|
@data = main::grabber("$path $args 2>/dev/null",'','strip');
|
|
}
|
|
else {
|
|
my $file;
|
|
if ($fake{'usbdevs'}){
|
|
$file = "$fake_data_dir/usb/usbdevs/bsd-usbdevs-v-1.txt";
|
|
}
|
|
elsif ($fake{'usbconfig'}){
|
|
$file = "$fake_data_dir/usb/usbconfig/bsd-usbconfig-list-v-1.txt";
|
|
}
|
|
else {
|
|
$file = "$fake_data_dir/usb/lsusb/mdmarmer-lsusb.txt";
|
|
}
|
|
@data = main::reader($file,'strip');
|
|
}
|
|
if (@data){
|
|
$use{'usb-tool'} = 1 if scalar @data > 2;
|
|
foreach (@data){
|
|
# this is the group separator and assign trigger
|
|
push(@working, '~') if $_ =~ /$pattern/i;
|
|
push(@working, $_);
|
|
}
|
|
push(@working, '~');
|
|
}
|
|
print Data::Dumper::Dumper \@working if $dbg[30];
|
|
eval $end if $b_log;
|
|
return @working;
|
|
}
|
|
|
|
sub sys_data {
|
|
eval $start if $b_log;
|
|
my ($source) = @_;
|
|
my ($configuration,$lanes_rx,$lanes_tx,$ports,$mode,$rev);
|
|
my (@drivers,@uevent);
|
|
my $i = 0;
|
|
my @files = main::globber('/sys/bus/usb/devices/*');
|
|
# we want to get rid of the hubs with x-0: syntax, those are hubs found in /usbx
|
|
@files = grep {!/\/[0-9]+-0:/} @files;
|
|
# print join("\n", @files);
|
|
foreach my $file (@files){
|
|
# be careful, sometimes uevent is not readable
|
|
@uevent = (-r "$file/uevent") ? main::reader("$file/uevent") : undef;
|
|
if (@uevent && ($ids = main::awk(\@uevent,'^(DEVNAME|DEVICE\b)',2,'='))){
|
|
($b_hub,$class_id,$protocol_id,$subclass_id) = (0,0,0,0);
|
|
(@drivers,$lanes_rx,$lanes_tx,$mode,$rev,$speed_iec,$speed_si) = ();
|
|
($configuration,$driver,$interfaces,$name,$ports,$product,$serial,
|
|
$type,$vendor) = ('','','','','','','','','');
|
|
# print Cwd::abs_path($file),"\n";
|
|
# print "f1: $file\n";
|
|
$path_id = $file;
|
|
$path_id =~ s/^.*\///;
|
|
$path_id =~ s/^usb([0-9]+)/$1-0/;
|
|
# if DEVICE= then path = /proc/bus/usb/001/001 else: bus/usb/006/001
|
|
$ids =~ s/^\///;
|
|
@working = split('/', $ids);
|
|
shift @working if $working[0] eq 'proc';
|
|
$bus_id = int($working[2]);
|
|
$bus_id_alpha = bus_id_alpha($path_id);
|
|
$device_id = int($working[3]);
|
|
# this will be a hex number
|
|
$class_id = sys_item("$file/bDeviceClass");
|
|
# $subclass_id = sys_item("$file/bDeviceSubClass");
|
|
# $protocol_id = sys_item("$file/bDeviceProtocol");
|
|
$class_id = hex($class_id) if $class_id;
|
|
# $subclass_id = hex($subclass_id) if $subclass_id;
|
|
# $protocol_id = hex($protocol_id) if $protocol_id;
|
|
# print "$path_id $class_id/$subclass_id/$protocol_id\n";
|
|
$power = sys_item("$file/bMaxPower");
|
|
process_power(\$power) if $power;
|
|
# this populates class, subclass, and protocol id with decimal numbers
|
|
@drivers = uevent_data("$file/[0-9]*/uevent");
|
|
push(@drivers, uevent_data("$file/[0-9]*/*/uevent")) if !$b_hub;
|
|
$ports = sys_item("$file/maxchild") if $b_hub;
|
|
if (@drivers){
|
|
main::uniq(\@drivers);
|
|
$driver = join(',', sort @drivers);
|
|
}
|
|
$interfaces = sys_item("$file/bNumInterfaces");
|
|
$lanes_rx = sys_item("$file/rx_lanes");
|
|
$lanes_tx = sys_item("$file/tx_lanes");
|
|
$serial = sys_item("$file/serial");
|
|
$rev = sys_item("$file/version");
|
|
$speed_si = sys_item("$file/speed");
|
|
version_data('sys',\$speed_si,\$speed_iec,\$rev,\$mode,$lanes_rx,$lanes_tx);
|
|
$configuration = sys_item("$file/configuration");
|
|
$power = sys_item("$file/bMaxPower");
|
|
process_power(\$power) if $power;
|
|
$class_id = sprintf("%02x", $class_id) if defined $class_id && $class_id ne '';
|
|
$subclass_id = sprintf("%02x", $subclass_id) if defined $subclass_id && $subclass_id ne '';
|
|
if ($source eq 'lsusb'){
|
|
for ($i = 0; $i < scalar @{$usb{'main'}}; $i++){
|
|
if ($usb{'main'}->[$i][0] eq $bus_id && $usb{'main'}->[$i][1] == $device_id){
|
|
if (!$b_hub && $usb{'main'}->[$i][13] && (!$type || $type eq '<vendor specific>')){
|
|
$type = check_type($usb{'main'}->[$i][13],$driver,$type);
|
|
}
|
|
$usb{'main'}->[$i][0] = $bus_id_alpha;
|
|
$usb{'main'}->[$i][2] = $path_id;
|
|
$usb{'main'}->[$i][3] = $file;
|
|
$usb{'main'}->[$i][4] = $class_id;
|
|
$usb{'main'}->[$i][5] = $subclass_id;
|
|
$usb{'main'}->[$i][6] = $protocol_id;
|
|
$usb{'main'}->[$i][8] = $rev;
|
|
$usb{'main'}->[$i][9] = $interfaces;
|
|
$usb{'main'}->[$i][10] = $ports if $ports;
|
|
if ($type && $b_hub && (!$usb{'main'}->[$i][13] ||
|
|
$usb{'main'}->[$i][13] =~ /^linux foundation/i)){
|
|
$usb{'main'}->[$i][13] = "$type";
|
|
}
|
|
$usb{'main'}->[$i][14] = $type if ($type && !$b_hub);
|
|
$usb{'main'}->[$i][15] = $driver if $driver;
|
|
$usb{'main'}->[$i][16] = $serial if $serial;
|
|
$usb{'main'}->[$i][17] = $speed_si if $speed_si;
|
|
$usb{'main'}->[$i][18] = $configuration;
|
|
$usb{'main'}->[$i][19] = $power;
|
|
$usb{'main'}->[$i][20] = '';
|
|
$usb{'main'}->[$i][22] = $mode;
|
|
$usb{'main'}->[$i][23] = $lanes_rx;
|
|
$usb{'main'}->[$i][24] = $lanes_tx;
|
|
$usb{'main'}->[$i][25] = $speed_iec if $speed_iec;
|
|
$usb{'main'}->[$i][26] = Cwd::abs_path($file);
|
|
assign_usb_type($usb{'main'}->[$i]);
|
|
# print join("\n",@{$usb{'main'}->[$i]}),"\n\n";# if !$b_hub;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$chip_id = sys_item("$file/idProduct");
|
|
$vendor_id = sys_item("$file/idVendor");
|
|
# we don't want the device, it's probably a bad path in /sys/bus/usb/devices
|
|
next if !$vendor_id && !$chip_id;
|
|
$product = sys_item("$file/product");
|
|
$product = main::clean($product) if $product;
|
|
$vendor = sys_item("$file/manufacturer");
|
|
$vendor = main::clean($vendor) if $vendor;
|
|
if (!$b_hub && ($product || $vendor)){
|
|
if ($vendor && $product && $product !~ /$vendor/){
|
|
$name = "$vendor $product";
|
|
}
|
|
elsif ($product){
|
|
$name = $product;
|
|
}
|
|
elsif ($vendor){
|
|
$name = $vendor;
|
|
}
|
|
}
|
|
elsif ($b_hub){
|
|
$name = $type;
|
|
}
|
|
$name = main::remove_duplicates($name) if $name;
|
|
if (!$b_hub && $name && (!$type || $type eq '<vendor specific>')){
|
|
$type = check_type($name,$driver,$type);
|
|
}
|
|
# this isn't that useful, but save in case something shows up
|
|
# if ($configuration){
|
|
# $name = ($name) ? "$name $configuration" : $configuration;
|
|
# }
|
|
$type = 'Hub' if $b_hub;
|
|
$usb{'main'}->[$i][0] = $bus_id_alpha;
|
|
$usb{'main'}->[$i][1] = $device_id;
|
|
$usb{'main'}->[$i][2] = $path_id;
|
|
$usb{'main'}->[$i][3] = $file;
|
|
$usb{'main'}->[$i][4] = $class_id;
|
|
$usb{'main'}->[$i][5] = $subclass_id;
|
|
$usb{'main'}->[$i][6] = $protocol_id;
|
|
$usb{'main'}->[$i][7] = "$vendor_id:$chip_id";
|
|
$usb{'main'}->[$i][8] = $rev;
|
|
$usb{'main'}->[$i][9] = $interfaces;
|
|
$usb{'main'}->[$i][10] = $ports;
|
|
$usb{'main'}->[$i][11] = $vendor;
|
|
$usb{'main'}->[$i][12] = $product;
|
|
$usb{'main'}->[$i][13] = $name;
|
|
$usb{'main'}->[$i][14] = $type;
|
|
$usb{'main'}->[$i][15] = $driver;
|
|
$usb{'main'}->[$i][16] = $serial;
|
|
$usb{'main'}->[$i][17] = $speed_si;
|
|
$usb{'main'}->[$i][18] = $configuration;
|
|
$usb{'main'}->[$i][19] = $power;
|
|
$usb{'main'}->[$i][20] = '';
|
|
$usb{'main'}->[$i][22] = $mode;
|
|
$usb{'main'}->[$i][23] = $lanes_rx;
|
|
$usb{'main'}->[$i][24] = $lanes_tx;
|
|
$usb{'main'}->[$i][25] = $speed_iec;
|
|
$usb{'main'}->[$i][26] = Cwd::abs_path($file);
|
|
assign_usb_type($usb{'main'}->[$i]);
|
|
$i++;
|
|
}
|
|
# print "$path_id ids: $bus_id:$device_id driver: $driver ports: $ports\n==========\n"; # if $dbg[6];;
|
|
}
|
|
}
|
|
print 'usb-sys: ', Data::Dumper::Dumper $usb{'main'} if $source eq 'main' && $dbg[6];
|
|
main::log_data('dump','$usb{main}: sys',$usb{'main'}) if $source eq 'main' && $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# Get driver, interface [type:] data
|
|
sub uevent_data {
|
|
my ($path) = @_;
|
|
my ($interface,$interfaces,$temp,@interfaces,@drivers);
|
|
my @files = main::globber($path);
|
|
@files = grep {!/\/(subsystem|driver|ep_[^\/]+)\/uevent$/} @files if @files;
|
|
foreach (@files){
|
|
last if $b_hub;
|
|
# print "f2: $_\n";
|
|
($interface) = ('');
|
|
@working = main::reader($_) if -r $_;
|
|
# print join("\n",@working), "\n";
|
|
if (@working){
|
|
$driver = main::awk(\@working,'^DRIVER',2,'=');
|
|
$interface = main::awk(\@working,'^INTERFACE',2,'=');
|
|
if ($interface){
|
|
# for hubs, we need the specific protocol, which is in TYPE
|
|
if ($interface eq '9/0/0' &&
|
|
(my $temp = main::awk(\@working,'^TYPE',2,'='))){
|
|
$interface = $temp;
|
|
}
|
|
# print "$interface\n";
|
|
$interface = device_type($interface);
|
|
if ($interface){
|
|
if ($interface ne '<vendor specific>'){
|
|
push(@interfaces, $interface);
|
|
}
|
|
# networking requires more data but this test is reliable
|
|
elsif (!@interfaces){
|
|
$temp = $_;
|
|
$temp =~ s/\/uevent$//;
|
|
push(@interfaces, 'Network') if -d "$temp/net/";
|
|
}
|
|
if (!@interfaces){
|
|
push(@interfaces, $interface);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# print "driver:$driver\n";
|
|
$b_hub = 1 if $driver && $driver eq 'hub';
|
|
$driver = '' if $driver && ($driver eq 'usb' || $driver eq 'hub');
|
|
push(@drivers,$driver) if $driver;
|
|
}
|
|
if (@interfaces){
|
|
main::uniq(\@interfaces);
|
|
# clear out values like: <vendor specific>,Printer
|
|
if (scalar @interfaces > 1 && (grep {!/^<vendor/} @interfaces) && (grep {/^<vendor/} @interfaces)){
|
|
@interfaces = grep {!/^<vendor/} @interfaces;
|
|
}
|
|
$type = join(',', @interfaces) if @interfaces;
|
|
# print "type:$type\n";
|
|
}
|
|
return @drivers;
|
|
}
|
|
|
|
sub sys_item {
|
|
my ($path) = @_;
|
|
my ($item);
|
|
$item = main::reader($path,'',0) if -r $path;
|
|
$item = '' if ! defined $item;
|
|
$item = main::trimmer($item) if $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>';}
|
|
if (scalar @types == 3){
|
|
$class_id = $types[0];
|
|
$subclass_id = $types[1];
|
|
$protocol_id = $types[2];
|
|
}
|
|
if ($types[0] eq '1'){
|
|
$type = 'audio';}
|
|
elsif ($types[0] eq '2'){
|
|
if ($types[1] eq '2'){
|
|
$type = 'abstract (modem)';}
|
|
elsif ($types[1] eq '6'){
|
|
$type = 'ethernet network';}
|
|
elsif ($types[1] eq '10'){
|
|
$type = 'mobile direct line';}
|
|
elsif ($types[1] eq '12'){
|
|
$type = 'ethernet emulation';}
|
|
else {
|
|
$type = 'communication';}
|
|
}
|
|
elsif ($types[0] eq '3'){
|
|
if ($types[2] eq '0'){
|
|
$type = 'HID';} # actual value: None
|
|
elsif ($types[2] eq '1'){
|
|
$type = 'keyboard';}
|
|
elsif ($types[2] eq '2'){
|
|
$type = 'mouse';}
|
|
}
|
|
elsif ($types[0] eq '6'){
|
|
$type = 'still imaging';}
|
|
elsif ($types[0] eq '7'){
|
|
$type = 'printer';}
|
|
elsif ($types[0] eq '8'){
|
|
$type = 'mass storage';}
|
|
# note: there is a bug in linux kernel that always makes hubs 9/0/0
|
|
elsif ($types[0] eq '9'){
|
|
if ($types[2] eq '0'){
|
|
$type = 'full speed or root hub';}
|
|
elsif ($types[2] eq '1'){
|
|
$type = 'hi-speed hub with single TT';}
|
|
elsif ($types[2] eq '2'){
|
|
$type = 'hi-speed hub with multiple TTs';}
|
|
# seen protocol 3, usb3 type hub, but not documented on usb.org
|
|
elsif ($types[2] eq '3'){
|
|
$type = 'super-speed hub';}
|
|
# this is a guess, never seen it
|
|
elsif ($types[2] eq '4'){
|
|
$type = 'super-speed+ hub';}
|
|
}
|
|
elsif ($types[0] eq '10'){
|
|
$type = 'CDC-data';}
|
|
elsif ($types[0] eq '11'){
|
|
$type = 'smart card';}
|
|
elsif ($types[0] eq '13'){
|
|
$type = 'content security';}
|
|
elsif ($types[0] eq '14'){
|
|
$type = 'video';}
|
|
elsif ($types[0] eq '15'){
|
|
$type = 'personal healthcare';}
|
|
elsif ($types[0] eq '16'){
|
|
$type = 'audio-video';}
|
|
elsif ($types[0] eq '17'){
|
|
$type = 'billboard';}
|
|
elsif ($types[0] eq '18'){
|
|
$type = 'type-C bridge';}
|
|
elsif ($types[0] eq '88'){
|
|
$type = 'Xbox';}
|
|
elsif ($types[0] eq '220'){
|
|
$type = 'diagnostic';}
|
|
elsif ($types[0] eq '224'){
|
|
if ($types[1] eq '1'){
|
|
$type = 'bluetooth';}
|
|
elsif ($types[1] eq '2'){
|
|
if ($types[2] eq '1'){
|
|
$type = 'host wire adapter';}
|
|
elsif ($types[2] eq '2'){
|
|
$type = 'device wire adapter';}
|
|
elsif ($types[2] eq '3'){
|
|
$type = 'device wire adapter';}
|
|
}
|
|
}
|
|
# print "$data: $type\n";
|
|
return $type;
|
|
}
|
|
|
|
# Device name/driver string based test, return <vendor specific> if not detected
|
|
# for linux based tests, and empty for bsd tests
|
|
sub check_type {
|
|
my ($name,$driver,$type) = @_;
|
|
$name = lc($name);
|
|
if (($driver && $driver =~ /hub/) || $name =~ /\b(hub)/i){
|
|
$type = 'Hub';
|
|
}
|
|
elsif ($name =~ /(audio|\bdac[0-9]*\b|(head|micro|tele)phone|hifi|\bmidi\b|\bmic\b|sound)/){
|
|
$type = 'Audio';
|
|
}
|
|
# Broadcom HP Portable SoftSailing
|
|
elsif (($driver && $driver =~ /\b(btusb|ubt)\b/) || $name =~ /(bluetooth)/){
|
|
$type = 'Bluetooth'
|
|
}
|
|
elsif (($driver && $driver =~ /video/) ||
|
|
$name =~ /(camera|display|\bdvb-t|\b(pc)?tv\bvideo|webcam)/){
|
|
$type = 'Video';
|
|
}
|
|
elsif ($name =~ /(wlan|wi-?fi|802\.1[15]|(11|54|108|240|300|433|450|900|1300)\s?mbps|(11|54|108|240)g\b|wireless[\s-][bgn]\b|wireless.*adapter)/){
|
|
$type = 'WiFi';
|
|
}
|
|
# note, until freebsd match to actual drivers, these top level driver matches aren't interesting
|
|
elsif (($driver && $bsd_type && $driver =~ /\b(muge)\b/) ||
|
|
$name =~ /(ethernet|\blan|802\.3|100?\/1000?|gigabit|10\s?G(b|ig)?E)/){
|
|
$type = 'Ethernet';
|
|
}
|
|
# note: audio devices show HID sometimes, not sure why
|
|
elsif ($name =~ /(joystick|keyboard|mouse|trackball)/){
|
|
$type = 'HID';
|
|
}
|
|
elsif (($driver && $driver =~ /^(umass)$/) ||
|
|
$name =~ /\b(disk|drive|flash)\b/){
|
|
$type = 'Mass Storage';
|
|
}
|
|
return $type;
|
|
}
|
|
|
|
# linux only, will create a positive match to sound devices
|
|
sub set_asound_ids {
|
|
$b_asound = 1;
|
|
if (-d '/proc/asound'){
|
|
# note: this will double the data, but it's easier this way.
|
|
# binxi tested for -L in the /proc/asound files, and used only those.
|
|
my @files = main::globber('/proc/asound/*/usbid');
|
|
foreach (@files){
|
|
my $id = main::reader($_,'',0);
|
|
push(@asound_ids, $id) if ($id && !(grep {/$id/} @asound_ids));
|
|
}
|
|
}
|
|
main::log_data('dump','@asound_ids',\@asound_ids) if $b_log;
|
|
}
|
|
|
|
# USB networking search string data, because some brands can have other products
|
|
# than wifi/nic cards, they need further identifiers, with wildcards. Putting
|
|
# the most common and likely first, then the less common, then some specifics
|
|
sub set_network_regex {
|
|
# belkin=050d; d-link=07d1; netgear=0846; ralink=148f; realtek=0bda;
|
|
# Atmel, Atheros make other stuff. NOTE: exclude 'networks': IMC Networks
|
|
# intel, ralink bluetooth as well as networking; (WG|WND?A)[0-9][0-9][0-9] netgear IDs
|
|
$network_regex = 'Ethernet|gigabit|\bISDN|\bLAN\b|Mobile\s?Broadband|';
|
|
$network_regex .= '\bNIC\b|wi-?fi|Wireless[\s-][GN]\b|WLAN|';
|
|
$network_regex .= '802\.(1[15]|3)|(10|11|54|108|240|300|450|1300)\s?Mbps|(11|54|108|240)g\b|100?\/1000?|';
|
|
$network_regex .= '(100?|N)Base-?T\b|';
|
|
$network_regex .= '(Actiontec|AirLink|Asus|Belkin|Buffalo|Dell|D-Link|DWA-|ENUWI-|';
|
|
$network_regex .= 'Ralink|Realtek|Rosewill|RNX-|Samsung|Sony|TEW-|TP-Link|';
|
|
$network_regex .= 'Zonet.*ZEW.*).*Wireless|';
|
|
# Note: Intel Bluetooth wireless interface < should be caught by bluetooth tests
|
|
$network_regex .= '(\bD-Link|Network(ing)?|Wireless).*(Adapter|Interface)|';
|
|
$network_regex .= '(Linksys|Netgear|Davicom)|';
|
|
$network_regex .= 'Range(Booster|Max)|Samsung.*LinkStick|\b(WG|WND?A)[0-9][0-9][0-9]|';
|
|
$network_regex .= '\b(050d:935b|0bda:8189|0bda:8197)\b';
|
|
}
|
|
|
|
# For linux, process rev, get mode. For bsds, get rev, speed.
|
|
# args: 0: sys/bsd; 1: speed_si; 2: speed_iec; 3: rev; 4: rev_info; 5: rx lanes;
|
|
# 6: tx lanes
|
|
# 1,2,3,4 passed by reference.
|
|
sub version_data {
|
|
return if !${$_[1]};
|
|
if ($_[0] eq 'sys'){
|
|
if (${$_[3]} && main::is_numeric(${$_[3]})){
|
|
# as far as we know, 4 will not have subversions, but this may change,
|
|
# check how /sys reports this in coming year(s)
|
|
if (${$_[3]} =~ /^4/){
|
|
${$_[3]} = ${$_[3]} + 0;
|
|
}
|
|
else {
|
|
${$_[3]} = sprintf('%.1f',${$_[3]});
|
|
}
|
|
}
|
|
# BSD rev is synthetic, it's a hack. And no lane data, so not trying.
|
|
if ($b_admin && ${$_[1]} && ${$_[3]} && $_[5] && $_[6] &&
|
|
${$_[3]} =~ /^[1234]/){
|
|
if (${$_[3]} =~ /^[12]/){
|
|
if (${$_[1]} == 1.5){
|
|
${$_[4]} = '1.0';}
|
|
elsif (${$_[1]} == 12){
|
|
${$_[4]} = '1.1';}
|
|
elsif (${$_[1]} == 480){
|
|
${$_[4]} = '2.0';}
|
|
}
|
|
# Note: unless otherwise indicated, 1 lane is 1rx+1tx.
|
|
elsif (${$_[3]} =~ /^3/){
|
|
if (${$_[1]} == 5000){
|
|
${$_[4]} = '3.2 gen-1x1';} # 1 lane
|
|
elsif (${$_[1]} == 10000){
|
|
if ($_[6] == 1){
|
|
${$_[4]} = '3.2 gen-2x1';} # 1 lane
|
|
elsif ($_[6] == 2){
|
|
${$_[4]} = '3.2 gen-1x2';} # 2 lane
|
|
}
|
|
elsif (${$_[1]} == 20000){
|
|
if ($_[6] == 1){
|
|
${$_[4]} = '3.2 gen-3x1';} # 1 lane
|
|
elsif ($_[6] == 2){
|
|
${$_[4]} = '3.2 gen-2x2';} # 2 lane
|
|
}
|
|
# just in case rev: 3.x shows these speeds
|
|
elsif (${$_[1]} == 40000){
|
|
if ($_[6] == 1){
|
|
${$_[4]} = '4-v1 gen-4x1';} # 1 lane
|
|
elsif ($_[6] == 2){
|
|
${$_[4]} = '4-v1 gen-3x2';} # 2 lane
|
|
}
|
|
elsif (${$_[1]} == 80000){
|
|
${$_[4]} = '4-v2 gen-4x2'; # 2 lanes
|
|
}
|
|
${$_[4]} = main::message('usb-mode-mismatch') if !${$_[4]};
|
|
}
|
|
# NOTE: no realworld usb4 data, unclear if these gen are reliable.
|
|
# possible /sys will expose v1/v2/v3. Check future data.
|
|
elsif (${$_[3]} =~ /^4/){
|
|
# gen 2: 10gb x 1 ln
|
|
if (${$_[1]} < 10001){
|
|
${$_[4]} = '4-v1 gen-2x1';} # 1 lane
|
|
# gen2: 10gb x 2 ln; gen3: 20gb x 1 ln. Confirm
|
|
elsif (${$_[1]} < 20001){
|
|
if ($_[6] == 2){
|
|
${$_[4]} = '4-v1 gen-2x2';} # 2 lanes
|
|
elsif ($_[6] == 1){
|
|
${$_[4]} = '4-v1 gen-3x1';} # 1 lane
|
|
}
|
|
# gen3: 20gb x 2 ln; gen4 40gb x 1 ln. Confirm
|
|
elsif (${$_[1]} < 40001){
|
|
if ($_[6] == 2){
|
|
${$_[4]} = '4-v1 gen-3x2';} # 2 lanes
|
|
elsif ($_[6] == 1){
|
|
${$_[4]} = '4-v2 gen-4x1';} # 1 lane
|
|
}
|
|
# 40gb x 2 ln
|
|
elsif (${$_[1]} < 80001){
|
|
${$_[4]} = '4-v2 gen-4x2';} # 2 lanes
|
|
# 3 lanes: 2 tx+tx @ 60gb, 1 rx+rx @ 40gb, wait for data
|
|
elsif (${$_[1]} < 120001){
|
|
${$_[4]} = '4-v2 gen-4x3-asym'; # 3 lanes, asymmetric
|
|
}
|
|
${$_[4]} = main::message('usb-mode-mismatch') if !${$_[4]};
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
(${$_[1]},${$_[3]}) = prep_speed(${$_[1]});
|
|
# bsd rev hardcoded. We want this set to undef if bad data
|
|
${$_[3]} = usb_rev(${$_[1]}) if !${$_[3]};
|
|
}
|
|
# Add Si/IEC units
|
|
if ($extra > 0 && ${$_[1]}){
|
|
# 1 == 1000000 bits
|
|
my $si = ${$_[1]};
|
|
if (${$_[1]} >= 1000){
|
|
${$_[1]} = (${$_[1]}/1000) . ' Gb/s';
|
|
}
|
|
else {
|
|
${$_[1]} = ${$_[1]} . ' Mb/s';
|
|
}
|
|
if ($b_admin){
|
|
$si = (($si*1000**2)/8);
|
|
if ($si < 1000000){
|
|
${$_[2]} = sprintf('%0.0f KiB/s',($si/1024));
|
|
}
|
|
elsif ($si < 1000000000){
|
|
${$_[2]} = sprintf('%0.1f MiB/s',$si/1024**2);
|
|
}
|
|
else {
|
|
${$_[2]} = sprintf('%0.2f GiB/s',($si/1024**3));
|
|
}
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \@_;
|
|
}
|
|
|
|
## BSD SPEED/REV ##
|
|
# Mapping of speed string to known speeds. Unreliable, very inaccurate, and some
|
|
# unconfirmed. Without real data source can never be better than a decent guess.
|
|
# args: 0: speed string
|
|
sub prep_speed {
|
|
return if !$_[0];
|
|
my $speed_si = $_[0];
|
|
my $rev;
|
|
if ($_[0] =~ /^([0-9\.]+)\s*Mb/){
|
|
$speed_si = $1;
|
|
}
|
|
elsif ($_[0] =~ /^([0-9\.]+)+\s*Gb/){
|
|
$speed_si = $1 * 1000;
|
|
}
|
|
elsif ($_[0] =~ /usb4?\s?120/i){
|
|
$speed_si = 120000;# 4 120Gbps
|
|
$rev = '4';
|
|
}
|
|
elsif ($_[0] =~ /usb4?\s?80/i){
|
|
$speed_si = 80000;# 4 80Gbps
|
|
$rev = '4';
|
|
}
|
|
elsif ($_[0] =~ /usb4?\s?40/i){
|
|
$speed_si = 40000;# 4 40Gbps
|
|
$rev = '4';
|
|
}
|
|
elsif ($_[0] =~ /usb4?\s?20/i){
|
|
$speed_si = 20000;# 4 20Gbps
|
|
$rev = '4';
|
|
}
|
|
elsif ($_[0] =~ /usb\s?20|super[\s-]?speed\s?(\+|plus) gen[\s-]?2x2/i){
|
|
$speed_si = 20000;# 3.2 20Gbps
|
|
$rev = '3.2';
|
|
}
|
|
# could be 3.2, 20000 too, also superspeed+
|
|
elsif ($_[0] =~ /super[\s-]?speed\s?(\+|plus)/i){
|
|
$speed_si = 10000;# 3.1; # can't trust bsds to use superspeed+ but we'll hope
|
|
$rev = '3.1';
|
|
}
|
|
elsif ($_[0] =~ /super[\s-]?speed/i){
|
|
$speed_si = 5000;# 3.0;
|
|
$rev = '3.0';
|
|
}
|
|
elsif ($_[0] =~ /hi(gh)?[\s-]?speed/i){
|
|
$speed_si = 480; # 2.0,
|
|
$rev = '2.0';
|
|
}
|
|
elsif ($_[0] =~ /full[\s-]?speed/i){
|
|
$speed_si = 12; # 1.1 - could be full speed 1.1/2.0
|
|
$rev = '1.1';
|
|
}
|
|
elsif ($_[0] =~ /low?[\s-]?speed/i){
|
|
$speed_si = 1.5; # 1.5 - could be 1.0, or low speed 1.1/2.0
|
|
$rev = '1.0';
|
|
}
|
|
else {
|
|
undef $speed_si; # we don't know what the syntax was
|
|
}
|
|
return ($speed_si,$rev);
|
|
}
|
|
|
|
# Try to guess at usb rev version from speed. Unreliable, very inaccurate.
|
|
# Note: this will probably be so inaccurate with USB 3.2/4 that it might be best
|
|
# to remove this feature at some point, unless better data sources found.
|
|
# args: 0: speed
|
|
sub usb_rev {
|
|
return if !$_[0] || !main::is_numeric($_[0]);
|
|
my $rev;
|
|
if ($_[0] < 2){
|
|
$rev = '1.0';}
|
|
elsif ($_[0] < 13)
|
|
{$rev = '1.1';}
|
|
elsif ($_[0] < 481){
|
|
$rev = '2.0';}
|
|
# 5 Gbps
|
|
elsif ($_[0] < 5001)
|
|
{$rev = '3.0';}
|
|
# 10 Gbps, this can be 3.1, 3.2 or 4
|
|
elsif ($_[0] < 10001){
|
|
$rev = '3.1';}
|
|
# SuperSpeed 'USB 20Gbps', this can be 3.2 or 4
|
|
elsif ($_[0] < 20001){
|
|
$rev = '3.2';}
|
|
# 4 does not use 4.x syntax, and real lanes/rev/speed data source required.
|
|
# 4: 10-120 Gbps. Update once data available for USB 3.2/4 speed strings
|
|
elsif ($_[0] < 120001){
|
|
$rev = '4';}
|
|
return $rev;
|
|
}
|
|
|
|
## UTILITIES ##
|
|
# This is used to create an alpha sortable bus id for main $usb[0]
|
|
sub bus_id_alpha {
|
|
my ($id) = @_;
|
|
$id =~ s/^([1-9])-/0$1-/;
|
|
$id =~ s/([-\.:])([0-9])\b/${1}0$2/g;
|
|
return $id;
|
|
}
|
|
|
|
sub process_power {
|
|
return if !${$_[0]};
|
|
${$_[0]} =~ s/\s//g;
|
|
# ${$_[0]} = '' if ${$_[0]} eq '0mA'; # better to handle on output
|
|
}
|
|
}
|
|
|
|
# note: seen android instance where reading file wakeup_count hangs endlessly.
|
|
# 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.
|
|
sub get_wakeups {
|
|
eval $start if $b_log;
|
|
return if %risc;
|
|
my ($path,$wakeups);
|
|
# this increments on suspend, but you can't see it until wake, numbers work.
|
|
$path = '/sys/power/suspend_stats/success';
|
|
$wakeups = reader($path,'strip',0) if -r $path;
|
|
eval $end if $b_log;
|
|
return $wakeups;
|
|
}
|
|
|
|
########################################################################
|
|
#### GENERATE OUTPUT
|
|
########################################################################
|
|
|
|
## OutputGenerator
|
|
# Also creates Short, Info, and System items
|
|
{
|
|
package OutputGenerator;
|
|
my ($items,$subs);
|
|
|
|
sub generate {
|
|
eval $start if $b_log;
|
|
my ($item,%checks);
|
|
main::set_ps_aux() if !$loaded{'ps-aux'};
|
|
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);
|
|
main::log_data('dump','@ps_cmd',\@ps_cmd);
|
|
}
|
|
if ($show{'short'}){
|
|
$item = short_output();
|
|
assign_data($item);
|
|
}
|
|
else {
|
|
if ($show{'system'}){
|
|
$item = system_item();
|
|
assign_data($item);
|
|
}
|
|
if ($show{'machine'}){
|
|
DmidecodeData::set(\$checks{'dmi'}) if $use{'dmidecode'} && !$checks{'dmi'};
|
|
$item = item_handler('Machine','machine');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'battery'}){
|
|
DmidecodeData::set(\$checks{'dmi'}) if $use{'dmidecode'} && !$checks{'dmi'};
|
|
$item = item_handler('Battery','battery');
|
|
if ($item || $show{'battery-forced'}){
|
|
assign_data($item);
|
|
}
|
|
}
|
|
if ($show{'ram'}){
|
|
DmidecodeData::set(\$checks{'dmi'}) if $use{'dmidecode'} && !$checks{'dmi'};
|
|
$item = item_handler('Memory','ram');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'slot'}){
|
|
DmidecodeData::set(\$checks{'dmi'}) if $use{'dmidecode'} && !$checks{'dmi'};
|
|
$item = item_handler('PCI Slots','slot');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'cpu'} || $show{'cpu-basic'}){
|
|
DeviceData::set(\$checks{'device'}) if %risc && !$checks{'device'};
|
|
DmidecodeData::set(\$checks{'dmi'}) if $use{'dmidecode'} && !$checks{'dmi'};
|
|
my $arg = ($show{'cpu-basic'}) ? 'basic' : 'full' ;
|
|
$item = item_handler('CPU','cpu',$arg);
|
|
assign_data($item);
|
|
}
|
|
if ($show{'graphic'}){
|
|
UsbData::set(\$checks{'usb'}) if !$checks{'usb'};
|
|
DeviceData::set(\$checks{'device'}) if !$checks{'device'};
|
|
$item = item_handler('Graphics','graphic');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'audio'}){
|
|
UsbData::set(\$checks{'usb'}) if !$checks{'usb'};
|
|
DeviceData::set(\$checks{'device'}) if !$checks{'device'};
|
|
$item = item_handler('Audio','audio');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'network'}){
|
|
UsbData::set(\$checks{'usb'}) if !$checks{'usb'};
|
|
DeviceData::set(\$checks{'device'}) if !$checks{'device'};
|
|
IpData::set() if ($show{'ip'} || ($bsd_type && $show{'network-advanced'}));
|
|
$item = item_handler('Network','network');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'bluetooth'}){
|
|
UsbData::set(\$checks{'usb'}) if !$checks{'usb'};
|
|
DeviceData::set(\$checks{'device'}) if !$checks{'device'};
|
|
$item = item_handler('Bluetooth','bluetooth');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'logical'}){
|
|
$item = item_handler('Logical','logical');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'raid'}){
|
|
DeviceData::set(\$checks{'device'}) if !$checks{'device'};
|
|
$item = item_handler('RAID','raid');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'disk'} || $show{'disk-basic'} || $show{'disk-total'} || $show{'optical'}){
|
|
UsbData::set(\$checks{'usb'}) if !$checks{'usb'};
|
|
$item = item_handler('Drives','disk');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'partition'} || $show{'partition-full'}){
|
|
$item = item_handler('Partition','partition');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'swap'}){
|
|
$item = item_handler('Swap','swap');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'unmounted'}){
|
|
$item = item_handler('Unmounted','unmounted');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'usb'}){
|
|
UsbData::set(\$checks{'usb'}) if !$checks{'usb'};
|
|
$item = item_handler('USB','usb');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'sensor'}){
|
|
$item = item_handler('Sensors','sensor');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'repo'}){
|
|
$item = item_handler('Repos','repo');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'process'}){
|
|
$item = item_handler('Processes','process');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'weather'}){
|
|
$item = item_handler('Weather','weather');
|
|
assign_data($item);
|
|
}
|
|
if ($show{'info'}){
|
|
$item = info_item();
|
|
assign_data($item);
|
|
}
|
|
}
|
|
if ($output_type ne 'screen'){
|
|
main::output_handler($items);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## Short, Info, System Items ##
|
|
sub short_output {
|
|
eval $start if $b_log;
|
|
my $num = 0;
|
|
my $kernel_os = ($bsd_type) ? 'OS' : 'Kernel';
|
|
my ($cpu_string,$speed,$speed_key,$type) = ('','','speed','');
|
|
my $cpu = CpuItem::get('short');
|
|
if (ref $cpu eq 'ARRAY' && scalar @$cpu > 1){
|
|
$type = ($cpu->[2]) ? " (-$cpu->[2]-)" : '';
|
|
($speed,$speed_key) = ('','');
|
|
if ($cpu->[6]){
|
|
$speed_key = "$cpu->[3]/$cpu->[5]";
|
|
$speed = "$cpu->[4]/$cpu->[6] MHz";
|
|
}
|
|
else {
|
|
$speed_key = $cpu->[3];
|
|
$speed = "$cpu->[4] MHz";
|
|
}
|
|
$cpu->[1] ||= main::message('cpu-model-null');
|
|
$cpu_string = $cpu->[0] . ' ' . $cpu->[1] . $type;
|
|
}
|
|
elsif ($bsd_type){
|
|
if ($alerts{'sysctl'}->{'action'}){
|
|
if ($alerts{'sysctl'}->{'action'} ne 'use'){
|
|
$cpu_string = "sysctl $alerts{'sysctl'}->{'action'}";
|
|
$speed = "sysctl $alerts{'sysctl'}->{'action'}";
|
|
}
|
|
else {
|
|
$cpu_string = 'bsd support coming';
|
|
$speed = 'bsd support coming';
|
|
}
|
|
}
|
|
}
|
|
$speed ||= 'N/A'; # totally unexpected situation, what happened?
|
|
my $disk = DriveItem::get('short');
|
|
# print Dumper \@disk;
|
|
my $disk_string = 'N/A';
|
|
my ($size,$used) = ('','');
|
|
my ($size_holder,$used_holder);
|
|
if (ref $disk eq 'ARRAY' && @$disk){
|
|
$size = ($disk->[0]{'logical-size'}) ? $disk->[0]{'logical-size'} : $disk->[0]{'size'};
|
|
# must be > 0
|
|
if ($size && main::is_numeric($size)){
|
|
$size_holder = $size;
|
|
$size = main::get_size($size,'string');
|
|
}
|
|
$used = $disk->[0]{'used'};
|
|
if ($used && main::is_numeric($disk->[0]{'used'})){
|
|
$used_holder = $disk->[0]{'used'};
|
|
$used = main::get_size($used,'string');
|
|
}
|
|
# in some fringe cases size can be 0 so only assign 'N/A' if no percents etc
|
|
if ($size_holder && $used_holder){
|
|
my $percent = ' (' . sprintf("%.1f", $used_holder/$size_holder*100) . '% used)';
|
|
$disk_string = "$size$percent";
|
|
}
|
|
else {
|
|
$size ||= main::message('disk-size-0');
|
|
$disk_string = "$used/$size";
|
|
}
|
|
}
|
|
my $memory = MemoryData::get('short');
|
|
$memory = 'N/A' if !$memory;
|
|
# print join('; ', @cpu), " sleep: $cpu_sleep\n";
|
|
if (!$loaded{'shell-data'} && $ppid && (!$b_irc || !$client{'name-print'})){
|
|
ShellData::set();
|
|
}
|
|
my $client = $client{'name-print'};
|
|
my $client_shell = ($b_irc) ? 'Client' : 'Shell';
|
|
if ($client{'version'}){
|
|
$client .= ' ' . $client{'version'};
|
|
}
|
|
my $data = [{
|
|
main::key($num++,0,0,'CPU') => $cpu_string,
|
|
main::key($num++,0,0,$speed_key) => $speed,
|
|
main::key($num++,0,0,$kernel_os) => join(' ', @{main::get_kernel_data()}),
|
|
main::key($num++,0,0,'Up') => main::get_uptime(),
|
|
main::key($num++,0,0,'Mem') => $memory,
|
|
main::key($num++,0,0,'Storage') => $disk_string,
|
|
# could make -1 for ps aux itself, -2 for ps aux and self
|
|
main::key($num++,0,0,'Procs') => scalar @ps_aux,
|
|
main::key($num++,0,0,$client_shell) => $client,
|
|
main::key($num++,0,0,$self_name) => main::get_self_version(),
|
|
},];
|
|
eval $end if $b_log;
|
|
return {
|
|
main::key($prefix,1,0,'SHORT') => $data,
|
|
};
|
|
}
|
|
|
|
sub info_item {
|
|
eval $start if $b_log;
|
|
my $num = 0;
|
|
my $gcc_alt = '';
|
|
my $running_in = '';
|
|
my $data_name = main::key($prefix++,1,0,'Info');
|
|
my ($b_gcc,$gcc,$index);
|
|
my ($available,$gpu_ram,$parent,$percent,$used) = ('',0,'','','');
|
|
my $gccs = main::get_gcc_data();
|
|
if (@$gccs){
|
|
$gcc = shift @$gccs;
|
|
if ($extra > 1 && @$gccs){
|
|
$gcc_alt = join('/', @$gccs);
|
|
}
|
|
$b_gcc = 1;
|
|
$gcc ||= 'N/A'; # should not be needed after fix but leave in case undef
|
|
}
|
|
my $data = {
|
|
$data_name => [{
|
|
main::key($num++,0,1,'Processes') => scalar @ps_aux,
|
|
main::key($num++,1,1,'Uptime') => main::get_uptime(),
|
|
},],
|
|
};
|
|
$index = scalar(@{$data->{$data_name}}) - 1;
|
|
if ($extra > 2){
|
|
my $wakeups = main::get_wakeups();
|
|
$data->{$data_name}[$index]{main::key($num++,0,2,'wakeups')} = $wakeups if defined $wakeups;
|
|
}
|
|
if (!$loaded{'memory'}){
|
|
my $row = {};
|
|
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;
|
|
}
|
|
if ((!$b_display || $force{'display'}) || $extra > 0){
|
|
my $init = InitData::get();
|
|
my $init_type = ($init->{'init-type'}) ? $init->{'init-type'}: 'N/A';
|
|
$data->{$data_name}[$index]{main::key($num++,1,1,'Init')} = $init_type;
|
|
if ($extra > 1){
|
|
my $init_version = ($init->{'init-version'}) ? $init->{'init-version'}: 'N/A';
|
|
$data->{$data_name}[$index]{main::key($num++,0,2,'v')} = $init_version;
|
|
}
|
|
if ($init->{'rc-type'}){
|
|
$data->{$data_name}[$index]{main::key($num++,1,2,'rc')} = $init->{'rc-type'};
|
|
if ($init->{'rc-version'}){
|
|
$data->{$data_name}[$index]{main::key($num++,0,3,'v')} = $init->{'rc-version'};
|
|
}
|
|
}
|
|
if ($init->{'runlevel'}){
|
|
my $key = ($init->{'init-type'} && $init->{'init-type'} eq 'systemd') ? 'target' : 'runlevel';
|
|
$data->{$data_name}[$index]{main::key($num++,1,2,$key)} = $init->{'runlevel'};
|
|
}
|
|
if ($extra > 1){
|
|
if ($init->{'default'}){
|
|
$data->{$data_name}[$index]{main::key($num++,0,3,'default')} = $init->{'default'};
|
|
}
|
|
if ($b_admin && (my $tool = ServiceData::get('tool',''))){
|
|
$data->{$data_name}[$index]{main::key($num++,0,2,'tool')} = $tool;
|
|
undef %service_tool;
|
|
}
|
|
}
|
|
}
|
|
if ($extra > 0){
|
|
my $b_clang;
|
|
my $clang_version = '';
|
|
if (my $path = main::check_program('clang')){
|
|
$clang_version = main::program_version($path,'clang',3,'--version');
|
|
$clang_version ||= 'N/A';
|
|
$b_clang = 1;
|
|
}
|
|
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 ($b_clang){
|
|
$data->{$data_name}[$index]{main::key($num++,0,2,'clang')} = $clang_version;
|
|
}
|
|
}
|
|
if ($extra > 0 && !$loaded{'package-data'}){
|
|
my $packages = PackageData::get('inner',\$num);
|
|
for (keys %$packages){
|
|
$data->{$data_name}[$index]{$_} = $packages->{$_};
|
|
}
|
|
}
|
|
if (!$loaded{'shell-data'} && $ppid && (!$b_irc || !$client{'name-print'})){
|
|
ShellData::set();
|
|
}
|
|
my $client_shell = ($b_irc) ? 'Client' : 'Shell';
|
|
my $client = $client{'name-print'};
|
|
if (!$b_irc && $extra > 1){
|
|
# some bsds don't support -f option to get PPPID
|
|
# note: root/su - does not have $DISPLAY usually
|
|
if ($b_display && !$force{'display'} && $ppid && $client{'pppid'}){
|
|
$parent = ShellData::shell_launcher();
|
|
}
|
|
else {
|
|
ShellData::tty_number() if !$loaded{'tty-number'};
|
|
if ($client{'tty-number'} ne ''){
|
|
my $tty_type = '';
|
|
if ($client{'tty-number'} =~ /^[a-f0-9]+$/i){
|
|
$tty_type = 'tty ';
|
|
}
|
|
elsif ($client{'tty-number'} =~ /pts/i){
|
|
$tty_type = 'pty ';
|
|
}
|
|
$parent = "$tty_type$client{'tty-number'}";
|
|
}
|
|
}
|
|
# can be tty 0 so test for defined
|
|
$running_in = $parent if $parent;
|
|
if ($extra > 2 && $running_in && ShellData::ssh_status()){
|
|
$running_in .= ' (SSH)';
|
|
}
|
|
if ($extra > 2 && $client{'su-start'}){
|
|
$client .= " ($client{'su-start'})";
|
|
}
|
|
}
|
|
$data->{$data_name}[$index]{main::key($num++,1,1,$client_shell)} = $client;
|
|
if ($extra > 0 && $client{'version'}){
|
|
$data->{$data_name}[$index]{main::key($num++,0,2,'v')} = $client{'version'};
|
|
}
|
|
if (!$b_irc){
|
|
if ($extra > 2 && $client{'default-shell'}){
|
|
$data->{$data_name}[$index]{main::key($num++,1,2,'default')} = $client{'default-shell'};
|
|
$data->{$data_name}[$index]{main::key($num++,0,3,'v')} = $client{'default-shell-v'} if $client{'default-shell-v'};
|
|
}
|
|
if ($running_in){
|
|
$data->{$data_name}[$index]{main::key($num++,0,2,'running-in')} = $running_in;
|
|
}
|
|
}
|
|
$data->{$data_name}[$index]{main::key($num++,0,1,$self_name)} = main::get_self_version();
|
|
eval $end if $b_log;
|
|
return $data;
|
|
}
|
|
|
|
sub system_item {
|
|
eval $start if $b_log;
|
|
my ($cont_desk,$ind_dm,$num) = (1,2,0);
|
|
my ($index);
|
|
my $data_name = main::key($prefix++,1,0,'System');
|
|
my ($desktop,$desktop_info,$desktop_key,$dm_key,$toolkit,$wm) = ('','','Desktop','dm','','');
|
|
my (@desktop_data,$cs_curr,$cs_avail,$desktop_version,$tk_version,$wm_version);
|
|
my $data = {
|
|
$data_name => [{}],
|
|
};
|
|
$index = scalar(@{$data->{$data_name}}) - 1;
|
|
if ($show{'host'}){
|
|
$data->{$data_name}[$index]{main::key($num++,0,1,'Host')} = main::get_hostname();
|
|
}
|
|
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 = CompilerVersion::get(); # get compiler data
|
|
if (scalar @$compiler != 2){
|
|
@$compiler = ('N/A', '');
|
|
}
|
|
$data->{$data_name}[$index]{main::key($num++,1,2,'compiler')} = $compiler->[0];
|
|
# if no compiler, obviously no version, so don't waste space showing.
|
|
if ($compiler->[0] ne 'N/A'){
|
|
$compiler->[1] ||= 'N/A';
|
|
$data->{$data_name}[$index]{main::key($num++,0,3,'v')} = $compiler->[1];
|
|
}
|
|
}
|
|
if ($extra > 2){
|
|
main::get_kernel_clocksource(\$cs_curr,\$cs_avail);
|
|
$cs_curr ||= 'N/A';
|
|
$data->{$data_name}[$index]{main::key($num++,1,2,'clocksource')} = $cs_curr;
|
|
if ($b_admin && $cs_avail){
|
|
$data->{$data_name}[$index]{main::key($num++,0,3,'available')} = $cs_avail;
|
|
}
|
|
}
|
|
if ($b_admin && (my $params = KernelParameters::get())){
|
|
# $index = scalar(@{$data{$data_name}}); # not on own line for now
|
|
# 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 = scalar(@{$data->{$data_name}});
|
|
}
|
|
# 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];
|
|
if ($extra > 0 && $desktop_data->[3]){
|
|
$toolkit = $desktop_data->[2];
|
|
$tk_version = $desktop_data->[3];
|
|
}
|
|
if ($extra > 2 && $desktop_data->[4]){
|
|
$desktop_info = $desktop_data->[4];
|
|
}
|
|
# don't print the desktop if it's a wm and the same
|
|
if ($extra > 1 && $desktop_data->[5] &&
|
|
(!$desktop_data->[0] || $desktop_data->[5] =~ /^(deepin.+|gnome[\s_-]shell|budgie.+)$/i ||
|
|
index(lc($desktop_data->[5]),lc($desktop_data->[0])) == -1)){
|
|
$wm = $desktop_data->[5];
|
|
$wm_version = $desktop_data->[6] if $extra > 2 && $desktop_data->[6];
|
|
}
|
|
}
|
|
if (!$b_display || (!$desktop && $b_root)){
|
|
ShellData::tty_number() if !$loaded{'tty-number'};
|
|
my $tty = $client{'tty-number'};
|
|
if (!$desktop){
|
|
$desktop_info = '';
|
|
}
|
|
# it is defined, as ''
|
|
if ($tty eq '' && $client{'console-irc'}){
|
|
ShellData::console_irc_tty() if !$loaded{'con-irc-tty'};
|
|
$tty = $client{'con-irc-tty'};
|
|
}
|
|
if ($tty ne ''){
|
|
my $tty_type = '';
|
|
if ($tty =~ /^[a-f0-9]+$/i){
|
|
$tty_type = 'tty ';
|
|
}
|
|
elsif ($tty =~ /pts/i){
|
|
$tty_type = 'pty ';
|
|
}
|
|
$desktop = "$tty_type$tty";
|
|
}
|
|
$desktop_key = 'Console';
|
|
$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 ($desktop_version){
|
|
$data->{$data_name}[$index]{main::key($num++,0,2,'v')} = $desktop_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 ($extra > 2){
|
|
if ($desktop_info){
|
|
$data->{$data_name}[$index]{main::key($num++,0,2,'info')} = $desktop_info;
|
|
}
|
|
}
|
|
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 && $b_display && defined $ENV{'XDG_VTNR'}){
|
|
$data->{$data_name}[$index]{main::key($num++,0,2,'vt')} = $ENV{'XDG_VTNR'};
|
|
}
|
|
my $dms = main::get_display_manager();
|
|
# note: version only present if proper extra level so no need to test again
|
|
if (@$dms || $desktop_key ne 'Console'){
|
|
if (@$dms && scalar @$dms > 1){
|
|
my $i = 0;
|
|
$data->{$data_name}[$index]{main::key($num++,1,$ind_dm,$dm_key)} = '';
|
|
foreach my $dm_data (@{$dms}){
|
|
$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 = ($dms && $dms->[0][0]) ? $dms->[0][0] : 'N/A';
|
|
$data->{$data_name}[$index]{main::key($num++,1,$ind_dm,$dm_key)} = $dm;
|
|
if ($dms && $dms->[0][1]){
|
|
$data->{$data_name}[$index]{main::key($num++,0,($ind_dm + 1),'v')} = $dms->[0][1];
|
|
}
|
|
}
|
|
|
|
}
|
|
}
|
|
# if ($extra > 2 && $desktop_key ne 'Console'){
|
|
# my $tty = ShellData::tty_number() if !$loaded{'tty-number'};
|
|
# $data->{$data_name}[$index]{main::key($num++,0,1,'vc')} = $tty if $tty ne '';
|
|
# }
|
|
my $distro_key = ($bsd_type) ? 'OS': 'Distro';
|
|
my @distro_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];
|
|
}
|
|
eval $end if $b_log;
|
|
return $data;
|
|
}
|
|
|
|
## Item Processors ##
|
|
sub assign_data {
|
|
return if !$_[0] || ref $_[0] ne 'HASH';
|
|
if ($output_type eq 'screen'){
|
|
main::print_data($_[0]);
|
|
}
|
|
else {
|
|
push(@$items,$_[0]);
|
|
}
|
|
}
|
|
|
|
sub item_handler {
|
|
eval $start if $b_log;
|
|
my ($key,$item,$arg) = @_;
|
|
set_subs() if !$subs;
|
|
my $rows = $subs->{$item}($arg);
|
|
eval $end if $b_log;
|
|
if (ref $rows eq 'ARRAY' && @$rows){
|
|
return {main::key($prefix++,1,0,$key) => $rows};
|
|
}
|
|
}
|
|
|
|
sub set_subs {
|
|
$subs = {
|
|
'audio' => \&AudioItem::get,
|
|
'battery' => \&BatteryItem::get,
|
|
'bluetooth' => \&BluetoothItem::get,
|
|
'cpu' => \&CpuItem::get,
|
|
'disk' => \&DriveItem::get,
|
|
'graphic' => \&GraphicItem::get,
|
|
'logical' => \&LogicalItem::get,
|
|
'machine' => \&MachineItem::get,
|
|
'network' => \&NetworkItem::get,
|
|
'partition' => \&PartitionItem::get,
|
|
'raid' => \&RaidItem::get,
|
|
'ram' => \&RamItem::get,
|
|
'repo' => \&RepoItem::get,
|
|
'process' => \&ProcessItem::get,
|
|
'sensor' => \&SensorItem::get,
|
|
'slot' => \&SlotItem::get,
|
|
'swap' => \&SwapItem::get,
|
|
'unmounted' => \&UnmountedItem::get,
|
|
'usb' => \&UsbItem::get,
|
|
'weather' => \&WeatherItem::get,
|
|
};
|
|
}
|
|
}
|
|
|
|
#######################################################################
|
|
#### LAUNCH
|
|
########################################################################
|
|
|
|
main(); ## From the End comes the Beginning
|
|
|
|
## note: this EOF is needed for self updater, triggers the full download ok
|
|
###**EOF**###
|