mirror of
https://github.com/smxi/inxi.git
synced 2024-11-16 16:21:39 +00:00
16716 lines
516 KiB
Perl
Executable file
16716 lines
516 KiB
Perl
Executable file
#!/usr/bin/env perl
|
|
## infobash: Copyright (C) 2005-2007 Michiel de Boer aka locsmif
|
|
## inxi: Copyright (C) 2008-2018 Harald Hope
|
|
## Additional features (C) Scott Rogers - kde, cpu info
|
|
## Further fixes (listed as known): Horst Tritremmel <hjt at sidux.com>
|
|
## Steven Barrett (aka: damentz) - usb audio patch; swap percent used patch
|
|
## Jarett.Stevens - dmidecode -M patch for older systems with the /sys
|
|
##
|
|
## 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
|
|
|
|
use strict;
|
|
use warnings;
|
|
# use diagnostics;
|
|
use 5.008;
|
|
|
|
use Cwd qw(abs_path); # qw(abs_path);#abs_path realpath getcwd
|
|
use Data::Dumper qw(Dumper); # print_r
|
|
use File::Find;
|
|
use Getopt::Long qw(GetOptions);
|
|
# Note: default auto_abbrev is enabled, that's fine
|
|
Getopt::Long::Configure ('bundling', 'no_ignore_case',
|
|
'no_getopt_compat', 'no_auto_abbrev','pass_through');
|
|
use POSIX qw(uname strftime ttyname);
|
|
# use feature qw(state);
|
|
|
|
## INXI INFO ##
|
|
my $self_name='inxi';
|
|
my $self_version='3.0.08';
|
|
my $self_date='2018-05-06';
|
|
my $self_patch='00';
|
|
## END INXI INFO ##
|
|
|
|
### INITIALIZE VARIABLES ###
|
|
|
|
## Self data
|
|
my ($self_path, $user_config_dir, $user_config_file,$user_data_dir);
|
|
|
|
## Debuggers
|
|
my $debug=0;
|
|
my (@t0,$end,$start,$fh_l,$log_file); # log file handle, file
|
|
my ($b_hires,$t1,$t2,$t3) = (0,0,0,0);
|
|
# NOTE: redhat removed HiRes from Perl Core Modules. Why? who knows.
|
|
if (eval {require Time::HiRes}){
|
|
Time::HiRes->import('gettimeofday','tv_interval','usleep');
|
|
$b_hires = 1;
|
|
}
|
|
@t0 = eval 'Time::HiRes::gettimeofday()' if $b_hires; # let's start it right away
|
|
## Hashes
|
|
my ( %alerts,%client,%colors,%dl,%files,%rows,%system_files,%use );
|
|
|
|
## Arrays
|
|
# ps_aux is full output, ps_cmd is only the last 10 to last
|
|
my (@app,@dmesg_boot,@dmi,@gpudata,@ifs,@ifs_bsd,@paths,@pci,@ps_aux,@ps_cmd,
|
|
@sysctl,@sysctl_battery,@sysctl_sensors,@sysctl_machine,@uname,@usb);
|
|
## Disk arrays
|
|
my (@dm_boot_disk,@dm_boot_optical,@glabel,@gpart,@labels,@lsblk,@partitions,
|
|
@raid,@sysctl_disks,@uuids);
|
|
my @test = (0,0,0,0,0);
|
|
|
|
## Booleans
|
|
my ($b_arm,$b_console_irc,$b_debug_gz,$b_display,$b_dmesg_boot_check,$b_dmi,
|
|
$b_dmidecode_force,$b_fake_bsd,$b_force_display,$b_gpudata,$b_irc,$b_log,
|
|
$b_log_colors,$b_log_full,$b_man,$b_mem,$b_pci,$b_root,$b_running_in_display,
|
|
$b_sudo,$b_sysctl,$b_usb_check);
|
|
## Disk checks
|
|
my ($b_dm_boot_disk,$b_dm_boot_optical,$b_glabel,$b_label_uuid,$b_lsblk,
|
|
$b_partitions,$b_raid);
|
|
my ($b_sysctl_disk,$b_update,$b_weather) = (1,1,1);
|
|
|
|
## System
|
|
my ($bsd_type,$language,$os) = ('','','');
|
|
my ($cpu_sleep,$dl_timeout,$limit,$ps_count,$usb_level) = (0.35,4,10,5,0);
|
|
my $sensors_cpu_nu = 0;
|
|
my ($bits_sys);
|
|
|
|
## Tools
|
|
my ($display,$ftp_alt,$tty_session);
|
|
my ($display_opt,$sudo) = ('','');
|
|
|
|
## 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 primiary row hash key prefix
|
|
|
|
# these will 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' => ':',
|
|
);
|
|
|
|
my %show = ('host' => 1);
|
|
|
|
my %size = (
|
|
'console' => 115,
|
|
# Default indentation level. NOTE: actual indent is 1 greater to allow for
|
|
# spacing
|
|
'indent' => 11,
|
|
'indent-min' => 90,
|
|
'irc' => 100, # shorter because IRC clients have nick lists etc
|
|
'max' => 0,
|
|
'no-display' => 130,
|
|
# these will be set dynamically in set_display_width()
|
|
'term' => 80,
|
|
'term-lines' => 100,
|
|
);
|
|
|
|
## debug temp tools
|
|
$client{'test-konvi'} = 0;
|
|
|
|
########################################################################
|
|
#### STARTUP
|
|
########################################################################
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### MAIN
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub main {
|
|
# print Dumper \@ARGV;
|
|
eval $start if $b_log;
|
|
initialize();
|
|
## use for start client debugging
|
|
# $debug = 10;
|
|
# set_debugger(); # for debugging of konvi issues
|
|
#my $ob_start = StartClient->new();
|
|
#$ob_start->get_client_data();
|
|
StartClient::get_client_data();
|
|
# print_line( Dumper \%client);
|
|
get_options();
|
|
set_debugger(); # right after so it's set
|
|
check_tools();
|
|
set_colors();
|
|
set_sep();
|
|
# print download_file('stdout','https://') . "\n";
|
|
generate_lines();
|
|
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_os();
|
|
set_path();
|
|
set_user_paths();
|
|
set_basics();
|
|
system_files('set');
|
|
get_configs();
|
|
# set_downloader();
|
|
set_display_width('live');
|
|
}
|
|
|
|
sub check_tools {
|
|
my ($action,$program,$message,@data,%commands,%hash);
|
|
if ( $b_dmi ){
|
|
$action = 'use';
|
|
if ($program = check_program('dmidecode')) {
|
|
my $result = system("$program -t chassis >/dev/null 2>&1");
|
|
if (!$result){
|
|
if ($b_root) {
|
|
@data = grabber("$program --type chassis");
|
|
if ( grep { $_ =~ /No SMBIOS/i } @data ){
|
|
$action = 'smbios';
|
|
}
|
|
}
|
|
}
|
|
elsif ($result){
|
|
$action = 'permissions';
|
|
}
|
|
}
|
|
else {
|
|
$action = 'missing';
|
|
}
|
|
%hash = (
|
|
'dmidecode' => {
|
|
'action' => $action,
|
|
'missing' => 'Required program dmidecode not available',
|
|
'permissions' => 'Unable to run dmidecode. Are you root?',
|
|
'smbios' => 'No SMBIOS data for dmidecode to process',
|
|
},
|
|
);
|
|
%alerts = (%alerts, %hash);
|
|
}
|
|
# note: gnu/linux has sysctl so it may be used that for something if present
|
|
# there is lspci for bsds so doesn't hurt to check it
|
|
if ($b_pci || $b_sysctl){
|
|
if (!$bsd_type){
|
|
if ($b_pci ){
|
|
%hash = ('lspci' => '-n',);
|
|
%commands = (%commands,%hash);
|
|
}
|
|
}
|
|
else {
|
|
if ($b_pci ){
|
|
%hash = ('pciconf' => '-l',);
|
|
%commands = (%commands,%hash);
|
|
}
|
|
if ($b_sysctl ){
|
|
# note: there is a case of kernel.osrelease but it's a linux distro
|
|
%hash = ('sysctl' => 'kern.osrelease',);
|
|
%commands = (%commands,%hash);
|
|
}
|
|
}
|
|
foreach ( keys %commands ){
|
|
$action = 'use';
|
|
if ($program = check_program($_)) {
|
|
# > 0 means error in shell
|
|
#my $cmd = "$program $commands{$_} >/dev/null";
|
|
#print "$cmd\n";
|
|
$action = 'permissions' if system("$program $commands{$_} >/dev/null 2>&1");
|
|
}
|
|
else {
|
|
$action = 'missing';
|
|
}
|
|
%hash = (
|
|
$_ => {
|
|
'action' => $action,
|
|
'missing' => "Missing system tool: $_. Output will be incomplete",
|
|
'permissions' => "Unable to run $_. Root required?",
|
|
},
|
|
);
|
|
%alerts = (%alerts, %hash);
|
|
}
|
|
}
|
|
%commands = ();
|
|
if ( $show{'sensor'} ){
|
|
%commands = ('sensors' => 'linux',);
|
|
}
|
|
# note: lsusb ships in FreeBSD ports sysutils/usbutils
|
|
if ( $usb_level ){
|
|
%hash = ('lsusb' => 'all',);
|
|
%commands = (%commands,%hash);
|
|
%hash = ('usbdevs' => 'bsd',);
|
|
%commands = (%commands,%hash);
|
|
}
|
|
if ($show{'ip'} || ($bsd_type && $show{'network-advanced'})){
|
|
%hash = (
|
|
'ip' => 'linux',
|
|
'ifconfig' => 'all',
|
|
);
|
|
%commands = (%commands,%hash);
|
|
}
|
|
foreach ( keys %commands ){
|
|
$action = 'use';
|
|
$message = 'Present and working';
|
|
if ( ($commands{$_} eq 'linux' && $os ne 'linux' ) || ($commands{$_} eq 'bsd' && $os eq 'linux' ) ){
|
|
$message = "No " . ucfirst($os) . " support. Is a comparable $_ tool available?";
|
|
$action = 'platform';
|
|
}
|
|
elsif (!check_program($_)){
|
|
$message = "Required tool $_ not installed. Check --recommends";
|
|
$action = 'missing';
|
|
}
|
|
%hash = (
|
|
$_ => {
|
|
'action' => $action,
|
|
'missing' => $message,
|
|
'platform' => $message,
|
|
},
|
|
);
|
|
%alerts = (%alerts, %hash);
|
|
}
|
|
# print Dumper \%alerts;
|
|
# only use 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
|
|
# important: -n makes it non interactive, no prompt for password
|
|
if (!$b_root && $b_sudo && (my $path = main::check_program('sudo') )) {
|
|
my @data = program_values('sudo');
|
|
my $version = program_version($path,$data[0],$data[1],$data[2],$data[5]);
|
|
$version =~ s/^([0-9]+\.[0-9]+).*/$1/;
|
|
$sudo = "$path -n " if $version >= 1.7;
|
|
}
|
|
}
|
|
|
|
# args: 1 - desktop/app command for --version; 2 - search string;
|
|
# 3 - space print number; 4 - [optional] version arg: -v, version, etc
|
|
# 5 - [optional] exit first find 0/1; 6 - [optional] 0/1 stderr output
|
|
sub set_basics {
|
|
### LOCALIZATION - DO NOT CHANGE! ###
|
|
# set to default LANG to avoid locales errors with , or .
|
|
# Make sure every program speaks English.
|
|
$ENV{'LANG'}='C';
|
|
$ENV{'LC_ALL'}='C';
|
|
# remember, perl uses the opposite t/f return as shell!!!
|
|
$b_irc = ( system('tty >/dev/null') ) ? 1 : 0;
|
|
# print "birc: $b_irc\n";
|
|
$b_display = ( $ENV{'DISPLAY'} ) ? 1 : 0;
|
|
$b_root = ( $ENV{'HOME'} eq '/root' ) ? 1 : 0;
|
|
$dl{'dl'} = 'curl';
|
|
$dl{'curl'} = 1;
|
|
$dl{'tiny'} = 1; # note: two modules needed, tested for in set_downloader
|
|
$dl{'wget'} = 1;
|
|
$dl{'fetch'} = 1;
|
|
$client{'console-irc'} = 0;
|
|
$client{'dcop'} = (check_program('dcop')) ? 1 : 0;
|
|
$client{'qdbus'} = (check_program('qdbus')) ? 1 : 0;
|
|
$client{'konvi'} = 0;
|
|
$client{'name'} = '';
|
|
$client{'name-print'} = '';
|
|
$client{'su-start'} = ''; # shows sudo/su
|
|
$client{'version'} = '';
|
|
$colors{'default'} = 2;
|
|
}
|
|
|
|
# args: $1 - default OR override default cols max integer count. $_[0]
|
|
# is the display width override.
|
|
sub set_display_width {
|
|
my ($width) = @_;
|
|
if ( $width eq 'live' ){
|
|
## sometimes tput will trigger an error (mageia) if irc client
|
|
if ( ! $b_irc ){
|
|
if ( check_program('tput') ) {
|
|
# trips error if use qx()...
|
|
chomp($size{'term'}=qx{tput cols});
|
|
chomp($size{'term-lines'}=qx{tput lines});
|
|
$size{'term-cols'} = $size{'term'};
|
|
}
|
|
# print "tc: $size{'term'} cmc: $size{'console'}\n";
|
|
# double check, just in case it's missing functionality or whatever
|
|
if ( $size{'term'} == 0 || $size{'term'} !~ /\d/ ){
|
|
$size{'term'}=80;
|
|
# we'll be using this for terminal dimensions later so don't set default.
|
|
# $size{'term-lines'}=100;
|
|
}
|
|
}
|
|
# this lets you set different size for in or out of display server
|
|
# if ( ! $b_running_in_display && $configs{'COLS_MAX_NO_DISPLAY'} != 0 ){
|
|
# $size{'console'}=$configs{'COLS_MAX_NO_DISPLAY'};
|
|
# }
|
|
# term_cols is set in top globals, using tput cols
|
|
# print "tc: $size{'term'} cmc: $size{'console'}\n";
|
|
if ( $size{'term'} < $size{'console'} ){
|
|
$size{'console'}=$size{'term'};
|
|
}
|
|
# adjust, some terminals will wrap if output cols == term cols
|
|
$size{'console'}=( $size{'console'} - 2 );
|
|
# echo cmc: $size{'console'}
|
|
# comes after source for user set stuff
|
|
if ( ! $b_irc ){
|
|
$size{'max'}=$size{'console'};
|
|
}
|
|
else {
|
|
$size{'max'}=$size{'irc'};
|
|
}
|
|
}
|
|
else {
|
|
$size{'max'}=$width;
|
|
}
|
|
# print "tc: $size{'term'} cmc: $size{'console'} cm: $size{'max'}\n";
|
|
}
|
|
|
|
# NOTE: most tests internally are against !$bsd_type
|
|
sub set_os {
|
|
@uname = uname();
|
|
$os = lc($uname[0]);
|
|
my $type = lc($uname[-1]);
|
|
$b_arm = 1 if $type =~ /arm|aarch/;
|
|
if ($type =~ /(armv[1-7]|aarch32|sparc_v9)/){
|
|
$bits_sys = 32;
|
|
}
|
|
elsif ($type =~ /(alpha|64)/){
|
|
$bits_sys = 64;
|
|
}
|
|
if ( $os =~ /(bsd|dragonfly|darwin)/ ){
|
|
if ( $os =~ /openbsd/ ){
|
|
$os = 'openbsd';
|
|
}
|
|
elsif ($os =~ /darwin/){
|
|
$os = 'darwin';
|
|
}
|
|
if ($os =~ /kfreebsd/){
|
|
$bsd_type = 'debian-bsd';
|
|
}
|
|
else {
|
|
$bsd_type = $os;
|
|
}
|
|
}
|
|
}
|
|
|
|
# This data is hard set top of program but due to a specific project's
|
|
# foolish idea that ignoring the FSH totally is somehow a positive step
|
|
# forwards for free software, we also have to padd the results with PATH.
|
|
sub set_path {
|
|
# Extra path variable to make execute failures less likely, merged below
|
|
my (@path);
|
|
@paths = qw(/sbin /bin /usr/sbin /usr/bin /usr/local/sbin /usr/local/bin /usr/X11R6/bin);
|
|
@path = split /:/, $ENV{'PATH'} if $ENV{'PATH'};
|
|
# print "paths: @paths\nPATH: $ENV{'PATH'}\n";
|
|
# Create a difference of $PATH and $extra_paths and add that to $PATH:
|
|
foreach my $id (@path) {
|
|
if ( !(grep { /^$id$/ } @paths) && $id !~ /(game)/ ){
|
|
push @paths, $id;
|
|
}
|
|
}
|
|
# print "paths: @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'};
|
|
}
|
|
}
|
|
|
|
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/[^\/]+$//;
|
|
|
|
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";
|
|
}
|
|
$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";
|
|
}
|
|
|
|
# args: 1: set|hash key to return either null or path
|
|
sub system_files {
|
|
my ($file) = @_;
|
|
if ( $file eq 'set'){
|
|
%files = (
|
|
'asound-cards' => '/proc/asound/cards',
|
|
'asound-modules' => '/proc/asound/modules',
|
|
'asound-version' => '/proc/asound/version',
|
|
'cpuinfo' => '/proc/cpuinfo',
|
|
'dmesg-boot' => '/var/run/dmesg.boot',
|
|
'lsb-release' => '/etc/lsb-release',
|
|
'mdstat' => '/proc/mdstat',
|
|
'meminfo' => '/proc/meminfo',
|
|
'modules' => '/proc/modules',
|
|
'mounts' => '/proc/mounts',
|
|
'os-release' => '/etc/os-release',
|
|
'partitions' => '/proc/partitions',
|
|
'scsi' => '/proc/scsi/scsi',
|
|
'version' => '/proc/version',
|
|
'xorg-log' => '/var/log/Xorg.0.log'
|
|
);
|
|
foreach ( keys %files ){
|
|
$system_files{$_} = ( -e $files{$_} ) ? $files{$_} : '';
|
|
}
|
|
if ( ! $system_files{'xorg-log'} && check_program('xset') ){
|
|
my $data = qx(xset q 2>/dev/null);
|
|
foreach ( split /\n/, $data){
|
|
if ($_ =~ /Log file/i){
|
|
$system_files{'xorg-log'} = get_piece($_,3);
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
return $system_files{$file};
|
|
}
|
|
}
|
|
|
|
########################################################################
|
|
#### UTILITIES
|
|
########################################################################
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### COLORS
|
|
#### -------------------------------------------------------------------
|
|
|
|
## arg: 1 - the type of action, either integer, count, or full
|
|
sub get_color_scheme {
|
|
my ($type) = @_;
|
|
eval $start if $b_log;
|
|
my @color_schemes = (
|
|
[qw(EMPTY EMPTY EMPTY )],
|
|
[qw(NORMAL NORMAL NORMAL )],
|
|
# 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)],
|
|
);
|
|
if ($type eq 'count' ){
|
|
return scalar @color_schemes;
|
|
}
|
|
if ($type eq 'full' ){
|
|
return @color_schemes;
|
|
}
|
|
else {
|
|
return @{$color_schemes[$type]};
|
|
# print Dumper $color_schemes[$scheme_nu];
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
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 @scheme = get_color_scheme($colors{'scheme'});
|
|
$colors{'c1'} = $color_palette{$scheme[0]}[$index];
|
|
$colors{'c2'} = $color_palette{$scheme[1]}[$index];
|
|
$colors{'cn'} = $color_palette{$scheme[2]}[$index];
|
|
# 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 && ! -t STDOUT ){
|
|
$color_scheme = 0;
|
|
}
|
|
set_color_scheme($color_scheme);
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
## SelectColors
|
|
{
|
|
package SelectColors;
|
|
|
|
# use warnings;
|
|
# use strict;
|
|
# use diagnostics;
|
|
# use 5.008;
|
|
|
|
my (@data,@rows,%configs,%status);
|
|
my ($type,$w_fh);
|
|
my $safe_color_count = 12; # null/normal + default color group
|
|
my $count = 0;
|
|
|
|
# args: 1 - 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 ){
|
|
main::check_config_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."],
|
|
);
|
|
}
|
|
@rows = (
|
|
[ 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, '', '', ""],
|
|
);
|
|
push @data, @rows;
|
|
if ( ! $b_irc ){
|
|
@rows = (
|
|
[ 0, '', '', "Please note that this will set the $configs{'selection'}
|
|
preferences only for user: $whoami"],
|
|
);
|
|
push @data, @rows;
|
|
}
|
|
@rows = (
|
|
[ 0, '', '', "$line1"],
|
|
);
|
|
push @data, @rows;
|
|
main::print_basic(@data);
|
|
@data = ();
|
|
}
|
|
sub create_color_selections {
|
|
my $spacer = '^^'; # printer removes double spaces, but replaces ^ with ' '
|
|
$count = ( main::get_color_scheme('count') - 1 );
|
|
for my $i (0 .. $count){
|
|
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);
|
|
@rows = (
|
|
[0, '', '', "$i)$spacer$colors{'c1'}Card:$colors{'c2'}^nVidia^GT218
|
|
$colors{'c1'}Display^Server$colors{'c2'}^x11^(X.Org^1.7.7)$colors{'cn'}"],
|
|
);
|
|
push @data, @rows;
|
|
}
|
|
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 = ();
|
|
my $response = <STDIN>;
|
|
chomp $response;
|
|
if ($response =~ /[^0-9]/ || $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);
|
|
}
|
|
}
|
|
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 1;
|
|
}
|
|
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_config_colors();
|
|
}
|
|
set_config_color_scheme($response);
|
|
}
|
|
}
|
|
sub delete_all_config_colors {
|
|
my @file_lines = main::reader( $user_config_file );
|
|
open( $w_fh, '>', $user_config_file ) or 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 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 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 1;
|
|
}
|
|
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### CONFIGS
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub check_config_file {
|
|
$user_config_file = "$user_config_dir/$self_name.conf";
|
|
if ( ! -f $user_config_file ){
|
|
open( my $fh, '>', $user_config_file ) or error_handler('create', $user_config_file, $!);
|
|
}
|
|
}
|
|
|
|
sub get_configs {
|
|
my (@configs) = @_;
|
|
my ($key, $val,@config_files);
|
|
if (!@configs){
|
|
@config_files = (
|
|
qq(/etc/$self_name.conf),
|
|
qq($user_config_dir/$self_name.conf)
|
|
);
|
|
}
|
|
else {
|
|
@config_files = (@configs);
|
|
}
|
|
# Config files should be passed in an array as a param to this function.
|
|
# Default intended use: global @CONFIGS;
|
|
foreach (@config_files) {
|
|
next unless open (my $fh, '<', "$_");
|
|
while (<$fh>) {
|
|
chomp;
|
|
s/#.*//;
|
|
s/^\s+//;
|
|
s/\s+$//;
|
|
s/'|"//g;
|
|
s/true/1/; # switch to 1/0 perl boolean
|
|
s/false/0/; # switch to 1/0 perl boolean
|
|
next unless length;
|
|
($key, $val) = split(/\s*=\s*/, $_, 2);
|
|
get_config_item($key,$val);
|
|
# print "f: $file key: $key val: $val\n";
|
|
}
|
|
close $fh;
|
|
}
|
|
}
|
|
|
|
# args: 0: key; 1: value
|
|
sub get_config_item {
|
|
my ($key,$val) = @_;
|
|
if ($key eq 'ALLOW_UPDATE' || $key eq 'B_ALLOW_UPDATE') {$b_update = int($val)}
|
|
elsif ($key eq 'ALLOW_WEATHER' || $key eq 'B_ALLOW_WEATHER') {$b_weather = int($val)}
|
|
elsif ($key eq 'CPU_SLEEP') {$cpu_sleep = $val if $val =~ /^[0-9\.]$/}
|
|
elsif ($key eq 'DL_TIMEOUT') {$dl_timeout = int($val)}
|
|
elsif ($key eq 'DOWNLOADER') {
|
|
if ($val =~ /^(curl|fetch|ftp|perl|wget)$/){
|
|
# this dumps all the other data and resets %dl for only the
|
|
# desired downloader.
|
|
$val = set_perl_downloader($val);
|
|
%dl = ('dl' => $val, $val => 1);
|
|
}}
|
|
elsif ($key eq 'FILTER_STRING') {$filter_string = $val}
|
|
elsif ($key eq 'LANGUAGE') {$language = $val if $val =~ /^(en)$/}
|
|
elsif ($key eq 'LIMIT') {$limit = int($val)}
|
|
elsif ($key eq 'OUTPUT_TYPE') {$output_type = $val if $val =~ /^json|screen|xml/}
|
|
elsif ($key eq 'PS_COUNT') {$ps_count = int($val) }
|
|
elsif ($key eq 'SENSORS_CPU_NO') {$sensors_cpu_nu = int($val)}
|
|
elsif ($key eq 'SHOW_HOST' || $key eq 'B_SHOW_HOST') { $show{'host'} = int($val)}
|
|
# layout
|
|
elsif ($key eq 'CONSOLE_COLOR_SCHEME') {$colors{'console'} = int($val)}
|
|
elsif ($key eq 'GLOBAL_COLOR_SCHEME') {$colors{'global'} = int($val)}
|
|
elsif ($key eq 'IRC_COLOR_SCHEME') {$colors{'irc-gui'} = int($val)}
|
|
elsif ($key eq 'IRC_CONS_COLOR_SCHEME') {$colors{'irc-console'} = int($val)}
|
|
elsif ($key eq 'IRC_X_TERM_COLOR_SCHEME') {$colors{'irc-virt-term'} = int($val)}
|
|
elsif ($key eq 'VIRT_TERM_COLOR_SCHEME') {$colors{'virt-term'} = 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 'SEP[23]_IRC') {$sep{'s2-irc'} = $val}
|
|
elsif ($key eq 'SEP[23]_CONSOLE') {$sep{'s2-console'} = $val}
|
|
# size
|
|
elsif ($key eq 'COLS_MAX_CONSOLE') {$size{'console'} = int($val)}
|
|
elsif ($key eq 'COLS_MAX_IRC') {$size{'irc'} = int($val)}
|
|
elsif ($key eq 'COLS_MAX_NO_DISPLAY') {$size{'no-display'} = int($val)}
|
|
elsif ($key eq 'INDENT') {$size{'indent'} = int($val)}
|
|
elsif ($key eq 'INDENT_MIN') {$size{'indent-min'} = int($val)}
|
|
# print "mc: key: $key val: $val\n";
|
|
# print Dumper (keys %size) . "\n";
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### 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;
|
|
# 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: $1 - type [fs|fe|cat|dump|raw] OR data to log
|
|
# arg: $2 -
|
|
# arg: $one type (fs/fe/cat/dump/raw) or logged data;
|
|
# [$two is function name; [$three - function args]]
|
|
sub log_data {
|
|
return if ! $b_log;
|
|
my ($one, $two, $three) = @_;
|
|
my $args = '';
|
|
my $data = '';
|
|
my $spacer = ' ';
|
|
# print "1: $one 2: $two 3: $three\n";
|
|
if ($one eq 'fs') {
|
|
if (ref $three eq 'ARRAY'){
|
|
my @temp = @$three;
|
|
# 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='';
|
|
}
|
|
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='';
|
|
}
|
|
elsif ( $one eq 'cat') {
|
|
if ( $b_log_full ){
|
|
for 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";
|
|
}
|
|
# print "d: $data";
|
|
if ($data){
|
|
print $fh_l "$spacer$data";
|
|
}
|
|
}
|
|
|
|
sub set_debugger {
|
|
if ( $debug < 10 || $debug > 12){
|
|
$end = '';
|
|
$start = '';
|
|
if ( $debug >= 20 ){
|
|
error_handler('not-in-irc', 'debug data generator') if $b_irc;
|
|
my $option = ( $debug > 22 ) ? 'main-full' : 'main';
|
|
$b_debug_gz = 1 if ($debug == 22 || $debug == 24);
|
|
my $ob_sys = SystemDebugger->new($option);
|
|
$ob_sys->run_debugger();
|
|
$ob_sys->upload_file($ftp_alt) if $debug > 20;
|
|
exit 0;
|
|
}
|
|
}
|
|
elsif ($debug >= 10 && $debug <= 12){
|
|
$b_log = 1;
|
|
if ($debug == 11){
|
|
$b_log_full = 1;
|
|
}
|
|
elsif ($debug == 12){
|
|
$b_log_colors = 1;
|
|
}
|
|
begin_logging();
|
|
}
|
|
}
|
|
|
|
## SystemDebugger
|
|
{
|
|
package SystemDebugger;
|
|
|
|
# use File::Find q(find);
|
|
#no warnings 'File::Find';
|
|
# use File::Spec::Functions;
|
|
#use File::Copy;
|
|
#use POSIX qw(strftime);
|
|
|
|
my $option = 'main';
|
|
my $upload = '';
|
|
my $data_dir = '';
|
|
my $debug_dir = '';
|
|
my $debug_gz = '';
|
|
my @content = ();
|
|
my $b_debug = 0;
|
|
my $b_delete_dir = 1;
|
|
# args: 1 - type
|
|
# args: 2 - upload
|
|
sub new {
|
|
my $class = shift;
|
|
($option) = @_;
|
|
my $self = {};
|
|
# print "$f\n";
|
|
# print "$option\n";
|
|
return bless $self, $class;
|
|
}
|
|
|
|
sub run_debugger {
|
|
require File::Copy;
|
|
import File::Copy;
|
|
require File::Spec::Functions;
|
|
import File::Spec::Functions;
|
|
|
|
print "Starting $self_name debugging data collector...\n";
|
|
create_debug_directory();
|
|
print "Note: for dmidecode data you must be root.\n" if !$b_root;
|
|
print $line3;
|
|
if (!$b_debug){
|
|
audio_data();
|
|
disk_data();
|
|
display_data();
|
|
network_data();
|
|
perl_modules();
|
|
system_data();
|
|
}
|
|
system_files();
|
|
print $line3;
|
|
if (!$b_debug){
|
|
if ( -d '/sys' && main::count_dir_files('/sys') ){
|
|
sys_tree();
|
|
sys_traverse_data();
|
|
}
|
|
else {
|
|
print "Skipping /sys data collection. /sys not present, or empty.\n";
|
|
}
|
|
print $line3;
|
|
}
|
|
run_self();
|
|
print $line3;
|
|
compress_dir();
|
|
}
|
|
|
|
sub create_debug_directory {
|
|
my $host = main::get_hostname();
|
|
$host =~ s/ /-/g;
|
|
$host ||= 'no-host';
|
|
my ($arm_string,$bsd_string,$root_string) = ('','','');
|
|
# note: Time::Piece was introduced in perl 5.9.5
|
|
my ($sec,$min,$hour,$mday,$mon,$year) = localtime;
|
|
my $version = substr($self_version,0,3);
|
|
$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';
|
|
}
|
|
$bsd_string = "-BSD-$bsd_type" if $bsd_type;
|
|
$arm_string = '-ARM' if $b_arm;
|
|
$debug_dir = "$self_name$arm_string$bsd_string-$host-$today$root_string-$version";
|
|
$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 "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', '-l'], # alsa
|
|
['pactl', 'list'], # pulseaudio
|
|
);
|
|
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');
|
|
@files = (@files,@files2) if @files2;
|
|
copy_files(\@files,'audio');
|
|
}
|
|
## 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/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/*/*');
|
|
@files = (@files, @ides) if @ides;
|
|
}
|
|
else {
|
|
push (@files, '/proc-ide-directory');
|
|
}
|
|
copy_files(\@files, 'disk');
|
|
my @cmds = (
|
|
['btrfs', 'filesystem show'],
|
|
['btrfs', 'filesystem show --mounted'],
|
|
# ['btrfs', 'filesystem show --all-devices'],
|
|
['df', '-h -T'],
|
|
['df', '-h'],
|
|
['df', '-k'],
|
|
['df', '-k -T'],
|
|
['df', '-k -T -P'],
|
|
['df', '-P'],
|
|
['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'],
|
|
['lsblk', '-rb --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,MOUNTPOINT'],
|
|
['lsblk', '-Pb --output NAME,PKNAME,TYPE,RM,FSTYPE,SIZE'],
|
|
['lsblk', '-Pb --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,SERIAL,MOUNTPOINT'],
|
|
['gpart', 'list'],
|
|
['gpart', 'show'],
|
|
['gpart', 'status'],
|
|
['ls', '-l /dev'],
|
|
['ls', '-l /dev/disk'],
|
|
['ls', '-l /dev/disk/by-id'],
|
|
['ls', '-l /dev/disk/by-label'],
|
|
['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/disk/by-path'],
|
|
['ls', '-l /dev/mapper'],
|
|
['mount', ''],
|
|
['nvme', 'present'],
|
|
['readlink', '/dev/root'],
|
|
['swapon', '-s'],
|
|
['zfs', 'list'],
|
|
['zpool', 'list'],
|
|
['zpool', 'list -v'],
|
|
);
|
|
run_commands(\@cmds,'disk');
|
|
@cmds = (
|
|
['atacontrol', 'list'],
|
|
['camcontrol', 'devlist'],
|
|
['glabel', 'status'],
|
|
['swapctl', '-l -k'],
|
|
['swapctl', '-l -k'],
|
|
['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');
|
|
}
|
|
push (@files, $files{'xorg-log'});
|
|
push (@files, '/etc/X11/xorg.conf');
|
|
copy_files(\@files,'display-xorg');
|
|
print "Collecting X, xprop, glxinfo, xrandr, xdpyinfo data, wayland, weston...\n";
|
|
%data = (
|
|
'desktop-session' => $ENV{'DESKTOP_SESSION'},
|
|
'gdmsession' => $ENV{'GDMSESSION'},
|
|
'gnome-desktop-session-id' => $ENV{'GNOME_DESKTOP_SESSION_ID'},
|
|
'kde3-full-session' => $ENV{'KDE_FULL_SESSION'},
|
|
'xdg-current-desktop' => $ENV{'XDG_CURRENT_DESKTOP'},
|
|
'kde-gte-4-session-version' => $ENV{'KDE_SESSION_VERSION'},
|
|
'xdg-session-desktop' => $ENV{'XDG_SESSION_DESKTOP'},
|
|
# wayland data collectors:
|
|
'xdg-session-type' => $ENV{'XDG_SESSION_TYPE'},
|
|
'wayland-display' => $ENV{'WAYLAND_DISPLAY'},
|
|
'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-indent' => $size{'indent'},
|
|
'size-indent-min' => $size{'indent-min'},
|
|
'size-cols-max' => $size{'max'},
|
|
);
|
|
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'],
|
|
['glxinfo',''],
|
|
['glxinfo','-B'],
|
|
['kded','--version'],
|
|
['kded1','--version'],
|
|
['kded2','--version'],
|
|
['kded3','--version'],
|
|
['kded4','--version'],
|
|
['kded5','--version'],
|
|
['kded6','--version'],
|
|
['kf4-config','--version'],
|
|
['kf5-config','--version'],
|
|
['kf6-config','--version'],
|
|
['kwin_x11','--version'],
|
|
['loginctl','--no-pager list-sessions'],
|
|
['nvidia-settings','-q screens'],
|
|
['nvidia-settings','-c :0.0 -q all'],
|
|
['nvidia-smi','-q'],
|
|
['nvidia-smi','-q -x'],
|
|
['plasmashell','--version'],
|
|
['weston-info',''],
|
|
['wmctrl','-m'],
|
|
['weston','--version'],
|
|
['xdpyinfo',''],
|
|
['Xorg','-version'],
|
|
['xprop','-root'],
|
|
['xrandr',''],
|
|
);
|
|
run_commands(\@cmds,'display');
|
|
}
|
|
sub network_data {
|
|
print "Collecting networking data...\n";
|
|
# no warnings 'uninitialized';
|
|
my @cmds = (
|
|
['ifconfig',''],
|
|
['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";
|
|
my %data = (
|
|
'cc' => $ENV{'CC'},
|
|
# @(#)MIRBSD KSH R56 2018/03/09: ksh and mksh
|
|
'ksh-version' => system('echo -n $KSH_VERSION'), # shell, not env, variable
|
|
'manpath' => $ENV{'MANPATH'},
|
|
'path' => $ENV{'PATH'},
|
|
'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', '-b kern.geom.conftxt'],
|
|
['sysctl', '-b kern.geom.confxml'],
|
|
['usbdevs','-v'],
|
|
# freebsd
|
|
['pciconf','-l -cv'],
|
|
['pciconf','-vl'],
|
|
['pciconf','-l'],
|
|
# openbsd
|
|
['pcidump',''],
|
|
['pcidump','-v'],
|
|
# netbsd
|
|
['kldstat',''],
|
|
['pcictl','list'],
|
|
['pcictl','list -ns'],
|
|
);
|
|
run_commands(\@cmds,'system-bsd');
|
|
# diskinfo -v <disk>
|
|
# fdisk <disk>
|
|
@cmds = (
|
|
['clang','--version'],
|
|
['dmidecode',''],
|
|
['dmesg',''],
|
|
['gcc','--version'],
|
|
['hciconfig','-a'],
|
|
['initctl','list'],
|
|
['ipmi-sensors',''],
|
|
['ipmi-sensors','--output-sensor-thresholds'],
|
|
['ipmitool','sensor'],
|
|
['lscpu',''],
|
|
['lspci','-k'],
|
|
['lspci','-knn'],
|
|
['lspci','-knnv'],# returns ports
|
|
['lspci','-n'],
|
|
['lspci','-nn'],
|
|
['lspci','-nnk'],
|
|
['lspci','-mm'],
|
|
['lspci','-mmk'],
|
|
['lspci','-mmkv'],
|
|
['lspci','-mmnn'],
|
|
['lspci','-v'],
|
|
['lspci',''],
|
|
['lsusb',''],
|
|
['lsusb','-v'],
|
|
['ps','aux'],
|
|
['ps','-e'],
|
|
['ps','-p 1'],
|
|
['runlevel',''],
|
|
['rc-status','-a'],
|
|
['rc-status','-l'],
|
|
['rc-status','-r'],
|
|
['sensors',''],
|
|
# 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','list-units'],
|
|
['systemctl','list-units --type=target'],
|
|
['systemd-detect-virt',''],
|
|
['uptime',''],
|
|
);
|
|
run_commands(\@cmds,'system');
|
|
@files = main::globber('/dev/bus/usb/*/*');
|
|
copy_files(\@files, 'system');
|
|
}
|
|
sub system_files {
|
|
print "Collecting system files data...\n";
|
|
my (%data,@files,@files2);
|
|
@files = RepoData::get($data_dir);
|
|
copy_files(\@files, 'repo');
|
|
# chdir "/etc";
|
|
@files = main::globber("/etc/*[-_]{[rR]elease,[vV]ersion}");
|
|
push (@files, '/etc/issue');
|
|
push (@files, '/etc/lsb-release');
|
|
push (@files, '/etc/os-release');
|
|
copy_files(\@files,'system-distro');
|
|
@files = (
|
|
'/proc/1/comm',
|
|
'/proc/cpuinfo',
|
|
'/proc/meminfo',
|
|
'/proc/modules',
|
|
'/proc/net/arp',
|
|
'/proc/version',
|
|
);
|
|
@files2=main::globber('/sys/class/power_supply/*/uevent');
|
|
if (@files2){
|
|
@files = (@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');
|
|
}
|
|
|
|
sub copy_files {
|
|
my ($files_ref, $type) = @_;
|
|
my ($absent,$error,$good,$name,$unreadable);
|
|
foreach (@$files_ref) {
|
|
$name = $_;
|
|
$name =~ s/^\///;
|
|
$name =~ s/\//-/g;
|
|
$name = "$data_dir/$type-file-$name";
|
|
$good = $name . '.txt';
|
|
$absent = $name . '-absent';
|
|
$error = $name . '-error';
|
|
$unreadable = $name . '-unreadable';
|
|
if (-e $_ ) {
|
|
if (-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 (@$cmds){
|
|
my @rows = @$_;
|
|
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 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);
|
|
}
|
|
}
|
|
}
|
|
|
|
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 $i = ($option eq 'main-full')? ' -i' : '';
|
|
my $cmd = "$self_path/$self_name -FRfrploudmxxx$i -c 0 --usb --slots --debug 10 -y 120 > $data_dir/$self_name-FRfrploudmxxxyusbslots120.txt 2>&1";
|
|
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");
|
|
}
|
|
|
|
sub sys_tree {
|
|
print "Constructing /sys tree data...\n";
|
|
if ( main::check_program('tree') ){
|
|
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);
|
|
}
|
|
}
|
|
# for now, we want all of these as well for better debugging
|
|
#else {
|
|
sys_ls(1);
|
|
sys_ls(2);
|
|
sys_ls(3);
|
|
sys_ls(4);
|
|
#}
|
|
}
|
|
sub sys_ls {
|
|
my ( $depth) = @_;
|
|
my $cmd = do {
|
|
if ( $depth == 1 ){ 'ls -l /sys/ 2>/dev/null' }
|
|
elsif ( $depth == 2 ){ 'ls -l /sys/*/ 2>/dev/null' }
|
|
elsif ( $depth == 3 ){ 'ls -l /sys/*/*/ 2>/dev/null' }
|
|
elsif ( $depth == 4 ){ 'ls -l /sys/*/*/*/ 2>/dev/null' }
|
|
elsif ( $depth == 5 ){ 'ls -l /sys/*/*/*/*/ 2>/dev/null' }
|
|
elsif ( $depth == 5 ){ 'ls -l /sys/*/*/*/*/ 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 - ";
|
|
}
|
|
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/sys-data-ls-$depth.txt";
|
|
open my $fh, '>', $file or main::error_handler('create',"$file", "$!");
|
|
print $fh $output;
|
|
close $fh;
|
|
# print "$output\n";
|
|
}
|
|
|
|
sub sys_traverse_data {
|
|
print "Parsing /sys files...\n";
|
|
# get rid pointless error:Can't cd to (/sys/kernel/) debug: Permission denied
|
|
no warnings 'File::Find';
|
|
File::Find::find( \&wanted, "/sys");
|
|
process_data();
|
|
}
|
|
sub wanted {
|
|
return if -d; # not directory
|
|
return unless -e; # Must exist
|
|
return unless -r; # Must be readable
|
|
return unless -f; # Must be file
|
|
# note: a new file in 4.11 /sys can hang this, it is /parameter/ then
|
|
# a few variables. Since inxi does not need to see that file, we will
|
|
# not use it. Also do not need . files or __ starting files
|
|
# print $File::Find::name . "\n";
|
|
# block maybe: cfgroup\/
|
|
return if $File::Find::name =~ /\/(\.[a-z]|kernel\/|parameters\/|debug\/)/;
|
|
# 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
|
|
return unless -T;
|
|
# print $File::Find::name . "\n";
|
|
push (@content, $File::Find::name);
|
|
return;
|
|
}
|
|
sub process_data {
|
|
my ($data,$fh,$result,$row,$sep);
|
|
my $filename = "sys-data-parse.txt";
|
|
# no sorts, we want the order it comes in
|
|
# @content = sort @content;
|
|
foreach (@content){
|
|
$data='';
|
|
$sep='';
|
|
open($fh, '<', $_);
|
|
while ($row = <$fh>) {
|
|
chomp $row;
|
|
$data .= $sep . '"' . $row . '"';
|
|
$sep=', ';
|
|
}
|
|
$result .= "$_:[$data]\n";
|
|
# print "$_:[$data]\n"
|
|
}
|
|
# print scalar @content . "\n";
|
|
open ($fh, '>', "$data_dir/$filename");
|
|
print $fh $result;
|
|
close $fh;
|
|
# print $fh "$result";
|
|
}
|
|
# args: 1 - path to file to be uploaded
|
|
# args: 2 - optional: alternate ftp upload url
|
|
# NOTE: must be in format: ftp.site.com/incoming
|
|
sub upload_file {
|
|
require Net::FTP;
|
|
import Net::FTP;
|
|
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);
|
|
$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 ($b_debug_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");
|
|
}
|
|
}
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### DOWNLOADER
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub download_file {
|
|
my ($type, $url, $file) = @_;
|
|
my ($cmd,$args,$timeout) = ('','','');
|
|
my $debug_data = '';
|
|
my $result = 1;
|
|
$dl{'no-ssl-opt'} ||= '';
|
|
$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-opt'}\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($type, $url, $file);
|
|
$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
|
|
else {
|
|
if ($type eq 'stdout'){
|
|
$args = $dl{'stdout'};
|
|
$cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $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-opt'} $timeout $args $file $url $dl{'null'}";
|
|
system($cmd);
|
|
$result = ($?) ? 0 : 1; # reverse these into Perl t/f
|
|
$debug_data = $result;
|
|
}
|
|
elsif ( $dl{'dl'} eq 'wget' && $type eq 'spider'){
|
|
$cmd = "$dl{'dl'} $dl{'no-ssl-opt'} $timeout $dl{'spider'} $url";
|
|
system($cmd);
|
|
$result = ($?) ? 0 : 1; # reverse these into Perl t/f
|
|
$debug_data = $result;
|
|
}
|
|
}
|
|
print "-------\nDownloader Data:\n$cmd\nResult: $debug_data\n" if $test[1];
|
|
log_data('data',"$cmd\nResult: $result") if $b_log;
|
|
return $result;
|
|
}
|
|
|
|
sub get_file {
|
|
my ($type, $url, $file) = @_;
|
|
my $response = HTTP::Tiny->new->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 $test[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;
|
|
$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'}){
|
|
if (check_module('HTTP::Tiny') && check_module('IO::Socket::SSL')){
|
|
import HTTP::Tiny;
|
|
import IO::Socket::SSL;
|
|
$dl{'tiny'} = 1;
|
|
}
|
|
else {
|
|
$dl{'tiny'} = 0;
|
|
}
|
|
}
|
|
#print $dl{'tiny'} . "\n";
|
|
if ($dl{'tiny'}){
|
|
$dl{'dl'} = 'tiny';
|
|
$dl{'file'} = '';
|
|
$dl{'stdout'} = '';
|
|
$dl{'timeout'} = '';
|
|
}
|
|
elsif ( $dl{'curl'} && check_program('curl') ){
|
|
$dl{'dl'} = 'curl';
|
|
$dl{'file'} = ' -L -s -o ';
|
|
$dl{'no-ssl'} = ' --insecure';
|
|
$dl{'stdout'} = ' -L -s ';
|
|
$dl{'timeout'} = ' -y ';
|
|
}
|
|
elsif ($dl{'wget'} && check_program('wget') ){
|
|
$dl{'dl'} = 'wget';
|
|
$dl{'file'} = ' -q -O ';
|
|
$dl{'no-ssl'} = ' --no-check-certificate';
|
|
$dl{'spider'} = ' -q --spider';
|
|
$dl{'stdout'} = ' -q -O -';
|
|
$dl{'timeout'} = ' -T ';
|
|
}
|
|
elsif ($dl{'fetch'} && check_program('fetch')){
|
|
$dl{'dl'} = 'fetch';
|
|
$dl{'file'} = ' -q -o ';
|
|
$dl{'no-ssl'} = ' --no-verify-peer';
|
|
$dl{'stdout'} = ' -q -o -';
|
|
$dl{'timeout'} = ' -T ';
|
|
}
|
|
elsif ( $bsd_type eq 'openbsd' && check_program('ftp') ){
|
|
$dl{'dl'} = 'ftp';
|
|
$dl{'file'} = ' -o ';
|
|
$dl{'null'} = ' 2>/dev/null';
|
|
$dl{'stdout'} = ' -o - ';
|
|
$dl{'timeout'} = '';
|
|
}
|
|
else {
|
|
$dl{'dl'} = '';
|
|
}
|
|
# no-ssl-opt is set to 1 with --no-ssl, so it is true, then assign
|
|
$dl{'no-ssl-opt'} = $dl{'no-ssl'} if $dl{'no-ssl-opt'};
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_perl_downloader {
|
|
my ($downloader) = @_;
|
|
$downloader =~ s/perl/tiny/;
|
|
return $downloader;
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### ERROR HANDLER
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub error_handler {
|
|
my ( $err, $one, $two) = @_;
|
|
my ($b_recommends,$b_help,$errno) = (0,0,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; "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!" }
|
|
## 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-login' ) {
|
|
$errno=71; "There was an error with login to ftp server: $one" }
|
|
elsif ( $err eq 'ftp-upload' ) {
|
|
$errno=72; "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" }
|
|
## 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");
|
|
}
|
|
exit 0;
|
|
}
|
|
|
|
sub error_defaults {
|
|
my ($type,$one) = @_;
|
|
$one ||= '';
|
|
my %errors = (
|
|
'download-error' => "Download Failure:\n$one\n",
|
|
);
|
|
return $errors{$type};
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### RECOMMENDS
|
|
#### -------------------------------------------------------------------
|
|
|
|
## CheckRecommends
|
|
{
|
|
package CheckRecommends;
|
|
sub run {
|
|
main::error_handler('not-in-irc', 'recommends') if $b_irc;
|
|
my (@data,@rows);
|
|
my $line = make_line();
|
|
my $pm = get_pm();
|
|
@data = basic_data($line);
|
|
push @rows,@data;
|
|
if (!$bsd_type){
|
|
@data = check_items('required system directories',$line,$pm);
|
|
push @rows,@data;
|
|
}
|
|
@data = check_items('recommended system programs',$line,$pm);
|
|
push @rows,@data;
|
|
@data = check_items('recommended display information programs',$line,$pm);
|
|
push @rows,@data;
|
|
@data = check_items('recommended downloader programs',$line,$pm);
|
|
push @rows,@data;
|
|
@data = check_items('recommended Perl modules',$line,$pm);
|
|
push @rows,@data;
|
|
@data = check_items('recommended directories',$line,'');
|
|
push @rows,@data;
|
|
@data = check_items('recommended files',$line,'');
|
|
push @rows,@data;
|
|
@data = (
|
|
['0', '', '', "$line"],
|
|
['0', '', '', "Ok, all done with the checks. Have a nice day."],
|
|
['0', '', '', " "],
|
|
);
|
|
push @rows,@data;
|
|
#print Data::Dumper::Dumper \@rows;
|
|
main::print_basic(@rows);
|
|
exit 1;
|
|
}
|
|
|
|
sub basic_data {
|
|
my ($line) = @_;
|
|
my (@data,@rows);
|
|
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);
|
|
@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" ],
|
|
);
|
|
return @rows;
|
|
}
|
|
sub check_items {
|
|
my ($type,$line,$pm) = @_;
|
|
my (@data,%info,@missing,$row,@rows,$result,@unreadable);
|
|
my ($b_dir,$b_file,$b_module,$b_program,$item);
|
|
my ($about,$extra,$extra2,$extra3,$extra4,$info_os,$install) = ('','','','','','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 dmidecode fdisk file glabel gpart ifconfig ipmi-sensors
|
|
ipmitool lsusb sudo smartctl sysctl tree uptime usbdevs);
|
|
$info_os = 'info-bsd';
|
|
}
|
|
else {
|
|
@data = qw(dig dmidecode fdisk file hddtemp ifconfig ip ipmitool ipmi-sensors
|
|
lsblk lsusb modinfo runlevel sensors strings sudo tree 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(glxinfo wmctrl xdpyinfo xprop xrandr);
|
|
$info_os = 'info-bsd';
|
|
}
|
|
else {
|
|
@data = qw(glxinfo wmctrl xdpyinfo xprop 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(HTTP::Tiny IO::Socket::SSL Time::HiRes Cpanel::JSON::XS JSON::XS XML::Dumper);
|
|
$b_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.";
|
|
}
|
|
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);
|
|
}
|
|
$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.";
|
|
}
|
|
@rows = (
|
|
['0', '', '', "$line" ],
|
|
['0', '', '', "Test: $type$extra:" ],
|
|
['0', '', '', " " ],
|
|
);
|
|
if ($extra2){
|
|
$rows[scalar @rows] = (['0', '', '', $extra2]);
|
|
$rows[scalar @rows] = (['0', '', '', ' ']);
|
|
}
|
|
if ($extra3){
|
|
$rows[scalar @rows] = (['0', '', '', $extra3]);
|
|
$rows[scalar @rows] = (['0', '', '', ' ']);
|
|
}
|
|
foreach (@data){
|
|
$install = '';
|
|
$about = '';
|
|
%info = item_data($_);
|
|
$about = $info{$info_os};
|
|
if ( ( $b_dir && -d $_ ) || ( $b_file && -r $_ ) ||
|
|
($b_program && main::check_program($_) ) || ($b_module && main::check_module($_)) ){
|
|
$result = 'Present';
|
|
}
|
|
elsif ($b_file && -f $_){
|
|
$result = 'Unreadable';
|
|
push @unreadable, "$_";
|
|
}
|
|
else {
|
|
$result = 'Missing';
|
|
$install = " ~ Install package: $info{$pm}" if (($b_program || $b_module) && $pm);
|
|
push @missing, "$_$install";
|
|
}
|
|
$row = make_row($_,$about,$result);
|
|
$rows[scalar @rows] = (['0', '', '', $row]);
|
|
}
|
|
$rows[scalar @rows] = (['0', '', '', " "]);
|
|
if (@missing){
|
|
$rows[scalar @rows] = (['0', '', '', "The following $type are missing$extra4:"]);
|
|
foreach (@missing) {
|
|
$rows[scalar @rows] = (['0', '', '', "$item: $_"]);
|
|
}
|
|
}
|
|
if (@unreadable){
|
|
$rows[scalar @rows] = (['0', '', '', "The following $type are not readable: "]);
|
|
foreach (@unreadable) {
|
|
$rows[scalar @rows] = (['0', '', '', "$item: $_"]);
|
|
}
|
|
}
|
|
if (!@missing && !@unreadable){
|
|
$rows[scalar @rows] = (['0', '', '', "All $type are present"]);
|
|
}
|
|
return @rows;
|
|
}
|
|
|
|
sub item_data {
|
|
my ($type) = @_;
|
|
my %data = (
|
|
# directory data
|
|
'/sys/class/dmi/id' => ({
|
|
'info' => '-M system, motherboard, bios',
|
|
}),
|
|
'/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' => '',
|
|
}),
|
|
# 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',
|
|
}),
|
|
# system tools
|
|
# apt-dpkg,apt-get; pm-arch,pacman; rpm-redhat,suse
|
|
'curl' => ({
|
|
'info' => '-i (if no dig); -w,-W; -U',
|
|
'info-bsd' => '-i (if no dig); -w,-W; -U',
|
|
'apt' => 'curl',
|
|
'pacman' => 'curl',
|
|
'rpm' => 'curl',
|
|
}),
|
|
'camcontrol' => ({
|
|
'info' => '',
|
|
'info-bsd' => '-R; -D; -P. Get actual gptid /dev path',
|
|
'apt' => '',
|
|
'pacman' => '',
|
|
'rpm' => '',
|
|
}),
|
|
'dig' => ({
|
|
'info' => '-i wlan IP',
|
|
'info-bsd' => '-i wlan IP',
|
|
'apt' => 'dnsutils',
|
|
'pacman' => 'dnsutils',
|
|
'rpm' => 'bind-utils',
|
|
}),
|
|
'dmidecode' => ({
|
|
'info' => '-M if no sys machine data; -m',
|
|
'info-bsd' => '-M if null sysctl; -m; -B if null sysctl',
|
|
'apt' => 'dmidecode',
|
|
'pacman' => 'dmidecode',
|
|
'rpm' => 'dmidecode',
|
|
}),
|
|
'fdisk' => ({
|
|
'info' => '-D partition scheme (fallback)',
|
|
'info-bsd' => '-D partition scheme',
|
|
'apt' => 'fdisk',
|
|
'pacman' => 'util-linux',
|
|
'rpm' => 'util-linux',
|
|
}),
|
|
'fetch' => ({
|
|
'info' => '',
|
|
'info-bsd' => '-i (if no dig); -w,-W; -U',
|
|
'apt' => '',
|
|
'pacman' => '',
|
|
'rpm' => '',
|
|
}),
|
|
'file' => ({
|
|
'info' => '-o unmounted file system (if no lsblk)',
|
|
'info-bsd' => '-o unmounted file system',
|
|
'apt' => 'file',
|
|
'pacman' => 'file',
|
|
'rpm' => 'file',
|
|
}),
|
|
'ftp' => ({
|
|
'info' => '',
|
|
'info-bsd' => '-i (if no dig); -w,-W; -U',
|
|
'apt' => '',
|
|
'pacman' => '',
|
|
'rpm' => '',
|
|
}),
|
|
'glabel' => ({
|
|
'info' => '',
|
|
'info-bsd' => '-R; -D; -P. Get actual gptid /dev path',
|
|
'apt' => '',
|
|
'pacman' => '',
|
|
'rpm' => '',
|
|
}),
|
|
'gpart' => ({
|
|
'info' => '',
|
|
'info-bsd' => '-p,-P file system, size',
|
|
'apt' => '',
|
|
'pacman' => '',
|
|
'rpm' => '',
|
|
}),
|
|
'hciconfig' => ({
|
|
'info' => 'Experimental',
|
|
'info-bsd' => '',
|
|
'apt' => 'bluez',
|
|
'pacman' => 'bluez-utils',
|
|
'rpm' => 'bluez-utils',
|
|
}),
|
|
'hddtemp' => ({
|
|
'info' => '-Dx show hdd temp',
|
|
'info-bsd' => '-Dx show hdd temp',
|
|
'apt' => 'hddtemp',
|
|
'pacman' => 'hddtemp',
|
|
'rpm' => 'hddtemp',
|
|
}),
|
|
'ifconfig' => ({
|
|
'info' => '-i ip LAN (deprecated)',
|
|
'info-bsd' => '-i ip LAN',
|
|
'apt' => 'net-tools',
|
|
'pacman' => 'net-tools',
|
|
'rpm' => 'net-tools',
|
|
}),
|
|
'ip' => ({
|
|
'info' => '-i ip LAN',
|
|
'info-bsd' => '',
|
|
'apt' => 'iproute',
|
|
'pacman' => 'iproute2',
|
|
'rpm' => 'iproute',
|
|
}),
|
|
'ipmi-sensors' => ({
|
|
'info' => '-s IPMI sensors (servers)',
|
|
'info-bsd' => '',
|
|
'apt' => 'freeipmi-tools',
|
|
'pacman' => 'freeipmi',
|
|
'rpm' => 'freeipmi',
|
|
}),
|
|
'ipmitool' => ({
|
|
'info' => '-s IPMI sensors (servers)',
|
|
'info-bsd' => '-s IPMI sensors (servers)',
|
|
'apt' => 'ipmitool',
|
|
'pacman' => 'ipmitool',
|
|
'rpm' => 'ipmitool',
|
|
}),
|
|
'lsblk' => ({
|
|
'info' => '-o unmounted file system (best option)',
|
|
'info-bsd' => '-o unmounted file system',
|
|
'apt' => 'util-linux',
|
|
'pacman' => 'util-linux',
|
|
'rpm' => 'util-linux-ng',
|
|
}),
|
|
'lsusb' => ({
|
|
'info' => '-A usb audio; -N usb networking; --usb',
|
|
'info-bsd' => '-A; -N; --usb. Alternate to usbdevs',
|
|
'apt' => 'usbutils',
|
|
'pacman' => 'usbutils',
|
|
'rpm' => 'usbutils',
|
|
}),
|
|
'modinfo' => ({
|
|
'info' => 'Ax; -Nx module version',
|
|
'info-bsd' => '',
|
|
'apt' => 'module-init-tools',
|
|
'pacman' => 'module-init-tools',
|
|
'rpm' => 'module-init-tools',
|
|
}),
|
|
'runlevel' => ({
|
|
'info' => '-I fallback to Perl',
|
|
'info-bsd' => '',
|
|
'apt' => 'systemd or sysvinit',
|
|
'pacman' => 'systemd',
|
|
'rpm' => 'systemd or sysvinit',
|
|
}),
|
|
'sensors' => ({
|
|
'info' => '-s sensors output',
|
|
'info-bsd' => '',
|
|
'apt' => 'lm-sensors',
|
|
'pacman' => 'lm-sensors',
|
|
'rpm' => 'lm-sensors',
|
|
}),
|
|
'smartctl' => ({
|
|
'info' => '-Dx show hdd temp',
|
|
'info-bsd' => '-Dx show hdd temp',
|
|
'apt' => '',
|
|
'pacman' => '',
|
|
'rpm' => '',
|
|
}),
|
|
'strings' => ({
|
|
'info' => '-I sysvinit version',
|
|
'info-bsd' => '',
|
|
'apt' => 'binutils',
|
|
'pacman' => '?',
|
|
'rpm' => '?',
|
|
}),
|
|
'sysctl' => ({
|
|
'info' => '',
|
|
'info-bsd' => '-C; -I; -m; -tm',
|
|
'apt' => '?',
|
|
'pacman' => '?',
|
|
'rpm' => '?',
|
|
}),
|
|
'sudo' => ({
|
|
'info' => '-Dx hddtemp-user; -o file-user',
|
|
'info-bsd' => '-Dx hddtemp-user; -o file-user',
|
|
'apt' => 'sudo',
|
|
'pacman' => 'sudo',
|
|
'rpm' => 'sudo',
|
|
}),
|
|
'tree' => ({
|
|
'info' => '--debugger 20,21 /sys tree',
|
|
'info-bsd' => '--debugger 20,21 /sys tree',
|
|
'apt' => 'tree',
|
|
'pacman' => 'tree',
|
|
'rpm' => 'tree',
|
|
}),
|
|
'uptime' => ({
|
|
'info' => '-I uptime',
|
|
'info-bsd' => '-I uptime',
|
|
'apt' => 'procps',
|
|
'pacman' => 'procps',
|
|
'rpm' => 'procps',
|
|
}),
|
|
'usbdevs' => ({
|
|
'info' => '',
|
|
'info-bsd' => '-A; -N; --usb;',
|
|
'apt' => 'usbutils',
|
|
'pacman' => 'usbutils',
|
|
'rpm' => 'usbutils',
|
|
}),
|
|
'wget' => ({
|
|
'info' => '-i (if no dig); -w,-W; -U',
|
|
'info-bsd' => '-i (if no dig); -w,-W; -U',
|
|
'apt' => 'wget',
|
|
'pacman' => 'wget',
|
|
'rpm' => 'wget',
|
|
}),
|
|
# display tools
|
|
'glxinfo' => ({
|
|
'info' => '-G glx info',
|
|
'info-bsd' => '-G glx info',
|
|
'apt' => 'mesa-utils',
|
|
'pacman' => 'mesa-demos',
|
|
'rpm' => 'glx-utils (openSUSE 12.3 and later Mesa-demo-x)',
|
|
}),
|
|
'wmctrl' => ({
|
|
'info' => '-S active window manager (not all wm)',
|
|
'info-bsd' => '-S active window managerr (not all wm)',
|
|
'apt' => 'wmctrl',
|
|
'pacman' => 'wmctrl',
|
|
'rpm' => 'wmctrl',
|
|
}),
|
|
'xdpyinfo' => ({
|
|
'info' => '-G multi screen resolution',
|
|
'info-bsd' => '-G multi screen resolution',
|
|
'apt' => 'X11-utils',
|
|
'pacman' => 'xorg-xdpyinfo',
|
|
'rpm' => 'xorg-x11-utils',
|
|
}),
|
|
'xprop' => ({
|
|
'info' => '-S desktop data',
|
|
'info-bsd' => '-S desktop data',
|
|
'apt' => 'X11-utils',
|
|
'pacman' => 'xorg-xprop',
|
|
'rpm' => 'x11-utils',
|
|
}),
|
|
'xrandr' => ({
|
|
'info' => '-G single screen resolution',
|
|
'info-bsd' => '-G single screen resolution',
|
|
'apt' => 'x11-xserver-utils',
|
|
'pacman' => 'xrandr',
|
|
'rpm' => 'x11-server-utils',
|
|
}),
|
|
# Perl modules
|
|
'Cpanel::JSON::XS' => ({
|
|
'info' => '--output json - required for export.',
|
|
'info-bsd' => '--output json - required for export.',
|
|
'apt' => 'libcpanel-json-xs-perl',
|
|
'pacman' => 'perl-cpanel-json-xs',
|
|
'rpm' => 'perl-Cpanel-JSON-XS',
|
|
}),
|
|
'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',
|
|
'pacman' => 'Core Modules',
|
|
'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',
|
|
'rpm' => 'perl-IO-Socket-SSL',
|
|
}),
|
|
'JSON::XS' => ({
|
|
'info' => '--output json - required for export (legacy).',
|
|
'info-bsd' => '--output json - required for export (legacy).',
|
|
'apt' => 'libjson-xs-perl',
|
|
'pacman' => 'perl-json-xs',
|
|
'rpm' => 'perl-JSON-XS',
|
|
}),
|
|
'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',
|
|
'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',
|
|
'rpm' => 'perl-XML-Dumper',
|
|
}),
|
|
);
|
|
my $ref = $data{$type};
|
|
my %values = %$ref;
|
|
return %values;
|
|
}
|
|
sub get_pm {
|
|
my ($pm) = ('');
|
|
if (main::check_program('dpkg')){
|
|
$pm = 'apt';
|
|
}
|
|
elsif (main::check_program('pacman')){
|
|
$pm = 'pacman';
|
|
}
|
|
elsif (main::check_program('rpm')){
|
|
$pm = 'rpm';
|
|
}
|
|
return $pm;
|
|
}
|
|
# note: end will vary, but should always be treated as longest value possible.
|
|
# expected values: Present/Missing
|
|
sub make_row {
|
|
my ($start,$middle,$end) = @_;
|
|
my ($dots,$line,$sep) = ('','',': ');
|
|
foreach (0 .. ($size{'max'} - 16 - length("$start$middle"))){
|
|
$dots .= '.';
|
|
}
|
|
$line = "$start$sep$middle$dots $end";
|
|
return $line;
|
|
}
|
|
sub make_line {
|
|
my $line = '';
|
|
foreach (0 .. $size{'max'} - 2 ){
|
|
$line .= '-';
|
|
}
|
|
return $line;
|
|
}
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### TOOLS
|
|
#### -------------------------------------------------------------------
|
|
|
|
# Duplicates the functionality of awk to allow for one liner
|
|
# type data parsing. note: -1 corresponds to awk NF
|
|
# args 1: array of data; 2: search term; 3: field result; 4: separator
|
|
# 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){
|
|
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;
|
|
}
|
|
|
|
# $1 - Perl module to check
|
|
sub check_module {
|
|
my ($module) = @_;
|
|
my $b_present = 0;
|
|
eval "require $module";
|
|
$b_present = 1 if !$@;
|
|
return $b_present;
|
|
}
|
|
|
|
# arg: 1 - 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;
|
|
}
|
|
}
|
|
}
|
|
|
|
# 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 ..
|
|
return $count;
|
|
}
|
|
|
|
# args: 1 - the string to get piece of
|
|
# 2 - the position in string, starting at 1 for 0 index.
|
|
# 3 - the separator, default is ' '
|
|
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];
|
|
}
|
|
}
|
|
|
|
# arg: 1 - command to turn into an array; 2 - optional: splitter
|
|
# 3 - 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) = @_;
|
|
$split ||= "\n";
|
|
my @rows = split /$split/, qx($cmd);
|
|
if ($strip && @rows){
|
|
@rows = grep {/^\s*[^#]/} @rows;
|
|
@rows = map {s/^\s+|\s+$//g; $_} @rows if @rows;
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
|
|
# args: 1 - string value to glob
|
|
sub globber {
|
|
eval $start if $b_log;
|
|
my @files = <$_[0]>;
|
|
eval $end if $b_log;
|
|
return @files;
|
|
}
|
|
|
|
# gets array ref, which may be undefined, plus join string
|
|
# this helps avoid debugger print errors when we are printing arrays
|
|
# which we don't know are defined or not null.
|
|
# args: 1 - array ref; 2 - join string; 3 - default value, optional
|
|
sub joiner {
|
|
my ($ref,$join,$default) = @_;
|
|
my @arr = @$ref;
|
|
$default ||= '';
|
|
my $string = '';
|
|
foreach (@arr){
|
|
if (defined $_){
|
|
$string .= $_ . $join;
|
|
}
|
|
else {
|
|
$string .= $default . $join;
|
|
}
|
|
}
|
|
return $string;
|
|
}
|
|
|
|
# returns array of:
|
|
# 0 - match string; 1 - search number; 2 - version string; 3 - Print name
|
|
# 4 - console 0/1; 5 - 0/1 exit version loop at first iteration;
|
|
# 6 - 0/1 write to stderr
|
|
# arg: 1 - program lower case name
|
|
sub program_values {
|
|
my ($app) = @_;
|
|
my (@client_data);
|
|
my %data = (
|
|
## 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
|
|
'afterstep' => ['^afterstep',3,'--version','AfterStep',0,1,0],
|
|
'awesome' => ['^awesome',2,'--version','Awesome',0,1,0],
|
|
'blackbox' => ['^Blackbox',2,'--version','Blackbox',0,1,0],
|
|
'budgie' => ['^budgie-desktop',2,'--version','Budgie',0,1,0],
|
|
'cinnamon' => ['^cinnamon',2,'--version','Cinnamon',0,1,0],
|
|
'dwm' => ['^dwm',1,'-v','dwm',0,1,1],
|
|
'fluxbox' => ['^fluxbox',2,'--version','Fluxbox',0,1,0],
|
|
'fvwm' => ['^fvwm',2,'--version','FVWM',0,0,1],
|
|
# command: fvwm
|
|
'fvwm-crystal' => ['^fvwm',2,'--version','FVWM-Crystal',0,0,0],
|
|
'gnome-about' => ['gnome',3,'--version','Gnome',0,1,0],
|
|
'gnome-shell' => ['gnome',3,'--version','Gnome',0,1,0],
|
|
'herbstluftwm' => ['^herbstluftwm',-1,'--version','herbstluftwm',0,1,0],
|
|
'jwm' => ['^jwm',2,'--version','JWM',0,1,0],
|
|
# i3 version 4.13 (2016-11-08) © 2009 Michael Stapelberg and contributors
|
|
'i3' => ['^i3',3,'--version','i3',0,1,0],
|
|
'icewm' => ['^icewm',2,'--version','IceWM',0,1,0],
|
|
'kded' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
|
|
'kded1' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
|
|
'kded2' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
|
|
'kded3' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
|
|
'kded4' => ['^KDE Development Platform:',4,'--version','KDE',0,1,0],
|
|
# command: lxqt-about
|
|
'lxqt' => ['^lxqt-about',2,'--version','LXQT',0,1,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],
|
|
'openbox' => ['^openboxt',2,'--version','Openbox',0,1,0],
|
|
'pekwm' => ['^pekwm',3,'--version','pekwm',0,1,0],
|
|
'plasmashell' => ['^plasmashell',2,'--version','KDE Plasma',0,1,0],
|
|
'qtdiag' => ['^qt',2,'--version','Qt',0,1,0],
|
|
'sawfish' => ['^sawfish',3,'--version','Sawfish',0,1,0],
|
|
'scrotwm' => ['^welcome.*scrotwm',4,'-v','Scrotwm',0,1,1],
|
|
'spectrwm' => ['^spectrwm.*welcome.*spectrwm',5,'-v','Spectrwm',0,1,0],
|
|
'unity' => ['^unity',2,'--version','Unity',0,1,0],
|
|
'wm2' => ['^wm2',-1,'--version','WM2',0,1,0],
|
|
'wmaker' => ['^Window[[:space:]]*Maker',-1,'--version','WindowMaker',0,1,0],
|
|
'wmii' => ['^wmii',1,'--version','wmii',0,1,0], # note: in debian, wmii is wmii3
|
|
'wmii2' => ['^wmii2',1,'--version','wmii2',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],
|
|
## Shells
|
|
'bash' => ['^GNU[[:space:]]bash,[[:space:]]version',4,'--version','Bash',1,0,0],
|
|
'csh' => ['^tcsh',2,'--version','csh',1,0,0],
|
|
'dash' => ['dash',3,'--version','Dash',1,0,0], # no version, uses dpkg query, sigh
|
|
# ksh/lksh/mksh/pdksh can't be handled with version but we'll use the search string to
|
|
# trigger version return and tests
|
|
'ksh' => ['ksh',5,'-v','ksh',1,0,0],
|
|
'lksh' => ['ksh',5,'-v','lksh',1,0,0],
|
|
'loksh' => ['ksh',5,'-v','lksh',1,0,0],
|
|
'mksh' => ['ksh',5,'-v','mksh',1,0,0],
|
|
'pdksh' => ['ksh',5,'-v','pdksh',1,0,0],
|
|
'tcsh' => ['^tcsh',2,'--version','tcsh',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
|
|
);
|
|
if ( defined $data{$app} ){
|
|
my $ref = $data{$app};
|
|
@client_data = @$ref;
|
|
}
|
|
#my $debug = main::Dumper \@client_data;
|
|
main::log_data('dump',"Client Data",\@client_data) if $b_log;
|
|
return @client_data;
|
|
}
|
|
|
|
# args: 1 - desktop/app command for --version; 2 - search string;
|
|
# 3 - space print number; 4 - [optional] version arg: -v, version, etc
|
|
# 5 - [optional] exit first find 0/1; 6 - [optional] 0/1 stderr output
|
|
sub program_version {
|
|
eval $start if $b_log;
|
|
my ($app, $search, $num,$version,$exit,$b_stderr) = @_;
|
|
my ($cmd,$line,$output);
|
|
my $version_nu = '';
|
|
my $count = 0;
|
|
$exit ||= 100; # basically don't exit ever
|
|
$version ||= '--version';
|
|
# adjust to array index, not human readable
|
|
$num-- if (defined $num && $num > 0);
|
|
# ksh: Version JM 93t+ 2010--03-05
|
|
# mksh: @(#)MIRBSD KSH R56 2018/03/09
|
|
# loksh: @(#)PD KSH v5.2.14 99/07/13.2
|
|
# --version opens a new ksh, sigh... This so far does not work
|
|
# because the ENV/Shell variable is not visible in subshells
|
|
if ($search eq 'ksh'){
|
|
my $ksh = system('echo -n $KSH_VERSION');
|
|
if ( $ksh ){
|
|
my @temp = split /\s+/, $ksh;
|
|
if ($temp[2]){
|
|
$temp[2] =~ s/^v//i; # trim off leading v
|
|
log_data('data',"Program *ksh array: @temp version: $temp[2]") if $b_log;
|
|
return $temp[2];
|
|
}
|
|
}
|
|
return 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 ( $app !~ /^\// ){
|
|
if (my $program = check_program($app) ){
|
|
$app = $program;
|
|
}
|
|
else {
|
|
log_data('data',"$app not found in path.");
|
|
return 0;
|
|
}
|
|
}
|
|
# note, some wm/apps send version info to stderr instead of stdout
|
|
if ( $b_stderr ) {
|
|
$cmd = "$app $version 2>&1";
|
|
}
|
|
# elsif ( $app eq 'csh' ){
|
|
# $app = 'tcsh';
|
|
# }
|
|
# quick debian/buntu hack until I find a universal way to get version for these
|
|
elsif ( $app eq 'dash' ){
|
|
$cmd = "dpkg -l $app 2>/dev/null";
|
|
}
|
|
else {
|
|
$cmd = "$app $version 2>/dev/null";
|
|
}
|
|
log_data('data',"version: $version num: $num search: $search command: $cmd") if $b_log;
|
|
$output = qx($cmd);
|
|
# print "$cmd : $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 "$_ ::$num\n";
|
|
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/(\([^)]+\)|,|dwm-|wmii2-|wmii-|v|V|\||\(|\))//g 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";
|
|
|
|
# arg: 1 - full file path, returns array of file lines.
|
|
# 2 - optionsl, strip and clean data
|
|
# note: chomp has to chomp the entire action, not just <$fh>
|
|
sub reader {
|
|
eval $start if $b_log;
|
|
my ($file,$strip) = @_;
|
|
return if ! $file;
|
|
open( my $fh, '<', $file ) or error_handler('open', $file, $!);
|
|
chomp(my @rows = <$fh>);
|
|
if ($strip && @rows){
|
|
@rows = grep {/^\s*[^#]/} @rows;
|
|
@rows = map {s/^\s+|\s+$//g; $_} @rows if @rows;
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
|
|
# args: 1 - 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
|
|
# arg: 1 - 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: 1 - hash
|
|
# send array, assign to hash, return array, uniq values only.
|
|
sub uniq {
|
|
my %seen;
|
|
grep !$seen{$_}++, @_;
|
|
}
|
|
|
|
# arg: 1 file full path to write to; 2 - arrayof data to write.
|
|
# note: turning off strict refs so we can pass it a scalar or an array reference.
|
|
sub writer {
|
|
my ($path, $ref_content) = @_;
|
|
my ($content);
|
|
no strict 'refs';
|
|
# print Dumper $ref_content, "\n";
|
|
if (ref $ref_content eq 'ARRAY'){
|
|
$content = join "\n", @$ref_content or die "failed with error $!";
|
|
}
|
|
else {
|
|
$content = scalar $ref_content;
|
|
}
|
|
open(my $fh, '>', $path) or error_handler('open',"$path", "$!");
|
|
print $fh $content;
|
|
close $fh;
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### UPDATER
|
|
##### -------------------------------------------------------------------
|
|
|
|
# arg 1: type to return
|
|
sub get_defaults {
|
|
my ($type) = @_;
|
|
my %defaults = (
|
|
'ftp-upload' => 'ftp.techpatterns.com/incoming',
|
|
'inxi-branch-1' => 'https://github.com/smxi/inxi/raw/one/',
|
|
'inxi-branch-2' => 'https://github.com/smxi/inxi/raw/two/',
|
|
'inxi-dev' => 'https://smxi.org/in/',
|
|
'inxi-main' => 'https://github.com/smxi/inxi/raw/master/',
|
|
'inxi-pinxi' => 'https://github.com/smxi/inxi/raw/inxi-perl/',
|
|
'inxi-man' => "https://smxi.org/in/$self_name.1.gz",
|
|
'inxi-man-gh' => "https://github.com/smxi/inxi/raw/master/$self_name.1",
|
|
'pinxi-man' => "https://smxi.org/in/$self_name.1.gz",
|
|
'pinxi-man-gh' => "https://github.com/smxi/inxi/raw/inxi-perl/$self_name.1",
|
|
);
|
|
if ( exists $defaults{$type}){
|
|
return $defaults{$type};
|
|
}
|
|
else {
|
|
error_handler('bad-arg-int', $type);
|
|
}
|
|
}
|
|
|
|
# args: 1 - download url, not including file name; 2 - string to print out
|
|
# 3 - update type option
|
|
# note that 1 must end in / to properly construct the url path
|
|
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
|
|
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";
|
|
$output .= "Starting download of man page file now.\n";
|
|
print $output;
|
|
$output = '';
|
|
if ($b_man){
|
|
update_man($download_id);
|
|
}
|
|
else {
|
|
print "Skipping man download because branch version is being used.\n";
|
|
}
|
|
exit 1;
|
|
}
|
|
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 {
|
|
my ($download_id) = @_;
|
|
my $man_file_location=set_man_location();
|
|
my $man_file_path="$man_file_location/$self_name.1" ;
|
|
my ($man_file_url,$output) = ('','');
|
|
|
|
my $b_downloaded = 0;
|
|
if ( ! -d $man_file_location ){
|
|
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! Are you root?\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' );
|
|
}
|
|
}
|
|
# first choice is inxi.1/pinxi.1 from gh, second gz from smxi.org
|
|
if ( $download_id ne 'dev server' && (my $program = check_program('gzip'))){
|
|
$man_file_url=get_defaults($self_name . '-man-gh');
|
|
print "Downloading Man page file...\n";
|
|
$b_downloaded = download_file('file', $man_file_url, $man_file_path);
|
|
if ($b_downloaded){
|
|
print "Download successful. Compressing file...\n";
|
|
system("$program -9 -f $man_file_path > $man_file_path.gz");
|
|
my $err = $?;
|
|
if ($err > 0){
|
|
print "Oh no! Something went wrong compressing the manfile:\n";
|
|
print "Local path: $man_file_path Error: $err\n";
|
|
}
|
|
else {
|
|
print "Download and install of man page successful.\nCheck to make sure it works: man $self_name\n";
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$man_file_url = get_defaults($self_name . '-man');
|
|
# used to use spider tests, but only wget supports that, so no need
|
|
print "Downloading Man page file gz...\n";
|
|
$man_file_path .= '.gz';
|
|
# returns perl, 1 for true, 0 for false, even when using shell tool returns
|
|
$b_downloaded = download_file('file', $man_file_url, $man_file_path );
|
|
if ($b_downloaded) {
|
|
print "Download and install of man page successful.\nCheck to make sure it works: man $self_name\n";
|
|
}
|
|
}
|
|
if ( !$b_downloaded ){
|
|
print "Oh no! Something went wrong downloading the Man file at:\n$man_file_url\n";
|
|
print "Try -U with --dbg 1 for more information on the failure.\n";
|
|
}
|
|
}
|
|
|
|
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
|
|
########################################################################
|
|
|
|
sub get_options{
|
|
eval $start if $b_log;
|
|
my (@args) = @_;
|
|
$show{'short'} = 1;
|
|
my ($b_downloader,$b_help,$b_no_man,$b_no_man_force,$b_recommends,$b_updater,$b_version,
|
|
$b_use_man,$self_download, $download_id);
|
|
GetOptions (
|
|
'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{'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 < get_color_scheme('count') ){
|
|
set_color_scheme($arg);
|
|
}
|
|
elsif ( $arg >= 94 && $arg <= 99 ){
|
|
$colors{'selector'} = $arg;
|
|
}
|
|
else {
|
|
error_handler('bad-arg', $opt, $arg);
|
|
} },
|
|
'C|cpu' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'cpu'} = 1; },
|
|
'd|disk-full|optical' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'disk'} = 1;
|
|
$show{'optical'} = 1; },
|
|
'D' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'disk'} = 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{'cpu'} = 1;
|
|
$show{'disk'} = 1;
|
|
$show{'graphic'} = 1;
|
|
$show{'info'} = 1;
|
|
$show{'machine'} = 1;
|
|
$show{'network'} = 1;
|
|
$show{'network-advanced'} = 1;
|
|
$show{'partition'} = 1;
|
|
$show{'raid'} = 1;
|
|
$show{'sensor'} = 1;
|
|
$show{'system'} = 1; },
|
|
'G|graphics|graphic' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'graphic'} = 1; },
|
|
'i|ip' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'ip'} = 1;
|
|
$show{'network'} = 1;
|
|
$show{'network-advanced'} = 1;
|
|
$b_downloader = 1 if ! check_program('dig');},
|
|
'I|info' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'info'} = 1; },
|
|
'l|labels|label' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'label'} = 1;
|
|
$show{'partition'} = 1; },
|
|
'limit:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg != 0){
|
|
$limit = $arg;
|
|
}
|
|
else {
|
|
error_handler('bad-arg',$opt,$arg);
|
|
} },
|
|
'm|memory' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'ram'} = 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' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'partition'} = 0;
|
|
$show{'partition-full'} = 1; },
|
|
'P|partitions|partition' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'partition'} = 1; },
|
|
'r|repos|repo' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'repo'} = 1; },
|
|
'R|raid' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'raid'} = 1;
|
|
$show{'raid-forced'} = 1; },
|
|
's|sensors|sensor' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'sensor'} = 1; },
|
|
'sleep:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
$arg ||= 0;
|
|
if ($arg >= 0){
|
|
$cpu_sleep = $arg;
|
|
}
|
|
else {
|
|
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 {
|
|
error_handler('bad-arg',$opt,$arg);
|
|
} },
|
|
'usb' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'usb'} = 1; },
|
|
'u|uuid' => sub {
|
|
$show{'short'} = 0;
|
|
$show{'partition'} = 1;
|
|
$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{'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{'ram'} = 1;
|
|
$show{'label'} = 1;
|
|
$show{'optical-basic'} = 1;
|
|
$show{'ram'} = 1;
|
|
$show{'raid'} = 1;
|
|
$show{'sensor'} = 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 ){
|
|
$b_downloader = 1 if ! check_program('dig');
|
|
$show{'cpu-flag'} = 1;
|
|
$show{'ip'} = 1;
|
|
$show{'raid-forced'} = 1;
|
|
$extra = 3;
|
|
}
|
|
if ($arg >= 8 ){
|
|
$b_downloader = 1;
|
|
$show{'slot'} = 1;
|
|
$show{'process'} = 1;
|
|
$show{'ps-cpu'} = 1;
|
|
$show{'ps-mem'} = 1;
|
|
$show{'repo'} = 1;
|
|
#$show{'weather'} = 1;
|
|
}
|
|
}
|
|
else {
|
|
error_handler('bad-arg',$opt,$arg);
|
|
} },
|
|
'w|weather' => sub {
|
|
my ($opt) = @_;
|
|
$show{'short'} = 0;
|
|
$b_downloader = 1;
|
|
if ( $b_weather ){
|
|
$show{'weather'} = 1;
|
|
}
|
|
else {
|
|
error_handler('distro-block', $opt);
|
|
} },
|
|
'W|weather-location:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
$arg ||= '';
|
|
$arg =~ s/\s//g;
|
|
$show{'short'} = 0;
|
|
$b_downloader = 1;
|
|
if ( $b_weather ){
|
|
if ($arg){
|
|
$show{'weather'} = 1;
|
|
$show{'weather-location'} = $arg;
|
|
}
|
|
else {
|
|
error_handler('bad-arg',$opt,$arg);
|
|
}
|
|
}
|
|
else {
|
|
error_handler('distro-block', $opt);
|
|
} },
|
|
'x|extra:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg > 0){
|
|
$extra = $arg;
|
|
}
|
|
else {
|
|
$extra++;
|
|
} },
|
|
'y|width:i' => sub {
|
|
my ($opt, $arg) = @_;
|
|
$arg = 2000 if defined $arg && $arg == -1;
|
|
if ( $arg =~ /\d/ && $arg >= 80 ){
|
|
set_display_width($arg);
|
|
}
|
|
else {
|
|
error_handler('bad-arg', $opt, $arg);
|
|
} },
|
|
'z|filter' => sub {
|
|
$show{'filter'} = 1; },
|
|
'Z|filter-override' => sub {
|
|
$show{'filter-override'} = 1; },
|
|
## Start non data options
|
|
'alt:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg == 40) {
|
|
$dl{'tiny'} = 0;
|
|
$b_downloader = 1;}
|
|
elsif ($arg == 41) {
|
|
$dl{'curl'} = 0;
|
|
$b_downloader = 1;}
|
|
elsif ($arg == 42) {
|
|
$dl{'fetch'} = 0;
|
|
$b_downloader = 1;}
|
|
elsif ($arg == 43) {
|
|
$dl{'wget'} = 0;
|
|
$b_downloader = 1;}
|
|
elsif ($arg == 44) {
|
|
$dl{'curl'} = 0;
|
|
$dl{'fetch'} = 0;
|
|
$dl{'wget'} = 0;
|
|
$b_downloader = 1;}
|
|
else {
|
|
error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'arm' => sub {
|
|
$b_arm = 1 },
|
|
'bsd:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg =~ /^(darwin|dragonfly|freebsd|openbsd|netbsd)$/i){
|
|
$bsd_type = lc($arg);
|
|
$b_fake_bsd = 1;
|
|
}
|
|
else {
|
|
error_handler('bad-arg', $opt, $arg);
|
|
}
|
|
},
|
|
'dbg:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg > 0) {
|
|
$test[$arg] = 1;
|
|
}
|
|
else {
|
|
error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'debug:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg =~ /^[1-3]|1[0-2]|2[0-4]$/){
|
|
$debug=$arg;
|
|
}
|
|
else {
|
|
error_handler('bad-arg', $opt, $arg);
|
|
} },
|
|
'display:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg =~ /^:?([0-9]+)?$/){
|
|
$display=$arg;
|
|
$display ||= ':0';
|
|
$display = ":$display" if $display !~ /^:/;
|
|
$b_display = ($b_root) ? 0 : 1;
|
|
$b_force_display = 1;
|
|
$display_opt = "-display $display";
|
|
}
|
|
else {
|
|
error_handler('bad-arg', $opt, $arg);
|
|
} },
|
|
'dmidecode' => sub {
|
|
$b_dmidecode_force = 1 },
|
|
'downloader:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
$arg = lc($arg);
|
|
if ($arg =~ /^(curl|fetch|ftp|perl|wget)$/){
|
|
if ($arg eq 'perl' && (!check_module('HTTP::Tiny') || !check_module('IO::Socket::SSL') )){
|
|
error_handler('missing-perl-downloader', $opt, $arg);
|
|
}
|
|
elsif ( !check_program($arg)) {
|
|
error_handler('missing-downloader', $opt, $arg);
|
|
}
|
|
else {
|
|
# this dumps all the other data and resets %dl for only the
|
|
# desired downloader.
|
|
$arg = set_perl_downloader($arg);
|
|
%dl = ('dl' => $arg, $arg => 1);
|
|
$b_downloader = 1;
|
|
}
|
|
}
|
|
else {
|
|
error_handler('bad-arg', $opt, $arg);
|
|
} },
|
|
'ftp:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
# pattern: ftp.x.x/x
|
|
if ($arg =~ /^ftp\..+\..+\/[^\/]+$/ ){
|
|
$ftp_alt = $arg;
|
|
}
|
|
else {
|
|
error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'h|help|?' => sub {
|
|
$b_help = 1; },
|
|
'host|hostname' => sub {
|
|
$show{'host'} = 1 },
|
|
'indent-min:i' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg =~ /^\d+$/){
|
|
$size{'indent-min'} = 1;
|
|
}
|
|
else {
|
|
error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'irc' => sub {
|
|
$b_irc = 1; },
|
|
'man' => sub {
|
|
$b_use_man = 1; },
|
|
'output:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg =~ /^(json|screen|xml)$/){
|
|
if ($arg =~ /json|screen|xml/){
|
|
$output_type = $arg;
|
|
}
|
|
else {
|
|
error_handler('option-feature-incomplete', $opt, $arg);
|
|
}
|
|
}
|
|
else {
|
|
error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'no-host|no-hostname' => sub {
|
|
$show{'host'} = 0 },
|
|
'no-man' => sub {
|
|
$b_no_man_force = 0; },
|
|
'no-ssl' => sub {
|
|
$dl{'no-ssl-opt'}=1 },
|
|
'output-file:s' => sub {
|
|
my ($opt,$arg) = @_;
|
|
if ($arg){
|
|
if ($arg eq 'print' || check_output_path($arg)){
|
|
$output_file = $arg;
|
|
}
|
|
else {
|
|
error_handler('output-file-bad', $opt, $arg);
|
|
}
|
|
}
|
|
else {
|
|
error_handler('bad-arg', $opt, $arg);
|
|
}},
|
|
'recommends' => sub {
|
|
$b_recommends = 1; },
|
|
'U|update:s' => sub { # 1,2,3 OR http://myserver/path/inxi
|
|
my ($opt,$arg) = @_;
|
|
$b_downloader = 1;
|
|
if ( $b_update ){
|
|
$b_updater = 1;
|
|
if (!$arg && $self_name eq 'pinxi'){
|
|
$b_man = 1;
|
|
$download_id = 'inxi-perl branch';
|
|
$self_download = get_defaults('inxi-pinxi');
|
|
}
|
|
elsif ($arg && $arg eq '3'){
|
|
$b_man = 1;
|
|
$download_id = 'dev server';
|
|
$self_download = get_defaults('inxi-dev');
|
|
}
|
|
else {
|
|
if (!$arg){
|
|
$download_id = 'main branch';
|
|
$self_download = get_defaults('inxi-main');
|
|
$b_man = 1;
|
|
$b_use_man = 1;
|
|
}
|
|
elsif ( $arg =~ /^[12]$/){
|
|
$download_id = "branch $arg";
|
|
$self_download = get_defaults("inxi-branch-$arg");
|
|
}
|
|
elsif ( $arg =~ /^http/){
|
|
$download_id = 'alt server';
|
|
$self_download = $arg;
|
|
}
|
|
}
|
|
if (!$self_download){
|
|
error_handler('bad-arg', $opt, $arg);
|
|
}
|
|
}
|
|
else {
|
|
error_handler('distro-block', $opt);
|
|
} },
|
|
'V|version' => sub {
|
|
$b_version = 1 },
|
|
'<>' => sub {
|
|
my ($opt) = @_;
|
|
error_handler('unknown-option', "$opt", "" ); }
|
|
) ; #or error_handler('unknown-option', "@ARGV", '');
|
|
## run all these after so that we can change widths, downloaders, etc
|
|
eval $end if $b_log;
|
|
CheckRecommends::run() if $b_recommends;
|
|
set_downloader() if $b_downloader;
|
|
show_version() if $b_version;
|
|
show_options() if $b_help;
|
|
$b_man = 0 if (!$b_use_man || $b_no_man_force);
|
|
update_me( $self_download, $download_id ) if $b_updater;
|
|
if ($output_type){
|
|
if ($output_type ne 'screen' && ! $output_file){
|
|
error_handler('bad-arg', '--output', '--output-file not provided');
|
|
}
|
|
}
|
|
if ( $show{'ram'} || $show{'slot'} ||
|
|
( ( $bsd_type || $b_dmidecode_force ) && ($show{'machine'} || $show{'battery'}) ) ){
|
|
$b_dmi = 1;
|
|
}
|
|
if ($show{'audio'} || $show{'graphic'} || $show{'network'} ){
|
|
$b_pci = 1;
|
|
}
|
|
if ($show{'usb'} || $show{'audio'} || $show{'network'} ){
|
|
# to detect wan/lan, we have to use long form to get as much data as possible
|
|
$usb_level = ($show{'usb'} || $show{'network'}) ? 2 : 1;
|
|
}
|
|
if ($bsd_type && ($show{'short'} || $show{'cpu'} || $show{'cpu-basic'} || $show{'machine'} ||
|
|
$show{'info'} || $show{'process'} || $show{'ram'} ) ){
|
|
$b_sysctl = 1;
|
|
}
|
|
if ($show{'filter-override'}){
|
|
$show{'filter'} = 0;
|
|
}
|
|
$b_sudo = 1 if ( $show{'unmounted'} || ($extra > 0 && $show{'disk'}) );
|
|
# 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'};
|
|
if ($show{'disk'} || $show{'optical'} ){
|
|
$show{'disk-basic'} = 0;
|
|
$show{'disk-total'} = 0;
|
|
}
|
|
if ($bsd_type && ($show{'short'} || $show{'disk-basic'} || $show{'disk-total'} || $show{'disk'})){
|
|
$b_dm_boot_disk = 1;
|
|
}
|
|
if ($bsd_type && ($show{'optical-basic'} || $show{'optical'})){
|
|
$b_dm_boot_optical = 1
|
|
}
|
|
}
|
|
|
|
sub show_options {
|
|
error_handler('not-in-irc', 'help') if $b_irc;
|
|
my (@row,@rows,@data);
|
|
my $line = '';
|
|
my $color_scheme_count = get_color_scheme('count') - 1;
|
|
my $partition_string='partition';
|
|
my $partition_string_u='Partition';
|
|
my $flags = ($b_arm) ? 'features' : 'flags' ;
|
|
if ( $bsd_type ){
|
|
$partition_string='slice';
|
|
$partition_string_u='Slice';
|
|
}
|
|
# fit the line to the screen!
|
|
for my $i ( 0 .. ( ( $size{'max'} / 2 ) - 2 ) ){
|
|
$line = $line . '- ';
|
|
}
|
|
@rows = (
|
|
['0', '', '', "$self_name supports the following options. You can combine
|
|
these or list them one by one. For more detailed information, see man^$self_name.
|
|
Examples:^$self_name^-v4^-c6 OR
|
|
$self_name^-bDc^6. If you start $self_name with no arguments, it will display
|
|
a short system summary." ],
|
|
[0, '', '', '' ],
|
|
['0', '', '', "The following options, if used without -F, -b, or -v, will
|
|
show option line(s): A, B, C, D, G, I, M, N, P, R, S, W, d, f, i, l, m, n,
|
|
o, p, r, s, t, u, w, --slots, --usb - you can use these alone or together
|
|
to show just the line(s) you want to see. If you use them with -v [level],
|
|
-b or -F, $self_name will combine the outputs." ],
|
|
['0', '', '', $line ],
|
|
['0', '', '', "Output Control Options:" ],
|
|
['1', '-A', '--audio', "Audio/sound card(s), driver, sound server." ],
|
|
['1', '-b', '--basic', "Basic output, short form. Same as $self_name^-v^2." ],
|
|
['1', '-B', '--battery', "Battery info, including charge and condition, plus
|
|
extra info (if battery present)." ],
|
|
['1', '-c', '--color', "Set color scheme (0-42). Example:^$self_name^-c^11" ],
|
|
['1', '', '', "Color selectors let you set the config file value for the
|
|
selection (NOTE: IRC and global only show safe color set)" ],
|
|
['2', '94', '', "Console, out of X" ],
|
|
['2', '95', '', "Terminal, running in X - like xTerm" ],
|
|
['2', '96', '', "Gui IRC, running in X - like Xchat, Quassel, Konversation etc." ],
|
|
['2', '97', '', "Console IRC running in X - like irssi in xTerm" ],
|
|
['2', '98', '', "Console IRC not in X" ],
|
|
['2', '99', '', "Global - Overrides/removes all settings. Setting specific
|
|
removes global." ],
|
|
['1', '-C', '--cpu', "CPU output, including per CPU clock speed and max
|
|
CPU speed (if available)." ],
|
|
['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 size(s)." ],
|
|
['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 -W, plus -s and -n. Does not show extra verbose options such
|
|
as -d -f -i -l -m -o -p -r -t -u -x, unless specified." ],
|
|
['1', '-G', '--graphics', "Graphics info (card(s), driver, display protocol
|
|
(if available), display server, resolution, renderer, OpenGL version)." ],
|
|
['1', '-i', '--ip', "WAN IP address and local interfaces (requires ifconfig
|
|
or ip network tool). Triggers -n. Not shown with -F for user security reasons.
|
|
You shouldn't paste your local/WAN IP." ],
|
|
['1', '-I', '--info', "General info, including processes, uptime, memory,
|
|
IRC client or shell type, $self_name version." ],
|
|
['1', '-l', '--label', "$partition_string_u labels. Triggers -P.
|
|
For full -p output, use -pl." ],
|
|
['1', '-m', '--memory', "Memory (RAM) data. Requires root. Numbers of
|
|
devices (slots) supported and individual memory devices (sticks of memory etc).
|
|
For devices, shows device locator, size, speed, type (e.g. DDR3).
|
|
If neither -I nor -tm are selected, also shows RAM used/total." ],
|
|
['1', '-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 card info. Triggers -N. Shows
|
|
interface, speed, MAC id, state, etc. " ],
|
|
['1', '-N', '--network', "Network card(s), driver." ],
|
|
['1', '-o', '--unmounted', "Unmounted $partition_string info (includes UUID
|
|
and Label if available). Shows file system type if you have lsblk installed
|
|
(Linux) or, for BSD/GNU Linux, if 'file' installed and you are root or if
|
|
you have added to /etc/sudoers (sudo v. 1.7 or newer)." ],
|
|
['1', '', '', "Example: ^<username>^ALL^=^NOPASSWD:^/usr/bin/file^" ],
|
|
['1', '-p', '--partitions-full', "Full $partition_string information (-P plus all other
|
|
detected ${partition_string}s)." ],
|
|
['1', '-P', '--partitions', "Basic $partition_string info. Shows, if detected:
|
|
/ /boot /home /opt /tmp /usr /var /var/log /var/tmp. Use -p to see all
|
|
mounted ${partition_string}s." ],
|
|
['1', '-r', '--repos', "Distro repository data. Supported repo types: APK,
|
|
APT, EOPKG, PACMAN, PACMAN-G2, PISI, PORTAGE, PORTS (BSDs), SLACKPKG,
|
|
URPMQ, YUM/ZYPP." ],
|
|
['1', '-R', '--raid', "RAID data. Shows RAID devices, states, levels,
|
|
and components. md-raid: If device is resyncing, also shows resync progress line." ],
|
|
['1', '-s', '--sensors', "Sensors output (if sensors installed/configured):
|
|
mobo/CPU/GPU temp; detected fan speeds. GPU temp only for Fglrx/Nvidia drivers.
|
|
Nvidia shows screen number for > 1 screen. IPMI sensors if present." ],
|
|
['1', '', '--slots', "PCI slots: type, speed, status. Requires root." ],
|
|
['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. write as^-t^cm10)." ],
|
|
['1', '', '--usb', "Show USB data: Hubs and Devices." ],
|
|
['1', '-u', '--uuid', "$partition_string_u UUIDs. Triggers -P. For full -p
|
|
output, use -pu." ],
|
|
['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 card (-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 card (-A), sensors (-s), memory/RAM (-m),
|
|
$partition_string label^(-l), UUID^(-u), short form of optical drives,
|
|
standard RAID data (-R). " ],
|
|
['2', '6', '', "Full $partition_string (-p), unmounted $partition_string (-o),
|
|
optical drive (-d), USB (--usb), full RAID; triggers -xx." ],
|
|
['2', '7', '', "Network IP data (-i); triggers -xxx."],
|
|
['2', '8', '', "Everything available, including repos (-r), processes
|
|
(-tcm), PCI slots (--slots)."],
|
|
);
|
|
push @data, @rows;
|
|
# if distro maintainers don't want the weather feature disable it
|
|
if ( $b_weather ){
|
|
@rows = (
|
|
['1', '-w', '--weather', "Local weather data/time. To check an alternate
|
|
location, see -W."],
|
|
['1', '-W', '--weather-location', "<location> Supported options for
|
|
<location>: postal code; city, state/country; 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"]
|
|
);
|
|
push @data, @rows;
|
|
}
|
|
@rows = (
|
|
['1', '-x', '-extra', "Adds the following extra data (only works with
|
|
verbose or line output, not short form):" ],
|
|
['2', '-B', '', "Vendor/model, status (if available)." ],
|
|
['2', '-C', '', "CPU $flags, Bogomips on CPU; CPU microarchitecture +
|
|
revision (if found)." ],
|
|
['2', '-d', '', "Extra optical drive features data; adds rev version to
|
|
optical drive." ],
|
|
['2', '-D', '', "HDD temp with disk data if you have hddtemp installed, if
|
|
you are root, or if you have added to /etc/sudoers (sudo v. 1.7 or newer).
|
|
Example:^<username>^ALL^=^NOPASSWD:^/usr/sbin/hddtemp" ],
|
|
['2', '-G', '', "Direct rendering status (in X); Screen number GPU is
|
|
running on (Nvidia only)." ],
|
|
['2', '-i', '', "For IPv6, show additional scope addresses: Global, Site,
|
|
Temporary, Unknown. See --limit for large counts of IP addresses." ],
|
|
['2', '-I', '', "Default system GCC. With -xx, also shows other installed
|
|
GCC versions. If running in shell, not in IRC client, shows shell version
|
|
number, if detected. Init/RC type and runlevel (if available)." ],
|
|
['2', '-m', '', "Max memory module size (if available), device type." ],
|
|
['2', '-N -A', '', "Version/port(s)/driver version (if available)." ],
|
|
['2', '-N -A -G', '', "PCI Bus ID/USB ID number of card." ],
|
|
['2', '-R', '', "md-raid: second RAID Info line with extra data:
|
|
blocks, chunk size, bitmap (if present). Resync line, shows blocks
|
|
synced/total blocks." ],
|
|
['2', '-s', '', "Basic voltages (ipmi, lm-sensors if present): 12v, 5v, 3.3v, vbat." ],
|
|
['2', '-S', '', "Desktop toolkit, if available (GNOME/Xfce/KDE only);
|
|
Kernel gcc version" ],
|
|
['2', '-t', '', "Adds memory use output to CPU (-xt c), and CPU use to
|
|
memory (-xt m)." ],
|
|
['2', '--usb', '', "For Devices, shows USB version/speed." ],
|
|
);
|
|
push @data, @rows;
|
|
if ( $b_weather ){
|
|
@rows = (['2', '-w -W', '', "Wind speed and direction, humidity, pressure,
|
|
and (-w only) time zone." ]);
|
|
push @data, @rows;
|
|
}
|
|
@rows = (
|
|
['1', '-xx', '--extra 2', "Show extra, extra data (only works with verbose
|
|
or line output, not short form):" ],
|
|
['2', '-A', '', "Chip vendor:product ID for each audio device." ],
|
|
['2', '-B', '', "Serial number, voltage now/minimum (if available)." ],
|
|
['2', '-C', '', "Minimum CPU speed, if available." ],
|
|
['2', '-D', '', "Disk serial number." ],
|
|
['2', '-G', '', "Chip vendor:product ID for each video card; OpenGL
|
|
compatibility version, if free drivers and available; compositor (experimental)." ],
|
|
['2', '-I', '', "Other detected installed gcc versions (if present). System
|
|
default runlevel. Adds parent program (or tty) for shell info if not in
|
|
IRC. Adds Init version number, RC (if found)." ],
|
|
['2', '-m', '', "Manufacturer, part number; single/double bank (if found)." ],
|
|
['2', '-M', '', "Chassis info, BIOS ROM size (dmidecode only), if available." ],
|
|
['2', '-N', '', "Chip vendor:product ID for each NIC." ],
|
|
['2', '-R', '', "md-raid: Superblock (if present), algorithm. If resync,
|
|
shows progress bar." ],
|
|
['2', '-s', '', "DIMM/SOC voltages (ipmi only)." ],
|
|
['2', '-S', '', "Display manager (dm) in desktop output if in X (e.g. kdm,
|
|
gdm3, lightdm)." ],
|
|
['2', '--slots', '', "Slot length." ],
|
|
['2', '--usb', '', "Vendor:chip ID." ],
|
|
);
|
|
push @data, @rows;
|
|
if ( $b_weather ){
|
|
@rows = (['2', '-w -W', '', "Wind chill, dew point, heat index, if available." ]);
|
|
push @data, @rows;
|
|
}
|
|
@rows = (
|
|
['1', '-xxx', '--extra 3', "Show extra, extra, extra data (only works
|
|
with verbose or line output, not short form):" ],
|
|
['2', '-B', '', "Chemistry, cycles, location (if available)." ],
|
|
['2', '-D', '', "Firmware rev. if available; partition scheme, in some cases." ],
|
|
['2', '-I', '', "For 'Shell:' adds ([su|sudo|login]) to shell name if present;
|
|
for 'running in:' adds (SSH) if SSH session." ],
|
|
['2', '-m', '', "Width of memory bus, data and total (if present and greater
|
|
than data); Detail for Type, if present; module voltage, if available; serial number." ],
|
|
['2', '-R', '', "zfs-raid: portion allocated (used) by RAID devices/arrays.
|
|
md-raid: system md-raid support types (kernel support, read ahead, RAID events)." ],
|
|
['2', '-S', '', "Panel/shell info in desktop output, if in X (like gnome-shell,
|
|
cinnamon, mate-panel); (if available) dm version number, active window manager." ]
|
|
);
|
|
push @data, @rows;
|
|
if ( $b_weather ){
|
|
@rows = (['2', '-w -W', '', "Location (uses -z/irc filter), weather observation
|
|
time, altitude (shows extra lines for data where relevant)." ] );
|
|
push @data, @rows;
|
|
}
|
|
@rows = (
|
|
['1', '-y', '--width', "Output line width max (integer >= 80). Overrides IRC/Terminal
|
|
settings or actual widths. Example:^inxi^-y^130" ],
|
|
['1', '-z', '--filter', "Adds security filters for IP/MAC addresses, serial numbers,
|
|
location (-w), user home directory name. Default on for IRC clients." ],
|
|
['1', '-Z', '--filter-override', "Absolute override for output filters. Useful for
|
|
debugging networking issues in IRC, for example." ],
|
|
[0, '', '', "$line" ],
|
|
[0, '', '', "Additional Options:" ],
|
|
['1', '-h', '--help', "This help menu." ],
|
|
['1', '', '--recommends', "Checks $self_name application dependencies + recommends,
|
|
and directories, then shows what package(s) you need to install to add support
|
|
for that feature." ]
|
|
);
|
|
push @data, @rows;
|
|
if ( $b_update ){
|
|
@rows = (
|
|
['1', '-U', '--update', "Auto-update $self_name. Will also install/update man
|
|
page. Note: if you installed as root, you must be root to update, otherwise
|
|
user is fine. Man page installs require root. No arguments downloads from
|
|
main $self_name git repo." ],
|
|
['1', '', '', "Use alternate sources for updating $self_name" ],
|
|
['2', '1', '', "Get the git branch one version." ],
|
|
['2', '2', '', "Get the git branch two version." ],
|
|
['3', '3', '', "Get the dev server (smxi.org) version." ],
|
|
['2', '<http>', '', "Get a version of $self_name from your own server;
|
|
use the full download path, e.g.^$self_name^-U^https://myserver.com/inxi" ]
|
|
);
|
|
push @data, @rows;
|
|
}
|
|
@rows = (
|
|
['1', '-V', '--version', "Prints $self_name version info then exits." ],
|
|
[0, '', '', "$line" ],
|
|
[0, '', '', "Debugging Options:" ],
|
|
['1', '', '--debug', "Triggers debugging modes." ],
|
|
['2', '1-3', '', "On screen debugger output." ],
|
|
['2', '10', '', "Basic logging." ],
|
|
['2', '11', '', "Full file/system info logging." ],
|
|
['1', '', ,'', "The following create a tar.gz file of system data, plus $self_name
|
|
output. To automatically upload debugger data tar.gz file
|
|
to ftp.techpatterns.com: $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', '', '--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" ],
|
|
[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', '', '--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', '', '--host', "Turn on hostname for -S." ],
|
|
['1', '', '--indent-min', "Set point where $self_name autowraps line starters." ],
|
|
['1', '', '--limit', "[-1; 1-x] Set max output limit of IP addresses for -i
|
|
(default 10; -1 removes limit)." ],
|
|
);
|
|
push @data, @rows;
|
|
if ( $b_update ){
|
|
@rows = (
|
|
['1', '', '--man', "Install correct man version for dev branch (-U 3) or pinxi using -U." ],
|
|
);
|
|
push @data, @rows;
|
|
}
|
|
@rows = (
|
|
['1', '', '--no-host', "Turn off hostname for -S. Useful if showing output from servers etc." ],
|
|
);
|
|
push @data, @rows;
|
|
if ( $b_update ){
|
|
@rows = (
|
|
['1', '', '--no-man', "Disable man install for all -U update actions." ],
|
|
);
|
|
push @data, @rows;
|
|
}
|
|
@rows = (
|
|
['1', '', '--no-ssl', "Skip SSL certificate checks for all downloader actions
|
|
(Wget/Fetch/Curl only)." ],
|
|
['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', '', '--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" ],
|
|
['0', '', '', $line ],
|
|
);
|
|
push @data, @rows;
|
|
print_basic(@data);
|
|
exit 1;
|
|
}
|
|
|
|
sub show_version {
|
|
require Cwd;
|
|
import Cwd;
|
|
# if not in PATH could be either . or directory name, no slash starting
|
|
my $working_path=$self_path;
|
|
my (@data, @row, @rows, $link, $self_string);
|
|
if ( $working_path eq '.' ){
|
|
$working_path = getcwd();
|
|
}
|
|
elsif ( $working_path !~ /^\// ){
|
|
$working_path = getcwd() . "/$working_path";
|
|
}
|
|
# 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%/\./%/%;
|
|
@row = ([ 0, '', '', "$self_name $self_version-$self_patch ($self_date)"],);
|
|
push @data, @row;
|
|
if ( ! $b_irc ){
|
|
@row = ([ 0, '', '', ""],);
|
|
push @data, @row;
|
|
my $year = (split/-/, $self_date)[0];
|
|
@row = [ 0, '', '', "Program Location: $working_path" ];
|
|
push @data, @row;
|
|
if ( $link ){
|
|
@row = [ 0, '', '', "Started via symbolic link: $link" ];
|
|
push @data, @row;
|
|
}
|
|
@rows = (
|
|
[ 0, '', '', "Website:^https://github.com/smxi/inxi^or^https://smxi.org/" ],
|
|
[ 0, '', '', "IRC:^irc.oftc.net channel:^#smxi" ],
|
|
[ 0, '', '', "Forums:^https://techpatterns.com/forums/forum-33.html" ],
|
|
[ 0, '', '', " " ],
|
|
[ 0, '', '', "$self_name - the universal, portable, system information tool
|
|
for console and irc." ],
|
|
[ 0, '', '', "Using Perl version: $]"],
|
|
[ 0, '', '', " " ],
|
|
[ 0, '', '', "This program started life as a fork of Infobash 3.02:
|
|
Copyright^(C)^2005-2007^Michiel^de^Boer^aka^locsmif." ],
|
|
[ 0, '', '', "Subsequent changes and modifications (after Infobash 3.02):
|
|
Copyright^(C)^2008-$year^Harald^Hope^aka^h2.
|
|
CPU/Konversation^fixes:^Scott^Rogers^aka^trash80.
|
|
USB^audio^fixes:^Steven^Barrett^aka^damentz." ],
|
|
[ 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)" ]
|
|
);
|
|
push @data, @rows;
|
|
}
|
|
print_basic(@data);
|
|
exit 1;
|
|
}
|
|
|
|
########################################################################
|
|
#### STARTUP DATA
|
|
########################################################################
|
|
|
|
# StartClient
|
|
{
|
|
package StartClient;
|
|
|
|
# use warnings;
|
|
# use strict;
|
|
|
|
my $ppid = '';
|
|
my $pppid = '';
|
|
|
|
# NOTE: there's no reason to crete 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 get_client_data {
|
|
eval $start if $b_log;
|
|
$ppid = getppid();
|
|
main::set_ps_aux() if ! @ps_aux;
|
|
if (!$b_irc){
|
|
main::get_shell_data($ppid);
|
|
}
|
|
else {
|
|
$show{'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|dash|sh|python.*|perl.*$/){
|
|
$pppid = (main::grabber("ps -p $ppid -o ppid"))[1];
|
|
#my @temp = (main::grabber("ps -p $ppid -o ppid 2>/dev/null"))[1];
|
|
$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";
|
|
}
|
|
else {
|
|
if (! check_modern_konvi() ){
|
|
$ppid = getppid();
|
|
$client_name = (main::grabber("ps -p $ppid"))[1];
|
|
if ($client_name){
|
|
my @data = split /\s+/, $client_name if $client_name;
|
|
if ($bsd_type){
|
|
$client_name = lc($data[5]);
|
|
}
|
|
# 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|dash|sh$/ ){
|
|
$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');
|
|
}
|
|
$client{'version'} = main::awk(\@data,'version',2,'\s*=\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/) {
|
|
@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();
|
|
}
|
|
if (!$client{'name-print'}) {
|
|
$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;
|
|
$ppid = getppid();
|
|
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 = 0;
|
|
my $konvi_version = '';
|
|
my $konvi = '';
|
|
my $pid = '';
|
|
my (@temp);
|
|
# main::log_data('data',"name: $client{'name'} :: qdb: $client{'qdbus'} :: version: $client{'version'} :: konvi: $client{'konvi'} :: PPID: $ppid") if $b_log;
|
|
# sabayon uses /usr/share/apps/konversation as path
|
|
if ( -d '/usr/share/kde4/apps/konversation' || -d '/usr/share/apps/konversation' ){
|
|
$pid = main::awk(\@ps_aux,'konversation',2,'\s+');
|
|
main::log_data('data',"pid: $pid") if $b_log;
|
|
$konvi = readlink ("/proc/$pid/exe");
|
|
$konvi =~ s/^.*\///; # basename
|
|
@app = main::program_values('konversation');
|
|
if ($konvi){
|
|
@app = main::program_values('konversation');
|
|
$konvi_version = main::program_version($konvi,$app[0],$app[1],$app[2],$app[5],$app[6]);
|
|
@temp = split /\./, $konvi_version;
|
|
$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
|
|
$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: $konvi_qt4 verNum: $konvi_version pid: $pid ppid: $ppid" );
|
|
eval $end if $b_log;
|
|
return $b_modern_konvi;
|
|
}
|
|
|
|
sub set_konvi_data {
|
|
eval $start if $b_log;
|
|
my $config_tool = '';
|
|
# https://userbase.kde.org/Konversation/Scripts/Scripting_guide
|
|
if ( $client{'konvi'} == 3 ){
|
|
$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;
|
|
# there's no current kde 5 konvi config tool that we're aware of. Correct if changes.
|
|
if ( main::check_program('kde4-config') ){
|
|
$config_tool = 'kde4-config';
|
|
}
|
|
elsif ( main::check_program('kde5-config') ){
|
|
$config_tool = 'kde5-config';
|
|
}
|
|
elsif ( main::check_program('kde-config') ){
|
|
$config_tool = 'kde-config';
|
|
}
|
|
# The section below is on request of Argonel from the Konversation developer team:
|
|
# it sources config files like $HOME/.kde/share/apps/konversation/scripts/inxi.conf
|
|
if ($config_tool){
|
|
my @data = main::grabber("$config_tool --path data 2>/dev/null",':');
|
|
main::get_configs(@data);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
}
|
|
|
|
########################################################################
|
|
#### OUTPUT
|
|
########################################################################
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### FILTERS AND TOOLS
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub apply_filter {
|
|
my ($string) = @_;
|
|
if ($string){
|
|
$string = ( $show{'filter'} ) ? $filter_string : $string;
|
|
}
|
|
else {
|
|
$string = 'N/A';
|
|
}
|
|
return $string;
|
|
}
|
|
|
|
sub clean_characters {
|
|
my ($data) = @_;
|
|
# newline, pipe, brackets, + sign, with space, then clear doubled
|
|
# spaces and then strip out trailing/leading spaces.
|
|
$data =~ s/\n|\|\+|\[\s\]|\s\s+/ /g if $data;
|
|
$data =~ s/^\s+|\s+$//g if $data;
|
|
return $data;
|
|
}
|
|
|
|
sub cleaner {
|
|
my ($item) = @_;
|
|
return $item if !$item;# handle cases where it was 0 or ''
|
|
$item =~ s/chipset|company|components|computing|computer|corporation|communications|electronics|electrical|electric|gmbh|group|incorporation|industrial|international|nee|revision|semiconductor|software|technologies|technology|ltd\.|<ltd>|\bltd\b|inc\.|<inc>|\binc\b|intl\.|co\.|<co>|corp\.|<corp>|\(tm\)|\(r\)|®|\(rev ..\)|\'|\"|\sinc\s*$|\?//gi;
|
|
$item =~ s/,|\*/ /g;
|
|
$item =~ s/\s\s+/ /g;
|
|
$item =~ s/^\s+|\s+$//g;
|
|
return $item;
|
|
}
|
|
|
|
sub disk_cleaner {
|
|
my ($item) = @_;
|
|
return $item if !$item;
|
|
$item =~ s/vendor.*|product.*|O\.?E\.?M\.?//gi;
|
|
$item =~ s/\s\s+/ /g;
|
|
$item =~ s/^\s+|\s+$//g;
|
|
return $item;
|
|
}
|
|
|
|
sub dmi_cleaner {
|
|
my ($string) = @_;
|
|
my $cleaner = '^Base Board .*|^Chassis .*|empty|Undefined.*|.*O\.E\.M\..*|.*OEM.*|^Not .*';
|
|
$cleaner .= '|^System .*|.*unknow.*|.*N\/A.*|none|^To be filled.*|^0x[0]+$';
|
|
$cleaner .= '|\[Empty\]|<Bad Index>|Default string|^\.\.$|Manufacturer.*';
|
|
$cleaner .= '|AssetTagNum|Manufacturer| Or Motherboard|PartNum.*|SerNum';
|
|
$string =~ s/$cleaner//i;
|
|
$string =~ s/^\s+|\bbios\b|\bacpi\b|\s+$//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 remove_duplicates {
|
|
my ($string) = @_;
|
|
return if ! $string;
|
|
my $holder = '';
|
|
my (@temp);
|
|
my @data = split /\s+/, $string;
|
|
foreach (@data){
|
|
if ($holder ne $_){
|
|
push @temp, $_;
|
|
}
|
|
$holder = $_;
|
|
}
|
|
$string = join ' ', @temp;
|
|
return $string;
|
|
}
|
|
|
|
# args: $1 - size in KB, return KB, MB, GB, TB, PB, EB
|
|
sub get_size {
|
|
my ($size,$b_int) = @_;
|
|
my (@data);
|
|
return ('','') if ! defined $size;
|
|
if ($size !~ /^[0-9\.]+$/){
|
|
$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] = int($data[0]) if $b_int && $data[0];
|
|
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 memory_data_full {
|
|
eval $start if $b_log;
|
|
my ($source) = @_;
|
|
my $num = 0;
|
|
my ($memory,@rows);
|
|
my ($percent,$total,$used) = ('','','');
|
|
if (!$show{'info'}){
|
|
$memory = get_memory_data('splits');
|
|
if ($memory){
|
|
my @temp = split /:/, $memory;
|
|
my @temp2 = get_size($temp[0]);
|
|
$total = ($temp2[1]) ? $temp2[0] . ' ' . $temp2[1] : $temp2[0];
|
|
@temp2 = get_size($temp[1]);
|
|
$used = ($temp2[1]) ? $temp2[0] . ' ' . $temp2[1] : $temp2[0];
|
|
$used .= " ($temp[2]%)" if $temp[2];
|
|
}
|
|
my $key = ($source eq 'process') ? 'System RAM': 'RAM';
|
|
$rows[0]{main::key($num++,$key)} = '';
|
|
$rows[0]{main::key($num++,'total')} = $total;
|
|
$rows[0]{main::key($num++,'used')} = $used;
|
|
}
|
|
$b_mem = 1;
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
|
|
sub pci_cleaner {
|
|
my ($string,$type) = @_;
|
|
#print "st1 $type:$string\n";
|
|
my $filter = 'compatible\scontroller|\b(device|controller|multimedia)\b|\([^)]+\)';
|
|
# \[[^\]]+\]$| not trimming off ending [...] initial type filters removes end
|
|
$filter = '\[[^\]]+\]$|' . $filter if $type eq 'pci';
|
|
$string =~ s/$filter//ig;
|
|
$string =~ s/\s\s+/ /g;
|
|
$string =~ s/^\s+|\s+$//g;
|
|
#print "st2 $type:$string\n";
|
|
$string = remove_duplicates($string) if $string;
|
|
return $string;
|
|
}
|
|
|
|
sub pci_long_filter {
|
|
my ($string) = @_;
|
|
if ($string =~ /\[AMD(\/ATI)?\]/){
|
|
$string =~ s/Advanced\sMicro\sDevices\s\[AMD(\/ATI)?\]/AMD/;
|
|
}
|
|
return $string;
|
|
}
|
|
|
|
sub row_defaults {
|
|
my ($type,$id) = @_;
|
|
$id ||= '';
|
|
my %unfound = (
|
|
'arm-cpu-f' => 'Use -f option to see features',
|
|
'arm-pci' => "PCI data type is not supported on ARM systems.",
|
|
'battery-data' => "No battery data found. Is one present?",
|
|
'battery-data-sys' => "No /sys data found. Old system?",
|
|
'cpu-model-null' => "Model N/A",
|
|
'darwin-feature' => "Feature not supported iu Darwin/OSX.",
|
|
'disk-data-bsd' => "No disk data found for this BSD system.",
|
|
'disk-data' => "No Disk data was found.",
|
|
'disk-size-0' => "Total N/A",
|
|
'display-console' => 'No advanced graphics data found on this system in console.',
|
|
'display-null' => 'No advanced graphics data found on this system.',
|
|
'display-root' => 'Advanced graphics data unavailable in console for root.',
|
|
'display-root-x' => 'Advanced graphics data unavailable for root. Old System?',
|
|
'display-server' => "No display server data found. Headless server?",
|
|
'glxinfo-missing' => "Unable to show advanced data. Required tool glxinfo missing.",
|
|
'display-try' => 'Advanced graphics data unavailable in console. Try -G --display',
|
|
'dev' => 'Feature under development',
|
|
'dmesg-boot-permissions' => 'dmesg.boot permissions',
|
|
'dmesg-boot-missing' => 'dmesg.boot not found',
|
|
'IP' => "No $id data found. Connected to the web? SSL issues?",
|
|
'machine-data' => "No machine data: try newer kernel.",
|
|
'machine-data-alt-33' => "No machine data: try newer kernel. Is dmidecode installed? Try -M --dmidecode.",
|
|
'machine-data-dmidecode' => "No machine data: try newer kernel, or install dmidecoce.",
|
|
'optical-data' => "No Optical or Floppy data was found.",
|
|
'optical-data-bsd' => "No floppy or optical data found for this BSD system.",
|
|
'output-limit' => "Output throttled. IPs: $id; Limit: $limit; Override: --limit [1-x;-1 all]",
|
|
'partition-data' => "No Partition data was found.",
|
|
'pci-advanced-data' => 'bus/chip ids unavailable',
|
|
'pci-card-data' => "No PCI card data found.",
|
|
'pci-slot-data' => "No PCI slot data found. SOC?",
|
|
'raid-data' => "No RAID data was found.",
|
|
'ram-data' => "No RAM data was found. SOC?",
|
|
'root-required' => "<root required>",
|
|
'sensors-data-ipmi' => "No ipmi sensors data was found.",
|
|
'sensors-data-linux' => "No sensors data was found. Is sensors configured?",
|
|
'sensors-ipmi-root' => "Unable to run ipmi sensors. Are you root?",
|
|
'unmounted-data' => "No unmounted partitions found.",
|
|
'unmounted-data-bsd' => "No unmounted partition data found for this BSD system.",
|
|
'unmounted-file' => "No /proc/partitions file found.",
|
|
'usb-data' => "No USB data was found. Server?",
|
|
'unknown-desktop-version' => "ERR-101",
|
|
'unknown-dev' => "ERR-102",
|
|
'unknown-shell' => "ERR-100",
|
|
'weather-null' => "No $id found. Internet connection working?",
|
|
'xdpyinfo-missing' => '<xdpyinfo missing>',
|
|
);
|
|
return $unfound{$type};
|
|
}
|
|
|
|
# convert string passed to KB, based on GB/MB/TB id
|
|
# NOTE: K 1024 KB 1000
|
|
sub translate_size {
|
|
my ($working) = @_;
|
|
my $size = 0;
|
|
#print ":$working:\n";
|
|
return if ! defined $working;
|
|
my $math = ( $working =~ /B$/) ? 1000: 1024;
|
|
if ( $working =~ /^([0-9\.]+)M[B]?$/i){
|
|
$size = $1 * $math;
|
|
}
|
|
elsif ( $working =~ /^([0-9\.]+)G[B]?$/i){
|
|
$size = $1 * $math**2;
|
|
}
|
|
elsif ( $working =~ /^([0-9\.]+)T[B]?$/i){
|
|
$size = $1 * $math**3;
|
|
}
|
|
elsif ( $working =~ /^([0-9\.]+)P[B]?$/i){
|
|
$size = $1 * $math**4;
|
|
}
|
|
elsif ( $working =~ /^([0-9\.]+)E[B]?$/i){
|
|
$size = $1 * $math**5;
|
|
}
|
|
elsif ( $working =~ /^([0-9\.]+)K[B]?$/i){
|
|
$size = $1;
|
|
}
|
|
$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;
|
|
}
|
|
|
|
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);
|
|
}
|
|
}
|
|
|
|
# NOTE: file has already been set and directory verified
|
|
sub generate_json {
|
|
eval $start if $b_log;
|
|
my (%data) = @_;
|
|
my ($json);
|
|
my $b_debug = 1;
|
|
my ($b_cpanel,$b_valid);
|
|
error_handler('not-in-irc', 'help') if $b_irc;
|
|
#print Dumper \%data if $b_debug;
|
|
if (check_module('Cpanel::JSON::XS')){
|
|
import Cpanel::JSON::XS;
|
|
$json = Cpanel::JSON::XS::encode_json(\%data);
|
|
}
|
|
elsif (check_module('JSON::XS')){
|
|
import JSON::XS;
|
|
$json = JSON::XS::encode_json(\%data);
|
|
}
|
|
else {
|
|
error_handler('required-module', 'json', '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_module('XML::Dumper')){
|
|
import XML::Dumper;
|
|
$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", $_[0],$_[1]);
|
|
}
|
|
|
|
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,$aref,$i,$j,$line);
|
|
|
|
if ( $size{'max'} > 110 ){
|
|
$indent_static = 22;
|
|
}
|
|
elsif ($size{'max'} < 90 ){
|
|
$indent_static = 15;
|
|
}
|
|
# print $length . "\n";
|
|
for my $i (0 .. $#data){
|
|
$aref = $data[$i];
|
|
#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]) ) < $size{'max'} ){
|
|
$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 = ' ';
|
|
foreach my $word (split / /, $data[$i][3]){
|
|
#print "$word\n";
|
|
if ( ( $indent + length($holder) + length($word) ) < $size{'max'} ) {
|
|
$word =~ s/\^/ /g;
|
|
$holder .= $word . $sep;
|
|
#print "3-hold.\n";
|
|
}
|
|
#elsif ( ( $indent + length($holder) + length($word) ) >= $size{'max'}){
|
|
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 $array = 0;
|
|
my $array_holder = 1;
|
|
my $counter=0;
|
|
my $split_count = 0;
|
|
my $hash = 0;
|
|
my $holder = '';
|
|
my $id_holder = 0;
|
|
my $start = '';
|
|
my $start2 = '';
|
|
my $length = 0;
|
|
my $indent = $size{'indent'};
|
|
my (@temp,@working,@values,%ids,$holder2,%row);
|
|
my ($key,$line,$val2,$val3);
|
|
# $size{'max'} = 88;
|
|
# NOTE: indent < 11 would break the output badly in some cases
|
|
if ($size{'max'} < $size{'indent-min'} || $size{'indent'} < 11 ){
|
|
$indent = 2;
|
|
}
|
|
#foreach my $key1 (sort { (split/#/, $a)[0] <=> (split/#/, $b)[0] } keys %data) {
|
|
foreach my $key1 (sort { substr($a,0,3) <=> substr($b,0,3) } keys %data) {
|
|
#foreach my $key1 (sort { $a cmp $b } keys %data) {
|
|
$key = (split/#/, $key1)[1];
|
|
if ($key ne 'SHORT' ) {
|
|
$start = sprintf("$colors{'c1'}%-${indent}s$colors{'cn'}","$key$sep{'s1'}");
|
|
if ($indent < 10){
|
|
$line = "$start\n";
|
|
print_line($line);
|
|
$start = '';
|
|
$line = '';
|
|
}
|
|
}
|
|
else {
|
|
$indent = 0;
|
|
}
|
|
if (ref($data{$key1}) eq 'ARRAY'){
|
|
# @working = @{$data{$key1}};
|
|
%ids = (
|
|
'Array' => 1,
|
|
'array' => 1,
|
|
'Battery' => 1,
|
|
'Card' => 1,
|
|
'Device' => 1,
|
|
'Floppy' => 1,
|
|
'ID' => 1,
|
|
'IF-ID' => 1,
|
|
'Optical' => 1,
|
|
);
|
|
$array_holder = 1;
|
|
foreach my $val1 (@{$data{$key1}}){
|
|
$length = $indent;
|
|
if (ref($val1) eq 'HASH'){
|
|
#%row = %$val1;
|
|
$counter=0;
|
|
$split_count = 0;
|
|
$hash = scalar %$val1;
|
|
#foreach my $key2 (sort { (split/#/, $a)[0] <=> (split/#/, $b)[0] } keys %$val1){
|
|
foreach my $key2 (sort { substr($a,0,3) <=> substr($b,0,3) } keys %$val1){
|
|
#foreach my $key2 (sort { $a cmp $b } keys %$val1){
|
|
$key = (split/#/, $key2)[1];
|
|
# for ram with > 1 system array, we want to reset device count to 1 for each
|
|
# new array
|
|
if ($key eq 'Array' && $array_holder != $ids{$key} ){
|
|
$array_holder = $ids{$key};
|
|
$ids{'Device'} = 1 if ($ids{'Device'} > 1);
|
|
}
|
|
if ($key eq 'Device' && $ids{'array'} > 1 && $id_holder != $ids{$key} ){
|
|
$id_holder = $ids{$key};
|
|
$ids{'array'} = 1 if ($ids{'array'} > 1);
|
|
}
|
|
if ($counter == 0 && defined $ids{$key}){
|
|
$key .= '-' . $ids{$key}++;
|
|
}
|
|
$val2 = $$val1{$key2};
|
|
# we have to handle cases where $val2 is 0
|
|
if ($val2 || $val2 eq '0'){
|
|
$val2 .= " ";
|
|
}
|
|
# see: Use of implicit split to @_ is deprecated. Only get this warning
|
|
# in Perl 5.08 oddly enough.
|
|
@temp = split/\s+/, $val2;
|
|
$split_count = scalar @temp;
|
|
if ( ( length( "$key$sep{'s2'} $val2" ) + $length ) < $size{'max'} ) {
|
|
$length += length("$key$sep{'s2'} $val2");
|
|
$holder .= "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val2";
|
|
#print "one\n";
|
|
}
|
|
# handle case where the opening key/value pair is > max, and where
|
|
# there are a lot of terms, like cpu flags, raid types supported. Raid
|
|
# can have the last row have a lot of devices, or many raid types
|
|
elsif ( ( length( "$key$sep{'s2'} $val2" ) + $indent ) > $size{'max'} &&
|
|
!defined $ids{$key} && $split_count > 2 ) {
|
|
@values = split/\s+/, $val2;
|
|
$val3 = shift @values;
|
|
# $length += length("$key$sep{'s2'} $val3 ") + $indent;
|
|
$start2 = "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val3 ";
|
|
$holder2 = '';
|
|
$length += length("$key$sep{'s2'} $val3 ");
|
|
# print scalar @values,"\n";
|
|
foreach (@values){
|
|
# my $l = (length("$_ ") + $length);
|
|
#print "$l\n";
|
|
if ( (length("$_ ") + $length) < $size{'max'} ){
|
|
#print "a\n";
|
|
if ($start2){
|
|
$holder2 .= "$start2$_ ";
|
|
$start2 = '';
|
|
#$length += $length2;
|
|
#$length2 = 0;
|
|
}
|
|
else {
|
|
$holder2 .= "$_ ";
|
|
}
|
|
$length += length("$_ ");
|
|
}
|
|
else {
|
|
#print "three\n";
|
|
if ($start2){
|
|
$holder2 = "$start2$holder2";
|
|
}
|
|
else {
|
|
$holder2 = "$colors{'c2'}$holder2";
|
|
}
|
|
#print "xx:$holder";
|
|
$line = sprintf("%-${indent}s%s$colors{'cn'}\n","$start","$holder$holder2");
|
|
print_line($line);
|
|
$holder = '';
|
|
|
|
$holder2 = "$_ ";
|
|
#print "h2: $holder2\n";
|
|
$length = length($holder2) + $indent;
|
|
$start2 = '';
|
|
$start = '';
|
|
#$length2 = 0;
|
|
}
|
|
}
|
|
if ($holder2 !~ /^\s*$/){
|
|
#print "four\n";
|
|
$holder2 = "$colors{'c2'}$holder2";
|
|
$line = sprintf("%-${indent}s%s$colors{'cn'}\n","$start","$holder$holder2");
|
|
print_line($line);
|
|
$holder = '';
|
|
$holder2 = '';
|
|
$length = $indent;
|
|
$start2 = '';
|
|
$start = '';
|
|
#$length2 = 0;
|
|
}
|
|
}
|
|
else {
|
|
#print "H: $counter $hash\n";
|
|
if ($holder){
|
|
#print "five\n";
|
|
$line = sprintf("%-${indent}s%s$colors{'cn'}\n",$start,"$holder");
|
|
$holder = "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val2";
|
|
$length = length("$key$sep{'s2'} $val2") + $indent;
|
|
print_line($line);
|
|
$start = '';
|
|
}
|
|
else {
|
|
#print "six\n";
|
|
$holder = "$colors{'c1'}$key$sep{'s2'}$colors{'c2'} $val2";
|
|
#$line = sprintf("%-${indent}s%s$colors{'cn'}\n",$start,"$holder");
|
|
$length = $indent;
|
|
#$holder = '';
|
|
}
|
|
}
|
|
$counter++;
|
|
}
|
|
if ($holder !~ /^\s*$/){
|
|
#print "seven\n";
|
|
$line = sprintf("%-${indent}s%s$colors{'cn'}\n",$start,"$start2$holder");
|
|
print_line($line);
|
|
$holder = '';
|
|
$length = 0;
|
|
$start = '';
|
|
}
|
|
}
|
|
# only for repos?
|
|
elsif (ref($val1) eq 'ARRAY'){
|
|
#print "eight\n";
|
|
$array=0;
|
|
foreach my $item (@$val1){
|
|
$array++;
|
|
$line = "$colors{'c1'}$array$sep{'s2'} $colors{'c2'}$item$colors{'cn'}";
|
|
$line = sprintf("%-${indent}s%s\n","","$line");
|
|
print_line($line);
|
|
}
|
|
}
|
|
else {
|
|
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
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 $line;
|
|
}
|
|
}
|
|
|
|
########################################################################
|
|
#### DATA PROCESSORS
|
|
########################################################################
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### PRIMARY DATA GENERATORS
|
|
#### -------------------------------------------------------------------
|
|
# 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
|
|
|
|
## AudioData
|
|
{
|
|
package AudioData;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (@data,@rows);
|
|
my $num = 0;
|
|
if ($b_arm){
|
|
my $key = 'ARM';
|
|
@data = ({
|
|
main::key($num++,$key) => main::row_defaults('arm-pci',''),
|
|
},);
|
|
@rows = (@rows,@data);
|
|
}
|
|
else {
|
|
@data = card_data();
|
|
@rows = (@rows,@data);
|
|
}
|
|
if ( ( $b_arm || !@rows ) && (my $file = main::system_files('asound-cards') ) ){
|
|
@data = asound_data($file);
|
|
@rows = (@rows,@data);
|
|
}
|
|
@data = usb_data();
|
|
@rows = (@rows,@data);
|
|
if (!@rows){
|
|
my $key = 'Message';
|
|
@data = ({
|
|
main::key($num++,$key) => main::row_defaults('pci-card-data',''),
|
|
},);
|
|
@rows = (@rows,@data);
|
|
}
|
|
@data = sound_server_data();
|
|
@rows = (@rows,@data);
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
|
|
sub card_data {
|
|
eval $start if $b_log;
|
|
my (@rows,@data);
|
|
my ($j,$num) = (0,1);
|
|
foreach (@pci){
|
|
$num = 1;
|
|
my @row = @$_;
|
|
if ($row[0] eq 'audio' || $row[0] eq 'multimedia'){
|
|
$j = scalar @rows;
|
|
my $driver = $row[9];
|
|
$driver ||= 'N/A';
|
|
my $card = $row[4];
|
|
$card = ($card) ? main::pci_cleaner($card,'output') : 'N/A';
|
|
# have seen absurdly verbose card descriptions, with non related data etc
|
|
if (length($card) > 85 || $size{'max'} < 110){
|
|
$card = main::pci_long_filter($card);
|
|
}
|
|
@data = ({
|
|
main::key($num++,'Card') => $card,
|
|
main::key($num++,'driver') => $driver,
|
|
},);
|
|
@rows = (@rows,@data);
|
|
if ($extra > 0 && !$bsd_type){
|
|
if ($row[9] ){
|
|
my $version = main::get_module_version($row[9]);
|
|
$rows[$j]{main::key($num++,'v')} = $version if $version;
|
|
}
|
|
}
|
|
if ($extra > 0){
|
|
$rows[$j]{main::key($num++,'bus ID')} = "$row[2].$row[3]";
|
|
}
|
|
if ($extra > 1){
|
|
$rows[$j]{main::key($num++,'chip ID')} = "$row[5]:$row[6]";
|
|
}
|
|
}
|
|
#print "$row[0]\n";
|
|
}
|
|
#my $ref = $pci[-1];
|
|
#print $$ref[0],"\n";
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
# this handles fringe cases where there is no card on pcibus,
|
|
# but there is a card present. I don't know the exact architecture
|
|
# involved but I know this situation exists on at least one old machine.
|
|
sub asound_data {
|
|
eval $start if $b_log;
|
|
my ($file) = @_;
|
|
my (@asound,@rows,@data);
|
|
my ($card,$driver,$j,$num) = ('','',0,1);
|
|
@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+(.*)/;
|
|
$card = $2;
|
|
$driver = $1;
|
|
if ( $card ){
|
|
$j = scalar @rows;
|
|
$driver ||= 'N/A';
|
|
@data = ({
|
|
main::key($num++,'Card') => $card,
|
|
main::key($num++,'driver') => $driver,
|
|
},);
|
|
@rows = (@rows,@data);
|
|
if ($extra > 0){
|
|
my $version = main::get_module_version($driver);
|
|
$rows[$j]{main::key($num++,'v')} = $version if $version;
|
|
$rows[$j]{main::key($num++,'message')} = main::row_defaults('pci-advanced-data','');
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# print Data::Dumper:Dumper \s@rows;
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub usb_data {
|
|
eval $start if $b_log;
|
|
my (@rows,@data,@ids,$driver,$product,$product2,@temp2,$vendor,$vendor2);
|
|
my ($j,$num) = (0,1);
|
|
if (-d '/proc/asound') {
|
|
# note: this will double the data, but it's easier this way.
|
|
# inxi tested for -L in the /proc/asound files, and used only those.
|
|
my @files = main::globber('/proc/asound/*/usbid');
|
|
foreach (@files){
|
|
my $id = (main::reader($_))[0];
|
|
push @ids, $id if ($id && ! grep {/$id/} @ids);
|
|
}
|
|
# lsusb is a very expensive operation
|
|
if (@ids){
|
|
if (!$bsd_type && !$b_usb_check){
|
|
main::set_usb_data();
|
|
$b_usb_check = 1;
|
|
}
|
|
}
|
|
main::log_data('dump','@ids',\@ids) if $b_log;
|
|
return if !@usb;
|
|
foreach my $id (@ids){
|
|
$j = scalar @rows;
|
|
foreach my $ref (@usb){
|
|
my @row = @$ref;
|
|
# a device will always be the second or > device on the bus
|
|
if ($row[1] > 1 && $row[2] eq $id){
|
|
$num = 1;
|
|
# makre sure to reset, or second device trips last flag
|
|
($product,$product2,$vendor,$vendor2) = ('','','','');
|
|
if ($usb_level == 1){
|
|
$product = main::cleaner($row[3]);
|
|
}
|
|
else {
|
|
foreach my $line (@row){
|
|
my @working = split /:/, $line;
|
|
if ($working[0] eq 'idVendor' && $working[2]){
|
|
$vendor = main::cleaner($working[2]);
|
|
}
|
|
if ($working[0] eq 'idProduct' && $working[2]){
|
|
$product = main::cleaner($working[2]);
|
|
}
|
|
if ($working[0] eq 'iManufacturer' && $working[2]){
|
|
$vendor2 = main::cleaner($working[2]);
|
|
}
|
|
if ($working[0] eq 'iProduct' && $working[2]){
|
|
$product2 = main::cleaner($working[2]);
|
|
}
|
|
if ($working[0] eq 'Descriptor_Configuration'){
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
if ($vendor && $product){
|
|
$product = ($product =~ /$vendor/) ? $product: "$vendor $product" ;
|
|
}
|
|
elsif (!$product) {
|
|
if ($vendor && $product2){
|
|
$product = ($product2 =~ /$vendor/) ? $product2: "$vendor $product2" ;
|
|
}
|
|
elsif ($vendor2 && $product2){
|
|
$product = ($product2 =~ /$vendor2/) ? $product2: "$vendor2 $product2" ;
|
|
}
|
|
elsif ($vendor){
|
|
$product = $vendor;
|
|
}
|
|
elsif ($vendor2){
|
|
$product = $vendor2;
|
|
}
|
|
else {
|
|
$product = 'N/A';
|
|
}
|
|
}
|
|
@temp2 = main::get_usb_drivers($row[0],$row[2]) if !$bsd_type && -d "/sys/devices";
|
|
if (@temp2 && $temp2[0]){
|
|
$driver = $temp2[0];
|
|
}
|
|
$driver ||= 'snd-usb-audio';
|
|
@data = ({
|
|
main::key($num++,'Card') => $product,
|
|
main::key($num++,'type') => 'USB',
|
|
main::key($num++,'driver') => $driver,
|
|
},);
|
|
@rows = (@rows,@data);
|
|
if ($extra > 0){
|
|
$rows[$j]{main::key($num++,'bus ID')} = "$row[0]:$row[1]";
|
|
}
|
|
if ($extra > 1){
|
|
$rows[$j]{main::key($num++,'chip ID')} = $row[2];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
|
|
sub sound_server_data {
|
|
eval $start if $b_log;
|
|
my (@data,$server,$version);
|
|
my $num = 0;
|
|
if (my $file = main::system_files('asound-version') ){
|
|
my $content = (main::reader($file))[0];
|
|
# some alsa strings have the build date in (...)
|
|
# remove trailing . and remove possible second line if compiled by user
|
|
# foreach (@content){
|
|
# if (!/compile/i){
|
|
#$_ =~ s/Advanced Linux Sound Architecture/ALSA/;
|
|
$version = (split /\s+/, $content)[-1];
|
|
$version =~ s/\.$//; # trim off period
|
|
$server = 'ALSA';
|
|
# }
|
|
# }
|
|
}
|
|
elsif (my $program = main::check_program('oss')){
|
|
$server = 'OSS';
|
|
$version = main::program_version('oss','\S',2);
|
|
$version ||= 'N/A';
|
|
}
|
|
if ($server){
|
|
@data = ({
|
|
main::key($num++,'Sound Server') => $server,
|
|
main::key($num++,'v') => $version,
|
|
},);
|
|
}
|
|
eval $end if $b_log;
|
|
return @data;
|
|
}
|
|
}
|
|
|
|
## BatteryData
|
|
{
|
|
package BatteryData;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (@rows,$key1,%battery,$val1);
|
|
my $num = 0;
|
|
if ($bsd_type || $b_dmidecode_force){
|
|
my $ref = $alerts{'dmidecode'};
|
|
if ( $$ref{'action'} ne 'use'){
|
|
$key1 = $$ref{'action'};
|
|
$val1 = $$ref{$key1};
|
|
$key1 = ucfirst($key1);
|
|
@rows = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
else {
|
|
%battery = battery_data_dmi();
|
|
if (!%battery){
|
|
if ($show{'battery-forced'}){
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('battery-data','');
|
|
@rows = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
}
|
|
else {
|
|
@rows = create_output(%battery);
|
|
}
|
|
}
|
|
}
|
|
elsif (-d '/sys/class/power_supply/'){
|
|
%battery = battery_data_sys();
|
|
if (!%battery){
|
|
if ($show{'battery-forced'}){
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('battery-data','');
|
|
@rows = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
}
|
|
else {
|
|
@rows = create_output(%battery);
|
|
}
|
|
}
|
|
else {
|
|
if ($show{'battery-forced'}){
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('battery-data-sys','');
|
|
@rows = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
}
|
|
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 create_output {
|
|
eval $start if $b_log;
|
|
my (%battery,@data,@rows) = @_;
|
|
my ($key);
|
|
my $num = 0;
|
|
my $j = 0;
|
|
foreach $key (sort keys %battery){
|
|
$num = 0;
|
|
my ($charge,$condition,$model,$serial,$status,$volts) = ('','','','','','');
|
|
my ($chemistry,$cycles,$location) = ('','','');
|
|
# $battery{$key}{''};
|
|
# we need to handle cases where charge or energy full is 0
|
|
$charge = ($battery{$key}{'energy_now'} || $battery{$key}{'energy_now'} eq 0) ? "$battery{$key}{'energy_now'} Wh" : 'N/A';
|
|
if ($battery{$key}{'energy_full'} || $battery{$key}{'energy_full_design'}){
|
|
$battery{$key}{'energy_full_design'} ||= 'N/A';
|
|
$battery{$key}{'energy_full'}= ($battery{$key}{'energy_full'} || $battery{$key}{'energy_full'} eq 0) ? $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;
|
|
@data = ({
|
|
main::key($num++,'ID') => $key,
|
|
main::key($num++,'charge') => $charge,
|
|
main::key($num++,'condition') => $condition,
|
|
},);
|
|
@rows = (@rows,@data);
|
|
if ($extra > 0){
|
|
if ($extra > 1){
|
|
if ($battery{$key}{'voltage_min_design'} || $battery{$key}{'voltage_now'}){
|
|
$battery{$key}{'voltage_min_design'} ||= 'N/A';
|
|
$battery{$key}{'voltage_now'} ||= 'N/A';
|
|
$volts = "$battery{$key}{'voltage_now'}/$battery{$key}{'voltage_min_design'}";
|
|
}
|
|
$volts ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'volts')} = $volts;
|
|
}
|
|
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++,'model')} = $model;
|
|
if ($extra > 2){
|
|
$chemistry = ( $battery{$key}{'technology'} ) ? $battery{$key}{'technology'}: 'N/A';
|
|
$rows[$j]{main::key($num++,'type')} = $chemistry;
|
|
}
|
|
if ($extra > 1){
|
|
$serial = main::apply_filter($battery{$key}{'serial_number'});
|
|
$rows[$j]{main::key($num++,'serial')} = $serial;
|
|
}
|
|
$status = ($battery{$key}{'status'}) ? $battery{$key}{'status'}: 'N/A';
|
|
$rows[$j]{main::key($num++,'status')} = $status;
|
|
if ($extra > 2){
|
|
if ($battery{$key}{'cycle_count'}){
|
|
$rows[$j]{main::key($num++,'cycles')} = $battery{$key}{'cycle_count'};
|
|
}
|
|
if ($battery{$key}{'location'}){
|
|
$rows[$j]{main::key($num++,'location')} = $battery{$key}{'location'};
|
|
}
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
|
|
# charge: mAh energy: Wh
|
|
sub battery_data_sys {
|
|
eval $start if $b_log;
|
|
my ($b_ma,%battery,$file,$id,$item,$path,$value);
|
|
my $num = 0;
|
|
# NOTE: known ids: BAT[0-9] CMB[0-9]
|
|
my @batteries = main::globber("/sys/class/power_supply/[BC][AM][TB]*/");
|
|
# note: there is no 'location' file, but dmidecode has it
|
|
# 'type' is generic, like: Battery
|
|
# capacity_level is a string, like: Normal
|
|
my @items = qw(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);
|
|
foreach $item (@batteries){
|
|
$b_ma = 0;
|
|
$id = $item;
|
|
$id =~ s%/sys/class/power_supply/|\/$%%g;
|
|
$battery{$id} = ({});
|
|
foreach $file (@items){
|
|
$path = "$item$file";
|
|
$value = (-f $path) ? (main::reader($path))[0]: '';
|
|
if ($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::dmi_cleaner($value);
|
|
}
|
|
elsif ($file eq 'model_name'){
|
|
$value = main::dmi_cleaner($value);
|
|
}
|
|
}
|
|
$battery{$id}{$file} = $value;
|
|
# print "$battery{$id}{$file}\n";
|
|
}
|
|
# 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( "%.0f", $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'} );
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return %battery;
|
|
}
|
|
# note, dmidecode does not have charge_now or charge_full
|
|
sub battery_data_dmi {
|
|
eval $start if $b_log;
|
|
my (%battery,$id);
|
|
my $i = 0;
|
|
foreach (@dmi){
|
|
my @ref = @$_;
|
|
# Portable Battery
|
|
if ($ref[0] == 22){
|
|
$id = "BAT$i";
|
|
$i++;
|
|
$battery{$id} = ({});
|
|
# skip first three row, we don't need that data
|
|
splice @ref, 0, 3 if @ref;
|
|
foreach my $item (@ref){
|
|
my @value = split /:\s+/, $item;
|
|
next if !$value[0];
|
|
if ($value[0] eq 'Location') {$battery{$id}{'location'} = $value[1] }
|
|
elsif ($value[0] eq 'Manufacturer') {$battery{$id}{'manufacturer'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] =~ /Chemistry/) {$battery{$id}{'technology'} = $value[1] }
|
|
elsif ($value[0] =~ /Serial Number/) {$battery{$id}{'serial_number'} = $value[1] }
|
|
elsif ($value[0] =~ /^Name/) {$battery{$id}{'model_name'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'Design Capacity') {
|
|
$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 ($ref[0] > 22){
|
|
last;
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \%battery;
|
|
eval $end if $b_log;
|
|
return %battery;
|
|
}
|
|
}
|
|
|
|
## CpuData
|
|
{
|
|
package CpuData;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my ($type) = @_;
|
|
my (@data,@rows,$single,$key1,$val1);
|
|
my $num = 0;
|
|
if ($type eq 'short' || $type eq 'basic'){
|
|
@rows = data_short($type);
|
|
}
|
|
else {
|
|
@rows = create_output_full();
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub create_output_full {
|
|
eval $start if $b_log;
|
|
my $num = 0;
|
|
my ($b_flags,$flag_key,@flags,%cpu,@data,@rows);
|
|
my $sleep = $cpu_sleep * 1000000;
|
|
if ($b_hires){
|
|
eval 'Time::HiRes::usleep( $sleep )';
|
|
}
|
|
else {
|
|
select(undef, undef, undef, $cpu_sleep);
|
|
}
|
|
if (my $file = main::system_files('cpuinfo')){
|
|
%cpu = data_cpuinfo($file,'full');
|
|
}
|
|
elsif ($bsd_type ){
|
|
my ($key1,$val1) = ('','');
|
|
if ( $alerts{'sysctl'} ){
|
|
if ( $alerts{'sysctl'}{'action'} eq 'use' ){
|
|
# $key1 = 'Status';
|
|
# $val1 = main::row_defaults('dev');
|
|
%cpu = data_sysctl('full');
|
|
}
|
|
else {
|
|
$key1 = ucfirst($alerts{'sysctl'}{'action'});
|
|
$val1 = $alerts{'sysctl'}{$alerts{'sysctl'}{'action'}};
|
|
@data = ({main::key($num++,$key1) => $val1,});
|
|
return @data;
|
|
}
|
|
}
|
|
}
|
|
my %properties = cpu_properties(%cpu);
|
|
my $type = ($properties{'cpu-type'}) ? $properties{'cpu-type'}: '';
|
|
my $ref = $cpu{'processors'};
|
|
my @processors = @$ref;
|
|
my @speeds = cpu_speeds(@processors);
|
|
my $j = scalar @rows;
|
|
$cpu{'model_name'} ||= 'N/A';
|
|
@data = ({
|
|
main::key($num++,'Topology') => $properties{'cpu-layout'},
|
|
main::key($num++,'model') => $cpu{'model_name'},
|
|
},);
|
|
@rows = (@rows,@data);
|
|
$properties{'bits-sys'} ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'bits')} = $properties{'bits-sys'};
|
|
if ($type){
|
|
$rows[$j]{main::key($num++,'type')} = $type;
|
|
}
|
|
if ($extra > 0){
|
|
$cpu{'arch'} ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'arch')} = $cpu{'arch'};
|
|
if ( $cpu{'arch'} ne 'N/A' && $cpu{'rev'} ){
|
|
$rows[$j]{main::key($num++,'rev')} = $cpu{'rev'};
|
|
}
|
|
}
|
|
$properties{'l2-cache'} ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'L2 cache')} = $properties{'l2-cache'} if (!$b_arm || ($b_arm && $properties{'l2-cache'} ne 'N/A'));
|
|
if ($extra > 0 && !$show{'cpu-flag'}){
|
|
$j = scalar @rows;
|
|
@flags = split /\s+/, $cpu{'flags'} if $cpu{'flags'};
|
|
$flag_key = ($b_arm || $bsd_type) ? 'features': 'flags';
|
|
my $flag = 'N/A';
|
|
if (@flags){
|
|
# failure to read dmesg.boot: dmesg.boot permissions
|
|
@flags = grep {/^(dmesg.boot|lm|nx|pae|permissions|pni|svm|vmx|(sss|ss)e([2-9])?([a-z])?(_[0-9])?)$/} @flags;
|
|
@flags = map {s/pni/sse3/; $_} @flags;
|
|
@flags = sort(@flags);
|
|
$flag = join ' ', @flags if @flags;
|
|
}
|
|
if ($b_arm && $flag eq 'N/A'){
|
|
$flag = main::row_defaults('arm-cpu-f');
|
|
}
|
|
@data = ({
|
|
main::key($num++,$flag_key) => $flag,
|
|
},);
|
|
@rows = (@rows,@data);
|
|
$b_flags = 1;
|
|
}
|
|
if ($extra > 0 && !$bsd_type){
|
|
my $bogomips = ($cpu{'bogomips'}) ? int($cpu{'bogomips'}) : 'N/A';
|
|
$rows[$j]{main::key($num++,'bogomips')} = $bogomips;
|
|
}
|
|
$j = scalar @rows;
|
|
my $core_key = (scalar @speeds > 1) ? 'Core speeds (MHz)' : 'Core speed (MHz)';
|
|
my $speed_key = ($properties{'speed-key'}) ? $properties{'speed-key'}: 'Speed';
|
|
my $min_max = ($properties{'min-max'}) ? $properties{'min-max'}: 'N/A';
|
|
my $min_max_key = ($properties{'min-max-key'}) ? $properties{'min-max-key'}: 'min/max';
|
|
my $speed = (defined $properties{'speed'}) ? $properties{'speed'}: 'N/A';
|
|
# aren't able to get per core speeds in bsds yet
|
|
my $core_speeds_value = (@speeds) ? '' : 'N/A';
|
|
$j = scalar @rows;
|
|
@data = ({
|
|
main::key($num++,$speed_key) => $speed,
|
|
main::key($num++,$min_max_key) => $min_max,
|
|
main::key($num++,$core_key) => $core_speeds_value,
|
|
}, );
|
|
@rows = (@rows,@data);
|
|
my $i = 1;
|
|
foreach (@speeds){
|
|
$rows[$j]{main::key($num++,$i++)} = $_;
|
|
}
|
|
if ($show{'cpu-flag'} && !$b_flags){
|
|
$flag_key = ($b_arm || $bsd_type) ? 'Features': 'Flags';
|
|
@flags = split /\s+/, $cpu{'flags'} if $cpu{'flags'};
|
|
my $flag = 'N/A';
|
|
if (@flags){
|
|
@flags = sort(@flags);
|
|
$flag = join ' ', @flags if @flags;
|
|
}
|
|
@data = ({
|
|
main::key($num++,$flag_key) => $flag,
|
|
},);
|
|
@rows = (@rows,@data);
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub create_output_short {
|
|
eval $start if $b_log;
|
|
my (@cpu) = @_;
|
|
my @data;
|
|
my $num = 0;
|
|
$cpu[1] ||= main::row_defaults('cpu-model-null');
|
|
$cpu[2] ||= 'N/A';
|
|
@data = ({
|
|
main::key($num++,$cpu[0]) => $cpu[1],
|
|
main::key($num++,'type') => $cpu[2],
|
|
},);
|
|
if ($extra > 0){
|
|
$data[0]{main::key($num++,'arch')} = $cpu[7];
|
|
}
|
|
$data[0]{main::key($num++,$cpu[3])} = $cpu[4];
|
|
if ($cpu[6]){
|
|
$data[0]{main::key($num++,$cpu[5])} = $cpu[6];
|
|
}
|
|
eval $end if $b_log;
|
|
return @data;
|
|
}
|
|
sub data_short {
|
|
eval $start if $b_log;
|
|
my ($type) = @_;
|
|
my $num = 0;
|
|
my (%cpu,@data,%speeds);
|
|
my $sys = '/sys/devices/system/cpu/cpufreq/policy0';
|
|
my $sleep = $cpu_sleep * 1000000;
|
|
if ($b_hires){
|
|
eval 'Time::HiRes::usleep( $sleep )';
|
|
}
|
|
else {
|
|
select(undef, undef, undef, $cpu_sleep);
|
|
}
|
|
# NOTE: : Permission denied, ie, this is not always readable
|
|
# /sys/devices/system/cpu/cpu0/cpufreq/cpuinfo_cur_freq
|
|
if (my $file = main::system_files('cpuinfo')){
|
|
%cpu = data_cpuinfo($file,$type);
|
|
}
|
|
elsif ($bsd_type ){
|
|
my ($key1,$val1) = ('','');
|
|
if ( $alerts{'sysctl'} ){
|
|
if ( $alerts{'sysctl'}{'action'} eq 'use' ){
|
|
# $key1 = 'Status';
|
|
# $val1 = main::row_defaults('dev');
|
|
%cpu = data_sysctl($type);
|
|
}
|
|
else {
|
|
$key1 = ucfirst($alerts{'sysctl'}{'action'});
|
|
$val1 = $alerts{'sysctl'}{$alerts{'sysctl'}{'action'}};
|
|
@data = ({main::key($num++,$key1) => $val1,});
|
|
return @data;
|
|
}
|
|
}
|
|
}
|
|
# $cpu{'cur-freq'} = $cpu[0]{'core-id'}[0]{'speed'};
|
|
if ($type eq 'short' || $type eq 'basic'){
|
|
@data = prep_short_data(%cpu);
|
|
}
|
|
if ($type eq 'basic'){
|
|
@data = create_output_short(@data);
|
|
}
|
|
eval $end if $b_log;
|
|
return @data;
|
|
}
|
|
|
|
sub prep_short_data {
|
|
eval $start if $b_log;
|
|
my (%cpu) = @_;
|
|
my %properties = cpu_properties(%cpu);
|
|
my ($cpu,$speed_key,$speed,$type) = ('','speed',0,'');
|
|
$cpu = $cpu{'model_name'} if $cpu{'model_name'};
|
|
$type = $properties{'cpu-type'} if $properties{'cpu-type'};
|
|
$speed_key = $properties{'speed-key'} if $properties{'speed-key'};
|
|
$speed = $properties{'speed'} if $properties{'speed'};
|
|
my @result = (
|
|
$properties{'cpu-layout'},
|
|
$cpu,
|
|
$type,
|
|
$speed_key,
|
|
$speed,
|
|
$properties{'min-max-key'},
|
|
$properties{'min-max'},
|
|
);
|
|
if ($extra > 0){
|
|
$cpu{'arch'} ||= 'N/A';
|
|
$result[7] = $cpu{'arch'};
|
|
}
|
|
eval $end if $b_log;
|
|
return @result;
|
|
}
|
|
|
|
sub data_cpuinfo {
|
|
eval $start if $b_log;
|
|
my ($file,$type)= @_;
|
|
my ($arch,@ids,@line,$b_first,$b_proc_int,$starter);
|
|
# use --arm flag when testing arm cpus
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/arm-4-core-pinebook-1.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/armv6-single-core-1.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/armv7-dual-core-1.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/armv7-new-format-model-name-single-core.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/arm-2-die-96-core-rk01.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/16-core-32-mt-ryzen.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/2-16-core-epyc-abucodonosor.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/2-core-probook-antix.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-jean-antix.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-althlon-mjro.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-apu-vc-box.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/amd/4-core-a10-5800k-1.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-core-ht-atom-bruh.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/core-2-i3.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/8-core-i7-damentz64.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-10-core-xeon-ht.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/4-core-xeon-fake-dual-die-zyanya.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-core-i5-fake-dual-die-hek.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/2-1-core-xeon-vm-vs2017.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/4-1-core-xeon-vps-frodo1.txt";
|
|
# $file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/intel/4-6-core-xeon-no-mt-lathander.txt";
|
|
my %speeds = set_cpu_speeds_sys();
|
|
my @cpuinfo = main::reader($file);
|
|
my @phys_cpus = (0);# start with 1 always
|
|
my ($cache,$core_count,$die_holder,$die_id,$phys_id,$proc_count,$speed) = (0,0,0,0,0,0,0);
|
|
my ($phys_holder) = (undef);
|
|
# 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
|
|
#$ids[0] = ([(0)]);
|
|
$ids[0] = ([]);
|
|
$ids[0][0] = ([]);
|
|
my %cpu = set_cpu_data();
|
|
# note, there con be a lot of processors, 32 core HT would have 64, for example.
|
|
foreach (@cpuinfo){
|
|
next if /^\s*$/;
|
|
@line = split /\s*:\s*/, $_;
|
|
next if !$line[0];
|
|
$starter = $line[0]; # preserve case for one specific ARM issue
|
|
$line[0] = lc($line[0]);
|
|
if ($b_arm && !$b_first && $starter eq 'Processor' && $line[1] !~ /^\d+$/){
|
|
#print "l1:$line[1]\n";
|
|
$cpu{'model_name'} = main::cleaner($line[1]);
|
|
$cpu{'model_name'} = cpu_cleaner($cpu{'model_name'});
|
|
$cpu{'type'} = 'arm';
|
|
# Processor : AArch64 Processor rev 4 (aarch64)
|
|
# Processor : Feroceon 88FR131 rev 1 (v5l)
|
|
if ($cpu{'model_name'} && $cpu{'model_name'} =~ /(.*)\srev\s([\S]+)\s(\(([\S]+)\))?/){
|
|
$cpu{'model_name'} = $1;
|
|
$cpu{'rev'} = $2;
|
|
if ($4){
|
|
$cpu{'arch'} = $4;
|
|
$cpu{'model_name'} .= ' ' . $cpu{'arch'} if $cpu{'model_name'} !~ /$cpu{'arch'}/i;
|
|
}
|
|
$cpu{'processors'}[$proc_count] = 0;
|
|
$b_proc_int = 0;
|
|
$b_first = 1;
|
|
#print "p0:\n";
|
|
}
|
|
}
|
|
elsif ($line[0] eq 'processor'){
|
|
# this protects against double processor lines, one int, one string
|
|
if ($line[1] =~ /^\d+$/){
|
|
$b_proc_int = 1;
|
|
$b_first = 1;
|
|
$cpu{'processors'}[$proc_count] = 0;
|
|
$proc_count++;
|
|
#print "p1: $proc_count\n";
|
|
}
|
|
else {
|
|
if (!$b_proc_int){
|
|
$cpu{'processors'}[$proc_count] = 0;
|
|
$proc_count++;
|
|
#print "p2a: $proc_count\n";
|
|
}
|
|
if (!$b_first ){
|
|
# note: alternate:
|
|
# Processor : AArch64 Processor rev 4 (aarch64)
|
|
# but no model name type
|
|
if ( $b_arm || $line[1] =~ /ARM|AArch/i){
|
|
$b_arm = 1;
|
|
$cpu{'type'} = 'arm';
|
|
}
|
|
$cpu{'model_name'} = main::cleaner($line[1]);
|
|
$cpu{'model_name'} = cpu_cleaner($cpu{'model'});
|
|
#print "p2b:\n";
|
|
}
|
|
$b_first = 1;
|
|
}
|
|
}
|
|
elsif (!$cpu{'family'} &&
|
|
($line[0] eq 'architecture' || $line[0] eq 'cpu family' || $line[0] eq 'cpu architecture' )){
|
|
if ($line[1] =~ /^\d+$/){
|
|
# translate integers to hex
|
|
$cpu{'family'} = uc(sprintf("%x", $line[1]));
|
|
}
|
|
elsif ($b_arm) {
|
|
$cpu{'arch'} = $line[1];
|
|
}
|
|
}
|
|
elsif (!$cpu{'rev'} && ($line[0] eq 'stepping' || $line[0] eq 'cpu revision' )){
|
|
$cpu{'rev'} = $line[1];
|
|
}
|
|
# this is hex so uc for cpu arch id
|
|
elsif (!$cpu{'model_id'} && $line[0] eq 'model' ){
|
|
$cpu{'model_id'} = uc(sprintf("%x", $line[1]));
|
|
}
|
|
elsif (!$cpu{'model_id'} && $line[0] eq 'cpu variant' ){
|
|
$cpu{'model_id'} = uc($line[1]);
|
|
$cpu{'model_id'} =~ s/^0X//;
|
|
}
|
|
# cpu can show in arm
|
|
elsif (!$cpu{'model_name'} &&( $line[0] eq 'model name' || $line[0] eq 'cpu' )){
|
|
$cpu{'model_name'} = main::cleaner($line[1]);
|
|
$cpu{'model_name'} = cpu_cleaner($cpu{'model_name'});
|
|
if ( $b_arm || $line[1] =~ /ARM|AArch/i){
|
|
$b_arm = 1;
|
|
$cpu{'type'} = 'arm';
|
|
if ($cpu{'model_name'} && $cpu{'model_name'} =~ /(.*)\srev\s([\S]+)\s(\(([\S]+)\))?/){
|
|
$cpu{'model_name'} = $1;
|
|
$cpu{'rev'} = $2;
|
|
if ($4){
|
|
$cpu{'arch'} = $4;
|
|
$cpu{'model_name'} .= ' ' . $cpu{'arch'} if $cpu{'model_name'} !~ /$cpu{'arch'}/i;
|
|
}
|
|
#$cpu{'processors'}[$proc_count] = 0;
|
|
}
|
|
}
|
|
}
|
|
elsif ( $line[0] eq 'cpu mhz' ){
|
|
$speed = speed_cleaner($line[1]);
|
|
$cpu{'processors'}[$proc_count-1] = $speed;
|
|
#$ids[$phys_id][$die_id] = ([($speed)]);
|
|
}
|
|
elsif (!$cpu{'siblings'} && $line[0] eq 'siblings' ){
|
|
$cpu{'siblings'} = $line[1];
|
|
}
|
|
elsif (!$cpu{'cores'} && $line[0] eq 'cpu cores' ){
|
|
$cpu{'cores'} = $line[1];
|
|
}
|
|
# increment by 1 for every new physical id we see. These are in almost all cases
|
|
# separate cpus, not separate dies within a single cpu body.
|
|
elsif ( $line[0] eq 'physical id' ){
|
|
if ( !defined $phys_holder || $phys_holder != $line[1] ){
|
|
# only increment if not in array counter
|
|
push @phys_cpus, $line[1] if ! grep {/$line[1]/} @phys_cpus;
|
|
$phys_holder = $line[1];
|
|
$ids[$phys_holder] = ([]) if ! exists $ids[$phys_holder];
|
|
$ids[$phys_holder][$die_id] = ([]) if ! exists $ids[$phys_holder][$die_id];
|
|
#print "pid: $line[1] ph: $phys_holder did: $die_id\n";
|
|
$die_id = 0;
|
|
#$die_holder = 0;
|
|
}
|
|
}
|
|
elsif ( $line[0] eq 'core id' ){
|
|
#print "ph: $phys_holder did: $die_id l1: $line[1] s: $speed\n";
|
|
# https://www.pcworld.com/article/3214635/components-processors/ryzen-threadripper-review-we-test-amds-monster-cpu.html
|
|
if ($line[1] > 0 ){
|
|
$die_holder = $line[1];
|
|
$core_count++;
|
|
}
|
|
# NOTE: this logic won't work for die detections, unforutnately.
|
|
# ARM uses a different /sys based method, and ryzen relies on math on the cores
|
|
# in process_data
|
|
elsif ($line[1] == 0 && $die_holder > 0 ){
|
|
$die_holder = $line[1];
|
|
$core_count = 0;
|
|
$die_id++ if ($cpu{'type'} ne 'intel' && $cpu{'type'} ne 'amd' );
|
|
}
|
|
$phys_holder = 0 if ! defined $phys_holder;
|
|
$ids[$phys_holder][$die_id][$line[1]] = $speed;
|
|
#print "ph: $phys_holder did: $die_id l1: $line[1] s: $speed\n";
|
|
}
|
|
if (!$cpu{'type'} && $line[0] eq 'vendor_id' ){
|
|
$cpu{'type'} = cpu_vendor($line[1]);
|
|
}
|
|
## this is only for -C full cpu output
|
|
if ( $type eq 'full' ){
|
|
if (!$cpu{'l2-cache'} && $line[0] eq 'cache size'){
|
|
if ($line[1] =~ /(\d+)\sKB$/){
|
|
$cpu{'l2-cache'} = $1;
|
|
}
|
|
elsif ($line[1] =~ /(\d+)\sMB$/){
|
|
$cpu{'l2-cache'} = ($1*1024);
|
|
}
|
|
}
|
|
if (!$cpu{'flags'} && ($line[0] eq 'flags' || $line[0] eq 'features' )){
|
|
$cpu{'flags'} = $line[1];
|
|
}
|
|
}
|
|
if ( $extra > 0 && $type eq 'full' ){
|
|
if ($line[0] eq 'bogomips'){
|
|
# new arm shows bad bogomip value, so don't use it
|
|
$cpu{'bogomips'} += $line[1] if $line[1] > 50;
|
|
}
|
|
}
|
|
}
|
|
$cpu{'phys'} = scalar @phys_cpus;
|
|
$cpu{'dies'} = $die_id++; # count starts at 0, all cpus have 1 die at least
|
|
if ($b_arm && $cpu{'dies'} <= 1){
|
|
my $arm_dies = cpu_dies_sys();
|
|
# case were 4 core arm returned 4 sibling lists, obviously wrong
|
|
$cpu{'dies'} = $arm_dies if $arm_dies && $proc_count != $arm_dies;
|
|
}
|
|
$cpu{'type'} = 'arm' if $b_arm && !$cpu{'type'};
|
|
$cpu{'ids'} = (\@ids);
|
|
if ( $extra > 0 && !$cpu{'arch'} && $type ne 'short' ){
|
|
$cpu{'arch'} = cpu_arch($cpu{'type'},$cpu{'family'},$cpu{'model_id'});
|
|
#print "$cpu{'type'},$cpu{'family'},$cpu{'model_id'},$cpu{'arch'}\n";
|
|
}
|
|
if (!$speeds{'cur-freq'}){
|
|
$cpu{'cur-freq'} = $cpu{'processors'}[0];
|
|
$speeds{'min-freq'} = 0;
|
|
$speeds{'max-freq'} = 0;
|
|
}
|
|
else {
|
|
$cpu{'cur-freq'} = $speeds{'cur-freq'};
|
|
$cpu{'min-freq'} = $speeds{'min-freq'};
|
|
$cpu{'max-freq'} = $speeds{'max-freq'};
|
|
}
|
|
main::log_data('dump','%cpu',\%cpu) if $b_log;
|
|
print Data::Dumper::Dumper \%cpu if $test[8];
|
|
eval $end if $b_log;
|
|
return %cpu;
|
|
}
|
|
|
|
sub data_sysctl {
|
|
eval $start if $b_log;
|
|
my ($type) = @_;
|
|
my %cpu = set_cpu_data();
|
|
my (@ids,@line,%speeds,@working);
|
|
my ($sep) = ('');
|
|
my ($cache,$die_holder,$die_id,$phys_holder,$phys_id,$proc_count,$speed) = (0,0,0,0,0,0,0);
|
|
foreach (@sysctl){
|
|
@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)
|
|
# freebsd 10: hw.model: AMD Athlon(tm) II X2 245 Processor
|
|
$line[1] = main::cleaner($line[1]);
|
|
$line[1] = cpu_cleaner($line[1]);
|
|
if ( $line[1] =~ /([0-9]+)[\-[:space:]]*([KM]B)\s+L2 cache/) {
|
|
my $multiplier = ($2 eq 'MB') ? 1024: 1;
|
|
$cpu{'l2-cache'} = $1 * $multiplier;
|
|
}
|
|
if ( $line[1] =~ /([^0-9\.][0-9\.]+)[\-[:space:]]*[MG]Hz/) {
|
|
$cpu{'max-freq'} = $1;
|
|
if ($cpu{'max-freq'} =~ /MHz/i) {
|
|
$cpu{'max-freq'} =~ s/[\-[:space:]]*MHz//;
|
|
$cpu{'max-freq'} = speed_cleaner($cpu{'max-freq'},'mhz');
|
|
}
|
|
elsif ($cpu{'max-freq'} =~ /GHz/) {
|
|
$cpu{'max-freq'} =~ s/[\-[:space:]]*GHz//i;
|
|
$cpu{'max-freq'} = $cpu{'max-freq'} / 1000;
|
|
$cpu{'max-freq'} = speed_cleaner($cpu{'max-freq'},'mhz');
|
|
}
|
|
}
|
|
if ( $line[1] =~ /\)$/ ){
|
|
$line[1] =~ s/\s*\(.*\)$//;
|
|
}
|
|
$cpu{'model_name'} = $line[1];
|
|
$cpu{'type'} = cpu_vendor($line[1]);
|
|
}
|
|
# NOTE: hw.l1icachesize: hw.l1dcachesize:
|
|
elsif ($line[0] eq 'hw.l1icachesize') {
|
|
$cpu{'l1-cache'} = $line[1]/1024;
|
|
}
|
|
elsif ($line[0] eq 'hw.l2cachesize') {
|
|
$cpu{'l2-cache'} = $line[1]/1024;
|
|
}
|
|
# this is in mghz in samples
|
|
elsif ($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;
|
|
}
|
|
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]);
|
|
}
|
|
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.
|
|
elsif ($line[0] eq 'dev.cpu.0.freq_levels') {
|
|
$line[1] =~ s/^\s+|\/[0-9]+|\s+$//g;
|
|
if ( $line[1] =~ /[0-9]+\s+[0-9]+/ ) {
|
|
my @temp = split /\s+/, $line[1];
|
|
$cpu{'max-freq'} = $temp[0];
|
|
$cpu{'min-freq'} = $temp[-1];
|
|
$cpu{'scalings'} = \@temp;
|
|
}
|
|
}
|
|
elsif (!$cpu{'cur-freq'} && $line[0] eq 'dev.cpu.0.freq' ) {
|
|
$cpu{'cur-freq'} = $line[1];
|
|
}
|
|
# 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;
|
|
$cpu{'processors'}[$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.
|
|
elsif ( $line[0] eq 'hw.cpu_topology.cpu0.physical_id' ){
|
|
if ($phys_holder != $line[1] ){
|
|
$phys_id++;
|
|
$phys_holder = $line[1];
|
|
$ids[$phys_id] = ([(0)]);
|
|
$ids[$phys_id][$die_id] = ([(0)]);
|
|
}
|
|
}
|
|
elsif ( $line[0] eq 'hw.cpu_topology.cpu0.core_id' ){
|
|
if ($line[1] > 0 ){
|
|
$die_holder = $line[1];
|
|
}
|
|
# this handles multi die cpus like 16 core ryzen
|
|
elsif ($line[1] == 0 && $die_holder > 0 ){
|
|
$die_id++ ;
|
|
$die_holder = $line[1];
|
|
}
|
|
$ids[$phys_id][$die_id][$line[1]] = $speed;
|
|
$cpu{'dies'} = $die_id;
|
|
}
|
|
}
|
|
if (!$cpu{'flags'}){
|
|
$cpu{'flags'} = cpu_flags_bsd();
|
|
}
|
|
main::log_data('dump','%cpu',\%cpu) if $b_log;
|
|
print Data::Dumper::Dumper \%cpu if $test[8];
|
|
eval $end if $b_log;
|
|
return %cpu;
|
|
}
|
|
|
|
sub cpu_properties {
|
|
my (%cpu) = @_;
|
|
my ($b_amd_zen,$b_epyc,$b_ht,$b_intel,$b_ryzen,$b_xeon);
|
|
if ($cpu{'type'} ){
|
|
if ($cpu{'type'} eq 'intel'){
|
|
$b_intel = 1;
|
|
$b_xeon = 1 if $cpu{'model_name'} =~ /Xeon/i;
|
|
}
|
|
elsif ($cpu{'type'} eq 'amd' ){
|
|
if ( $cpu{'family'} && $cpu{'family'} eq '17' ) {
|
|
$b_amd_zen = 1;
|
|
if ($cpu{'model_name'} ){
|
|
if ($cpu{'model_name'} =~ /Ryzen/i ){
|
|
$b_ryzen = 1;
|
|
}
|
|
elsif ($cpu{'model_name'} =~ /EPYC/i){
|
|
$b_epyc = 1;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
#my @dies = $phys[0][0];
|
|
my $ref = $cpu{'ids'};
|
|
my @phys = @$ref;
|
|
my $phyical_count = 0;
|
|
#my $phyical_count = scalar @phys;
|
|
my @processors;
|
|
my ($speed,$speed_key);
|
|
# handle case where cpu reports say, phys id 0, 2, 4, 6 [yes, seen it]
|
|
foreach (@phys) {
|
|
$phyical_count++ if $_;
|
|
}
|
|
$phyical_count ||= 1; # assume 1 if no id found, as with ARM
|
|
# count unique processors ##
|
|
# note, this fails for intel cpus at times
|
|
$ref = $cpu{'processors'};
|
|
@processors = @$ref;
|
|
#print ref $cpu{'processors'}, "\n";
|
|
my $processors_count = scalar @processors;
|
|
#print "p count:$processors_count\n";
|
|
#print Data::Dumper::Dumper \@processors;
|
|
# $cpu_cores is per physical cpu
|
|
my ($cpu_layout,$cpu_type,$min_max,$min_max_key) = ('','','','');
|
|
my ($cache,$core_count,$cpu_cores,$die_count) = (0,0,0,0);
|
|
foreach my $die_ref ( @phys ){
|
|
next if ! $die_ref;
|
|
my @dies = @$die_ref;
|
|
$core_count = 0;
|
|
$die_count = scalar @dies;
|
|
#$cpu{'dies'} = $die_count;
|
|
foreach my $core_ref (@dies){
|
|
next if ref $core_ref ne 'ARRAY';
|
|
my @cores = @$core_ref;
|
|
$core_count = 0;# reset for each die!!
|
|
# NOTE: the counters can be undefined because the index comes from
|
|
# core id: which can be 0 skip 1 then 2, which leaves index 1 undefined
|
|
# arm cpus do not actually show core id so ignore that counter
|
|
foreach my $id (@cores){
|
|
$core_count++ if defined $id && !$b_arm;
|
|
}
|
|
#print 'cores: ' . $core_count, "\n";
|
|
}
|
|
}
|
|
# this covers potentially cases where ARM cpus have > 1 die
|
|
$cpu{'dies'} = ($b_arm && $die_count <= 1 && $cpu{'dies'} > 1) ? $cpu{'dies'}: $die_count;
|
|
# this is an attempt to fix the amd family 15 bug with reported cores vs actual cores
|
|
# NOTE: amd A6-4400M APU 2 core reports: cores: 1 siblings: 2
|
|
# NOTE: AMD A10-5800K APU 4 core reports: cores: 2 siblings: 4
|
|
if ($cpu{'cores'} && ! $core_count || $cpu{'cores'} >= $core_count){
|
|
$cpu_cores = $cpu{'cores'};
|
|
}
|
|
elsif ($core_count > $cpu{'cores'}){
|
|
$cpu_cores = $core_count;
|
|
}
|
|
#print "cpu-c:$cpu_cores\n";
|
|
#$cpu_cores = $cpu{'cores'};
|
|
# like, intel core duo
|
|
# NOTE: sadly, not all core intel are HT/MT, oh well...
|
|
# xeon may show wrong core / physical id count, if it does, fix it. A xeon
|
|
# may show a repeated core id : 0 which gives a fake num_of_cores=1
|
|
if ($b_intel){
|
|
if ($cpu{'siblings'} && $cpu{'siblings'} > 1 && $cpu{'cores'} && $cpu{'cores'} > 1 ){
|
|
if ( $cpu{'siblings'}/$cpu{'cores'} == 1 ){
|
|
$b_intel = 0;
|
|
$b_ht = 0;
|
|
}
|
|
else {
|
|
$cpu_cores = ($cpu{'siblings'}/2);
|
|
$b_ht = 1;
|
|
}
|
|
}
|
|
}
|
|
# ryzen is made out of blocks of 8 core dies
|
|
elsif ($b_ryzen){
|
|
$cpu_cores = $cpu{'cores'};
|
|
# note: posix ceil isn't present in Perl for some reason, deprecated?
|
|
my $working = $cpu_cores / 8;
|
|
my @temp = split /\./, $working;
|
|
$cpu{'dies'} = ($temp[1] && $temp[1] > 0) ? $temp[0]++ : $temp[0];
|
|
}
|
|
# these always have 4 dies
|
|
elsif ($b_epyc) {
|
|
$cpu_cores = $cpu{'cores'};
|
|
$cpu{'dies'} = 4;
|
|
}
|
|
# final check, override the num of cores value if it clearly is wrong
|
|
# and use the raw core count and synthesize the total instead of real count
|
|
if ( $cpu_cores == 0 && ($cpu{'cores'} * $phyical_count > 1)){
|
|
$cpu_cores = ($cpu{'cores'} * $phyical_count);
|
|
}
|
|
# last check, seeing some intel cpus and vms with intel cpus that do not show any
|
|
# core id data at all, or siblings.
|
|
if ($cpu_cores == 0 && $processors_count > 0){
|
|
$cpu_cores = $processors_count;
|
|
}
|
|
# this happens with BSDs which have very little cpu data available
|
|
if ( $processors_count == 0 && $cpu_cores > 0 ){
|
|
$processors_count = $cpu_cores;
|
|
if ($bsd_type && ($b_ht || $b_amd_zen) && $cpu_cores > 2 ){
|
|
$cpu_cores = $cpu_cores/2;;
|
|
}
|
|
my $count = $processors_count;
|
|
$count-- if $count > 0;
|
|
$cpu{'processors'}[$count] = 0;
|
|
# no way to get per processor speeds yet, so assign 0 to each
|
|
# must be a numeric value. Could use raw speed from core 0, but
|
|
# that would just be a hack.
|
|
foreach (0 .. $count){
|
|
$cpu{'processors'}[$_] = 0;
|
|
}
|
|
}
|
|
# last test to catch some corner cases
|
|
# seen a case where a xeon vm in a dual xeon system actually had 2 cores, no MT
|
|
# so it reported 4 siblings, 2 cores, but actually only had 1 core per virtual cpu
|
|
#print "prc: $processors_count phc: $phyical_count coc: $core_count cpc: $cpu_cores\n";
|
|
if (!$b_arm && $processors_count == $phyical_count*$core_count && $cpu_cores > $core_count){
|
|
$b_ht = 0;
|
|
#$b_xeon = 0;
|
|
$b_intel = 0;
|
|
$cpu_cores = 1;
|
|
$core_count = 1;
|
|
$cpu{'siblings'} = 1;
|
|
}
|
|
#print "pc: $processors_count s: $cpu{'siblings'} cpuc: $cpu_cores corec: $core_count\n";
|
|
# Algorithm:
|
|
# if > 1 processor && processor id (physical id) == core id then Multi threaded (MT)
|
|
# if siblings > 1 && siblings == 2 * num_of_cores ($cpu{'cores'}) then Multi threaded (MT)
|
|
# if > 1 processor && processor id (physical id) != core id then Multi-Core Processors (MCP)
|
|
# if > 1 processor && processor ids (physical id) > 1 then Symmetric Multi Processing (SMP)
|
|
# if = 1 processor then single core/processor Uni-Processor (UP)
|
|
if ( $processors_count > 1 || ( $b_intel && $cpu{'siblings'} > 0 ) ) {
|
|
# non-multicore MT
|
|
if ($processors_count == ($phyical_count * $cpu_cores * 2)){
|
|
#print "mt:1\n";
|
|
$cpu_type .= 'MT';
|
|
}
|
|
# elsif ($b_xeon && $cpu{'siblings'} > 1){
|
|
# #print "mt:2\n";
|
|
# $cpu_type .= 'MT';
|
|
# }
|
|
elsif ($cpu{'siblings'} > 1 && ($cpu{'siblings'} == 2 * $cpu_cores )){
|
|
#print "mt:3\n";
|
|
$cpu_type .= 'MT';
|
|
}
|
|
# non-MT multi-core or MT multi-core
|
|
if ( ($processors_count == $cpu_cores ) || ($phyical_count < $cpu_cores)){
|
|
my $sep = ($cpu_type) ? ' ' : '' ;
|
|
$cpu_type .= $sep . 'MCP';
|
|
}
|
|
# only solidly known > 1 die cpus will use this, ryzen and arm for now
|
|
if ( $cpu{'dies'} > 1 ){
|
|
my $sep = ($cpu_type) ? ' ' : '' ;
|
|
$cpu_type .= $sep . 'MCM';
|
|
}
|
|
# >1 cpu sockets active: Symetric Multi Processing
|
|
if ($phyical_count > 1){
|
|
my $sep = ($cpu_type) ? ' ' : '' ;
|
|
$cpu_type .= $sep . 'SMP';
|
|
}
|
|
}
|
|
else {
|
|
$cpu_type = 'UP';
|
|
}
|
|
if ($phyical_count > 1){
|
|
$cpu_layout = $phyical_count . 'x ';
|
|
}
|
|
$cpu_layout .= count_alpha($cpu_cores) . 'Core';
|
|
$cpu_layout .= ' (' . $cpu{'dies'}. '-Die)' if !$bsd_type && $cpu{'dies'} > 1;
|
|
# the only possible change for bsds is if we can get phys counts in the future
|
|
if ($bsd_type){
|
|
$cache = $cpu{'l2-cache'} * $phyical_count;
|
|
}
|
|
# AMD SOS chips appear to report full L2 cache per core
|
|
elsif ($cpu{'type'} eq 'amd' && ($cpu{'family'} eq '14' || $cpu{'family'} eq '15' || $cpu{'family'} eq '16')){
|
|
$cache = $cpu{'l2-cache'} * $phyical_count;
|
|
}
|
|
elsif ($cpu{'type'} ne 'intel'){
|
|
$cache = $cpu{'l2-cache'} * $cpu_cores * $phyical_count;
|
|
}
|
|
## note: this handles how intel reports L2, total instead of per core like AMD does
|
|
# note that we need to multiply by number of actual cpus here to get true cache size
|
|
else {
|
|
$cache = $cpu{'l2-cache'} * $phyical_count;
|
|
}
|
|
if ($cache > 10000){
|
|
$cache = sprintf("%.01f MiB",$cache/1024); # trim to no decimals?
|
|
}
|
|
elsif ($cache > 0){
|
|
$cache = "$cache KiB";
|
|
}
|
|
if ($cpu{'cur-freq'} && $cpu{'min-freq'} && $cpu{'max-freq'} ){
|
|
$min_max = "$cpu{'min-freq'}/$cpu{'max-freq'} MHz";
|
|
$min_max_key = "min/max";
|
|
$speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
|
|
$speed = "$cpu{'cur-freq'} MHz";
|
|
}
|
|
elsif ($cpu{'cur-freq'} && $cpu{'max-freq'}){
|
|
$min_max = "$cpu{'max-freq'} MHz";
|
|
$min_max_key = "max";
|
|
$speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
|
|
$speed = "$cpu{'cur-freq'} MHz";
|
|
}
|
|
# elsif ($cpu{'cur-freq'} && $cpu{'max-freq'} && $cpu{'cur-freq'} == $cpu{'max-freq'}){
|
|
# $speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
|
|
# $speed = "$cpu{'cur-freq'} MHz (max)";
|
|
# }
|
|
elsif ($cpu{'cur-freq'} && $cpu{'min-freq'}){
|
|
$min_max = "$cpu{'min-freq'} MHz";
|
|
$min_max_key = "min";
|
|
$speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
|
|
$speed = "$cpu{'cur-freq'} MHz";
|
|
}
|
|
elsif ($cpu{'cur-freq'} && !$cpu{'max-freq'}){
|
|
$speed_key = ($show{'short'} || $show{'cpu-basic'}) ? 'speed' : 'Speed';
|
|
$speed = "$cpu{'cur-freq'} MHz";
|
|
}
|
|
|
|
if ( !$bits_sys && !$b_arm && $cpu{'flags'} ){
|
|
$bits_sys = ($cpu{'flags'} =~ /\blm\b/) ? 64 : 32;
|
|
}
|
|
my %cpu_properties = (
|
|
'bits-sys' => $bits_sys,
|
|
'cpu-layout' => $cpu_layout,
|
|
'cpu-type' => $cpu_type,
|
|
'min-max-key' => $min_max_key,
|
|
'min-max' => $min_max,
|
|
'speed-key' => $speed_key,
|
|
'speed' => $speed,
|
|
'l2-cache' => $cache,
|
|
);
|
|
main::log_data('dump','%cpu_properties',\%cpu_properties) if $b_log;
|
|
#print Data::Dumper::Dumper \%cpu;
|
|
#print Data::Dumper::Dumper \%cpu_properties;
|
|
#my $dc = scalar @dies;
|
|
#print 'phys: ' . $pc . ' dies: ' . $dc, "\n";
|
|
eval $end if $b_log;
|
|
return %cpu_properties;
|
|
}
|
|
sub cpu_speeds {
|
|
eval $start if $b_log;
|
|
my (@processors) = @_;
|
|
my (@speeds);
|
|
my @files = main::globber('/sys/devices/system/cpu/cpu*/cpufreq/scaling_cur_freq');
|
|
foreach (@files){
|
|
my $speed = (main::reader($_))[0];
|
|
if ($speed || $speed eq '0'){
|
|
$speed = sprintf "%.0f", $speed/1000;
|
|
push @speeds, $speed;
|
|
}
|
|
}
|
|
if (!@speeds){
|
|
foreach (@processors){
|
|
if ($_ || $_ eq '0'){
|
|
$_ = sprintf "%.0f", $_;
|
|
push @speeds, $_;
|
|
}
|
|
}
|
|
}
|
|
#print join '; ', @speeds, "\n";
|
|
eval $end if $b_log;
|
|
return @speeds;
|
|
}
|
|
sub set_cpu_speeds_sys {
|
|
eval $start if $b_log;
|
|
my (@arm,%speeds);
|
|
my $sys = '/sys/devices/system/cpu/cpufreq/policy0';
|
|
my $sys2 = '/sys/devices/system/cpu/cpu0/cpufreq/';
|
|
my ($cur,$min,$max) = ('scaling_cur_freq','scaling_min_freq','scaling_max_freq');
|
|
if (!-d $sys && -d $sys2){
|
|
$sys = $sys2;
|
|
($cur,$min,$max) = ('scaling_cur_freq','cpuinfo_min_freq','cpuinfo_max_freq');
|
|
}
|
|
if (-d $sys){
|
|
$speeds{'cur-freq'} = (main::reader("$sys/$cur"))[0];
|
|
$speeds{'cur-freq'} = speed_cleaner($speeds{'cur-freq'},'khz');
|
|
$speeds{'min-freq'} = (main::reader("$sys/$min"))[0];
|
|
$speeds{'min-freq'} = speed_cleaner($speeds{'min-freq'},'khz');
|
|
$speeds{'max-freq'} = (main::reader("$sys/$max"))[0];
|
|
$speeds{'max-freq'} = speed_cleaner($speeds{'max-freq'},'khz');
|
|
if ($b_arm){
|
|
@arm = main::globber('/sys/devices/system/cpu/cpufreq/policy*/');
|
|
# there are arm chips with two dies, that run at different min max speeds!!
|
|
# see: https://github.com/smxi/inxi/issues/128.
|
|
# it would be slick to show both die min/max/cur speeds, but this is
|
|
# ok for now.
|
|
if (scalar @arm > 1){
|
|
my ($current,$max,$min) = (0,0,0);
|
|
foreach (@arm){
|
|
$_ =~ s/\/$//; # strip off last slash in case globs have them
|
|
my $max_temp = main::reader("$_/cpuinfo_max_freq");
|
|
$max_temp = speed_cleaner($max_temp,'khz');
|
|
if ($max_temp > $max){
|
|
$max = $max_temp;
|
|
}
|
|
my $min_temp = main::reader("$_/cpuinfo_min_freq");
|
|
$min_temp = speed_cleaner($min_temp,'khz');
|
|
if ($min_temp < $min || $min == 0){
|
|
$max = $min_temp;
|
|
}
|
|
my $cur_temp = main::reader("$_/cpuinfo_max_freq");
|
|
$cur_temp = speed_cleaner($cur_temp,'khz');
|
|
if ($cur_temp > $current){
|
|
$current = $cur_temp;
|
|
}
|
|
}
|
|
$speeds{'cur-freq'} = $current if $current;
|
|
$speeds{'max-freq'} = $max if $max;
|
|
$speeds{'min-freq'} = $min if $min;
|
|
}
|
|
}
|
|
# policy4/cpuinfo_max_freq:["2000000"]
|
|
# policy4/cpuinfo_min_freq:["200000"]
|
|
if ($speeds{'min-freq'} > $speeds{'max-freq'} || $speeds{'min-freq'} == $speeds{'max-freq'}){
|
|
$speeds{'min-freq'} = 0;
|
|
}
|
|
}
|
|
main::log_data('dump','%speeds',\%speeds) if $b_log;
|
|
eval $end if $b_log;
|
|
return %speeds;
|
|
}
|
|
|
|
# right now only using this for ARM cpus, this is not the same in intel/amd
|
|
sub cpu_dies_sys {
|
|
eval $start if $b_log;
|
|
my @data = main::globber('/sys/devices/system/cpu/cpu*/topology/core_siblings_list');
|
|
my (@dies);
|
|
foreach (@data){
|
|
my $siblings = (main::reader($_))[0];
|
|
if (! grep {/$siblings/} @dies){
|
|
push @dies, $siblings;
|
|
}
|
|
}
|
|
my $die_count = scalar @dies;
|
|
eval $end if $b_log;
|
|
return $die_count;
|
|
}
|
|
sub cpu_flags_bsd {
|
|
eval $start if $b_log;
|
|
my ($flags,$sep) = ('','');
|
|
# this will be null if it was not readable
|
|
my $file = main::system_files('dmesg-boot');
|
|
if ( $file && ! -r $file ){
|
|
$flags = main::row_defaults('dmesg-boot-permissions');
|
|
}
|
|
else {
|
|
foreach (@dmesg_boot){
|
|
if ( /Features/ || ( $bsd_type eq "openbsd" && /^cpu0:\s*[a-z0-9]{2,3}(\s|,)[a-z0-9]{2,3}(\s|,)/i ) ) {
|
|
my @line = split /:\s*/, lc($_);
|
|
# free bsd has to have weird syntax: <....<b23>,<b34>>
|
|
# Features2=0x1e98220b<SSE3,PCLMULQDQ,MON,SSSE3,CX16,SSE4.1,SSE4.2,POPCNT,AESNI,XSAVE,OSXSAVE,AVX>
|
|
$line[1] =~ s/^[^<]*<|>[^>]*$//g;
|
|
# then get rid of <b23> stuff
|
|
$line[1] =~ s/<[^>]+>//g;
|
|
# and replace commas with spaces
|
|
$line[1] =~ s/,/ /g;
|
|
$flags .= $sep . $line[1];
|
|
$sep = ' ';
|
|
}
|
|
elsif (/real mem/){
|
|
last;
|
|
}
|
|
}
|
|
if ($flags){
|
|
$flags =~ s/\s+/ /g;
|
|
$flags =~ s/^\s+|\s+$//g;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $flags;
|
|
}
|
|
|
|
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
|
|
elsif ($string =~ /centaur/){
|
|
$vendor = "centaur"
|
|
}
|
|
eval $end if $b_log;
|
|
return $vendor;
|
|
}
|
|
|
|
sub cpu_arch {
|
|
eval $start if $b_log;
|
|
my ($type,$family,$model) = @_;
|
|
my $arch = '';
|
|
# https://en.wikipedia.org/wiki/List_of_AMD_CPU_microarchitectures
|
|
# print "$type;$family;$model\n";
|
|
if ( $type eq 'amd'){
|
|
if ($family eq '4'){
|
|
if ( $model =~ /^(3|7|8|9|A)$/ ) {$arch = 'Am486'}
|
|
elsif ( $model =~ /^(E|F)$/ ) {$arch = 'Am5x86'}
|
|
}
|
|
elsif ($family eq '5'){
|
|
if ( $model =~ /^(0|1|2|3)$/ ) {$arch = 'K5'}
|
|
elsif ( $model =~ /^(6|7)$/ ) {$arch = 'K6'}
|
|
elsif ( $model =~ /^(8)$/ ) {$arch = 'K6-2'}
|
|
elsif ( $model =~ /^(9|D)$/ ) {$arch = 'K6-3'}
|
|
elsif ( $model =~ /^(A)$/ ) {$arch = 'Geode'}
|
|
}
|
|
elsif ($family eq '6'){
|
|
if ( $model =~ /^(1|2)$/ ) {$arch = 'K7'}
|
|
elsif ( $model =~ /^(3|4)$/ ) {$arch = 'K7 Thunderbird'}
|
|
elsif ( $model =~ /^(6|7|8|A)$/ ) {$arch = 'K7 Palomino+'}
|
|
else {$arch = 'K7'}
|
|
}
|
|
elsif ($family eq 'F'){
|
|
if ( $model =~ /^(4|5|7|8|B|C|E|F|14|15|17|18|1B|1C|1F)$/ ) {$arch = 'K8'}
|
|
elsif ( $model =~ /^(21|23|24|25|27|28|2C|2F)$/ ) {$arch = 'K8 rev.E'}
|
|
elsif ( $model =~ /^(41|43|48|4B|4C|4F|5D|5F|68|6B|6C|6F|7C|7F|C1)$/ ) {$arch = 'K8 rev.F+'}
|
|
else {$arch = 'K8'}
|
|
}
|
|
elsif ($family eq '10'){
|
|
if ( $model =~ /^(2|4|5|6|8|9|A)$/ ) {$arch = 'K10'}
|
|
else {$arch = 'K10'}
|
|
}
|
|
elsif ($family eq '11'){
|
|
if ( $model =~ /^(3)$/ ) {$arch = 'Turion X2 Ultra'}
|
|
}
|
|
# might also need cache handling like 14/16
|
|
elsif ($family eq '12'){
|
|
if ( $model =~ /^(1)$/ ) {$arch = 'Fusion'}
|
|
else {$arch = 'Fusion'}
|
|
}
|
|
# SOC, apu
|
|
elsif ($family eq '14'){
|
|
if ( $model =~ /^(1|2)$/ ) {$arch = 'Bobcat'}
|
|
else {$arch = 'Bobcat'}
|
|
}
|
|
elsif ($family eq '15'){
|
|
if ( $model =~ /^(0|1|2|3|4|5|6|7|8|9|A|B|C|D|E|F)$/ ) {$arch = 'Bulldozer'}
|
|
elsif ( $model =~ /^(10|11|12|13|14|15|16|17|18|19|1A|1B|1C|1D|1E|1F)$/ ) {$arch = 'Piledriver'}
|
|
elsif ( $model =~ /^(30|31|32|33|34|35|36|37|38|39|3A|3B|3C|3D|3E|3F)$/ ) {$arch = 'Steamroller'}
|
|
elsif ( $model =~ /^(60|61|62|63|64|65|66|67|68|69|6A|6B|6C|6D|6E|6F|70|71|72|73|74|75|76|77|78|79|7A|7B|7C|7D|7E|7F)$/ ) {$arch = 'Excavator'}
|
|
else {$arch = 'Bulldozer'}
|
|
}
|
|
# SOC, apu
|
|
elsif ($family eq '16'){
|
|
if ( $model =~ /^(0|1|2|3|4|5|6|7|8|9|A|B|C|D|E|F)$/ ) {$arch = 'Jaguar'}
|
|
elsif ( $model =~ /^(30|31|32|33|34|35|36|37|38|39|3A|3B|3C|3D|3E|3F)$/ ) {$arch = 'Puma'}
|
|
else {$arch = 'Jaguar'}
|
|
}
|
|
elsif ($family eq '17'){
|
|
if ( $model =~ /^(1)$/ ) {$arch = 'Zen'}
|
|
else {$arch = 'Zen'}
|
|
}
|
|
}
|
|
elsif ( $type eq 'arm'){
|
|
if ($family ne ''){$arch="ARMv$family";}
|
|
else {$arch='ARM';}
|
|
}
|
|
# aka VIA
|
|
elsif ( $type eq 'centaur'){
|
|
if ($family eq '5'){
|
|
if ( $model =~ /^(4)$/ ) {$arch = 'WinChip C6'}
|
|
elsif ( $model =~ /^(8)$/ ) {$arch = 'WinChip 2'}
|
|
elsif ( $model =~ /^(9)$/ ) {$arch = 'WinChip 3'}
|
|
}
|
|
elsif ($family eq '6'){
|
|
if ( $model =~ /^(6)$/ ) {$arch = 'WinChip-based'}
|
|
elsif ( $model =~ /^(7|8)$/ ) {$arch = 'C3'}
|
|
elsif ( $model =~ /^(9)$/ ) {$arch = 'C3-2'}
|
|
elsif ( $model =~ /^(A|D)$/ ) {$arch = 'C7'}
|
|
elsif ( $model =~ /^(F)$/ ) {$arch = 'Isaiah'}
|
|
}
|
|
}
|
|
elsif ( $type eq 'intel'){
|
|
if ($family eq '4'){
|
|
if ( $model =~ /^(0|1|2|3|4|5|6|7|8|9)$/ ) {$arch = '486'}
|
|
}
|
|
elsif ($family eq '5'){
|
|
if ( $model =~ /^(1|2|3|7)$/ ) {$arch = 'P5'}
|
|
elsif ( $model =~ /^(4|8)$/ ) {$arch = 'P5'} # MMX
|
|
elsif ( $model =~ /^(9)$/ ) {$arch = 'Quark'}
|
|
}
|
|
elsif ($family eq '6'){
|
|
if ( $model =~ /^(1)$/ ) {$arch = 'P6 Pro'}
|
|
elsif ( $model =~ /^(3|5|6)$/ ) {$arch = 'P6 II'}
|
|
elsif ( $model =~ /^(7|8)$/ ) {$arch = 'P6 III'}
|
|
elsif ( $model =~ /^(9)$/ ) {$arch = 'Banias'} # pentium M
|
|
elsif ( $model =~ /^(15)$/ ) {$arch = 'Dothan Tolapai'} # pentium M system on chip
|
|
elsif ( $model =~ /^(D)$/ ) {$arch = 'Dothan'} # Pentium M
|
|
elsif ( $model =~ /^(E)$/ ) {$arch = 'Yonah'}
|
|
elsif ( $model =~ /^(F|16)$/ ) {$arch = 'Conroe'}
|
|
elsif ( $model =~ /^(17|1D)$/ ) {$arch = 'Penryn'}
|
|
elsif ( $model =~ /^(1A|1E|1F|2E|25|2C|2F)$/ ) {$arch = 'Nehalem'}
|
|
elsif ( $model =~ /^(1C|26)$/ ) {$arch = 'Bonnell'}
|
|
elsif ( $model =~ /^(27|35|36)$/ ) {$arch = 'Saltwell'}
|
|
elsif ( $model =~ /^(25|2C|2F)$/ ) {$arch = 'Westmere'}
|
|
elsif ( $model =~ /^(26|27)$/ ) {$arch = 'Bonnell'}
|
|
elsif ( $model =~ /^(2A|2D)$/ ) {$arch = 'Sandy Bridge'}
|
|
elsif ( $model =~ /^(37|4A|4D|5A)$/ ) {$arch = 'Silvermont'}
|
|
elsif ( $model =~ /^(3A|3E)$/ ) {$arch = 'Ivy Bridge'}
|
|
elsif ( $model =~ /^(3C|3F|45|46)$/ ) {$arch = 'Haswell'}
|
|
elsif ( $model =~ /^(3D|47|4F|56)$/ ) {$arch = 'Broadwell'}
|
|
elsif ( $model =~ /^(4E|55|9E)$/ ) {$arch = 'Skylake'}
|
|
elsif ( $model =~ /^(5E)$/ ) {$arch = 'Skylake-S'}
|
|
elsif ( $model =~ /^(4C|5D)$/ ) {$arch = 'Airmont'}
|
|
elsif ( $model =~ /^(8E|9E)$/ ) {$arch = 'Kaby Lake'}
|
|
elsif ( $model =~ /^(57)$/ ) {$arch = 'Knights Landing'}
|
|
elsif ( $model =~ /^(85)$/ ) {$arch = 'Knights Mill'}
|
|
# product codes: https://en.wikipedia.org/wiki/List_of_Intel_microprocessors
|
|
# coming: coffee lake; cannonlake; icelake; tigerlake
|
|
}
|
|
elsif ($family eq 'B'){
|
|
if ( $model =~ /^(1)$/ ) {$arch = 'Knights Corne'}
|
|
}
|
|
elsif ($family eq 'F'){
|
|
if ( $model =~ /^(0|1|2)$/ ) {$arch = 'Netburst Willamette'}
|
|
elsif ( $model =~ /^(3|4|6)$/ ) {$arch = 'Netburst Prescott'} # Nocona
|
|
else {$arch = 'Netburst'}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $arch;
|
|
}
|
|
|
|
sub count_alpha {
|
|
my ($count) = @_;
|
|
#print "$count\n";
|
|
my @alpha = qw(Single Dual Triple Quad);
|
|
if ($count > 4){
|
|
$count .= '-';
|
|
}
|
|
else {
|
|
$count = $alpha[$count-1] . ' ' if $count > 0;
|
|
}
|
|
return $count;
|
|
}
|
|
sub set_cpu_data {
|
|
my %cpu = (
|
|
'arch' => '',
|
|
'bogomips' => 0,
|
|
'cores' => 0,
|
|
'cur-freq' => 0,
|
|
'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,
|
|
'min-freq' => 0,
|
|
'model_id' => '',
|
|
'model_name' => '',
|
|
'processors' => [],
|
|
'rev' => '',
|
|
'scalings' => [],
|
|
'siblings' => 0,
|
|
'type' => '',
|
|
);
|
|
return %cpu;
|
|
}
|
|
# MHZ - cell cpus
|
|
sub speed_cleaner {
|
|
my ($speed,$opt) = @_;
|
|
return if ! $speed || $speed eq '0';
|
|
$speed =~ s/[GMK]HZ$//gi;
|
|
$speed = ($speed/1000) if $opt && $opt eq 'khz';
|
|
$speed = sprintf "%.0f", $speed;
|
|
return $speed;
|
|
}
|
|
sub cpu_cleaner {
|
|
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;
|
|
}
|
|
}
|
|
|
|
## DiskData
|
|
{
|
|
package DiskData;
|
|
my ($b_hddtemp,$b_nvme);
|
|
my ($hddtemp,$nvme) = ('','');
|
|
my (@by_id,@by_path);
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (@data,@rows,$key1,$val1);
|
|
my ($type) = @_;
|
|
$type ||= 'standard';
|
|
my $num = 0;
|
|
@data = disk_data($type);
|
|
# NOTE:
|
|
if (@data){
|
|
if ($type eq 'standard'){
|
|
@data = create_output(@data);
|
|
@rows = (@rows,@data);
|
|
if ( $bsd_type && !@dm_boot_disk && $type eq 'standard' && $show{'disk'} ){
|
|
$key1 = 'Drive Report';
|
|
my $file = main::system_files('dmesg-boot');
|
|
if ( $file && ! -r $file ){
|
|
$val1 = main::row_defaults('dmesg-boot-permissions');
|
|
}
|
|
elsif (! -e $file){
|
|
$val1 = main::row_defaults('dmesg-boot-missing');
|
|
}
|
|
else {
|
|
$val1 = main::row_defaults('disk-data-bsd');
|
|
}
|
|
@data = ({main::key($num++,$key1) => $val1,});
|
|
@rows = (@rows,@data);
|
|
}
|
|
}
|
|
else {
|
|
@rows = @data;
|
|
# print Data::Dumper::Dumper \@rows;
|
|
}
|
|
}
|
|
else {
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('disk-data');
|
|
@rows = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
if (!@rows){
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('disk-data');
|
|
@data = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
#@rows = (@rows,@data);
|
|
@data = ();
|
|
if ($show{'optical'} || $show{'optical-basic'}){
|
|
@data = OpticalData::get();
|
|
@rows = (@rows,@data);
|
|
}
|
|
($b_hddtemp,$b_nvme,$hddtemp,$nvme) = (undef,undef,undef,undef);
|
|
(@by_id,@by_path) = (undef,undef);
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub create_output {
|
|
eval $start if $b_log;
|
|
my (@disks) = @_;
|
|
#print Data::Dumper::Dumper \@disks;
|
|
my (@data,@rows);
|
|
my ($num,$j) = (0,0);
|
|
my ($id,$model,$size,$used,$percent,$size_holder,$used_holder) = ('','','','','','','');
|
|
my @sizing = main::get_size($disks[0]{'size'}) if $disks[0]{'size'};
|
|
#print Data::Dumper::Dumper \@disks;
|
|
if (@sizing){
|
|
$size = $sizing[0];
|
|
# note: if a string is returned there will be no Size unit so just use string.
|
|
if (defined $sizing[0] && $sizing[1]){
|
|
$size .= ' ' . $sizing[1];
|
|
}
|
|
}
|
|
$size ||= 'N/A';
|
|
@sizing = main::get_size($disks[0]{'used'}) if $disks[0]{'used'};
|
|
if (@sizing){
|
|
$used = $sizing[0];
|
|
if (defined $sizing[0] && $sizing[1]){
|
|
$used .= ' ' . $sizing[1];
|
|
if (( $disks[0]{'size'} && $disks[0]{'size'} =~ /^[0-9]/ ) &&
|
|
( $disks[0]{'used'} =~ /^[0-9]/ ) ){
|
|
$used = $used . ' (' . sprintf("%0.1f", $disks[0]{'used'}/$disks[0]{'size'}*100) . '%)';
|
|
}
|
|
}
|
|
}
|
|
$used ||= 'N/A';
|
|
@data = ({
|
|
main::key($num++,'HDD Total Size') => $size,
|
|
main::key($num++,'used') => $used,
|
|
});
|
|
@rows = (@rows,@data);
|
|
shift @disks;
|
|
if ( $show{'disk'} && @disks){
|
|
@disks = sort { $a->{'id'} cmp $b->{'id'} } @disks;
|
|
foreach my $ref (@disks){
|
|
($id,$model,$size) = ('','','');
|
|
my %row = %$ref;
|
|
$num = 1;
|
|
$model = ($row{'model'}) ? $row{'model'}: 'N/A';
|
|
$id = ($row{'id'}) ? "/dev/$row{'id'}":'N/A';
|
|
my @sizing = main::get_size($row{'size'});
|
|
#print Data::Dumper::Dumper \@disks;
|
|
if (@sizing){
|
|
$size = $sizing[0];
|
|
# note: if a string is returned there will be no Size unit so just use string.
|
|
if (defined $sizing[0] && $sizing[1]){
|
|
$size .= ' ' . $sizing[1];
|
|
$size_holder = $sizing[0];
|
|
}
|
|
$size ||= 'N/A';
|
|
}
|
|
else {
|
|
$size = 'N/A';
|
|
}
|
|
$j = scalar @rows;
|
|
@data = ({
|
|
main::key($num++,'ID') => $id,
|
|
});
|
|
@rows = (@rows,@data);
|
|
if ($row{'type'}){
|
|
$rows[$j]{main::key($num++,'type')} = $row{'type'},
|
|
}
|
|
if ($row{'vendor'}){
|
|
$rows[$j]{main::key($num++,'vendor')} = $row{'vendor'},
|
|
}
|
|
$rows[$j]{main::key($num++,'model')} = $model;
|
|
$rows[$j]{main::key($num++,'size')} = $size;
|
|
if ($extra > 0 && $row{'speed'}){
|
|
$rows[$j]{main::key($num++,'speed')} = $row{'speed'};
|
|
}
|
|
if ($extra > 1){
|
|
my $serial = main::apply_filter($row{'serial'});
|
|
$rows[$j]{main::key($num++,'serial')} = $serial;
|
|
if ($row{'firmware'}){
|
|
$rows[$j]{main::key($num++,'rev')} = $row{'firmware'};
|
|
}
|
|
}
|
|
if ($extra > 0 && $row{'temp'}){
|
|
$rows[$j]{main::key($num++,'temp')} = $row{'temp'} . ' C';
|
|
}
|
|
# extra level tests already done
|
|
if (defined $row{'partition-table'}){
|
|
$rows[$j]{main::key($num++,'scheme')} = $row{'partition-table'};
|
|
}
|
|
}
|
|
}
|
|
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub disk_data {
|
|
eval $start if $b_log;
|
|
my ($type) = @_;
|
|
my (@rows,@data,@devs);
|
|
my $num = 0;
|
|
my ($used) = (0);
|
|
PartitionData::partition_data() if !$b_partitions;
|
|
foreach my $ref (@partitions){
|
|
my %row = %$ref;
|
|
# don't count remote used, also, some cases mount
|
|
# panfs is parallel NAS volume manager, need more data
|
|
next if ($row{'fs'} && $row{'fs'} =~ /nfs|panfs|sshfs|smbfs|unionfs/);
|
|
# 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 && (my $file = main::system_files('partitions'))){
|
|
@data = proc_data($used,$file);
|
|
}
|
|
elsif ($bsd_type) {
|
|
@data = dmesg_boot_data($used);
|
|
}
|
|
#print Data::Dumper::Dumper \@data;
|
|
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,$file) = @_;
|
|
my (@data,@drives);
|
|
my ($b_hdx,$size,$drive_size) = (0,0,0);
|
|
my @proc_partitions = main::reader($file,'strip');
|
|
shift @proc_partitions;
|
|
foreach (@proc_partitions){
|
|
next if (/^\s*$/);
|
|
my @row = split /\s+/, $_;
|
|
if ( $row[-1] =~ /^([hsv]d[a-z]+|(ada|mmcblk|n[b]?d|nvme[0-9]+n)[0-9]+)$/) {
|
|
$drive_size = $row[2];
|
|
$b_hdx = 1 if $row[-1] =~ /^hd[a-z]/;
|
|
@data = ({
|
|
'firmware' => '',
|
|
'id' => $row[-1],
|
|
'model' => '',
|
|
'serial' => '',
|
|
'size' => $drive_size,
|
|
'spec' => '',
|
|
'speed' => '',
|
|
'temp' => '',
|
|
'type' => '',
|
|
'vendor' => '',
|
|
});
|
|
@drives = (@drives,@data);
|
|
}
|
|
# See http://lanana.org/docs/device-list/devices-2.6+.txt for major numbers used below
|
|
# See https://www.mjmwired.net/kernel/Documentation/devices.txt for kernel 4.x device numbers
|
|
# if ( $row[0] =~ /^(3|22|33|8)$/ && $row[1] % 16 == 0 ) {
|
|
# $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
|
|
if ( $row[0] =~ /^(3|8|22|33|43|179|202|252|253|254|259)$/ &&
|
|
$row[-1] =~ /(mmcblk[0-9]+|n[b]?d[0-9]+|nvme[0-9]+n[0-9]+|[hsv]d[a-z]+)$/ &&
|
|
( $row[1] % 16 == 0 || $row[1] % 16 == 8 ) ) {
|
|
$size += $row[2];
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \@drives;
|
|
main::log_data('data',"size: $size") if $b_log;
|
|
@data = ({
|
|
'size' => $size,
|
|
'used' => $used,
|
|
});
|
|
#print Data::Dumper::Dumper \@data;
|
|
if ( $show{'disk'} ){
|
|
@drives = (@data,@drives);
|
|
# print 'drives:', Data::Dumper::Dumper \@drives;
|
|
@data = proc_data_advanced($b_hdx,@drives);
|
|
}
|
|
main::log_data('dump','@data',\@data) if $b_log;
|
|
# print Data::Dumper::Dumper \@data;
|
|
eval $end if $b_log;
|
|
return @data;
|
|
}
|
|
sub proc_data_advanced {
|
|
eval $start if $b_log;
|
|
my ($b_hdx,@drives) = @_;
|
|
my ($i) = (0);
|
|
my (@data,@disk_data,@rows,@scsi,@temp,@working);
|
|
my ($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 = main::system_files('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) = ('','','','','','','');
|
|
if ($extra > 2){
|
|
@data = partition_scheme($pt_cmd,$drives[$i]{'id'});
|
|
$pt_cmd = $data[0];
|
|
$drives[$i]{'partition-table'} = uc($data[1]) if $data[1];
|
|
}
|
|
#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[^\/]*$//;
|
|
}
|
|
main::log_data('data',"working path: $working_path") if $b_log;
|
|
if ($block_type && @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 $ref (@scsi){
|
|
my %row = %$ref;
|
|
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 ( -e $path){
|
|
$model = (main::reader($path,'strip'))[0];
|
|
if ($model){
|
|
$drives[$i]{'model'} = $model;
|
|
}
|
|
}
|
|
elsif ($block_type eq 'mmc' && -e "${working_path}name"){
|
|
$path = "${working_path}name";
|
|
$model = (main::reader($path,'strip'))[0];
|
|
if ($model){
|
|
$drives[$i]{'model'} = $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::disk_cleaner($drives[$i]{'model'});
|
|
my @device_data = device_vendor($drives[$i]{'model'},'');
|
|
$drives[$i]{'model'} = $device_data[1] if $device_data[1];
|
|
$drives[$i]{'vendor'} = $device_data[0] if $device_data[0];
|
|
}
|
|
if ($working_path){
|
|
$path = "${working_path}removable";
|
|
$drives[$i]{'type'} = 'Removable' if -e $path && (main::reader($path,'strip'))[0]; # 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("/dev/$drives[$i]{'id'}");
|
|
if ($extra > 1){
|
|
if (@disk_data && $disk_data[2]){
|
|
$drives[$i]{'serial'} = $disk_data[2];
|
|
}
|
|
else {
|
|
$path = "${working_path}serial";
|
|
if ( -e $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 ( -e $path){
|
|
$drives[$i]{'firmware'} = (main::reader($path,'strip'))[0];
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \@drives;
|
|
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 dmesg_boot_data {
|
|
eval $start if $b_log;
|
|
my ($used) = @_;
|
|
my (@data,@drives,@temp);
|
|
my ($id_holder,$i,$size,$working) = ('',0,0,0);
|
|
my $file = main::system_files('dmesg-boot');
|
|
if (@dm_boot_disk){
|
|
foreach (@dm_boot_disk){
|
|
my @row = split /:\s*/, $_;
|
|
next if ! defined $row[1];
|
|
if ($id_holder ne $row[0]){
|
|
$i++ if $id_holder;
|
|
# print "$i $id_holder $row[0]\n";
|
|
$id_holder = $row[0];
|
|
}
|
|
# no dots, note: ada2: 2861588MB BUT: ada2: 600.000MB/s
|
|
if (! exists $drives[$i]){
|
|
$drives[$i] = ({});
|
|
$drives[$i]{'id'} = $row[0];
|
|
$drives[$i]{'firmware'} = '';
|
|
$drives[$i]{'temp'} = '';
|
|
$drives[$i]{'type'} = '';
|
|
$drives[$i]{'vendor'} = '';
|
|
}
|
|
#print "$i\n";
|
|
if ($bsd_type eq 'openbsd'){
|
|
if ($row[1] =~ /,\s*([0-9\.]+[MGTPE][B]?),.*\ssectors$|^</){
|
|
$working = main::translate_size($1);
|
|
$size += $working if $working;
|
|
$drives[$i]{'size'} = $working;
|
|
}
|
|
if ($row[2] && $row[2] =~ /<([^>]+)>/){
|
|
$drives[$i]{'model'} = $1 if $1;
|
|
$drives[$i]{'type'} = 'removable' if $_ =~ /removable$/;
|
|
# <Generic-, Compact Flash, 1.00>
|
|
my $count = ($drives[$i]{'model'} =~ tr/,//);
|
|
if ($count && $count > 1){
|
|
@temp = split /,\s*/, $drives[$i]{'model'};
|
|
$drives[$i]{'model'} = $temp[1];
|
|
}
|
|
}
|
|
# print "openbsd\n";
|
|
}
|
|
else {
|
|
if ($row[1] =~ /^([0-9]+[KMGTPE][B]?)\s/){
|
|
$working = main::translate_size($1);
|
|
$size += $working if $working;
|
|
$drives[$i]{'size'} = $working;
|
|
}
|
|
if ($row[1] =~ /device$|^</){
|
|
$row[1] =~ s/\sdevice$//g;
|
|
$row[1] =~ /<([^>]*)>\s(.*)/;
|
|
$drives[$i]{'model'} = $1 if $1;
|
|
$drives[$i]{'spec'} = $2 if $2;
|
|
}
|
|
if ($row[1] =~ /^Serial\sNumber\s(.*)/){
|
|
$drives[$i]{'serial'} = $1;
|
|
}
|
|
if ($row[1] =~ /^([0-9\.]+[MG][B]?\/s)/){
|
|
$drives[$i]{'speed'} = $1;
|
|
$drives[$i]{'speed'} =~ s/\.[0-9]+// if $drives[$i]{'speed'};
|
|
}
|
|
}
|
|
$drives[$i]{'model'} = main::disk_cleaner($drives[$i]{'model'});
|
|
my @device_data = device_vendor($drives[$i]{'model'},'');
|
|
$drives[$i]{'vendor'} = $device_data[0] if $device_data[0];
|
|
$drives[$i]{'model'} = $device_data[1] if $device_data[1];
|
|
}
|
|
if (!$size){
|
|
$size = main::row_defaults('data-bsd');
|
|
}
|
|
}
|
|
elsif ( $file && ! -r $file ){
|
|
$size = main::row_defaults('dmesg-boot-permissions');
|
|
}
|
|
elsif (! -f $file ){
|
|
$size = main::row_defaults('dmesg-boot-missing');
|
|
}
|
|
@data = ({
|
|
'size' => $size,
|
|
'used' => $used,
|
|
});
|
|
#main::log_data('dump','@data',\@data) if $b_log;
|
|
if ( $show{'disk'} ){
|
|
@data = (@data,@drives);
|
|
# print 'drives:', Data::Dumper::Dumper \@drives;
|
|
}
|
|
# print Data::Dumper::Dumper \@data;
|
|
eval $end if $b_log;
|
|
return @data;
|
|
}
|
|
|
|
# check for usb/firewire/[and thunderwire 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 partition_scheme {
|
|
eval $start if $b_log;
|
|
my ($set_cmd,$id) = @_;
|
|
my ($cmd,$pt,$program,@data,@return);
|
|
if ($set_cmd ne 'unset'){
|
|
$return[0] = $set_cmd;
|
|
}
|
|
else {
|
|
# runs as user, but is SLOW: udisksctl info -b /dev/sda
|
|
# line: org.freedesktop.UDisks2.PartitionTable:
|
|
# Type: dos
|
|
if (!$b_root){
|
|
if ($program = main::check_program('udevadm')){
|
|
$return[0] = "$program info -q property -n ";
|
|
}
|
|
}
|
|
if (!$return[0] && $b_root && -e "/lib/udev/udisks-part-id") {
|
|
$return[0] = "/lib/udev/udisks-part-id /dev/";
|
|
}
|
|
elsif (!$return[0] && $b_root && ($program = main::check_program('fdisk'))) {
|
|
$return[0] = "$program -l /dev/";
|
|
}
|
|
if (!$return[0]) {
|
|
$return[0] = 'na'
|
|
}
|
|
}
|
|
if ($return[0] ne 'na'){
|
|
$cmd = "$return[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/){
|
|
$return[1] = 'gpt';
|
|
last;
|
|
}
|
|
elsif (/^Disklabel\stype:\s*(.+)/i){
|
|
$return[1] = $1;
|
|
last;
|
|
}
|
|
}
|
|
$return[1] = 'dos' if !$return[1];
|
|
}
|
|
else {
|
|
$return[1] = main::awk(\@data,'^(UDISKS_PARTITION_TABLE_SCHEME|ID_PART_TABLE_TYPE)',2,'=');
|
|
}
|
|
$return[1] = 'mbr' if $return[1] && $return[1] eq 'dos';
|
|
}
|
|
eval $end if $b_log;
|
|
return @return;
|
|
}
|
|
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){
|
|
my @working = ({
|
|
'vendor' => $vendor,
|
|
'model' => $model,
|
|
'firmware' => $firmware,
|
|
});
|
|
@scsi = (@scsi,@working);
|
|
}
|
|
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 /_/, $_;
|
|
my @device_data = ();
|
|
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::disk_cleaner($model);
|
|
@device_data = device_vendor($model,$serial);
|
|
$vendor = $device_data[0] if $device_data[0];
|
|
$model = $device_data[1] if $device_data[1];
|
|
# print $device, '::', Cwd::abs_path($_),'::', $model, '::', $vendor, '::', $serial, "\n";
|
|
(@disk_data) = ($model,$vendor,$serial);
|
|
last;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @disk_data;
|
|
}
|
|
# receives space separated string that may or may not contain vendor data
|
|
sub device_vendor {
|
|
eval $start if $b_log;
|
|
my ($model,$serial) = @_;
|
|
my ($vendor) = ('');
|
|
my (@data);
|
|
return if !$model;
|
|
# 0 - match pattern; 1 - replace pattern; 2 - vendor print; 3 - serial pattern
|
|
# https://elinux.org/RPi_SD_cards
|
|
# https://sd2snes.de/blog/card-list
|
|
# https://www.superbiiz.com # lists by real part numbers
|
|
my @vendors = (
|
|
# these go first because they are the most likely and common
|
|
['^INTEL','^INTEL','Intel',''],
|
|
# 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]
|
|
['^(SAMSUNG|MCG[0-9]+GC)','^SAMSUNG','Samsung',''], # maybe ^SM
|
|
# NOTE: F[MNETU] not reliable, g.skill starts with FM too:
|
|
['^(STT)','','Super Talent',''], # must be before seagate, _may_ start with F
|
|
['^(ST|[S]?SEAGATE|X[AFP])','^[S]?SEAGATE','Seagate',''], # real, SSEAGATE Backup+; XP1600HE30002
|
|
['^WD','^(WDC|WD\s)','Western Digital',''],
|
|
# then better known ones
|
|
['^(A-DATA|ADATA)','^(A-DATA|ADATA)','A-Data',''],
|
|
['^ADTRON','^(ADTRON)','Adtron',''],
|
|
['^ASUS','^ASUS','ASUS',''],
|
|
['^ATP','^ATP[\s\-]','ATP',''],
|
|
['^Corsair','^Corsair','Corsair',''],
|
|
['(^Crucial|^CT|-CT|^M4-)','^Crucial','Crucial',''],
|
|
['^(FUJITSU|MP)','^FUJITSU','Fujitsu',''],
|
|
# note: 2012: wdc bought hgst
|
|
['^(Hitachi|HGST|IC|HT|HU)','^Hitachi','Hitachi',''], # HGST HUA
|
|
['^(HP[\s\-])','^HP[\s\-]','HP',''], # vb: VB0250EAVER but clases with vbox
|
|
['^(KINGSTON|DataTraveler|SMS|SHS|SUV)','^KINGSTON','Kingston',''], # maybe SHS: SHSS37A SKC SUV
|
|
['^(LSD|Lexar)','^Lexar','Lexar',''], # mmc-LEXAR_0xb016546c
|
|
# OCZSSD2-2VTXE120G is OCZ-VERTEX2_3.5
|
|
['^(OCZ|APOC|D2|DEN|DEN|DRSAK|EC188|FTNC|GFGC|MANG|MMOC|NIMC|NIMR|PSIR|TALOS2|TMSC|TRSAK)','^OCZ[\s\-]','OCZ',''],
|
|
['^OWC','^OWC[\s\-]','OWC',''],
|
|
['^Philips','^Philips','Philips',''],
|
|
['^PIONEER','^PIONEER','Pioneer',''],
|
|
['^PNY','^PNY\s','PNY','','^PNY'],
|
|
['^(SanDisk|SDS[S]?[DQ]|SL([0-9]+)G|AFGCE)','^SanDisk','SanDisk',''],
|
|
# note: get rid of: M[DGK] becasue mushkin starts with MK
|
|
['^([S]?TOS|THN)','^[S]?TOSHIBA','Toshiba',''], # scsi-STOSHIBA_STOR.E_EDITION_
|
|
# these go last because they are short and could lead to false ID or are unlikely
|
|
['^Android','^Android','Android',''],
|
|
# must come before AP|Apacer
|
|
['^APPLE','','^APPLE','Apple'],
|
|
['^(AP|Apacer)','^Apacer','Apacer',''],
|
|
['^BUFFALO','^BUFFALO','Buffalo',''],
|
|
['^EXCELSTOR','^EXCELSTOR( TECHNOLOGY)?','Excelstor',''],
|
|
['^Generic','^Generic','Generic',''],
|
|
['^GOODRAM','^GOODRAM','GOODRAM',''],
|
|
# supertalent also has FM: |FM
|
|
['^(G[\.]?SKILL)','^G[\.]?SKILL','G.SKILL',''],
|
|
['^HUAWEI','^HUAWEI','Huawei',''],
|
|
['^(IBM|DT)','^IBM','IBM',''],
|
|
['^Imation','^Imation(\sImation)?','Imation',''], # Imation_ImationFlashDrive
|
|
['^(InnoDisk|Innolite)','^InnoDisk( Corp.)?','InnoDisk',''],
|
|
['^Innostor','^Innostor','Innostor',''],
|
|
['^Intenso','^Intenso','Intenso',''],
|
|
['^(LITE[\-]?ON[\s\-]?IT)','^LITE[\-]?ON[\s\-]?IT','LITE-ON IT',''], # LITEONIT_LSS-24L6G
|
|
['^(LITE[\-]?ON|PH6)','^LITE[\-]?ON','LITE-ON',''], # PH6-CE240-L
|
|
['^M-Systems','^M-Systems','M-Systems',''],
|
|
['^MAXTOR','^MAXTOR','Maxtor',''],
|
|
['^(MT|M5|Micron)','^Micron','Micron',''],
|
|
['^MARVELL','^MARVELL','Marvell',''],
|
|
['^Medion','^Medion','Medion',''],
|
|
['^Motorola','^Motorola','Motorola',''],
|
|
['^(PS[8F]|Patriot)','^Patriot','Patriot',''],
|
|
['^PIX[\s]?JR','^PIX[\s]?JR','Disney',''],
|
|
['^(PLEXTOR|PX-)','^PLEXTOR','Plextor',''],
|
|
['(^Quantum|Fireball)','^Quantum','Quantum',''],
|
|
['^R3','','AMD Radeon',''], # ssd
|
|
['^RENICE','^RENICE','Renice',''],
|
|
['^RIM[\s]','^RIM','RIM',''],
|
|
['^(SK HYNIX|SKHYNIX|HFS)','^(SK HYNIX|SKHYNIX)','SK Hynix',''], # HFS128G39TND-N210A
|
|
['^(SMART( Storage Systems)?|TX)','^(SMART( Storage Systems)?)','Smart Storage Systems',''],
|
|
['^STEK','^STEK','sTec',''], # wd bought this one
|
|
['^STORFLY','^STORFLY','StorFly',''],
|
|
['^SigmaTel','^SigmaTel','SigmaTel',''],
|
|
['^SPPC','','Silicon Power',''],
|
|
['^SH','','Smart Modular Tech.',''],
|
|
['^(S[FR]-|Sony)','^Sony','Sony',''],
|
|
['^(SF|Swissbit)','^Swissbit','Swissbit',''],
|
|
# ['^(SUPERSPEED)','^SUPERSPEED','SuperSpeed',''], # superspeed is a generic term
|
|
['^TANDBERG','^TANDBERG','Tanberg',''],
|
|
['^TEAC','^TEAC','TEAC',''],
|
|
['^(TS|Transcend|JetFlash)','^Transcend','Transcend',''],
|
|
['^TrekStor','^TrekStor','TrekStor',''],
|
|
['^(UG|Unigen)','^Unigen','Unigen',''],
|
|
['^VBOX','','VirtualBox',''],
|
|
['^Verbatim','^Verbatim','Verbatim',''],
|
|
['^VISIONTEK','^VISIONTEK','VisionTek',''],
|
|
['^VMware','^VMware','VMware',''],
|
|
['^(Vseky|Vaseky)','^Vaseky','Vaseky',''], # ata-Vseky_V880_350G_
|
|
);
|
|
foreach my $ref (@vendors){
|
|
my @row = @$ref;
|
|
if ($model =~ /$row[0]/i || ($row[3] && $serial && $serial =~ /$row[3]/)){
|
|
$vendor = $row[2];
|
|
$model =~ s/$row[1]//i if $row[1] && lc($model) ne lc($row[1]);
|
|
$model =~ s/^[\s\-_]+|[\s\-_]+$//g;
|
|
@data = ($vendor,$model);
|
|
last;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @data;
|
|
}
|
|
# Normally hddtemp requires root, but you can set user rights in /etc/sudoers.
|
|
# args: $1 - /dev/<disk> to be tested for
|
|
sub hdd_temp {
|
|
eval $start if $b_log;
|
|
my ($device) = @_;
|
|
my ($path) = ('');
|
|
my (@data,$hdd_temp);
|
|
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("$sudo$nvme smart-log $device 2>/dev/null");
|
|
foreach (@data){
|
|
my @row = split /\s*:\s*/, $_;
|
|
# 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("$sudo$hddtemp -nq -u C $device 2>/dev/null"))[0];
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $hdd_temp;
|
|
}
|
|
# gptid/c5e940f1-5ce2-11e6-9eeb-d05099ac4dc2 N/A ada0p1
|
|
sub match_glabel {
|
|
eval $start if $b_log;
|
|
my ($gptid) = @_;
|
|
return if !@glabel || ! $gptid;
|
|
#$gptid =~ s/s[0-9]+$//;
|
|
my ($dev_id) = ('');
|
|
foreach (@glabel){
|
|
my @temp = split /\s+/, $_;
|
|
my $gptid_trimmed = $gptid;
|
|
# slice off s[0-9] from end in case they use slice syntax
|
|
$gptid_trimmed =~ s/s[0-9]+$//;
|
|
if (defined $temp[0] && ($temp[0] eq $gptid || $temp[0] eq $gptid_trimmed ) ){
|
|
$dev_id = $temp[2];
|
|
last;
|
|
}
|
|
}
|
|
$dev_id ||= $gptid; # no match? return full string
|
|
eval $end if $b_log;
|
|
return $dev_id;
|
|
}
|
|
sub set_glabel {
|
|
eval $start if $b_log;
|
|
$b_glabel = 1;
|
|
if (my $path = main::check_program('glabel')){
|
|
@glabel = main::grabber("$path status 2>/dev/null");
|
|
}
|
|
main::log_data('dump','@glabel:with Headers',\@glabel) if $b_log;
|
|
# get rid of first header line
|
|
shift @glabel;
|
|
eval $end if $b_log;
|
|
}
|
|
}
|
|
|
|
## GraphicData
|
|
{
|
|
package GraphicData;
|
|
my $driver = ''; # we need this as a fallback in case no xorg.0.log
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (@data,@rows);
|
|
my $num = 0;
|
|
if ($b_arm){
|
|
my $key = 'ARM';
|
|
@data = ({
|
|
main::key($num++,$key) => main::row_defaults('arm-pci',''),
|
|
},);
|
|
@rows = (@rows,@data);
|
|
}
|
|
else {
|
|
@data = card_data();
|
|
@rows = (@rows,@data);
|
|
if (!@rows){
|
|
my $key = 'Message';
|
|
@data = ({
|
|
main::key($num++,$key) => main::row_defaults('pci-card-data',''),
|
|
},);
|
|
@rows = (@rows,@data);
|
|
}
|
|
}
|
|
@data = display_data();
|
|
@rows = (@rows,@data);
|
|
@data = gl_data();
|
|
@rows = (@rows,@data);
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
# 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
|
|
# 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
|
|
sub card_data {
|
|
eval $start if $b_log;
|
|
my (@rows,@data);
|
|
my ($j,$num) = (0,1);
|
|
foreach (@pci){
|
|
$num = 1;
|
|
my @row = @$_;
|
|
#print "$row[0] $row[3]\n";
|
|
if ($row[3] == 0 && ( $row[0] eq 'vga' || $row[0] eq 'display' || $row[0] eq '3d' ) ){
|
|
#print "$row[0] $row[3]\n";
|
|
$j = scalar @rows;
|
|
$driver = $row[9];
|
|
$driver ||= 'N/A';
|
|
my $card = main::trimmer($row[4]);
|
|
$card = ($card) ? main::pci_cleaner($card,'output') : 'N/A';
|
|
#$card ||= 'N/A';
|
|
# have seen absurdly verbose card descriptions, with non related data etc
|
|
if (length($card) > 85 || $size{'max'} < 110){
|
|
$card = main::pci_long_filter($card);
|
|
}
|
|
@data = (
|
|
{
|
|
main::key($num++,'Card') => $card,
|
|
main::key($num++,'driver') => $driver,
|
|
},
|
|
);
|
|
@rows = (@rows,@data);
|
|
if ($row[9] && !$bsd_type){
|
|
my $version = main::get_module_version($row[9]);
|
|
$version ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'v')} = $version;
|
|
}
|
|
if ($extra > 0){
|
|
$rows[$j]{main::key($num++,'bus ID')} = "$row[2].$row[3]";
|
|
}
|
|
if ($extra > 1){
|
|
$rows[$j]{main::key($num++,'chip ID')} = "$row[5]:$row[6]";
|
|
}
|
|
}
|
|
#print "$row[0]\n";
|
|
}
|
|
#my $ref = $pci[-1];
|
|
#print $$ref[0],"\n";
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub display_data(){
|
|
eval $start if $b_log;
|
|
my (%graphics,@row);
|
|
my @xdpyinfo;
|
|
my $num = 0;
|
|
my ($protocol,$server) = ('','');
|
|
# note: these may not always be set, they won't be out of X, for example
|
|
$protocol = $ENV{'XDG_SESSION_TYPE'} if $ENV{'XDG_SESSION_TYPE'};
|
|
$protocol = $ENV{'WAYLAND_DISPLAY'} if (!$protocol && $ENV{'WAYLAND_DISPLAY'});
|
|
# need to confirm that there's a point to this test, I believe no, fails out of x
|
|
# loginctl also results in the session id
|
|
if (!$protocol && $b_display && $b_force_display){
|
|
if (my $program = main::check_program('loginctl')){
|
|
my $id = '';
|
|
# $id = $ENV{'XDG_SESSION_ID'}; # returns tty session in console
|
|
my @data = main::grabber("$program --no-pager --no-legend 2>/dev/null",'','strip');
|
|
foreach (@data){
|
|
next if /tty[0-6]$/;
|
|
$id = (split /\s+/, $_)[0];
|
|
last; # multiuser? too bad, we'll go for the first one
|
|
}
|
|
if ($id ){
|
|
my $temp = (main::grabber("$program show-session $id -p Type --no-pager --no-legend 2>/dev/null"))[0];
|
|
$temp =~ s/Type=// if $temp;
|
|
# ssh will not show /dev/ttyx so would have passed the first test
|
|
$protocol = $temp if $temp && $temp ne 'tty';
|
|
}
|
|
}
|
|
}
|
|
if ($extra > 1){
|
|
# initial tests, if wayland, it is certainly a compositor
|
|
$protocol = lc($protocol) if $protocol;
|
|
$graphics{'compositor'} = display_compositor($protocol);
|
|
}
|
|
if ( $b_display){
|
|
# X vendor and version detection.
|
|
# new method added since radeon and X.org and the disappearance of
|
|
# <X server name> version : ...etc. Later on, the normal textual version string
|
|
# returned, e.g. like: X.Org version: 6.8.2
|
|
# A failover mechanism is in place: if $version empty, release number parsed instead
|
|
if (my $program = main::check_program('xdpyinfo')){
|
|
my @xdpyinfo = main::grabber("$program $display_opt 2>/dev/null","\n",'strip');
|
|
#@xdpyinfo = map {s/^\s+//;$_} @xdpyinfo if @xdpyinfo;
|
|
#print join "\n",@xdpyinfo, "\n";
|
|
foreach (@xdpyinfo){
|
|
my @working = split /:\s+/, $_;
|
|
next if ( ($graphics{'dimensions'} && $working[0] ne 'dimensions' ) || !$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{'vendor'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'version number'){
|
|
$graphics{'version-id'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'vendor release number'){
|
|
$graphics{'vendor-release'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'X.Org version'){
|
|
$graphics{'xorg-version'} = $working[1];
|
|
}
|
|
elsif ($working[0] eq 'dimensions'){
|
|
$working[1] =~ s/\spixels//;
|
|
$working[1] =~ s/\smillimeters/ mm/;
|
|
if ($graphics{'dimensions'}){
|
|
$graphics{'dimensions'} = ([@{$graphics{'dimensions'}},$working[1]]);
|
|
}
|
|
else {
|
|
$graphics{'dimensions'} = ([$working[1]]);
|
|
}
|
|
}
|
|
}
|
|
#$graphics{'dimensions'} = (\@dimensions);
|
|
# we get a bit more info from xrandr than xdpyinfo, but xrandr fails to handle
|
|
# multiple screens from different video cards
|
|
my $ref = $graphics{'dimensions'};
|
|
if (defined $ref){
|
|
my @screens = @$ref;
|
|
if (scalar @screens == 1){
|
|
if (my $program = main::check_program('xrandr')){
|
|
my @xrandr = main::grabber("$program $display_opt 2>/dev/null",'','strip');
|
|
foreach (@xrandr){
|
|
my @working = split /\s+/,$_;
|
|
# print join "$_\n";
|
|
if ($working[1] =~ /\*/){
|
|
$working[1] =~ s/\*|\+//g;
|
|
$working[1] = sprintf("%.0f",$working[1]);
|
|
$working[1] = ($working[1]) ? "$working[1]Hz" : 'N/A';
|
|
my $screen = "$working[0]~$working[1]";
|
|
if ($graphics{'screens'}){
|
|
$graphics{'screens'} = ([@{$graphics{'screens'}},$screen]);
|
|
}
|
|
else {
|
|
$graphics{'screens'} = ([$screen]);
|
|
}
|
|
}
|
|
}
|
|
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$graphics{'tty'} = tty_data();
|
|
}
|
|
}
|
|
else {
|
|
$graphics{'screens'} = ([main::row_defaults('xdpyinfo-missing')]);
|
|
}
|
|
}
|
|
else {
|
|
$graphics{'tty'} = tty_data();
|
|
}
|
|
# this gives better output than the failure last case, which would only show:
|
|
# for example: X.org: 1.9 instead of: X.org: 1.9.0
|
|
$graphics{'version'} = $graphics{'xorg-version'} if $graphics{'xorg-version'};;
|
|
$graphics{'version'} = x_version() if !$graphics{'version'};
|
|
$graphics{'version'} = $graphics{'version-id'} if !$graphics{'version'};
|
|
|
|
undef @xdpyinfo;
|
|
#print Data::Dumper::Dumper \%graphics;
|
|
if (%graphics){
|
|
my $resolution = '';
|
|
my $server_string = '';
|
|
if ($graphics{'vendor'}){
|
|
my $version = ($graphics{'version'}) ? " $graphics{'version'}" : '';
|
|
$server_string = "$graphics{'vendor'}$version";
|
|
}
|
|
elsif ($graphics{'version'}) {
|
|
$server_string = "X.org $graphics{'version'}";
|
|
}
|
|
if ($graphics{'screens'}){
|
|
my $ref = $graphics{'screens'};
|
|
my @screens = @$ref;
|
|
my $sep = '';
|
|
foreach (@screens){
|
|
$resolution .= $sep . $_;
|
|
$sep = ', ';
|
|
}
|
|
}
|
|
my @drivers = x_drivers();
|
|
if (!$protocol && !$server_string && !$graphics{'vendor'} && !@drivers){
|
|
$server_string = main::row_defaults('display-server');
|
|
@row = ({
|
|
main::key($num++,'Display') => '',
|
|
main::key($num++,'server') => $server_string,
|
|
});
|
|
}
|
|
else {
|
|
$server_string ||= 'N/A';
|
|
# note: if no xorg log, and if wayland, there will be no xorg drivers,
|
|
# obviously, so we use the last driver found on the card section in that case.
|
|
# those come from lscpi kernel drivers so there should be no xorg/wayland issues.
|
|
$driver = ($drivers[0]) ? $drivers[0]: $driver;
|
|
@row = ({
|
|
main::key($num++,'Display') => $protocol,
|
|
main::key($num++,'server') => $server_string,
|
|
main::key($num++,'driver') => $driver,
|
|
});
|
|
if ($drivers[2]){
|
|
$row[0]{main::key($num++,'FAILED')} = $drivers[2];
|
|
}
|
|
if ($drivers[1]){
|
|
$row[0]{main::key($num++,'unloaded')} = $drivers[1];
|
|
}
|
|
if ($graphics{'compositor'}){
|
|
$row[0]{main::key($num++,'compositor')} = $graphics{'compositor'};
|
|
}
|
|
}
|
|
if ($resolution){
|
|
$row[0]{main::key($num++,'resolution')} = $resolution;
|
|
}
|
|
else {
|
|
$graphics{'tty'} ||= 'N/A';
|
|
$row[0]{main::key($num++,'tty')} = $graphics{'tty'};
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @row;
|
|
}
|
|
sub gl_data(){
|
|
eval $start if $b_log;
|
|
my $num = 0;
|
|
my (@row,$arg);
|
|
#print ("$b_display : $b_root\n");
|
|
if ( $b_display){
|
|
if (my $program = main::check_program('glxinfo')){
|
|
# NOTE: glxinfo -B is not always available, unforunately
|
|
my @glxinfo = main::grabber("$program $display_opt 2>/dev/null");
|
|
if (!@glxinfo){
|
|
my $type = 'display-console';
|
|
if ($b_root){
|
|
$type = 'display-root-x';
|
|
}
|
|
else {
|
|
$type = 'display-null';
|
|
}
|
|
@row = ({
|
|
main::key($num++,'Message') => main::row_defaults($type),
|
|
});
|
|
return @row;
|
|
}
|
|
#print join "\n",@glxinfo,"\n";
|
|
my $compat_version = '';
|
|
my ($b_compat,@core_profile_version,@direct_render,@renderer,@opengl_version,@working);
|
|
foreach (@glxinfo){
|
|
next if /^\s/;
|
|
if (/^opengl renderer/i){
|
|
@working = split /:\s*/, $_;
|
|
$working[1] = main::cleaner($working[1]);
|
|
# Allow all mesas
|
|
#if ($working[1] =~ /mesa/i){
|
|
#
|
|
#}
|
|
push @renderer, $working[1];
|
|
}
|
|
# dropping all conditions from this test to just show full mesa information
|
|
# there is a user case where not f and mesa apply, atom mobo
|
|
# /opengl version/ && ( f || $2 !~ /mesa/ ) {
|
|
elsif (/^opengl version/i){
|
|
# fglrx started appearing with this extra string, does not appear
|
|
# to communicate anything of value
|
|
@working = split /:\s*/, $_;
|
|
$working[1] =~ s/(Compatibility Profile Context|\(Compatibility Profile\))//;
|
|
$working[1] =~ s/\s\s/ /g;
|
|
$working[1] =~ s/^\s+|\s+$//;
|
|
push @opengl_version, $working[1];
|
|
# note: this is going to be off if ever multi opengl versions appear, never seen one
|
|
@working = split /\s+/, $working[1];
|
|
$compat_version = $working[0];
|
|
}
|
|
elsif (/^opengl core profile version/i){
|
|
# fglrx started appearing with this extra string, does not appear
|
|
# to communicate anything of value
|
|
@working = split /:\s*/, $_;
|
|
$working[1] =~ s/(Compatibility Profile Context|\((Compatibility|Core) Profile\))//;
|
|
$working[1] =~ s/\s\s/ /g;
|
|
$working[1] =~ s/^\s+|\s+$//;
|
|
push @core_profile_version, $working[1];
|
|
}
|
|
elsif (/direct rendering/){
|
|
@working = split /:\s*/, $_;
|
|
push @direct_render, $working[1];
|
|
}
|
|
# if -B was always available, we could skip this, but it is not
|
|
elsif (/GLX Visuals/){
|
|
last;
|
|
}
|
|
}
|
|
my ($direct_render,$renderer,$version) = ('N/A','N/A','N/A');
|
|
$direct_render = join ', ', @direct_render if @direct_render;
|
|
# non free drivers once filtered and cleaned show the same for core and compat
|
|
# but this stopped for some reason at 4.5/4.6 nvidia
|
|
if (@core_profile_version && @opengl_version &&
|
|
join ('', @core_profile_version) ne join( '', @opengl_version) &&
|
|
!(grep {/nvidia/i} @opengl_version ) ){
|
|
@opengl_version = @core_profile_version;
|
|
$b_compat = 1;
|
|
}
|
|
$version = join ', ', @opengl_version if @opengl_version;
|
|
$renderer = join ', ', @renderer if @renderer;
|
|
@row = ({
|
|
main::key($num++,'OpenGL') => '',
|
|
main::key($num++,'renderer') => $renderer,
|
|
main::key($num++,'v') => $version,
|
|
});
|
|
|
|
if ($b_compat && $extra > 1 && $compat_version){
|
|
$row[0]{main::key($num++,'compat-v')} = $compat_version;
|
|
}
|
|
if ($extra > 0){
|
|
$row[0]{main::key($num++,'direct render')} = $direct_render;
|
|
}
|
|
}
|
|
else {
|
|
@row = ({
|
|
main::key($num++,'Message') => main::row_defaults('glxinfo-missing'),
|
|
});
|
|
}
|
|
}
|
|
else {
|
|
my $type = 'display-console';
|
|
if (!main::check_program('glxinfo')){
|
|
$type = 'glxinfo-missing';
|
|
}
|
|
else {
|
|
if ($b_root){
|
|
$type = 'display-root';
|
|
}
|
|
else {
|
|
$type = 'display-try';
|
|
}
|
|
}
|
|
@row = ({
|
|
main::key($num++,'Message') => main::row_defaults($type),
|
|
});
|
|
}
|
|
eval $end if $b_log;
|
|
return @row;
|
|
}
|
|
sub tty_data(){
|
|
eval $start if $b_log;
|
|
my ($tty);
|
|
if ($size{'term-cols'}){
|
|
$tty = "$size{'term-cols'}x$size{'term-lines'}";
|
|
}
|
|
elsif ($b_irc && $client{'console-irc'}){
|
|
my $tty_working = main::get_tty_console_irc();
|
|
if (my $program = main::check_program('stty')){
|
|
my $tty_arg = ($bsd_type) ? '-f' : '-F';
|
|
$tty = (main::grabber("$program $tty_arg /dev/pts/$tty_working size 2>/dev/null"))[0];
|
|
if ($tty){
|
|
my @temp = split /\s+/, $tty;
|
|
$tty = "$temp[1]x$temp[0]";
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $tty;
|
|
}
|
|
sub x_drivers {
|
|
eval $start if $b_log;
|
|
my ($driver,@driver_data,,%drivers);
|
|
my ($failed,$loaded,$sep,$unloaded) = ('','','','');
|
|
if (my $log = main::system_files('xorg-log')){
|
|
my @xorg = main::reader($log);
|
|
# list is from sgfxi plus non-free drivers
|
|
my $list = 'amdgpu|apm|ark|ati|chips|cirrus|cyrix|fbdev|fglrx|glint|';
|
|
$list .= 'i128|i740|i810|iftv|imstt|intel|ivtv|mach64|mesa|mga|modesetting|';
|
|
$list .= 'neomagic|newport|nouveau|nsc|nvidia|nv|openchrome|radeonhd|radeon|';
|
|
$list .= 'rendition|s3virge|s3|savage|siliconmotion|sisimedia|sisusb|sis|tdfx|';
|
|
$list .= 'tga|trident|tseng|unichrome|v4l|vboxvideo|vesa|vga|via|vmware|voodoo';
|
|
# it's much cheaper to grab the simple pattern match then do the expensive one
|
|
# in the main loop.
|
|
#@xorg = grep {/Failed|Unload|Loading/} @xorg;
|
|
foreach (@xorg){
|
|
next if !/Failed|Unload|Loading/;
|
|
# note that in file names, driver is always lower case
|
|
if (/\sLoading.*($list)_drv.so$/i ) {
|
|
$driver=lc($1);
|
|
# we get all the actually loaded drivers first, we will use this to compare the
|
|
# failed/unloaded, which have not always actually been truly loaded
|
|
$drivers{$driver}="loaded";
|
|
}
|
|
# openbsd uses UnloadModule:
|
|
elsif (/(Unloading\s|UnloadModule).*($list)(_drv.so)?$/i ) {
|
|
$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
|
|
$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
|
|
elsif (/Failed.*($list)\"?(_drv.so)?$/i ) {
|
|
$driver=lc($1);
|
|
# we need to make sure that the driver has already been truly loaded, not just
|
|
# discussed, also set driver to lower case because sometimes it will show as
|
|
# RADEON or NVIDIA in the actual x start
|
|
if (exists $drivers{$driver}){
|
|
$drivers{$driver}="failed";
|
|
}
|
|
}
|
|
}
|
|
my $sep = '';
|
|
foreach (sort keys %drivers){
|
|
if ($drivers{$_} eq 'loaded') {
|
|
$sep = ($loaded) ? ',' : '';
|
|
$loaded .= $sep . $_;
|
|
}
|
|
elsif ($drivers{$_} eq 'unloaded') {
|
|
$sep = ($unloaded) ? ',' : '';
|
|
$unloaded .= $sep . $_;
|
|
}
|
|
elsif ($drivers{$_} eq 'failed') {
|
|
$sep = ($failed) ? ',' : '';
|
|
$failed .= $sep . $_;
|
|
}
|
|
}
|
|
$loaded ||= 'none';
|
|
@driver_data = ($loaded,$unloaded,$failed);
|
|
}
|
|
eval $end if $b_log;
|
|
return @driver_data;
|
|
}
|
|
sub x_version {
|
|
eval $start if $b_log;
|
|
my ($version,@data,$program);
|
|
# IMPORTANT: both commands send version data to stderr!
|
|
if ($program = main::check_program('Xorg')){
|
|
@data = main::grabber("$program -version 2>&1");
|
|
}
|
|
elsif ($program = main::check_program('X')){
|
|
@data = main::grabber("$program -version 2>&1");
|
|
}
|
|
#print Data::Dumper::Dumper \@data;
|
|
if (@data){
|
|
foreach (@data){
|
|
if (/^X.org X server/i){
|
|
my @working = split /\s+/, $_;
|
|
$version = $working[3];
|
|
last;
|
|
}
|
|
elsif (/^X Window System Version/i) {
|
|
my @working = split /\s+/, $_;
|
|
$version = $working[4];
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $version;
|
|
}
|
|
# $1 - protocol: wayland|x11
|
|
sub display_compositor {
|
|
eval $start if $b_log;
|
|
my ($protocol) = @_;
|
|
my ($compositor) = ('');
|
|
# NOTE: chains of greps of ps data are VERY expensive, so check for program presence
|
|
if (main::check_program('mutter') && (grep {/mutter/} @ps_cmd ) ) {
|
|
$compositor = 'mutter';
|
|
}
|
|
elsif (main::check_program('kwin') && (grep {/\bkwin\b/} @ps_cmd ) ) {
|
|
$compositor = 'kwin';
|
|
}
|
|
elsif (main::check_program('muffin') && (grep {/muffin/} @ps_cmd ) ) {
|
|
$compositor = 'muffin';
|
|
}
|
|
# Note: other strings have gnome-shell in them, so important to get exact one. Since we
|
|
# can't fully trust how this will appear, the pattern should tighten it
|
|
elsif (main::check_program('gnome-shell') && (grep {/^(\/[\S]+\/)?gnome-shell(\s|$)/} @ps_cmd ) ) {
|
|
$compositor = 'gnome-shell';
|
|
}
|
|
elsif (main::check_program('weston') && (grep {/weston/} @ps_cmd ) ) {
|
|
$compositor = 'weston';
|
|
}
|
|
elsif (main::check_program('compton') && (grep {/compton/} @ps_cmd ) ) {
|
|
$compositor = 'compton';
|
|
}
|
|
# owned by: compiz-core in debian
|
|
elsif (main::check_program('compiz') && (grep {/compiz/} @ps_cmd ) ) {
|
|
$compositor = 'compiz';
|
|
}
|
|
# did not find in debian apt
|
|
elsif (main::check_program('moblin') && (grep {/moblin/} @ps_cmd ) ) {
|
|
$compositor = 'moblin';
|
|
}
|
|
# did not find in debian apt
|
|
elsif (main::check_program('kmscon') && (grep {/kmscon/} @ps_cmd ) ) {
|
|
$compositor = 'kmscon';
|
|
}
|
|
# did not find in debian apt
|
|
elsif (main::check_program('sway') && (grep {/\bsway\b/} @ps_cmd ) ) {
|
|
$compositor = 'sway';
|
|
}
|
|
# did not find in debian apt
|
|
elsif (main::check_program('grefson') && (grep {/grefson/} @ps_cmd ) ) {
|
|
$compositor = 'grefson';
|
|
}
|
|
# did not find in debian apt
|
|
elsif (main::check_program('westford') && (grep {/westford/} @ps_cmd ) ) {
|
|
$compositor = 'westford';
|
|
}
|
|
# did not find in debian apt
|
|
elsif (main::check_program('rustland') && (grep {/rustland/} @ps_cmd ) ) {
|
|
$compositor = 'rustland';
|
|
}
|
|
# did not find in debian apt
|
|
elsif (main::check_program('ireplace') && (grep {/fireplace/} @ps_cmd ) ) {
|
|
$compositor = 'fireplace';
|
|
}
|
|
# did not find in debian apt
|
|
elsif (main::check_program('wayhouse') && (grep {/wayhouse/} @ps_cmd ) ) {
|
|
$compositor = 'wayhouse';
|
|
}
|
|
# did not find in debian apt
|
|
elsif (main::check_program('swc') && (grep {/\bswc\b/} @ps_cmd ) ) {
|
|
$compositor = 'swc';
|
|
}
|
|
# did not find in debian apt
|
|
elsif (main::check_program('dwc') && (grep {/\bdwc\b/} @ps_cmd ) ) {
|
|
$compositor = 'dwc';
|
|
}
|
|
main::log_data('data',"compositor: $compositor") if $b_log;
|
|
eval $end if $b_log;
|
|
return $compositor;
|
|
}
|
|
}
|
|
|
|
## MachineData
|
|
{
|
|
package MachineData;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (%arm_machine,@data,@rows,$key1,$val1,$which);
|
|
my $num = 0;
|
|
if ($bsd_type || $b_dmidecode_force){
|
|
my $ref = $alerts{'dmidecode'};
|
|
if ( $$ref{'action'} ne 'use'){
|
|
$key1 = $$ref{'action'};
|
|
$val1 = $$ref{$key1};
|
|
$key1 = ucfirst($key1);
|
|
}
|
|
else {
|
|
@data = machine_data_dmi();
|
|
if (!@data && !$key1){
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('machine-data','');
|
|
}
|
|
}
|
|
}
|
|
elsif (-d '/sys/class/dmi/id/') {
|
|
@data = machine_data_sys();
|
|
if (!@data){
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('machine-data-dmidecode','');
|
|
}
|
|
}
|
|
elsif (!$bsd_type) {
|
|
# this uses /proc/cpuinfo so only GNU/Linux
|
|
if ($b_arm){
|
|
%arm_machine = machine_data_arm();
|
|
if (%arm_machine){
|
|
@data = create_output_arm(%arm_machine);
|
|
}
|
|
}
|
|
if (!@data){
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('machine-data-alt-33','');
|
|
}
|
|
}
|
|
# if error case, null data, whatever
|
|
if ($key1) {
|
|
@data = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
eval $end if $b_log;
|
|
return @data;
|
|
}
|
|
## 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 create_output {
|
|
eval $start if $b_log;
|
|
my ($ref) = @_;
|
|
my (%data,@row,@rows);
|
|
%data = %$ref;
|
|
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;
|
|
}
|
|
# 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{'sys_vendor'} eq $data{'board_vendor'} ) &&
|
|
( ($data{'product_version'} && $data{'product_version'} eq $data{'board_version'} ) ||
|
|
(!$data{'product_version'} && $data{'product_name'} eq $data{'board_name'} ) ) ){
|
|
$b_skip_system = 1;
|
|
}
|
|
}
|
|
$data{'device'} ||= 'N/A';
|
|
$j = scalar @rows;
|
|
@row = ({
|
|
main::key($num++,'Type') => ucfirst($data{'device'}),
|
|
},);
|
|
@rows = (@rows,@row);
|
|
if (!$b_skip_system){
|
|
# this has already been tested for above so we know it's not null
|
|
$system_vendor = main::cleaner($data{'sys_vendor'});
|
|
$product_name = ($data{'product_name'}) ? $data{'product_name'}:'N/A';
|
|
$product_version = ($data{'product_version'}) ? $data{'product_version'}:'N/A';
|
|
$product_serial = main::apply_filter($data{'product_serial'});
|
|
$rows[$j]{main::key($num++,'System')} = $system_vendor;
|
|
$rows[$j]{main::key($num++,'product')} = $product_name;
|
|
$rows[$j]{main::key($num++,'v')} = $product_version;
|
|
$rows[$j]{main::key($num++,'serial')} = $product_serial;
|
|
# no point in showing chassis if system isn't there, it's very unlikely that
|
|
# would be correct
|
|
if ($extra > 1){
|
|
if ($data{'board_version'} && $data{'chassis_version'} eq $data{'board_version'}){
|
|
$b_skip_chassis = 1;
|
|
}
|
|
if (!$b_skip_chassis && $data{'chassis_vendor'} ){
|
|
if ($data{'chassis_vendor'} ne $data{'sys_vendor'} ){
|
|
$chassis_vendor = $data{'chassis_vendor'};
|
|
}
|
|
if ($data{'chassis_type'} ){
|
|
$chassis_type = $data{'chassis_type'};
|
|
}
|
|
if ($data{'chassis_version'}){
|
|
$chassis_version = $data{'chassis_version'}
|
|
}
|
|
$chassis_serial = main::apply_filter($data{'chassis_serial'});
|
|
$chassis_vendor ||= '';
|
|
$chassis_type ||= '';
|
|
$rows[$j]{main::key($num++,'Chassis')} = $chassis_vendor;
|
|
if ($chassis_type){
|
|
$rows[$j]{main::key($num++,'type')} = $chassis_type;
|
|
}
|
|
if ($chassis_version){
|
|
$rows[$j]{main::key($num++,'v')} = $chassis_version;
|
|
}
|
|
$rows[$j]{main::key($num++,'serial')} = $chassis_serial;
|
|
}
|
|
}
|
|
$j++; # start new row
|
|
}
|
|
if ($data{'firmware'}){
|
|
$firmware = $data{'firmware'};
|
|
}
|
|
$mobo_vendor = ($data{'board_vendor'}) ? main::cleaner($data{'board_vendor'}) : 'N/A';
|
|
$mobo_model = ($data{'board_name'}) ? $data{'board_name'}: 'N/A';
|
|
$mobo_version = ($data{'board_version'})? $data{'board_version'} : '';
|
|
$mobo_serial = main::apply_filter($data{'board_serial'});
|
|
$bios_vendor = ($data{'bios_vendor'}) ? main::cleaner($data{'bios_vendor'}) : 'N/A';
|
|
if ($data{'bios_version'}){
|
|
$bios_version = $data{'bios_version'};
|
|
if ($data{'bios_rev'}){
|
|
$bios_rev = $data{'bios_rev'};
|
|
}
|
|
$bios_version ||= 'N/A';
|
|
}
|
|
if ($data{'bios_date'}){
|
|
$bios_date = $data{'bios_date'};
|
|
}
|
|
if ($extra > 1 && $data{'bios_romsize'}){
|
|
$bios_romsize = $data{'bios_romsize'};
|
|
}
|
|
$rows[$j]{main::key($num++,'Mobo')} = $mobo_vendor;
|
|
$rows[$j]{main::key($num++,'model')} = $mobo_model;
|
|
if ($mobo_version){
|
|
$rows[$j]{main::key($num++,'v')} = $mobo_version;
|
|
}
|
|
$rows[$j]{main::key($num++,'serial')} = $mobo_serial;
|
|
$rows[$j]{main::key($num++,$firmware)} = $bios_vendor;
|
|
$rows[$j]{main::key($num++,'v')} = $bios_version;
|
|
if ($bios_rev){
|
|
$rows[$j]{main::key($num++,'rev')} = $bios_rev;
|
|
}
|
|
$rows[$j]{main::key($num++,'date')} = $bios_date;
|
|
if ($bios_romsize){
|
|
$rows[$j]{main::key($num++,'rom size')} = $bios_romsize;
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub create_output_arm {
|
|
my (%data,@row,@rows);
|
|
my (%arm_machine) = @_;
|
|
my $num = 0;
|
|
my $j = 0;
|
|
#print Data::Dumper::Dumper \%arm_machine;
|
|
if ($arm_machine{'device'}){
|
|
my $device = main::cleaner( $arm_machine{'device'} );
|
|
$device ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'Type')} = 'ARM Device';
|
|
$rows[$j]{main::key($num++,'System')} = $device;
|
|
}
|
|
# we're going to print N/A for 0000 values sine the item was there.
|
|
if ($arm_machine{'firmware'}){
|
|
# most samples I've seen are like: 0000
|
|
$arm_machine{'firmware'} =~ s/^[0]+$//;
|
|
$arm_machine{'firmware'} ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'rev')} = $arm_machine{'firmware'};
|
|
}
|
|
# sometimes has value like: 0000
|
|
if (defined $arm_machine{'serial'}){
|
|
# most samples I've seen are like: 0000
|
|
$arm_machine{'serial'} =~ s/^[0]+$//;
|
|
$rows[$j]{main::key($num++,'serial')} = main::apply_filter($arm_machine{'serial'});
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
|
|
sub machine_data_sys {
|
|
eval $start if $b_log;
|
|
my (%data,$path,$vm);
|
|
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::dmi_cleaner($data{$_}) : '';
|
|
}
|
|
else {
|
|
$data{$_} = '';
|
|
}
|
|
}
|
|
if ($data{'chassis_type'}){
|
|
if ( $data{'chassis_type'} == 1){
|
|
$data{'device'} = get_device_vm($data{'sys_vendor'},$data{'product_name'});
|
|
$data{'device'} ||= 'other-vm?';
|
|
}
|
|
else {
|
|
$data{'device'} = get_device_sys($data{'chassis_type'});
|
|
}
|
|
}
|
|
# print "sys:\n";
|
|
# foreach (keys %data){
|
|
# print "$_: $data{$_}\n";
|
|
# }
|
|
main::log_data('dump','%data',\%data) if $b_log;
|
|
my @rows = create_output(\%data);
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
# 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_arm {
|
|
eval $end if $b_log;
|
|
my (%arm_machine,@temp);
|
|
if (my $file = main::system_files('cpuinfo')){
|
|
#$file = "$ENV{'HOME'}/bin/scripts/inxi/data/cpu/arm/arm-shevaplug-1.2ghz.txt";
|
|
my @data = main::reader($file);
|
|
foreach (@data){
|
|
if (/^Hardware/i){
|
|
@temp = split /\s*:\s*/, $_;
|
|
$arm_machine{'device'} = $temp[1];
|
|
}
|
|
elsif (/^Revision/i){
|
|
@temp = split /\s*:\s*/, $_;
|
|
$arm_machine{'firmware'} = $temp[1];
|
|
}
|
|
elsif (/^Serial/i){
|
|
@temp = split /\s*:\s*/, $_;
|
|
$arm_machine{'serial'} = $temp[1];
|
|
}
|
|
}
|
|
}
|
|
#print Data::Dumper::Dumper \%arm_machine;
|
|
eval $end if $b_log;
|
|
return %arm_machine;
|
|
}
|
|
|
|
# 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 only
|
|
# sys_vendor:
|
|
sub machine_data_dmi {
|
|
eval $start if $b_log;
|
|
my (%data,$vm);
|
|
return if ! @dmi;
|
|
$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 (@dmi){
|
|
my @ref = @$_;
|
|
# bios/firmware
|
|
if ($ref[0] == 0){
|
|
# skip first three row, we don't need that data
|
|
splice @ref, 0, 3 if @ref;
|
|
foreach my $item (@ref){
|
|
if ($item !~ /^~/){ # skip the indented rows
|
|
my @value = split /:\s+/, $item;
|
|
if ($value[0] eq 'Release Date') {$data{'bios_date'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'Vendor') {$data{'bios_vendor'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'Version') {$data{'bios_version'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'ROM Size') {$data{'bios_romsize'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'BIOS Revision') {$data{'bios_rev'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] =~ /^UEFI is supported/) {$data{'firmware'} = 'UEFI';}
|
|
}
|
|
}
|
|
next;
|
|
}
|
|
# system information
|
|
elsif ($ref[0] == 1){
|
|
# skip first three row, we don't need that data
|
|
splice @ref, 0, 3 if @ref;
|
|
foreach my $item (@ref){
|
|
if ($item !~ /^~/){ # skip the indented rows
|
|
my @value = split /:\s+/, $item;
|
|
if ($value[0] eq 'Product Name') {$data{'product_name'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'Version') {$data{'product_version'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'Serial Number') {$data{'product_serial'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'Manufacturer') {$data{'sys_vendor'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'UUID') {$data{'sys_uuid'} = main::dmi_cleaner($value[1]) }
|
|
}
|
|
}
|
|
next;
|
|
}
|
|
# baseboard information
|
|
elsif ($ref[0] == 2){
|
|
# skip first three row, we don't need that data
|
|
splice @ref, 0, 3 if @ref;
|
|
foreach my $item (@ref){
|
|
if ($item !~ /^~/){ # skip the indented rows
|
|
my @value = split /:\s+/, $item;
|
|
if ($value[0] eq 'Product Name') {$data{'board_name'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'Serial Number') {$data{'board_serial'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'Manufacturer') {$data{'board_vendor'} = main::dmi_cleaner($value[1]) }
|
|
}
|
|
}
|
|
next;
|
|
}
|
|
# chassis information
|
|
elsif ($ref[0] == 3){
|
|
# skip first three row, we don't need that data
|
|
splice @ref, 0, 3 if @ref;
|
|
foreach my $item (@ref){
|
|
if ($item !~ /^~/){ # skip the indented rows
|
|
my @value = split /:\s+/, $item;
|
|
if ($value[0] eq 'Serial Number') {$data{'chassis_serial'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'Type') {$data{'chassis_type'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'Manufacturer') {$data{'chassis_vendor'} = main::dmi_cleaner($value[1]) }
|
|
elsif ($value[0] eq 'Version') {$data{'chassis_version'} = main::dmi_cleaner($value[1]) }
|
|
}
|
|
}
|
|
if ( $data{'chassis_type'} && $data{'chassis_type'} ne 'Other' ){
|
|
$data{'device'} = $data{'chassis_type'};
|
|
}
|
|
next;
|
|
}
|
|
# this may catch some BSD and fringe Linux cases
|
|
# processor information: check for hypervisor
|
|
elsif ($ref[0] == 4){
|
|
# skip first three row, we don't need that data
|
|
splice @ref, 0, 3 if @ref;
|
|
if (!$data{'device'}){
|
|
if (grep {/hypervisor/i} @ref){
|
|
$data{'device'} = 'virtual-machine';
|
|
}
|
|
}
|
|
last;
|
|
}
|
|
elsif ($ref[0] > 4){
|
|
last;
|
|
}
|
|
}
|
|
if (!$data{'device'}){
|
|
$data{'device'} = get_device_vm($data{'sys_vendor'},$data{'product_name'});
|
|
$data{'device'} ||= 'other-vm?';
|
|
}
|
|
# print "dmi:\n";
|
|
# foreach (keys %data){
|
|
# print "$_: $data{$_}\n";
|
|
# }
|
|
main::log_data('dump','%data',\%data) if $b_log;
|
|
my @rows = create_output(\%data);
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
|
|
sub get_device_sys {
|
|
eval $start if $b_log;
|
|
my ($chasis_id) = @_;
|
|
my ($device) = ('');
|
|
my @chassis;
|
|
# https://www.dmtf.org/sites/default/files/standards/documents/DSP0134_2.8.0.pdf
|
|
$chassis[2] = 'unknown';
|
|
# note: 13 is all-in-one which we take as a mac type system
|
|
$chassis[3] = 'desktop';
|
|
$chassis[4] = 'desktop';
|
|
$chassis[6] = 'desktop';
|
|
$chassis[7] = 'desktop';
|
|
$chassis[13] = 'desktop';
|
|
$chassis[15] = 'desktop';
|
|
$chassis[24] = 'desktop';
|
|
# 5 - pizza box was a 1 U desktop enclosure, but some old laptops also id this way
|
|
$chassis[5] = 'pizza-box';
|
|
$chassis[9] = 'laptop';
|
|
# note: lenovo T420 shows as 10, notebook, but it's not a notebook
|
|
$chassis[10] = 'laptop';
|
|
$chassis[16] = 'laptop';
|
|
$chassis[14] = 'notebook';
|
|
$chassis[8] = 'portable';
|
|
$chassis[11] = 'portable';
|
|
$chassis[17] = 'server';
|
|
$chassis[23] = 'server';
|
|
$chassis[25] = 'server';
|
|
$chassis[27] = 'blade';
|
|
$chassis[25] = 'blade';
|
|
$chassis[29] = 'blade';
|
|
$chassis[12] = 'docking-station';
|
|
$chassis[18] = 'expansion-chassis';
|
|
$chassis[19] = 'sub-chassis';
|
|
$chassis[20] = 'bus-expansion';
|
|
$chassis[21] = 'peripheral';
|
|
$chassis[22] = 'RAID';
|
|
$chassis[26] = 'compact-PCI';
|
|
$device = $chassis[$chasis_id] if $chassis[$chasis_id];
|
|
eval $end if $b_log;
|
|
return $device;
|
|
}
|
|
|
|
sub get_device_vm {
|
|
eval $start if $b_log;
|
|
my ($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/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' ) {
|
|
my @vm_data = (@pci,@sysctl,@dmesg_boot);
|
|
if (-e '/dev/disk/by-id'){
|
|
my @dev = glob('/dev/disk/by-id/*');
|
|
@vm_data = (@vm_data,@dev);
|
|
}
|
|
if ( grep {/innotek|vbox|virtualbox/i} @vm_data){
|
|
$vm = 'virtualbox';
|
|
}
|
|
elsif (grep {/vmware/i} @vm_data){
|
|
$vm = 'vmware';
|
|
}
|
|
elsif (grep {/Virtual HD/i} @vm_data){
|
|
$vm = 'hyper-v';
|
|
}
|
|
if (!$vm && (my $file = main::system_files('cpuinfo'))){
|
|
my @info = main::reader($file);
|
|
$vm = 'virtual-machine' if grep {/^flags.*hypervisor/} @info;
|
|
}
|
|
if (!$vm && -e '/dev/vda' || -e '/dev/vdb' || -e '/dev/xvda' || -e '/dev/xvdb' ){
|
|
$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';
|
|
}
|
|
eval $end if $b_log;
|
|
return $vm;
|
|
}
|
|
|
|
}
|
|
|
|
## NetworkData
|
|
{
|
|
package NetworkData;
|
|
my ($b_ip_run,@ifs_found);
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (@data,@rows);
|
|
my $num = 0;
|
|
if ($b_arm){
|
|
my $key = 'ARM';
|
|
@data = ({
|
|
main::key($num++,$key) => main::row_defaults('arm-pci',''),
|
|
},);
|
|
@rows = (@rows,@data);
|
|
}
|
|
else {
|
|
@data = card_data();
|
|
@rows = (@rows,@data) if @data;
|
|
@data = usb_data();
|
|
@rows = (@rows,@data) if @data;
|
|
}
|
|
if ($show{'network-advanced'}){
|
|
# @ifs_found = ();
|
|
# shift @ifs_found;
|
|
# pop @ifs_found;
|
|
if (!$bsd_type){
|
|
@data = advanced_data_sys('check','',0,'','');
|
|
@rows = (@rows,@data) if @data;
|
|
}
|
|
else {
|
|
@data = advanced_data_bsd('check');
|
|
@rows = (@rows,@data) if @data;
|
|
}
|
|
}
|
|
if ($show{'ip'}){
|
|
@data = wan_ip();
|
|
@rows = (@rows,@data);
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
# 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 (bsds)
|
|
sub card_data {
|
|
eval $start if $b_log;
|
|
my ($b_wifi,@rows,@data,%holder);
|
|
my ($j,$num) = (0,1);
|
|
foreach (@pci){
|
|
$num = 1;
|
|
my @row = @$_;
|
|
#print "$row[0] $row[3]\n";
|
|
if ($row[0] eq 'network' || $row[0] eq 'ethernet' ){
|
|
#print "$row[0] $row[3]\n";
|
|
$j = scalar @rows;
|
|
my $driver = $row[9];
|
|
my $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 $card = $row[4];
|
|
$card = ($card) ? main::pci_cleaner($card,'output') : 'N/A';
|
|
#$card ||= 'N/A';
|
|
$driver ||= 'N/A';
|
|
@data = (
|
|
{
|
|
main::key($num++,'Card') => $card,
|
|
main::key($num++,'driver') => $driver,
|
|
},
|
|
);
|
|
@rows = (@rows,@data);
|
|
if ($extra > 0){
|
|
if ($row[9] && !$bsd_type){
|
|
my $version = main::get_module_version($row[9]);
|
|
$version ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'v')} = $version;
|
|
}
|
|
$row[8] ||= 'N/A';
|
|
# as far as I know, wifi has no port, but in case it does in future, use it
|
|
$rows[$j]{main::key($num++,'port')} = $row[8] if (!$b_wifi || ( $b_wifi && $row[8] ne 'N/A') );
|
|
$rows[$j]{main::key($num++,'bus ID')} = $row[2] . '.' . $row[3];
|
|
}
|
|
if ($extra > 1){
|
|
$rows[$j]{main::key($num++,'chip ID')} = $chip_id;
|
|
}
|
|
if ($show{'network-advanced'}){
|
|
if (!$bsd_type){
|
|
@data = advanced_data_sys($row[5],$row[6],$holder{$chip_id},$b_wifi,'');
|
|
}
|
|
else {
|
|
@data = advanced_data_bsd("$row[9]$row[11]",$b_wifi);
|
|
}
|
|
@rows = (@rows,@data);
|
|
}
|
|
}
|
|
#print "$row[0]\n";
|
|
}
|
|
# @rows = ();
|
|
if (!@rows){
|
|
my $key = 'Message';
|
|
@data = ({
|
|
main::key($num++,$key) => main::row_defaults('pci-card-data',''),
|
|
},);
|
|
@rows = (@rows,@data);
|
|
|
|
}
|
|
#my $ref = $pci[-1];
|
|
#print $$ref[0],"\n";
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub usb_data {
|
|
eval $start if $b_log;
|
|
my (@data,@rows,@temp2,$b_wifi,$driver,$path,$product,$product2,$test,$vendor,$vendor2);
|
|
my ($j,$num) = (0,1);
|
|
return if !@usb;
|
|
foreach my $ref (@usb){
|
|
my @row = @$ref;
|
|
# a device will always be the second or > device on the bus
|
|
if ($row[1] > 1){
|
|
$num = 1;
|
|
($product,$product2,$test,$vendor,$vendor2) = ('','','','','');
|
|
if ($usb_level == 1){
|
|
$product = main::cleaner($row[3]);
|
|
}
|
|
else {
|
|
foreach my $line (@row){
|
|
my @working = split /:/, $line;
|
|
if ($working[0] eq 'idVendor' && $working[2]){
|
|
$vendor = main::cleaner($working[2]);
|
|
}
|
|
if ($working[0] eq 'idProduct' && $working[2]){
|
|
$product = main::cleaner($working[2]);
|
|
}
|
|
if ($working[0] eq 'iVendor' && $working[2]){
|
|
$product2 = main::cleaner($working[2]);
|
|
}
|
|
if ($working[0] eq 'iProduct' && $working[2]){
|
|
$product2 = main::cleaner($working[2]);
|
|
}
|
|
if ($working[0] eq 'Descriptor_Configuration'){
|
|
last;
|
|
}
|
|
}
|
|
if ($vendor && $product){
|
|
$product = ($product =~ /$vendor/) ? $product: "$vendor $product";
|
|
}
|
|
elsif ($vendor && $product2){
|
|
$product = ($product2 =~ /$vendor/) ? $product2: "$vendor $product2";
|
|
}
|
|
elsif ($vendor2 && $product){
|
|
$product = ($product =~ /$vendor2/) ? $product: "$vendor2 $product";
|
|
}
|
|
elsif ($vendor2 && $product2){
|
|
$product = ($product2 =~ /$vendor2/) ? $product2: "$vendor2 $product2";
|
|
}
|
|
elsif ($vendor){
|
|
$product = $vendor;
|
|
}
|
|
elsif ($vendor2){
|
|
$product = $vendor2;
|
|
}
|
|
$test = "$vendor $product $vendor2 $vendor2";
|
|
}
|
|
if ($product && network_device($test)){
|
|
@temp2 = main::get_usb_drivers($row[0],$row[2]) if !$bsd_type && -d "/sys/devices";
|
|
if (@temp2){
|
|
$driver = $temp2[0] if $temp2[0];
|
|
$path = $temp2[1] if $temp2[1];
|
|
}
|
|
$driver ||= 'usb-network';
|
|
@data = ({
|
|
main::key($num++,'Card') => $product,
|
|
main::key($num++,'type') => 'USB',
|
|
main::key($num++,'driver') => $driver,
|
|
},);
|
|
$b_wifi = check_wifi($product);
|
|
@rows = (@rows,@data);
|
|
if ($extra > 0){
|
|
$rows[$j]{main::key($num++,'bus ID')} = "$row[0]:$row[1]";
|
|
}
|
|
if ($extra > 1){
|
|
$rows[$j]{main::key($num++,'chip ID')} = $row[2];
|
|
}
|
|
$j = scalar @rows;
|
|
if ($show{'network-advanced'}){
|
|
if (!$bsd_type){
|
|
my (@temp,$vendor,$chip);
|
|
@temp = split (/:/, $row[2]) if $row[2];
|
|
($vendor,$chip) = ($temp[0],$temp[1]) if @temp;
|
|
@data = advanced_data_sys($vendor,$chip,0,$b_wifi,$path);
|
|
}
|
|
# NOTE: we need the driver.number, like wlp0 to get a match, and
|
|
# we can't get that from usb data, so we have to let it fall back down
|
|
# to the check function for BSDs.
|
|
#else {
|
|
# @data = advanced_data_bsd($row[2],$b_wifi);
|
|
#}
|
|
@rows = (@rows,@data) if @data;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub advanced_data_sys {
|
|
eval $start if $b_log;
|
|
return if ! -d '/sys/class/net';
|
|
my ($vendor,$chip,$count,$b_wifi,$path_usb) = @_;
|
|
my $num = 0;
|
|
my $key = 'IF';
|
|
my ($b_check,$b_usb,$if,$path,@paths,@row,@rows);
|
|
# 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;
|
|
if ( $count > 0 && $count < scalar @paths ){
|
|
@paths = splice @paths, $count, scalar @paths;
|
|
}
|
|
if ($vendor eq 'check'){
|
|
$b_check = 1;
|
|
$key = 'IF-ID';
|
|
}
|
|
#print join '; ', @paths, $count, "\n";
|
|
foreach (@paths){
|
|
my ($data1,$data2,$duplex,$mac,$speed,$state);
|
|
# for usb, we already know where we are
|
|
if (!$b_usb){
|
|
$path = "$_/device/vendor";
|
|
$data1 = (main::reader($path))[0] if -e $path;
|
|
$data1 =~ s/^0x// if $data1;
|
|
$path = "$_/device/device";
|
|
$data2 = (main::reader($path))[0] if -e $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;
|
|
}
|
|
#print "d1:$data1 v:$vendor d2:$data2 c:$chip\n";
|
|
if ( $b_usb || $b_check || ( $data1 && $data2 && $data1 eq $vendor && $data2 eq $chip )) {
|
|
$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 -e $path;
|
|
$duplex ||= 'N/A';
|
|
$path = "$_/address";
|
|
$mac = (main::reader($path))[0] if -e $path;
|
|
$mac = main::apply_filter($mac);
|
|
$path = "$_/speed";
|
|
$speed = (main::reader($path))[0] if -e $path;
|
|
$speed ||= 'N/A';
|
|
$path = "$_/operstate";
|
|
$state = (main::reader($path))[0] if -e $path;
|
|
$state ||= 'N/A';
|
|
#print "$speed \n";
|
|
@row = ({
|
|
main::key($num++,$key) => $if,
|
|
main::key($num++,'state') => $state,
|
|
},);
|
|
#my $j = scalar @row - 1;
|
|
push (@ifs_found, $if) if (!$b_check && (! grep {/$if/} @ifs_found));
|
|
# print "push: if: $if ifs: @ifs_found\n";
|
|
# no print out for wifi since it doesn't have duplex/speed data available
|
|
# note that some cards show 'unknown' for state, so only testing explicitly
|
|
# for 'down' string in that to skip showing speed/duplex
|
|
# /sys/class/net/$if/wireless : nont always there, but worth a try: wlan/wl/ww/wlp
|
|
$b_wifi = 1 if !$b_wifi && ( -e "$_$if/wireless" || $if =~ /^(wl|ww)/);
|
|
if (!$b_wifi && $state ne 'down' && $state ne 'no'){
|
|
# make sure the value is strictly numeric before appending Mbps
|
|
$speed = ($speed =~ /^[0-9]+$/) ? "$speed Mbps" : $speed;
|
|
$row[0]{main::key($num++,'speed')} = $speed;
|
|
$row[0]{main::key($num++,'duplex')} = $duplex;
|
|
}
|
|
$row[0]{main::key($num++,'mac')} = $mac;
|
|
if ($b_check){
|
|
@rows = (@rows,@row);
|
|
}
|
|
else {
|
|
@rows = @row;
|
|
}
|
|
if ($show{'ip'}){
|
|
@row = if_ip($if);
|
|
@rows = (@rows,@row);
|
|
}
|
|
last if !$b_check;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub advanced_data_bsd {
|
|
eval $start if $b_log;
|
|
return if ! @ifs_bsd;
|
|
my ($if,$b_wifi) = @_;
|
|
my (@data,@row,@rows,$working_if);
|
|
my ($b_check,$state,$speed,$duplex,$mac);
|
|
my $num = 0;
|
|
my $key = 'IF';
|
|
my $j = 0;
|
|
if ($if eq 'check'){
|
|
$b_check = 1;
|
|
$key = 'IF-ID';
|
|
}
|
|
foreach my $ref (@ifs_bsd){
|
|
if (ref $ref ne 'ARRAY'){
|
|
$working_if = $ref;
|
|
# print "$working_if\n";
|
|
next;
|
|
}
|
|
else {
|
|
@data = @$ref;
|
|
}
|
|
if ( $b_check || $working_if eq $if){
|
|
$if = $working_if if $b_check;
|
|
# print "top: if: $if ifs: @ifs_found\n";
|
|
next if ($b_check && grep {/$if/} @ifs_found);
|
|
foreach my $line (@data){
|
|
# ($state,$speed,$duplex,$mac)
|
|
$duplex = $data[2];
|
|
$duplex ||= 'N/A';
|
|
$mac = main::apply_filter($data[3]);
|
|
$speed = $data[1];
|
|
$speed ||= 'N/A';
|
|
$state = $data[0];
|
|
$state ||= 'N/A';
|
|
#print "$speed \n";
|
|
@row = ({
|
|
main::key($num++,$key) => $if,
|
|
main::key($num++,'state') => $state,
|
|
},);
|
|
push (@ifs_found, $if) if (!$b_check && (! grep {/$if/} @ifs_found ));
|
|
# print "push: if: $if ifs: @ifs_found\n";
|
|
# no print out for wifi since it doesn't have duplex/speed data available
|
|
# note that some cards show 'unknown' for state, so only testing explicitly
|
|
# for 'down' string in that to skip showing speed/duplex
|
|
if (!$b_wifi && $state ne 'down' && $state ne 'no'){
|
|
# make sure the value is strictly numeric before appending Mbps
|
|
$speed = ($speed =~ /^[0-9]+$/) ? "$speed Mbps" : $speed;
|
|
$row[0]{main::key($num++,'speed')} = $speed;
|
|
$row[0]{main::key($num++,'duplex')} = $duplex;
|
|
}
|
|
$row[0]{main::key($num++,'mac')} = $mac;
|
|
}
|
|
@rows = (@rows,@row);
|
|
if ($show{'ip'}){
|
|
@row = if_ip($if) if $if;
|
|
@rows = (@rows,@row) if @row;
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
## values:
|
|
# 0 - ipv
|
|
# 1 - ip
|
|
# 2 - broadcast, if found
|
|
# 3 - scope, if found
|
|
# 4 - scope if, if different from if
|
|
sub if_ip {
|
|
eval $start if $b_log;
|
|
$b_ip_run = 1;
|
|
my ($if) = @_;
|
|
my (@data,@row,@rows,$working_if);
|
|
my $num = 0;
|
|
my $j = 0;
|
|
OUTER:
|
|
foreach my $ref (@ifs){
|
|
if (ref $ref ne 'ARRAY'){
|
|
$working_if = $ref;
|
|
# print "if:$if wif:$working_if\n";
|
|
next;
|
|
}
|
|
else {
|
|
@data = @$ref;
|
|
# print "ref:$ref\n";
|
|
}
|
|
if ($working_if eq $if){
|
|
foreach my $ref2 (@data){
|
|
$j = scalar @rows;
|
|
$num = 1;
|
|
if ($limit > 0 && $j >= $limit){
|
|
@row = ({
|
|
main::key($num++,'Message') => main::row_defaults('output-limit',scalar @data),
|
|
},);
|
|
@rows = (@rows,@row);
|
|
last OUTER;
|
|
}
|
|
my @data2 = @$ref2;
|
|
#print "$data2[0] $data2[1]\n";
|
|
my ($ipv,$ip,$broadcast,$scope,$scope_id);
|
|
$ipv = ($data2[0])? $data2[0]: 'N/A';
|
|
$ip = main::apply_filter($data2[1]);
|
|
$scope = ($data2[3])? $data2[3]: 'N/A';
|
|
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 eth0
|
|
# scope link
|
|
# scope site dynamic
|
|
# scope link
|
|
my $key = ($data2[4] =~ /deprecated|dynamic|temporary/ ) ? 'type':'virtual' ;
|
|
@row = ({
|
|
main::key($num++,"IP v$ipv") => $ip,
|
|
main::key($num++,$key) => $data2[4],
|
|
main::key($num++,'scope') => $scope,
|
|
},);
|
|
}
|
|
else {
|
|
@row = ({
|
|
main::key($num++,"IP v$ipv") => $ip,
|
|
main::key($num++,'scope') => $scope,
|
|
},);
|
|
}
|
|
}
|
|
else {
|
|
@row = ({
|
|
main::key($num++,'IF') => $if,
|
|
main::key($num++,"IP v$ipv") => $ip,
|
|
main::key($num++,'scope') => $scope,
|
|
},);
|
|
}
|
|
@rows = (@rows,@row);
|
|
if ($extra > 1 && $data2[2]){
|
|
$broadcast = main::apply_filter($data2[2]);
|
|
$rows[$j]{main::key($num++,'broadcast')} = $broadcast;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
# 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 (@data,$ip);
|
|
my $num = 0;
|
|
# time: 0.06 - 0.07 seconds
|
|
if (my $program = main::check_program('dig')){
|
|
$ip = (main::grabber("$program +short +time=1 +tries=1 myip.opendns.com \@resolver1.opendns.com 2>/dev/null"))[0];
|
|
}
|
|
else {
|
|
# note: tests: akamai: 0.055 - 0.065 icanhazip.com: 0.177 0.164
|
|
# smxi: 0.525, so almost 10x slower. Dig is fast too
|
|
# leaving smxi as last test because I know it will always be up.
|
|
my @urls = qw( http://whatismyip.akamai.com/ http://icanhazip.com/ https://smxi.org/opt/ip.php);
|
|
foreach (@urls){
|
|
$ip = main::download_file('stdout',$_);
|
|
if ($ip){
|
|
# print "$_\n";
|
|
chomp $ip;
|
|
$ip = (split /\s+/, $ip)[-1];
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
if ($ip && $show{'filter'}){
|
|
$ip = $filter_string;
|
|
}
|
|
$ip ||= main::row_defaults('IP', 'WAN IP');
|
|
@data = ({
|
|
main::key($num++,'WAN IP') => $ip,
|
|
},);
|
|
eval $end if $b_log;
|
|
return @data;
|
|
}
|
|
|
|
### USB networking search string data, because some brands can have other products than
|
|
### wifi/nic cards, they need further identifiers, with wildcards.
|
|
### putting the most common and likely first, then the less common, then some specifics
|
|
|
|
# Wi-Fi.*Adapter Wireless.*Adapter Ethernet.*Adapter WLAN.*Adapter
|
|
# Network.*Adapter 802\.11 Atheros Atmel D-Link.*Adapter D-Link.*Wireless Linksys
|
|
# Netgea Ralink Realtek.*Network Realtek.*Wireless Realtek.*WLAN Belkin.*Wireless
|
|
# Belkin.*WLAN Belkin.*Network Actiontec.*Wireless Actiontec.*Network AirLink.*Wireless
|
|
# Asus.*Network Asus.*Wireless Buffalo.*Wireless Davicom DWA-.*RangeBooster DWA-.*Wireless
|
|
# ENUWI-.*Wireless LG.*Wi-Fi Rosewill.*Wireless RNX-.*Wireless Samsung.*LinkStick
|
|
# Samsung.*Wireless Sony.*Wireless TEW-.*Wireless TP-Link.*Wireless
|
|
# WG[0-9][0-9][0-9].*Wireless WNA[0-9][0-9][0-9] WNDA[0-9][0-9][0-9]
|
|
# Zonet.*ZEW.*Wireless
|
|
sub network_device {
|
|
eval $start if $b_log;
|
|
my ($device_string) = @_;
|
|
my ($b_network);
|
|
# belkin=050d; d-link=07d1; netgear=0846; ralink=148f; realtek=0bda;
|
|
# Atmel makes other stuff
|
|
my @tests = qw(wifi Wi-Fi.*Adapter Ethernet \bLAN\b WLAN Network 802\.11
|
|
Wireless.*Adapter 54\sMbps Network 100\/1000 Mobile\sBroadband Atheros D-Link.*Adapter
|
|
Dell.*Wireless D-Link.*Wireless Linksys Netgea Ralink Realtek.*Network Realtek.*Wireless
|
|
Belkin.*Wireless Actiontec.*Wireless AirLink.*Wireless Asus.*Wireless
|
|
Buffalo.*Wireless Davicom DWA-.*RangeBooster DWA-.*Wireless
|
|
ENUWI-.*Wireless LG.*Wi-Fi Rosewill.*Wireless RNX-.*Wireless Samsung.*LinkStick
|
|
Samsung.*Wireless Sony.*Wireless TEW-.*Wireless TP-Link.*Wireless
|
|
WG[0-9][0-9][0-9].*Wireless WNA[0-9][0-9][0-9] WNDA[0-9][0-9][0-9]
|
|
Zonet.*ZEW.*Wireless 050d:935b 0bda:8189 0bda:8197
|
|
);
|
|
foreach (@tests){
|
|
if ($device_string =~ /$_/i ){
|
|
$b_network = 1;
|
|
last;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $b_network;
|
|
}
|
|
sub check_wifi {
|
|
my ($item) = @_;
|
|
my $b_wifi = ($item =~ /wireless|wifi|wi-fi|wlan|802\.11|centrino/i) ? 1 : 0;
|
|
return $b_wifi;
|
|
}
|
|
}
|
|
|
|
## OpticalData
|
|
{
|
|
package OpticalData;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (@data,@rows,$key1,$val1);
|
|
my $num = 0;
|
|
if ($bsd_type){
|
|
#@data = optical_data_bsd();
|
|
$key1 = 'Optical Report';
|
|
$val1 = main::row_defaults('optical-data-bsd');
|
|
@data = ({main::key($num++,$key1) => $val1,});
|
|
if ( @dm_boot_optical){
|
|
@data = optical_data_bsd();
|
|
}
|
|
else{
|
|
my $file = main::system_files('dmesg-boot');
|
|
if ( $file && ! -r $file ){
|
|
$val1 = main::row_defaults('dmesg-boot-permissions');
|
|
}
|
|
elsif (! -e $file){
|
|
$val1 = main::row_defaults('dmesg-boot-missing');
|
|
}
|
|
else {
|
|
$val1 = main::row_defaults('optical-data-bsd');
|
|
}
|
|
$key1 = 'Optical Report';
|
|
@data = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
}
|
|
else {
|
|
@data = optical_data_linux();
|
|
}
|
|
if (!@data){
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('optical-data');
|
|
@data = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
@rows = (@rows,@data);
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub create_output {
|
|
eval $start if $b_log;
|
|
my (%devices) = @_;
|
|
my (@data,@rows);
|
|
my $num = 0;
|
|
my $j = 0;
|
|
# build floppy if any
|
|
foreach my $key (sort keys %devices){
|
|
if ($devices{$key}{'type'} eq 'floppy'){
|
|
@data = ({ main::key($num++,ucfirst($devices{$key}{'type'})) => "/dev/$key"});
|
|
@rows = (@rows,@data);
|
|
delete $devices{$key};
|
|
}
|
|
}
|
|
foreach my $key (sort keys %devices){
|
|
$j = scalar @rows;
|
|
$num = 1;
|
|
my $vendor = $devices{$key}{'vendor'};
|
|
$vendor ||= 'N/A';
|
|
my $model = $devices{$key}{'model'};
|
|
$model ||= 'N/A';
|
|
@data = ({
|
|
main::key($num++,ucfirst($devices{$key}{'type'})) => "/dev/$key",
|
|
main::key($num++,'vendor') => $vendor,
|
|
main::key($num++,'model') => $model,
|
|
});
|
|
@rows = (@rows,@data);
|
|
if ($extra > 0){
|
|
my $rev = $devices{$key}{'rev'};
|
|
$rev ||= 'N/A';
|
|
$rows[$j]{ main::key($num++,'rev')} = $rev;
|
|
}
|
|
if ($extra > 1 && $devices{$key}{'serial'}){
|
|
$rows[$j]{ main::key($num++,'serial')} = main::apply_filter($devices{$key}{'serial'});
|
|
}
|
|
my $ref = $devices{$key}{'links'};
|
|
my $links = (@$ref) ? join ',', sort @$ref: 'N/A' ;
|
|
$rows[$j]{ main::key($num++,'dev-links')} = $links;
|
|
if ($show{'optical'}){
|
|
$j = scalar @rows;
|
|
my $speed = $devices{$key}{'speed'};
|
|
$speed ||= 'N/A';
|
|
my ($audio,$multisession) = ('','');
|
|
if (defined $devices{$key}{'multisession'}){
|
|
$multisession = ( $devices{$key}{'multisession'} == 1 ) ? 'yes' : 'no' ;
|
|
}
|
|
$multisession ||= 'N/A';
|
|
if (defined $devices{$key}{'audio'}){
|
|
$audio = ( $devices{$key}{'audio'} == 1 ) ? 'yes' : 'no' ;
|
|
}
|
|
$audio ||= 'N/A';
|
|
my $dvd = 'N/A';
|
|
my (@rw,$rws);
|
|
if (defined $devices{$key}{'dvd'}){
|
|
$dvd = ( $devices{$key}{'dvd'} == 1 ) ? 'yes' : 'no' ;
|
|
}
|
|
if ($devices{$key}{'cdr'}){
|
|
push @rw, 'cd-r';
|
|
}
|
|
if ($devices{$key}{'cdrw'}){
|
|
push @rw, 'cd-rw';
|
|
}
|
|
if ($devices{$key}{'dvdr'}){
|
|
push @rw, 'dvd-r';
|
|
}
|
|
if ($devices{$key}{'dvdram'}){
|
|
push @rw, 'dvd-ram';
|
|
}
|
|
$rws = (@rw) ? join ',', @rw: 'none' ;
|
|
@data = ({
|
|
main::key($num++,'Features') => '',
|
|
main::key($num++,'speed') => $speed,
|
|
main::key($num++,'multisession') => $multisession,
|
|
main::key($num++,'audio') => $audio,
|
|
main::key($num++,'dvd') => $dvd,
|
|
main::key($num++,'rw') => $rws,
|
|
});
|
|
@rows = (@rows,@data);
|
|
|
|
if ($extra > 0 ){
|
|
my $state = $devices{$key}{'state'};
|
|
$state ||= 'N/A';
|
|
$rows[$j]{ main::key($num++,'state')} = $state;
|
|
}
|
|
}
|
|
}
|
|
#print Data::Dumper::Dumper \%devices;
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub optical_data_bsd {
|
|
eval $start if $b_log;
|
|
my (@data,%devices,@rows,@temp);
|
|
my ($count,$i,$working) = (0,0,'');
|
|
foreach (@dm_boot_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 $devices{$working}){
|
|
$devices{$working} = ({});
|
|
$devices{$working}{'links'} = ([]);
|
|
$devices{$working}{'model'} = '';
|
|
$devices{$working}{'rev'} = '';
|
|
$devices{$working}{'state'} = '';
|
|
$devices{$working}{'vendor'} = '';
|
|
$devices{$working}{'temp'} = '';
|
|
$devices{$working}{'type'} = ($working =~ /^cd/) ? 'optical' : 'unknown';
|
|
}
|
|
#print "$_\n";
|
|
if ($bsd_type ne 'openbsd'){
|
|
if ($row[1] && $row[1] =~ /^<([^>]+)>/){
|
|
$devices{$working}{'model'} = $1;
|
|
$count = ($devices{$working}{'model'} =~ tr/ //);
|
|
if ($count && $count > 1){
|
|
@temp = split /\s+/, $devices{$working}{'model'};
|
|
$devices{$working}{'vendor'} = $temp[0];
|
|
my $index = ($#temp > 2 ) ? ($#temp - 1): $#temp;
|
|
$devices{$working}{'model'} = join ' ', @temp[1..$index];
|
|
$devices{$working}{'rev'} = $temp[-1] if $count > 2;
|
|
}
|
|
if ($show{'optical'}){
|
|
if (/\bDVD\b/){
|
|
$devices{$working}{'dvd'} = 1;
|
|
}
|
|
if (/\bRW\b/){
|
|
$devices{$working}{'cdrw'} = 1;
|
|
$devices{$working}{'dvdr'} = 1 if $devices{$working}{'dvd'};
|
|
}
|
|
}
|
|
}
|
|
if ($row[1] && $row[1] =~ /^Serial/){
|
|
@temp = split /\s+/,$row[1];
|
|
$devices{$working}{'serial'} = $temp[-1];
|
|
}
|
|
if ($show{'optical'}){
|
|
if ($row[1] =~ /^([0-9\.]+[MGTP][B]?\/s)/){
|
|
$devices{$working}{'speed'} = $1;
|
|
$devices{$working}{'speed'} =~ s/\.[0-9]+//;
|
|
}
|
|
if (/\bDVD[-]?RAM\b/){
|
|
$devices{$working}{'cdr'} = 1;
|
|
$devices{$working}{'dvdram'} = 1;
|
|
}
|
|
if ($row[2] && $row[2] =~ /,\s(.*)$/){
|
|
$devices{$working}{'state'} = $1;
|
|
$devices{$working}{'state'} =~ s/\s+-\s+/, /;
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
if ($row[2] && $row[2] =~ /<([^>]+)>/){
|
|
$devices{$working}{'model'} = $1;
|
|
$count = ($devices{$working}{'model'} =~ tr/,//);
|
|
#print "c: $count $row[2]\n";
|
|
if ($count && $count > 1){
|
|
@temp = split /,\s*/, $devices{$working}{'model'};
|
|
$devices{$working}{'vendor'} = $temp[0];
|
|
$devices{$working}{'model'} = $temp[1];
|
|
$devices{$working}{'rev'} = $temp[2];
|
|
}
|
|
if ($show{'optical'}){
|
|
if (/\bDVD\b/){
|
|
$devices{$working}{'dvd'} = 1;
|
|
}
|
|
if (/\bRW\b/){
|
|
$devices{$working}{'cdrw'} = 1;
|
|
$devices{$working}{'dvdr'} = 1 if $devices{$working}{'dvd'};
|
|
}
|
|
if (/\bDVD[-]?RAM\b/){
|
|
$devices{$working}{'cdr'} = 1;
|
|
$devices{$working}{'dvdram'} = 1;
|
|
}
|
|
}
|
|
}
|
|
if ($show{'optical'}){
|
|
#print "$row[1]\n";
|
|
if (($row[1] =~ tr/,//) > 1){
|
|
@temp = split /,\s*/, $row[1];
|
|
$devices{$working}{'speed'} = $temp[2];
|
|
}
|
|
|
|
}
|
|
}
|
|
}
|
|
|
|
main::log_data('dump','%devices',\%devices) if $b_log;
|
|
#print Data::Dumper::Dumper \%devices;
|
|
@rows = create_output(%devices) if %devices;
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub optical_data_linux {
|
|
eval $start if $b_log;
|
|
my (@data,%devices,@info,@rows);
|
|
@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 $devices{$working}){
|
|
my @temp = ($_ ne $working) ? ([$_]) : ([]);
|
|
$devices{$working} = ({'links' => @temp});
|
|
$devices{$working}{'type'} = ($working =~ /^fd/) ? 'floppy' : 'optical' ;
|
|
}
|
|
else {
|
|
my $ref = $devices{$working}{'links'};
|
|
push @$ref, $_ 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 %devices){
|
|
next if $devices{$key}{'type'} eq 'floppy';
|
|
my $device = "/sys/block/$key/device";
|
|
if ( -d $device){
|
|
if (-e "$device/vendor"){
|
|
$devices{$key}{'vendor'} = (main::reader("$device/vendor"))[0];
|
|
$devices{$key}{'vendor'} = main::cleaner($devices{$key}{'vendor'});
|
|
$devices{$key}{'state'} = (main::reader("$device/state"))[0];
|
|
$devices{$key}{'model'} = (main::reader("$device/model"))[0];
|
|
$devices{$key}{'model'} = main::cleaner($devices{$key}{'model'});
|
|
$devices{$key}{'rev'} = (main::reader("$device/rev"))[0];
|
|
}
|
|
}
|
|
elsif ( -e "/proc/ide/$_/model"){
|
|
$devices{$key}{'vendor'} = (main::reader("/proc/ide/$_/model"))[0];
|
|
$devices{$key}{'vendor'} = main::cleaner($devices{$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:/) {
|
|
$devices{$key}{'speed'} = $split[$index];
|
|
}
|
|
elsif ($item =~/^Can read multisession:/) {
|
|
$devices{$key}{'multisession'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can read MCN:/) {
|
|
$devices{$key}{'mcn'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can play audio:/) {
|
|
$devices{$key}{'audio'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can write CD-R:/) {
|
|
$devices{$key}{'cdr'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can write CD-RW:/) {
|
|
$devices{$key}{'cdrw'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can read DVD:/) {
|
|
$devices{$key}{'dvd'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can write DVD-R:/) {
|
|
$devices{$key}{'dvdr'}=$split[$index+1];
|
|
}
|
|
elsif ($item =~/^Can write DVD-RAM:/) {
|
|
$devices{$key}{'dvdram'}=$split[$index+1];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
main::log_data('dump','%devices',\%devices) if $b_log;
|
|
#print Data::Dumper::Dumper \%devices;
|
|
@rows = create_output(%devices) if %devices;
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
|
|
}
|
|
|
|
## PartitionData
|
|
{
|
|
package PartitionData;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (@rows,$key1,$val1);
|
|
my $num = 0;
|
|
partition_data() if !$b_partitions;
|
|
if (!@partitions) {
|
|
$key1 = 'Message';
|
|
#$val1 = ($bsd_type && $bsd_type eq 'darwin') ?
|
|
# main::row_defaults('darwin-feature') : main::row_defaults('partition-data');
|
|
$val1 = main::row_defaults('partition-data');
|
|
@rows = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
else {
|
|
@rows = create_output();
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub create_output {
|
|
eval $start if $b_log;
|
|
my $num = 0;
|
|
my $j = 0;
|
|
my (@data,@data2,%part,@rows,$dev,$dev_type,$fs);
|
|
@partitions = sort { $a->{'id'} cmp $b->{'id'} } @partitions;
|
|
foreach my $ref (@partitions){
|
|
my %row = %$ref;
|
|
$num = 1;
|
|
next if $row{'type'} eq 'secondary' && $show{'partition'};
|
|
@data2 = main::get_size($row{'size'}) if (defined $row{'size'});
|
|
my $size = (@data2) ? $data2[0] . ' ' . $data2[1]: 'N/A';
|
|
@data2 = main::get_size($row{'used'}) if (defined $row{'used'});
|
|
my $used = (@data2) ? $data2[0] . ' ' . $data2[1]: 'N/A';
|
|
my $percent = (defined $row{'percent-used'}) ? ' (' . $row{'percent-used'} . '%)' : '';
|
|
%part = ();
|
|
if (defined $row{'dev-base'}){
|
|
if ($row{'dev-base'} =~ /^non-dev-/){
|
|
$row{'dev-base'} =~ s/^non-dev-//;
|
|
$dev_type = 'raid';
|
|
$dev = $row{'dev-base'};
|
|
}
|
|
# note: I have seen this: beta:data/ for sshfs path
|
|
elsif ($row{'dev-base'} =~ /^\/\/|:\//){
|
|
$dev_type = 'remote';
|
|
$dev = $row{'dev-base'};
|
|
}
|
|
# an error has occurred almost for sure
|
|
elsif (!$row{'dev-base'}){
|
|
$dev_type = 'dev';
|
|
$dev = main::row_defaults('unknown-dev');
|
|
}
|
|
else {
|
|
$dev_type = 'dev';
|
|
$dev = '/dev/' . $row{'dev-base'};
|
|
}
|
|
}
|
|
else {
|
|
$dev_type = 'dev';
|
|
}
|
|
$fs = ($row{'fs'}) ? lc($row{'fs'}): 'N/A';
|
|
$dev ||= 'N/A';
|
|
$j = scalar @rows;
|
|
@data = ({
|
|
main::key($num++,'ID') => $row{'id'},
|
|
main::key($num++,'size') => $size,
|
|
main::key($num++,'used') => $used . $percent,
|
|
main::key($num++,'fs') => $fs,
|
|
main::key($num++,$dev_type) => $dev,
|
|
});
|
|
@rows = (@rows,@data);
|
|
if ($show{'label'}){
|
|
$rows[$j]{main::key($num++,'label')} = ($row{'label'}) ? $row{'label'}: 'N/A';
|
|
}
|
|
if ($show{'uuid'}){
|
|
$rows[$j]{main::key($num++,'uuid')} = ($row{'uuid'}) ? $row{'uuid'}: 'N/A';
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
|
|
sub partition_data {
|
|
eval $start if $b_log;
|
|
#return if $bsd_type && $bsd_type eq 'darwin'; # darwin has muated output, of course
|
|
my (@data,@rows,@mapper,@mount,@partitions_working,%part);
|
|
my ($b_fake_map,$b_fs,$b_load,$cols,$roots) = (0,1,0,6,0);
|
|
my ($back_size,$back_used) = (4,3);
|
|
my ($dev_base,$fs,$id,$label,$percent_used,$size,$type,$uuid,$used);
|
|
$b_partitions = 1;
|
|
set_lsblk() if !$bsd_type && !$b_lsblk;
|
|
# set labels, uuid, gpart
|
|
set_label_uuid() if !$b_label_uuid;
|
|
# most current OS support -T and -k, but -P means different things
|
|
# in freebsd. However since most use is from linux, we make that default
|
|
if (!$bsd_type){
|
|
@partitions_working = main::grabber("df -P -T -k 2>/dev/null");
|
|
if (-d '/dev/mapper'){
|
|
@mapper = main::globber('/dev/mapper/*');
|
|
}
|
|
}
|
|
else {
|
|
# this is missing the file system data
|
|
if ($bsd_type ne 'darwin'){
|
|
@partitions_working = main::grabber("df -T -k 2>/dev/null");
|
|
}
|
|
#Filesystem 1024-blocks Used Available Capacity iused ifree %iused Mounted on
|
|
else {
|
|
$cols = 8;
|
|
$b_fake_map = 1;
|
|
($back_size,$back_used) = (7,6);
|
|
}
|
|
if (!@partitions_working){
|
|
@partitions_working = main::grabber("df -k 2>/dev/null");
|
|
$b_fs = 0;
|
|
$cols = 5 if $bsd_type ne 'darwin';
|
|
if (my $path = main::check_program('mount')){
|
|
@mount = main::grabber("$path 2>/dev/null");
|
|
}
|
|
}
|
|
}
|
|
# determine positions
|
|
my $row1 = shift @partitions_working;
|
|
# new kernels/df have rootfs and / repeated, creating two entries for the same partition
|
|
# so check for two string endings of / then slice out the rootfs one, I could check for it
|
|
# before slicing it out, but doing that would require the same action twice re code execution
|
|
foreach (@partitions_working){
|
|
if (/\s\/$/){
|
|
$roots++;
|
|
}
|
|
}
|
|
@partitions_working = grep {!/^rootfs/} @partitions_working if $roots > 1;
|
|
my $filters = '^(aufs|cgroup.*|cgmfs|configfs|debugfs|\/dev|dev|\/dev/loop[0-9]*|devfs|devtmpfs|';
|
|
$filters .= 'fdescfs|iso9660|linprocfs|none|procfs|\/run(\/.*)?|run|squashfs|sys|\/sys\/.*|sysfs|';
|
|
$filters .= 'tmpfs|type|udev|unionfs|vartmp)$';
|
|
foreach (@partitions_working){
|
|
# stupid apple bullshit
|
|
$_ =~ s/^map\s+([\S]+)/map:\/$1/ if $b_fake_map;
|
|
my @row = split /\s+/, $_;
|
|
if ($row[0] =~ /$filters/ || $row[0] =~ /^ROOT/i){
|
|
next;
|
|
}
|
|
$dev_base = '';
|
|
$fs = '';
|
|
$id = '';
|
|
$label = '';
|
|
$size = 0;
|
|
$used = 0;
|
|
%part = ();
|
|
$percent_used = 0;
|
|
$type = '';
|
|
$uuid = '';
|
|
$b_load = 0;
|
|
# NOTE: using -P for linux fixes line wraps, and for bsds, assuming they don't use such long file names
|
|
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){
|
|
$row[0] = get_mapper($row[0],@mapper);
|
|
}
|
|
$dev_base = $row[0];
|
|
$dev_base =~ s/^\/dev\///;
|
|
%part = check_lsblk($dev_base,0) if @lsblk;
|
|
}
|
|
# this handles zfs type devices/partitions, which do not start with / but contain /
|
|
# note: Main/jails/transmission_1 path can be > 1 deep
|
|
# Main zfs 3678031340 8156 3678023184 0% /mnt/Main
|
|
if (!$dev_base && ($row[0] =~ /^([^\/]+\/)(.+)/ || ($row[0] =~ /^[^\/]+$/ && $row[1] =~ /^(btrfs|zfs)$/ ) ) ){
|
|
$dev_base = "non-dev-$row[0]";
|
|
}
|
|
# this handles yet another fredforfaen special case where a mounted drive
|
|
# has the search string in its name
|
|
if ($row[-1] =~ /^\/$|^\/boot$|^\/var$|^\/var\/tmp$|^\/var\/log$|^\/home$|^\/opt$|^\/tmp$|^\/usr$/){
|
|
$b_load = 1;
|
|
# note, older df in bsd do not have file system column
|
|
$type = 'main';
|
|
}
|
|
elsif ($row[$cols] !~ /^\/$|^\/boot$|^\/var$|^\/var\/tmp$|^\/var\/log$|^\/home$|^\/opt$|^\/tmp$|^\/usr$|^filesystem/){
|
|
$b_load = 1;
|
|
$type = 'secondary';
|
|
}
|
|
if ($b_load){
|
|
if (!$bsd_type){
|
|
$fs = (%part && $part{'fs'}) ? $part{'fs'} : $row[1];
|
|
if ($show{'label'}) {
|
|
if (%part && $part{'label'}) {
|
|
$label = $part{'label'};
|
|
}
|
|
elsif ( @labels){
|
|
$label = get_label($row[0]);
|
|
}
|
|
}
|
|
if ($show{'uuid'}) {
|
|
if (%part && $part{'uuid'}) {
|
|
$uuid = $part{'uuid'};
|
|
}
|
|
elsif ( @uuids){
|
|
$uuid = get_uuid($row[0]);
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$fs = ($b_fs) ? $row[1]: get_bsd_fs($row[0],@mount);
|
|
if (@gpart && ($show{'label'} || $show{'uuid'} ) ){
|
|
my @extra = get_bsd_label_uuid("$dev_base");
|
|
if (@extra){
|
|
$label = $extra[0];
|
|
$uuid = $extra[1];
|
|
}
|
|
}
|
|
}
|
|
$id = join ' ', @row[$cols .. $#row];
|
|
$id =~ s/\/home\/[^\/]+\/(.*)/\/home\/$filter_string\/$1/ if $show{'filter'};
|
|
$size = $row[$cols - $back_size];
|
|
$used = $row[$cols - $back_used];
|
|
$percent_used = sprintf( "%.1f", ( $used/$size )*100 ) if ($size);
|
|
@data = ({
|
|
'id' => $id,
|
|
'dev-base' => $dev_base,
|
|
'fs' => $fs,
|
|
'label' => $label,
|
|
'size' => $size,
|
|
'type' => $type,
|
|
'used' => $used,
|
|
'uuid' => $uuid,
|
|
'percent-used' => $percent_used,
|
|
});
|
|
@partitions = (@partitions,@data);
|
|
}
|
|
}
|
|
@data = swap_data();
|
|
@partitions = (@partitions,@data);
|
|
main::log_data('dump','@partitions',\@partitions) if $b_log;
|
|
# print Data::Dumper::Dumper \@partitions;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub swap_data {
|
|
eval $start if $b_log;
|
|
my (@swap,@working,$path,$label,$uuid);
|
|
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");
|
|
}
|
|
}
|
|
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);
|
|
}
|
|
# 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/;
|
|
my @data = split /\s+/, $_;
|
|
my $dev_base = $data[0];
|
|
$dev_base =~ s/^\/dev\///;
|
|
my $size = $data[$size_id];
|
|
my $used = $data[$used_id];
|
|
my $percent_used = sprintf( "%.1f", ( $used/$size )*100 );
|
|
if ($show{'label'} && @labels){
|
|
$label = get_label($data[0]);
|
|
}
|
|
if ($show{'uuid'} && @uuids){
|
|
$uuid = get_uuid($data[0]);
|
|
}
|
|
if ($bsd_type && @gpart && ($show{'label'} || $show{'uuid'} ) ){
|
|
my @extra = get_bsd_label_uuid("$dev_base");
|
|
if (@extra){
|
|
$label = $extra[0];
|
|
$uuid = $extra[1];
|
|
}
|
|
}
|
|
@data = ({
|
|
'id' => "swap-$s",
|
|
'dev-base' => $dev_base,
|
|
'fs' => 'swap',
|
|
'label' => $label,
|
|
'size' => $size,
|
|
'type' => 'main',
|
|
'used' => $used,
|
|
'uuid' => $uuid,
|
|
'percent-used' => $percent_used,
|
|
});
|
|
@swap = (@swap,@data);
|
|
$s++;
|
|
}
|
|
eval $end if $b_log;
|
|
return @swap;
|
|
}
|
|
sub get_bsd_fs {
|
|
eval $start if $b_log;
|
|
my ($item,@mount) = @_;
|
|
$item =~ s/map:\/(\S+)/map $1/ if $bsd_type eq 'darwin';
|
|
return 'N/A' if ! @mount;
|
|
my ($fs) = ('');
|
|
# linux: /dev/sdb6 on /var/www/m type ext4 (rw,relatime,data=ordered)
|
|
# bsd: /dev/ada0s1a on / (ufs, local, soft-updates)
|
|
foreach (@mount){
|
|
if ($_ =~ /^$item\son.*\(([^,\s\)]+)[,\s]*.*\)/){
|
|
$fs = $1;
|
|
last;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
main::log_data('data',"fs: $fs") if $b_log;
|
|
return $fs;
|
|
}
|
|
# 1. Name: ada1p1
|
|
# label: (null)
|
|
# label: ssd-root
|
|
# rawuuid: b710678b-f196-11e1-98fd-021fc614aca9
|
|
sub get_bsd_label_uuid {
|
|
eval $start if $b_log;
|
|
my ($item) = @_;
|
|
my (@data,$b_found);
|
|
foreach (@gpart){
|
|
my @working = split /\s*:\s*/, $_;
|
|
if ($_ =~ /^[0-9]+\.\sName:/ && $working[1] eq $item){
|
|
$b_found = 1;
|
|
}
|
|
elsif ($_ =~ /^[0-9]+\.\sName:/ && $working[1] ne $item){
|
|
$b_found = 0;
|
|
}
|
|
if ($b_found){
|
|
if ($working[0] eq 'label'){
|
|
$data[0] = $working[1];
|
|
$data[0] =~ s/\(|\)//g; # eg: label:(null) - we want to show null
|
|
}
|
|
if ($working[0] eq 'rawuuid'){
|
|
$data[1] = $working[1];
|
|
$data[0] =~ s/\(|\)//g;
|
|
}
|
|
}
|
|
}
|
|
main::log_data('dump','@data',\@data) if $b_log;
|
|
eval $end if $b_log;
|
|
return @data;
|
|
}
|
|
sub set_label_uuid {
|
|
eval $start if $b_log;
|
|
$b_label_uuid = 1;
|
|
if ( $show{'unmounted'} || $show{'label'} || $show{'uuid'} ){
|
|
if (!$bsd_type){
|
|
if (-d '/dev/disk/by-label'){
|
|
@labels = main::globber('/dev/disk/by-label/*');
|
|
}
|
|
if (-d '/dev/disk/by-uuid'){
|
|
@uuids = main::globber('/dev/disk/by-uuid/*');
|
|
}
|
|
}
|
|
else {
|
|
if ( my $path = main::check_program('gpart')){
|
|
@gpart = main::grabber("$path list 2>/dev/null",'strip');
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
sub set_lsblk {
|
|
eval $start if $b_log;
|
|
$b_lsblk = 1;
|
|
my (@temp,@working);
|
|
if (my $program = main::check_program('lsblk')){
|
|
@working = main::grabber("$program -bP --output NAME,TYPE,RM,FSTYPE,SIZE,LABEL,UUID,SERIAL,MOUNTPOINT 2>/dev/null");
|
|
foreach (@working){
|
|
if (/NAME="([^"]*)"\s+TYPE="([^"]*)"\s+RM="([^"]*)"\s+FSTYPE="([^"]*)"\s+SIZE="([^"]*)"\s+LABEL="([^"]*)"\s+UUID="([^"]*)"\s+SERIAL="([^"]*)"\s+MOUNTPOINT="([^"]*)"/){
|
|
my $size = ($5) ? $5/1024: 0;
|
|
# some versions of lsblk do not return serial, fs, uuid, or label
|
|
my @temp = ({
|
|
'name' => $1,
|
|
'type' => $2,
|
|
'rm' => $3,
|
|
'fs' => $4,
|
|
'size' => $size,
|
|
'label' => $6,
|
|
'uuid' => $7,
|
|
'serial' => $8,
|
|
'mount' => $9,
|
|
});
|
|
@lsblk = (@lsblk,@temp);
|
|
}
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \@lsblk;
|
|
main::log_data('dump','@lsblk',\@lsblk) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
sub check_lsblk {
|
|
eval $start if $b_log;
|
|
my ($name,$b_size) = @_;
|
|
my (%part,@row);
|
|
foreach my $ref (@lsblk){
|
|
my %row = %$ref;
|
|
next if ! $row{'name'};
|
|
if ($name eq $row{'name'}){
|
|
%part = %row;
|
|
last;
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \%part;
|
|
main::log_data('dump','%part',\%part) if $b_log;
|
|
eval $end if $b_log;
|
|
return %part;
|
|
}
|
|
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;
|
|
}
|
|
# args: $1 - dev item $2 - @mapper
|
|
# check for mapper, then get actual dev item if mapped
|
|
# /dev/mapper/ will usually be a symbolic link to the real /dev id
|
|
sub get_mapper {
|
|
eval $start if $b_log;
|
|
my ($item,@mapper) = @_;
|
|
my $mapped = '';
|
|
foreach (@mapper){
|
|
if ($item eq $_){
|
|
my $temp = Cwd::abs_path($_);
|
|
$mapped = $temp if $temp;
|
|
last;
|
|
}
|
|
}
|
|
$mapped ||= $item;
|
|
eval $end if $b_log;
|
|
return $mapped;
|
|
}
|
|
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 be empty, if so, then try mount
|
|
if (!$path && (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;
|
|
}
|
|
}
|
|
|
|
## ProcessData
|
|
{
|
|
package ProcessData;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (@processes,@rows);
|
|
if ($show{'ps-cpu'}){
|
|
@rows = cpu_processes();
|
|
@processes = (@processes,@rows);
|
|
}
|
|
if ($show{'ps-mem'}){
|
|
@rows = mem_processes();
|
|
@processes = (@processes,@rows);
|
|
}
|
|
return @processes;
|
|
eval $end if $b_log;
|
|
}
|
|
sub cpu_processes {
|
|
eval $start if $b_log;
|
|
my ($j,$num,$cpu,$cpu_mem,$mem) = (0,0,'','','');
|
|
my (@processes);
|
|
my $count = ($b_irc)? 5: $ps_count;
|
|
my @rows = sort {
|
|
my @a = split(/\s+/,$a);
|
|
my @b = split(/\s+/,$b);
|
|
$b[2] <=> $a[2] } @ps_aux;
|
|
# if there's a count limit, for irc, etc, only use that much of the data
|
|
@rows = splice @rows,0,$count;
|
|
|
|
$j = scalar @rows;
|
|
# $cpu_mem = ' - Memory: MiB / % used' if $extra > 0;
|
|
my $throttled = throttled($ps_count,$count,$j);
|
|
#my $header = "CPU % used - Command - pid$cpu_mem - top";
|
|
#my $header = "Top $count by CPU";
|
|
my @data = ({
|
|
main::key($num++,'CPU top') => "$count$throttled",
|
|
},);
|
|
@processes = (@processes,@data);
|
|
my $i = 1;
|
|
foreach (@rows){
|
|
$num = 1;
|
|
$j = scalar @processes;
|
|
my @row = split /\s+/, $_;
|
|
my @command = process_starter(scalar @row, $row[10],$row[11]);
|
|
@data = ({
|
|
main::key($num++,$i++) => '',
|
|
main::key($num++,'cpu') => $row[2] . '%',
|
|
main::key($num++,'command') => $command[0],
|
|
},);
|
|
@processes = (@processes,@data);
|
|
if ($command[1]) {
|
|
$processes[$j]{main::key($num++,'started by')} = $command[1];
|
|
}
|
|
$processes[$j]{main::key($num++,'pid')} = $row[1];
|
|
if ($extra > 0){
|
|
my $decimals = ($row[5]/1024 > 10 ) ? 1 : 2;
|
|
$mem = (defined $row[5]) ? sprintf( "%.${decimals}f", $row[5]/1024 ) . ' MiB' : 'N/A';
|
|
$mem .= ' (' . $row[3] . '%)';
|
|
$processes[$j]{main::key($num++,'mem')} = $mem;
|
|
}
|
|
#print Data::Dumper::Dumper \@processes, "i: $i; j: $j ";
|
|
}
|
|
eval $end if $b_log;
|
|
return @processes;
|
|
}
|
|
sub mem_processes {
|
|
eval $start if $b_log;
|
|
my ($j,$num,$cpu,$cpu_mem,$mem) = (0,0,'','','');
|
|
my (@data,@processes,$memory);
|
|
my $count = ($b_irc)? 5: $ps_count;
|
|
my @rows = sort {
|
|
my @a = split(/\s+/,$a);
|
|
my @b = split(/\s+/,$b);
|
|
$b[5] <=> $a[5] } @ps_aux;
|
|
@rows = splice @rows,0,$count;
|
|
#print Data::Dumper::Dumper \@rows;
|
|
@processes = main::memory_data_full('process') if !$b_mem;
|
|
$j = scalar @rows;
|
|
my $throttled = throttled($ps_count,$count,$j);
|
|
#$cpu_mem = ' - CPU: % used' if $extra > 0;
|
|
#my $header = "Memory MiB/% used - Command - pid$cpu_mem - top";
|
|
#my $header = "Top $count by Memory";
|
|
@data = ({
|
|
main::key($num++,'Memory top') => "$count$throttled",
|
|
},);
|
|
@processes = (@processes,@data);
|
|
my $i = 1;
|
|
foreach (@rows){
|
|
$num = 1;
|
|
$j = scalar @processes;
|
|
my @row = split /\s+/, $_;
|
|
my $decimals = ($row[5]/1024 > 10 ) ? 1 : 2;
|
|
$mem = ($row[5]) ? sprintf( "%.${decimals}f", $row[5]/1024 ) . ' MiB' : 'N/A';
|
|
my @command = process_starter(scalar @row, $row[10],$row[11]);
|
|
$mem .= " (" . $row[3] . "%)";
|
|
@data = ({
|
|
main::key($num++,$i++) => '',
|
|
main::key($num++,'mem') => $mem,
|
|
main::key($num++,'command') => $command[0],
|
|
},);
|
|
@processes = (@processes,@data);
|
|
if ($command[1]) {
|
|
$processes[$j]{main::key($num++,'started by')} = $command[1];
|
|
}
|
|
$processes[$j]{main::key($num++,'pid')} = $row[1];
|
|
if ($extra > 0){
|
|
$cpu = $row[2] . '%';
|
|
$processes[$j]{main::key($num++,'cpu')} = $cpu;
|
|
}
|
|
#print Data::Dumper::Dumper \@processes, "i: $i; j: $j ";
|
|
}
|
|
eval $end if $b_log;
|
|
return @processes;
|
|
}
|
|
sub process_starter {
|
|
my ($count, $row10, $row11) = @_;
|
|
my (@return);
|
|
# note: [migration/0] would clear with a simple basename
|
|
if ($count > 11 && $row11 =~ /^\//){
|
|
$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)";
|
|
}
|
|
elsif ($count < $ps_count){
|
|
$throttled = " (throttled from $ps_count)";
|
|
}
|
|
return $throttled;
|
|
}
|
|
}
|
|
|
|
## RaidData
|
|
{
|
|
package RaidData;
|
|
# debugger switches
|
|
my ($b_md,$b_zfs) = (0,0);
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (@rows,$key1,$val1);
|
|
my $num = 0;
|
|
raid_data() if !$b_raid;
|
|
#print 'get: ', Data::Dumper::Dumper \@raid;
|
|
if (!@raid){
|
|
if ($show{'raid-forced'}){
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('raid-data');
|
|
}
|
|
}
|
|
else {
|
|
@rows = create_output();
|
|
}
|
|
if (!@rows && $key1){
|
|
@rows = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
eval $end if $b_log;
|
|
($b_md,$b_zfs) = undef;
|
|
return @rows;
|
|
}
|
|
sub create_output {
|
|
eval $start if $b_log;
|
|
my (@arrays,@arrays_holder,@components,@components_good,@data,@failed,@rows,
|
|
@sizes,@spare,@temp);
|
|
my ($allocated,$available,$blocks_avail,$chunk_raid,$component_string,$raid,
|
|
$ref2,$ref3,$report_size,$size,$status);
|
|
my ($b_row_1_sizes);
|
|
my ($i,$j,$num,$status_id) = (0,0,0,0);
|
|
#print Data::Dumper::Dumper \@raid;
|
|
if ($extra > 2 && $raid[0]{'system-supported'}){
|
|
@data = ({
|
|
main::key($num++,'Supported md-raid types') => $raid[0]{'system-supported'},
|
|
});
|
|
@rows = (@rows,@data);
|
|
}
|
|
foreach my $ref (@raid){
|
|
$j = scalar @rows;
|
|
my %row = %$ref;
|
|
$b_row_1_sizes = 0;
|
|
next if !%row;
|
|
$num = 1;
|
|
@data = ({
|
|
main::key($num++,'Device') => $row{'id'},
|
|
main::key($num++,'type') => $row{'type'},
|
|
main::key($num++,'status') => $row{'status'},
|
|
});
|
|
@rows = (@rows,@data);
|
|
if ($row{'type'} eq 'mdraid'){
|
|
$blocks_avail = 'blocks';
|
|
$chunk_raid = 'chunk size';
|
|
$report_size = 'report';
|
|
if ($extra > 0){
|
|
$available = ($row{'blocks'}) ? $row{'blocks'} : 'N/A';
|
|
}
|
|
$size = ($row{'report'}) ? $row{'report'}: '';
|
|
$size .= " $row{'u-data'}" if $size;
|
|
$size ||= 'N/A';
|
|
$status_id = 2;
|
|
}
|
|
else {
|
|
$blocks_avail = 'free';
|
|
$chunk_raid = 'allocated';
|
|
$report_size = 'size';
|
|
@sizes = ($row{'size'}) ? main::get_size($row{'size'}) : ();
|
|
$size = (@sizes) ? "$sizes[0] $sizes[1]" : '';
|
|
@sizes = ($row{'free'}) ? main::get_size($row{'free'}) : ();
|
|
$available = (@sizes) ? "$sizes[0] $sizes[1]" : '';
|
|
if ($extra > 2){
|
|
@sizes = ($row{'allocated'}) ? main::get_size($row{'allocated'}) : ();
|
|
$allocated = (@sizes) ? "$sizes[0] $sizes[1]" : '';
|
|
}
|
|
$status_id = 1;
|
|
}
|
|
$ref2 = $row{'arrays'};
|
|
@arrays = @$ref2;
|
|
@arrays = grep {defined $_} @arrays;
|
|
@arrays_holder = @arrays;
|
|
if (($row{'type'} eq 'mdraid' && $extra == 0 ) || !defined $arrays[0]{'raid'} ){
|
|
$raid = (defined $arrays[0]{'raid'}) ? $arrays[0]{'raid'}: 'no-raid';
|
|
$rows[$j]{main::key($num++,'raid')} = $raid;
|
|
}
|
|
if ( ( $row{'type'} eq 'zfs' || ($row{'type'} eq 'mdraid' && $extra == 0 ) ) && $size){
|
|
#print "here 0\n";
|
|
$rows[$j]{main::key($num++,$report_size)} = $size;
|
|
$size = '';
|
|
$b_row_1_sizes = 1;
|
|
}
|
|
if ( $row{'type'} eq 'zfs' && $available){
|
|
$rows[$j]{main::key($num++,$blocks_avail)} = $available;
|
|
$available = '';
|
|
$b_row_1_sizes = 1;
|
|
}
|
|
if ( $row{'type'} eq 'zfs' && $allocated){
|
|
$rows[$j]{main::key($num++,$chunk_raid)} = $allocated;
|
|
$allocated = '';
|
|
}
|
|
$i = 0;
|
|
my $count = scalar @arrays;
|
|
foreach $ref3 (@arrays){
|
|
my %row2 = %$ref3;
|
|
if ($count > 1){
|
|
$j = scalar @rows;
|
|
$num = 1;
|
|
@sizes = ($row2{'size'}) ? main::get_size($row2{'size'}) : ();
|
|
$size = (@sizes) ? "$sizes[0] $sizes[1]" : 'N/A';
|
|
@sizes = ($row2{'free'}) ? main::get_size($row2{'free'}) : ();
|
|
$available = (@sizes) ? "$sizes[0] $sizes[1]" : '';
|
|
$raid = (defined $row2{'raid'}) ? $row2{'raid'}: 'no-raid';
|
|
$status = ($row2{'status'}) ? $row2{'status'}: 'N/A';
|
|
@data = ({
|
|
main::key($num++,'array') => $raid,
|
|
main::key($num++,'status') => $status,
|
|
main::key($num++,'size') => $size,
|
|
main::key($num++,'free') => $available,
|
|
});
|
|
@rows = (@rows,@data);
|
|
}
|
|
# items like cache may have one component, with a size on that component
|
|
elsif (!$b_row_1_sizes && $row{'type'} eq 'zfs'){
|
|
#print "here $count\n";
|
|
@sizes = ($row2{'size'}) ? main::get_size($row2{'size'}) : ();
|
|
$size = (@sizes) ? "$sizes[0] $sizes[1]" : '';
|
|
@sizes = ($row2{'free'}) ? main::get_size($row2{'free'}) : ();
|
|
$available = (@sizes) ? "$sizes[0] $sizes[1]" : '';
|
|
$rows[$j]{main::key($num++,'size')} = $size;
|
|
$rows[$j]{main::key($num++,'free')} = $available;
|
|
if ($extra > 2){
|
|
@sizes = ($row{'allocated'}) ? main::get_size($row2{'allocated'}) : ();
|
|
$allocated = (@sizes) ? "$sizes[0] $sizes[1]" : '';
|
|
if ($allocated){
|
|
$rows[$j]{main::key($num++,$chunk_raid)} = $allocated;
|
|
}
|
|
}
|
|
}
|
|
$ref3 = $row2{'components'};
|
|
@components = (ref $ref3 eq 'ARRAY') ? @$ref3 : ();
|
|
@failed = ();
|
|
@spare = ();
|
|
@components_good = ();
|
|
# @spare = split(/\s+/, $row{'unused'}) if $row{'unused'};
|
|
foreach my $item (@components){
|
|
@temp = split /~/, $item;
|
|
if (defined $temp[$status_id] && $temp[$status_id] =~ /^(F|DEGRADED|FAULTED|UNAVAIL)$/){
|
|
$temp[0] = "$temp[0]~$temp[1]" if $status_id == 2;
|
|
push @failed, $temp[0];
|
|
}
|
|
elsif (defined $temp[$status_id] && $temp[$status_id] =~ /(S|OFFLINE)$/){
|
|
$temp[0] = "$temp[0]~$temp[1]" if $status_id == 2;
|
|
push @spare, $temp[0];
|
|
}
|
|
else {
|
|
$temp[0] = ($status_id == 2) ? "$temp[0]~$temp[1]" : $temp[0];
|
|
push @components_good, $temp[0];
|
|
}
|
|
}
|
|
$component_string = (@components_good) ? join ' ', @components_good : 'N/A';
|
|
$rows[$j]{main::key($num++,'Components')} = '';
|
|
$rows[$j]{main::key($num++,'online')} = $component_string;
|
|
if (@failed){
|
|
$rows[$j]{main::key($num++,'FAILED')} = join ' ', @failed;
|
|
}
|
|
if (@spare){
|
|
$rows[$j]{main::key($num++,'spare')} = join ' ', @spare;
|
|
}
|
|
if ($row{'type'} eq 'mdraid' && $extra > 0 ){
|
|
$j = scalar @rows;
|
|
$num = 1;
|
|
#print Data::Dumper::Dumper \@arrays_holder;
|
|
$rows[$j]{main::key($num++,'Info')} = '';
|
|
$raid = (defined $arrays_holder[0]{'raid'}) ? $arrays_holder[0]{'raid'}: 'no-raid';
|
|
$rows[$j]{main::key($num++,'raid')} = $raid;
|
|
$rows[$j]{main::key($num++,$blocks_avail)} = $available;
|
|
if ($size){
|
|
$rows[$j]{main::key($num++,$report_size)} = $size;
|
|
}
|
|
my $chunk = ($row{'chunk-size'}) ? $row{'chunk-size'}: 'N/A';
|
|
$rows[$j]{main::key($num++,$chunk_raid)} = $chunk;
|
|
if ($extra > 1){
|
|
if ($row{'bitmap'}){
|
|
$rows[$j]{main::key($num++,'bitmap')} = $row{'bitmap'};
|
|
}
|
|
if ($row{'super-block'}){
|
|
$rows[$j]{main::key($num++,'super blocks')} = $row{'super-block'};
|
|
}
|
|
if ($row{'algorithm'}){
|
|
$rows[$j]{main::key($num++,'algorithm')} = $row{'algorithm'};
|
|
}
|
|
}
|
|
}
|
|
$i++;
|
|
}
|
|
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++,'Recovering')} = $percent;
|
|
my $finish = ($row{'recovery-finish'})?$row{'recovery-finish'} : 'N/A';
|
|
$rows[$j]{main::key($num++,'time remaining')} = $finish;
|
|
if ($extra > 0){
|
|
if ($row{'sectors-recovered'}){
|
|
$rows[$j]{main::key($num++,'sectors')} = $row{'sectors-recovered'};
|
|
}
|
|
}
|
|
if ($extra > 1 && $row{'recovery-speed'}){
|
|
$rows[$j]{main::key($num++,'speed')} = $row{'recovery-speed'};
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
#print Data::Dumper::Dumper \@rows;
|
|
return @rows;
|
|
}
|
|
sub raid_data {
|
|
eval $start if $b_log;
|
|
my (@data);
|
|
$b_raid = 1;
|
|
if ($b_md || (my $file = main::system_files('mdstat') )){
|
|
@data = mdraid_data($file);
|
|
@raid = (@raid,@data) if @data;
|
|
}
|
|
if ($b_zfs || (my $path = main::check_program('zpool') )){
|
|
@data = zfs_data($path);
|
|
@raid = (@raid,@data) if @data;
|
|
}
|
|
main::log_data('dump','@raid',\@raid) if $b_log;
|
|
#print Data::Dumper::Dumper \@raid;
|
|
eval $end if $b_log;
|
|
}
|
|
sub mdraid_data {
|
|
eval $start if $b_log;
|
|
my ($mdstat) = @_;
|
|
my $j = 0;
|
|
#$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-4-device-1.txt";
|
|
#$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-rebuild-1.txt";
|
|
#$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-2-mirror-fserver2-1.txt";
|
|
#$mdstat = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/md-2-raid10-abucodonosor.txt";
|
|
my @working = main::reader($mdstat,'strip');
|
|
#print Data::Dumper::Dumper \@working;
|
|
my (@data,@mdraid,@temp,$b_found,$system,$unused);
|
|
# NOTE: a system with empty mdstat will still 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] =~ /^used\sdevices/){
|
|
$unused = ( split /:\s*/, $working[0])[1];
|
|
$unused =~ s/<|>|none//g if $unused;
|
|
pop @working;
|
|
}
|
|
foreach (@working){
|
|
$_ =~ s/\s*:\s*/:/;
|
|
# print "$_\n";
|
|
#md126 : active (auto-read-only) raid1 sdq1[0]
|
|
if (/^(md[0-9]+)\s*:\s*([^\s]+)(\s\([^)]+\))?\s([^\s]+)\s(.*)/){
|
|
my $id = $1;
|
|
my $status = $2;
|
|
my $raid = $4;
|
|
my $component_string = $5;
|
|
@temp = ();
|
|
$raid =~ s/^raid1$/mirror/;
|
|
$raid =~ s/^raid/raid-/;
|
|
$raid = 'mirror' if $raid eq '1';
|
|
# remember, these include the [x] id, so remove that for disk/unmounted
|
|
my @components = split /\s+/, $component_string;
|
|
foreach my $component (@components){
|
|
$component =~ /([\S]+)\[([0-9]+)\]\(?([SF])?\)?/;
|
|
my $string = "$1~";
|
|
$string .= (defined $2) ? "c$2" : '';
|
|
$string .= (defined $3) ? "~$3" : '';
|
|
push @temp, $string;
|
|
}
|
|
@components = @temp;
|
|
#print "$component_string\n";
|
|
$j = scalar @mdraid;
|
|
@data = ({
|
|
'id' => $id,
|
|
'arrays' => ([],),
|
|
'status' => $status,
|
|
'type' => 'mdraid',
|
|
});
|
|
@mdraid = (@mdraid,@data);
|
|
$mdraid[$j]{'arrays'}[0]{'raid'} = $raid;
|
|
$mdraid[$j]{'arrays'}[0]{'components'} = \@components;
|
|
}
|
|
#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]{'system-supported'} = $system if $system;
|
|
$mdraid[0]{'unused'} = $unused if $unused;
|
|
}
|
|
#print Data::Dumper::Dumper \@mdraid;
|
|
eval $end if $b_log;
|
|
return @mdraid;
|
|
}
|
|
|
|
sub zfs_data {
|
|
eval $start if $b_log;
|
|
my ($zpool) = @_;
|
|
my (@components,@data,@zfs);
|
|
my ($allocated,$free,$ref,$size,$status);
|
|
my $b_v = 1;
|
|
my ($i,$j,$k) = (0,0,0);
|
|
#my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-list-1-mirror-main-solestar.txt";
|
|
#my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-list-2-mirror-main-solestar.txt";
|
|
#my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-list-v-tank-1.txt";
|
|
#my @working = main::reader($file);$zpool = '';
|
|
my @working = main::grabber("$zpool list -v 2>/dev/null");
|
|
DiskData::set_glabel() if $bsd_type && !$b_glabel;
|
|
# bsd sed does not support inserting a true \n so use this trick
|
|
# some zfs does not have -v
|
|
if (!@working){
|
|
@working = main::grabber("$zpool list 2>/dev/null");
|
|
$b_v = 0;
|
|
}
|
|
#print Data::Dumper::Dumper \@working;
|
|
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]): '';
|
|
$status = (defined $row[$status_i] && $row[$status_i] ne '') ? $row[$status_i]: 'no-status';
|
|
$j = scalar @zfs;
|
|
@data = ({
|
|
'id' => $row[0],
|
|
'allocated' => $allocated,
|
|
'arrays' => ([],),
|
|
'free' => $free,
|
|
'size' => $size,
|
|
'status' => $status,
|
|
'type' => 'zfs',
|
|
});
|
|
@zfs = (@zfs,@data);
|
|
}
|
|
#print Data::Dumper::Dumper \@zfs;
|
|
# raid level is the second item in the output, unless it is not, sometimes it is absent
|
|
if ($row[1] =~ /raid|mirror/){
|
|
$row[1] =~ s/^raid1/mirror/;
|
|
#$row[1] =~ s/^raid/raid-/; # need to match in zpool status <device>
|
|
$ref = $zfs[$j]{'arrays'};
|
|
$k = scalar @$ref;
|
|
$zfs[$j]{'arrays'}[$k]{'raid'} = $row[1];
|
|
$i = 0;
|
|
$zfs[$j]{'arrays'}[$k]{'size'} = ($row[2] && $row[2] ne '-') ? main::translate_size($row[2]) : '';
|
|
$zfs[$j]{'arrays'}[$k]{'allocated'} = ($row[3] && $row[3] ne '-') ? main::translate_size($row[3]) : '';
|
|
$zfs[$j]{'arrays'}[$k]{'free'} = ($row[4] && $row[4] ne '-') ? main::translate_size($row[4]) : '';
|
|
}
|
|
# https://blogs.oracle.com/eschrock/entry/zfs_hot_spares
|
|
elsif ($row[1] =~ /spares/){
|
|
next;
|
|
}
|
|
# the first is a member of a raid array
|
|
# ada2 - - - - - -
|
|
# this second is a single device not in an array
|
|
# ada0s2 25.9G 14.6G 11.3G - 0% 56%
|
|
# gptid/3838f796-5c46-11e6-a931-d05099ac4dc2 - - - - - -
|
|
elsif ($row[1] =~ /^([a-z0-9]+[0-9]+|([\S]+)\/.*)$/ &&
|
|
($row[2] eq '-' || $row[2] =~ /^[0-9\.]+[MGTP]$/ )){
|
|
$row[1] =~ /^([a-z0-9]+[0-9]+|([\S]+)\/.*)\s*(DEGRADED|FAULTED|OFFLINE)?$/;
|
|
my $working = $1;
|
|
my $state = ($3) ? $3 : '';
|
|
if ($working =~ /[\S]+\// && @glabel){
|
|
$working = DiskData::match_glabel($working);
|
|
}
|
|
# kind of a hack, things like cache may not show size/free
|
|
# data since they have no array row, but they might show it in
|
|
# component row:
|
|
# ada0s2 25.9G 19.6G 6.25G - 0% 75%
|
|
if (!$zfs[$j]{'size'} && $row[2] && $row[2] ne '-') {
|
|
$size = ($row[2])? main::translate_size($row[2]): '';
|
|
$zfs[$j]{'arrays'}[$k]{'size'} = $size;
|
|
}
|
|
if (!$zfs[$j]{'allocated'} && $row[3] && $row[3] ne '-') {
|
|
$allocated = ($row[3])? main::translate_size($row[3]): '';
|
|
$zfs[$j]{'arrays'}[$k]{'allocated'} = $allocated;
|
|
}
|
|
if (!$zfs[$j]{'free'} && $row[4] && $row[4] ne '-') {
|
|
$free = ($row[4])? main::translate_size($row[4]): '';
|
|
$zfs[$j]{'arrays'}[$k]{'free'} = $free;
|
|
}
|
|
$zfs[$j]{'arrays'}[$k]{'components'}[$i] = $working . '~' . $state;
|
|
$i++;
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \@zfs;
|
|
# clear out undefined arrrays values
|
|
$j = 0;
|
|
foreach $ref (@zfs){
|
|
my %row = %$ref;
|
|
my $ref2 = $row{'arrays'};
|
|
my @arrays = (ref $ref2 eq 'ARRAY' ) ? @$ref2 : ();
|
|
@arrays = grep {defined $_} @arrays;
|
|
$zfs[$j]{'arrays'} = \@arrays;
|
|
$j++;
|
|
}
|
|
@zfs = zfs_status($zpool,@zfs);
|
|
# print Data::Dumper::Dumper \@zfs;
|
|
eval $end if $b_log;
|
|
return @zfs;
|
|
}
|
|
sub zfs_status {
|
|
eval $start if $b_log;
|
|
my ($zpool,@zfs) = @_;
|
|
my ($cmd,$status,$file,$raid,@arrays,@pool_status,@temp);
|
|
my ($i,$j,$k,$l) = (0,0,0,0);
|
|
foreach my $ref (@zfs){
|
|
my %row = %$ref;
|
|
$i = 0;
|
|
$k = 0;
|
|
#$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-status-1-mirror-main-solestar.txt";
|
|
#$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-status-2-mirror-main-solestar.txt";
|
|
#$file = "$ENV{'HOME'}/bin/scripts/inxi/data/raid/zpool-status-tank-1.txt";
|
|
#@pool_status = main::reader($file,'strip');
|
|
$cmd = "$zpool status $row{'id'} 2>/dev/null";
|
|
@pool_status = main::grabber($cmd,"\n",'strip');
|
|
main::log_data('cmd',$cmd) if $b_log;
|
|
my $ref2 = $row{'arrays'};
|
|
@arrays = (ref $ref2 eq 'ARRAY' ) ? @$ref2 : ();
|
|
#print "$row{'id'} rs:$row{'status'}\n";
|
|
$status = ($row{'status'} && $row{'status'} eq 'no-status') ? check_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 (@arrays){
|
|
#print 'ref: ', ref $array, "\n";
|
|
#next if ref $array ne 'HASH';
|
|
my %row2 = %$array;
|
|
my $ref3 = $row2{'components'};
|
|
my @components = (ref $ref3 eq 'ARRAY') ? @$ref3 : ();
|
|
$l = 0;
|
|
# zpool status: mirror-0 ONLINE 2 0 0
|
|
$raid = ($row2{'raid'}) ? "$row2{'raid'}-$i": $row2{'raid'};
|
|
$status = ($raid) ? check_status($raid,@pool_status): '';
|
|
$zfs[$j]{'arrays'}[$k]{'status'} = $status;
|
|
#print "$raid i:$i j:$j k:$k $status\n";
|
|
foreach my $component (@components){
|
|
my @temp = split /~/, $component;
|
|
$status = ($temp[0]) ? check_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
|
|
$i++ if $row2{'raid'}; # && $row2{'raid'} eq 'mirror';
|
|
}
|
|
$j++;
|
|
}
|
|
eval $end if $b_log;
|
|
return @zfs;
|
|
}
|
|
sub check_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;
|
|
}
|
|
}
|
|
|
|
## RamData
|
|
{
|
|
package RamData;
|
|
|
|
sub get {
|
|
my (@data,@rows,$key1,@ram,$val1);
|
|
my $num = 0;
|
|
my $ref = $alerts{'dmidecode'};
|
|
@rows = main::memory_data_full('ram') if !$b_mem;
|
|
if ( $$ref{'action'} ne 'use'){
|
|
$key1 = $$ref{'action'};
|
|
$val1 = $$ref{$key1};
|
|
@data = ({
|
|
main::key($num++,'RAM Report') => '',
|
|
main::key($num++,$key1) => $val1,
|
|
});
|
|
@rows = (@rows,@data);
|
|
}
|
|
else {
|
|
@ram = dmidecode_data();
|
|
if (@ram){
|
|
@data = create_output(@ram);
|
|
}
|
|
else {
|
|
$key1 = 'message';
|
|
$val1 = main::row_defaults('ram-data');
|
|
@data = ({
|
|
main::key($num++,'RAM Report') => '',
|
|
main::key($num++,$key1) => $val1,
|
|
});
|
|
}
|
|
@rows = (@rows,@data);
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
|
|
sub create_output {
|
|
eval $start if $b_log;
|
|
my (@ram) = @_;
|
|
return if !@ram;
|
|
my $num = 0;
|
|
my $j = 0;
|
|
my (@data,@rows);
|
|
foreach (@ram){
|
|
$j = scalar @rows;
|
|
my %ref = %$_;
|
|
$num = 1;
|
|
@data = ({
|
|
main::key($num++,'Array') => '',
|
|
main::key($num++,'capacity') => process_size($ref{'capacity'}),
|
|
});
|
|
@rows = (@rows,@data);
|
|
if ($ref{'cap-qualifier'}){
|
|
$rows[$j]{main::key($num++,'note')} = $ref{'cap-qualifier'};
|
|
}
|
|
$rows[$j]{main::key($num++,'slots')} = $ref{'slots'};
|
|
$rows[$j]{main::key($num++,'EC')} = $ref{'eec'};
|
|
if ($extra > 0 ){
|
|
$rows[$j]{main::key($num++,'max module size')} = process_size($ref{'max-module-size'});
|
|
if ($ref{'mod-qualifier'}){
|
|
$rows[$j]{main::key($num++,'note')} = $ref{'mod-qualifier'};
|
|
}
|
|
}
|
|
foreach my $ref2 ($ref{'modules'}){
|
|
my @modules = @$ref2;
|
|
# print Data::Dumper::Dumper \@modules;
|
|
foreach my $ref3 ( @modules){
|
|
$num = 1;
|
|
$j = scalar @rows;
|
|
# multi array setups will start index at next from previous array
|
|
next if ref $ref3 ne 'HASH';
|
|
my %mod = %$ref3;
|
|
$mod{'locator'} ||= 'N/A';
|
|
@data = ({
|
|
main::key($num++,'Device') => $mod{'locator'},
|
|
main::key($num++,'size') => process_size($mod{'size'}),
|
|
});
|
|
@rows = (@rows,@data);
|
|
next if ($mod{'size'} =~ /\D/);
|
|
if ($extra > 1 && $mod{'type'} ){
|
|
$rows[$j]{main::key($num++,'info')} = $mod{'type'};
|
|
}
|
|
$rows[$j]{main::key($num++,'speed')} = $mod{'speed'};
|
|
if ($extra > 0 ){
|
|
$mod{'device-type'} ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'type')} = $mod{'device-type'};
|
|
if ($extra > 2 && $mod{'device-type'} ne 'N/A'){
|
|
$mod{'device-type-detail'} ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'detail')} = $mod{'device-type-detail'};
|
|
}
|
|
}
|
|
if ($extra > 2 ){
|
|
$mod{'data-width'} ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'bus width')} = $mod{'data-width'};
|
|
$mod{'total-width'} ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'total')} = $mod{'total-width'};
|
|
}
|
|
if ($extra > 1 ){
|
|
$mod{'manufacturer'} ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'manufacturer')} = $mod{'manufacturer'};
|
|
$mod{'part-number'} ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'part-no')} = $mod{'part-number'};
|
|
}
|
|
if ($extra > 2 ){
|
|
$mod{'serial'} = main::apply_filter($mod{'serial'});
|
|
$rows[$j]{main::key($num++,'serial')} = $mod{'serial'};
|
|
}
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
|
|
sub dmidecode_data {
|
|
eval $start if $b_log;
|
|
my ($b_5,$handle,@ram,@temp);
|
|
my ($derived_module_size,$max_cap_5,$max_cap_16,$max_module_size) = (0,0,0,0);
|
|
my ($i,$j,$k) = (0,0,0);
|
|
foreach (@dmi){
|
|
my @ref = @$_;
|
|
# Portable Battery
|
|
if ($ref[0] == 5){
|
|
$ram[$k] = ({}) if !$ram[$k];
|
|
foreach my $item (@ref){
|
|
@temp = split /:\s*/, $item;
|
|
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.*$//;
|
|
$ram[$k]{'voltage'} = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Associated Memory Slots'){
|
|
$ram[$k]{'slots-5'} = $temp[1];
|
|
}
|
|
}
|
|
$ram[$k]{'modules'} = ([],);
|
|
#print Data::Dumper::Dumper \@ram;
|
|
$b_5 = 1;
|
|
}
|
|
elsif ($ref[0] == 6){
|
|
my ($size,$speed,$type) = (0,0,0);
|
|
foreach my $item (@ref){
|
|
@temp = split /:\s*/, $item;
|
|
next if ! $temp[1];
|
|
if ($temp[0] eq 'Installed Size'){
|
|
# get module size
|
|
|
|
$size = calculate_size($temp[1],0);
|
|
# get data after module size
|
|
$temp[1] =~ s/ Connection\)?//;
|
|
$temp[1] =~ s/^[0-9]+\s*[MGTP]B\s*\(?//;
|
|
$type = lc($temp[1]);
|
|
}
|
|
elsif ($temp[0] eq 'Current Speed'){
|
|
$speed = $temp[1];
|
|
}
|
|
}
|
|
$ram[$k]{'modules'}[$j] = ({
|
|
'size' => $size,
|
|
'speed-ns' => $speed,
|
|
'type' => $type,
|
|
});
|
|
#print Data::Dumper::Dumper \@ram;
|
|
$j++;
|
|
}
|
|
elsif ($ref[0] == 16){
|
|
$handle = $ref[1];
|
|
$ram[$handle] = $ram[$k] if $ram[$k];
|
|
$ram[$k] = undef;
|
|
$ram[$handle] = ({}) if !$ram[$handle];
|
|
foreach my $item (@ref){
|
|
@temp = split /:\s*/, $item;
|
|
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 set_dmidecode_data, 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 ($ref[0] == 17){
|
|
my ($bank_locator,$configured_clock_speed,$data_width) = ('','','');
|
|
my ($device_type,$device_type_detail,$form_factor,$locator,$main_locator) = ('','','','','');
|
|
my ($manufacturer,$part_number,$serial,$speed,$total_width) = ('','','','','');
|
|
my ($device_size,$i_data,$i_total,$working_size) = (0,0,0,0);
|
|
foreach my $item (@ref){
|
|
@temp = split /:\s*/, $item;
|
|
next if ! $temp[1];
|
|
if ($temp[0] eq 'Array Handle'){
|
|
$handle = hex($temp[1]);
|
|
}
|
|
elsif ($temp[0] eq 'Data Width'){
|
|
$data_width = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Total Width'){
|
|
$total_width = $temp[1];
|
|
}
|
|
# 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*[MTPG]B/ ) {
|
|
$derived_module_size = calculate_size($temp[1],$derived_module_size);
|
|
$working_size = calculate_size($temp[1],0);
|
|
$device_size = $working_size;
|
|
}
|
|
else {
|
|
$device_size = $temp[1];
|
|
}
|
|
}
|
|
elsif ($temp[0] eq 'Locator'){
|
|
$temp[1] =~ s/RAM slot #/Slot/;
|
|
$locator = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Bank Locator'){
|
|
$bank_locator = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Form Factor'){
|
|
$form_factor = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Type'){
|
|
$device_type = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Type Detail'){
|
|
$device_type_detail = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Speed'){
|
|
$speed = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Configured Clock Speed'){
|
|
$configured_clock_speed = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Manufacturer'){
|
|
$temp[1] = main::dmi_cleaner($temp[1]);
|
|
$manufacturer = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Part Number'){
|
|
$temp[1] =~ s/(^[0]+$||.*Module.*|Undefined.*|PartNum.*|\[Empty\]|^To be filled.*)//g;
|
|
$part_number = $temp[1];
|
|
}
|
|
elsif ($temp[0] eq 'Serial Number'){
|
|
$temp[1] =~ s/(^[0]+$|Undefined.*|SerNum.*|\[Empty\]|^To be filled.*)//g;
|
|
$serial = $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;
|
|
}
|
|
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;
|
|
}
|
|
$ram[$handle]{'derived-module-size'} = $derived_module_size;
|
|
$ram[$handle]{'modules'}[$i]{'configured-clock-speed'} = $configured_clock_speed;
|
|
$ram[$handle]{'modules'}[$i]{'data-width'} = $data_width;
|
|
$ram[$handle]{'modules'}[$i]{'size'} = $device_size;
|
|
$ram[$handle]{'modules'}[$i]{'device-type'} = $device_type;
|
|
$ram[$handle]{'modules'}[$i]{'device-type-detail'} = lc($device_type_detail);
|
|
$ram[$handle]{'modules'}[$i]{'form-factor'} = $form_factor;
|
|
$ram[$handle]{'modules'}[$i]{'locator'} = $main_locator;
|
|
$ram[$handle]{'modules'}[$i]{'manufacturer'} = $manufacturer;
|
|
$ram[$handle]{'modules'}[$i]{'part-number'} = $part_number;
|
|
$ram[$handle]{'modules'}[$i]{'serial'} = $serial;
|
|
$ram[$handle]{'modules'}[$i]{'speed'} = $speed;
|
|
$ram[$handle]{'modules'}[$i]{'total-width'} = $total_width;
|
|
$i++
|
|
}
|
|
elsif ($ref[0] < 17 ){
|
|
next;
|
|
}
|
|
elsif ($ref[0] > 17 ){
|
|
last;
|
|
}
|
|
}
|
|
@ram = data_processor(@ram) if @ram;
|
|
main::log_data('dump','@ram',\@ram) if $b_log;
|
|
# print Data::Dumper::Dumper \@ram;
|
|
eval $end if $b_log;
|
|
return @ram;
|
|
}
|
|
sub data_processor {
|
|
eval $start if $b_log;
|
|
my (@ram) = @_;
|
|
my $b_debug = 0;
|
|
my (@return,@temp);
|
|
my $est = 'est.';
|
|
|
|
foreach (@ram){
|
|
# because we use the actual array handle as the index,
|
|
# there will be many undefined keys
|
|
next if ! defined $_;
|
|
my %ref = %$_;
|
|
my ($max_cap,$max_mod_size) = (0,0);
|
|
my ($alt_cap,$est_cap,$est_mod,$unit) = (0,'','','');
|
|
$max_cap = $ref{'max-capacity-16'};
|
|
# make sure they are integers not string if empty
|
|
$ref{'slots-5'} ||= 0;
|
|
$ref{'slots-16'} ||= 0;
|
|
$ref{'max-capacity-5'} ||= 0;
|
|
$ref{'max-module-size'} ||= 0;
|
|
#$ref{'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: $ref{'max-module-size'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'used-capacity'}\n";
|
|
print "1a: s5: $ref{'slots-5'} s16: $ref{'slots-16'}\n";
|
|
}
|
|
if (!$max_cap && $ref{'max-capacity-5'}) {
|
|
$max_cap = $ref{'max-capacity-5'};
|
|
}
|
|
if ($b_debug){
|
|
print "2: mms: $ref{'max-module-size'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'used-capacity'}\n";
|
|
}
|
|
# 2: now check to see if actually found module sizes are > than listed max module, replace if >
|
|
if ( $ref{'max-module-size'} && $ref{'derived-module-size'} &&
|
|
$ref{'derived-module-size'} > $ref{'max-module-size'} ){
|
|
$ref{'max-module-size'} = $ref{'derived-module-size'};
|
|
$est_mod = $est;
|
|
}
|
|
if ($b_debug){
|
|
print "3: dcf: $ref{'device-count-found'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'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 && ($ref{'device-count-found'} || $ref{'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 ($ref{'used-capacity'} && $ref{'max-capacity-16'}){
|
|
if ($ref{'used-capacity'} > $max_cap){
|
|
if ($ref{'max-module-size'} &&
|
|
$ref{'used-capacity'} < ($ref{'slots-16'} * $ref{'max-module-size'} )){
|
|
$max_cap = $ref{'slots-16'} * $ref{'max-module-size'};
|
|
$est_cap = $est;
|
|
print "A\n" if $b_debug;
|
|
}
|
|
elsif ($ref{'derived-module-size'} &&
|
|
$ref{'used-capacity'} < ($ref{'slots-16'} * $ref{'derived-module-size'}) ){
|
|
$max_cap = $ref{'slots-16'} * $ref{'derived-module-size'};
|
|
$est_cap = $est;
|
|
print "B\n" if $b_debug;
|
|
}
|
|
else {
|
|
$max_cap = $ref{'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 ($ref{'slots-16'} > 1 && $ref{'device-count-found'} > 1 &&
|
|
$max_cap < ($ref{'derived-module-size'} * $ref{'slots-16'} ) ){
|
|
$max_cap = $ref{'derived-module-size'} * $ref{'slots-16'};
|
|
$est_cap = $est;
|
|
print "D\n" if $b_debug;
|
|
}
|
|
elsif ($ref{'device-count-found'} > 0 && $max_cap < ( $ref{'derived-module-size'} * $ref{'device-count-found'} )){
|
|
$max_cap = $ref{'derived-module-size'} * $ref{'device-count-found'};
|
|
$est_cap = $est;
|
|
print "E\n" if $b_debug;
|
|
}
|
|
## handle cases where we have type 5 data: mms x device count equals type 5 max cap
|
|
# however do not use it if cap / devices equals the derived module size
|
|
elsif ($ref{'max-module-size'} > 0 &&
|
|
($ref{'max-module-size'} * $ref{'slots-16'}) == $ref{'max-capacity-5'} &&
|
|
$ref{'max-capacity-5'} != $ref{'max-capacity-16'} &&
|
|
$ref{'derived-module-size'} != ($ref{'max-capacity-16'}/$ref{'slots-16'}) ){
|
|
$max_cap = $ref{'max-capacity-5'};
|
|
$est_cap = $est;
|
|
print "F\n" if $b_debug;
|
|
}
|
|
|
|
}
|
|
if ($b_debug){
|
|
print "4: mms: $ref{'max-module-size'} :dms: $ref{'derived-module-size'} :mc: $max_cap :uc: $ref{'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 ($ref{'max-module-size'} && $max_cap && $ref{'max-module-size'} > $max_cap){
|
|
$ref{'max-module-size'} = 0;
|
|
}
|
|
if ($b_debug){
|
|
print "5: dms: $ref{'derived-module-size'} :s16: $ref{'slots-16'} :mc: $max_cap\n";
|
|
}
|
|
|
|
# now prep for rebuilding the ram array data
|
|
if (!$ref{'max-module-size'}){
|
|
# ie: 2x4gB
|
|
if (!$est_cap && $ref{'derived-module-size'} > 0 && $max_cap > ($ref{'derived-module-size'} * $ref{'slots-16'} * 4) ){
|
|
$est_cap = 'check';
|
|
print "G\n" if $b_debug;
|
|
}
|
|
if ($max_cap && ($ref{'slots-16'} || $ref{'slots-5'})){
|
|
my $slots = 0;
|
|
if ($ref{'slots-16'} && $ref{'slots-16'} >= $ref{'slots-5'}){
|
|
$slots = $ref{'slots-16'};
|
|
}
|
|
elsif ($ref{'slots-5'} && $ref{'slots-5'} > $ref{'slots-16'}){
|
|
$slots = $ref{'slots-5'};
|
|
}
|
|
if ($ref{'derived-module-size'} * $slots > $max_cap){
|
|
$ref{'max-module-size'} = $ref{'derived-module-size'};
|
|
}
|
|
else {
|
|
$ref{'max-module-size'} = sprintf("%.f",$max_cap/$slots);
|
|
}
|
|
$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 && $ref{'max-module-size'} > 0){
|
|
if ($max_cap > ( $ref{'max-module-size'} * $ref{'slots-16'})){
|
|
$est_cap = 'check';
|
|
print "H\n" if $b_debug;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
@temp = ({
|
|
'capacity' => $max_cap,
|
|
'cap-qualifier' => $est_cap,
|
|
'eec' => $ref{'eec'},
|
|
'location' => $ref{'location'},
|
|
'max-module-size' => $ref{'max-module-size'},
|
|
'mod-qualifier' => $est_mod,
|
|
'modules' => $ref{'modules'},
|
|
'slots' => $ref{'slots-16'},
|
|
'use' => $ref{'use'},
|
|
'voltage' => $ref{'voltage'},
|
|
});
|
|
@return = (@return,@temp);
|
|
}
|
|
eval $end if $b_log;
|
|
return @return;
|
|
}
|
|
sub process_size {
|
|
my ($size) = @_;
|
|
my ($b_trim,$unit) = (0,'');
|
|
return 'N/A' if ( ! $size );
|
|
return $size if $size =~ /\D/;
|
|
if ( $size < 1024 ){
|
|
$unit='MiB';
|
|
}
|
|
elsif ( $size < 1024000 ){
|
|
$size = $size / 1024;
|
|
$unit='GiB';
|
|
$b_trim = 1;
|
|
}
|
|
elsif ( $size < 1024000000 ){
|
|
$size = $size / 1024000;
|
|
$unit='TiB';
|
|
$b_trim = 1;
|
|
}
|
|
# we only want a max 2 decimal places, and only when it's
|
|
# a unit > MB
|
|
$size = sprintf("%.2f",$size) if $b_trim;
|
|
$size =~ s/\.[0]+$//;
|
|
$size = "$size $unit";
|
|
return $size;
|
|
}
|
|
sub calculate_size {
|
|
my ($data, $size) = @_;
|
|
if ( $data =~ /^[0-9]+\s*[GMTP]B/) {
|
|
if ( $data =~ /([0-9]+)\s*GB/ ) {
|
|
$data = $1 * 1024;
|
|
}
|
|
elsif ( $data =~ /([0-9]+)\s*MB/ ) {
|
|
$data = $1;
|
|
}
|
|
elsif ( $data =~ /([0-9]+)\s*TB/ ) {
|
|
$data = $1 * 1024 * 1000;
|
|
}
|
|
elsif ( $data =~ /([0-9]+)\s*PB/ ) {
|
|
$data = $1 * 1024 * 1000 * 1000;
|
|
}
|
|
if ($data =~ /^[0-9][0-9]+$/ && $data > $size ) {
|
|
$size=$data;
|
|
}
|
|
}
|
|
else {
|
|
$size = 0;
|
|
}
|
|
return $size;
|
|
}
|
|
}
|
|
|
|
## RepoData
|
|
{
|
|
package RepoData;
|
|
|
|
# easier to keep these package global, but undef after done
|
|
my (@dbg_files,$debugger_dir);
|
|
my $num = 0;
|
|
sub get {
|
|
eval $start if $b_log;
|
|
($debugger_dir) = @_;
|
|
my (@data,@rows);
|
|
if ($bsd_type){
|
|
@rows = get_repos_bsd();
|
|
}
|
|
else {
|
|
@rows = get_repos_linux();
|
|
}
|
|
if ($debugger_dir){
|
|
@rows = @dbg_files;
|
|
undef @dbg_files;
|
|
undef $debugger_dir;
|
|
}
|
|
else {
|
|
if (!@rows){
|
|
my $pm = (!$bsd_type) ? 'package manager': 'OS type';
|
|
@data = (
|
|
{main::key($num++,'Alert') => "No repo data detected. Does $self_name support your $pm?"},
|
|
);
|
|
@rows = (@data);
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub get_repos_linux {
|
|
eval $start if $b_log;
|
|
my (@content,@data,@data2,@data3,@files,$repo,@repos,@rows);
|
|
my ($key,$path);
|
|
my $apk = '/etc/apk/repositories';
|
|
my $apt = '/etc/apt/sources.list';
|
|
my $eopkg_dir = '/var/lib/eopkg/';
|
|
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 $slackpkg = '/etc/slackpkg/mirrors';
|
|
my $slackpkg_plus = '/etc/slackpkg/slackpkgplus.conf';
|
|
my $yum_conf = '/etc/yum.conf';
|
|
my $yum_repo_dir = '/etc/yum.repos.d/';
|
|
my $zypp_repo_dir = '/etc/zypp/repos.d/';
|
|
my $b_test = 0;
|
|
# apt - debian, buntus, also sometimes some yum/rpm repos may create
|
|
# apt repos here as well
|
|
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('/etc/apt/sources.list.d/*.list');
|
|
push @files, $apt;
|
|
main::log_data('data',"apt repo files:\n" . main::joiner(\@files, "\n", 'unset') ) if $b_log;
|
|
foreach ( sort @files){
|
|
@data = repo_builder($_,'apt','^\s*deb') if -r $_;
|
|
@rows = (@rows,@data);
|
|
}
|
|
#@files = main::globber("$ENV{'HOME'}/bin/scripts/inxi/data/repo/apt/*.sources");
|
|
@files = main::globber('/etc/apt/sources.list.d/*.sources');
|
|
main::log_data('data',"apt deb822 repo files:\n" . main::joiner(\@files, "\n", 'unset') ) if $b_log;
|
|
foreach $file (@files){
|
|
@data2 = main::reader($file,'strip');
|
|
my $count = scalar @data2;
|
|
push @dbg_files, $file if $debugger_dir;
|
|
#print "$file\n";
|
|
@apt_urls = ();
|
|
@apt_working = ();
|
|
$counter = 0;
|
|
$b_apt_enabled = 1;
|
|
foreach my $row (@data2){
|
|
$counter++;
|
|
next if $row =~ /^\s*$|^\s*#/;
|
|
#print "row:$row\n";
|
|
if ($row =~ /^Types:\s*(.*)/){
|
|
my $type_holder= $1;
|
|
#print "ath:$type_holder\n";
|
|
if ($apt_types && @apt_working){
|
|
if ($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";
|
|
@apt_urls = (@apt_urls,@data3);
|
|
@data3 = ();
|
|
@apt_working = ();
|
|
$apt_arch = '';
|
|
$apt_comp = '';
|
|
$apt_suites = '';
|
|
$apt_types = '';
|
|
}
|
|
$apt_types = $type_holder;
|
|
$b_apt_enabled = 1;
|
|
}
|
|
if ($row =~ /^Enabled:\s*(.*)/){
|
|
my $status = $1;
|
|
$b_apt_enabled = ($status =~ /no/i) ? 0: 1;
|
|
}
|
|
if ($row =~ /:\//){
|
|
my $url = $row;
|
|
$url =~ s/^URIs:\s*//;
|
|
push @apt_working, $url if $url;
|
|
}
|
|
if ($row =~ /^Suites:\s*(.*)/){
|
|
$apt_suites = $1;
|
|
}
|
|
if ($row =~ /^Components:\s*(.*)/){
|
|
$apt_comp = $1;
|
|
}
|
|
if ($row =~ /^Architectures:\s*(.*)/){
|
|
$apt_arch = $1;
|
|
}
|
|
# we've hit the last line!!
|
|
if ($counter == $count && @apt_working){
|
|
#print "2: url builder\n";
|
|
if ($b_apt_enabled){
|
|
foreach $repo (@apt_working){
|
|
my $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 "s2:$string\n";
|
|
push @data3, $string;
|
|
}
|
|
}
|
|
#print join "\n",@data3,"\n";
|
|
@apt_urls = (@apt_urls,@data3);
|
|
@data3 = ();
|
|
@apt_working = ();
|
|
$apt_arch = '';
|
|
$apt_comp = '';
|
|
$apt_suites = '';
|
|
$apt_types = '';
|
|
}
|
|
}
|
|
if (@apt_urls){
|
|
$key = repo_builder('active','apt');
|
|
@apt_urls = url_cleaner(@apt_urls);
|
|
}
|
|
else {
|
|
$key = repo_builder('missing','apt');
|
|
}
|
|
@data = (
|
|
{main::key($num++,$key) => $file},
|
|
[@apt_urls],
|
|
);
|
|
@rows = (@rows,@data);
|
|
}
|
|
@files = ();
|
|
}
|
|
# pacman: Arch and derived
|
|
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);
|
|
@files = main::uniq(@files);
|
|
unshift @files, $pacman if @repos;
|
|
foreach (@files){
|
|
if (-f $_){
|
|
@data = repo_builder($_,$repo,'^\s*Server','\s*=\s*',1);
|
|
@rows = (@rows,@data);
|
|
}
|
|
else {
|
|
# set it so the debugger knows the file wasn't there
|
|
push @dbg_files, $_ if $debugger_dir;
|
|
@data = (
|
|
{main::key($num++,'File listed in') => $pacman},
|
|
[("$_ does not seem to exist.")],
|
|
);
|
|
@rows = (@rows,@data);
|
|
}
|
|
}
|
|
if (!@rows){
|
|
@data = (
|
|
{main::key($num++,repo_builder('missing','no-files')) => $pacman },
|
|
);
|
|
@rows = (@rows,@data);
|
|
}
|
|
}
|
|
# slackware
|
|
if (-f $slackpkg || -f $slackpkg_plus){
|
|
#$slackpkg = "$ENV{HOME}/bin/scripts/inxi/data/repo/slackware/slackpkg-2.conf";
|
|
if (-f $slackpkg){
|
|
@data = repo_builder($slackpkg,'slackpkg','^[[:space:]]*[^#]+');
|
|
@rows = (@rows,@data);
|
|
}
|
|
if (-f $slackpkg_plus){
|
|
push @dbg_files, $slackpkg_plus if $debugger_dir;
|
|
@data = main::reader($slackpkg_plus,'strip');
|
|
my (@repoplus_list,$active_repos);
|
|
foreach my $row (@data){
|
|
@data2 = split /\s*=\s*/, $row;
|
|
@data2 = map { $_ =~ s/^\s+|\s+$//g ; $_ } @data2;
|
|
last if $data2[0] =~ /^SLACKPKGPLUS/ && $data2[1] eq 'off';
|
|
# REPOPLUS=( slackpkgplus restricted alienbob ktown multilib slacky)
|
|
if ($data2[0] =~ /^REPOPLUS/){
|
|
@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/){
|
|
$data2[0] =~ s/MIRRORPLUS\[\'|\'\]//g;
|
|
if ($data2[0] =~ /$active_repos/){
|
|
push @content,"$data2[0] ~ $data2[1]";
|
|
}
|
|
}
|
|
}
|
|
if (! @content){
|
|
$key = repo_builder('missing','slackpkg+');
|
|
}
|
|
else {
|
|
@content = url_cleaner(@content);
|
|
$key = repo_builder('active','slackpkg+');
|
|
}
|
|
@data = (
|
|
{main::key($num++,$key) => $slackpkg_plus},
|
|
[@content],
|
|
);
|
|
@data = url_cleaner(@data);
|
|
@rows = (@rows,@data);
|
|
@content = ();
|
|
}
|
|
}
|
|
# redhat/suse
|
|
if (-d $yum_repo_dir || -f $yum_conf || -d $zypp_repo_dir){
|
|
if (-d $yum_repo_dir || -f $yum_conf){
|
|
@files = main::globber("$yum_repo_dir*.repo");
|
|
push @files, $yum_conf if -f $yum_conf;
|
|
$repo = 'yum';
|
|
}
|
|
elsif (-d $zypp_repo_dir){
|
|
@files = main::globber("$zypp_repo_dir*.repo");
|
|
main::log_data('data',"zypp repo files:\n" . main::joiner(\@files, "\n", 'unset')) if $b_log;
|
|
$repo = 'zypp';
|
|
}
|
|
#$repo = 'yum';
|
|
#push @files, "$ENV{'HOME'}/bin/scripts/inxi/data/repo/yum/rpmfusion-nonfree-1.repo";
|
|
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;
|
|
}
|
|
# Note: it looks like enabled comes before url
|
|
elsif ($line =~ /^(metalink|mirrorlist|baseurl)\s*=\s*(.*)/){
|
|
$url = $2;
|
|
}
|
|
# note: enabled = 1. enabled = 0 means disabled
|
|
elsif ($line =~ /^enabled\s*=\s*([01])/){
|
|
$enabled = $1;
|
|
}
|
|
# 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_builder('missing',$repo);
|
|
}
|
|
else {
|
|
@content = url_cleaner(@content);
|
|
$key = repo_builder('active',$repo);
|
|
}
|
|
@data = (
|
|
{main::key($num++,$key) => $_},
|
|
[@content],
|
|
);
|
|
@rows = (@rows,@data);
|
|
@content = ();
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \@rows;
|
|
}
|
|
# gentoo
|
|
if (-d $portage_dir && main::check_program('emerge')){
|
|
@files = main::globber("$portage_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*(.*)/){
|
|
$url = $2;
|
|
}
|
|
# note: enabled = 1. enabled = 0 means disabled
|
|
elsif ($line =~ /^auto-sync\s*=\s*([01])/){
|
|
$enabled = $1;
|
|
}
|
|
# 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_builder('missing','portage');
|
|
}
|
|
else {
|
|
@content = url_cleaner(@content);
|
|
$key = repo_builder('active','portage');
|
|
}
|
|
@data = (
|
|
{main::key($num++,$key) => $_},
|
|
[@content],
|
|
);
|
|
@rows = (@rows,@data);
|
|
@content = ();
|
|
}
|
|
}
|
|
}
|
|
# Alpine linux
|
|
if (-f $apk){
|
|
@data = repo_builder($apk,'apk','^\s*[^#]+');
|
|
@rows = (@rows,@data);
|
|
}
|
|
# Mandriva/Mageia using: urpmq
|
|
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;
|
|
@content = url_cleaner(@content);
|
|
# get the repo
|
|
$repo = $2;
|
|
@data = (
|
|
{main::key($num++,'urpmq repo') => $repo},
|
|
[@content],
|
|
);
|
|
@rows = (@rows,@data);
|
|
@content = ();
|
|
}
|
|
}
|
|
}
|
|
# 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){
|
|
@content = url_cleaner(@content);
|
|
$key = repo_builder('active',$which);
|
|
@data = (
|
|
{main::key($num++,$key) => $repo},
|
|
[@content],
|
|
);
|
|
@rows = (@rows,@data);
|
|
$repo = '';
|
|
@content = ();
|
|
}
|
|
}
|
|
# last one if present
|
|
if ($repo && @content){
|
|
@content = url_cleaner(@content);
|
|
$key = repo_builder('active',$which);
|
|
@data = (
|
|
{main::key($num++,$key) => $repo},
|
|
[@content],
|
|
);
|
|
@rows = (@rows,@data);
|
|
}
|
|
}
|
|
# print Dumper \@rows;
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub get_repos_bsd {
|
|
eval $start if $b_log;
|
|
my (@content,@data,@data2,@data3,@files,@rows);
|
|
my ($key);
|
|
my $bsd_pkg = '/usr/local/etc/pkg/repos/';
|
|
my $freebsd = '/etc/freebsd-update.conf';
|
|
my $freebsd_pkg = '/etc/pkg/FreeBSD.conf';
|
|
my $netbsd = '/usr/pkg/etc/pkgin/repositories.conf';
|
|
my $openbsd = '/etc/pkg.conf';
|
|
my $openbsd2 = '/etc/installurl';
|
|
my $portsnap = '/etc/portsnap.conf';
|
|
if ( -f $portsnap || -f $freebsd || -d $bsd_pkg){
|
|
if ( -f $portsnap ) {
|
|
@data = repo_builder($portsnap,'portsnap','^\s*SERVERNAME','\s*=\s*',1);
|
|
@rows = (@rows,@data);
|
|
}
|
|
if ( -f $freebsd ){
|
|
@data = repo_builder($freebsd,'freebsd','^\s*ServerName','\s+',1);
|
|
@rows = (@rows,@data);
|
|
}
|
|
# if ( -f $freebsd_pkg ){
|
|
# @data = repo_builder($freebsd_pkg,'freebsd-pkg','^\s*url',':\s+',1);
|
|
# @rows = (@rows,@data);
|
|
# }
|
|
if ( -d $bsd_pkg || -f $freebsd_pkg){
|
|
@files = main::globber('/usr/local/etc/pkg/repos/*.conf');
|
|
push @files, $freebsd_pkg if -f $freebsd_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] eq 'yes'){
|
|
push @data3, "$url"
|
|
}
|
|
$url = '';
|
|
}
|
|
}
|
|
}
|
|
if (! @data3){
|
|
$key = repo_builder('missing','bsd-package');
|
|
}
|
|
else {
|
|
@data3 = url_cleaner(@data3);
|
|
$key = repo_builder('active','bsd-package');
|
|
}
|
|
@data = (
|
|
{main::key($num++,$key) => $_},
|
|
[@data3],
|
|
);
|
|
@rows = (@rows,@data);
|
|
@data3 = ();
|
|
}
|
|
}
|
|
}
|
|
}
|
|
elsif (-f $openbsd || -f $openbsd2) {
|
|
if (-f $openbsd){
|
|
@data = repo_builder($openbsd,'openbsd','^installpath','\s*=\s*',1);
|
|
@rows = (@rows,@data);
|
|
}
|
|
if (-f $openbsd2){
|
|
@data = repo_builder($openbsd2,'openbsd','^(http|ftp)','',1);
|
|
@rows = (@rows,@data);
|
|
}
|
|
}
|
|
elsif (-f $netbsd){
|
|
# not an empty row, and not a row starting with #
|
|
@data = repo_builder($netbsd,'netbsd','^\s*[^#]+$');
|
|
@rows = (@rows,@data);
|
|
}
|
|
# 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_builder('missing','freebsd-nf');
|
|
}
|
|
elsif ($bsd_type eq 'openbsd'){
|
|
$key = repo_builder('missing','openbsd-nf');
|
|
}
|
|
elsif ($bsd_type eq 'netbsd'){
|
|
$key = repo_builder('missing','netbsd-nf');
|
|
}
|
|
else {
|
|
$key = repo_builder('missing','bsd-nf');
|
|
}
|
|
@data = (
|
|
{main::key($num++,'Message') => $key},
|
|
[()],
|
|
);
|
|
@rows = (@rows,@data);
|
|
}
|
|
eval $start if $b_log;
|
|
return @rows;
|
|
}
|
|
sub repo_builder {
|
|
eval $start if $b_log;
|
|
my ($file,$type,$search,$split,$count) = @_;
|
|
my (@content,@data,$missing,$key);
|
|
my %unfound = (
|
|
'apk' => 'No active APK repos in',
|
|
'apt' => 'No active apt repos in',
|
|
'bsd-package' => 'No enabled BSD pkg servers in',
|
|
'bsd-nf' => 'No BSD pkg server files found',
|
|
'eopkg' => 'No active eopkg repos found',
|
|
'pacman' => 'No active pacman repos in',
|
|
'pacman-g2' => 'No active pacman-g2 repos in',
|
|
'pisi' => 'No active pisi repos found',
|
|
'portage' => 'No enabled portage sources in',
|
|
'portsnap' => 'No ports servers in',
|
|
'freebsd' => 'No FreeBSD update servers in',
|
|
'freebsd-nf' => 'No FreeBSD update server files found',
|
|
'freebsd-pkg' => 'No FreeBSD default pkg server in',
|
|
'openbsd' => 'No OpenBSD pkg mirrors in',
|
|
'openbsd-nf' => 'No OpenBSD pkg mirror files found',
|
|
'netbsd' => 'No NetBSD pkg servers in',
|
|
'netbsd-nf' => 'No NetBSD pkg server files found',
|
|
'no-files' => 'No repo files found in',
|
|
'slackpkg' => 'No active slackpkg repos in',
|
|
'slackpkg+' => 'No active slackpkg+ repos in',
|
|
'yum' => 'No active yum repos in',
|
|
'zypp' => 'No active zypp repos in',
|
|
);
|
|
$missing = $unfound{$type};
|
|
return $missing if $file eq 'missing';
|
|
my %keys = (
|
|
'apk' => 'APK repo',
|
|
'apt' => 'Active apt repos in',
|
|
'bsd-package' => 'BSD enabled pkg servers in',
|
|
'eopkg' => 'Active eopkg repo',
|
|
'freebsd' => 'FreeBSD update server',
|
|
'freebsd-pkg' => 'FreeBSD default pkg server',
|
|
'pacman' => 'Active pacman repo servers in',
|
|
'pacman-g2' => 'Active pacman-g2 repo servers in',
|
|
'pisi' => 'Active pisi repo',
|
|
'portage' => 'Enabled portage sources in',
|
|
'portsnap' => 'BSD ports server',
|
|
'openbsd' => 'OpenBSD pkg mirror',
|
|
'netbsd' => 'NetBSD pkg servers',
|
|
'slackpkg' => 'slackpkg repos in',
|
|
'slackpkg+' => 'slackpkg+ repos in',
|
|
'yum' => 'Active yum repos in',
|
|
'zypp' => 'Active zypp repos in',
|
|
);
|
|
$key = $keys{$type};
|
|
return $key if $file eq 'active';
|
|
push @dbg_files, $file if $debugger_dir;
|
|
@content = main::reader($file);
|
|
@content = grep {/$search/i && !/^\s*$/} @content if @content;
|
|
@content = data_cleaner(@content);
|
|
if ($split){
|
|
@content = map {
|
|
my @inner = split (/$split/, $_);
|
|
$inner[$count];
|
|
} @content;
|
|
}
|
|
if (!@content){
|
|
$key = $missing;
|
|
}
|
|
else {
|
|
@content = url_cleaner(@content);
|
|
}
|
|
@data = (
|
|
{main::key($num++,$key) => $file},
|
|
[@content],
|
|
);
|
|
eval $end if $b_log;
|
|
return @data;
|
|
}
|
|
sub data_cleaner {
|
|
my (@content) = @_;
|
|
# basics: trim white space, get rid of double spaces
|
|
@content = map { $_ =~ s/^\s+|\s+$//g; $_ =~ s/\s\s+/ /g; $_} @content;
|
|
return @content;
|
|
}
|
|
# clean if irc
|
|
sub url_cleaner {
|
|
my (@content) = @_;
|
|
@content = map { $_ =~ s/:\//: \//; $_} @content if $b_irc;
|
|
return @content;
|
|
}
|
|
sub file_path {
|
|
my ($filename,$dir) = @_;
|
|
my ($working);
|
|
$working = $filename;
|
|
$working =~ s/^\///;
|
|
$working =~ s/\//-/g;
|
|
$working = "$dir/file-repo-$working.txt";
|
|
return $working;
|
|
}
|
|
}
|
|
|
|
## SensorData
|
|
{
|
|
package SensorData;
|
|
my (@sensors_data);
|
|
my ($b_ipmi) = (0);
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my ($key1,$program,$val1,@data,@rows,%sensors);
|
|
my $num = 0;
|
|
my $source = 'sensors';
|
|
# we're allowing 1 or 2 ipmi tools, first the gnu one, then the
|
|
# almost certain to be present in BSDs
|
|
if ( $b_ipmi ||
|
|
( main::globber('/dev/ipmi*') &&
|
|
( ( $program = main::check_program('ipmi-sensors') ) ||
|
|
( $program = main::check_program('ipmitool') ) ) ) ){
|
|
if ($b_ipmi || $b_root){
|
|
%sensors = ipmi_data($program);
|
|
@data = create_output('ipmi',%sensors);
|
|
if (!@data) {
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('sensors-data-ipmi');
|
|
#$val1 = main::row_defaults('dev');
|
|
@data = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
@rows = (@rows,@data);
|
|
$source = 'lm-sensors'; # trips per sensor type output
|
|
}
|
|
else {
|
|
$key1 = 'Permissions';
|
|
$val1 = main::row_defaults('sensors-ipmi-root');
|
|
@data = ({main::key($num++,$key1) => $val1,});
|
|
@rows = (@rows,@data);
|
|
}
|
|
}
|
|
my $ref = $alerts{'sensors'};
|
|
if ( $$ref{'action'} ne 'use'){
|
|
#print "here 1\n";
|
|
$key1 = $$ref{'action'};
|
|
$val1 = $$ref{$key1};
|
|
$key1 = ucfirst($key1);
|
|
@data = ({main::key($num++,$key1) => $val1,});
|
|
@rows = (@rows,@data);
|
|
}
|
|
else {
|
|
%sensors = sensors_data();
|
|
@data = create_output($source,%sensors);
|
|
#print "here 2\n";
|
|
if (!@data) {
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('sensors-data-linux');
|
|
@data = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
@rows = (@rows,@data);
|
|
}
|
|
undef @sensors_data;
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub create_output {
|
|
eval $start if $b_log;
|
|
my ($source,%sensors) = @_;
|
|
# note: might revisit this, since gpu sensors data might be present
|
|
return if ! %sensors;
|
|
my (@gpu,@data,@rows,@fan_default,@fan_main);
|
|
my ($data_source) = ('');
|
|
my $fan_number = 0;
|
|
my $num = 0;
|
|
my $j = 0;
|
|
@gpu = gpu_data() if ( $source eq 'sensors' || $source eq 'lm-sensors' );
|
|
my $temp_unit = (defined $sensors{'temp-unit'}) ? " $sensors{'temp-unit'}": '';
|
|
my $cpu_temp = (defined $sensors{'cpu-temp'}) ? $sensors{'cpu-temp'} . $temp_unit: 'N/A';
|
|
my $mobo_temp = (defined $sensors{'mobo-temp'}) ? $sensors{'mobo-temp'} . $temp_unit: 'N/A';
|
|
my $cpu1_key = ($sensors{'cpu2-temp'}) ? 'cpu-1': 'cpu' ;
|
|
$data_source = $source if ($source eq 'ipmi' || $source eq 'lm-sensors');
|
|
@data = ({
|
|
main::key($num++,'System Temperatures') => $data_source,
|
|
main::key($num++,$cpu1_key) => $cpu_temp,
|
|
});
|
|
@rows = (@rows,@data);
|
|
if ($sensors{'cpu2-temp'}){
|
|
$rows[$j]{main::key($num++,'cpu-2')} = $sensors{'cpu2-temp'} . $temp_unit;
|
|
}
|
|
if ($sensors{'cpu3-temp'}){
|
|
$rows[$j]{main::key($num++,'cpu-3')} = $sensors{'cpu3-temp'} . $temp_unit;
|
|
}
|
|
if ($sensors{'cpu4-temp'}){
|
|
$rows[$j]{main::key($num++,'cpu-4')} = $sensors{'cpu4-temp'} . $temp_unit;
|
|
}
|
|
$rows[$j]{main::key($num++,'mobo')} = $mobo_temp;
|
|
if (defined $sensors{'sodimm-temp'}){
|
|
my $sodimm_temp = $sensors{'sodimm-temp'} . $temp_unit;
|
|
$rows[$j]{main::key($num++,'sodimm')} = $sodimm_temp;
|
|
}
|
|
if (defined $sensors{'psu-temp'}){
|
|
my $psu_temp = $sensors{'psu-temp'} . $temp_unit;
|
|
$rows[$j]{main::key($num++,'psu')} = $psu_temp;
|
|
}
|
|
if (scalar @gpu == 1){
|
|
my $gpu_temp = $gpu[0]{'temp'};
|
|
my $gpu_type = $gpu[0]{'type'};
|
|
my $gpu_unit = (defined $gpu[0]{'temp-unit'} && $gpu_temp ) ? " $gpu[0]{'temp-unit'}" : ' C';
|
|
$rows[$j]{main::key($num++,'gpu')} = $gpu_type;
|
|
$rows[$j]{main::key($num++,'temp')} = $gpu_temp . $gpu_unit;
|
|
}
|
|
$j = scalar @rows;
|
|
my $ref_main = $sensors{'fan-main'};
|
|
my $ref_default = $sensors{'fan-default'};
|
|
@fan_main = @$ref_main if @$ref_main;
|
|
@fan_default = @$ref_default if @$ref_default;
|
|
my $fan_def = ($data_source) ? $data_source : '';
|
|
if (!@fan_main && !@fan_default){
|
|
$fan_def = ($fan_def) ? "$data_source N/A" : 'N/A';
|
|
}
|
|
$rows[$j]{main::key($num++,'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++,'cpu')} = $fan_main[$i];
|
|
$b_cpu = 1;
|
|
}
|
|
elsif ($i == 2 && $b_cpu){
|
|
$rows[$j]{main::key($num++,'mobo')} = $fan_main[$i];
|
|
}
|
|
elsif ($i == 3){
|
|
$rows[$j]{main::key($num++,'psu')} = $fan_main[$i];
|
|
}
|
|
elsif ($i == 4){
|
|
$rows[$j]{main::key($num++,'sodimm')} = $fan_main[$i];
|
|
}
|
|
elsif ($i > 4){
|
|
$fan_number = $i - 4;
|
|
$rows[$j]{main::key($num++,"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++,"fan-$i")} = $fan_default[$i];
|
|
}
|
|
}
|
|
# note: so far, only nvidia-settings returns speed, and that's in percent
|
|
if (scalar @gpu == 1 && defined $gpu[0]{'fan-speed'}){
|
|
my $gpu_fan = $gpu[0]{'fan-speed'} . $gpu[0]{'speed-unit'};
|
|
my $gpu_type = $gpu[0]{'type'};
|
|
$rows[$j]{main::key($num++,'gpu')} = $gpu_type;
|
|
$rows[$j]{main::key($num++,'fan')} = $gpu_fan;
|
|
}
|
|
if (scalar @gpu > 1){
|
|
$j = scalar @rows;
|
|
$rows[$j]{main::key($num++,'GPU')} = '';
|
|
my $gpu_unit = (defined $gpu[0]{'temp-unit'} ) ? " $gpu[0]{'temp-unit'}" : ' C';
|
|
foreach my $ref (@gpu){
|
|
my %info = %$ref;
|
|
# 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++,'device')} = $gpu_type;
|
|
if (defined $info{'screen'} ){
|
|
$rows[$j]{main::key($num++,'screen')} = $info{'screen'};
|
|
}
|
|
$rows[$j]{main::key($num++,'temp')} = $gpu_temp;
|
|
if (defined $gpu_fan){
|
|
$rows[$j]{main::key($num++,'fan')} = $gpu_fan;
|
|
}
|
|
}
|
|
}
|
|
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++,'Voltages')} = $data_source;
|
|
$rows[$j]{main::key($num++,'12v')} = $sensors{'volts-12'};
|
|
$rows[$j]{main::key($num++,'5v')} = $sensors{'volts-5'};
|
|
$rows[$j]{main::key($num++,'3.3v')} = $sensors{'volts-3.3'};
|
|
$rows[$j]{main::key($num++,'vbat')} = $sensors{'volts-vbat'};
|
|
if ($extra > 1 && $source eq 'ipmi' ){
|
|
$sensors{'volts-dimm-p1'} ||= 'N/A';
|
|
$sensors{'volts-dimm-p2'} ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'dimm-p1')} = $sensors{'volts-dimm-p1'} if $sensors{'volts-dimm-p1'};
|
|
$rows[$j]{main::key($num++,'dimm-p2')} = $sensors{'volts-dimm-p2'} if $sensors{'volts-dimm-p2'};
|
|
$rows[$j]{main::key($num++,'soc-p1')} = $sensors{'volts-soc-p1'} if $sensors{'volts-soc-p1'};
|
|
$rows[$j]{main::key($num++,'soc-p2')} = $sensors{'volts-soc-p2'} if $sensors{'volts-soc-p2'};
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub ipmi_data {
|
|
eval $start if $b_log;
|
|
my ($program) = @_;
|
|
my ($cmd,$file,@data,$fan_working,%sensors,@row,$sys_fan_nu,$temp_working,$working_unit);
|
|
#$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmitool-sensors-archerseven-1.txt";
|
|
#$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmitool-sensors-crazy-epyc-1.txt";
|
|
#$file = "$ENV{'HOME'}/bin/scripts/inxi/data/ipmitool/ipmi-sensors-crazy-epyc-1.txt";$program='ipmi-sensors';
|
|
#@data = main::reader($file);
|
|
$program ||= 'ipmi-xx'; # only for debugging, will always exist if reachers here
|
|
my ($b_ipmitool,$i_key,$i_value,$i_unit);
|
|
if ($program =~ /ipmi-sensors$/){
|
|
$cmd = $program;
|
|
($b_ipmitool,$i_key,$i_value,$i_unit) = (0,1,3,4);
|
|
}
|
|
else {
|
|
$cmd = "$program sensors";
|
|
($b_ipmitool,$i_key,$i_value,$i_unit) = (1,0,1,2);
|
|
}
|
|
@data = main::grabber("$cmd 2>/dev/null");
|
|
return if ! @data;
|
|
foreach (@data){
|
|
next if /^\s*$/;
|
|
#print "$_\n";
|
|
@row = split /\s*\|\s*/, $_;
|
|
#print "$row[$i_key] $row[$i_value]\n";
|
|
if ($row[$i_key] =~ /^System 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;
|
|
}
|
|
# Platform Control Hub (PCH), it is the X370 chip on the Crosshair VI Hero.
|
|
# VRM: voltage regulator module
|
|
elsif ($row[$i_key] =~ /^CPU[1]?\sTemp/i) {
|
|
$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([2-4])\sTemp/i) {
|
|
$temp_working = $1;
|
|
$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] =~ /^Temp 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] =~ /^Temp 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] =~ /^Temp 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;
|
|
}
|
|
# note: can be cpu fan:, cpu fan speed:, etc.
|
|
elsif ($row[$i_key] =~ /^(CPU|Processor)\sFan/i) {
|
|
$sensors{'fan-main'} = () if !$sensors{'fan-main'};
|
|
$sensors{'fan-main'}[1] = int($row[$i_value]);
|
|
}
|
|
# note that the counters are dynamically set for fan numbers here
|
|
# otherwise you could overwrite eg aux fan2 with case fan2 in theory
|
|
# note: cpu/mobo/ps are 1/2/3
|
|
elsif ($row[$i_key] =~ /^FAN([0-9A-F]+)/i) {
|
|
$sys_fan_nu = hex($1);
|
|
next if $row[$i_value] !~ /^[0-9\.]+$/;
|
|
$fan_working = int($row[$i_value]);
|
|
$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;
|
|
}
|
|
}
|
|
}
|
|
if ($extra > 0){
|
|
if ($row[$i_key] =~ /^12V$/i) {
|
|
$sensors{'volts-12'} = $row[$i_value];
|
|
}
|
|
elsif ($row[$i_key] =~ /^(P5V|5VCC)$/i) {
|
|
$sensors{'volts-5'} = $row[$i_value];
|
|
}
|
|
elsif ($row[$i_key] =~ /^(P3V3|3.3VCC)$/i) {
|
|
$sensors{'volts-3.3'} = $row[$i_value];
|
|
}
|
|
elsif ($row[$i_key] =~ /^VBAT$/i) {
|
|
$sensors{'volts-vbat'} = $row[$i_value];
|
|
}
|
|
# NOTE: VDimmP1ABC VDimmP1DEF
|
|
elsif (!$sensors{'volts-dimm-p1'} && $row[$i_key] =~ /^(P1_VMEM|VDimmP1)/i) {
|
|
$sensors{'volts-dimm-p1'} = $row[$i_value];
|
|
}
|
|
elsif (! $sensors{'volts-dimm-p2'} && $row[$i_key] =~ /^(P2_VMEM|VDimmP2)/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;
|
|
%sensors = data_processor(%sensors) if %sensors;
|
|
main::log_data('dump','ipmi: %sensors',\%sensors) if $b_log;
|
|
eval $end if $b_log;
|
|
#print Data::Dumper::Dumper \%sensors;
|
|
return %sensors;
|
|
}
|
|
sub sensors_data {
|
|
eval $start if $b_log;
|
|
my (%sensors);
|
|
my ($b_valid,$sys_fan_nu) = (0,0);
|
|
my ($adapter,$fan_working,$temp_working,$working_unit) = ('','','','');
|
|
#my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/amdgpu-w-fan-speed-stretch-k10.txt";
|
|
#my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/peci-tin-geggo.txt";
|
|
#my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-w-other-biker.txt";
|
|
#my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/sensors/sensors-asus-chassis-1.txt";
|
|
#@sensors_data = main::reader($file);
|
|
@sensors_data = main::grabber(main::check_program('sensors') . " 2>/dev/null");
|
|
#print @sensors_data;
|
|
@sensors_data = map {$_ =~ s/\s*:\s*\+?/:/;$_} @sensors_data;
|
|
foreach (@sensors_data){
|
|
# we get this from gpu_data()
|
|
if (/^(amdgpu|intel|nouveau|radeon)-pci/){
|
|
$b_valid = 0;
|
|
$adapter = '';
|
|
next;
|
|
}
|
|
if (/^(?:(?!amdgpu|intel|nouveau|radeon).)*-(isa|pci|virtual)-/){
|
|
$b_valid = 1;
|
|
$adapter = $1;
|
|
next;
|
|
}
|
|
next if !$b_valid;
|
|
my @working = split /:/, $_;
|
|
next if !$working[0] || /^Adapter/;
|
|
#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 ($_ =~ /^(AMBIENT|M\/B|MB|SIO|SYS).*:([0-9\.]+)[\s°]*(C|F)/i) {
|
|
$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
|
|
elsif (!$sensors{'cpu-temp'} && $_ =~ /^CPU.*:([0-9\.]+)[\s°]*(C|F)/i) {
|
|
$sensors{'cpu-temp'} = $1;
|
|
$working_unit = $2;
|
|
$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 ($_ =~ /^(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 ($_ =~ /^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 ) ) {
|
|
$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 ) ) {
|
|
$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 ) ) {
|
|
$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 ($_ =~ /^(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 ) ) {
|
|
$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 (!$sensors{'fan-main'}[1] && $_ =~ /^(CPU|Processor).*:([0-9]+)[\s]RPM/i) {
|
|
$sensors{'fan-main'} = () if !$sensors{'fan-main'};
|
|
$sensors{'fan-main'}[1] = $2;
|
|
}
|
|
elsif (!$sensors{'fan-main'}[2] && $_ =~ /^(M\/B|MB|SYS).*:([0-9]+)[\s]RPM/i) {
|
|
$sensors{'fan-main'} = () if !$sensors{'fan-main'};
|
|
$sensors{'fan-main'}[2] = $2;
|
|
}
|
|
elsif (!$sensors{'fan-main'}[3] && $_ =~ /(Power|P\/S|POWER).*:([0-9]+)[\s]RPM/i) {
|
|
$sensors{'fan-main'} = () if !$sensors{'fan-main'};
|
|
$sensors{'fan-main'}[3] = $2;
|
|
}
|
|
elsif (!$sensors{'fan-main'}[4] && $_ =~ /(SODIMM).*:([0-9]+)[\s]RPM/i) {
|
|
$sensors{'fan-main'} = () if !$sensors{'fan-main'};
|
|
$sensors{'fan-main'}[4] = $2;
|
|
}
|
|
# 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 ($_ =~ /^(AUX|CASE|CHASSIS).*:([0-9]+)[\s]RPM/i) {
|
|
$temp_working = $2;
|
|
$sensors{'fan-main'} = () if !$sensors{'fan-main'};
|
|
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'} = () if !$sensors{'fan-default'};
|
|
$sensors{'fan-default'}[1] = $2;
|
|
}
|
|
elsif ($_ =~ /^FAN([2-9]|1[0-9]).*:([0-9]+)[\s]RPM/i) {
|
|
$fan_working = $2;
|
|
$sys_fan_nu = $1;
|
|
$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;
|
|
}
|
|
}
|
|
}
|
|
if ($extra > 0){
|
|
if ($_ =~ /^[+]?(12 Volt|12V).*:([0-9\.]+)\sV/i) {
|
|
$sensors{'volts-12'} = $2;
|
|
}
|
|
# note: 5VSB is a field name
|
|
elsif ($_ =~ /^[+]?(5 Volt|5V):([0-9\.]+)\sV/i) {
|
|
$sensors{'volts-5'} = $2;
|
|
}
|
|
elsif ($_ =~ /^[+]?(3\.3 Volt|3\.3V).*:([0-9\.]+)\sV/i) {
|
|
$sensors{'volts-3.3'} = $2;
|
|
}
|
|
elsif ($_ =~ /^(Vbat).*:([0-9\.]+)\sV/i) {
|
|
$sensors{'volts-vbat'} = $2;
|
|
}
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper \%sensors;
|
|
%sensors = data_processor(%sensors) if %sensors;
|
|
main::log_data('dump','lm-sensors: %sensors',\%sensors) if $b_log;
|
|
# print Data::Dumper::Dumper \%sensors;
|
|
eval $end if $b_log;
|
|
return %sensors;
|
|
}
|
|
|
|
# oddly, openbsd sysctl actually has hw.sensors data!
|
|
sub sysctl_data {
|
|
eval $start if $b_log;
|
|
my (@data,%sensors);
|
|
foreach (@sysctl_sensors){
|
|
if (/^hw.sensors\.([0-9a-z]+)\.(temp|fan|volt)([0-9])/){
|
|
my $sensor = $1;
|
|
my $type = $2;
|
|
my $number = $3;
|
|
my @working = split /:/, $_;
|
|
}
|
|
last if /^(hw.cpuspeed|hw.vendor|hw.physmem)/;
|
|
}
|
|
|
|
%sensors = data_processor(%sensors) if %sensors;
|
|
main::log_data('dump','%sensors',\%sensors) if $b_log;
|
|
# print Data::Dumper::Dumper \%sensors;
|
|
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 data_processor {
|
|
eval $start if $b_log;
|
|
my (%sensors) = @_;
|
|
my ($cpu_temp,$cpu2_temp,$cpu3_temp,$cpu4_temp,$index_count_fan_default,
|
|
$index_count_fan_main,$mobo_temp,$psu_temp) = (0,0,0,0,0,0,0,0);
|
|
my ($fan_type,$i,$j) = (0,0,0);
|
|
my $temp_diff = 20; # for C, handled for F after that is determined
|
|
my (@fan_main,@fan_default);
|
|
# 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'};
|
|
#}
|
|
}
|
|
else {
|
|
$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] = '';
|
|
# 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 ($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'};
|
|
# 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 = (
|
|
'cpu-temp' => $cpu_temp,
|
|
'cpu2-temp' => $cpu2_temp,
|
|
'cpu3-temp' => $cpu3_temp,
|
|
'cpu4-temp' => $cpu4_temp,
|
|
'mobo-temp' => $mobo_temp,
|
|
'psu-temp' => $psu_temp,
|
|
'temp-unit' => $sensors{'temp-unit'},
|
|
'fan-main' => \@fan_main,
|
|
'fan-default' => \@fan_default,
|
|
);
|
|
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;
|
|
return %sensors;
|
|
}
|
|
sub gpu_data {
|
|
eval $start if $b_log;
|
|
return @gpudata if $b_gpudata;
|
|
my ($cmd,@data,@data2,$path,@screens,$temp);
|
|
my ($j) = (0);
|
|
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;
|
|
@data = (@data,@data2);
|
|
$j = scalar @gpudata;
|
|
$gpudata[$j] = ({});
|
|
foreach my $item (@data){
|
|
if ($item =~ /^\s*Attribute\s\'([^']+)\'\s.*:\s*([\S]+)\.$/){
|
|
my $attribute = $1;
|
|
my $value = $2;
|
|
$gpudata[$j]{'type'} = 'nvidia';
|
|
$gpudata[$j]{'speed-unit'} = '%';
|
|
$gpudata[$j]{'screen'} = $screen;
|
|
if (!$gpudata[$j]{'temp'} && $attribute eq 'GPUCoreTemp'){
|
|
$gpudata[$j]{'temp'} = $value;
|
|
}
|
|
elsif (!$gpudata[$j]{'ram'} && $attribute eq 'VideoRam'){
|
|
$gpudata[$j]{'ram'} = $value;
|
|
}
|
|
elsif (!$gpudata[$j]{'clock'} && $attribute eq 'GPUCurrentClockFreqs'){
|
|
$gpudata[$j]{'clock'} = $value;
|
|
}
|
|
elsif (!$gpudata[$j]{'bus'} && $attribute eq 'PCIBus'){
|
|
$gpudata[$j]{'bus'} = $value;
|
|
}
|
|
elsif (!$gpudata[$j]{'bus-id'} && $attribute eq 'PCIDevice'){
|
|
$gpudata[$j]{'bus-id'} = $value;
|
|
}
|
|
elsif (!$gpudata[$j]{'fan-speed'} && $attribute eq 'GPUCurrentFanSpeed'){
|
|
$gpudata[$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 @gpudata;
|
|
$gpudata[$j] = ({});
|
|
my $value = $1;
|
|
$gpudata[$j]{'type'} = 'amd';
|
|
$gpudata[$j]{'temp'} = $value;
|
|
}
|
|
}
|
|
}
|
|
if (@sensors_data){
|
|
my ($b_found,$holder) = (0,'');
|
|
foreach (@sensors_data){
|
|
next if (/^Adapter:/ || /^\s*$/);
|
|
if (/^(amdgpu|intel|nouveau|radeon)-pci-(.*)/){
|
|
$b_found = 1;
|
|
$holder = $1;
|
|
$j = scalar @gpudata;
|
|
}
|
|
if ($b_found){
|
|
if (/^temp.*:([0-9]+).*(C|F)/){
|
|
$gpudata[$j]{'temp'} = $1;
|
|
$gpudata[$j]{'type'} = $holder;
|
|
$gpudata[$j]{'unit'} = $2;
|
|
}
|
|
if (/^fan.*:([0-9]+).*(RPM)?/){
|
|
$gpudata[$j]{'fan-speed'} = $1;
|
|
# NOTE: we test for nvidia %, everything else stays with nothing
|
|
$gpudata[$j]{'speed-unit'} = '';
|
|
}
|
|
main::log_data('dump','sensors output: video: @gpudata',\@gpudata);
|
|
}
|
|
if (/^(?:(?!amdgpu|intel|nouveau|radeon).)*-(pci|virtual|isa)-(.*)/){
|
|
$b_found = 0;
|
|
$holder = '';
|
|
}
|
|
}
|
|
}
|
|
# we'll probably use this data elsewhere so make it a one time call
|
|
$b_gpudata = 1;
|
|
# print Data::Dumper::Dumper \@gpudata;
|
|
eval $end if $b_log;
|
|
return @gpudata;
|
|
}
|
|
}
|
|
|
|
## SlotData
|
|
{
|
|
package SlotData;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (@data,@rows,$key1,$val1);
|
|
my $num = 0;
|
|
my $ref = $alerts{'dmidecode'};
|
|
if ($b_arm){
|
|
$key1 = 'ARM';
|
|
$val1 = main::row_defaults('arm-pci','');
|
|
@rows = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
elsif ( $$ref{'action'} ne 'use'){
|
|
$key1 = $$ref{'action'};
|
|
$val1 = $$ref{$key1};
|
|
$key1 = ucfirst($key1);
|
|
@rows = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
else {
|
|
@rows = slot_data();
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub slot_data {
|
|
eval $start if $b_log;
|
|
my (@data,@rows);
|
|
my $num = 0;
|
|
foreach (@dmi){
|
|
$num = 1;
|
|
my @ref = @$_;
|
|
if ($ref[0] == 9){
|
|
my ($designation,$id,$length,$type,$usage) = ('','','','','');
|
|
# skip first two row, we don't need that data
|
|
splice @ref, 0, 2 if @ref;
|
|
my $j = scalar @rows;
|
|
foreach my $item (@ref){
|
|
if ($item !~ /^~/){ # skip the indented rows
|
|
my @value = split /:\s+/, $item;
|
|
if ($value[0] eq 'Type'){
|
|
$type = $value[1];
|
|
}
|
|
if ($value[0] eq 'Designation'){
|
|
$designation = $value[1];
|
|
}
|
|
if ($value[0] eq 'Current Usage'){
|
|
$usage = $value[1];
|
|
|
|
}
|
|
if ($value[0] eq 'ID'){
|
|
$id = $value[1];
|
|
}
|
|
if ($extra > 1 && $value[0] eq 'Length'){
|
|
$length = $value[1];
|
|
}
|
|
}
|
|
}
|
|
if ($type){
|
|
$id = 'N/A' if ($id eq '' );
|
|
if ($type eq 'Other' && $designation){
|
|
$type = $designation;
|
|
}
|
|
elsif ($type && $designation) {
|
|
$type = "$type $designation";
|
|
}
|
|
@data = (
|
|
{
|
|
main::key($num++,'Slot') => $id,
|
|
main::key($num++,'type') => $type,
|
|
main::key($num++,'status') => $usage,
|
|
},
|
|
);
|
|
@rows = (@rows,@data);
|
|
if ($extra > 1 ){
|
|
$rows[$j]{main::key($num++,'length')} = $length;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if (!@rows){
|
|
my $key = 'Message';
|
|
@data = ({
|
|
main::key($num++,$key) => main::row_defaults('pci-slot-data',''),
|
|
},);
|
|
@rows = (@rows,@data);
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
}
|
|
|
|
## UnmountedData
|
|
{
|
|
package UnmountedData;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (@data,@rows,$key1,$val1);
|
|
my $num = 0;
|
|
if ($bsd_type){
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('unmounted-data-bsd');
|
|
}
|
|
else {
|
|
if (my $file = main::system_files('partitions')){
|
|
@data = unmounted_data($file);
|
|
if (!@data){
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('unmounted-data');
|
|
}
|
|
else {
|
|
@rows = create_output(@data);
|
|
}
|
|
}
|
|
else {
|
|
$key1 = 'Message';
|
|
$val1 = main::row_defaults('unmounted-file');
|
|
}
|
|
}
|
|
if (!@rows && $key1){
|
|
@rows = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub create_output {
|
|
eval $start if $b_log;
|
|
my (@unmounted) = @_;
|
|
my (@data,@rows,$fs);
|
|
my $num = 0;
|
|
@unmounted = sort { $a->{'dev-base'} cmp $b->{'dev-base'} } @unmounted;
|
|
foreach my $ref (@unmounted){
|
|
my %row = %$ref;
|
|
$num = 1;
|
|
my @data2 = main::get_size($row{'size'}) if (defined $row{'size'});
|
|
my $size = (@data2) ? $data2[0] . ' ' . $data2[1]: 'N/A';
|
|
if ($row{'fs'}){
|
|
$fs = lc($row{'fs'});
|
|
}
|
|
else {
|
|
if (main::check_program('file')){
|
|
$fs = ($b_root) ? 'N/A' : main::row_defaults('root-required');
|
|
}
|
|
else {
|
|
$fs = 'requires file';
|
|
}
|
|
}
|
|
@data = ({
|
|
main::key($num++,'ID') => , "/dev/$row{'dev-base'}",
|
|
main::key($num++,'size') => , $size,
|
|
main::key($num++,'fs') => , $fs,
|
|
main::key($num++,'label') => , $row{'label'},
|
|
main::key($num++,'uuid') => , $row{'uuid'},
|
|
});
|
|
@rows = (@rows,@data);
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub unmounted_data {
|
|
eval $start if $b_log;
|
|
my ($file) = @_;
|
|
my ($fs,$label,$size,$uuid,@data,%part,@unmounted);
|
|
my @mounted = ('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 @mounts = main::reader($file,'strip');
|
|
my $num = 0;
|
|
PartitionData::set_lsblk() if !$bsd_type && !$b_lsblk;
|
|
# set labels, uuid, gpart
|
|
PartitionData::partition_data() if !$b_partitions;
|
|
PartitionData::set_label_uuid() if !$b_label_uuid;
|
|
RaidData::raid_data() if !$b_raid;
|
|
@mounted = get_mounted(@mounted);
|
|
foreach (@mounts){
|
|
my @working = split /\s+/, $_;
|
|
($fs,$label,$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
|
|
if ( $working[-1] !~ /^nvme[0-9]+n[0-9]+$/ &&
|
|
$working[-1] =~ /[a-z][0-9]+$|dm-[0-9]+$/ && $working[2] != 1 &&
|
|
$working[-1] !~ /loop/ && !(grep {$working[-1] =~ /$_/} @mounted)){
|
|
%part = PartitionData::check_lsblk($working[-1],0) if (@lsblk && $working[-1]);
|
|
if (%part){
|
|
$fs = $part{'fs'};
|
|
$label = $part{'label'};
|
|
$uuid = $part{'uuid'};
|
|
$size = $part{'size'} if $part{'size'} && !$working[2];
|
|
}
|
|
$size ||= $working[2];
|
|
$fs = unmounted_filesystem($working[-1]) if !$fs;
|
|
$label = PartitionData::get_label("/dev/$working[-1]") if !$label;
|
|
$uuid = PartitionData::get_uuid("/dev/$working[-1]") if !$uuid;
|
|
@data = ({
|
|
'dev-base' => $working[-1],
|
|
'fs' => $fs,
|
|
'label' => $label,
|
|
'size' => $size,
|
|
'uuid' => $uuid,
|
|
});
|
|
@unmounted = (@unmounted,@data);
|
|
}
|
|
}
|
|
# print Data::Dumper::Dumper @unmounted;
|
|
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 (@mounted) = @_;
|
|
foreach my $ref (@partitions){
|
|
my %row = %$ref;
|
|
push @mounted, $row{'dev-base'} if $row{'dev-base'};
|
|
}
|
|
foreach my $ref (@raid){
|
|
my %row = %$ref;
|
|
my $ref2 = $row{'arrays'};
|
|
# we want to not show md0 etc in unmounted report
|
|
push @mounted, $row{'id'} if $row{'id'};
|
|
my @arrays = (ref $ref2 eq 'ARRAY' ) ? @$ref2 : ();
|
|
@arrays = grep {defined $_} @arrays;
|
|
foreach my $array (@arrays){
|
|
my %row2 = %$array;
|
|
my $ref3 = $row2{'components'};
|
|
my @components = (ref $ref3 eq 'ARRAY') ? @$ref3 : ();
|
|
foreach my $component (@components){
|
|
my @temp = split /~/, $component;
|
|
push @mounted, $temp[0];
|
|
}
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @mounted;
|
|
}
|
|
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','swap','btrfs',
|
|
'ffs','hammer','hfs\+','hfs\splus','hfs\sextended\sversion\s[1-9]','hfsj',
|
|
'hfs','jfs','nss','reiserfs','reiser4','ufs2','ufs','xfs','zfs');
|
|
if ($file){
|
|
# this will fail if regular user and no sudo present, but that's fine, it will just return null
|
|
# note the hack that simply slices out the first line if > 1 items found in string
|
|
# also, if grub/lilo is on partition boot sector, no file system data is available
|
|
$data = (main::grabber("$sudo$file -s /dev/$item 2>/dev/null"))[0];
|
|
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;
|
|
}
|
|
}
|
|
|
|
## UsbData
|
|
{
|
|
package UsbData;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (@data,@rows,$key1,$val1);
|
|
my $num = 0;
|
|
my $ref = $alerts{'lsusb'};
|
|
my $ref2 = $alerts{'usbdevs'};
|
|
if ( $$ref{'action'} ne 'use' && $$ref2{'action'} ne 'use'){
|
|
if ($os eq 'linux' ){
|
|
$key1 = $$ref{'action'};
|
|
$val1 = $$ref{$key1};
|
|
}
|
|
else {
|
|
$key1 = $$ref2{'action'};
|
|
$val1 = $$ref2{$key1};
|
|
}
|
|
$key1 = ucfirst($key1);
|
|
@rows = ({main::key($num++,$key1) => $val1,});
|
|
}
|
|
else {
|
|
@rows = usb_data();
|
|
if (!@rows){
|
|
my $key = 'Message';
|
|
@data = ({
|
|
main::key($num++,$key) => main::row_defaults('usb-data',''),
|
|
},);
|
|
@rows = (@rows,@data);
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub usb_data {
|
|
eval $start if $b_log;
|
|
return if ! @usb;
|
|
my (@data,@row,@rows,$bus_id,$chip_id,$speed,$protocol,$class,$vendor,$product);
|
|
my $num = 0;
|
|
my $j = 0;
|
|
# note: the data has been presorted in set_lsusb_data by:
|
|
# bus id then device id, so we don't need to worry about the order
|
|
foreach my $ref (@usb){
|
|
my @id = @$ref;
|
|
$j = scalar @rows;
|
|
$num = 1;
|
|
$bus_id = "$id[0]:$id[1]";
|
|
$chip_id = $id[2];
|
|
my $b_hub = 0;
|
|
# it's a hub
|
|
if ($id[1] == 1){
|
|
foreach my $line (@id){
|
|
#print "$line\n";
|
|
@row = split /:/, $line;
|
|
next if ! defined $row[0];
|
|
if ($row[0] eq 'bcdUSB' && defined $row[1]){
|
|
$speed = ($row[1] =~ /^[0-9,\.]+$/) ? sprintf("%1.1f",$row[1]) : $row[1];
|
|
}
|
|
elsif ($row[0] eq '~bInterfaceProtocol' && $row[2] ){
|
|
$protocol = $row[2];
|
|
}
|
|
}
|
|
$protocol ||= 'N/A';
|
|
$speed ||= 'N/A';
|
|
#print "pt0:$protocol\n";
|
|
@data = ({
|
|
main::key($num++,'Hub') => $bus_id,
|
|
main::key($num++,'usb') => $speed,
|
|
main::key($num++,'type') => $protocol,
|
|
},);
|
|
@rows = (@rows,@data);
|
|
if ($extra > 1){
|
|
$rows[$j]{main::key($num++,'chip ID')} = $chip_id;
|
|
}
|
|
}
|
|
# it's a device
|
|
else {
|
|
($class,$product,$protocol,$vendor,$speed) = ('','','','','');
|
|
foreach my $line (@id){
|
|
@row = split /:/, $line;
|
|
next if ! defined $row[0];
|
|
if ($row[0] eq 'bcdUSB' && defined $row[1]){
|
|
$speed = sprintf("%.1f",$row[1]);
|
|
}
|
|
elsif ($row[0] eq 'bDeviceClass' && defined $row[1] && $row[1] == 9){
|
|
$b_hub = 1;
|
|
}
|
|
elsif ($row[0] eq 'idVendor' && $row[2]){
|
|
$vendor = main::cleaner($row[2]);
|
|
}
|
|
elsif ($row[0] eq 'idProduct' && $row[2]){
|
|
$product = main::cleaner($row[2]);
|
|
}
|
|
# we want hubs to cascade to last item
|
|
elsif ($row[0] eq '~bInterfaceClass' && $row[2] && defined $row[1] && $row[1] != 9){
|
|
$class = main::cleaner($row[2]);
|
|
}
|
|
elsif ($row[0] eq '~bInterfaceProtocol' && defined $row[2]){
|
|
$protocol = $row[2];
|
|
$protocol =~ s/none//i if $protocol;
|
|
last if $class;
|
|
}
|
|
}
|
|
if ( $b_hub ){
|
|
if ($vendor && $product){
|
|
$protocol = "$vendor $product";
|
|
}
|
|
elsif (!$product && $protocol && $vendor){
|
|
$protocol = "$vendor $protocol";
|
|
}
|
|
$speed ||= 'N/A';
|
|
$protocol ||= 'N/A';
|
|
#print "pt2:$protocol\n";
|
|
@data = ({
|
|
main::key($num++,'Hub') => $bus_id,
|
|
main::key($num++,'usb') => $speed,
|
|
main::key($num++,'type') => $protocol,
|
|
},);
|
|
@rows = (@rows,@data);
|
|
}
|
|
else {
|
|
if ($vendor && $product){
|
|
if ($product !~ /$vendor/){
|
|
$product = "$vendor $product";
|
|
}
|
|
}
|
|
elsif (!$product && !$vendor && $protocol){
|
|
$product = $protocol;
|
|
}
|
|
elsif (!$product){
|
|
$product = $vendor;
|
|
}
|
|
# bInterfaceProtocol:0 but $row[2] undefined
|
|
#print "pt3:$class:$product\n";
|
|
# for we want Mass Storage Device instead of Bulk-Only
|
|
# we want to filter out certain protocol values that are less
|
|
# informative than the class type.
|
|
if ($protocol && $class && $class ne $protocol && protocol_filter($protocol) ){
|
|
$class = $protocol;
|
|
}
|
|
$class ||= 'N/A';
|
|
#print "pt3:$class:$product\n";
|
|
$product ||= 'N/A';
|
|
$speed ||= 'N/A';
|
|
$rows[$j]{main::key($num++,'Device')} = $product;
|
|
$rows[$j]{main::key($num++,'bus ID')} = $bus_id;
|
|
if ($extra > 0){
|
|
$rows[$j]{main::key($num++,'usb')} = $speed;
|
|
}
|
|
$rows[$j]{main::key($num++,'type')} = $class;
|
|
}
|
|
if ($extra > 1){
|
|
$rows[$j]{main::key($num++,'chip ID')} = $chip_id;
|
|
}
|
|
}
|
|
}
|
|
#print Data::Dumper::Dumper \@rows;
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub protocol_filter {
|
|
eval $start if $b_log;
|
|
my ($string) = @_;
|
|
$string =~ s/Bulk-Only|streaming|Bidirectional|None//i if $string;
|
|
eval $end if $b_log;
|
|
return $string;
|
|
}
|
|
}
|
|
|
|
## add metric / imperial (us) switch
|
|
## WeatherData
|
|
{
|
|
package WeatherData;
|
|
|
|
sub get {
|
|
eval $start if $b_log;
|
|
my (@rows,$key1,$val1);
|
|
my $num = 0;
|
|
@rows = create_output();
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub create_output {
|
|
eval $start if $b_log;
|
|
my $num = 0;
|
|
my (@data,@location,@rows,%weather,);
|
|
my ($conditions) = ('NA');
|
|
if ($show{'weather-location'}){
|
|
my $location_string;
|
|
$location_string = $show{'weather-location'};
|
|
$location_string =~ s/\+/ /g;
|
|
if ( $location_string =~ /,/){
|
|
my @temp = split /,/, $location_string;
|
|
my $sep = '';
|
|
my $string = '';
|
|
foreach (@temp){
|
|
$_ = ucfirst($_);
|
|
$string .= $sep . $_;
|
|
$sep = ', ';
|
|
}
|
|
$location_string = $string;
|
|
}
|
|
$location_string = main::apply_filter($location_string);
|
|
@location = ($show{'weather-location'},$location_string,'');
|
|
}
|
|
else {
|
|
@location = get_location();
|
|
if (!$location[0]) {
|
|
return @rows = ({
|
|
main::key($num++,'Message') => main::row_defaults('weather-null','current location'),
|
|
});
|
|
}
|
|
}
|
|
%weather = get_weather(@location);
|
|
if (!$weather{'weather'}) {
|
|
return @rows = ({
|
|
main::key($num++,'Message') => main::row_defaults('weather-null','weather data'),
|
|
});
|
|
}
|
|
if ($weather{'temp'} && $weather{'weather'} ){
|
|
$conditions = "$weather{'temp'} - $weather{'weather'}";
|
|
}
|
|
elsif ($weather{'temp'}){
|
|
$conditions = $weather{'temp'};
|
|
}
|
|
elsif ($weather{'weather'}) {
|
|
$conditions = $weather{'weather'};
|
|
}
|
|
@data = ({
|
|
main::key($num++,'Conditions') => $conditions,
|
|
},);
|
|
@rows = (@rows,@data);
|
|
if ($extra > 0){
|
|
$rows[0]{main::key($num++,'Wind')} = $weather{'wind'};
|
|
$rows[0]{main::key($num++,'Humidity')} = $weather{'humidity'};
|
|
$rows[0]{main::key($num++,'Pressure')} = $weather{'pressure'};
|
|
}
|
|
if ($extra > 1){
|
|
if ($weather{'heat-index'}){
|
|
$rows[0]{main::key($num++,'Heat Index')} = $weather{'heat-index'};
|
|
}
|
|
if ($weather{'windchill'}){
|
|
$rows[0]{main::key($num++,'Wind Chill')} = $weather{'windchill'};
|
|
}
|
|
if ($weather{'dewpoint'}){
|
|
$rows[0]{main::key($num++,'Dew Point')} = $weather{'dewpoint'};
|
|
}
|
|
}
|
|
if ($extra > 2){
|
|
if (!$show{'filter'}){
|
|
$rows[0]{main::key($num++,'Location')} = $location[1];
|
|
$rows[0]{main::key($num++,'altitude')} = $weather{'elevation'};
|
|
}
|
|
}
|
|
$rows[0]{main::key($num++,'Time')} = $weather{'date-time'};
|
|
if ($extra > 2){
|
|
$rows[0]{main::key($num++,'Observation Time')} = $weather{'observation-time-local'};
|
|
}
|
|
eval $end if $b_log;
|
|
return @rows;
|
|
}
|
|
sub get_weather {
|
|
eval $start if $b_log;
|
|
my (@location) = @_;
|
|
my $now = POSIX::strftime "%Y%m%d%H%M", localtime;
|
|
my ($date_time,$freshness,$tz,@weather_data,%weather);
|
|
my $loc_name = lc($location[0]);
|
|
$loc_name =~ s/-\/|\s|,/-/g;
|
|
$loc_name =~ s/--/-/g;
|
|
my $file_cached = "$user_data_dir/weather-$loc_name.txt";
|
|
if (-f $file_cached){
|
|
@weather_data = main::reader($file_cached);
|
|
$freshness = (split /\^\^/, $weather_data[0])[1];
|
|
#print "$now:$freshness\n";
|
|
}
|
|
if (!$freshness || $freshness < $now - 90) {
|
|
my $url = "http://api.wunderground.com/auto/wui/geo/WXCurrentObXML/index.xml?query=$location[0]";
|
|
my $temp;
|
|
# {
|
|
# #my $file2 = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/weather-1.xml";
|
|
# # my $file2 = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/feed-oslo-1.xml";
|
|
# local $/;
|
|
# my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/weather/weather-1.xml";
|
|
# open my $fh, '<', $file or die "can't open $file: $!";
|
|
# $temp = <$fh>;
|
|
# }
|
|
$temp = main::download_file('stdout',$url);
|
|
$temp =~ s/\r|\n\n/\n/g;
|
|
my @weather_temp = split /\n/, $temp;
|
|
foreach (@weather_temp){
|
|
chomp $_;
|
|
$_ =~ s/<\/[^>]+>//;
|
|
$_ =~ s/.*icon.*|\r//g;
|
|
$_ =~ s/\s\s/ /g;
|
|
$_ =~ s/^\s+|\s+$//g;
|
|
$_ =~ s/>/^^/;
|
|
$_ =~ s/^<|NA$//g;
|
|
$_ =~ s/^(current|credit|terms|image|title|link|.*_url).*//;
|
|
push @weather_data, $_ if $_ !~ /^\s*$/;
|
|
}
|
|
unshift (@weather_data,("timestamp^^$now"));
|
|
main::writer($file_cached,\@weather_data);
|
|
#print "$file_cached: download/cleaned\n";
|
|
}
|
|
#print join "\n", @weather_data, "\n";
|
|
|
|
foreach (@weather_data){
|
|
my @working = split /\s*\^\^\s*/,$_;
|
|
if ( $working[0] eq 'local_time' ){
|
|
$weather{'local-time'} = $working[1];
|
|
}
|
|
elsif ( $working[0] eq 'weather' ){
|
|
$weather{'weather'} = $working[1];
|
|
}
|
|
elsif ( $working[0] eq 'temperature_string' ){
|
|
$weather{'temp'} = $working[1];
|
|
# $weather{'temp'} =~ s/\sF/\xB0 F/; # B0
|
|
# $weather{'temp'} =~ s/\sF/\x{2109}/;
|
|
# $weather{'temp'} =~ s/\sC/\x{2103}/;
|
|
}
|
|
elsif ( $working[0] eq 'relative_humidity' ){
|
|
$weather{'humidity'} = $working[1];
|
|
}
|
|
elsif ( $working[0] eq 'wind_string' ){
|
|
$weather{'wind'} = $working[1];
|
|
}
|
|
elsif ( $working[0] eq 'pressure_string' ){
|
|
$weather{'pressure'} = $working[1];
|
|
}
|
|
elsif ( $working[0] eq 'heat_index_string' ){
|
|
$weather{'heat-index'} = $working[1];
|
|
}
|
|
elsif ( $working[0] eq 'windchill_string' ){
|
|
$weather{'windchill'} = $working[1];
|
|
}
|
|
elsif ( $working[0] eq 'dewpoint_string' ){
|
|
$weather{'dewpoint'} = $working[1];
|
|
}
|
|
elsif ( $working[0] eq 'observation_time_rfc822' ){
|
|
$weather{'observation-time-gmt'} = $working[1];
|
|
}
|
|
elsif ( $working[0] eq 'observation_time_rfc822' ){
|
|
$weather{'observation-time-gmt'} = $working[1];
|
|
}
|
|
elsif ( $working[0] eq 'observation_time' ){
|
|
$weather{'observation-time-local'} = $working[1];
|
|
$weather{'observation-time-local'} =~ s/Last Updated on //;
|
|
}
|
|
elsif (!$weather{'elevation'} && $working[0] eq 'elevation'){
|
|
# note: bug in source data uses ft for meters, not 100% of time, but usually
|
|
$weather{'elevation'} = $working[1];
|
|
$weather{'elevation'} =~ s/ft/m/;
|
|
}
|
|
}
|
|
if ($show{'weather-location'}){
|
|
$weather{'observation-time-local'} =~ /^(.*)\s([\S]+)$/;
|
|
$tz = $2;
|
|
# very clever trick, just make the system think it's in the
|
|
# remote timezone for this local block only
|
|
local $ENV{'TZ'} = $tz;
|
|
$date_time = POSIX::strftime "%c", localtime;
|
|
$weather{'date-time'} = $date_time;
|
|
}
|
|
else {
|
|
$date_time = POSIX::strftime "%c", localtime;
|
|
$tz = ( $location[2] ) ? " ($location[2])" : '';
|
|
$weather{'date-time'} = $date_time . $tz;
|
|
}
|
|
return %weather;
|
|
eval $end if $b_log;
|
|
}
|
|
sub get_location {
|
|
eval $start if $b_log;
|
|
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 (-f $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 = "$ENV{'HOME'}/bin/scripts/inxi/data/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::apply_filter("$city, $state, $country");
|
|
my @location = ($loc_arg,$loc_string,$loc{'tz'});
|
|
#print ($loc_arg,"\n", join "\n", @loc_data, "\n",scalar @loc_data, "\n");
|
|
eval $end if $b_log;
|
|
return @location;
|
|
}
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### UTILITIES FOR DATA LINES
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub get_compiler_version {
|
|
eval $start if $b_log;
|
|
my (@compiler);
|
|
if (my $file = system_files('version') ) {
|
|
@compiler = get_compiler_version_linux($file);
|
|
}
|
|
else {
|
|
@compiler = get_compiler_version_bsd();
|
|
}
|
|
eval $end if $b_log;
|
|
return @compiler;
|
|
}
|
|
|
|
sub get_compiler_version_bsd {
|
|
eval $start if $b_log;
|
|
my (@compiler,@working);
|
|
if ($alerts{'sysctl'}{'action'} eq 'use'){
|
|
# for dragonfly, we will use free mem, not used because free is 0
|
|
my @working;
|
|
foreach (@sysctl){
|
|
# freebsd seems to use bytes here
|
|
# Not every line will have a : separator though the processor should make
|
|
# most have it. This appears to be 10.x late feature add, I don't see it
|
|
# on earlier BSDs
|
|
if (/^kern.compiler_version/){
|
|
@working = split /:\s*/, $_;
|
|
$working[1] =~ /.*(gcc|clang)\sversion\s([\S]+)\s.*/;
|
|
@compiler = ($1,$2);
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
@compiler = ('N/A','');
|
|
}
|
|
log_data('dump','@compiler',\@compiler) if $b_log;
|
|
eval $end if $b_log;
|
|
return @compiler;
|
|
}
|
|
|
|
sub get_compiler_version_linux {
|
|
eval $start if $b_log;
|
|
my ($file) = @_;
|
|
my (@compiler,$type);
|
|
my @data = reader($file);
|
|
my $result = $data[0] if @data;
|
|
if ($result){
|
|
$result =~ /(gcc|clang).*version\s([\S]+)/;
|
|
# $result = $result =~ /\*(gcc|clang)\*eval\*/;
|
|
if ($1){
|
|
$type = $2;
|
|
$type ||= 'N/A'; # we don't really know what linux clang looks like!
|
|
@compiler = ($1,$type);
|
|
}
|
|
}
|
|
log_data('dump','@compiler',\@compiler) if $b_log;
|
|
|
|
eval $end if $b_log;
|
|
return @compiler;
|
|
}
|
|
|
|
## Get DesktopEnvironment
|
|
## returns array:
|
|
# 0 - desktop name
|
|
# 1 - version
|
|
# 2 - toolkit
|
|
# 3 - toolkit version
|
|
# 4 - info extra desktop data
|
|
# 5 - wm
|
|
{
|
|
package DesktopEnvironment;
|
|
my ($b_xprop,$kde_session_version,$xdg_desktop,@desktop,@data,@xprop);
|
|
sub get {
|
|
# 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)
|
|
$xdg_desktop = ( $ENV{'XDG_CURRENT_DESKTOP'} ) ? lc($ENV{'XDG_CURRENT_DESKTOP'}) : '';
|
|
$kde_session_version = ($ENV{'KDE_SESSION_VERSION'}) ? $ENV{'KDE_SESSION_VERSION'} : '';
|
|
get_kde_data();
|
|
if (!@desktop){
|
|
get_env_de_data();
|
|
}
|
|
if (!@desktop){
|
|
get_env_xprop_de_data();
|
|
}
|
|
if (!@desktop && $b_xprop ){
|
|
get_xprop_de_data();
|
|
}
|
|
if (!@desktop){
|
|
get_ps_de_data();
|
|
}
|
|
if ($extra > 2 && @desktop){
|
|
set_info_data();
|
|
}
|
|
if ($b_display && !$b_force_display && $extra > 2){
|
|
get_wm();
|
|
}
|
|
main::log_data('dump','@desktop', \@desktop) if $b_log;
|
|
# ($b_xprop,$kde_session_version,$xdg_desktop,@data,@xprop) = undef;
|
|
return @desktop;
|
|
}
|
|
sub get_kde_data {
|
|
eval $start if $b_log;
|
|
my ($program,@version_data,@version_data2);
|
|
my $kde_full_session = ($ENV{'KDE_FULL_SESSION'}) ? $ENV{'KDE_FULL_SESSION'} : '';
|
|
return 1 if ($xdg_desktop ne 'kde' && !$kde_session_version && $kde_full_session ne 'true' );
|
|
# 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
|
|
if ($xdg_desktop eq 'kde' || $kde_session_version ){
|
|
if ($kde_session_version && $kde_session_version <= 4){
|
|
@data = main::program_values("kded$kde_session_version");
|
|
if (@data){
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version("kded$kde_session_version",$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
# kded exists, so we can now get the qt data string as well
|
|
if ($desktop[1] && ($program = main::check_program("kded$kde_session_version")) ){
|
|
@version_data = main::grabber("$program --version 2>/dev/null");
|
|
}
|
|
}
|
|
$desktop[0] = 'KDE' if !$desktop[0];
|
|
}
|
|
else {
|
|
# NOTE: this command string is almost certain to change, and break, with next
|
|
# major plasma desktop, ie, 6.
|
|
# qdbus org.kde.plasmashell /MainApplication org.qtproject.Qt.QCoreApplication.applicationVersion
|
|
# Qt: 5.4.2
|
|
# KDE Frameworks: 5.11.0
|
|
# kf5-config: 1.0
|
|
# for QT, and Frameworks if we use it
|
|
if (!@version_data && ($program = main::check_program("kf$kde_session_version-config") )){
|
|
@version_data = main::grabber("$program --version 2>/dev/null");
|
|
}
|
|
if (!@version_data && ($program = main::check_program("kded$kde_session_version"))){
|
|
@version_data = main::grabber("$program --version 2>/dev/null");
|
|
}
|
|
if ($program = main::check_program("plasmashell")){
|
|
@version_data2 = main::grabber("$program --version 2>/dev/null");
|
|
$desktop[1] = main::awk(\@version_data2,'^plasmashell',-1,'\s+');
|
|
}
|
|
$desktop[0] = 'KDE Plasma';
|
|
}
|
|
if (!$desktop[1]){
|
|
$desktop[1] = ($kde_session_version) ? $kde_session_version: main::row_defaults('unknown-desktop-version');
|
|
}
|
|
# print Data::Dumper::Dumper \@version_data;
|
|
if ($extra > 0 && @version_data){
|
|
$desktop[2] = 'Qt';
|
|
$desktop[3] = main::awk(\@version_data,'^Qt:', 2,'\s+');
|
|
}
|
|
}
|
|
# KDE_FULL_SESSION property is only available since KDE 3.5.5.
|
|
elsif ($kde_full_session eq 'true'){
|
|
@version_data = main::grabber("kded --version 2>/dev/null");
|
|
$desktop[0] = 'KDE';
|
|
$desktop[1] = main::awk(\@version_data,'^KDE:',2,'\s+') if @version_data;
|
|
if (!$desktop[1]){
|
|
$desktop[1] = '3.5';
|
|
}
|
|
if ($extra > 0 && @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 ($xdg_desktop eq 'unity'){
|
|
@data = main::program_values('unity');
|
|
$desktop[0] = $data[3];
|
|
$desktop[0] ||= 'Unity';
|
|
$desktop[1] = main::program_version('cinnamon',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
set_gtk_data() if $extra > 0;
|
|
}
|
|
elsif ( $xdg_desktop =~ /budgie/ ){
|
|
@data = main::program_values('budgie');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('budgie-desktop',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
set_gtk_data() if $extra > 0;
|
|
}
|
|
elsif ( $xdg_desktop eq 'lxqt' ){
|
|
@data = main::program_values('lxqt');
|
|
$desktop[0] = $data[3];
|
|
$desktop[0] ||= 'LXQT';
|
|
$desktop[1] = main::program_version('lxqt-about',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
if ( $extra > 0 ){
|
|
if ($program = main::check_program("kded$kde_session_version") ){
|
|
@version_data = main::grabber("$program --version 2>/dev/null");
|
|
$desktop[2] = 'Qt';
|
|
$desktop[3] = main::awk(\@version_data,'^Qt:',2);
|
|
}
|
|
elsif ($program = main::check_program("qtdiag") ){
|
|
@data = main::program_values('qtdiag');
|
|
$desktop[3] = main::program_version($program,$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
$desktop[2] = $data[3];
|
|
}
|
|
}
|
|
}
|
|
# note, X-Cinnamon value strikes me as highly likely to change, so just
|
|
# search for the last part
|
|
elsif ( $xdg_desktop =~ /cinnamon/ ){
|
|
@data = main::program_values('cinnamon');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('cinnamon',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
set_gtk_data() if $extra > 0;
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
sub get_env_xprop_de_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();
|
|
# 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 'muffinr' but that's not part of cinnom
|
|
if ( (main::check_program('muffin') || main::check_program('cinnamon-session') ) &&
|
|
($b_xprop && main::awk(\@xprop,'_muffin') )){
|
|
@data = main::program_values('cinnamon');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('cinnamon',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
set_gtk_data() if $extra > 0;
|
|
$desktop[0] ||= 'Cinnamon';
|
|
}
|
|
elsif ($xdg_desktop eq 'mate' || ( $b_xprop && main::awk(\@xprop,'_marco') )){
|
|
# NOTE: mate-about reported wrong version, 1.18.0 when actual was 1.18.2
|
|
if ($program = main::check_program('mate-session') ) {
|
|
$value = 'mate-session';
|
|
}
|
|
elsif ($program = main::check_program('mate-about')) {
|
|
$value = 'mate-about';
|
|
}
|
|
if ($value){
|
|
@data = main::program_values($value);
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version($program,$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
set_gtk_data() if $extra > 0;
|
|
$desktop[0] ||= 'MATE';
|
|
}
|
|
# 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...
|
|
elsif ($xdg_desktop eq 'gnome' || $ENV{'GNOME_DESKTOP_SESSION_ID'} ||
|
|
(main::check_program('gnome-shell') && $b_xprop && main::awk(\@xprop,'^_gnome') ) ){
|
|
if ($program = main::check_program('gnome-about') ) {
|
|
@data = main::program_values('gnome-about');
|
|
$desktop[1] = main::program_version('gnome-about',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
elsif ($program = main::check_program('gnome-shell') ) {
|
|
@data = main::program_values('gnome-shell');
|
|
$desktop[1] = main::program_version('gnome-shell',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
set_gtk_data() if $extra > 0;
|
|
$desktop[0] = ( $data[3] ) ? $data[3] : 'Gnome';
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
sub get_xprop_de_data {
|
|
eval $start if $b_log;
|
|
my ($program,@version_data,$version);
|
|
#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)
|
|
if ($xdg_desktop eq 'xfce' || main::awk(\@xprop,'xfce' )){
|
|
# this is a very expensive test that doesn't usually result in a find
|
|
# talk to xfce to see what id they will be using for xfce 5
|
|
# if (main::awk(\@xprop, 'xfce4')){
|
|
# $version = '4';
|
|
# }
|
|
if (main::awk(\@xprop, 'xfce5')){
|
|
$version = '5';
|
|
}
|
|
else {
|
|
$version = '4';
|
|
}
|
|
@data = main::program_values('xfdesktop');
|
|
$desktop[0] = $data[3];
|
|
# xfdesktop --version out of x fails to get display, so no data
|
|
@version_data = main::grabber('xfdesktop --version 2>/dev/null');
|
|
# out of x, this error goes to stderr, so it's an empty result
|
|
$desktop[1] = main::awk(\@version_data,$data[0],$data[1],'\s+');
|
|
#$desktop[1] = main::program_version('xfdesktop',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
if ( !$desktop[1] ){
|
|
@data = main::program_values("xfce${version}-panel");
|
|
# print Data::Dumper::Dumper \@data;
|
|
# 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] ||= 4;
|
|
if ($extra > 0){
|
|
@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];
|
|
}
|
|
}
|
|
elsif ( (main::check_program('blackbox') || main::check_program('fluxbox')) && main::awk(\@xprop,'blackbox_pid' )){
|
|
if (grep {/fluxbox/} @ps_cmd){
|
|
@data = main::program_values('fluxbox');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('fluxbox',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
else {
|
|
@data = main::program_values('blackbox');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('blackbox',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
}
|
|
# debian package: lxde-core
|
|
elsif ( (main::check_program('lxpanel') || main::check_program('lxqt-session') ||
|
|
main::check_program('razor-session')) && main::awk(\@xprop,'openbox_pid' )){
|
|
# note: openbox-lxde --version may be present, but returns openbox data
|
|
@data = main::program_values('openbox');
|
|
$desktop[1] = main::program_version('openbox',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
if ($xdg_desktop eq 'lxde' || main::awk(\@ps_cmd, 'lxsession')){
|
|
$desktop[1] = "(Openbox $desktop[1])" if $desktop[1];
|
|
$desktop[0] = 'LXDE';
|
|
}
|
|
elsif ($xdg_desktop eq 'razor' || $xdg_desktop eq 'lxqt' || main::awk(\@ps_cmd, 'razor-desktop|lxqt-session')) {
|
|
if (main::awk(\@ps_cmd,'lxqt-session' )){
|
|
$desktop[0] = 'LXQt';
|
|
}
|
|
elsif (main::awk(\@ps_cmd, 'razor-desktop')){
|
|
$desktop[0] = 'Razor-Qt';
|
|
}
|
|
else {
|
|
$desktop[0] = 'LX-Qt-Variant';
|
|
}
|
|
$desktop[1] = "(Openbox $desktop[1])" if $desktop[1];
|
|
}
|
|
else {
|
|
$desktop[0] = 'Openbox';
|
|
}
|
|
}
|
|
elsif (main::check_program('icewm') && main::awk(\@xprop,'icewm' )){
|
|
@data = main::program_values('icewm');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('icewm',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
elsif (main::check_program('enlightenment') && main::awk(\@xprop,'enlightenment' )){
|
|
$desktop[0] = 'Enlightenment';
|
|
# no -v or --version but version is in xprop -root
|
|
# ENLIGHTENMENT_VERSION(STRING) = "Enlightenment 0.16.999.49898"
|
|
$desktop[1] = main::awk(\@xprop,'enlightenment_version',2,'\s+=\s+' );
|
|
$desktop[1] = (split /"/, $desktop[1])[1] if $desktop[1];
|
|
$desktop[1] = (split /\s+/, $desktop[1])[1] if $desktop[1];
|
|
}
|
|
# debian package: i3-wm
|
|
elsif (main::check_program('i3') && main::awk(\@xprop,'^i3_' )){
|
|
@data = main::program_values('i3');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('i3',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
# debian package name: wmaker
|
|
elsif (main::check_program('WindowMaker') && main::awk(\@xprop,'^windowmaker' )){
|
|
@data = main::program_values('wmaker');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('wmaker',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
elsif (main::check_program('wm2') && main::awk(\@xprop,'^_wm2' )){
|
|
@data = main::program_values('wm2');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('wm2',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
elsif (main::check_program('herbstluftwm') && main::awk(\@xprop,'herbstluftwm' )){
|
|
@data = main::program_values('herbstluftwm');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('herbstluftwm',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
# 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);
|
|
if ( main::check_program('fvwm-crystal') && main::awk(\@ps_cmd,'fvwm-crystal' )){
|
|
@data = main::program_values('fvwm-crystal');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('fvwm',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
elsif ((main::check_program('fvwm2') || main::check_program('fvwm')) && main::awk(\@ps_cmd,'fvwm' )){
|
|
@data = main::program_values('fvwm');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('fvwm',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
elsif (main::check_program('pekwm') && main::awk(\@ps_cmd,'pekwm' )){
|
|
@data = main::program_values('pekwm');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('pekwm',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
elsif (main::check_program('awesome') && main::awk(\@ps_cmd,'awesome' )){
|
|
@data = main::program_values('awesome');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('awesome',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
# not in debian apt
|
|
elsif (main::check_program('scrotwm') && main::awk(\@ps_cmd,'scrotwm' )){
|
|
@data = main::program_values('scrotwm');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('scrotwm',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
elsif (main::check_program('spectrwm') && main::awk(\@ps_cmd,'spectrwm' )){
|
|
@data = main::program_values('spectrwm');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('spectrwm',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
elsif (main::check_program('twm') && main::awk(\@ps_cmd,'(\s|\/)twm' )){
|
|
# no version
|
|
$desktop[0] = 'Twm';
|
|
}
|
|
# note: built from source, but I assume it will show: /usr/bin/dwm
|
|
elsif (main::check_program('dwm') && main::awk(\@ps_cmd,'(\s|\/)dwm' )){
|
|
@data = main::program_values('dwm');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('dwm',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
# not in debian apt, current is wmii, version 3
|
|
elsif (main::check_program('wmii2') && main::awk(\@ps_cmd,'wmii2' )){
|
|
@data = main::program_values('wmii2');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('wmii2',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
elsif (main::check_program('wmii') && main::awk(\@ps_cmd,'wmii' )){
|
|
@data = main::program_values('wmii');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('wmii',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
elsif (main::check_program('jwm') && main::awk(\@ps_cmd,'(\s|\/)jwm' )){
|
|
@data = main::program_values('jwm');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('jwm',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
elsif (main::check_program('sawfish') && main::awk(\@ps_cmd,'sawfish' )){
|
|
@data = main::program_values('sawfish');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('sawfish',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
elsif ( main::check_program('afterstep') && grep {/afterstep/} @ps_cmd){
|
|
@data = main::program_values('afterstep');
|
|
$desktop[0] = $data[3];
|
|
$desktop[1] = main::program_version('afterstep',$data[0],$data[1],$data[2],$data[5],$data[6]);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_wm {
|
|
eval $start if $b_log;
|
|
if ( my $program = main::check_program('wmctrl') ){
|
|
my $cmd = "$program -m 2>/dev/null";
|
|
my @data = main::grabber($cmd,'','strip');
|
|
$desktop[5] = main::awk(\@data,'^Name',2,'\s*:\s*');
|
|
if ($desktop[5]){
|
|
# IceWM 1.3.8 (Linux 3.2.0-4-amd64/i686)
|
|
$desktop[5] =~ s/[0-9]+\.[0-9][\S]+|[\[\(].*[\)\]]//g;
|
|
$desktop[5] = main::trimmer($desktop[5]);
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_gtk_data {
|
|
eval $start if $b_log;
|
|
my ($version,$program,@data);
|
|
# this is a hack, and has to be changed with every toolkit version change, and
|
|
# only dev systems # have this installed, but it's a cross distro command try it.
|
|
if ($program = main::check_program('pkg-config')){
|
|
@data = main::grabber("$program --modversion gtk+-4.0 2>/dev/null");
|
|
$version = main::awk(\@data,'\S');
|
|
# note: opensuse gets null output here, we need the command to get version and output sample
|
|
if ( !$version ){
|
|
@data = main::grabber("$program --modversion gtk+-3.0 2>/dev/null");
|
|
$version = main::awk(\@data,'\S');
|
|
}
|
|
if ( !$version ){
|
|
@data = main::grabber("$program --modversion gtk+-2.0 2>/dev/null");
|
|
$version = main::awk(\@data,'\S');
|
|
}
|
|
}
|
|
# now let's go to more specific version tests, this will never cover everything and that's fine.
|
|
if (!$version){
|
|
# we'll try some known package managers next. dpkg will handle a lot of distros
|
|
# this is the most likely order as of: 2014-01-13. Not going to try to support all
|
|
# package managers too much work, just the very biggest ones.
|
|
if ($program = main::check_program('dpkg')){
|
|
@data = main::grabber("$program -s libgtk-3-0 2>/dev/null");
|
|
$version = main::awk(\@data,'^\s*Version',2,'\s+');
|
|
# just guessing on gkt 4 package name
|
|
if (!$version){
|
|
@data = main::grabber("$program -s libgtk-4-0 2>/dev/null");
|
|
$version = main::awk(\@data,'^\s*Version',2,'\s+');
|
|
}
|
|
if (!$version){
|
|
@data = main::grabber("$program -s libgtk2.0-0 2>/dev/null");
|
|
$version = main::awk(\@data,'^\s*Version',2,'\s+');
|
|
}
|
|
}
|
|
elsif ($program = main::check_program('pacman')){
|
|
@data = main::grabber("$program -Qi gtk3 2>/dev/null");
|
|
$version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
|
|
# just guessing on gkt 4 package name
|
|
if (!$version){
|
|
@data = main::grabber("$program -Qi gtk4 2>/dev/null");
|
|
$version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
|
|
}
|
|
if (!$version){
|
|
@data = main::grabber("$program -Qi gtk2 2>/dev/null");
|
|
$version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
|
|
}
|
|
}
|
|
elsif ($program = main::check_program('rpm')){
|
|
@data = main::grabber("$program -qi libgtk-3-0 2>/dev/null");
|
|
$version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
|
|
# just guessing on gkt 4 package name
|
|
if (!$version){
|
|
@data = main::grabber("$program -qi libgtk-4-0 2>/dev/null");
|
|
$version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
|
|
}
|
|
if (!$version){
|
|
@data = main::grabber("$program -qi libgtk-3-0 2>/dev/null");
|
|
$version = main::awk(\@data,'^\s*Version',2,'\s*:\s*');
|
|
}
|
|
}
|
|
}
|
|
$desktop[2] = 'Gtk';
|
|
eval $end if $b_log;
|
|
}
|
|
sub set_info_data {
|
|
eval $start if $b_log;
|
|
my (@data,@info,$item);
|
|
my $pattern = 'gnome-shell|gnome-panel|kicker|lxpanel|mate-panel|';
|
|
$pattern .= 'plasma-desktop|plasma-netbook|xfce4-panel';
|
|
if (@data = grep {/($pattern)(\s|$)/} @ps_cmd ) {
|
|
# 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];
|
|
}
|
|
}
|
|
}
|
|
$desktop[4] = join (',', @info) if @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
|
|
my $pattern = 'blackbox_pid|enlightenment|^_gnome|herbstluftwm|';
|
|
$pattern .= '^i3_|icewm|_marco|_muffin|openbox_pid|^windowmaker|^_wm2|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;
|
|
}
|
|
|
|
}
|
|
|
|
sub get_display_manager {
|
|
eval $start if $b_log;
|
|
my (@data,@found,$temp,$working);
|
|
# ldm - LTSP display manager. Note that sddm does not appear to have a .pid
|
|
# extension in Arch note: to avoid positives with directories, test for -f
|
|
# explicitly, not -e
|
|
my @dms = qw(entranced.pid gdm.pid gdm3.pid kdm.pid ldm.pid
|
|
lightdm.pid lxdm.pid mdm.pid nodm.pid sddm.pid sddm slim.lock
|
|
tint2.pid wdm.pid xdm.pid xenodm.pid);
|
|
# this is the only one I know of so far that has --version
|
|
# lightdm outputs to stderr, so it has to be redirected
|
|
my @dms_version = qw(lightdm);
|
|
foreach my $id (@dms){
|
|
# note: ${dm_id%.*}/$dm_id will create a dir name out of the dm id, then
|
|
# test if pid is in that note: sddm, in an effort to be unique and special,
|
|
# do not use a pid/lock file, but rather a random string inside a directory
|
|
# called /run/sddm/ so assuming the existence of the pid inside a directory named
|
|
# from the dm. Hopefully this change will not have negative results.
|
|
$working = $id;
|
|
$working =~ s/\.\S+$//;
|
|
# note: there's always been an issue with duplicated dm's in inxi, this should now correct it
|
|
if ( ( -f "/run/$id" || -d "/run/$working" || -f "/var/run/$id" ) && ! grep {/$working/} @found ){
|
|
if ($extra > 2 && awk( \@dms_version, $working) ){
|
|
@data = main::grabber("$working --version 2>&1");
|
|
$temp = awk(\@data,'\S',2,'\s+');
|
|
$working .= ' ' . $temp if $temp;
|
|
}
|
|
push @found, $working;
|
|
}
|
|
}
|
|
if (!@found && grep {/\/usr.*\/x/ && !/\/xprt/} @ps_cmd){
|
|
if (awk (\@ps_cmd, 'startx') ){
|
|
$found[0] = 'startx';
|
|
}
|
|
elsif (awk (\@ps_cmd, 'xinit') ){
|
|
$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
|
|
log_data('dump','display manager: @found',\@found) if $b_log;
|
|
eval $end if $b_log;
|
|
return join ',', @found if @found;
|
|
}
|
|
|
|
## Get DistroData
|
|
{
|
|
package DistroData;
|
|
my ($distro);
|
|
sub get {
|
|
eval $start if $b_log;
|
|
if ($bsd_type){
|
|
get_bsd_os();
|
|
}
|
|
else {
|
|
get_linux_distro();
|
|
}
|
|
eval $end if $b_log;
|
|
return $distro;
|
|
}
|
|
|
|
sub get_bsd_os {
|
|
eval $start if $b_log;
|
|
if ($bsd_type eq 'darwin'){
|
|
my $file = '/System/Library/CoreServices/SystemVersion.plist';
|
|
if (-f $file){
|
|
my @data = main::reader($file);
|
|
@data = grep {/(ProductName|ProductVersion)/} @data if @data;
|
|
@data = grep {/<string>/} @data if @data;
|
|
@data = map {s/<[\/]?string>//g; } @data if @data;
|
|
$distro = join (' ', @data);
|
|
}
|
|
}
|
|
else {
|
|
$distro = "$uname[0] $uname[2]";
|
|
}
|
|
eval $end if $b_log;
|
|
return $distro;
|
|
}
|
|
|
|
sub get_linux_distro {
|
|
eval $start if $b_log;
|
|
my ($distro_file) = ('');
|
|
my ($b_osr,@working);
|
|
my @derived = qw(antix-version aptosid-version kanotix-version knoppix-version
|
|
mandrake-release manjaro-release mx-version pardus-release porteus-version sabayon-release
|
|
siduction-version sidux-version slitaz-release solusos-release turbolinux-release
|
|
zenwalk-version);
|
|
my $derived_s = join "|", @derived;
|
|
my @primary = qw(arch-release gentoo-release redhat-release slackware-version
|
|
SuSE-release);
|
|
my $primary_s = join "|", @primary;
|
|
my $exclude_s = 'debian_version|devuan_version|ubuntu_version';
|
|
my $lsb_good_s = 'mandrake-release|mandriva-release|mandrakelinux-release|manjaro-release';
|
|
my $os_release_good_s = 'arch-release|SuSE-release';
|
|
# note: always exceptions, so wild card after release/version:
|
|
# /etc/lsb-release-crunchbang
|
|
# wait to handle since crunchbang file is one of the few in the world that
|
|
# uses this method
|
|
my @distro_files = glob('/etc/*[-_]{[rR]elease,[vV]ersion}*');
|
|
my $lsb_release = '/etc/lsb-release';
|
|
my $issue = '/etc/issue';
|
|
my $os_release = '/etc/os-release';
|
|
my $b_os_release = ( -f $os_release ) ? 1 : 0;
|
|
my $b_lsb = ( -f $lsb_release ) ? 1 : 0;
|
|
main::log_data('dump','@distro_files',\@distro_files) if $b_log;
|
|
if ( scalar @distro_files == 1 ){
|
|
$distro_file = $distro_files[0];
|
|
}
|
|
elsif (scalar @distro_files > 1) {
|
|
# special case, to force manjaro which also has arch-release
|
|
# manjaro should use lsb, which has the full info, arch uses os release
|
|
if (grep {/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)$/){
|
|
# Now lets see if the distro file is in the known-good working-lsb-list
|
|
# if so, use lsb-release, if not, then just use the found file
|
|
# this is for only those distro's with self named release/version files
|
|
# because Mint does not use such, it must be done as below
|
|
if ($b_lsb && $file =~ /$lsb_good_s/){
|
|
$distro_file = $lsb_release;
|
|
}
|
|
elsif ($b_os_release && $file =~ /($os_release_good_s)$/){
|
|
$distro_file = $os_release;
|
|
}
|
|
else {
|
|
$distro_file = "/etc/$file";
|
|
}
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
main::log_data('data',"distro_file: $distro_file") if $b_log;
|
|
# first test for the legacy antiX distro id file
|
|
if ( -f '/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) ){
|
|
$distro = get_lsb_release();
|
|
}
|
|
elsif ($distro_file eq $os_release){
|
|
$distro = get_os_release();
|
|
$b_osr = 1;
|
|
}
|
|
# if distro id file was found and it's not in the exluded primary distro file list, read it
|
|
elsif ( $distro_file && -s $distro_file && $distro_file !~ /\/etc\/($exclude_s)$/){
|
|
# new opensuse uses os-release, but older ones may have a similar syntax, so just use
|
|
# 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');
|
|
$distro = main::clean_characters($distro) if $distro;
|
|
}
|
|
else {
|
|
$distro = (main::reader($distro_file))[0];
|
|
}
|
|
}
|
|
# otherwise try the default debian/ubuntu /etc/issue file
|
|
elsif (-f $issue){
|
|
@working = main::reader($issue);
|
|
my $b_mint = scalar (grep {/mint/i} @working);
|
|
# os-release/lsb gives more manageable and accurate output than issue,
|
|
# but mint should use issue for now.
|
|
if ($b_os_release && !$b_mint){
|
|
$distro = get_os_release();
|
|
$b_osr = 1;
|
|
}
|
|
elsif ($b_lsb && !$b_mint){
|
|
$distro = get_lsb_release();
|
|
}
|
|
else {
|
|
# debian issue can end with weird escapes like \n \l
|
|
@working = main::reader($issue);
|
|
$distro = (map {s/\\[a-z]|,|\*|\\||\"|[:\47]|^\s+|\s+$|n\/a//ig; $_} @working)[0] if @working;
|
|
# 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
|
|
if ($distro && length($distro) > 50 ){
|
|
if (!$b_osr && $b_os_release){
|
|
$distro = get_os_release();
|
|
}
|
|
}
|
|
# test for /etc/lsb-release as a backup in case of failure, in cases
|
|
# where > one version/release file were found but the above resulted
|
|
# in null distro value.
|
|
if (!$distro){
|
|
if ($b_os_release){
|
|
$distro = get_os_release();
|
|
}
|
|
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/[-_]|release|version//g;
|
|
}
|
|
}
|
|
## finally, if all else has failed, give up
|
|
$distro ||= 'unknown';
|
|
eval $end if $b_log;
|
|
return $distro;
|
|
}
|
|
sub get_lsb_release {
|
|
eval $start if $b_log;
|
|
my ($distro,$id,$release,$codename,$description) = ('','','','','');
|
|
my @content = main::reader('/etc/lsb-release');
|
|
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 'DISTRIB_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];
|
|
}
|
|
}
|
|
if ($working[0] eq 'DISTRIB_RELEASE' && $working[1]){
|
|
$release = $working[1];
|
|
}
|
|
if ($working[0] eq 'DISTRIB_CODENAME' && $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.
|
|
if ($working[0] eq 'DISTRIB_DESCRIPTION' && $working[1]){
|
|
$description = $working[1];
|
|
}
|
|
}
|
|
if (!$id && !$release && !$codename && $description){
|
|
$distro = $description;
|
|
}
|
|
else {
|
|
$distro = "$id $release $codename";
|
|
$distro =~ s/^\s+|\s\s+|\s+$//g; # get rid of double and trailling spaces
|
|
}
|
|
eval $end if $b_log;
|
|
return $distro;
|
|
}
|
|
sub get_os_release {
|
|
eval $start if $b_log;
|
|
my ($pretty_name,$name,$version_name,$version_id,
|
|
$distro_name,$distro) = ('','','','','','');
|
|
my @content = main::reader('/etc/os-release');
|
|
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]){
|
|
$pretty_name = $working[1];
|
|
}
|
|
if ($working[0] eq 'NAME' && $working[1]){
|
|
$name = $working[1];
|
|
}
|
|
if ($working[0] eq 'VERSION' && $working[1]){
|
|
$version_name = $working[1];
|
|
}
|
|
if ($working[0] eq 'VERSION_ID' && $working[1]){
|
|
$version_id = $working[1];
|
|
}
|
|
}
|
|
# NOTE: tumbleweed has pretty name but pretty name does not have version id
|
|
if ($pretty_name && $pretty_name !~ /tumbleweed/i){
|
|
$distro = $pretty_name;
|
|
}
|
|
elsif ($name){
|
|
$distro = $name;
|
|
if ($version_name){
|
|
$distro .= ' ' . $version_name;
|
|
}
|
|
elsif ($version_id){
|
|
$distro .= ' ' . $version_id;
|
|
}
|
|
|
|
}
|
|
eval $end if $b_log;
|
|
return $distro;
|
|
}
|
|
}
|
|
|
|
sub get_gcc_data {
|
|
eval $start if $b_log;
|
|
my ($gcc,@data,@gccs,@temp);
|
|
# NOTE: We can't use program_version because we don't yet know where
|
|
# the version number is
|
|
if (my $program = check_program('gcc') ){
|
|
@data = grabber("$program --version 2>/dev/null");
|
|
$gcc = awk(\@data,'^gcc');
|
|
}
|
|
if ($gcc){
|
|
# strip out: gcc (Debian 6.3.0-18) 6.3.0 20170516
|
|
# gcc (GCC) 4.2.2 20070831 prerelease [FreeBSD]
|
|
$gcc =~ s/\([^\)]*\)//g;
|
|
$gcc = get_piece($gcc,2);
|
|
}
|
|
if ($extra > 1){
|
|
# glob /usr/bin for gccs, strip out all non numeric values
|
|
@temp = globber('/usr/bin/gcc-*');
|
|
foreach (@temp){
|
|
if (/\/gcc-([0-9.]+)$/){
|
|
push @gccs, $1;
|
|
}
|
|
}
|
|
}
|
|
unshift @gccs, $gcc;
|
|
log_data('dump','@gccs',\@gccs) if $b_log;
|
|
eval $end if $b_log;
|
|
return @gccs;
|
|
}
|
|
|
|
sub get_hostname {
|
|
eval $start if $b_log;
|
|
my $hostname = '';
|
|
if ( $ENV{'HOSTNAME'} ){
|
|
$hostname = $ENV{'HOSTNAME'};
|
|
}
|
|
elsif ( !$bsd_type && -f "/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_module('Sys::Hostname')){
|
|
import Sys::Hostname;
|
|
$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;
|
|
}
|
|
|
|
sub get_init_data {
|
|
eval $start if $b_log;
|
|
my $runlevel = get_runlevel_data();
|
|
my $default = ($extra > 1) ? get_runlevel_default() : '';
|
|
my ($init,$init_version,$rc,$rc_version,$program) = ('','','','','');
|
|
my $comm = ( -e '/proc/1/comm' ) ? (reader('/proc/1/comm'))[0] : '';
|
|
my (@data);
|
|
# this test is pretty solid, if pid 1 is owned by systemd, it is systemd
|
|
# otherwise that is 'init', which covers the rest of the init systems.
|
|
# more data may be needed for other init systems.
|
|
if ( $comm ){
|
|
if ( $comm =~ /systemd/ ){
|
|
$init = 'systemd';
|
|
if ( $program = check_program('systemd')){
|
|
$init_version = program_version($program,'^systemd','2','--version');
|
|
}
|
|
if (!$init_version && ($program = check_program('systemctl') ) ){
|
|
$init_version = program_version($program,'^systemd','2','--version');
|
|
}
|
|
}
|
|
# epoch version == Epoch Init System 1.0.1 "Sage"
|
|
elsif ($comm =~ /epoch/){
|
|
$init = 'Epoch';
|
|
$init_version = program_version('epoch', '^Epoch', '4','version');
|
|
}
|
|
# 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';
|
|
}
|
|
}
|
|
if (!$init){
|
|
# output: /sbin/init --version: init (upstart 1.1)
|
|
# init (upstart 0.6.3)
|
|
if ($init_version = program_version('init', 'upstart', '3','--version')){
|
|
$init = 'Upstart';
|
|
}
|
|
elsif (check_program('launchctl')){
|
|
$init = 'launchd';
|
|
}
|
|
elsif ( -f '/etc/inittab' ){
|
|
$init = 'SysVinit';
|
|
if (check_program('strings')){
|
|
@data = grabber('strings /sbin/init');
|
|
$init_version = awk(\@data,'version\s+[0-9]');
|
|
$init_version = get_piece($init_version,2) if $init_version;
|
|
}
|
|
}
|
|
elsif ( -f '/etc/ttys' ){
|
|
$init = 'init (BSD)';
|
|
}
|
|
}
|
|
if ( grep { /openrc/ } globber('/run/*openrc*') ){
|
|
$rc = 'OpenRC';
|
|
# /sbin/openrc --version == openrc (OpenRC) 0.13
|
|
if ($program = check_program('openrc')){
|
|
$rc_version = program_version($program, '^openrc', '3','--version');
|
|
}
|
|
# /sbin/rc --version == rc (OpenRC) 0.11.8 (Gentoo Linux)
|
|
elsif ($program = check_program('rc')){
|
|
$rc_version = program_version($program, '^rc', '3','--version');
|
|
}
|
|
if ( -e '/run/openrc/softlevel' ){
|
|
$runlevel = (reader('/run/openrc/softlevel'))[0];
|
|
}
|
|
elsif ( -e '/var/run/openrc/softlevel'){
|
|
$runlevel = (reader('/var/run/openrc/softlevel'))[0];
|
|
}
|
|
elsif ( $program = check_program('rc-status')){
|
|
$runlevel = (grabber("$program -r 2>/dev/null"))[0];
|
|
}
|
|
}
|
|
my %init = (
|
|
'init-type' => $init,
|
|
'init-version' => $init_version,
|
|
'rc-type' => $rc,
|
|
'rc-version' => $rc_version,
|
|
'runlevel' => $runlevel,
|
|
'default' => $default,
|
|
);
|
|
eval $end if $b_log;
|
|
return %init;
|
|
}
|
|
|
|
sub get_kernel_data {
|
|
eval $start if $b_log;
|
|
my ($kernel,$ksplice) = ('','');
|
|
# Linux; yawn; 4.9.0-3.1-liquorix-686-pae; #1 ZEN SMP PREEMPT liquorix 4.9-4 (2017-01-14); i686
|
|
# FreeBSD; siwi.pair.com; 8.2-STABLE; FreeBSD 8.2-STABLE #0: Tue May 31 14:36:14 EDT 2016 erik5@iddhi.pair.com:/usr/obj/usr/src/sys/82PAIRx-AMD64; amd64
|
|
if (@uname){
|
|
$kernel = $uname[2];
|
|
if (check_program('uptrack-uname') && $kernel){
|
|
$ksplice = qx(uptrack-uname -rm);
|
|
$ksplice = trimmer($ksplice);
|
|
$kernel = ($ksplice) ? $ksplice . ' (ksplice)' : $kernel;
|
|
}
|
|
$kernel .= ' ' . $uname[-1];
|
|
$kernel = ($bsd_type) ? $uname[0] . ' ' . $kernel : $kernel;
|
|
}
|
|
$kernel ||= 'N/A';
|
|
log_data('data',"kernel: $kernel ksplice: $ksplice") if $b_log;
|
|
eval $end if $b_log;
|
|
return $kernel;
|
|
}
|
|
|
|
sub get_kernel_bits {
|
|
eval $start if $b_log;
|
|
my $bits = '';
|
|
if (@uname){
|
|
$bits = $uname[-1];
|
|
$bits = ($bits =~ /64/ ) ? 64 : 32;
|
|
}
|
|
$bits ||= 'N/A';
|
|
eval $end if $b_log;
|
|
return $bits;
|
|
}
|
|
|
|
sub get_memory_data {
|
|
eval $start if $b_log;
|
|
my ($type) = @_;
|
|
my ($memory);
|
|
if (my $file = system_files('meminfo') ) {
|
|
$memory = get_memory_data_linux($type,$file);
|
|
}
|
|
else {
|
|
$memory = get_memory_data_bsd($type);
|
|
}
|
|
eval $end if $b_log;
|
|
return $memory;
|
|
}
|
|
|
|
sub get_memory_data_linux {
|
|
eval $start if $b_log;
|
|
my ($type,$file) = @_;
|
|
my $memory = '';
|
|
my $total = 0;
|
|
my $not_used = 0;
|
|
my @data = reader($file);
|
|
foreach (@data){
|
|
if ($_ =~ /^MemTotal:/){
|
|
$total = get_piece($_,2);
|
|
}
|
|
elsif ($_ =~ /^(MemFree|Buffers|Cached):/){
|
|
$not_used += get_piece($_,2);
|
|
}
|
|
}
|
|
my $used = $total - $not_used;
|
|
my $percent = ($used && $total) ? sprintf("%.1f", ($used/$total)*100) : '';
|
|
if ($type eq 'string'){
|
|
$percent = " ($percent%)" if $percent;
|
|
$memory = sprintf("%.1f/%.1f MiB", $used/1024, $total/1024) . $percent;
|
|
}
|
|
else {
|
|
$memory = "$total:$used:$percent";
|
|
}
|
|
log_data('data',"memory: $memory") if $b_log;
|
|
eval $end if $b_log;
|
|
return $memory;
|
|
}
|
|
|
|
# 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
|
|
# 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
|
|
# procs memory page disks faults cpu
|
|
# r b w avm fre flt re pi po fr sr ad0 ad1 in sy cs us sy id
|
|
# 0 0 0 0 84060 30273993 2845 12742 1164 407498171 320960902 0 0 ....
|
|
sub get_memory_data_bsd {
|
|
eval $start if $b_log;
|
|
my ($type) = @_;
|
|
my $memory = '';
|
|
my ($avail,$total,$free_mem,$real_mem) = (0,0,0,0);
|
|
my (@data,$message);
|
|
my $arg = ($bsd_type ne 'openbsd') ? '-H' : '';
|
|
if (my $program = check_program('vmstat')){
|
|
# see above, it's the last line. -H makes it hopefully all in kB so no need
|
|
# for K/M/G tests
|
|
my $row = (grabber("vmstat $arg 2>/dev/null",'\n','strip'))[-1];
|
|
if ( $row ){
|
|
@data = split /\s+/, $row;
|
|
# dragonfly can have 0 avg, but they may fix that so make test dynamic
|
|
if ($data[3] != 0){
|
|
$avail = ($bsd_type ne 'openbsd') ? sprintf ('%.1f',$data[3]/1024) : $data[3];
|
|
}
|
|
elsif ($data[4] != 0){
|
|
$free_mem = sprintf ('%.1f',$data[4]);
|
|
}
|
|
}
|
|
}
|
|
## code to get total goes here:
|
|
my $ref = $alerts{'sysctl'};
|
|
if ($$ref{'action'} eq 'use'){
|
|
# for dragonfly, we will use free mem, not used because free is 0
|
|
my @working;
|
|
foreach (@sysctl){
|
|
# freebsd seems to use bytes here
|
|
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 $$ref{'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 (($avail || $free_mem) && !$real_mem){
|
|
my $error = ($message) ? $message: 'total N/A';
|
|
my $used = (!$free_mem) ? $avail : $real_mem - $free_mem;
|
|
if ($type eq 'string'){
|
|
$used = sprintf("%.1f",$used/1024);
|
|
$memory = "$used/($error) MB";
|
|
}
|
|
else {
|
|
$memory = "$error:$used:";
|
|
}
|
|
}
|
|
# use openbsd/dragonfly avail mem data if available
|
|
elsif (($avail || $free_mem) && $real_mem) {
|
|
my $used = (!$free_mem) ? $avail : $real_mem - $free_mem;
|
|
my $percent = ($used && $real_mem) ? sprintf("%.1f", ($used/$real_mem)*100) : '';
|
|
if ($type eq 'string'){
|
|
$used = sprintf("%.1f",$used/1024);
|
|
$real_mem = sprintf("%.1f",$real_mem/1024);
|
|
$percent = " ($percent)" if $percent;
|
|
$memory = "$used/$real_mem MB" . $percent;
|
|
}
|
|
else {
|
|
$memory = "$real_mem:$used:$percent";
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $memory;
|
|
}
|
|
|
|
sub get_module_version {
|
|
eval $start if $b_log;
|
|
my ($module) = @_;
|
|
return if ! $module;
|
|
my ($version);
|
|
my $path = "/sys/module/$module/version";
|
|
if (-f $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;
|
|
}
|
|
|
|
# # check? /var/run/nologin for bsds?
|
|
sub get_runlevel_data {
|
|
eval $start if $b_log;
|
|
my $runlevel = '';
|
|
if ( my $program = check_program('runlevel')){
|
|
$runlevel = (grabber("$program 2>/dev/null"))[0];
|
|
$runlevel =~ s/[^\d]//g if $runlevel;
|
|
#print_line($runlevel . ";;");
|
|
}
|
|
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 = '';
|
|
my $b_systemd = 0;
|
|
my $inittab = '/etc/inittab';
|
|
my $systemd = '/etc/systemd/system/default.target';
|
|
my $upstart = '/etc/init/rc-sysinit.conf';
|
|
# note: systemd systems do not necessarily have this link created
|
|
if ( -e $systemd){
|
|
$default = readlink($systemd);
|
|
$default =~ s/.*\/// if $default;
|
|
$b_systemd = 1;
|
|
}
|
|
# http://askubuntu.com/questions/86483/how-can-i-see-or-change-default-run-level
|
|
# note that technically default can be changed at boot but for inxi purposes
|
|
# that does not matter, we just want to know the system default
|
|
elsif ( -e $upstart){
|
|
# env DEFAULT_RUNLEVEL=2
|
|
@data = reader($upstart);
|
|
$default = awk(\@data,'^env\s+DEFAULT_RUNLEVEL',2,'=');
|
|
}
|
|
# handle weird cases where null but inittab exists
|
|
if (!$default && -e $inittab ){
|
|
@data = reader($inittab);
|
|
$default = awk(\@data,'^id.*initdefault',2,':');
|
|
}
|
|
eval $end if $b_log;
|
|
return $default;
|
|
}
|
|
|
|
sub get_self_version {
|
|
eval $start if $b_log;
|
|
my $patch = $self_patch;
|
|
if ( $patch ne '' ){
|
|
# for cases where it was for example: 00-b1 clean to -b1
|
|
$patch =~ s/^[0]+-?//;
|
|
$patch = "-$patch" if $patch;
|
|
}
|
|
eval $end if $b_log;
|
|
return $self_version . $patch;
|
|
}
|
|
|
|
sub get_shell_data {
|
|
eval $start if $b_log;
|
|
my ($ppid) = @_;
|
|
my $cmd = "ps -p $ppid -o comm= 2>/dev/null";
|
|
my $shell = qx($cmd);
|
|
log_data('cmd',$cmd) if $b_log;
|
|
chomp($shell);
|
|
if ($shell){
|
|
#print "shell pre: $shell\n";
|
|
# when run in debugger subshell, would return sh as shell,
|
|
# and parent as perl, that is, pinxi itself, which is actually right.
|
|
# trim leading /.../ off just in case. ps -p should return the name, not path
|
|
# but at least one user dataset suggests otherwise so just do it for all.
|
|
$shell =~ s/^.*\///;
|
|
my $working = $ENV{'SHELL'};
|
|
$working =~ s/^.*\///;
|
|
# NOTE: su -c "inxi -F" results in shell being su
|
|
if (($shell eq 'sh' || $shell eq 'sudo' || $shell eq 'su' ) && $shell ne $working){
|
|
$client{'su-start'} = $shell if ($shell eq 'sudo' || $shell eq 'su');
|
|
$shell = $working;
|
|
}
|
|
#print "shell post: $shell\n";
|
|
# sh because -v/--version doesn't work on it
|
|
if ( $shell ne 'sh' ) {
|
|
@app = main::program_values(lc($shell));
|
|
if ($app[0]){
|
|
$client{'version'} = main::program_version($shell,$app[0],$app[1],$app[2],$app[5],$app[6]);
|
|
}
|
|
# guess that it's two and --version
|
|
else {
|
|
# we're just guessing at the search phrase and position
|
|
if ($shell){
|
|
$client{'version'} = main::program_version($shell,$shell,2,'');
|
|
}
|
|
else {
|
|
$client{'version'} = row_defaults('unknown-shell');
|
|
}
|
|
}
|
|
$client{'version'} =~ s/(\(.*|-release|-version)//;
|
|
}
|
|
$client{'name'} = lc($shell);
|
|
$client{'name-print'} = $shell;
|
|
}
|
|
else {
|
|
$client{'name'} = 'shell';
|
|
$client{'name-print'} = 'Unknown Shell';
|
|
}
|
|
$client{'su-start'} = 'sudo' if (!$client{'su-start'} && $ENV{'SUDO_USER'});
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub get_shell_source {
|
|
eval $start if $b_log;
|
|
my (@data);
|
|
my ($msg,$self_parent,$shell_parent) = ('','','');
|
|
my $ppid = getppid();
|
|
$self_parent = get_start_parent($ppid);
|
|
if ($b_log){
|
|
$msg = ($ppid) ? "self parent: $self_parent ppid: $ppid": "self parent: undefined";
|
|
log_data('data',$msg);
|
|
}
|
|
#print "self parent: $self_parent ppid: $ppid\n";
|
|
if ($self_parent){
|
|
$shell_parent = get_shell_parent($self_parent);
|
|
$client{'su-start'} = $shell_parent if ($shell_parent eq 'su' && !$client{'su-start'});
|
|
#print "shell parent 1: $shell_parent\n";
|
|
if ($b_log){
|
|
$msg = ($shell_parent) ? "shell parent 1: $shell_parent": "shell parent 1: undefined";
|
|
log_data('data',$msg);
|
|
}
|
|
# in case sudo starts inxi, parent is shell (or perl inxi if run by debugger)
|
|
if ( $shell_parent && ( $shell_parent eq 'su' ||
|
|
$shell_parent =~ /^(bash|csh|ksh|lksh|loksh|mksh|pdksh|sh|dash|perl|zsh|tcsh)$/ ) ){
|
|
my $shell = $1; # we want the first set only if shell is parent
|
|
# no idea why have to do script_parent action twice in su case, but you do.
|
|
$self_parent = get_start_parent($self_parent);
|
|
$shell_parent = get_shell_parent($self_parent) if $shell;
|
|
#print "shell parent 2: $shell_parent\n";
|
|
if ($b_log){
|
|
$msg = ($shell_parent) ? "shell parent 2: $shell_parent": "shell parent 2: undefined";
|
|
log_data('data',$msg);
|
|
}
|
|
if (!$shell ||
|
|
$shell_parent =~ /^(bash|csh|ksh|lksh|loksh|mksh|pdksh|sh|dash|perl|zsh|tcsh)$/ ){
|
|
$self_parent = get_start_parent($self_parent);
|
|
$shell_parent = get_shell_parent($self_parent);
|
|
}
|
|
#print "shell parent 3: $shell_parent\n";
|
|
if ($b_log){
|
|
$msg = ($shell_parent) ? "shell parent 3: $shell_parent": "shell parent 3: undefined";
|
|
log_data('data',$msg);
|
|
}
|
|
}
|
|
# to work around a ps -p or gnome-terminal bug, which returns
|
|
# gnome-terminal- trim - off end
|
|
$shell_parent =~ s/-$//;
|
|
}
|
|
if ($b_log){
|
|
$self_parent ||= '';
|
|
$shell_parent ||= '';
|
|
log_data('data',"parents: self: $self_parent shell: $shell_parent");
|
|
}
|
|
eval $end if $b_log;
|
|
return $shell_parent;
|
|
}
|
|
|
|
# utilities for get_shell_source
|
|
# arg: 1 - parent id
|
|
sub get_start_parent {
|
|
eval $start if $b_log;
|
|
my ($parent) = @_;
|
|
# ps -j -fp : bsds ps do not have -f for PPID, so we can't get the ppid
|
|
my $cmd = "ps -j -fp $parent";
|
|
log_data('cmd',$cmd) if $b_log;
|
|
my @data = grabber($cmd);
|
|
#shift @data if @data;
|
|
my $self_parent = awk(\@data,"$parent",3,'\s+');
|
|
eval $end if $b_log;
|
|
return $self_parent;
|
|
}
|
|
|
|
# arg: 1 - parent id
|
|
sub get_shell_parent {
|
|
eval $start if $b_log;
|
|
my ($parent) = @_;
|
|
my $cmd = "ps -j -p $parent";
|
|
log_data('cmd',$cmd) if $b_log;
|
|
my @data = grabber($cmd,'strip');
|
|
#shift @data if @data;
|
|
my $shell_parent = awk(\@data, "$parent",-1,'\s+');
|
|
eval $end if $b_log;
|
|
return $shell_parent;
|
|
}
|
|
|
|
# this will test against default IP like: (:0) vs full IP to determine
|
|
# ssh status. Surprisingly easy test? Cross platform
|
|
sub get_ssh_status {
|
|
eval $start if $b_log;
|
|
my ($b_ssh,$ssh);
|
|
# fred pts/10 2018-03-24 16:20 (:0.0)
|
|
# fred-remote pts/1 2018-03-27 17:13 (43.43.43.43)
|
|
if (my $program = check_program('who')){
|
|
$ssh = (grabber("$program am i 2>/dev/null"))[0];
|
|
# crude IP validation
|
|
if ($ssh && $ssh =~ /\(([:0-9a-f]{8,}|[1-9][\.0-9]{6,})\)$/){
|
|
$b_ssh = 1;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $b_ssh;
|
|
}
|
|
|
|
sub get_tty_console_irc {
|
|
eval $start if $b_log;
|
|
return $tty_session if $tty_session;
|
|
my $ppid = getppid();
|
|
$tty_session = awk(\@ps_aux,".*$ppid.*$client{'name'}",7,'\s+');
|
|
$tty_session =~ s/^[^[0-9]+// if $tty_session;
|
|
$tty_session = '' if ! defined $tty_session;
|
|
log_data('data',"conole-irc-tty:$tty_session") if $b_log;
|
|
eval $end if $b_log;
|
|
return $tty_session;
|
|
}
|
|
|
|
sub get_tty_number {
|
|
eval $start if $b_log;
|
|
my $tty = POSIX::ttyname(1);
|
|
#variants: /dev/pts/1 /dev/tty1 /dev/ttyp2 /dev/ttyra [hex number a]
|
|
$tty =~ s/.*\/[^0-9]*//g if defined $tty;
|
|
$tty = '' if ! defined $tty;
|
|
log_data('data',"tty:$tty") if $b_log;
|
|
eval $end if $b_log;
|
|
return $tty;
|
|
}
|
|
|
|
# 2:58PM up 437 days, 8:18, 3 users, load averages: 2.03, 1.72, 1.77
|
|
# 04:29:08 up 3:18, 3 users, load average: 0,00, 0,00, 0,00
|
|
# 10:23PM up 5 days, 16:17, 1 user, load averages: 0.85, 0.90, 1.00
|
|
# 05:36:47 up 1 day, 3:28, 4 users, load average: 1,88, 0,98, 0,62
|
|
# 05:36:47 up 1 day, 3 min, 4 users, load average: 1,88, 0,98, 0,62
|
|
sub get_uptime {
|
|
eval $start if $b_log;
|
|
my ($days,$hours,$minutes,$uptime) = ('','','','');
|
|
if (check_program('uptime')){
|
|
$uptime = qx(uptime);
|
|
$uptime = trimmer($uptime);
|
|
#$uptime = '05:36:47 up 3 min, 4 users, load average: 1,88, 0,98, 0,62';
|
|
if ($uptime &&
|
|
$uptime =~ /[\S]+\s+up\s+(([0-9]+)\s+day[s]?,\s+)?(([0-9]{1,2}):([0-9]{1,2})|([0-9]+)\smin),\s+[0-9]+\s+user/){
|
|
$days = $2 . 'd' if $2;
|
|
$days .= ' ' if ($days && ($4 || $6));
|
|
if ($4 && $5){
|
|
$hours = $4 . 'h ';
|
|
$minutes = $5 . 'm';
|
|
}
|
|
elsif ($6){
|
|
$minutes = $6 . 'm';
|
|
|
|
}
|
|
$uptime = $days . $hours . $minutes;
|
|
}
|
|
}
|
|
$uptime ||= 'N/A';
|
|
eval $end if $b_log;
|
|
return $uptime;
|
|
}
|
|
|
|
# NOTE: annoyingly, /sys does NOT actually use the id, it uses
|
|
# the count of physical devices, starting at 0 for hub, on the bus.
|
|
# args: $1 - $bus number; $2 - vendor:chip id
|
|
sub get_usb_drivers {
|
|
eval $start if $b_log;
|
|
my ($bus,$id) = @_;
|
|
return if !$bus || !$id;# these will be > 0
|
|
my ($chip,$driver,$file,$path,$vendor,$working,$working2,@drivers,@temp);
|
|
@temp = split /:/, $id;
|
|
$vendor = $temp[0];
|
|
$chip = $temp[1];
|
|
# some have it one level deeper than others
|
|
my @globs = ("/sys/bus/usb/devices/usb$bus/$bus-*/","/sys/bus/usb/devices/usb$bus/$bus-*/$bus-*/");
|
|
foreach (@globs){
|
|
$path = get_usb_path($vendor,$chip,$_);
|
|
last if $path;
|
|
}
|
|
if ($path){
|
|
if ( -e "${path}driver"){
|
|
if ($working = Cwd::abs_path("${path}driver")){
|
|
$working =~ s/^.*\///;
|
|
if ($working && $working ne 'usb' && $working ne 'usbhid'){
|
|
push @drivers, $working;
|
|
}
|
|
}
|
|
}
|
|
# test 2
|
|
@temp = main::globber("$path$bus-*/");
|
|
#print "@temp\n";
|
|
foreach (@temp){
|
|
#print "p2:". $_ . "driver\n";
|
|
$file = $_ . 'driver';
|
|
#print "f:$file\n";
|
|
if (-e $file){
|
|
#print "here\n";
|
|
#print (Cwd::abs_path($file), "\n");
|
|
if ($working = Cwd::abs_path($file)){
|
|
#print "w:$working\n";
|
|
$working =~ s/^.*\///;
|
|
if ($working && $working ne 'usb' && $working ne 'usbhid' && ! grep {/$working/} @drivers){
|
|
push @drivers, $working;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
#print join "\n", @drivers, "\n";
|
|
$driver = join ',', @drivers if @drivers;
|
|
}
|
|
@temp = ($driver,$path);
|
|
eval $end if $b_log;
|
|
return @temp;
|
|
}
|
|
|
|
sub get_usb_path {
|
|
eval $start if $b_log;
|
|
my ($vendor,$chip,$glob) = @_;
|
|
my ($path,$working,$working2);
|
|
#print "$vendor,$chip,$glob\n";
|
|
my @temp = main::globber($glob);
|
|
#print join "\n", @temp, "\n";
|
|
# first we need to get the device path, since it's not predictable
|
|
foreach (@temp){
|
|
#print "$_\n";
|
|
$working = $_ . 'idVendor';
|
|
$working2 = $_ . 'idProduct';
|
|
if (-e $working && (main::reader($working))[0] eq $vendor &&
|
|
-e $working2 && (main::reader($working2))[0] eq $chip){
|
|
$path = $_;
|
|
#print "$_\n";
|
|
last;
|
|
}
|
|
}
|
|
eval $end if $b_log;
|
|
return $path
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### INITIALIZE DATA VALUES
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub set_dmesg_boot_data {
|
|
eval $start if $b_log;
|
|
my ($file,@temp);
|
|
my ($counter) = (0);
|
|
$b_dmesg_boot_check = 1;
|
|
$file = system_files('dmesg-boot');
|
|
#$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/bsd-disks-diabolus.txt";
|
|
#$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/freebsd-disks-solestar.txt";
|
|
#$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/freebsd-enceladus-1.txt";
|
|
#$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/openbsd-5.6-dmesg.boot-1.txt";
|
|
#$file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmesg-boot/openbsd-dmesg.boot-1.txt";
|
|
if ($file){
|
|
return if ! -r $file;
|
|
@dmesg_boot = reader($file);
|
|
# some dmesg repeats, so we need to dump the second and > iterations
|
|
# replace all indented items with ~ so we can id them easily while
|
|
# processing note that if user, may get error of read permissions
|
|
# for some weird reason, real mem and avail mem are use a '=' separator,
|
|
# who knows why, the others are ':'
|
|
foreach (@dmesg_boot){
|
|
$counter++ if /^(OpenBSD|DragonFly|FreeBSD is a registered trademark)/;
|
|
last if $counter > 1;
|
|
$_ =~ s/\s*=\s*|:\s*/:/;
|
|
$_ =~ s/\"//g;
|
|
$_ =~ s/^\s+/~/;
|
|
$_ =~ s/\s\s/ /g;
|
|
$_ =~ s/^(\S+)\sat\s/$1:at /; # ada0 at ahcich0
|
|
push @temp, $_;
|
|
}
|
|
@dmesg_boot = @temp;
|
|
# FreeBSD: 'da*' is a USB device 'ada*' is a SATA device 'mmcsd*' is an SD card
|
|
if ($b_dm_boot_disk && @dmesg_boot){
|
|
@dm_boot_disk = grep {/^(ad|ada|da|mmcblk|mmcsd|nvme[0-9]+n|sd|wd)[0-9]+(:|\sat\s)/} @dmesg_boot;
|
|
log_data('dump','@dm_boot_disk',\@dm_boot_disk) if $b_log;
|
|
print Dumper \@dm_boot_disk if $test[9];
|
|
}
|
|
if ($b_dm_boot_optical && @dmesg_boot){
|
|
@dm_boot_optical = grep {/^(cd)[0-9]+(\([^)]+\))?(:|\sat\s)/} @dmesg_boot;
|
|
log_data('dump','@dm_boot_optical',\@dm_boot_optical) if $b_log;
|
|
print Dumper \@dm_boot_optical if $test[9];
|
|
}
|
|
}
|
|
log_data('dump','@dmesg_boot',\@dmesg_boot) if $b_log;
|
|
#print Dumper \@dmesg_boot if $test[9];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# note, all actual tests have already been run in check_tools so if we
|
|
# got here, we're good.
|
|
sub set_dmi_data {
|
|
eval $start if $b_log;
|
|
if ($alerts{'dmidecode'}{'action'} eq 'use' ){
|
|
set_dmidecode_data();
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_dmidecode_data {
|
|
eval $start if $b_log;
|
|
my ($content,@data,@working,$type,$handle);
|
|
#my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/dmidecode/pci-freebsd-8.2-2";
|
|
#open my $fh, '<', $file or die "can't open $file: $!";
|
|
#chomp(@data = <$fh>);
|
|
my $path = check_program('dmidecode');
|
|
$content = qx($path 2>/dev/null) if $path;
|
|
@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;
|
|
$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 Dumper \@dmi if $test[2];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_ip_data {
|
|
eval $start if $b_log;
|
|
if ($alerts{'ip'}{'action'} eq 'use' ){
|
|
set_ip_addr();
|
|
}
|
|
elsif ($alerts{'ifconfig'}{'action'} eq 'use'){
|
|
set_ifconfig();
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_ip_addr {
|
|
eval $start if $b_log;
|
|
my $program = check_program('ip');
|
|
my @data = grabber("$program addr 2>/dev/null",'\n','strip') if $program;
|
|
#my @data = reader("$ENV{'HOME'}/bin/scripts/inxi/data/if/scope-ipaddr-1.txt",'strip') or die $!;
|
|
my ($b_skip,$broadcast,$if,$ip,@ips,$scope,$if_id,$type,@temp,@temp2);
|
|
foreach (@data){
|
|
if (/^[0-9]/){
|
|
#print "$_\n";
|
|
if (@ips){
|
|
#print "$if\n";
|
|
@temp = ($if,[@ips]);
|
|
@ifs = (@ifs,@temp);
|
|
@ips = ();
|
|
}
|
|
@temp = split /:\s+/,$_;
|
|
$if = $temp[1];
|
|
if ($if eq 'lo'){
|
|
$b_skip = 1;
|
|
$if = '';
|
|
next;
|
|
}
|
|
$b_skip = 0;
|
|
@temp = ();
|
|
}
|
|
elsif (!$b_skip && /^inet/){
|
|
#print "$_\n";
|
|
@temp = split /\s+/, $_;
|
|
($broadcast,$ip,$scope,$if_id,$type) = ('','','','','');
|
|
$ip = $temp[1];
|
|
$type = ($temp[0] eq 'inet') ? 4 : 6 ;
|
|
if ($temp[2] eq 'brd'){
|
|
$broadcast = $temp[3];
|
|
}
|
|
if (/scope\s([^\s]+)(\s(.+))?/){
|
|
$scope = $1;
|
|
$if_id = $3;
|
|
}
|
|
@temp = ($type,$ip,$broadcast,$scope,$if_id);
|
|
@ips = (@ips,[@temp]);
|
|
#print Dumper \@ips;
|
|
}
|
|
}
|
|
#print Dumper \@ips if $test[4];
|
|
if (@ips){
|
|
@temp = ($if,[@ips]);
|
|
@ifs = (@ifs,@temp);
|
|
}
|
|
main::log_data('dump','@ifs',\@ifs) if $b_log;
|
|
print Dumper \@ifs if $test[3];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_ifconfig {
|
|
eval $start if $b_log;
|
|
my $program = check_program('ifconfig'); # not in user path, sbin
|
|
my @data = grabber("$program 2>/dev/null",'\n','') if $program;
|
|
#my @data = reader("$ENV{'HOME'}/bin/scripts/inxi/data/if/vps-ifconfig-1.txt",'') or die $!;
|
|
my ($b_skip,$broadcast,$if,@ips_bsd,$ip,@ips,$scope,$if_id,$type,@temp,@temp2);
|
|
my ($state,$speed,$duplex,$mac);
|
|
foreach (@data){
|
|
if (/^[\S]/i){
|
|
#print "$_\n";
|
|
if (@ips){
|
|
#print "here\n";
|
|
@temp = ($if,[@ips]);
|
|
@ifs = (@ifs,@temp);
|
|
@ips = ();
|
|
}
|
|
if ($mac){
|
|
@temp = ($if,[($state,$speed,$duplex,$mac)]);
|
|
@ifs_bsd = (@ifs_bsd,@temp);
|
|
($state,$speed,$duplex,$mac,$if_id) = ('','','','','');
|
|
}
|
|
$if = (split /\s+/,$_)[0];
|
|
$if =~ s/:$//; # em0: flags=8843
|
|
$if_id = $if;
|
|
$if = (split /:/, $if)[0] if $if;
|
|
if ($if =~ /^lo/){
|
|
$b_skip = 1;
|
|
$if = '';
|
|
$if_id = '';
|
|
next;
|
|
}
|
|
$b_skip = 0;
|
|
}
|
|
# lladdr openbsd
|
|
elsif (!$b_skip && $bsd_type && /^\s+(ether|media|status|lladdr)/){
|
|
$_ =~ s/^\s+//;
|
|
# media: Ethernet 100baseTX <full-duplex> freebsd 7.3
|
|
# media: Ethernet autoselect (1000baseT <full-duplex>) Freebsd 8.2
|
|
#
|
|
if (/^media/){
|
|
# openbsd: media: Ethernet autoselect (1000baseT full-duplex)
|
|
if ($bsd_type && $bsd_type eq 'openbsd'){
|
|
$_ =~ /\s\([\S]+\s([\S]+)\)/;
|
|
$duplex = $1;
|
|
}
|
|
else {
|
|
$_ =~ /<([^>]+)>/;
|
|
$duplex = $1;
|
|
}
|
|
$_ =~ /\s\(([1-9][\S]+\s)/;
|
|
$speed = $1;
|
|
$speed =~ s/\s+$// if $speed;
|
|
}
|
|
elsif (!$mac && /^ether|lladdr/){
|
|
$mac = (split /\s+/, $_)[1];
|
|
}
|
|
elsif (/^status/){
|
|
$state = (split /\s+/, $_)[1];
|
|
}
|
|
}
|
|
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/;
|
|
@temp = ($type,$ip,$broadcast,$scope,$if_id);
|
|
@ips = (@ips,[@temp]);
|
|
#print Dumper \@ips;
|
|
}
|
|
}
|
|
if (@ips){
|
|
@temp = ($if,[@ips]);
|
|
@ifs = (@ifs,@temp);
|
|
}
|
|
if ($mac){
|
|
@temp = ($if,[($state,$speed,$duplex,$mac)]);
|
|
@ifs_bsd = (@ifs_bsd,@temp);
|
|
($state,$speed,$duplex,$mac) = ('','','','');
|
|
}
|
|
print Dumper \@ifs if $test[3];
|
|
print Dumper \@ifs_bsd if $test[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 set_pci_data {
|
|
eval $start if $b_log;
|
|
if ( $b_pci ){
|
|
if (!$bsd_type){
|
|
if ($alerts{'lspci'}{'action'} eq 'use' ){
|
|
set_lspci_data();
|
|
}
|
|
}
|
|
else {
|
|
#if (1 == 1){
|
|
if ($alerts{'pciconf'}{'action'} eq 'use'){
|
|
set_pciconf_data();
|
|
}
|
|
}
|
|
}
|
|
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
|
|
# 11 driver_nu [bsd, like: em0 - driver em; nu 0. Used to match IF in -n
|
|
sub set_lspci_data {
|
|
eval $start if $b_log;
|
|
my ($busid,$busid_nu,$content,$port,$driver,$modules,$device,$vendor_id,$chip_id,$rev,
|
|
$type,$type_id,@pcis,@temp);
|
|
# my @pcis = grabber('lspci -nnv','\n','strip');
|
|
my $path = check_program('lspci');
|
|
$content = qx($path -nnv 2>/dev/null) if $path;
|
|
@pcis = split /\n/, $content if $content;
|
|
#print scalar @pcis;
|
|
@pcis = map {$_ =~ s/^\s+//; $_} @pcis if @pcis;
|
|
foreach (@pcis){
|
|
#print "$_\n";
|
|
if ($device){
|
|
if ($_ =~ /^\s*$/) {
|
|
@temp = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id,
|
|
$rev,$port,$driver,$modules);
|
|
@pci = (@pci,[@temp]);
|
|
$device = '';
|
|
#print "$busid $device_id r:$rev p: $port\n$type\n$device\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];
|
|
}
|
|
|
|
}
|
|
elsif ($_ =~ /^([0-9a-f]{2}:[0-9a-f]{2})[.:]([0-9a-f]+)\s(.*)\s\[([0-9a-f]{4}):([0-9a-f]{4})\](\s\(rev\s([^\)]+)\))?/){
|
|
$busid = $1;
|
|
$busid_nu = hex($2);
|
|
my @working = split /:\s+/, $3;
|
|
$device = $working[1];
|
|
$type = $working[0];
|
|
$vendor_id = $4;
|
|
$chip_id = $5;
|
|
$rev = ($7)?$7 : '';
|
|
$device = cleaner($device);
|
|
$working[0] =~ /\[([^\]]+)\]$/;
|
|
$type_id = $1;
|
|
$type = lc($type);
|
|
$type = pci_cleaner($type,'pci');
|
|
$type =~ s/\s+$//;
|
|
$port = '';
|
|
$driver = '';
|
|
$modules = '';
|
|
}
|
|
}
|
|
if ($device && $busid){
|
|
@temp = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id,$rev,$port,$driver,$modules);
|
|
@pci = (@pci,[@temp]);
|
|
$device = '';
|
|
}
|
|
print Dumper \@pci if $test[4];
|
|
main::log_data('dump','@pci',\@pci) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# 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 set_pciconf_data {
|
|
eval $start if $b_log;
|
|
my ($busid,$busid_nu,$content,$port,$driver,$driver_nu,$modules,$device,$vendor,
|
|
$vendor_id,$chip_id,$rev,$type,$type_id,@data,@temp,@working);
|
|
# my $file = "$ENV{'HOME'}/bin/scripts/inxi/data/pciconf/pci-freebsd-8.2-2";
|
|
# open my $fh, '<', $file or die "can't open $file: $!";
|
|
# chomp(@data = <$fh>);
|
|
my $path = check_program('pciconf');
|
|
$content = qx($path -lv 2>/dev/null) if $path;
|
|
@data = split /\n/, $content if $content;
|
|
foreach (@data){
|
|
if ($_ =~ /^[^@]+\@pci/){
|
|
push @working, '';
|
|
}
|
|
$_ =~ s/^\s+//;
|
|
push @working, $_;
|
|
}
|
|
foreach (@working){
|
|
if ($driver){
|
|
if ($_ =~ /^\s*$/) {
|
|
$vendor = cleaner($vendor);
|
|
$device = cleaner($device);
|
|
if ($vendor && $device){
|
|
if ($vendor !~ /$device/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);
|
|
@pci = (@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];
|
|
}
|
|
|
|
}
|
|
elsif (/^([^@]+)\@pci([0-9]{1,3}:[0-9]{1,3}:[0-9]{1,3}):([0-9]{1,3}).*class=([^\s]+)\scard=([^\s]+)\schip=([^\s]+)\srev=([^\s]+)/){
|
|
$driver = $1;
|
|
$busid = $2;
|
|
$busid_nu = $3;
|
|
$type_id = $4;
|
|
#$vendor_id = $5;
|
|
$vendor_id = substr($6,6,4);
|
|
$chip_id = substr($6,2,4);
|
|
$rev = $7;
|
|
$vendor = '';
|
|
$device = '';
|
|
$type = '';
|
|
$driver =~ /(^[a-z]+)([0-9]+$)/;
|
|
$driver = $1;
|
|
$driver_nu = $2;
|
|
}
|
|
}
|
|
if ($driver && $busid){
|
|
$vendor = cleaner($vendor);
|
|
$device = cleaner($device);
|
|
$device = ( $vendor && $device !~ /$vendor/) ? "$vendor $device" : $device;
|
|
@temp = ($type,$type_id,$busid,$busid_nu,$device,$vendor_id,$chip_id,$rev,$port,$driver,$modules,$driver_nu);
|
|
@pci = (@pci,[@temp]);
|
|
$device = '';
|
|
}
|
|
print Dumper \@pci if $test[4];
|
|
main::log_data('dump','@pci',\@pci) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_ps_aux {
|
|
eval $start if $b_log;
|
|
@ps_aux = split "\n",qx(ps aux);;
|
|
shift @ps_aux; # get rid of header row
|
|
$_=lc for @ps_aux; # this is a super fast way to set to lower
|
|
# this is for testing for the presence of the command
|
|
@ps_cmd = map {
|
|
my @split = split /\s+/, $_;
|
|
# slice out 10th to last elements of ps aux rows
|
|
my $final = $#split;
|
|
# some stuff has a lot of data, chrome for example
|
|
$final = ($final > 12) ? 12 : $final;
|
|
@split = @split[10 .. $final ];
|
|
join " ", @split;
|
|
} @ps_aux;
|
|
print Dumper \@ps_aux if $test[5];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_sysctl_data {
|
|
eval $start if $b_log;
|
|
return if $alerts{'sysctl'}{'action'} ne 'use';
|
|
# darwin sysctl has BOTH = and : separators, and repeats data. Why?
|
|
my $program = check_program('sysctl');
|
|
my @temp = grabber("$program -a 2>/dev/null");
|
|
foreach (@temp){
|
|
$_ =~ s/\s*=\s*|:\s+/:/;
|
|
$_ =~ s/\"//g;
|
|
push @sysctl, $_;
|
|
# we're building these here so we can use these arrays to test
|
|
# in each feature if we will try to build the feature for bsds
|
|
if (/^hw\.sensors/ && !/^hw\.sensors\.acpi(bat|cmb)/ && !/^hw.sensors.softraid/){
|
|
push @sysctl_sensors, $_;
|
|
}
|
|
elsif (/^hw\.(vendor|product|version|serialno|uuid)/){
|
|
push @sysctl_machine, $_;
|
|
}
|
|
elsif (/^hw\.sensors\.acpi(bat|cmb)/){
|
|
push @sysctl_battery, $_;
|
|
}
|
|
}
|
|
print Dumper \@sysctl if $test[7];
|
|
# this thing can get really long.
|
|
if ($b_log){
|
|
#main::log_data('dump','@sysctl',\@sysctl);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
# http://www.usb.org/developers/defined_class
|
|
sub set_usb_data {
|
|
eval $start if $b_log;
|
|
if ($alerts{'lsusb'}{'action'} eq 'use' ){
|
|
#$usb_level = 2;
|
|
# NOTE: we can't get reliable usb network device with short
|
|
if ($usb_level == 2){
|
|
set_lsusb_data_long();
|
|
}
|
|
else {
|
|
set_lsusb_data_short();
|
|
}
|
|
}
|
|
elsif ( $alerts{'usbdevs'}{'action'} eq 'use'){
|
|
set_usbdevs_data();
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_lsusb_data_short {
|
|
eval $start if $b_log;
|
|
my ($content,@data);
|
|
my $b_live = 1;
|
|
if ($b_live){
|
|
my $path = check_program('lsusb');
|
|
$content = qx($path 2>/dev/null) if $path;
|
|
@data = split /\n/, $content if $content;
|
|
}
|
|
else {
|
|
open my $fh, '<', "$ENV{'HOME'}/bin/scripts/inxi/data/lsusb/mdmarmer-lsusb.txt" or die $!;
|
|
chomp(@data = <$fh>);
|
|
}
|
|
foreach (@data){
|
|
next if /^\s*$|^Couldn't/; # expensive second call: || /UNAVAIL/
|
|
my @working = split /\s+/, $_;
|
|
$working[3] =~ s/:$//;
|
|
my $id = int($working[3]);
|
|
if ($id > 1){
|
|
my $bus = int($working[1]);
|
|
my $chip = $working[5];
|
|
my @temp = @working[6..$#working];
|
|
my $name = join ' ', @temp;
|
|
if ($name !~ /hub/i){
|
|
@usb = (@usb,[$bus,$id,$chip,$name]);
|
|
}
|
|
}
|
|
}
|
|
print Dumper \@usb if $test[6];
|
|
main::log_data('dump','@usb: short',\@usb) if $b_log;
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub set_lsusb_data_long {
|
|
eval $start if $b_log;
|
|
my ($content,@data,@working,$bus_id,$device_id,$id,$b_skip);
|
|
my $j = 0;
|
|
my $b_live = 1;
|
|
if ($b_live){
|
|
my $path = check_program('lsusb');
|
|
$content = qx($path -v 2>/dev/null) if $path;
|
|
@data = split /\n/, $content if $content;
|
|
}
|
|
else {
|
|
my $file;
|
|
#$file = "$ENV{'HOME'}/bin/scripts/inxi/data/lsusb/mdmarmer-lsusb-v.txt";
|
|
$file = "$ENV{'HOME'}/bin/scripts/inxi/data/lsusb/lsusb-v-dz64.txt";
|
|
open my $fh, '<', $file or die $!;
|
|
chomp(@data = <$fh>);
|
|
}
|
|
foreach (@data){
|
|
# we won't need all the lsusb data, so set it to skip
|
|
# after the last item we might want
|
|
# Couldn't open device, some information will be missing
|
|
next if /^\s*$|^Couldn't/; # expensive second call: || /UNAVAIL/
|
|
if (!$b_skip && $bus_id && /^\s\s/){
|
|
#if ($_ =~ /\bDescriptor\b:/){
|
|
if ($_ =~ /^\s+([\S]+)\sDescriptor:/){
|
|
#$_ =~ /^\s+([\S]+)\sDescriptor:/;
|
|
$_ = "Descriptor_$1";
|
|
}
|
|
else {
|
|
$_ =~ s/^\s\s|[\s]+$//g;
|
|
$_ =~ s/^[\s]+/~/g;
|
|
#$_ =~ s/[\s]+$//g;
|
|
$_ =~ s/\sType/_Type/g;
|
|
$_ =~ s/^([\S]+)[\s]+(.*)//;
|
|
my $one = ($1) ? $1: '';
|
|
my $two = ($2) ? $2: '';
|
|
$_ = "$one:$two";
|
|
$b_skip = 1 if $one eq '~bInterfaceProtocol';
|
|
#$_ = cleaner($_);
|
|
if (/([\S]+):([0-9]+|0x[0-9a-f]+)\s(.*)/){
|
|
$_ = "$1:$2:$3";
|
|
#$b_skip = 1 if $1 eq '~bInterfaceProtocol';
|
|
}
|
|
#print "$1\n";
|
|
}
|
|
push @working, $_;
|
|
}
|
|
elsif (/^Bus\s([0-9]+)\sDevice\s([0-9]+):\sID\s(([0-9a-f]{4}):([0-9a-f]{4})).*/){
|
|
#elsif (/^Bus\s/){
|
|
#if (/^Bus\s([0-9]+)\sDevice\s([0-9]+):\sID\s(([0-9a-f]{4}):([0-9a-f]{4})).*/){
|
|
$j = scalar @usb;
|
|
$bus_id = int($1);
|
|
$device_id = int($2);
|
|
$id = $3;
|
|
$b_skip = 0;
|
|
# we don't need 32, system boot, or 127, end of table
|
|
if (@working){
|
|
if ($working[0] != 32 && $working[0] != 127){
|
|
$usb[$j] = (
|
|
[@working],
|
|
);
|
|
}
|
|
}
|
|
@working = ($bus_id,$device_id,$id);
|
|
#}
|
|
}
|
|
}
|
|
if (@working){
|
|
$j = scalar @usb;
|
|
$usb[$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
|
|
@usb = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @usb;
|
|
print Dumper \@usb if $test[6];
|
|
main::log_data('dump','@usb: long',\@usb) if $b_log;
|
|
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 set_usbdevs_data {
|
|
eval $start if $b_log;
|
|
my (@data,@working,$class,$bus_id,$addr_id,$id,$speed,$protocol);
|
|
my $b_live = 1;
|
|
my $j = 0;
|
|
my $ports = 0;
|
|
if ($b_live){
|
|
my $program = check_program('usbdevs');
|
|
my $content = qx($program -v 2>/dev/null);
|
|
@data = split /\n/, $content;
|
|
}
|
|
else {
|
|
open my $fh, '<', "$ENV{'HOME'}/bin/scripts/inxi/data/lsusb/bsd-usbdevs-v-1.txt" or die $!;
|
|
chomp(@data = <$fh>);
|
|
}
|
|
foreach (@data){
|
|
if (/^Controller\s\/dev\/usb([0-9]+)/){
|
|
$j = scalar @usb;
|
|
$ports = 0;
|
|
$bus_id = $1;
|
|
@working = ();
|
|
}
|
|
elsif (/^addr\s([0-9]+):\s([^,]+),[^,]+,[^,]+,\s?([^,]+)\(0x([0-9a-f]{4})\),\s?([^,]+)\s?\(0x([0-9a-f]{4})\)/){
|
|
$j = scalar @usb;
|
|
$addr_id = $1;
|
|
$speed = "bcdUSB:$2";
|
|
$id = "$4:$6";
|
|
$protocol="~bInterfaceProtocol:0:$5 $3";
|
|
#print "p1:$protocol\n";
|
|
$class='bDeviceClass:9:Hub';
|
|
@working = ($bus_id,$addr_id,$id,$speed,$class,$protocol);
|
|
if (@working){
|
|
$usb[$j] = (
|
|
[@working],
|
|
);
|
|
}
|
|
@working = ();
|
|
}
|
|
elsif (/^\s+port\s([0-9]+)\saddr\s([0-9]+):\s([^,]+),[^,]+,[^,]+,\s?([^,]+)\(0x([0-9a-f]{4})\),\s?([^,]+)\s?\(0x([0-9a-f]{4})\)/){
|
|
$j = scalar @usb;
|
|
$addr_id = "$2";
|
|
$speed = "bcdUSB:$3";
|
|
$id = "$5:$7";
|
|
$protocol="~bInterfaceProtocol:0:$6 $4";
|
|
#print "p2:$protocol\n";
|
|
$ports++;
|
|
@working = ($bus_id,$addr_id,$id,$speed,$protocol);
|
|
if (@working){
|
|
$usb[$j] = (
|
|
[@working],
|
|
);
|
|
}
|
|
@working = ();
|
|
}
|
|
elsif (/^\s+port\s([0-9]+)\spowered/){
|
|
$ports++;
|
|
}
|
|
}
|
|
if (@working){
|
|
$j = scalar @usb;
|
|
$usb[$j] = (
|
|
[@working],
|
|
);
|
|
}
|
|
main::log_data('dump','@usb: usbdevs',\@usb) if $b_log;
|
|
print Dumper \@usb if $test[6];
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
########################################################################
|
|
#### GENERATE LINES
|
|
########################################################################
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### LINE CONTROLLERS
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub assign_data {
|
|
my (%row) = @_;
|
|
return if ! %row;
|
|
if ($output_type eq 'screen'){
|
|
print_data(%row);
|
|
}
|
|
else {
|
|
%rows = (%rows,%row);
|
|
}
|
|
}
|
|
|
|
sub generate_lines {
|
|
eval $start if $b_log;
|
|
my (%row,$b_pci_check,$b_dmi_check);
|
|
set_ps_aux() if ! @ps_aux;
|
|
set_sysctl_data() if $b_sysctl;
|
|
# 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'} ){
|
|
if ($bsd_type && !$b_dmesg_boot_check){
|
|
set_dmesg_boot_data();
|
|
}
|
|
%row = generate_short_data();
|
|
assign_data(%row);
|
|
}
|
|
else {
|
|
if ( $show{'system'} ){
|
|
%row = generate_system_data();
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'machine'} ){
|
|
if ($b_dmi && !$b_dmi_check ){
|
|
set_dmi_data() ;
|
|
$b_dmi_check = 1;
|
|
}
|
|
if ($bsd_type && !$b_dmesg_boot_check){
|
|
set_dmesg_boot_data();
|
|
}
|
|
%row = line_handler('Machine','machine');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'battery'} ){
|
|
set_dmi_data() if $b_dmi && !$b_dmi_check;
|
|
$b_dmi_check = 1;
|
|
%row = line_handler('Battery','battery');
|
|
if (%row || $show{'battery-forced'}){
|
|
assign_data(%row);
|
|
}
|
|
}
|
|
if ( $show{'ram'} ){
|
|
set_dmi_data() if $b_dmi && !$b_dmi_check;
|
|
$b_dmi_check = 1;
|
|
%row = line_handler('Memory','ram');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'slot'} ){
|
|
set_dmi_data() if $b_dmi && !$b_dmi_check;
|
|
$b_dmi_check = 1;
|
|
%row = line_handler('PCI Slots','slot');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'cpu'} || $show{'cpu-basic'} ){
|
|
if ($bsd_type && !$b_dmesg_boot_check){
|
|
set_dmesg_boot_data();
|
|
}
|
|
my $arg = ($show{'cpu-basic'}) ? 'basic' : 'full' ;
|
|
%row = line_handler('CPU','cpu',$arg);
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'graphic'} ){
|
|
set_pci_data() if !$b_pci_check;
|
|
$b_pci_check = 1;
|
|
%row = line_handler('Graphics','graphic');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'audio'} ){
|
|
set_pci_data() if !$b_pci_check;
|
|
$b_pci_check = 1;
|
|
%row = line_handler('Audio','audio');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'network'} ){
|
|
set_usb_data() if !$b_usb_check;
|
|
set_pci_data() if !$b_pci_check;
|
|
set_ip_data() if ($show{'ip'} || ($bsd_type && $show{'network-advanced'}));
|
|
$b_pci_check = 1;
|
|
$b_usb_check = 1;
|
|
%row = line_handler('Network','network');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'disk'} || $show{'disk-basic'} || $show{'disk-total'} || $show{'optical'} ){
|
|
if ($bsd_type && !$b_dmesg_boot_check){
|
|
set_dmesg_boot_data();
|
|
}
|
|
%row = line_handler('Drives','disk');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'raid'} ){
|
|
%row = line_handler('RAID','raid');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'partition'} || $show{'partition-full'}){
|
|
%row = line_handler('Partition','partition');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'unmounted'} ){
|
|
%row = line_handler('Unmounted','unmounted');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'usb'} ){
|
|
set_usb_data() if !$b_usb_check;
|
|
%row = line_handler('USB','usb');
|
|
assign_data(%row);
|
|
$b_usb_check = 1;
|
|
}
|
|
if ( $show{'sensor'} ){
|
|
%row = line_handler('Sensors','sensor');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'repo'} ){
|
|
%row = line_handler('Repos','repo');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'process'} ){
|
|
%row = line_handler('Processes','process');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'weather'} ){
|
|
%row = line_handler('Weather','weather');
|
|
assign_data(%row);
|
|
}
|
|
if ( $show{'info'} ){
|
|
%row = generate_info_data();
|
|
assign_data(%row);
|
|
}
|
|
}
|
|
if ( $output_type ne 'screen' ){
|
|
output_handler(%rows);
|
|
}
|
|
eval $end if $b_log;
|
|
}
|
|
|
|
sub line_handler {
|
|
eval $start if $b_log;
|
|
my ($key,$sub,$arg) = @_;
|
|
my %subs = (
|
|
'audio' => \&AudioData::get,
|
|
'battery' => \&BatteryData::get,
|
|
'cpu' => \&CpuData::get,
|
|
'disk' => \&DiskData::get,
|
|
'graphic' => \&GraphicData::get,
|
|
'machine' => \&MachineData::get,
|
|
'network' => \&NetworkData::get,
|
|
'partition' => \&PartitionData::get,
|
|
'raid' => \&RaidData::get,
|
|
'ram' => \&RamData::get,
|
|
'repo' => \&RepoData::get,
|
|
'process' => \&ProcessData::get,
|
|
'sensor' => \&SensorData::get,
|
|
'slot' => \&SlotData::get,
|
|
'unmounted' => \&UnmountedData::get,
|
|
'usb' => \&UsbData::get,
|
|
'weather' => \&WeatherData::get,
|
|
);
|
|
my (%data);
|
|
my $data_name = main::key($prefix++,$key);
|
|
my @rows = $subs{$sub}->($arg);
|
|
if (@rows){
|
|
%data = ($data_name => \@rows,);
|
|
}
|
|
eval $end if $b_log;
|
|
return %data;
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### SHORT, DEBUG
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub generate_short_data {
|
|
eval $start if $b_log;
|
|
my $num = 0;
|
|
my $kernel_os = ($bsd_type) ? 'OS' : 'Kernel';
|
|
my $client = $client{'name-print'};
|
|
my $client_shell = ($b_irc) ? 'Client' : 'Shell';
|
|
if ($client{'version'}){
|
|
$client .= ' ' . $client{'version'};
|
|
}
|
|
my ($cpu_string,$speed,$speed_key,$type) = ('','','speed','');
|
|
my $memory = get_memory_data('string');
|
|
my @cpu = CpuData::get('short');
|
|
if (scalar @cpu > 1){
|
|
$type = ($cpu[2]) ? " (-$cpu[2]-)" : '';
|
|
($speed,$speed_key) = ('','');
|
|
if ($cpu[6]){
|
|
$speed_key = "$cpu[3]/$cpu[5]";
|
|
$cpu[4] =~ s/ MHz//;
|
|
$speed = "$cpu[4]/$cpu[6]";
|
|
}
|
|
else {
|
|
$speed_key = $cpu[3];
|
|
$speed = $cpu[4];
|
|
}
|
|
$cpu[1] ||= row_defaults('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';
|
|
}
|
|
}
|
|
}
|
|
my @disk = DiskData::get('short');
|
|
# print Dumper \@disk;
|
|
my $disk_string = 'N/A';
|
|
my ($size,$used,$size_type,$used_type) = ('','','','');
|
|
my (@temp,$size_holder,$used_holder);
|
|
if (@disk){
|
|
$size = $disk[0]{'size'};
|
|
if ($disk[0]{'size'} && $disk[0]{'size'} =~ /^[0-9\.]+$/){
|
|
$size_holder = $disk[0]{'size'};
|
|
@temp = get_size($size);
|
|
$size = $temp[0];
|
|
$size_type = " $temp[1]";
|
|
}
|
|
$used = $disk[0]{'used'};
|
|
if (defined $disk[0]{'used'} && $disk[0]{'used'} =~ /^[0-9\.]+$/){
|
|
$used_holder = $disk[0]{'used'};
|
|
@temp = get_size($used);
|
|
$used = $temp[0];
|
|
$used_type = " $temp[1]";
|
|
}
|
|
# 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$size_type$percent";
|
|
}
|
|
else {
|
|
$size ||= row_defaults('disk-size-0');
|
|
$disk_string = "$used$used_type/$size$size_type";
|
|
}
|
|
}
|
|
#print join '; ', @cpu, " sleep: $cpu_sleep\n";
|
|
$memory ||= 'N/A';
|
|
my @data = ({
|
|
main::key($num++,'CPU') => $cpu_string,
|
|
main::key($num++,$speed_key) => $speed,
|
|
main::key($num++,$kernel_os) => &get_kernel_data(),
|
|
main::key($num++,'Up') => &get_uptime(),
|
|
main::key($num++,'Mem') => $memory,
|
|
main::key($num++,'HDD') => $disk_string,
|
|
# could make -1 for ps aux itself, -2 for ps aux and self
|
|
main::key($num++,'Procs') => scalar @ps_aux,
|
|
main::key($num++,$client_shell) => $client,
|
|
main::key($num++,$self_name) => &get_self_version(),
|
|
},);
|
|
my %row = (
|
|
main::key($prefix,'SHORT') => [(@data),],
|
|
);
|
|
eval $end if $b_log;
|
|
return %row;
|
|
}
|
|
|
|
#### -------------------------------------------------------------------
|
|
#### CONSTRUCTED LINES
|
|
#### -------------------------------------------------------------------
|
|
|
|
sub generate_info_data {
|
|
eval $start if $b_log;
|
|
my $num = 0;
|
|
my $gcc_alt = '';
|
|
my $running_in = '';
|
|
my $data_name = main::key($prefix++,'Info');
|
|
my ($b_gcc,%row,$gcc,$index,$ref);
|
|
my ($parent,$percent,$total,$used) = ('','','','');
|
|
my $client_shell = ($b_irc) ? 'Client' : 'Shell';
|
|
my $client = $client{'name-print'};
|
|
my @gccs = get_gcc_data();
|
|
if (@gccs){
|
|
$gcc = shift @gccs;
|
|
if ($extra > 1 && @gccs){
|
|
$gcc_alt = join '/', @gccs;
|
|
}
|
|
$b_gcc = 1;
|
|
}
|
|
$gcc ||= 'N/A';
|
|
if (!$b_irc && $extra > 1 ){
|
|
# bsds don't support -f option to get PPID
|
|
if (($b_display && !$b_force_display) && !$bsd_type){
|
|
$parent = get_shell_source();
|
|
}
|
|
else {
|
|
$parent = get_tty_number();
|
|
$parent = "tty $parent" if $parent ne '';
|
|
}
|
|
if ($parent eq 'login'){
|
|
$client{'su-start'} = $parent if !$client{'su-start'};
|
|
$parent = undef;
|
|
}
|
|
# can be tty 0 so test for defined
|
|
$running_in = $parent if defined $parent;
|
|
if ($extra > 2 && $running_in && get_ssh_status() ){
|
|
$running_in .= ' (SSH)';
|
|
}
|
|
}
|
|
my $memory = get_memory_data('splits');
|
|
if ($memory){
|
|
my @temp = split /:/, $memory;
|
|
my @temp2 = get_size($temp[0]);
|
|
$total = ($temp2[1]) ? $temp2[0] . ' ' . $temp2[1] : $temp2[0];
|
|
@temp2 = get_size($temp[1]);
|
|
$used = ($temp2[1]) ? $temp2[0] . ' ' . $temp2[1] : $temp2[0];
|
|
$used .= " ($temp[2]%)" if $temp[2];
|
|
}
|
|
$memory ||= 'N/A';
|
|
my %data = (
|
|
$data_name => [{
|
|
main::key($num++,'Processes') => scalar @ps_aux,
|
|
main::key($num++,'Uptime') => &get_uptime(),
|
|
main::key($num++,'Memory') => $total,
|
|
main::key($num++,'used') => $used,
|
|
},],
|
|
);
|
|
$index = scalar(@{ $data{$data_name} } ) - 1;
|
|
if ( (!$b_display || $b_force_display) || $extra > 0 ){
|
|
my %init = get_init_data();
|
|
my $init_type = ($init{'init-type'}) ? $init{'init-type'}: 'N/A';
|
|
$data{$data_name}[$index]{main::key($num++,'Init')} = $init_type;
|
|
if ($extra > 1 ){
|
|
my $init_version = ($init{'init-version'}) ? $init{'init-version'}: 'N/A';
|
|
$data{$data_name}[$index]{main::key($num++,'v')} = $init_version;
|
|
}
|
|
if ($init{'rc-type'}){
|
|
$data{$data_name}[$index]{main::key($num++,'rc')} = $init{'rc-type'};
|
|
if ($init{'rc-version'}){
|
|
$data{$data_name}[$index]{main::key($num++,'v')} = $init{'rc-version'};
|
|
}
|
|
}
|
|
if ($init{'runlevel'}){
|
|
$data{$data_name}[$index]{main::key($num++,'runlevel')} = $init{'runlevel'};
|
|
}
|
|
if ($extra > 1 ){
|
|
if ($init{'default'}){
|
|
my $default = ($init{'init-type'} eq 'systemd' && $init{'default'} =~ /[^0-9]$/ ) ? 'target' : 'default';
|
|
$data{$data_name}[$index]{main::key($num++,$default)} = $init{'default'};
|
|
}
|
|
}
|
|
}
|
|
if ($extra > 0 ){
|
|
my $b_clang;
|
|
my $clang_version = '';
|
|
if (my $path = check_program('clang')){
|
|
$clang_version = program_version($path,'clang',3,'--version');
|
|
$clang_version ||= 'N/A';
|
|
$b_clang = 1;
|
|
}
|
|
my $compiler = ($b_gcc || $b_clang) ? '': 'N/A';
|
|
$data{$data_name}[$index]{main::key($num++,'Compilers')} = $compiler;
|
|
if ($b_gcc){
|
|
$data{$data_name}[$index]{main::key($num++,'gcc')} = $gcc;
|
|
if ( $extra > 1 && $gcc_alt){
|
|
$data{$data_name}[$index]{main::key($num++,'alt')} = $gcc_alt;
|
|
}
|
|
}
|
|
if ($b_clang){
|
|
$data{$data_name}[$index]{main::key($num++,'clang')} = $clang_version;
|
|
}
|
|
}
|
|
if ($extra > 2 && $client{'su-start'}){
|
|
$client .= " ($client{'su-start'})";
|
|
}
|
|
$data{$data_name}[$index]{main::key($num++,$client_shell)} = $client;
|
|
if ($extra > 0 && $client{'version'}){
|
|
$data{$data_name}[$index]{main::key($num++,'v')} = $client{'version'};
|
|
}
|
|
if ( $running_in ){
|
|
$data{$data_name}[$index]{main::key($num++,'running in')} = $running_in;
|
|
}
|
|
$data{$data_name}[$index]{main::key($num++,$self_name)} = &get_self_version();
|
|
|
|
eval $end if $b_log;
|
|
return %data;
|
|
}
|
|
|
|
sub generate_system_data {
|
|
eval $start if $b_log;
|
|
my $num = 0;
|
|
my (%row,$ref,$index,$val1);
|
|
my $data_name = main::key($prefix++,'System');
|
|
my ($desktop,$desktop_info,$desktop_key,$toolkit,$wm) = ('','','Desktop','','');
|
|
my (@desktop_data,$desktop_version);
|
|
|
|
my %data = (
|
|
$data_name => [{}],
|
|
);
|
|
$index = scalar(@{ $data{$data_name} } ) - 1;
|
|
if ($show{'host'}){
|
|
$data{$data_name}[$index]{main::key($num++,'Host')} = &get_hostname();
|
|
}
|
|
$data{$data_name}[$index]{main::key($num++,'Kernel')} = &get_kernel_data();
|
|
$data{$data_name}[$index]{main::key($num++,'bits')} = &get_kernel_bits;
|
|
if ($extra > 0){
|
|
my @compiler = get_compiler_version(); # get compiler data
|
|
if (scalar @compiler != 2){
|
|
@compiler = ('N/A', '');
|
|
}
|
|
$data{$data_name}[$index]{main::key($num++,'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++,'v')} = $compiler[1];
|
|
}
|
|
}
|
|
# note: tty can have the value of 0 but the two tools
|
|
# return '' if undefined, so we test for explicit ''
|
|
if ($b_display){
|
|
my @desktop_data = DesktopEnvironment::get();
|
|
$desktop = $desktop_data[0] if $desktop_data[0];
|
|
$desktop_version = $desktop_data[1] if $desktop_data[1];
|
|
$desktop .= ' ' . $desktop_version if $desktop_version;
|
|
if ($extra > 0 && $desktop_data[3]){
|
|
#$desktop .= ' (' . $desktop_data[2];
|
|
#$desktop .= ( $desktop_data[3] ) ? ' ' . $desktop_data[3] . ')' : ')';
|
|
$toolkit = "$desktop_data[2] $desktop_data[3]";
|
|
}
|
|
if ($extra > 2 && $desktop_data[4]){
|
|
$desktop_info = $desktop_data[4];
|
|
}
|
|
# don't print the desktop if it's a wm and the same
|
|
if ($desktop_data[5] && (!$desktop_data[0] || index(lc($desktop_data[5]),lc($desktop_data[0])) == -1 )){
|
|
$wm = $desktop_data[5];
|
|
}
|
|
}
|
|
if (!$b_display || ( ! $desktop && $b_root)) {
|
|
my $tty = get_tty_number();
|
|
if (!$desktop){
|
|
$desktop_info = '';
|
|
}
|
|
# it is defined, as ''
|
|
if ( $tty eq '' && $client{'console-irc'}){
|
|
$tty = get_tty_console_irc();
|
|
}
|
|
$desktop = "tty $tty" if $tty ne '';
|
|
$desktop_key = 'Console';
|
|
}
|
|
$desktop ||= 'N/A';
|
|
$data{$data_name}[$index]{main::key($num++,$desktop_key)} = $desktop;
|
|
if ($toolkit){
|
|
$data{$data_name}[$index]{main::key($num++,'tk')} = $toolkit;
|
|
}
|
|
if ($extra > 2){
|
|
if ($desktop_info){
|
|
$data{$data_name}[$index]{main::key($num++,'info')} = $desktop_info;
|
|
}
|
|
if ($wm){
|
|
$data{$data_name}[$index]{main::key($num++,'wm')} = $wm;
|
|
}
|
|
}
|
|
if ($extra > 1){
|
|
my $dms = get_display_manager();
|
|
$dms ||= 'N/A';
|
|
$data{$data_name}[$index]{main::key($num++,'dm')} = $dms;
|
|
}
|
|
my $distro_key = ($bsd_type) ? 'OS': 'Distro' ;
|
|
my $distro = DistroData::get();
|
|
$distro ||= 'N/A';
|
|
$data{$data_name}[$index]{main::key($num++,$distro_key)} = $distro;
|
|
|
|
eval $end if $b_log;
|
|
return %data;
|
|
}
|
|
|
|
#######################################################################
|
|
#### LAUNCH
|
|
########################################################################
|
|
|
|
main(); ## From the End comes the Beginning
|
|
|
|
## note: this EOF is needed for smxi handling, this is what triggers the full download ok
|
|
###**EOF**###
|